以下是代码片段: 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. |