江湖救急：怎样关闭浏览器的弹出式广告窗口(200分)

江湖救急：怎样关闭浏览器的弹出式广告窗口

用Findwindow函数试一试

http://www.delphibbs.com/delphibbs/dispq.asp?lid=752644
我问过类似的问题
我现在只上DFW，所以这个问题没有继续讨论了

禁止ie中java功能。

好象办法不多,最好是找一个收费空间,也不是太贵,大约每年300元左右,不但没有广告,
还提供数据库支持,asp支持!

谁能回答
我再给分

把它扼杀在摇篮里，再不行就把它卡死在胎盘里。呵

我的浏览器源代码里有!

WebBrowser有OnNewWindow事件，控制弹出很方便。
有些弹窗口不是广告，这判断是不是广告才是关键。

具体一点
有没有源代码呀--雨人

我的E-mail:feng0904@163.com

1. 查表法， 建立一个禁止弹出的地址表；每次有窗口要弹出时查表，在表中则KILL。否则弹出，并
询问是否加到禁止表。
2。地址过滤，如包含AD.xxx.com的弹出窗口，KILL
3。内容过滤，文本内容少，包含SALE，PROMPT，。。等，KILL
4。外观过滤，窗口小，无菜单、STATUSBAR，SPEEDBUTTON的，KILL

最好的办法是智能地综合使用多种过滤，AI法，呵。 当然一定要给用户自己选择判断的余地

具体一点
有没有源代码呀--yaoluo
我的E-mail:feng0904@163.com

具体一点
有没有源代码呀--yaoluo
我的E-mail:feng0904@163.com

关注

下面是源码
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.

oiwin的代码可以用，但不是很好用。[]

很高兴oiwin引用了偶在电脑爱好者上发表的示范程序。
我现在给程序加上了进程show(进程、线程、窗口[窗口名.类名])，
通过它知道恶意窗口的类名和窗口名， 并加入黑名单。
用窗口有没有WorkerA 来判断是否广告窗口时存在一个问题： 有些正常
窗口刚刚可见时， WorkerA没有立即出现， 而要再过0.几秒才出现， 这样它
可能被当作广告窗口关闭。 我的处理方法是： 每秒扫描1次， 若发现某窗口
没有WorkerA， 那么再过0.5秒， 如果它还没有WorkerA， 那就只好对不起它了

学习

加入ShellHook监视窗口创建，监测新的窗口是否包含ie组件，然后判断窗口是否在客户区只有
Ie组件，没有工具栏