4

我正在为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;
4

2 回答 2

7

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

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

PostThreadMessage(Thread.Handle, WM_QUIT, 0, 0);
于 2012-05-02T14:27:42.743 回答
2

消息泵永远不会退出，因此当您释放线程时，它会无限期地阻塞等待 Execute 方法完成。从线程调用 PostQuitMessage 以终止消息泵。如果您希望从主线程调用它，那么您需要将 WM_QUIT 发布到线程。

此外，您的隐藏窗口是一场等待发生的灾难。您不能在主线程之外创建 VCL 对象。您必须使用原始 Win32 创建窗口句柄，或者更好的是使用 DsiAllocateHwnd。

于 2012-05-02T14:31:31.503 回答