魅族免费主题:使用钩子函数[5] - 数据传递

　　本例建立一个全局的鼠标钩子, 然后把鼠标的相关信息通过一个自定义的 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