关于屏蔽IE弹出的广告窗口(100分)

  • 主题发起人 主题发起人 mdc
  • 开始时间 开始时间
M

mdc

Unregistered / Unconfirmed
GUEST, unregistred user!
调用bho时,用这样一条语句if ie.ToolBar=0 then ie.Quit;可以屏蔽广告窗口,不过IE
总是出现错误而被迫关闭。
请问谁有更好的办法?
 
让弹出式广告就地正法
让弹出式广告就地正法
作者: tomore 提出时间: 2002年6月6日 15:01 访问数:84
大小:1,842字节


简介:
每当我浏览网站的时候,那扑面而来的广告窗口总是弄得我心烦意乱.我下定决心要自己编一个查杀广告的程序.经过我的观察,发现了广告窗口和正常IE窗口的区别主要在于广告窗口没有标题栏和状态栏(其实它们也有,如果你不明白,请继续往下看!)

祭出我自编的软件-探索者(其实只不过是窗口类的显示器,当然也能看密码),发现正常浏览窗口的类名是IEFRAME和CabinetWClass,而广告窗口的类名是CabinetWClass,听说在Windows2000中也是IEFrame(未经证实).其实是什么都无所谓,只要在程序中查找这两个类就可以了.

procedure TForm1.Timer1Timer(Sender: TObject);

var

mainHD,WorkAHD:THandle;

begin

// Kill AD.

mainHD:=FindWIndowEx(0,0,'CabinetWClass',nil);

if Mainhd<>0 then

begin

WorkAHD:=FindWindowEx(Mainhd,0,'WorkerA',nil); ////WorkerA类,具体关联见下图

if WorkAHD=0 then PostMessage(Mainhd,WM_CLOSE,0,0);

end;

end;

通过在Timer事件中调用FindWindowEx函数可以查找到运行窗口的句柄,具体介绍请见Delphi的Win32 API帮助.

当我满心欢喜的运行程序时却发现广告窗口一如往常的弹出,哪里出了错?继续祭出我的"探索者",先把IE浏览器的框架结构搞清楚,功夫不负有心人,经过一下午的时间,终于让我找到了:







调试,却发现原来广告窗口同样具有上图的结构,这也让我的程序设计进程停滞不前,经过两个晚上的思考,我终于想到另一个API函数:GetWindowRect,它可以得到一个窗口的物理尺寸结构.马上调试,终于发现:

1.广告窗口的WorkerA类和Shell DocObject View类的rect.top的值是相同的;

2.正常IE窗口的WorkerA类和Shell DocObject View类的rect.top的值是不相同的;

马上更改代码,代码如下:

procedure TForm1.Timer1Timer(Sender: TObject);

var

mainHD,WorkAHD,ViewHD:THandle;

y_workA,y_view:integer;

rect1,rect2:TRect;

begin

// Kill AD.

mainHD:=FindWIndowEx(0,0,'CabinetWClass',nil);

if Mainhd<>0 then

begin

WorkAHD:=FindWindowEx(Mainhd,0,'WorkerA',nil);

GetwindowRect(WorkAHD,rect1);

y_workA:=rect1.top;

ViewHD:=FindWindowEx(mainHD,0,'Shell DocObject View',nil);

if viewHD<>0 then ////注1:

begin

GetwindowRect(ViewHD,rect2);

y_view:=rect2.top;

if y_View-y_WorkA<5 then PostMessage(Mainhd,WM_CLOSE,0,0);

end;

end;

end;

程序的主要核心部分我已经给出来了,至于其它的,像:如何把程序添加到启动菜单,最小化到任务栏中等等,这方面的介绍很多,我就不多言了.

本程序在Windows98SE和Delphi5.0下调试通过.

注1:其实资源管理器的类名也是"CabinetWClass",但它不具有"Shell DocObject View".如果不判断这一点,那么运行程序后,你连资源管理器也打不开了.
 
关注!
太阳火:你的用timer不行的,这样的杀广告程序是广告弹出来以后才杀的。

 
楼上说的有点道理……还有更好的方法嘛?
 
刚下了一个,贴出来看看。
unit unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellAPI, ExtCtrls;

const
ICON_ID = 1;
ICONEVENT = WM_USER + 1;

type
TPopWinKillerForm = class(TForm)
PopupMenu1: TPopupMenu;
Pause: TMenuItem;
Continue: TMenuItem;
Quit: TMenuItem;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure PauseClick(Sender: TObject);
procedure ContinueClick(Sender: TObject);
procedure QuitClick(Sender: TObject);
private
{ Private declarations }
procedure InstallIcon;
procedure UnInstallIcon;
procedure IconOnClick(var message: TMessage); message ICONEVENT;
procedure ENumChildWindows(hand: HWND);
public
{ Public declarations }
end;

var
PopWinKillerForm: TPopWinKillerForm;
IconData: TNotifyIconData;

implementation

{$R *.DFM}

{ TForm1 }

procedure TPopWinKillerForm.FormCreate(Sender: TObject);
var
aa:hwnd;
begin
aa := FindWindow('TPopWinKillerForm','xta');
if aa <> 0 then
begin
MessageBox(Handle,'程序已经运行,请不要重复运行','信息',MB_OK);
Application.Terminate;
exit;
end;
PopWinKillerForm.Caption := 'xta';
InstallIcon; //安装图标
Width:=0;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TPopWinKillerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnInstallIcon; //卸载图标
end;

procedure TPopWinKillerForm.Timer1Timer(Sender: TObject);
var
h: HWnd;
Text: array [0..255] of char;
begin
h:=GetWindow(Handle, GW_HWNDFIRST);
while h <> 0 do
begin
if GetWindowText(h, @Text, 255)>0 then
if GetClassName(h, @Text, 255)>0 then
if (StrPas(Text)='CabinetWClass') or (StrPas(Text)='IEFrame') then
ENumChildWindows(h);
h:=GetWindow(h, GW_HWNDNEXT);
end;
end;

procedure TPopWinKillerForm.PauseClick(Sender: TObject);
begin
Timer1.Enabled:=False;
Pause.Checked:=true;
Continue.Checked:=False;
end;

procedure TPopWinKillerForm.ContinueClick(Sender: TObject);
begin
Timer1.Enabled:=True;
Pause.Checked:=False;
Continue.Checked:=true;
end;

procedure TPopWinKillerForm.QuitClick(Sender: TObject);
begin
Close;
end;

//安装图标
procedure TPopWinKillerForm.InstallIcon;
begin
IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=Handle;
IconData.uID:=ICON_ID;
IconData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallBackMessage:=ICONEVENT;
IconData.hIcon:=PopWinKillerForm.Icon.Handle;;
IconData.szTip:='广告窗口杀手';
Shell_NotifyIcon(NIM_ADD, @IconData );
end;

//卸载图标
procedure TPopWinKillerForm.UnInstallIcon;
begin
Shell_NotifyIcon(NIM_DELETE, @IconData );
end;

//在图标上按下鼠标
procedure TPopWinKillerForm.IconOnClick(var message: TMessage);
var
p: TPoint;
begin
if (message.lParam = WM_LBUTTONDOWN) or (message.lParam = WM_RBUTTONDOWN) then
begin
GetCursorPos(p);
PopupMenu1.Popup(p.x ,p.y);
end;
end;

procedure TPopWinKillerForm.ENumChildWindows(hand: HWND);
var
h: HWND;
s: Array[0..255] of char;
IsPopWindow: Bool;
begin
IsPopWindow:=True;
h:=GetWindow(hand,GW_child);
while h>0 do
begin
GetClassName(h, s, 256);
if (StrPas(s)='WorkerA') or (StrPas(s)='WorkerW') then
If IsWindowVisible(h) then
IsPopWindow:=False;
h:=GetWindow(h,GW_HWNDNEXT);
end;
if IsPopWindow then
PostMessage(hand,WM_CLOSE,0,0);
end;

end.

 
联众的启动FLASH怎么屏蔽?呵呵
 
多人接受答案了。
 
后退
顶部