我已經看到了很多人想在一個應用程序中掛接消息搞一個干凈的解決方案。所以，前一段時間作我決定寫一個鉤子類，能很好的處理事件之類的東西。

Hook.pas可以分配方法的指針指向一個過程（有一些匯編的幫助）。

例如：如果你想在應用程序中捕獲所有擊鍵 - 只需聲明一個TKeyboardHook實例，指派一個處理程序給OnPreExecute或OnPostExecute，或同時處理這兩個事件。設置激活你的KeyboadHook（KeyboardHook.Active：= true）然后你就可以出去等他運行了..

Windows的鉤子
下面是Windows API指南中鉤子的說明：

一個鉤子是系統消息處理機制的指針，應用程序可以安裝一個子程序，監測系統中到達目標窗口過程的消息的和某些類型的信息流量。

簡單的說，掛鉤是一個函數，你可以創建一個DLL或您的應用程序的一部分來監視Windows操作系統內部運做。

想法就是寫一個函數，Windows發生某些事件時可以調用 - 例如，當用戶按下鍵盤上的鍵或移動鼠標。

為了更深入介紹鉤子，看看? Windows鉤子以及如何在Delphi應用程序使用它們。

掛鉤機制依賴于Windows消息和回調函數。

掛鉤類型
不同的鉤子類型使應用程序能夠監視系統的不同信息。

例如：
您可以使用WH_KEYBOARD鉤子監視鍵盤輸入發送的消息隊列;
您可以使用WH_MOUSE鉤子子監視鼠標輸入發送的消息隊列;
您可以用WH_SHELL鉤子處理Shell程序應用程序即將被激活、當頂層窗口創建或銷毀。

Hooks.pas
該hooks.pas單位定義了幾個鉤子類型：

??? TCBTHook - 在窗口激活，創建，銷毀，最小化，最大化，移動或調整大小之前調用，完成一個系統命令之前，從系統消息隊列中刪除鼠標或鍵盤事件之前，設置輸入焦點之前;或與前同步系統消息隊列之前也會調用。
??? TDebugHook - 在調用系統中其他鉤子設置的過程之前調用
??? TGetMessageHook - 使應用程序能夠監視即將被GetMessage或者PeekMessage函數返回的消息
??? TJournalPlaybackHook -應用程序能夠在系統消息隊列中插入消息。
??? TJournalRecordHook - 讓您能夠監視和記錄輸入事件（使用WH_JOURNALPLAYBACK鉤子記錄鼠標和鍵盤事件的順序以便后來重現）。
??? TKeyboardHook - 讓應用程序可以監視WM_KEYDOWN和WM_KEYUP消息流量。
??? TMouseHook - 讓您能監視即將被GetMessage或者PeekMessage函數返回的鼠標消息。
??? TLowLevelKeyboardHook - 允許您監視即將送到一個線程輸入隊列的鍵盤輸入事件。
??? TLowLevelMouseHook - 允許您監視即將送到一個線程輸入隊列的鼠標輸入事件。

TKeyboardHook例子
這里有一個演示應用程序的鍵盤鉤子的部分代碼，向你展示你如何使用hooks.pas：

uses hooks, ....

var
??KeyboardHook: TKeyboardHook;
....
//MainForm's OnCreate event handler
procedure TMainForm.FormCreate(Sender: TObject) ;
begin
??KeyboardHook := TKeyboardHook.Create;
??KeyboardHook.OnPreExecute := KeyboardHookPREExecute;
??KeyboardHook.Active := True;
end;

//handles KeyboardHook's OnPREExecute
procedure TMainForm.KeyboardHookPREExecute(Hook: THook; var Hookmsg: THookMsg) ;
var
??Key: Word;
begin
??//Here you can choose if you want to return
??//the key stroke to the application or not
??Hookmsg.Result := IfThen(cbEatKeyStrokes.Checked, 1, 0) ;
??Key := Hookmsg.WPARAM;

??Caption := Char(key) ;
end;

?

{
*****************************************************************************
*?????????????????????????????????????????????????????????????????????????? *
*?????????????????????????????????? Hooks?????????????????????????????????? *
*?????????????????????????????????????????????????????????????????????????? *
*??????????????????????????? By Jens Borrisholt???????????????????????????? *
*?????????????????????????? Jens@Borrisholt.com???????????????????????????? *
*?????????????????????????????????????????????????????????????????????????? *
* This file may be distributed and/or modified under the terms of the GNU?? *
* General Public License (GPL) version 2 as published by the Free Software? *
* Foundation.?????????????????????????????????????????????????????????????? *
*?????????????????????????????????????????????????????????????????????????? *
* This file has no warranty and is used at the users own peril????????????? *
*?????????????????????????????????????????????????????????????????????????? *
* Please report any bugs to Jens@Borrisholt.com or contact me if you want?? *
* to contribute to this unit.? It will be deemed a breach of copyright if?? *
* you publish any source code? (modified or not) herein under your own name *
* without the authors consent!!!!!????????????????????????????????????????? *
*?????????????????????????????????????????????????????????????????????????? *
* CONTRIBUTIONS:-?????????????????????????????????????????????????????????? *
*????? Jens Borrisholt (Jens@Borrisholt.com) [ORIGINAL AUTHOR]????????????? *
*?????????????????????????????????????????????????????????????????????????? *
* Published:? http://delphi.about.com/od/windowsshellapi/a/delphi-hooks.htm *
*****************************************************************************
}

unit hooks;

interface

uses
? Windows, Classes;

const
? WH_KEYBOARD_LL = 13;
? WH_MOUSE_LL = 14;

? (*
? * Low level hook flags
? *)
? LLKHF_EXTENDED = $01;
? LLKHF_INJECTED = $10;
? LLKHF_ALTDOWN = $20;
? LLKHF_UP = $80;

{$M+}
type
? TKeyState = (ksKeyDown, ksKeyIsDown, ksDummy, ksKeyUp);
? THookMsg = packed record
??? Code: Integer;
??? WParam: WPARAM;
??? LParam: LPARAM;
??? Result: LResult
? end;

? ULONG_PTR = ^DWORD;
? pKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
? KBDLLHOOKSTRUCT = packed record
??? vkCode: DWORD;
??? scanCodem: DWORD;
??? flags: DWORD;
??? time: DWORD;
??? dwExtraInfo: ULONG_PTR;
? end;

? pMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
? MSLLHOOKSTRUCT = packed record
??? Pt: TPoint;
??? MouseData: DWORD;
??? Flags: DWORD;
??? Time: DWORD;
??? dwExtraInfo: ULONG_PTR;
? end;

? TCustomHook = class;
? THook = class;

? THookMethod = procedure(var HookMsg: THookMsg) of object;
? THookNotify = procedure(Hook: THook; var Hookmsg: THookMsg) of object;

? TCustomHook = class
? private
??? FHook: hHook;
??? FHookProc: Pointer;
??? FOnPreExecute: THookNotify;
??? FOnPostExecute: THookNotify;
??? FActive: Boolean;
??? FLoadedActive: Boolean;
??? FThreadID: Integer;

??? procedure SetActive(NewState: Boolean);
??? procedure SetThreadID(NewID: Integer);
??? procedure HookProc(var HookMsg: THookMsg);
? protected
??? procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); virtual;
??? procedure PostExecute(var HookMsg: THookMsg); virtual;
??? function AllocateHook: hHook; virtual; abstract;
? public
??? constructor Create;
??? destructor Destroy; override;
??? property ThreadID: Integer read FThreadID write SetThreadID stored False;
??? property Active: Boolean read FActive write SetActive;
??? property OnPreExecute: THookNotify read FOnPreExecute write FOnPreExecute;
??? property OnPostExecute: THookNotify read FOnPostExecute write FOnPostExecute;
? end;

? THook = class(TCustomHook)
? published
??? property Active;
??? property OnPreExecute;
??? property OnPostExecute;
? end;

? TCallWndProcHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TCallWndProcRetHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TCBTHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TDebugHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TGetMessageHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TJournalPlaybackHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TJournalRecordHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TKeyboardHook = class(THook)
? private
??? FKeyState: TKeyState;
? protected
??? procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); override;
??? procedure PostExecute(var HookMsg: THookMsg); override;
? public
??? function AllocateHook: hHook; override;
? published
??? property KeyState : TKeyState read FKeyState;
? end;

? TMouseHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TMsgHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TShellHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TSysMsgHook = class(THook)
? public
??? function AllocateHook: hHook; override;
? end;

? TLowLevelKeyboardHook = class(THook)
? private
??? FHookStruct: pKBDLLHOOKSTRUCT;
? protected
??? procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); override;
??? procedure PostExecute(var HookMsg: THookMsg); override;
? public
??? function AllocateHook: hHook; override;
??? property HookStruct: pKBDLLHOOKSTRUCT read FHookStruct;
? end;

? TLowLevelMouseHook = class(THook)
? private
??? FHookStruct: pMSLLHOOKSTRUCT;
? protected
??? procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); override;
??? procedure PostExecute(var HookMsg: THookMsg); override;
? public
??? function AllocateHook: hHook; override;
??? property HookStruct: pMSLLHOOKSTRUCT read FHookStruct;
? end;

function MakeHookInstance(Method: THookMethod): Pointer;
procedure FreeHookInstance(ObjectInstance: Pointer);

implementation

uses
? SysUtils;

const
? InstanceCount = 313; // set so that sizeof (TInstanceBlock) < PageSize

type
? pObjectInstance = ^TObjectInstance;
? TObjectInstance = packed record
??? Code: Byte;
??? Offset: Integer;
??? case Integer of
????? 0: (Next: pObjectInstance);
????? 1: (Method: THookMethod);
? end;

? pInstanceBlock = ^TInstanceBlock;
? TInstanceBlock = packed record
??? Next: pInstanceBlock;
??? Code: array[1..2] of Byte;
??? WndProcPtr: Pointer;
??? Instances: array[0..InstanceCount] of TObjectInstance;
? end;

var
? InstBlockList: pInstanceBlock = nil;
? InstFreeList: pObjectInstance = nil;

function StdHookProc(Code, WParam: WPARAM; LParam: LPARAM): LResult; stdcall; assembler;
asm
? XOR???? EAX,EAX
? PUSH??? EAX
? PUSH??? LParam
? PUSH??? WParam
? PUSH??? Code
? MOV???? EDX,ESP
? MOV???? EAX,[ECX].Longint[4]
? CALL??? [ECX].Pointer
? ADD???? ESP,12
? POP???? EAX
end;

{ Allocate a hook method instance }

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
? Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeHookInstance(Method: THookMethod): Pointer;
const
? BlockCode: array[1..2] of Byte = ($59, $E9);
? PageSize = 4096;
var
? Block: pInstanceBlock;
? Instance: pObjectInstance;
begin
? if InstFreeList = nil then
? begin
??? Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
??? Block^.Next := InstBlockList;
??? Move(BlockCode, Block^.Code, SizeOf(BlockCode));
??? Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdHookProc));
??? Instance := @Block^.Instances;

??? repeat
????? Instance^.Code := $E8;
????? Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
????? Instance^.Next := InstFreeList;
????? InstFreeList := Instance;
????? Inc(Longint(Instance), SizeOf(TObjectInstance));
??? until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);

??? InstBlockList := Block
? end;

? Result := InstFreeList;
? Instance := InstFreeList;
? InstFreeList := Instance^.Next;
? Instance^.Method := Method
end;

{ Free a hook method instance }

procedure FreeHookInstance(ObjectInstance: Pointer);
begin
? if ObjectInstance = nil then
??? Exit;

? pObjectInstance(ObjectInstance)^.Next := InstFreeList;
? InstFreeList := ObjectInstance
end;

constructor TCustomHook.Create;
begin
? inherited;
? FHookProc := MakeHookInstance(HookProc);
? FActive := False;
? FLoadedActive := False;
? FHook := 0;
? ThreadID := GetCurrentThreadID;
end;

destructor TCustomHook.Destroy;
begin
? Active := False;
? FreeHookInstance(FHookProc);
? inherited;
end;

procedure TCustomHook.SetActive(NewState: Boolean);
begin
? if FActive = NewState then
??? Exit;

? FActive := NewState;

? case Active of
??? True:
????? begin
??????? FHook := AllocateHook;
??????? if (FHook = 0) then
??????? begin
????????? FActive := False;
????????? raise Exception.Create(Classname + ' CREATION FAILED!');
??????? end;
????? end;

??? False:
????? begin
??????? if (FHook <> 0) then
????????? UnhookWindowsHookEx(FHook);
??????? FHook := 0;
????? end;
? end;
end;

procedure TCustomHook.SetThreadID(NewID: Integer);
var
? IsActive: Boolean;
begin
? IsActive := FActive;
? Active := False;
? FThreadID := NewID;
? Active := IsActive;
end;

procedure TCustomHook.HookProc(var HookMsg: THookMsg);
var
? Handled: Boolean;
begin
? Handled := False;
? PreExecute(HookMsg, Handled);
? if not Handled then
? begin
??? with HookMsg do
????? Result := CallNextHookEx(FHook, Code, wParam, lParam);
??? PostExecute(HookMsg);
? end;
end;

procedure TCustomHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
? if Assigned(FOnPreExecute) then
??? FOnPreExecute(THook(Self), HookMsg);
? Handled := HookMsg.Result <> 0;
end;

procedure TCustomHook.PostExecute(var HookMsg: THookMsg);
begin
? if Assigned(FOnPostExecute) then
??? FOnPostExecute(THook(Self), HookMsg);
end;

function TCallWndProcHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_CALLWNDPROC, FHookProc, HInstance, ThreadID);
end;

function TCallWndProcRetHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_CALLWNDPROCRET, FHookProc, hInstance, ThreadID);
end;

function TCBTHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_CBT, FHookProc, hInstance, ThreadID);
end;

function TDebugHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_DEBUG, FHookProc, hInstance, ThreadID);
end;

function TGetMessageHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_GETMESSAGE, FHookProc, hInstance, ThreadID);
end;

function TJournalPlaybackHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_JOURNALPLAYBACK, FHookProc, hInstance, ThreadID);
end;

function TJournalRecordHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_JOURNALRECORD, FHookProc, hInstance, ThreadID);
end;

function TKeyboardHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_KEYBOARD, FHookProc, hInstance, ThreadID);
end;

function TMouseHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_MOUSE, FHookProc, hInstance, ThreadID);
end;

function TMsgHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_MSGFILTER, FHookProc, hInstance, ThreadID);
end;

function TShellHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_SHELL, FHookProc, hInstance, ThreadID);
end;

function TSysMsgHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_SYSMSGFILTER, FHookProc, hInstance, ThreadID);
end;

function TLowLevelKeyboardHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_KEYBOARD_LL, FHookProc, hInstance, 0);
end;

procedure TLowLevelKeyboardHook.PostExecute(var HookMsg: THookMsg);
begin
? inherited;
? FHookStruct := nil;
end;

procedure TLowLevelKeyboardHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
? FHookStruct := pKBDLLHOOKSTRUCT(Hookmsg.LPARAM);
? inherited;
end;

{ TLowLevelMouseHook }

function TLowLevelMouseHook.AllocateHook: hHook;
begin
? Result := SetWindowsHookEx(WH_MOUSE_LL, FHookProc, hInstance, 0);
end;

procedure TLowLevelMouseHook.PostExecute(var HookMsg: THookMsg);
begin
? inherited;
? FHookStruct := nil;
end;

procedure TLowLevelMouseHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
? FHookStruct := pMSLLHOOKSTRUCT(Hookmsg.LPARAM);
? inherited;
end;

procedure TKeyboardHook.PostExecute(var HookMsg: THookMsg);
begin
? inherited;
? FKeyState := ksDummy;
end;

procedure TKeyboardHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
? FKeyState := TKeyState(Hookmsg.lParam shr 30);
? inherited;
end;

end.

?

?

轉載于:https://www.cnblogs.com/hnxxcxg/archive/2011/04/23/2940608.html

總結

以上是生活随笔為你收集整理的Windows勾子处理类Thook 以及示例的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。