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.