Delphi DLL代码(Delphi Xe下测试通过)：
DLL Code
1 library Project1;
2
3 uses SysUtils, Classes, Windows, Messages;
4
5 var
6 Hook: HHOOK;
7 Hooked: Boolean;
8 ParentHandle: DWORD;
9 const
10 WM_MouseClk = WM_USER + 2046;
11 //自定义消息
12 {$R *.res}
13 //钩子处理函数
14
15 function MyHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
16 stdcall;
17 var
18 Tmp: string;
19 begin
20 Tmp := Format('X: %d , Y: %d', [PMouseHookStruct(lParam)^.pt.X,
21 PMouseHookStruct(lParam)^.pt.Y]);
22 PostMessage(ParentHandle, WM_MouseClk, 0, Integer(PChar(Tmp)));
23 //将鼠标坐标发送到接收端
24 //将消息传递到下一个钩子
25 Result := CallNextHookEx(Hook, nCode, wParam, lParam);
26 end;
27 //安装钩子
28
29 function SetHook(AParentHandle: DWORD): Boolean; stdcall;
30 begin
31 Result := false;
32 if not Hooked then
33 //防止重复加载钩子
34 begin
35 ParentHandle := AParentHandle;
36 HOOK := SetWindowsHookEx(WH_MOUSE_LL, MyHookProc, HInstance, 0);
37 Result := Hook <
38 >
39 0;
40 Hooked := Result;
41 //标记是否成功创建钩子
42 end;
43 end;
44 //删除钩子
45
46 function DelHook: Boolean; stdcall;
47 begin
48 Result := false;
49 if Hooked then
50 begin
51 Result := UnhookWindowsHookEx(Hook);
52 Hooked := Result;
53 end;
54 end;
55
56 exports
57 SetHook,
58 DelHook,
59 MyHookProc;
60
61 begin
62 Hooked := false;
63 end.
Delphi EXE代码
Exe Code
1 unit Unit1;
2
3 interface
4
5 uses Windows, Messages, SysUtils, Variants, Classes, Graphics,
6 Controls, Forms, Dialogs, StdCtrls;
7
8 const
9 WM_MouseClk = WM_USER + 2046;
10 //自定义消息
11 type
12 TForm1 = class(TForm)
13 btnInstaller: TButton;
14 btnUninstaller: TButton;
15 procedure btnInstallerClick(Sender: TObject);
16 procedure btnUninstallerClick(Sender: TObject);
17 procedure MsgProc(var Msg: TMessage); message WM_MouseClk;
18 //消息处理函数
19 private
20 { Private declarations }
21 function InstallerUninstallerHook(Installer: Boolean): Boolean;
22 public
23 { Public declarations }
24 end;
25 var
26 Form1: TForm1;
27
28 implementation {$R *.dfm} { TForm1 }
29
30 procedure TForm1.btnInstallerClick(Sender: TObject);
31 begin
32 if InstallerUninstallerHook(true) then
33 ShowMessage('安装钩子成功')
34 else
35 ShowMessage('安装钩子失败');
36 end;
37
38 procedure TForm1.btnUninstallerClick(Sender: TObject);
39 begin
40 if InstallerUninstallerHook(false) then
41 ShowMessage('删除钩子成功')
42 else
43 ShowMessage('删除钩子失败');
44 end;
45 //安装卸载钩子的方法
46
47 function TForm1.InstallerUninstallerHook(Installer: Boolean): Boolean;
48 var
49 DllHandle: DWORD;
50 SetHook: function (AHandle: DWORD): Boolean; stdcall;
51 DelHook: function: Boolean; stdcall;
52 begin
53 try
54 DllHandle := LoadLibrary('D:\我的文档\RAD Studio\Projects\Debug\Win32\Project1.dll');
55
56 Result := false;
57 if DllHandle = 0 then
58 //
59 raise Exception.Create('载入DLL失败')
60 else
61 begin
62 SetHook := GetProcAddress(DllHandle, 'SetHook');
63 DelHook := GetProcAddress(DllHandle, 'DelHook');
64 if Installer then
65 Result := SetHook(Self.Handle)
66 else
67 Result := DelHook;
68 end;
69 finally
70 FreeLibrary(DllHandle);
71 end;
72 end;
73 //将鼠标坐标显示于标题栏上
74
75 procedure TForm1.MsgProc(var Msg: TMessage);
76 begin
77 Self.Caption := PChar(Msg.lParam);
78 end;
79
80 end.