使用鉤子函數[5]

前言: 博友 "鵬" 來信探討關於鉤子的問題, 核心困難是: dll 中的資料如何傳遞出來. 在接下來的兩個例子中探討這個問題.

本例建立一個全域的滑鼠鉤子, 然後把滑鼠的相關資訊通過一個自訂的 GetInfo 函數傳遞給調用鉤子的程式.

為了方便測試, 提供一個源碼下載吧: http://files.cnblogs.com/del/MouseHook_1.rar

本例效果圖:

DLL 檔案:

library　MyHook;

uses
SysUtils,
Windows,
Messages,
Classes;

{$R　*.res}

var
hook:　HHOOK;
info:　string;

function　GetInfo:　PChar;
begin
Result　:=　PChar(info);
end;

function　MouseHook(nCode:　Integer;　wParam:　WPARAM;　lParam:　LPARAM):　LRESULT;　stdcall;
begin
case　wParam　of
WM_MOUSEMOVE　　:　info　:=　'滑鼠位置';
WM_LBUTTONDOWN　:　info　:=　'按下';
WM_LBUTTONUp　　:　info　:=　'放開';
end;
info　:=　Format('%s:　%d,%d',　[info,　PMouseHookStruct(lParam)^.pt.X,　PMouseHookStruct(lParam)^.pt.Y]);
{此資訊可通過　GetInfo　函數從外部提取}

Result　:=　CallNextHookEx(hook,　nCode,　wParam,　lParam);
end;

function　SetHook:　Boolean;　stdcall;
const
WH_MOUSE_LL　=14;　{Delphi　少給了兩個常量:　WH_KEYBOARD_LL　=　13;　WH_MOUSE_LL　=　14;　需要時自己定義}
begin
hook　:=　SetWindowsHookEx(WH_MOUSE_LL,　@MouseHook,　HInstance,　0);　{WH_MOUSE　只是線程級的}
Result　:=　hook　<>　0;
end;

function　DelHook:　Boolean;　stdcall;
begin
Result　:=　UnhookWindowsHookEx(hook);
end;

exports　SetHook,　DelHook,　MouseHook,　GetInfo;
begin
end.

測試代碼:

unit　Unit1;

interface

uses
Windows,　Messages,　SysUtils,　Variants,　Classes,　Graphics,　Controls,　Forms,
Dialogs,　StdCtrls,　ExtCtrls;

type
TForm1　=　class(TForm)
Button1:　TButton;
Button2:　TButton;
Timer1:　TTimer;
procedure　FormCreate(Sender:　TObject);
procedure　Button1Click(Sender:　TObject);
procedure　Button2Click(Sender:　TObject);
procedure　Timer1Timer(Sender:　TObject);
procedure　FormDestroy(Sender:　TObject);
end;

function　SetHook:　Boolean;　stdcall;
function　DelHook:　Boolean;　stdcall;
function　GetInfo:　PChar;　stdcall;

var
Form1:　TForm1;

implementation

{$R　*.dfm}

function　SetHook;　external　'MyHook.dll';
function　DelHook;　external　'MyHook.dll';
function　GetInfo;　external　'MyHook.dll';

procedure　TForm1.Button1Click(Sender:　TObject);
begin
SetHook;
Timer1.Enabled　:=　True;
end;

procedure　TForm1.Button2Click(Sender:　TObject);
begin
Timer1.Enabled　:=　False;
DelHook;
end;

procedure　TForm1.FormCreate(Sender:　TObject);
begin
Button1.Caption　:=　'安裝鉤子';
Button2.Caption　:=　'載卸鉤子';
Timer1.Interval　:=　100;
Timer1.Enabled　:=　False;
FormStyle　:=　fsStayOnTop;　{為了測試,　讓視窗一直在前面}
end;

procedure　TForm1.FormDestroy(Sender:　TObject);
begin
DelHook;
end;

procedure　TForm1.Timer1Timer(Sender:　TObject);
begin
Text　:=　GetInfo;
end;

end.