如何用DELPHI编程实现禁止浏览器弹出广告窗口？(50分)

macrolen · 2001-12-11

同上....[

]

Toylin · 2001-12-11

可以，但需要管理员输入禁止弹出的网页的名称或所含有的内容， 在Webbrowser控件的新弹开窗口事件中加以判断，就可以啦

macrolen · 2001-12-11

有原代码么？参考一下，急着用呢！macrolen@163.net

Toylin · 2001-12-11

我做的浏览器现在并没有禁止，用户自己关去好了。 如果判别内容，会影响网页打开速度。 建议判断网址或网页名，控件中很方便的能得到

macrolen · 2001-12-11

我曾经有一个用VC编的，运行后最小化到系统托盘后就再也没有广告弹出了！[

]

我是帅哥 · 2001-12-13

program

太阳火 · 2001-12-15

macrolen:万一那不是广告是重要的通知，你的程序可以分辨出来吗？

coolbaby · 2001-12-28

确实不好分辨 其实好多是判断新弹出的窗口有没有 菜单栏，没有的关闭 很可能误关的

kinneng · 2001-12-29

判断新弹出的窗口有没有菜单栏，没有的第一次别关， 询问，如果用户决定关， 记住标题的字串，以后再出现就关掉它好了。

macrolen · 2001-12-29

看样子很复杂呀！其实我也不管它弹出的是不是广告，只要是在浏览时自动弹出的小窗口就关闭。 我做了一个，可连我点开连接的窗口都关闭了。谁有原码？给我研究研究！谢了！[

]

cozo · 2002-01-02

其实真正的好方法只能是看网址.看标题的话岂不是要等收到网页的信息才关，那不是浪费带宽吗? 针对国内的情况，也就是163的比较严重，它的网址是固定的，当跳出新窗口，看它的连接请求，如果符合过滤条件，关闭。 为了扩展性，可以把过滤网址写在一个文本文件里嘛。

机机 · 2002-02-14

关注

Pan Ying · 2002-02-14

源码方法的话参见本页面http://www.euromind.com/iedelphi/ie5tools/bho.htm 我个人认为应该输入网址列表，检查以后就可以关闭了吗。

failureman · 2002-11-23

关注

oiwin · 2002-12-26

下面是源码 unit unit1; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,   Menus, ShellAPI, ExtCtrls; const   ICON_ID = 1;   ICONEVENT = WM_USER + 1; type   TForm1 = 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   Form1: TForm1;   IconData: TNotifyIconData; implementation {$R *.DFM} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin   InstallIcon; //安装图标   Width:=0;   SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin   UnInstallIcon; //卸载图标 end; procedure TForm1.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 TForm1.PauseClick(Sender: TObject); begin   Timer1.Enabled:=False;   Pause.Checked:=true;   Continue.Checked:=False; end; procedure TForm1.ContinueClick(Sender: TObject); begin   Timer1.Enabled:=True;   Pause.Checked:=False;   Continue.Checked:=true; end; procedure TForm1.QuitClick(Sender: TObject); begin   Close; end; //安装图标 procedure TForm1.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:=Form1.Icon.Handle;;   IconData.szTip:='广告窗口杀手';   Shell_NotifyIcon(NIM_ADD, @IconData ); end; //卸载图标 procedure TForm1.UnInstallIcon; begin   Shell_NotifyIcon(NIM_DELETE, @IconData ); end; //在图标上按下鼠标 procedure TForm1.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 TForm1.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.

太阳火 · 2003-01-17

(转载自playicq) 让弹出式广告就地正法   作者： 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". 如果不判断这一点,那么运行程序后,你连资源管理器也打不开了.

_zeus · 2003-02-10

只要能判断窗口中显示的 HTML 内容就行。 不过要怎么得到？...

tianliangle2003 · 2003-05-06

unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ExtCtrls, StdCtrls,registry; type   TForm1 = class(TForm)     Button1: TButton;     Timer1: TTimer;     procedure FormCreate(Sender: TObject);     procedure Timer1Timer(Sender: TObject);     procedure Button1Click(Sender: TObject);     procedure FormClose(Sender: TObject; var Action: TCloseAction);   private     { Private declarations }   public     { Public declarations }   end; var   Form1: TForm1;   ieclassname:string;   deskwidth,deskheight:integer;   //strs:tstrings; implementation {$R *.dfm} function enumchildprocs(wnd:hwnd;lparam:lparam):boolean;stdcall; var buffer1:array[0..255] of char; begin result:=true; getclassname(wnd,buffer1,255); //strs.Add(buffer1); end;  function getiever(key:string):string;  var  reg:tregistry;  begin  reg:=tregistry.Create ;  reg.RootKey:=HKEY_LOCAL_MACHINE;  if reg.OpenKey('software/microsoft/internet explorer',false) then  begin  try  result:=reg.ReadString(key);  except  result:='';  end;  end  else  reg.Free;  end; procedure TForm1.FormCreate(Sender: TObject); var h:thandle; t:trect; begin timer1.Interval :=1000; timer1.Enabled :=false; //if getiever('version')[1]='5' then //ieclassname:='CabinetWclass'; //if getiever('version')[1]='5' then //ieclassname:='IEFrame'; //if getiever('version')[1]='6' then ieclassname:='IEFrame'; h:=findwindow('progman',nil); getwindowrect(h,t); deskwidth:=t.Right-t.Left; deskheight:=t.Bottom-t.Top; //strs:=tstringlist.Create;                 end; procedure TForm1.Timer1Timer(Sender: TObject); var iehandle,iehandle1,ie:thandle; style:longint; ierect:trect; closeie:boolean; i,c,h:integer; ietext:array[0..255] of char; begin c:=0; iehandle:=findwindow(pchar(ieclassname),nil); //iehandle1:=findwindow('IEFrame',nil); //strs.Clear; //enumchildwindows(iehandle,@enumchildprocs,0); {for i:=0 to strs.Count-1 do begin if strs='ReBarWindow32' then begin c:=1; end; end; if c=0 then begin postmessage(iehandle,wm_syscommand,sc_close,0); end;} {iehandle1:=ChildWindowFromPointEx(iehandle,point(50,100),CWP_SKIPINVISIBLE); ie:=FindWindowEx(iehandle,0,nil,'地址(&D)'); if ie=0 then begin postmessage(iehandle,wm_syscommand,sc_close,0); end;} if iehandle<>0 then begin closeie:=false; style:=getwindowlong(iehandle,gwl_style); getwindowrect(iehandle,ierect); if ((style and ws_sizebox)<>ws_sizebox) then closeie:=true else with ierect do begin if (right-left>160) and (right-left<500) and (bottom-top>37) and (bottom-top<400) then closeie:=true; end; if ((ierect.right-ierect.left)>(deskwidth+10)) or ((ierect.Bottom-ierect.Top)>(deskheight+10))  then closeie:=true; if  ((ierect.right-ierect.left)<(deskwidth-10)) and ((ierect.right-ierect.left)>(deskwidth div 2)) and ((ierect.Bottom-ierect.Top)<(deskheight div 2 +30)) then closeie:=true; h:=getwindowtext(iehandle,ietext,256); if (pos('脱机时无法使用',trim(ietext))>0) or (pos('about:blank',ietext)>0) or (pos('无法连接',ietext)>0) or (pos('找不到服务器',ietext)>0)  then closeie:=true; end; if closeie=true then postmessage(iehandle,wm_syscommand,sc_close,0); end; procedure TForm1.Button1Click(Sender: TObject); begin timer1.Enabled :=true; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin timer1.Enabled :=false; end; end.

yczjs · 2003-05-06

http://mydelphi.8u8.com/ym2.htm Delphi园地 广告窗口杀手源码

如何用DELPHI编程实现禁止浏览器弹出广告窗口？(50分)

macrolen

Unregistered / Unconfirmed

Toylin

Unregistered / Unconfirmed

macrolen

Unregistered / Unconfirmed

Toylin

Unregistered / Unconfirmed

macrolen

Unregistered / Unconfirmed

我是帅哥

Unregistered / Unconfirmed

太阳火

Unregistered / Unconfirmed

coolbaby

Unregistered / Unconfirmed

kinneng

Unregistered / Unconfirmed

macrolen

Unregistered / Unconfirmed

cozo

Unregistered / Unconfirmed

机机

Unregistered / Unconfirmed

Pan Ying

Unregistered / Unconfirmed

failureman

Unregistered / Unconfirmed

oiwin

Unregistered / Unconfirmed

太阳火

Unregistered / Unconfirmed

_zeus

Unregistered / Unconfirmed

tianliangle2003

Unregistered / Unconfirmed

yczjs

Unregistered / Unconfirmed

Similar threads