鼠标钩子-冻结程序

Question

我下载了一个鼠标钩示例，但没有用。所以我剥离了所有不必要的东西，并想知道其中出了什么问题。当我启动程序时，它和Delphi都冻结了，我必须通过taskmgr关闭它。

应用程序：

type
...
    procedure ms(var message: tmessage); message WM_USER+1234;

  end;

var
  MainHookTestForm: TMainHookTestForm;

implementation
procedure HookMouse; stdcall; external 'MouseHook.DLL'; // Added stdcalls;
procedure UnHookMouse; stdcall; external 'MouseHook.DLL';

{$R *.dfm}    

procedure TMainHookTestForm.FormCreate(Sender: TObject);
begin
  HookMouse;
end;

procedure TMainHookTestForm.FormDestroy(Sender: TObject);
begin
  UnHookMouse;
end;

procedure TMainHookTestForm.ms(var message: tmessage);
begin
  Label1.Caption:=format('%d - %d',[message.LParam, message.WParam]); // Edited
end;

Lib：

library MouseHook;
uses
  Forms,
  Windows,
  Messages;

var Hook: HHOOK;
{$R *.res}

function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
  mousePoint: TPoint;
begin
  mousePoint := PMouseHookStruct(Data)^.pt;
  PostMessage(FindWindow('TMainHookTestForm', 'Main'), WM_USER+1234, mousePoint.X, mousePoint.Y); // Edited class name
  Result := CallNextHookEx(Hook,nCode,MsgID,Data);
end;

procedure HookMouse; stdcall;
begin
  if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE,@HookProc,HInstance,0);
end;

procedure UnHookMouse; stdcall;
begin
  UnhookWindowsHookEx(Hook);
  Hook:=0;
end;

exports
  HookMouse, UnHookMouse;

begin
end.

我认为这很简单。冻结发生在调用 HookMouse 时，当执行此行时，整个 IDE 冻结，我无法进一步调试。但我看不出这个程序有什么问题。

我正在使用 XE2，如果有帮助的话。感谢您进行故障排除

---

编辑：我使用 stdcall;HookMouse 和 UnhookMouse 编辑了调用； code> 和要查找的窗口类的名称。现在似乎工作得很好，它显示了正确的值，但只有当鼠标光标不在应用程序窗口中时 - 当我将鼠标移动到窗口时，它会更改为 HourGlass 和标签标题停止更新。什么可能导致这种情况？

Answer 1

您的代码存在一些问题

1.您缺少 stdcall 调用约定：

procedure HookMouse; stdcall; external 'MouseHook.DLL';
procedure UnHookMouse; stdcall; external 'MouseHook.DLL';

2.您正在更改主窗体中的标题。因此，FindWindow（在 DLL 中）只会查找该窗口一次。可以使用TMemo来调试：

procedure TMainHookTestForm.ms(var message: tmessage);
begin
  Memo1.Lines.Add(format('%d - %d',[message.LParam, message.WParam]));
end;

2.1.类名MainHookTestForm不正确。应该是：

FindWindow('TMainHookTestForm', 'Main')

T MainHookTestForm 3.：

注意您必须使用的 HookProc 中的

if nCode = HC_ACTION then
begin
  mousePoint := PMouseHookStruct(Data)^.pt;      
  PostMessage(FindWindow('TMainHookTestForm', 'Main'), WM_USER+1234, mousePoint.X, mousePoint.Y);
end;  

Result := CallNextHookEx(Hook,nCode,MsgID,Data);