Delphi实现全局鼠标钩子

最新推荐文章于 2022-09-23 11:17:46 发布

bdmh

最新推荐文章于 2022-09-23 11:17:46 发布

阅读量5.5k

点赞数 2

分类专栏： Delphi 文章标签： delphi function dll parameters action integer

本文链接：https://blog.csdn.net/bdmh/article/details/5888287

版权

Delphi 专栏收录该内容

28 篇文章 0 订阅

订阅专栏

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

因为是全局钩子，所以要用dll注入。用到的鼠标消息结构如下：

PMouseHookStruct = ^TMouseHookStruct; {$EXTERNALSYM tagMOUSEHOOKSTRUCT} tagMOUSEHOOKSTRUCT = packed record pt: TPoint; hwnd: HWND; wHitTestCode: UINT; dwExtraInfo: DWORD; end; TMouseHookStruct = tagMOUSEHOOKSTRUCT;

DLL代码，Mouse_HookDLL

library Mouse_HookDLL; { Important note about DLL memory management: ShareMem must be the first unit in your library's USES clause AND your project's (select Project-View Source) USES clause if your DLL exports any procedures or functions that pass strings as parameters or function results. This applies to all strings passed to and from your DLL--even those that are nested in records and classes. ShareMem is the interface unit to the BORLNDMM.DLL shared memory manager, which must be deployed along with your DLL. To avoid using BORLNDMM.DLL, pass string information using PChar or ShortString parameters. } uses SysUtils, Windows, Messages, Classes; {$R *.res} var NextHook : HHook; //调用者的Handle，用来给其发消息 CallHandle : HWND; //通知调用者的消息，由调用者传进来 MessageID : Word; //挂钩子函数 ,这里只处理鼠标移动，其他的鼠标动作，道理一样 function HookProc(code:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall; begin Result := 0; if code < 0 then Result := CallNextHookEx(NextHook,code,wParam,lParam); case wParam of WM_NCMOUSEMOVE,WM_MOUSEMOVE: begin //给调用者发消息 SendMessage(CallHandle,MessageID,wParam,Integer(@pMouseHookStruct(lParam)^)); end; end; end; //启动钩子 function StartHook(MsgID:Word):Bool;stdcall; begin Result := False; if NextHook <> 0 then Exit; MessageID := MsgID; //挂钩,SetWindowsHookEx的参数dwThreadId=0，表示挂全局的,不知道为什么，我系统是2003，用WH_MOUSE只能在本进程中实现钩子，WH_MOUSE_LL可以实现全局，在Delphi7中，是没有WH_MOUSE_LL定义的，你可以自己定义，值是14 NextHook := SetWindowsHookEx(WH_MOUSE_LL,@HookProc,HInstance,0); Result := NextHook <> 0; end; //脱钩 function StopHook:Bool;stdcall; begin if NextHook <> 0 then begin UnHookWindowsHookEx(NextHook); NextHook := 0; end; Result := NextHook = 0; end; //传递调用者句柄 procedure SetCallHandle(sender:HWND);stdcall; begin CallHandle := sender; NextHook := 0; end; exports StartHook name 'StartHook', StopHook name 'StopHook', SetCallHandle name 'SetCallHandle'; begin end.

调用者代码，HookTest

unit HookTest; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TfrmHookTest = class(TForm) Label1: TLabel; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } //重载消息处理 procedure WndProc(var Message: TMessage);override; public { Public declarations } end; var frmHookTest: TfrmHookTest; const WM_TestMsg = WM_User + 100; implementation {$R *.dfm} function StartHook(MsgID:Word):Bool;stdcall;external 'Mouse_HookDLL.dll'; function StopHook:Bool;stdcall;external 'Mouse_HookDLL.dll'; procedure SetCallHandle(sender:HWND);stdcall;external 'Mouse_HookDLL.dll'; procedure TfrmHookTest.FormClose(Sender: TObject; var Action: TCloseAction); begin StopHook; end; procedure TfrmHookTest.FormCreate(Sender: TObject); begin SetCallHandle(Self.Handle); if not StartHook(WM_TestMsg) then begin ShowMessage('挂钩失败！'); end; end; procedure TfrmHookTest.WndProc(var Message: TMessage); var x,y:integer; begin //得到符合条件的钩子 if Message.Msg = WM_TestMsg then begin x := pMouseHookStruct(Message.LParam)^.pt.X; y := pMouseHookStruct(Message.LParam)^.pt.Y; //显示x，y坐标 Self.Label1.Caption := '鼠标当前位置：x='+IntToStr(x)+' : y='+IntToStr(y); end; inherited; end; end.

运行结果