delphi - スレッドの不安定性内の SetWindowsHookEx

Question

わかりました、私の問題を非常に完全な形で説明しようと思います。別のプロセスに挿入された 1 つの DLL を使用しています (VirtualAllocEx/WriteProcessMemory/CreateRemoteThread を使用して挿入されますが、これは実際には問題ではありません)。この DLL を EntryPoint で実行すると、次の 1 つしかありません。

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' は、POST/GET 要求を実行する Indy 経由で 1 つの php に接続する、実行中のプロセスを一覧表示する、などの処理を行います...そして、StartKeyboardHook は次のように単純です:

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

ご覧のとおり、この StartKeyboardHook は MyMainThread 内にあり、llKeyboardHook/LowLevelKeyboardHook はグローバル変数/メソッドです...スレッド内に L​​owLevelKeyboardHook プロシージャを配置すると、フックが機能しません。私が言ったように、2つのタイマーをセットアップしないとフックは完全に機能しますが、必要に応じてここに投稿できます。私が言ったように、フックはスレッド内で開始されますが、コールバック プロシージャと hhook 変数はグローバルです (おそらくそれが問題です)...タイマーとフックには CreateMessagePump (スレッドの Execute での最後の呼び出し) プロシージャが必要です。 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 のコードは完全に機能しました。受け取ったエラーは、コールバックが正しく宣言されていることを確認するコンパイラからのものです。そうではなかったので、コンパイラは停止しました。それが望ましい動作です。コンパイラを無視し、エラーを抑制し、破損したコールバックを続行することを選択しました。正しい応答は、コールバックを修正することでした。

質問し続け、アドバイスを受け、そのアドバイスに耳を貸さず、同じ質問を何度もするのは、むしろ無意味です。進歩したい場合は、アドバイスに注意する必要があります。なぜあなたがそれをしないかどうかさえ尋ねるのですか？

---

ここでの詳細については、主に 2 つの問題があると思います。

1. スレッド ループは決して終了しません。前回の質問で示した正確なループを使用してください。単にコピーするのではなく、それがどのように機能し、なぜ正しいのかを理解しようとします。

2. タイマー コールバック関数が必要なシグネチャと一致しません。インスタンス メソッド (またはクラス メソッド) にすることはできません。これらは、ユニット スコープで宣言された関数である必要があります。それらは stdcall でなければなりません。パラメータ リストは一致する必要があります。これらの要件を満たすのは難しいので、以前の質問から Sertac のコードを使用し、コンパイラにタイプ セーフを適用させるのが最善です。

Answer 2

最初に: グローバル変数を使用してスレッドに接続することは推奨される解決策ではありません.. LowLevelKeyboardHook をグローバル プロシージャとして使用しています.メイン スレッドに LowLevelKeyboardHook を宣言する必要があります: 残念ながら、コールバック関数をオブジェクト (クラス、オブジェクト、スレッド、..)、したがって、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 を 1 回だけ呼び出す必要があります。

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

コールバック関数をクラス内で機能させる別の方法: 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.