How can I terminate a thread that has a seperate message loop?

http://www.techques.com/question/1-10415481/How-can-I-terminate-a-thread-that-has-a-seperate-message-loop

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;

 

 

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

 

 

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 = 0 then Exit;
   try
      while Longint(GetMessage(msg, 0, 0, 0)) > 0 do // will block until a message arrives on the queue.
      begin
         TranslateMessage(msg);
         DispatchMessage(msg);
      end;
   finally
      DeallocateHwnd(Fhwnd);
      Fhwnd := 0;
   end;
end;

 

Where we can have a plain old window procedure to handle the messages:

WM_TerminateYourself = WM_APP + 1;

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, 0, 0);
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.