鉤子(HOOK)機制的使用
作者:e夢緣
SetWindowsHookEx函數提供15種不同的消息監視類型,也就是15中不同的鉤子。
分別用於捕獲某一特定類型或某一范圍的消息（如：鍵盤消息，鼠標消息等)。
我們這裡僅以鼠標鉤子的使用為例，討論在Delphi下怎樣編寫DLL程序和怎樣在自己的程序中安裝使用鼠標鉤子函數。
Windows提供API函數SetWindowsHookEx來建立一個Hook，
通過這個函數可以將一個程序添加到Hook鏈中監視Windows消息，函數語法為：
SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWord)
其中：
參數idHook指定建立的監視函數類型。
參數lpfn指定消息函數，在相應的消息產生後，系統會調用該函數並將消息值傳遞給該函數供處理。函數的一般形式為：
Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
其中code為系統指示標記，wParam和lParam為附加參數，根據不同的消息監視類型而不同。只要在程序中建立這樣一個函數再通過SetWindowsHookEx函數將它加入到消息監視鏈中就可以處理消息了。
由於鉤子過濾函數必須在獨立的模塊中，也就是說我們必須首先生成一個DLL框架，然後再在其中加入鉤子函數代碼以及其他相關函數代碼。
一、 鉤子編寫說明
1、先生成一個DLL框架
2、編寫自己的鉤子過濾函數
鉤子過濾函數必須是回調函數，其函數的形式：
function KeyHookProc(
iCode:Integer;
wParam:WPARAM;
lParam:LPARAM ) : LRESULT; stdcall ;export ;
3、在生成的DLL框架中加入自己鉤子的處理函數。
4、用SetWindowsHookEx函數（用法見上）安裝HOOK
5、用UnHookWindowsHookEx卸載鉤子
}
library mousehook;
uses
SysUtils,
Classes,Windows,messages,shellapi;
type
Tcallbackfun=procedure(info:pchar);
Tmousehook=record
isrun:boolean;
hook:hhook;
callbackfun:Tcallbackfun;
end;
var
mymousehook:Tmousehook;
{$R *.res}
function gethookinfo(code:integer;wp:WPARAM;lp:LPARAM):LResult;stdcall;
var
info:string;
begin
if code<0 then begin
result:= CallNextHookEx(mymousehook.hook,code,wp,lp);
exit;
end;
info:='';
Case wp of
WM_LBUTTONDOWN:begin
info:='WM_LBUTTONDOWN+';
end;
WM_LBUTTONUP:begin
info:='WM_LBUTTONUP+';
end;
WM_LBUTTONDBLCLK:begin
info:='WM_LBUTTONDBLCLK+';
end;
WM_RBUTTONDOWN:begin
info:='WM_RBUTTONDOWN+';
end;
WM_RBUTTONUP:begin
info:='WM_RBUTTONUP+';
end;
WM_RBUTTONDBLCLK:begin
info:='WM_RBUTTONDBLCLK+';
end;
WM_MBUTTONDOWN:begin
info:='WM_MBUTTONDOWN+';
end;
WM_MBUTTONUP:begin
info:='WM_MBUTTONUP+';
end;
WM_MBUTTONDBLCLK:begin
info:='WM_MBUTTONDBLCLK+';
end;
WM_NCMouseMove, WM_MOUSEMOVE:begin
info:='WM_MOUSEMOVE+';
end;
end;
info:=info+'pos('+inttostr(PMouseHookStruct(lp)^.pt.x)+','+inttostr(PMouseHookStruct(lp)^.pt.x)+')' ;
mymousehook.callbackfun(pchar(info));
result:= CallNextHookEx(mymousehook.hook,code,wp,lp);
end;
procedure installmousehook(callbackF:Tcallbackfun); stdcall;
begin
if not mymousehook.isrun then
begin
mymousehook.hook:=setWindowshookex(WH_MOUSE,@gethookinfo,HInstance,getcurrentthreadid());
mymousehook.callbackfun :=callbackf;
mymousehook.isrun:=not mymousehook.isrun;
end;
end;
procedure uninstallmousehook(); stdcall;
begin
if mymousehook.isrun then
begin
UnHookWindowsHookEx(mymousehook.hook);
mymousehook.callbackfun :=nil;
mymousehook.isrun:=not mymousehook.isrun;
end;
end;
Procedure DLLEntryPoint(dwReason:DWord);
begin
Case dwReason of
DLL_PROCESS_ATTACH:begin
mymousehook.isrun:=false;
end;
DLL_PROCESS_DETACH:;
DLL_THREAD_ATTACH:;
DLL_THREAD_DETACH:;
End;
end;
exports
installmousehook,
uninstallmousehook;
begin
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
{
二、鉤子的使用
1、調用鉤子的DLL
2、安裝鉤子
3、一定不要忘了卸裝鉤子
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
Tcallbackfun=procedure(info:pchar);
type
TForm1 = class(TForm)
memo: TMemo;
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure installmousehook(callbackF:Tcallbackfun); stdcall;external 'mousehook.dll';
procedure uninstallmousehook(); stdcall;external 'mousehook.dll';
{$R *.dfm}
procedure addinfo(info:pchar);
begin
Tform1(application.MainForm ).memo.Lines.Add(info);
end;
//2、安裝鉤子
procedure TForm1.Button1Click(Sender: TObject);
begin
installmousehook(addinfo);
end;
//3、一定不要忘了卸裝鉤子
procedure TForm1.FormDestroy(Sender: TObject);
begin
uninstallmousehook();
end;
end.
