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执行是这样的：

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是全局var /方法......如果我把LowLevelKeyboardHook程序放在线程里面，就不用挂钩了。我认为问题不在我的LowLevelKeyboardHook（代码本身）中，因为正如我所说的，如果我没有设置2个定时器，那么钩子可以完美地工作，但是如果你想我可以在这里发布它。正如我所说的，钩子是在线程内部启动的，但是回调过程和hhook变量是全局的（也许这就是问题）......对于定时器和钩子来说，CreateMessagePump（线程执行中的最后一次调用）过程是必需的，因为它是LowLevel钩子我需要一个消息队列。为什么我会遇到这种不稳定性（因为我的测试仅在Win2k3中显示），如果我只放置没有定时器的键盘钩，或者只有没有挂钩的定时器，一切正常？ MessagePump是：

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的代码完美无缺。您收到的错误来自编译器检查您的回调是否被正确声明。由于它不是，编译器停止了。这是理想的行为。您选择忽略编译器，抑制错误，并继续使用损坏的回调。正确的答案就是修复你的回调。

你继续提问，接受建议，不听从这些建议，然后一遍又一遍地问同样的问题，这是毫无意义的。如果你想取得进步，你必须听从建议。为什么甚至会问你是否会这样做？

至于详细信息，我看到两个主要问题：

线程循环永远不会终止。使用我在上一个问题中给出的确切循环。而不是仅仅复制它，试着理解它是如何工作的以及它为什么是正确的。
您的计时器回叫功能与所需的签名不匹配。它们不能是实例方法（或类方法）。它们应该是在单位范围内声明的函数。他们必须是stdcall。参数列表必须匹配。由于您发现很难满足这些要求，因此最好使用先前问题中的Sertac代码并让编译器强制执行类型安全。

Answer 2

首先：使用全局变量来联系线程不是推荐的解决方案。您正在使用LowLevelKeyboardHook作为全局过程。您应该将LowLevelKeyboardHook声明为主线程：遗憾的是，您不能将回调函数声明为对象（Class，Object，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);

其次：你的线程的execute方法永远运行，每次调用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;

但要注意，您无法访问函数参数，并且需要指定包含要与其联系的对象的全局变量（Form3）（ListBox2）。我认为这个方法只适用于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.

SetWindowsHookEx里面的Thread不稳定

3 个答案: