I am writing a utility unit for the SetWindowsHookEx API.
To use it, I'd like to have an interface like this:
var
Thread: TKeyboardHookThread;
begin
Thread := TKeyboardHookThread.Create(SomeForm.Handle, SomeMessageNumber);
try
Thread.Resume;
SomeForm.ShowModal;
finally
Thread.Free; // <-- Application hangs here
end;
end;
In my current implementation of TKeyboardHookThread I am unable to make the thread exit correctly.
The code is:
TKeyboardHookThread = class(TThread)
private
class var
FCreated : Boolean;
FKeyReceiverWindowHandle : HWND;
FMessage : Cardinal;
FHiddenWindow : TForm;
public
constructor Create(AKeyReceiverWindowHandle: HWND; AMessage: Cardinal);
destructor Destroy; override;
procedure Execute; override;
end; function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
S: KBDLLHOOKSTRUCT;
begin
if nCode < then begin
Result := CallNextHookEx(, nCode, wParam, lParam)
end else begin
S := PKBDLLHOOKSTRUCT(lParam)^;
PostMessage(TKeyboardHookThread.FKeyReceiverWindowHandle, TKeyboardHookThread.FMessage, S.vkCode, );
Result := CallNextHookEx(, nCode, wParam, lParam);
end;
end; constructor TKeyboardHookThread.Create(AKeyReceiverWindowHandle: HWND;
AMessage: Cardinal);
begin
if TKeyboardHookThread.FCreated then begin
raise Exception.Create('Only one keyboard hook supported');
end;
inherited Create('KeyboardHook', True);
FKeyReceiverWindowHandle := AKeyReceiverWindowHandle;
FMessage := AMessage;
TKeyboardHookThread.FCreated := True;
end; destructor TKeyboardHookThread.Destroy;
begin
PostMessage(FHiddenWindow.Handle, WM_QUIT, , );
inherited;
end; procedure TKeyboardHookThread.Execute;
var
m: tagMSG;
hook: HHOOK;
begin
hook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, );
try
FHiddenWindow := TForm.Create(nil);
try
while GetMessage(m, , , ) do begin
TranslateMessage(m);
DispatchMessage(m);
end;
finally
FHiddenWindow.Free;
end;
finally
UnhookWindowsHookEx(hook);
end;
end;
AFAICS the hook procedure only gets called when there is a message loop in the thread.
The problem is I don't know how to correctly exit this message loop.
I tried to do this using a hidden TForm that belongs to the thread,
but the message loop doesn't process messages I'm sending to the window handle of that form.
How to do this right, so that the message loop gets terminated on thread shutdown?
Edit: The solution I'm now using looks like this (and works like a charm):
TKeyboardHookThread = class(TThread)
private
class var
FCreated : Boolean;
FKeyReceiverWindowHandle : HWND;
FMessage : Cardinal;
public
constructor Create(AKeyReceiverWindowHandle: HWND; AMessage: Cardinal);
destructor Destroy; override;
procedure Execute; override;
end; function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
S: KBDLLHOOKSTRUCT;
begin
if nCode < then begin
Result := CallNextHookEx(, nCode, wParam, lParam)
end else begin
S := PKBDLLHOOKSTRUCT(lParam)^;
PostMessage(TKeyboardHookThread.FKeyReceiverWindowHandle, TKeyboardHookThread.FMessage, S.vkCode, );
Result := CallNextHookEx(, nCode, wParam, lParam);
end;
end; constructor TKeyboardHookThread.Create(AKeyReceiverWindowHandle: HWND;
AMessage: Cardinal);
begin
if TKeyboardHookThread.FCreated then begin
raise Exception.Create('Only one keyboard hook supported');
end;
inherited Create('KeyboardHook', True);
FKeyReceiverWindowHandle := AKeyReceiverWindowHandle;
FMessage := AMessage;
TKeyboardHookThread.FCreated := True;
end; destructor TKeyboardHookThread.Destroy;
begin
PostThreadMessage(ThreadId, WM_QUIT, , );
inherited;
end; procedure TKeyboardHookThread.Execute;
var
m: tagMSG;
hook: HHOOK;
begin
hook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, );
try
while GetMessage(m, , , ) do begin
TranslateMessage(m);
DispatchMessage(m);
end;
finally
UnhookWindowsHookEx(hook);
end;
end;
You need to send the WM_QUIT message to that thread's message queue to exit the thread.
GetMessage returns false if the message it pulls from the queue is WM_QUIT, so it will exit the loop on receiving that message.
To do this, use the PostThreadMessage function to send the WM_QUIT message directly to the thread's message queue.
For example:
PostThreadMessage(Thread.Handle, WM_QUIT, , );
The message pump never exits and so when you free the thread
it blocks indefinitely waiting for the Execute method to finish.
Call PostQuitMessage, from the thread, to terminate the message pump.
If you wish to invoke this from the main thread then you will need to
post a WM_QUIT to the thread.
Also, your hidden window is a disaster waiting to happen.
You can't create a VCL object outside the main thread.
You will have to create a window handle using raw Win32,
or even better, use DsiAllocateHwnd.
http://www.techques.com/question/1-10451535/How-to-exit-a-thread's-message-loop?
It turns out that it's better for everyone that you don't use a windowless message queue.
A lot of things can be unintentionally, and subtly, broken if you don't have a window for messages to be dispatched to.
Instead allocate hidden window (e.g. using Delphi's thread-unsafe AllocateHwnd)
and post messages to it using plain old PostMessage:
procedure TMyThread.Execute;
var
msg: TMsg;
begin
Fhwnd := AllocateHwnd(WindowProc);
if Fhwnd = then Exit;
try
while Longint(GetMessage(msg, , , )) > do // will block until a message arrives on the queue.
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
finally
DeallocateHwnd(Fhwnd);
Fhwnd := ;
end;
end;
Where we can have a plain old window procedure to handle the messages:
WM_TerminateYourself = WM_APP + ; procedure TMyThread.WindowProc(var msg: TMessage);
begin
case msg.Msg of
WM_ReadyATractorBeam: ReadyTractorBeam;
WM_TerminateYourself: PostQuitMessage(0);
else
msg.Result := DefWindowProc(Fhwnd, msg.msg, msg.wParam, msg.lParam);
end;
end;
and when you want the thread to finish, you tell it:
procedure TMyThread.Terminate;
begin
PostMessage(Fhwnd, WM_TerminateYourself, , );
end; PostThreadMessage( FThreadId, WM_QUIT, 0, 0 );
Using PostThreadMessage is not necessarily incorrect. Raymond's article that you linked to says:
PostQuitMessage(0)
Because the system tries not to inject a WM_QUIT message at a "bad time";
instead it waits for things to "settle down" before generating the WM_QUIT message,
thereby reducing the chances that the program might be in the middle of a multi-step
procedure triggered by a sequence of posted messages.
If the concerns outlined here do not apply to your message queue,
then call PostThreadMessage with WM_QUIT and knock yourself out.
Otherwise you'll need to create a special signal, i.e. a user-defined message,
that allows you to call PostQuitMessage from the thread.