delphi - SetWindowsHookEx 里面的 Thread 不稳定

Question

好的，伙计们，我将尝试以非常完整的形式解释我的问题。我正在使用在另一个进程中注入的一个 DLL（使用 VirtualAllocEx/WriteProcessMemory/CreateRemoteThread 注入，但这并不重要），并且这个 DLL 在 EntryPoint 中运行时只有一件事：

procedure EntryPoint(Reason: integer);
begin
  if Reason = DLL_PROCESS_ATTACH then
    begin
      MyMainThread.Create;
    end

好的，所以我所有的工作都在这个 MyMainThread (TThread) 中完成......我在 MyMainThread 中所做的基本上是设置 2 个计时器，并使用 SetWindowsHookEx (WH_KEYBOARD_LL) 挂钩键盘事件。分开时一切正常，这是：或 SetWindowsHookEx 或 2 个计时器......当我出于某种未知原因将这两个东西放在一起时，钩子适用于在键盘中输入的几个字符（少于 10 个）并且计时器只是停止，但 MyMainThread 不会终止。我在 Windows 7 / 2008 上的测试非常完美，但在 Windows 2003 上运行时问题就出现了。MyMainThread Execute 是这样的：

procedure MyMainThread.Execute;
begin
  while not Terminated do
    begin
      MyThread:= Self;
      StartKeyboardHook;
      StartUp;
      SetTimer(0, 0, 600000, @MyMainThread.ContactHome);
      SetTimer(0, 0, 40000, @MyMainThread.MapProc);
      CreateMessagePump;
    end;
end;

2个计时器和'StartUp'做一些事情，比如通过Indy联系一个php做POST/GET请求，列出正在运行的进程，等等...... StartKeyboardHook很简单，如下所示：

procedure MyMainThread.StartKeyboardHook;
begin
  if llKeyboardHook = 0 then
    llKeyboardHook:= SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardHook, HInstance, 0);
end;

如您所见，这个 StartKeyboardHook 在 MyMainThread 内，而 llKeyboardHook/LowLevelKeyboardHook 是全局变量/方法...如果我将 LowLevelKeyboardHook 程序放在线程内，则挂钩不起作用。我相信问题不在于我的 LowLevelKeyboardHook（代码本身），因为正如我所说，如果我不设置 2 个计时器，则挂钩可以完美运行，但如果您愿意，我可以将其发布在这里。正如我所说，钩子是在线程内部启动的，但回调过程和钩子变量是全局的（也许这就是问题所在）...... CreateMessagePump（线程执行中的最后一次调用）过程对于计时器和钩子是必需的，因为它是 LowLevel 挂钩，所以我需要一个消息队列。为什么我会出现这种不稳定性（因为我的测试仅在 Win2k3 中显示），如果我只放置没有计时器的键盘挂钩，还是只有没有钩子的计时器，一切正常？消息泵是：

procedure MyMainThread.CreateMessagePump;
var
  AppMsg: TMsg;
begin
  while GetMessage(AppMsg, 0, 0, 0) do
    begin
      TranslateMessage(AppMsg);
      DispatchMessage(AppMsg);
    end;
  //if needed to quit this procedure use PostQuitMessage(0);
end;

Answer 1

首先是一些非常一般的建议。

你问了一个问题，你之前的问题，关于如何组织线程的 Execute 方法。我当时给你的答案是准确的。你应该注意它。

在您本人就该主题提出的每一个问题中，Sertac 和其他人都告诉您有关 Win32 回调函数声明不匹配的问题。看来你没有听从建议。您继续使用 RTL 和 @ 运算符提供的损坏的 API 声明。在上一个问题中，Sertac 向您展示了如何纠正 RTL 声明的错误。如果您无法检查您的回调是否匹配，那么您必须让编译器执行此操作。

您在评论中说您尝试了 Sertac 的类型安全 SetTimer，但它“没有用”。那是误诊。Sertac 的代码运行良好。您收到的错误来自编译器检查您的回调是否正确声明。既然不是，编译器就停止了。这是期望的行为。您选择忽略编译器、抑制错误并继续使用中断的回调。正确的回应是修复您的回调。

你不断地问问题，接受建议，不听建议，然后一遍又一遍地问同样的问题，这对你来说是毫无意义的。如果你想取得进步，你必须听从建议。为什么还要问你是否不会这样做？

---

至于这里的细节，我看到两个主要问题：

1. 线程循环永远不会终止。使用我在上一个问题中给你的确切循环。与其只是复制它，不如试着理解它是如何工作的以及为什么它是正确的。

2. 您的计时器回调函数与所需的签名不匹配。它们不能是实例方法（或类方法）。它们应该是在单元范围内声明的函数。它们必须是标准调用。参数列表必须匹配。由于您发现很难满足这些要求，因此最好使用前面问题中的 Sertac 代码并让编译器强制执行类型安全。

Answer 2

首先：不推荐使用全局变量来联系线程..您正在使用 LowLevelKeyboardHook 作为全局过程。您应该将 LowLevelKeyboardHook 声明到您的主线程中：不幸的是，您不能将回调函数声明为对象（类，对象， Thread,..),所以你需要将你的 LowLevelKeyboardHook 作为一个类函数，当然它应该是静态函数。（或者你可以使用 MakeObjectInstance 函数从回调函数创建一个对象。）：

   TMyMainThread = class(TThread)
  private
  class var
    llKeyboardHook: HHook;

  public
    constructor Create(CreateSuspended: Boolean); overload;
    destructor Destroy; override;
  protected
    procedure Execute; override;
    class function LowLevelKeyboardHook(Code: Integer; wParam: wParam;
      lParam: lParam): LRESULT; stdcall; static;
  end;

现在你可以设置你的钩子了：

 llKeyboardHook := SetWindowsHookEx(WH_KEYBOARD_LL,
        @TMyMainThread.LowLevelKeyboardHook, HInstance, 0);

其次：你的线程的执行方法永远运行，当它每次调用SetTimer时运行时......你应该只调用一次Settimer ..

procedure TMyMainThread.Execute;
begin
  while not Terminated do
    begin
    {Set FirstTime to true on TMyMainThread.Create}
      if FirstTime then
        begin
          FirstTime := False;
          SetTimer();
          ...
        end;
    end;
end;

Answer 3

在 Class 中创建回调函数的另一种方法：我将以 SetTimer 为例：首先我们可以在类中声明回调函数：

type
  TForm3 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    IDTimer, IDTimer2: DWORD;
    FObj: Pointer;
    procedure FTimerMethod2(var Message: TTimerStruct);
    procedure FTimerMethod(_hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
      dwTime: DWORD); stdcall;
  public
    { Public declarations }
  end;

然后，处理函数：

procedure TForm3.FTimerMethod(_hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
  dwTime: DWORD); stdcall;
begin
  { Note : you can not access function params correctly }
  { & you should use Form3.ListBox2.Items to access the ListBox
    instead of ListBox2.Items .
  }
  {
    this Code will not work :
    ListBox2.Items.add(IntToStr(_hwnd)); !!!

  }
  Form3.ListBox2.Items.add(IntToStr(_hwnd));
end;

但请注意，您不能访问函数参数，并且您需要指定保存要与其联系的对象（ListBox2）的全局变量（Form3）。我认为这种方法只适用于 Settimer 回调函数。

其次：使用MakeXObjectInstance从我们的回调函数创建一个对象：这意味着我们的回调函数将被复制到类中..我们首先正常调用回调函数然后我们将所有函数参数转换为TObject类中的函数：添加这个单元第一的 ：

unit uTimer;
{uTimer Unit by S.Mahdi}
interface

uses Windows;

type

  TTimerStruct = record
    _hwnd: HWND;
    uMsg: UINT;
    idEvent: UINT_PTR;
    dwTime: DWORD;

  end;

type
  TTimerMethod = procedure(var Message: TTimerStruct) of object;

function MakeTimerObjectInstance(const AMethod: TTimerMethod): Pointer;
procedure FreeTimerObjectInstance(ObjectInstance: Pointer);

implementation

type
  PObjectInstance = ^TObjectInstance;

  TObjectInstance = packed record
    Code: Byte;
    Offset: Integer;
    case Integer of
      0:
        (Next: PObjectInstance);
      1:
        (FMethod: TMethod);
  end;

const
{$IF Defined(CPUX86)}
  CodeBytes = 2;
{$ELSEIF Defined(CPUX64)}
  CodeBytes = 8;
{$ENDIF CPU}
  InstanceCount = (4096 - SizeOf(Pointer) * 2 - CodeBytes)
    div SizeOf(TObjectInstance) - 1;

type
  PInstanceBlock = ^TInstanceBlock;

  TInstanceBlock = packed record
    Next: PInstanceBlock;
    Code: array [1 .. CodeBytes] of Byte;
    WndProcPtr: Pointer;
    Instances: array [0 .. InstanceCount] of TObjectInstance;
  end;

var
  InstBlockList: PInstanceBlock;
  InstFreeList: PObjectInstance;

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := IntPtr(Dest) - (IntPtr(Src) + 5);
end;

procedure StdTimerProc(_hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
  dwTime: DWORD); stdcall;
var
  TimerStruct: TTimerStruct;
{$IF Defined(CPUX86)}
  { In    ECX = Address of method pointer }
  asm
    PUSH EBX
    PUSH EDX
    MOV EBX,_hwnd
    XOR EDX,EDX
    LEA EDX,TimerStruct
    MOV [EDX].TTimerStruct._hwnd,EBX;
    MOV EBX,uMsg
    MOV [EDX].TTimerStruct.uMsg,EBX;
    MOV EBX,idEvent
    MOV [EDX].TTimerStruct.idEvent,EBX;
    MOV EBX,dwTime
    MOV [EDX].TTimerStruct.dwTime,EBX;
    PUSH EDX
    MOV     EAX,[ECX].Longint[4]
    CALL    [ECX].Pointer
    POP EDX
    POP EBX
    (* XOR     EAX,EAX
    PUSH    EAX
    PUSH    dwTime
    PUSH    idEvent
    PUSH    uMsg
    PUSH    _hwnd
    MOV     EDX,ESP
    MOV     EAX,[ECX].Longint[4]
    CALL    [ECX].Pointer
    ADD     ESP,16
    POP     EAX *)
end;
{$ELSEIF Defined(CPUX64)}
  { In    R11 = Address of method pointer }
  asm
    .PARAMS 1
    MOV TimerStruct._hwnd,_hwnd;
    MOV TimerStruct.uMsg,uMsg;
    MOV TimerStruct.idEvent,idEvent;
    MOV TimerStruct.dwTime,dwTime;
    LEA RDX,TimerStruct
    PUSH RCX
    PUSH R11
    MOV     RCX,[R11].TMethod.Data
    CALL    [R11].TMethod.Code
    POP R11
    POP RCX
end;
{$ENDIF CPUX64}

function MakeTimerObjectInstance(const AMethod: TTimerMethod): Pointer;
const
  BlockCode: array [1 .. CodeBytes] of Byte = (
{$IF Defined(CPUX86)}
    $59, { POP ECX }
    $E9); { JMP StdTimerProc }
{$ELSEIF Defined(CPUX64)}
    $41, $5B, { POP R11 }
    $FF, $25, $00, $00, $00, $00)
  ; { JMP [RIP+0] }
{$ENDIF}
  PageSize = 4096;
var
  Block: PInstanceBlock;
  Instance: PObjectInstance;
begin
  if InstFreeList = nil then
    begin
      Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
      Block^.Next := InstBlockList;
      Move(BlockCode, Block^.Code, SizeOf(BlockCode));
{$IF Defined(CPUX86)}
      Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2],
        @StdTimerProc));
{$ELSEIF Defined(CPUX64)}
      Block^.WndProcPtr := @StdTimerProc;
{$ENDIF}
      Instance := @Block^.Instances;
      repeat
        Instance^.Code := $E8; { CALL NEAR PTR Offset }
        Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
        Instance^.Next := InstFreeList;
        InstFreeList := Instance;
        Inc(PByte(Instance), SizeOf(TObjectInstance));
      until IntPtr(Instance) - IntPtr(Block) >= SizeOf(TInstanceBlock);
      InstBlockList := Block;
    end;
  Result := InstFreeList;
  Instance := InstFreeList;
  InstFreeList := Instance^.Next;
  Instance^.FMethod := TMethod(AMethod);
end;

procedure FreeTimerObjectInstance(ObjectInstance: Pointer);
begin
  if ObjectInstance <> nil then
    begin
      PObjectInstance(ObjectInstance)^.Next := InstFreeList;
      InstFreeList := ObjectInstance;
    end;
end;

end.

这是一个如何使用这两种方法的简单示例：

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  uTimer;

type
  TForm3 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    IDTimer, IDTimer2: DWORD;
    FObj: Pointer;
    procedure FTimerMethod(_hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
      dwTime: DWORD); stdcall;

    procedure FTimerMethod2(var Message: TTimerStruct);
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Button2Click(Sender: TObject);
begin
  KillTimer(Handle, IDTimer);
  FreeTimerObjectInstance(FObj);
end;

procedure TForm3.FTimerMethod(_hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
  dwTime: DWORD); stdcall;
begin
  { Note : you can not access function params correctly }
  { & you should use Form3.ListBox2.Items to access the ListBox
    instead of ListBox2.Items .
  }
  {
    this Code will not work :
    ListBox2.Items.add(IntToStr(_hwnd)); !!!

  }
  Form3.ListBox2.Items.add(IntToStr(_hwnd));
end;

procedure TForm3.FTimerMethod2(var Message: TTimerStruct);
begin
  ListBox1.Items.add(IntToStr(Message._hwnd));
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
  FObj := MakeTimerObjectInstance(FTimerMethod2);
  IDTimer := SetTimer(Handle, 0, 1000, FObj);
  IDTimer2 := SetTimer(Handle, 1, 1000, @TForm3.FTimerMethod);

end;

end.