How can I end a thread that has a separate message loop?

I am writing a utility for the API SetWindowsHookEx.

To use it, I would 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, TKeyboardHookThreadI cannot execute the thread correctly.

The code:

  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 hook procedure is only called when there is a message loop in the stream. The problem is that I do not know how to get out of this message loop correctly.

I tried to do this using a hidden TFormone that belongs to the stream, but the message loop does not process the messages that I send to the window handle of this form.

How to do this correctly so that the message cycle ends when the stream is turned off?

Edit: The solution I'm using right now 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;
+3
2

WM_QUIT , . GetMessage false, , , - WM_QUIT, .

PostThreadMessage, WM_QUIT . :

PostThreadMessage(Thread.Handle, WM_QUIT, 0, 0);
+6

, , , Execute. PostQuitMessage , . , WM_QUIT .

, - , . VCL . Win32 DsiAllocateHwnd.

+2

All Articles