Maus-/Keyboard-Hook in Thread packen?

[H4ndy]

Hallo,

Ich habe erfolgreich einen Low Level Maus- sowie Tastatur-Hook in meinem Programm laufen,
diese funktionieren auch problemlos und fangen alles ab.

Jetzt habe ich aber das Problem, dass alle Maus- bzw. Tastatureingaben nur sehr verzögert
und schleppend verarbeitet werden, wenn mein Programm was rechenintensives im Hauptthread
veranstaltet. Woran das liegt ist ja offensichtlich, schließlich liegen mein Hook-Callbacks
auch im Hauptthread.

Als Ausweg sind mir nun Threads in den Sinn gekommen, allerdings finde ich da jetzt
absolut keine Ansatz in meinem Gehirn, wie ich die Callbacks oder den gesamten Hook in den Thread bekomme,
da ich ein Event-basiertes Hook-Objekt benutze.

Der Thread muss ja in einer Endlosschleife bleiben, damit diese am Leben bleibt, aber wie bekomm ich
da jetzt eine Eventsteuerung hinein?

Hoffentlich kennt da jemand einen Ansatz, finde in der Richtung absolut nix über Google,
obwohl es bestimmt eine triviale Antwort ist :?

[Apollonius]

Die Frage ist: Was machst du in der Hook-Prozedur? Grenze doch bitte das "event-basierte Hook-Objekt" etwas ein.

[H4ndy]

Zitat:

Zitat von Apollonius

Die Frage ist: Was machst du in der Hook-Prozedur? Grenze doch bitte das "event-basierte Hook-Objekt" etwas ein.

Hallo,

Ich überprüfe nur den Input auf "injected",
was ich genau mache, habe ich hier beschrieben:
http://www.delphipraxis.net/internal...=914745#914745

[Apollonius]

Du veränderst lediglich einige Formular-Elemente? Dann solltest du innerhalb deiner rechenintensiven Aufgaben einfach mal häufiger Application.ProcessMessages aufrufen. Du musst für eine zügige Nachrichtenbearbeitung sorgen. Aus Threads kannst du bekanntermaßen nicht auf VCL-Formular-Elemente zugreifen.

[H4ndy]

Das Code war nur ein Bespiel.

Konkret:
Aus den Callbacks setze ich nur was innerhalb einer Klasse von mir (TObject, ohne VLC o.ä.).
Die Hooks sind Objekte innerhalb dieser Klasse, werden also von dieser angelegt und verwaltet.
Meine Klasse feuert dann ein Ereignis, falls ein bestimmter Schwellwert überschritten wird.

Das einzige, was auf die VLC dann zugreifen muss, ist die Routine in dem Ereignis was geworfen wird.
Bis das passiert dürfen die Callbacks nicht vom Hauptthread beeinflusst werden, sonst kommt es
eben wieder zu den genannten Hängern :/

[Apollonius]

Den Hook musst du aus dem Thread installieren. Außerdem muss der Thread eine Nachrichtenschleife besitzen.

[H4ndy]

Zitat:

Zitat von Apollonius

Den Hook musst du aus dem Thread installieren. Außerdem muss der Thread eine Nachrichtenschleife besitzen.

OK, dann werd ich mich mal belesen wie ich einen Thread mit Nachrichtenschleife erstelle.
Vielen Dank :)

[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.