Delphi实现全局鼠标钩子


本文整理自网络,侵删。

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

TMouseHookStruct = tagMOUSEHOOKSTRUCT;


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.




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.


相关阅读 >>

Delphi ipnumberipv4

Delphi json字符串转义

Delphi listview导出到excel

Delphi 计算运行耗时的方法1

Delphi 点击关闭叉时,最小化图标

Delphi 获取一个文件夹下的一级目录

Delphi xe vcl - tlinklabel(链接标签)

Delphi与sql server存储过程编程详解

Delphi 弹出带黄色感叹号对话框提醒

Delphi 用iisreset命令重启iis

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...