广告窗口杀手

————————————————以下为程序代码—————————————

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.