Maus-/Keyboard-Hook in Thread packen?

[H4ndy]

So, ich habe das Problem gelöst.

Man darf die Hooks nicht innerhalb einer Routine setzen, welche von außen initiiert werden kann (z.B. die Set-Routine einer roperty). Denn dann werden die HookProcs im Kontext des setzenden Threads statt des gewollten Threads gestartet.

Folgender Aufbau funktioniert.
Ich werde demnächst mal noch ein voll funktionierendes Beispiel erstellen.

Delphi-Quellcode:

unit HookThread;

interface

uses
  Classes, Windows, Messages, ExtCtrls;

type
  ULONG_PTR = ^DWORD;

  // Low Level Keyboard Hook Info Struct
  // [url]http://msdn.microsoft.com/en-us/ms644967.aspx[/url]
  KBDLLHOOKSTRUCT = packed record
    vkCode,
      scanCodem,
      flags,
      time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;
  pKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;

  POINT = packed record
    x,y: longint;
  end;

  // Low Level Mouse Hook Info Struct
  // [url]http://msdn.microsoft.com/en-us/ms644970.aspx[/url]
  MSLLHOOKSTRUCT = packed record
    pt: POINT;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;
  PMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;

const
  // System Metrics Constants
  SM_REMOTECONTROL = $2001;
  SM_REMOTESESSION = $1000;

  // Low Level Hook API Constants
  WH_KEYBOARD_LL = 13;
  WH_MOUSE_LL = 14;

  // Low Level Keyboard Hook Flags
  LLKHF_EXTENDED = $01;
  LLKHF_INJECTED = $10;
  LLKHF_ALTDOWN = $20;
  LLKHF_UP = $80;

  // Low Level Mouse Hook Flags
  LLMHF_INJECTED = 1;

type

  THookThread = class(TThread)
  private
    FOnRemoteDetection: TNotifyEvent;
    FNeedUpdateHookState: Boolean;
    FIsActive: boolean;
    
    // Hook Handles
    FKBHookHandle, FMSHookHandle: Cardinal;

    // Invisible window handle
    //FWndHandle: HWND;

    // Procedure pointer for hook callback method "typecast"
    FKBCallStub, FMSCallStub: Pointer;

    FRemoteDesktopTimer: TTimer;
    
    // Main message loop to process hook messages
    procedure MessageLoop;

    // Event handlers
    procedure SyncRemoteDetectionEvent;
    procedure FireRemoteDetection;

    // Hook callbacks
    function KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
    function MouseHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

    function DoHooking(const DoUnhook: boolean = FALSE): boolean;
    // Install/Uninstall both hooks

    // *ProcInstance - Converts method pointer to regular procedures
    // For usage refer to THookThread.Create
    // Author: Michael Puff ([url]http://www.michael-puff.de[/url])
    // Source: [url]http://www.delphipraxis.net/topic115574.html[/url]
    // License: PUBLIC DOMAIN
    function RDMakeProcInstance(M: TMethod): Pointer;
    procedure RDFreeProcInstance(ProcInstance: Pointer);

    procedure UpdateHookState;
    function IsRemoteDesktopSession: boolean;
    procedure IncHolddownBuffer;

    procedure OnRemoteDesktopTimer(Sender: TObject);
    
    procedure SetActive(const Value: boolean);
    
  protected
    procedure Execute; override;
    
  public
    constructor Create(const CreateThreadSuspended: boolean = FALSE;
      const CreateInactive: boolean = FALSE;
      const OnRemoteDetectionCallback: TNotifyevent = NIL); reintroduce;

    destructor Destroy; override;

    property Active: Boolean read FIsActive write SetActive;
    
    property OnRemoteDetection: TNotifyEvent read FOnRemoteDetection write FOnRemoteDetection;
    // Fired if Remote Desktop is detected or HolddownBufferLimit is reached
  end;

implementation


{ THookThread }

constructor THookThread.Create(const CreateThreadSuspended,
  CreateInactive: boolean;
  const OnRemoteDetectionCallback: TNotifyevent);
var
  tmpMethod: TMethod;
begin
  // Default on
  FreeOnTerminate := TRUE;
  
//  FWndHandle := AllocateHWnd(WndMessageProc);

  FKBHookHandle := 0;
  FMSHookHandle := 0;

  // Create keyboard hook proc stub
  tmpMethod.Code := @THookThread.KeyboardHookProc;
  tmpMethod.Data := Self;
  FKBCallStub := RDMakeProcInstance(tmpMethod);

  // Create mouse hook proc stub
  tmpMethod.Code := @THookThread.MouseHookProc;
  tmpMethod.Data := Self;
  FMsCallStub := RDMakeProcInstance(tmpMethod);

  FRemoteDesktopTimer := TTimer.Create(nil);
  FRemoteDesktopTimer.Enabled := FALSE;
  FRemoteDesktopTimer.Interval := 60000; // 1 Check per minute
  FRemoteDesktopTimer.OnTimer := OnRemoteDesktopTimer;

  FOnRemoteDetection := OnRemoteDetectionCallback;

  FIsActive := not CreateInactive;
  FNeedUpdateHookState := False;
  
  // Create thread
  inherited Create(CreateThreadSuspended);
end;

destructor THookThread.Destroy;
begin
//  if FWndHandle <> 0 then
  //  DeallocateHWnd(FWndHandle);

  if Assigned(FRemoteDesktopTimer) then
    FRemoteDesktopTimer.Free;
    
  // Unhook (just to be shure)
  DoHooking(TRUE);

  // Free procedure pointers
  if FKBCallStub <> NIL then
    RDFreeProcInstance(FKBCallStub);

  if FMSCallStub <> NIL then
    RDFreeProcInstance(FMSCallStub);
  
  inherited;
end;

function THookThread.DoHooking(const DoUnhook: boolean): boolean;
begin
  if not DoUnhook then
  begin
    // Install hooks
    if FKBHookHandle = 0 then
    begin
      FKBHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, FKBCallStub, HInstance, 0);
    end;

    if FMSHookHandle = 0 then
    begin
      FMSHookHandle := SetWindowsHookEx(WH_MOUSE_LL, FMSCallStub, HInstance, 0);
    end;
    
    Result := (FKBHookHandle <> 0) and (FMSHookHandle <> 0);
  end
  else
  begin
    // Uninstall hooks
    if FKBHookHandle <> 0 then
      if UnhookWindowsHookEx(FKBHookHandle) then
        FKBHookHandle := 0;

    if FMSHookHandle <> 0 then
      if UnhookWindowsHookEx(FMSHookHandle) then
        FMSHookHandle := 0;

    Result := (FKBHookHandle = 0) and (FMSHookHandle = 0);
  end;
end;

procedure THookThread.Execute;
begin
  // Enable everything
  UpdateHookState();

  // Message loop
  while not Terminated do
  begin
    if FNeedUpdateHookState then
    begin
      FNeedUpdateHookState := False;
      UpdateHookState;
    end;
    
    MessageLoop;
    Sleep(10);
  end;

  // Unhook
  DoHooking(TRUE);
end;

procedure THookThread.FireRemoteDetection;
begin
  if Assigned(FOnRemoteDetection) then
  begin
    FOnRemoteDetection(Self);
  end;
end;

procedure THookThread.IncHolddownBuffer;
begin
  if not FStopActivity and not FIsDisabled then
  begin
    inc(FHolddownBuffer);
  end;

  if not FRemoteInputDetected then
  begin
    if FHolddownBuffer > FHolddownBufferLimit then
    begin
      FRemoteInputDetected := TRUE;
      FStopActivity := TRUE;
      if Assigned(FOnRemoteDetection) then
      begin
        SyncRemoteDetectionEvent;
      end;
    end;
  end;
end;

function THookThread.IsRemoteDesktopSession: boolean;
var
  RemoteDesktopActive, RemoteClientSessionActive: boolean;
begin
  // API Checks

  // [url]http://msdn.microsoft.com/en-us/library/ms724385.aspx[/url]
  // This seems to be allways false on Windows XP or Vista.
  RemoteDesktopActive := GetSystemMetrics(SM_REMOTECONTROL) <> 0;

  // [url]http://msdn.microsoft.com/en-us/library/ms724385.aspx[/url]
  // Reliable Value (tested on XP and Vista).
  RemoteClientSessionActive := GetSystemMetrics(SM_REMOTESESSION) <> 0;

  Result := RemoteDesktopActive or RemoteClientSessionActive;
end;

procedure THookThread.OnRemoteDesktopTimer(Sender: TObject);
begin
  if not FRemoteDesktopDetected and not FStopActivity and not FIsDisabled then
  begin
    FRemoteDesktopDetected := IsRemoteDesktopSession;
    if FRemoteDesktopDetected then
    begin
      if Assigned(FOnRemoteDetection) then
      begin
        FStopActivity := TRUE;
        SyncRemoteDetectionEvent();
      end;
    end;
  end;
end;

function THookThread.KeyboardHookProc(nCode: Integer;
  wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  pKeyHookStruct: PKBDLLHOOKSTRUCT;
  KeyHookStruct: KBDLLHOOKSTRUCT;
begin
  if nCode >= HC_ACTION then
  begin
    pKeyHookStruct := PKBDLLHOOKSTRUCT(LParam);
    KeyHookStruct := pKeyHookStruct^;

    if KeyHookStruct.flags = LLKHF_INJECTED then
    begin
      IncHolddownBuffer();
    end;
  end;
  Result := CallNextHookEx(FKBHookHandle, nCode, wParam, lParam);
end;

procedure THookThread.MessageLoop;
var
  msg: TMsg;
begin
  // GetMessage will wait until a message is received so we use PeekMessage
  // to get it working (GetMessage would block forever and Terminate wouldn't work)
  
  //while GetMessage(msg, 0, 0, 0) do

  while PeekMessage(msg, 0, 0, 0, PM_NOREMOVE) do
  begin
    // We just pass all messages...
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end;

function THookThread.MouseHookProc(nCode: Integer;
  wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  pMouseHookStruct: PMSLLHOOKSTRUCT;
  MouseHookStruct: MSLLHOOKSTRUCT;
begin
  if nCode >= HC_ACTION then
  begin
    pMouseHookStruct := PMSLLHOOKSTRUCT(LParam);
    MouseHookStruct := pMouseHookStruct^;

    if MouseHookStruct.flags = LLMHF_INJECTED then
    begin
      IncHolddownBuffer();
    end;
  end;
  Result := CallNextHookEx(FMSHookHandle, nCode, wParam, lParam);
end;

procedure THookThread.RDFreeProcInstance(ProcInstance: Pointer);
begin
  // free memory
  FreeMem(ProcInstance, 15);
end;

function THookThread.RDMakeProcInstance(M: TMethod): Pointer;
begin
  // allocate memory for 15 byte of code
  GetMem(Result, 15);
  asm
    // MOV ECX,
    MOV BYTE PTR [EAX], $B9
    MOV ECX, M.Data
    MOV DWORD PTR [EAX+$1], ECX
    // POP EDX (put old jump back adress to EDX)
    MOV BYTE PTR [EAX+$5], $5A
    // PUSH ECX (add "self" as parameter 0)
    MOV BYTE PTR [EAX+$6], $51
    // PUSH EDX (put jump back adress back on stack)
    MOV BYTE PTR [EAX+$7], $52
    // MOV ECX, (move adress to ECX)
    MOV BYTE PTR [EAX+$8], $B9
    MOV ECX, M.Code
    MOV DWORD PTR [EAX+$9], ECX
    // JMP ECX (jump to first put down command and call method)
    MOV BYTE PTR [EAX+$D], $FF
    MOV BYTE PTR [EAX+$E], $E1
    // No call here or there would be another jump back adress on the stack
  end;
end;

procedure THookThread.SetActive(const Value: boolean);
begin
  if Value <> FIsActive then
  begin
    if Value and not FIsDisabled then
    begin
      FIsActive := Value;
    end
    else
      FIsActive := Value;

    FNeedUpdateHookState := True;
  end;
end;

procedure THookThread.UpdateHookState;
begin
  // Set hook state regarding FIsActive and FIsInstalled;
  DoHooking(not FIsActive);
  FRemoteDesktopTimer.Enabled := FIsActive;
end;

procedure THookThread.SyncRemoteDetectionEvent;
begin
  Synchronize(FireRemoteDetection);
end;

end.