使用鉤子函數[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.

測試窗體:

object　Form1:　TForm1
Left　=　0
Top　=　0
Caption　=　'Form1'
ClientHeight　=　78
ClientWidth　=　271
Color　=　clBtnFace
Font.Charset　=　DEFAULT_CHARSET
Font.Color　=　clWindowText
Font.Height　=　-11
Font.Name　=　'Tahoma'
Font.Style　=　[]
OldCreateOrder　=　False
OnCreate　=　FormCreate
OnDestroy　=　FormDestroy
PixelsPerInch　=　96
TextHeight　=　13
object　Button1:　TButton
Left　=　48
Top　=　32
Width　=　75
Height　=　25
Caption　=　'Button1'
TabOrder　=　0
OnClick　=　Button1Click
end
object　Button2:　TButton
Left　=　144
Top　=　32
Width　=　75
Height　=　25
Caption　=　'Button2'
TabOrder　=　1
OnClick　=　Button2Click
end
object　Timer1:　TTimer
OnTimer　=　Timer1Timer
Left　=　128
Top　=　8
end
end