谁能在程序中屏蔽掉浏览器广告窗口(200分)(200分)

W

wmyao

Unregistered / Unconfirmed
GUEST, unregistred user!
通过TWebBrowser控件使用,如何去掉弹出的广告窗口
 
L

lzj_29

Unregistered / Unconfirmed
GUEST, unregistred user!
我做个这样的程序,但在98下不是太稳定,所以就免费了,
可以到http://www.euromind.com/iedelphi去看一下,我就是从那里得到的资料
不过可是E文呢
 
O

oiwin

Unregistered / Unconfirmed
GUEST, unregistred user!
我把源码贴在这。
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.
 
W

wmyao

Unregistered / Unconfirmed
GUEST, unregistred user!
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
顶部