如何终止具有单独消息循环的线程？

Question

我正在为SetWindowsHookExAPI 编写一个实用程序单元.

要使用它,我想要一个这样的界面:

var
  Thread: TKeyboardHookThread;
begin
  Thread := TKeyboardHookThread.Create(SomeForm.Handle, SomeMessageNumber);
  try
    Thread.Resume;
    SomeForm.ShowModal;
  finally
    Thread.Free; // <-- Application hangs here
  end;
end;

在我当前的实现中,TKeyboardHookThread我无法正确退出线程.

代码是:

  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只有在线程中有消息循环时才会调用钩子过程.问题是我不知道如何正确退出此消息循环.

我尝试使用TForm属于该线程的隐藏,但消息循环不处理我发送到该窗体的窗口句柄的消息.

如何做到这一点,以便消息循环在线程关闭时终止？

编辑:我现在使用的解决方案看起来像这样(并且像魅力一样):

  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;

Answer 1

您需要将WM_QUIT消息发送到该线程的消息队列以退出该线程.如果从队列中提取的消息是WM_QUIT,则GetMessage返回false,因此它将在接收到该消息时退出循环.

为此,请使用PostThreadMessage函数将WM_QUIT消息直接发送到线程的消息队列.例如:

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