globalkeyboardhook.pas

//-----------------------------------------------------------------------------------
//  Toolkit Package © 2026 by Alexander Tverskoy
//  Licensed under the MIT License
//  You may obtain a copy of the License at https://opensource.org/licenses/MIT
//-----------------------------------------------------------------------------------

unit GlobalKeyboardHook;

{$NOTES OFF}
{$HINTS OFF}
{$WARNINGS OFF}

{$mode objfpc}{$H+}

interface

uses
  SysUtils
  {$IFDEF WINDOWS}
  , Windows
  , Messages
  {$ENDIF}
  ;

type
  TKeyCodeSet = set of byte;   // set of virtual key codes to block

  PKeyboardLLHookStruct = ^TKeyboardLLHookStruct;

  TKeyboardLLHookStruct = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: PtrUInt;
  end;

  TKeyboardEventInfo = record
    KeyCode: DWORD;      // virtual key code
    ScanCode: DWORD;     // hardware scan code
    Flags: DWORD;        // LLKHF_* flags (e.g. LLKHF_EXTENDED, LLKHF_ALTDOWN)
    Time: DWORD;         // event timestamp in milliseconds
    IsDown: boolean;     // True = key press, False = key release
    CtrlDown: boolean;
    ShiftDown: boolean;
    AltDown: boolean;
    IsInjected: boolean;   // True if event was generated by software (SendInput, keybd_event)
    Handled: boolean;
  end;

  TKeyboardEvent = procedure(Sender: TObject; var Info: TKeyboardEventInfo) of object;

  // FIX: Class declaration is now unconditional (not inside IFDEF WINDOWS)
  TGlobalKeyboardHook = class
  private
    FEnabled: boolean;
    FEditFieldOnly: boolean;   // process events only when focus is in an editable control
    FBlockedKeys: TKeyCodeSet; // keys that will be swallowed (not passed to system)
    FOnKeyEvent: TKeyboardEvent;
    {$IFDEF WINDOWS}
    FHook: HHOOK;
    // Internal modifier state (updated from key events, always accurate)
    FLeftCtrl: Boolean;
    FRightCtrl: Boolean;
    FLeftShift: Boolean;
    FRightShift: Boolean;
    FLeftAlt: Boolean;
    FRightAlt: Boolean;
    class var FActiveInstance: TGlobalKeyboardHook;
    class function HookProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;
    procedure InternalKeyboardEvent(wParam: WPARAM; const KBDLLHOOKSTRUCT: TKeyboardLLHookStruct; var Info: TKeyboardEventInfo);
    {$ENDIF}
    procedure SetEnabled(AValue: boolean);
  public
    constructor Create;
    destructor Destroy; override;

    property Enabled: boolean read FEnabled write SetEnabled;
    // When True, events are generated only when focus is in an editable control
    property EditFieldOnly: boolean read FEditFieldOnly write FEditFieldOnly;
    // Set of virtual key codes that will be blocked (not passed to the system)
    property BlockedKeys: TKeyCodeSet read FBlockedKeys write FBlockedKeys;
    // Event fired on any key press or release (if filters pass)
    property OnKeyEvent: TKeyboardEvent read FOnKeyEvent write FOnKeyEvent;

    class function IsCtrlPressed: boolean;
    class function IsShiftPressed: boolean;
    class function IsAltPressed: boolean;
  end;

const
  WH_KEYBOARD_LL = 13;

  // Flags that may appear in TKeyboardLLHookStruct.flags
  LLKHF_EXTENDED = 1;
  LLKHF_ALTDOWN = 32;
  LLKHF_UP = 128; // usually indicates key up; but wParam gives exact state

  LLKHF_INJECTED = $00000010;

implementation

{$IFDEF WINDOWS}

// ---------- Hook callback ----------
class function TGlobalKeyboardHook.HookProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  p: PKeyboardLLHookStruct;
  Info: TKeyboardEventInfo;
  Block: boolean;
begin
  Result := 0;
  if (nCode >= 0) and (FActiveInstance <> nil) then
  begin
    p := PKeyboardLLHookStruct(Pointer(PtrUInt(lParam)));

    // Let the event handler inspect the key and optionally mark it as handled
    FActiveInstance.InternalKeyboardEvent(wParam, p^, Info);

    // Determine whether to block this key
    Block := Info.Handled;   // Event handler requested blocking
    // Also block hardware (non-injected) keys that are in the BlockedKeys set
    if not Block and ((p^.flags and LLKHF_INJECTED) = 0) then
      Block := (p^.vkCode in FActiveInstance.FBlockedKeys);

    if Block then
    begin
      Result := 1;   // Swallow the event – do not pass to the system
      Exit;
    end;
  end;

  // Pass to the next hook in the chain
  if FActiveInstance <> nil then
    Result := CallNextHookEx(FActiveInstance.FHook, nCode, wParam, lParam)
  else
    Result := CallNextHookEx(0, nCode, wParam, lParam);
end;

procedure TGlobalKeyboardHook.InternalKeyboardEvent(wParam: WPARAM; const KBDLLHOOKSTRUCT: TKeyboardLLHookStruct;
  var Info: TKeyboardEventInfo);
var
  IsDown: Boolean;
begin
  IsDown := (wParam = WM_KEYDOWN) or (wParam = WM_SYSKEYDOWN);

  // Update internal modifier state based on the current event.
  // This ensures that modifier flags are correct even when the modifier key
  // itself is pressed or released (GetAsyncKeyState would lag behind).
  case KBDLLHOOKSTRUCT.vkCode of
    VK_LCONTROL: FLeftCtrl := IsDown;
    VK_RCONTROL: FRightCtrl := IsDown;
    VK_LSHIFT:   FLeftShift := IsDown;
    VK_RSHIFT:   FRightShift := IsDown;
    VK_LMENU:    FLeftAlt := IsDown;
    VK_RMENU:    FRightAlt := IsDown;
    VK_MENU:     begin FLeftAlt := IsDown; FRightAlt := False; end;   // generic Alt
    VK_CONTROL:  begin FLeftCtrl := IsDown; FRightCtrl := False; end;  // generic Ctrl
    VK_SHIFT:    begin FLeftShift := IsDown; FRightShift := False; end; // generic Shift
  end;

  // Fill event information
  Info.KeyCode := KBDLLHOOKSTRUCT.vkCode;
  Info.ScanCode := KBDLLHOOKSTRUCT.scanCode;
  Info.Flags := KBDLLHOOKSTRUCT.flags;
  Info.Time := KBDLLHOOKSTRUCT.time;

  Info.IsDown := IsDown;
  // Modifier states taken from our internal tracking – always accurate
  Info.CtrlDown := FLeftCtrl or FRightCtrl;
  Info.ShiftDown := FLeftShift or FRightShift;
  Info.AltDown := FLeftAlt or FRightAlt;

  Info.IsInjected := (KBDLLHOOKSTRUCT.flags and LLKHF_INJECTED) <> 0;

  // Default: key is passed to the system
  Info.Handled := False;

  // Fire the event if assigned
  if Assigned(FOnKeyEvent) then
    FOnKeyEvent(Self, Info);
end;

// ---------- Lifecycle and hook management ----------
constructor TGlobalKeyboardHook.Create;
begin
  inherited;
  FHook := 0;
  FEnabled := False;
  FEditFieldOnly := False;
  FBlockedKeys := [];
  // Initialize internal modifier flags
  FLeftCtrl := False;
  FRightCtrl := False;
  FLeftShift := False;
  FRightShift := False;
  FLeftAlt := False;
  FRightAlt := False;
end;

destructor TGlobalKeyboardHook.Destroy;
begin
  Enabled := False;
  inherited;
end;

procedure TGlobalKeyboardHook.SetEnabled(AValue: boolean);
begin
  if FEnabled = AValue then Exit;
  if AValue then
  begin
    if FActiveInstance <> nil then
      raise Exception.Create('Only one TGlobalKeyboardHook can be active at a time.');

    // Install the hook, passing HInstance for XP compatibility
    FHook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, 0);
    if FHook = 0 then
    begin
      // Hook installation failed – keep FActiveInstance nil and FEnabled false.
      // Show a warning instead of crashing, especially important for XP.
      MessageBox(0,
        PChar('Cannot enable global keyboard hook.' + sLineBreak + 'System error: ' +
        SysErrorMessage(GetLastError)),
        'Trayslate',
        MB_ICONWARNING);
      Exit;   // FEnabled stays False, FActiveInstance stays nil
    end;

    // Sync initial modifier state (in case a key was already held down)
    FLeftCtrl  := (GetAsyncKeyState(VK_LCONTROL) and $8000) <> 0;
    FRightCtrl := (GetAsyncKeyState(VK_RCONTROL) and $8000) <> 0;
    FLeftShift := (GetAsyncKeyState(VK_LSHIFT)   and $8000) <> 0;
    FRightShift:= (GetAsyncKeyState(VK_RSHIFT)   and $8000) <> 0;
    FLeftAlt   := (GetAsyncKeyState(VK_LMENU)    and $8000) <> 0;
    FRightAlt  := (GetAsyncKeyState(VK_RMENU)    and $8000) <> 0;

    // Success – mark as active
    FActiveInstance := Self;
    FEnabled := True;
  end
  else
  begin
    // Disable: only unhook if we are the active instance
    if FActiveInstance = Self then
    begin
      if FHook <> 0 then
      begin
        UnhookWindowsHookEx(FHook);
        FHook := 0;
      end;
      FActiveInstance := nil;
    end;
    FEnabled := False;
  end;
end;

// ---------- Helper methods ----------
class function TGlobalKeyboardHook.IsCtrlPressed: boolean;
begin
  Result := (GetAsyncKeyState(VK_CONTROL) and $8000) <> 0;
end;

class function TGlobalKeyboardHook.IsShiftPressed: boolean;
begin
  Result := (GetAsyncKeyState(VK_SHIFT) and $8000) <> 0;
end;

class function TGlobalKeyboardHook.IsAltPressed: boolean;
begin
  Result := (GetAsyncKeyState(VK_MENU) and $8000) <> 0;
end;

{$ELSE}

//  Non-Windows platform – stub to allow compilation

constructor TGlobalKeyboardHook.Create;
begin
  inherited;
  FEnabled := False;
  FEditFieldOnly := False;
  FBlockedKeys := [];
end;

destructor TGlobalKeyboardHook.Destroy;
begin
  inherited;
end;

procedure TGlobalKeyboardHook.SetEnabled(AValue: boolean);
begin
  if AValue then
    raise Exception.Create('GlobalKeyboardHook is only supported on Windows.');
  FEnabled := AValue;
end;

class function TGlobalKeyboardHook.IsCtrlPressed: boolean;
begin
  Result := False;
end;

class function TGlobalKeyboardHook.IsShiftPressed: boolean;
begin
  Result := False;
end;

class function TGlobalKeyboardHook.IsAltPressed: boolean;
begin
  Result := False;
end;

{$ENDIF}

end.