[Delphi]钩子，HOOK机制的使用

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;

由于钩子过滤函数必须在独立的模块中，也就是说我们必须首先生成一个DLL框架，然后再在其中加入钩子函数代码以及其他相关函数代码。

一、 钩子编写说明

1、先生成一个DLL框架

2、编写自己的钩子过滤函数

钩子过滤函数必须是回调函数，其函数的形式：

function KeyHookProc(

iCode:Integer;

wParam:WPARAM;

lParam:LPARAM ) : LRESULT; stdcall ;export ;

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.