Delphi implements global Mouse hooks

Some of the APIs involved can be found on the Internet for detailed explanations, which are no longer discussed here. SOURCE download

Because it is a global hook, it is injected with a DLL. The mouse message structure used is as follows:

[Delphi]View Plaincopy

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 code, Mouse_hookdll

[Delphi]View Plaincopy

2. Library Mouse_hookdll;
6. {Important Note about DLL memory Management:sharemem must is the
8. First unit in your library ' s USES clause and your project ' s (select
10. Project-view Source) USES clause If your DLL exports any procedures or
12. Functions that pass strings as parameters or function results. This
14. Applies to all strings passed to and from your dll--even those
16. is nested in records and classes. SHAREMEM is the interface unit to
18. The BORLNDMM. DLL shared Memory manager, which must be deployed along
20. With your DLL. To avoid using BORLNDMM. DLL, pass string information
22. Using PChar or shortstring parameters. }
26. Uses
28. Sysutils,
30. Windows
32. Messages,
34. Classes;
38. {$R *.res}
42. Var
44. Nexthook:hhook;
46. //caller's handle, used to send messages to it
48. Callhandle:hwnd;
50. //Notifies the caller of the message, which is passed in by the caller
52. Messageid:word;
56. Hook Sub-function, here only handle mouse movement, other mouse actions, the same reason
58. function HookProc (code:integer;wparam:wparam;lparam:lparam): Lresult;stdcall;
60. Begin
62. Result: = 0;
64. if code < 0 Then
66. Result: = CallNextHookEx (Nexthook,code,wparam,lparam);
68. Case WParam of
70. Wm_ncmousemove,wm_mousemove:
72. begin
74. //Send a message to the caller
76. SendMessage (Callhandle,messageid,wparam,integer (@pMouseHookStruct (lParam) ^));
78. end;
80. end;
82. End
86. Start Hook
88. function Starthook (Msgid:word): Bool;stdcall;
90. Begin
92. Result: = False;
94. if Nexthook <> 0 Then
96. Exit;
98. MessageID: = MsgID;
100. //hooks, SetWindowsHookEx parameters dwthreadid=0, indicating the hanging global, do not know why, my system is 2003, with Wh_mouse can only be implemented in this process hook, WH_MOUSE_LL can achieve the global, In Delphi7, there is no wh_mouse_ll definition, you can define it yourself, the value is
102. Nexthook: = SetWindowsHookEx (Wh_mouse_ll, @HookProc, hinstance,0);
104. Result: = Nexthook <> 0;
106. End
110. Decoupling
112. function Stophook:bool;stdcall;
114. Begin
116. if Nexthook <> 0 Then
118. begin
120. UnhookWindowsHookEx (Nexthook);
122. Nexthook: = 0;
124. end;
126. Result: = Nexthook = 0;
128. End
132. Passing the caller handle
134. Procedure Setcallhandle (Sender:hwnd); stdcall;
136. Begin
138. Callhandle: = sender;
140. Nexthook: = 0;
142. End
146. Exports
148. Starthook name ' Starthook ',
150. Stophook name ' Stophook ',
152. Setcallhandle name ' Setcallhandle ';
156. Begin
158. End.

Caller Code, Hooktest

[Delphi]View Plaincopy

2. Unit hooktest;
6. Interface
10. Uses
12. Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms,
14. Dialogs, Stdctrls;
18. Type
20. Tfrmhooktest = Class (Tform)
22. Label1:tlabel;
24. procedure formcreate (sender:tobject);
26. procedure Formclose (sender:tobject;  var action:tcloseaction);
28. Private
30. {Private declarations}
32. //Overloaded message processing
34. procedure WndProc (var message:tmessage); override;
36. Public
38. {public declarations}
40. end;
44. Var
46. Frmhooktest:tfrmhooktest;
50. Const
52. wm_testmsg = wm_user + 100;
56. Implementation
60. {$R *.DFM}
62. function Starthook (msgid:word): bool;stdcall;external ' Mouse_hookdll.dll ';
64. function stophook:bool;stdcall;external ' mouse_hookdll.dll ';
66. Procedure Setcallhandle (Sender:hwnd); stdcall;external ' Mouse_hookdll.dll ';
70. Procedure Tfrmhooktest. Formclose (Sender:tobject;  var action:tcloseaction);
72. Begin
74. Stophook;
76. End
80. Procedure Tfrmhooktest.  Formcreate (Sender:tobject);
82. Begin
84. Setcallhandle (self.  Handle);
86. If not starthook (wm_testmsg) Then
88. begin
90. ShowMessage (' hook failed!  ‘);
92. end;
94. End
98. Procedure Tfrmhooktest.  WndProc (var message:tmessage);
100. Var
102. X, y:integer;
104. Begin
106. //Get the hook that matches the condition
108. if Message. MSG = wm_testmsg Then
110. begin
112. x: = Pmousehookstruct (Message. LParam) ^.pt.  X
114. Y: = pmousehookstruct (Message. LParam) ^.pt.  Y
116. //display x, y coordinates
118. Self. Label1.  Caption: = ' mouse current position: x= ' +inttostr (x) +': y= ' +inttostr (y);
120. end;
122. inherited;
124. End
128. End.

Run results

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

Delphi implements global Mouse hooks