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.

View Code

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.

View Code