How can I terminate a thread that has a seperate message loop?
delphi, delphi-2007, message-loop, multithreading
Solution
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, 0, 0);
Problem
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 < 0 then begin Result := CallNextHookEx(0, nCode, wParam, lParam) end else begin S := PKBDLLHOOKSTRUCT(lParam)^; PostMessage(TKeyboardHookThread.FKeyReceiverWindowHandle, TKeyboardHookThread.FMessage, S.vkCode, 0); Result := CallNextHookEx(0, 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, 0, 0); inherited; end; procedure TKeyboardHookThread.Execute; var m: tagMSG; hook: HHOOK; begin hook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, 0); try FHiddenWindow := TForm.Create(nil); try while GetMessage(m, 0, 0, 0) 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 < 0 then begin Result := CallNextHookEx(0, nCode, wParam, lParam) end else begin S := PKBDLLHOOKSTRUCT(lParam)^; PostMessage(TKeyboardHookThread.FKeyReceiverWindowHandle, TKeyboardHookThread.FMessage, S.vkCode, 0); Result := CallNextHookEx(0, 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, 0, 0); inherited; end; procedure TKeyboardHookThread.Execute; var m: tagMSG; hook: HHOOK; begin hook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, 0); try while GetMessage(m, 0, 0, 0) do begin TranslateMessage(m); DispatchMessage(m); end; finally UnhookWindowsHookEx(hook); end; end; ```