Question

I downloaded a mouse hook sample, which didn’t work. So I stripped all the unnecessary stuff and would like to know what is wrong in it. When I start the program, both it and Delphi freeze and I have to close it through taskmgr.

App:

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.

I think this is as simple as it gets. The freeze happens at the call of HookMouse, when this line is executed, the whole IDE freezes and I can’t debug further. But I can’t see anything wrong in that procedure.

I am using XE2, if that helps. Thanks for the troubleshooting

---

Edit: I edited the calls of HookMouse and UnhookMouse with stdcall; and the name of the window class to find. It seems to be working nice now, it shows correct values, BUT only if the mouse cursor is not in the app window – when I move the mouse to the window, it changes to the HourGlass and the Label caption stops updating. What could cause this?

Answer 1

You have a few problems with your code

1.You are missing the stdcall calling convention:

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

2.You are changing the caption in the main form. so FindWindow (in the DLL) will find the window only once. you can use TMemo to debug:

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

2.1.The class name MainHookTestForm is not correct. should be:

FindWindow('TMainHookTestForm', 'Main')

Note the T MainHookTestForm

3.in the HookProc you must use:

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);