Delphi实现监视Windows窗口的创建销毁

要监视Windows窗口的各种事件，可以使用全局钩子，但是那样会降低系统性能，并难以保证稳定性。

下面使用一个未公开的函数RegisterShellHook（Shell32.dll的181号导出函数）实现该功能。

代码来自一个DLL项目，需要经过修改才能运行。

以下是代码片段： Unit Test_Unit; Interface Uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls,   Tlhelp32, PSAPI; Const   HSHELL_WINDOWCREATED = $0001;         // 系统级的窗体被创建   HSHELL_WINDOWDESTROYED = $0002;       // 系统级的窗体即将被关闭   HSHELL_ACTIVATESHELLWINDOW = $0003;   // SHELL 的主窗体将被激活   HSHELL_WINDOWACTIVATED = $0004;       // 系统级的窗体被激活   HSHELL_GETMINRECT = $0005;            // 窗体被最大化或最小化   HSHELL_REDRAW     = $0006;            // Windows 任务栏被刷新   HSHELL_TASKMAN    = $0007;            // 任务列表的内容被选中   HSHELL_LANGUAGE   = $0008;            // 中英文切换或输入法切换   GWL_WNDPROC       = $ - 4;            // 该索引用来创建窗口类的子类 Type   TFrmTest = Class(TForm)     mmo1: TMemo;     Procedure FormCreate(Sender: TObject);     Procedure FormDestroy(Sender: TObject);   Private     { Private declarations }     FWindowHandle: HWND;     Procedure WndProc2(Var Msg: TMessage);   Public     { Public declarations }     Procedure WMWindowsChange(Var Msg: TMessage); // 接收窗口改变的消息   End; Function RegisterShellHook(HWND, nAction: LongWord): Integer; stdcall; external 'Shell32.dll' index 181; Function RegisterShellHookWindow(HWND: LongWord): Integer; stdcall; external 'User32.dll' Name 'RegisterShellHookWindow'; Function GetProcessFileName(Const vProcessID: LongWord): String; Var   Msg_ID            : Cardinal;   Original          : Integer; Implementation {$R *.dfm} Procedure TFrmTest.WndProc2(Var Msg: TMessage); Begin   If (Msg.Msg = Msg_ID) Then     Begin       Try         WMWindowsChange(Msg);       Except         // Application.HandleException(Self);       End;     End   Else     Msg.result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.WParam, Msg.lParam);   //Msg.result := CallWindowProc(Original, FWindowHandle, Msg.Msg, Msg.WParam, Msg.lParam); End; Procedure TFrmTest.WMWindowsChange(Var Msg: TMessage); Var   buf               : Array[0..250] Of Char;   WindowsCaption    : String;   iLen              : Integer;   strAction         : String;   ProcessID         : DWORD;   hProcess          : THandle;   ModHandle         : HMODULE;   ProcessName       : String;   ExePath           : String;   tmp               : DWORD; Begin   If (Msg.WParam <> HSHELL_WINDOWCREATED) And (Msg.WParam <> HSHELL_WINDOWDESTROYED) And (Msg.WParam     <> HSHELL_WINDOWACTIVATED) Then Exit;   iLen := GetWindowThreadProcessId(Msg.lParam, @ProcessID);   ProcessName := GetProcessFileName(ProcessID);   hProcess := OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, false, ProcessID);   If hProcess > 0 Then     Begin       iLen := GetModuleFileNameEx(hProcess, 0, buf, SizeOf(buf));       ExePath := buf;       CloseHandle(hProcess);     End;   iLen := GetWindowText(Msg.lParam, buf, SizeOf(buf));   If iLen < 1 Then Exit;                // 取窗体的标题   WindowsCaption := buf;   strAction := '';   Case Msg.WParam Of     HSHELL_WINDOWCREATED:       // strAction := '系统级的窗体被创建';       strAction := '创建';     HSHELL_WINDOWDESTROYED:       // strAction := '系统级的窗体即将被关闭';       strAction := '关闭';     {HSHELL_ACTIVATESHELLWINDOW:       strAction := 'SHELL 的主窗体将被激活'; }     //HSHELL_WINDOWACTIVATED:       // strAction := '系统级的窗体被激活';     //  strAction := '激活'; // 拦截 激活,为了QQ,QQ信息窗口建立的时候,无法取到标题,关闭的时候反而能     {HSHELL_GETMINRECT:       strAction := '窗体被最大化或最小化';     HSHELL_REDRAW:       strAction := 'Windows 任务栏被刷新';     HSHELL_TASKMAN:       strAction := '任务列表的内容被选中';     HSHELL_LANGUAGE:       strAction := '中英文切换或输入法切换';}   End;   If strAction <> '' Then     SendLog('$' + strAction + '$' + WindowsCaption + '$' + ProcessName + '$' + ExePath); End; Function GetProcessFileName(Const vProcessID: LongWord): String; Var   Snap              : THandle;   RB                : Boolean;   PE                : TProcessEntry32; Begin   If vProcessID = 0 Then Exit;   Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);   If Snap = -1 Then Exit;   Try     PE.dwSize := SizeOf(TProcessEntry32);     RB := Process32First(Snap, PE);     While RB Do       Begin         If PE.th32ProcessID = vProcessID Then           Begin             result := PE.szExeFile;             Break;           End;         PE.dwSize := SizeOf(TProcessEntry32);         RB := Process32Next(Snap, PE);       End;   Finally     CloseHandle(Snap);   End; End; Procedure TFrmTest.FormCreate(Sender: TObject); Begin   FWindowHandle := AllocateHWnd(WndProc2);   Msg_ID := RegisterWindowMessage('SHELLHOOK');   RegisterShellHookWindow(FWindowHandle);   //RegisterShellHook(Self.Handle, 1);   //Original := SetWindowLong(Self.Handle, GWL_WNDPROC, Cardinal(@WndProc2)); End; Procedure TFrmTest.FormDestroy(Sender: TObject); Begin   DeallocateHWnd(FWindowHandle);   //RegisterShellHook(FWindowHandle, 0);   //Original := SetWindowLong(Self.Handle, GWL_WNDPROC, Original); End; End.