[Delphi]钩子(HOOK)机制的使用

SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD)

Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;

function KeyHookProc(
iCode:Integer;
wParam:WPARAM;
lParam:LPARAM ) : LRESULT; stdcall ;export ;

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.

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.