Delphi实现全局鼠标钩子

Delphi实现全局鼠标钩子

其中涉及到的一些API，网上均能查到详细的解释，这里不再熬述。

源码下载

因为是全局钩子，所以要用dll注入。

用到的鼠标消息结构如下：

1. PMouseHookStruct = ^TMouseHookStruct;
2. {$EXTERNALSYM tagMOUSEHOOKSTRUCT}
3. tagMOUSEHOOKSTRUCT = packed record
4. pt: TPoint;
5. hwnd: HWND;
6. wHitTestCode: UINT;
7. dwExtraInfo: DWORD;
8. end;
9. TMouseHookStruct = tagMOUSEHOOKSTRUCT;

DLL代码，Mouse_HookDLL

1. library Mouse_HookDLL;
2. { Important note about DLL memory management: ShareMem must be the
3. first unit in your library's USES clause AND your project's (select
4. Project-View Source) USES clause if your DLL exports any procedures or
5. functions that pass strings as parameters or function results. This
6. applies to all strings passed to and from your DLL--even those that
7. are nested in records and classes. ShareMem is the interface unit to
8. the BORLNDMM.DLL shared memory manager, which must be deployed along
9. with your DLL. To avoid using BORLNDMM.DLL, pass string information
10. using PChar or ShortString parameters. }
11. uses
12. SysUtils,
13. Windows,
14. Messages,
15. Classes;
16. {$R *.res}
17. var
18. NextHook : HHook;
19. //调用者的Handle，用来给其发消息
20. CallHandle : HWND;
21. //通知调用者的消息，由调用者传进来
22. MessageID : Word;
23. //挂钩子函数 ,这里只处理鼠标移动，其他的鼠标动作，道理一样
24. function HookProc(code:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
25. begin
26. Result := 0;
27. if code < 0 then
28. Result := CallNextHookEx(NextHook,code,wParam,lParam);
29. case wParam of
30. WM_NCMOUSEMOVE,WM_MOUSEMOVE:
31. begin
32. //给调用者发消息
33. SendMessage(CallHandle,MessageID,wParam,Integer(@pMouseHookStruct(lParam)^));
34. end;
35. end;
36. end;
37. //启动钩子
38. function StartHook(MsgID:Word):Bool;stdcall;
39. begin
40. Result := False;
41. if NextHook <> 0 then
42. Exit;
43. MessageID := MsgID;
44. //挂钩,SetWindowsHookEx的参数dwThreadId=0，表示挂全局的,不知道为什么，我系统是2003，用WH_MOUSE只能在本进程中实现钩子，WH_MOUSE_LL可以实现全局，在Delphi7中，是没有WH_MOUSE_LL定义的，你可以自己定义，值是14
45. NextHook := SetWindowsHookEx(WH_MOUSE_LL,@HookProc,HInstance,0);
46. Result := NextHook <> 0;
47. end;
48. //脱钩
49. function StopHook:Bool;stdcall;
50. begin
51. if NextHook <> 0 then
52. begin
53. UnHookWindowsHookEx(NextHook);
54. NextHook := 0;
55. end;
56. Result := NextHook = 0;
57. end;
58. //传递调用者句柄
59. procedure SetCallHandle(sender:HWND);stdcall;
60. begin
61. CallHandle := sender;
62. NextHook := 0;
63. end;
64. exports
65. StartHook name 'StartHook',
66. StopHook name 'StopHook',
67. SetCallHandle name 'SetCallHandle';
68. begin
69. end.

调用者代码，HookTest

1. unit HookTest;
2. interface
3. uses
4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5. Dialogs, StdCtrls;
6. type
7. TfrmHookTest = class(TForm)
8. Label1: TLabel;
9. procedure FormCreate(Sender: TObject);
10. procedure FormClose(Sender: TObject; var Action: TCloseAction);
11. private
12. { Private declarations }
13. //重载消息处理
14. procedure WndProc(var Message: TMessage);override;
15. public
16. { Public declarations }
17. end;
18. var
19. frmHookTest: TfrmHookTest;
20. const
21. WM_TestMsg = WM_User + 100;
22. implementation
23. {$R *.dfm}
24. function StartHook(MsgID:Word):Bool;stdcall;external 'Mouse_HookDLL.dll';
25. function StopHook:Bool;stdcall;external 'Mouse_HookDLL.dll';
26. procedure SetCallHandle(sender:HWND);stdcall;external 'Mouse_HookDLL.dll';
27. procedure TfrmHookTest.FormClose(Sender: TObject; var Action: TCloseAction);
28. begin
29. StopHook;
30. end;
31. procedure TfrmHookTest.FormCreate(Sender: TObject);
32. begin
33. SetCallHandle(Self.Handle);
34. if not StartHook(WM_TestMsg) then
35. begin
36. ShowMessage('挂钩失败！');
37. end;
38. end;
39. procedure TfrmHookTest.WndProc(var Message: TMessage);
40. var
41. x,y:integer;
42. begin
43. //得到符合条件的钩子
44. if Message.Msg = WM_TestMsg then
45. begin
46. x := pMouseHookStruct(Message.LParam)^.pt.X;
47. y := pMouseHookStruct(Message.LParam)^.pt.Y;
48. //显示x，y坐标
49. Self.Label1.Caption := '鼠标当前位置：x='+IntToStr(x)+' : y='+IntToStr(y);
50. end;
51. inherited;
52. end;
53. end.

运行结果

http://blog.csdn.net/bdmh/article/details/5888287