Password-Manager/delphi-backend/Source/PM.Bridge.pas

unit PM.Bridge;

{
  PM.Bridge — JS↔Delphi native capability bridge.

  Three features exposed to the embedded WebView2 via cmd:// URLs:

  1. TSecureClipboard
     Sets text on the Windows clipboard alongside the
     ExcludeClipboardContentFromMonitorProcessing format, which prevents
     Win+V clipboard history from recording the password. Auto-clears
     after a configurable delay via TTimer.

  2. Tray icon (TPMBridge.MinimizeToTray / RestoreFromTray)
     Shell_NotifyIcon-based. The main window hides; a tray icon appears.
     Single-click or double-click on the tray icon restores the window.
     OnTrayRestore is called on the main thread so the caller can Show/BringToFront.

  3. Windows session-lock detection
     WTSRegisterSessionNotification on a dedicated message-only window.
     On WTS_SESSION_LOCK the bridge fires OnSystemLock (main thread) so
     the Delphi host can inject lockVault() into the WebView2.

  Both tray icon messages and WTS notifications are routed through a
  single message-only window created with AllocateHWnd, avoiding any
  subclassing of the FMX main window.
}

interface

uses
  System.SysUtils, System.Classes, System.Math,
  FMX.Types, FMX.Forms,
  Winapi.Windows, Winapi.ShellAPI, Winapi.Messages,
  PM.SingleInstance;

type
  // -------------------------------------------------------------------------
  //  TSecureClipboard
  // -------------------------------------------------------------------------
  TSecureClipboard = class
  private
    FClearTimer: TTimer;
    procedure ClearTimerTick(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    function ReadText: string;
    // Copy AText to the clipboard, excluding it from Win+V history.
    // AClearAfterMs = 0 disables auto-clear; default is 30 seconds.
    procedure SetText(const AText: string; AClearAfterMs: Integer = 30000);
    procedure Clear;
  end;

  // Distinguishes the "fill everything" hotkey (Ctrl+Shift+L) from the
  // "password only" hotkey (Ctrl+Shift+P). The host decides what to type
  // based on this kind.
  TAutofillKind = (akFull, akPasswordOnly);

  // Fired when an autofill hotkey is pressed. Args are the foreground
  // window HWND and its title (captured before any focus change), plus
  // the kind of fill requested.
  // Declared as a method pointer (not TProc<>) because Delphi has no implicit
  // conversion from "procedure of object" to "reference to procedure" — the
  // host wires this with a regular form method (BridgeAutofillRequest).
  TAutofillRequestEvent = procedure(AKind: TAutofillKind;
    ATargetHWND: HWND; const ATitle: string) of object;

  TNewEntryHotkeyEvent = procedure(const AWindowTitle: string) of object;

  // -------------------------------------------------------------------------
  //  TPMBridge
  // -------------------------------------------------------------------------
  TPMBridge = class
  private
    FMainForm: TForm;
    FMsgWindow: HWND;
    FTrayAdded: Boolean;
    FIconOwned: Boolean;   // true = we must call DestroyIcon on FIconHandle
    FIconHandle: HICON;
    FNid: TNotifyIconData;
    FPowerNotify: THandle; // registration handle from PowerRegisterSuspendResumeNotification
    FSecureClipboard: TSecureClipboard;
    FBalloonShown: Boolean;
    // Window placement captured at MinimizeToTray time. Replayed on
    // RestoreFromTray so the window comes back in the same state
    // (maximised / normal + position + size) as before hiding.
    FSavedPlacement: TWindowPlacement;
    FHasSavedPlacement: Boolean;
    FOnSystemLock: TProc;
    FOnTrayRestore: TProc;
    FOnLockRequest: TProc;
    FOnQuit: TProc;
    // Autofill: global hotkeys → inject credentials into browser. Combos
    // are user-configurable from Settings; defaults are Ctrl+Shift+L /
    // Ctrl+Shift+P. We track which IDs are actually live so unregister
    // doesn't blindly call UnregisterHotKey on unregistered IDs (which
    // would set GetLastError noise during shutdown).
    FAutofillRegistered: Boolean;
    FAutofillFullActive: Boolean;
    FAutofillPwdActive:  Boolean;
    FOnAutofillRequest: TAutofillRequestEvent;
    FDebugHotkeyRegistered: Boolean;
    FOnDebugHotkey: TProc;
    FNewEntryHotkeyRegistered: Boolean;
    FOnNewEntryHotkey: TNewEntryHotkeyEvent;
    procedure MsgWindowHandler(var AMsg: TMessage);
    procedure PrepareNid;
    procedure ShowTrayMenu;
    procedure ShowFirstTimeBalloon;
    function FindFMXAppWindow: HWND;
  public
    constructor Create(AMainForm: TForm);
    destructor Destroy; override;
    // Hide main window and show tray icon.
    procedure MinimizeToTray;
    // Restore main window and remove tray icon.
    procedure RestoreFromTray;
    // Apply Windows dark-mode title bar to the main form. Win10 19044+
    // / Win11 only — no-op on older builds. Safe to call repeatedly.
    procedure ApplyTitleBarTheme(ADark: Boolean);

    // Register the two autofill global hotkeys (full + password-only) with
    // the given Win32 modifier flags (MOD_CONTROL/MOD_SHIFT/MOD_ALT/MOD_WIN
    // bitmask) and virtual-key codes. Replaces any prior registration —
    // safe to call repeatedly to swap combos at runtime.
    // Returns True if both hotkeys registered successfully. If one or both
    // failed (clash with another app), best-effort: whichever succeeded
    // stays active.
    function SetAutofillHotkeys(AFullMods, AFullVk,
      APwdMods, APwdVk: Word): Boolean;
    // Convenience wrapper: register the historical defaults (Ctrl+Shift+L
    // and Ctrl+Shift+P). Used by the host on first start; runtime changes
    // go through SetAutofillHotkeys.
    procedure RegisterAutofillHotkey;
    // Unregister both autofill hotkeys.
    procedure UnregisterAutofillHotkey;
    // Simulate username + Tab + password keystrokes into ATargetHWND.
    // ATargetHWND = 0 → type into whatever window has focus.
    // If AUsername is empty, only the password is typed (no Tab) — matches
    // the password-only hotkey path AND avoids spurious Tab on entries
    // without a stored username.
    procedure ExecuteAutofill(ATargetHWND: HWND;
      const AUsername, APassword: string);
    property SecureClipboard: TSecureClipboard read FSecureClipboard;
    property TrayAdded: Boolean read FTrayAdded;
    property AutofillRegistered: Boolean read FAutofillRegistered;
    // Fired on main thread when Windows locks the session (WTS_SESSION_LOCK).
    property OnSystemLock: TProc read FOnSystemLock write FOnSystemLock;
    // Fired on main thread when the user clicks the tray icon.
    property OnTrayRestore: TProc read FOnTrayRestore write FOnTrayRestore;
    // Fired when the user picks "Lock vault" from the tray menu. Handler
    // should trigger the JS lockVault() (typically via ExecuteJavaScript).
    property OnLockRequest: TProc read FOnLockRequest write FOnLockRequest;
    // Fired when the user picks "Quit" from the tray menu. Handler must
    // actually terminate the app (Application.Terminate or similar) — the
    // bridge does not call it itself, so the host stays in control of
    // shutdown order (server stop, save state, etc.).
    property OnQuit: TProc read FOnQuit write FOnQuit;
    // Fired on main thread when the autofill hotkey fires.
    // Args: (ATargetHWND, AWindowTitle). Handler calls ExecuteJavaScript
    // to let JS match the title against vault entries.
    property OnAutofillRequest: TAutofillRequestEvent
      read FOnAutofillRequest write FOnAutofillRequest;
    property OnDebugHotkey: TProc
      read FOnDebugHotkey write FOnDebugHotkey;
    // Fires on Ctrl+Shift+A. Arg = foreground window title (stripped of
    // browser suffix by the JS layer before pre-fill).
    property OnNewEntryHotkey: TNewEntryHotkeyEvent
      read FOnNewEntryHotkey write FOnNewEntryHotkey;
  end;

implementation

uses
  FMX.Platform.Win;

// Win32 format name that suppresses Win+V clipboard history recording.
// Introduced in Windows 10 1809 (build 17763). Silently ignored on older builds.
const
  CLIPBOARD_EXCLUDE_FORMAT = 'ExcludeClipboardContentFromMonitorProcessing';

// Tray callback message routed to our message-only window.
const
  WM_TRAY_ICON = WM_APP + 1;

// WTS session change message and state constants (declared here to avoid
// a hard dependency on Winapi.WtsApi32 which varies across Delphi versions).
const
  WM_WTSSESSION_CHANGE    = $02B1;
  WTS_SESSION_LOCK        = 7;
  NOTIFY_FOR_THIS_SESSION = 0;

// Power management broadcast — sent to all top-level windows when the
// system is about to sleep / hibernate or has just resumed. No explicit
// registration needed (unlike WTS).
// PBT_APMSUSPEND ($04) : "system is suspending operation" — fires once,
//   right before sleep/hibernate. This is our lock trigger.
// PBT_APMRESUMEAUTOMATIC ($12) : system resumed (we don't need to act).
// PBT_APMRESUMESUSPEND ($07) : system resumed with user interaction.
const
  WM_POWERBROADCAST       = $0218;
  PBT_APMSUSPEND          = $0004;
  PBT_APMRESUMEAUTOMATIC  = $0012;
  PBT_APMRESUMESUSPEND    = $0007;

// Autofill hotkeys — Ctrl+Shift+L (full) and Ctrl+Shift+P (password only).
// IDs must not clash with other RegisterHotKey calls in this process;
// 42-43 are arbitrary and well outside the range used by FMX internals.
const
  AUTOFILL_HOTKEY_ID_FULL    = 42;  // Ctrl+Shift+L → user + Tab + password
  AUTOFILL_HOTKEY_ID_PWDONLY = 43;  // Ctrl+Shift+P → password only
  DEBUG_HOTKEY_ID            = 44;  // Ctrl+Shift+D → toggle debug panel
  NEW_ENTRY_HOTKEY_ID        = 45;  // Ctrl+Shift+A → quick-add from window title
  AF_MOD_CONTROL             = $0002;  // same value as MOD_CONTROL
  AF_MOD_SHIFT               = $0004;  // same value as MOD_SHIFT

// Dynamic WTS function pointers — wtsapi32.dll is not guaranteed on all
// Windows SKUs (e.g. minimal Server Core without Session Services), so
// we load it at runtime and tolerate absence gracefully.
var
  _WTSRegister  : function(hWnd: HWND; dwFlags: DWORD): BOOL; stdcall = nil;
  _WTSUnregister: function(hWnd: HWND): BOOL; stdcall = nil;
  _WtsApiLoaded : Boolean = False;
  _WtsLib       : HMODULE = 0;

procedure LoadWtsApi;
begin
  if _WtsApiLoaded then Exit;
  _WtsApiLoaded := True;
  _WtsLib := LoadLibrary('wtsapi32.dll');
  if _WtsLib = 0 then Exit;
  _WTSRegister   := GetProcAddress(_WtsLib, 'WTSRegisterSessionNotification');
  _WTSUnregister := GetProcAddress(_WtsLib, 'WTSUnRegisterSessionNotification');
end;

// Power notification registration (Windows 8+). Forces delivery of
// WM_POWERBROADCAST to a specific HWND, including non-top-level / hidden
// utility windows that Windows might otherwise skip. Exported from user32.
const
  DEVICE_NOTIFY_WINDOW_HANDLE = 0;

var
  _PowerRegister  : function(Flags: DWORD; Recipient: THandle;
    out RegistrationHandle: THandle): DWORD; stdcall = nil;
  _PowerUnregister: function(RegistrationHandle: THandle): DWORD; stdcall = nil;
  _PowerApiLoaded : Boolean = False;

procedure LoadPowerApi;
var
  LLib: HMODULE;
begin
  if _PowerApiLoaded then Exit;
  _PowerApiLoaded := True;
  // Functions live in user32.dll despite the "Power" prefix.
  LLib := GetModuleHandle('user32.dll');
  if LLib = 0 then Exit;
  _PowerRegister   := GetProcAddress(LLib, 'PowerRegisterSuspendResumeNotification');
  _PowerUnregister := GetProcAddress(LLib, 'PowerUnregisterSuspendResumeNotification');
end;

// =============================================================================
//  TSecureClipboard
// =============================================================================

constructor TSecureClipboard.Create;
begin
  inherited;
  FClearTimer := TTimer.Create(nil);
  FClearTimer.Enabled := False;
  FClearTimer.OnTimer := ClearTimerTick;
end;

destructor TSecureClipboard.Destroy;
begin
  FClearTimer.Free;
  inherited;
end;

procedure TSecureClipboard.ClearTimerTick(Sender: TObject);
begin
  FClearTimer.Enabled := False;
  Clear;
end;

procedure TSecureClipboard.SetText(const AText: string; AClearAfterMs: Integer);
var
  CFExclude: UINT;
  LMem: THandle;       // HGLOBAL — renamed to avoid Pascal's case-insensitive
                       // collision with the HGLOBAL type identifier.
  LDest: Pointer;
  LByteCount: NativeUInt;
begin
  FClearTimer.Enabled := False;

  // Register (or look up if already registered) the exclusion format.
  CFExclude := RegisterClipboardFormat(CLIPBOARD_EXCLUDE_FORMAT);

  LByteCount := NativeUInt(Length(AText) + 1) * SizeOf(Char);
  LMem := GlobalAlloc(GMEM_MOVEABLE, LByteCount);
  if LMem = 0 then Exit;

  LDest := GlobalLock(LMem);
  try
    Move(PChar(AText)^, LDest^, LByteCount);
  finally
    GlobalUnlock(LMem);
  end;

  if not OpenClipboard(0) then
  begin
    GlobalFree(LMem);
    Exit;
  end;
  try
    EmptyClipboard;
    // CF_UNICODETEXT ownership is transferred to the clipboard on success.
    if SetClipboardData(CF_UNICODETEXT, LMem) = 0 then
      GlobalFree(LMem);
    // Exclusion marker: presence of this format is the signal to Windows;
    // the data handle is nil and ignored by the subsystem.
    SetClipboardData(CFExclude, 0);
  finally
    CloseClipboard;
  end;

  if AClearAfterMs > 0 then
  begin
    FClearTimer.Interval := AClearAfterMs;
    FClearTimer.Enabled := True;
  end;
end;

procedure TSecureClipboard.Clear;
begin
  if OpenClipboard(0) then
  try
    EmptyClipboard;
  finally
    CloseClipboard;
  end;
end;

function TSecureClipboard.ReadText: string;
var
  H: THandle;
  P: PChar;
begin
  Result := '';
  if not OpenClipboard(0) then Exit;
  try
    H := GetClipboardData(CF_UNICODETEXT);
    if H = 0 then Exit;
    P := PChar(GlobalLock(H));
    if P <> nil then
    try
      Result := P;
    finally
      GlobalUnlock(H);
    end;
  finally
    CloseClipboard;
  end;
end;

// =============================================================================
//  TPMBridge
// =============================================================================

constructor TPMBridge.Create(AMainForm: TForm);
begin
  inherited Create;
  FMainForm := AMainForm;
  FSecureClipboard := TSecureClipboard.Create;
  FTrayAdded := False;
  FBalloonShown := False;

  // Dedicated message-only window for tray + WTS notifications.
  FMsgWindow := AllocateHWnd(MsgWindowHandler);

  PrepareNid;

  // Add the tray icon eagerly so it's visible from app startup, regardless
  // of whether the window is shown or hidden. Without this, the tray icon
  // only appears the first time the user minimizes — meaning fresh-launch
  // users can't lock/quit from the tray and discover the feature only by
  // accident. NIM_DELETE is now only called at shutdown.
  if Shell_NotifyIcon(NIM_ADD, @FNid) then
    FTrayAdded := True;

  // Session-lock detection (fails silently if wtsapi32.dll is absent).
  LoadWtsApi;
  if Assigned(_WTSRegister) then
    _WTSRegister(FMsgWindow, NOTIFY_FOR_THIS_SESSION);

  // Sleep/hibernate detection. Forces WM_POWERBROADCAST delivery to our
  // message-only window even if Windows would otherwise skip it. On
  // Windows < 8 this fails silently — only modern systems support this
  // API, but they're also the ones that have aggressive sleep behavior.
  FPowerNotify := 0;
  LoadPowerApi;
  if Assigned(_PowerRegister) then
    _PowerRegister(DEVICE_NOTIFY_WINDOW_HANDLE, FMsgWindow, FPowerNotify);

  FDebugHotkeyRegistered := RegisterHotKey(FMsgWindow, DEBUG_HOTKEY_ID,
    AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('D'));
  FNewEntryHotkeyRegistered := RegisterHotKey(FMsgWindow, NEW_ENTRY_HOTKEY_ID,
    AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('A'));
end;

destructor TPMBridge.Destroy;
begin
  if FDebugHotkeyRegistered then
    UnregisterHotKey(FMsgWindow, DEBUG_HOTKEY_ID);

  if FNewEntryHotkeyRegistered then
    UnregisterHotKey(FMsgWindow, NEW_ENTRY_HOTKEY_ID);

  if (FPowerNotify <> 0) and Assigned(_PowerUnregister) then
    _PowerUnregister(FPowerNotify);

  if Assigned(_WTSUnregister) then
    _WTSUnregister(FMsgWindow);

  if FTrayAdded then
  begin
    Shell_NotifyIcon(NIM_DELETE, @FNid);
    FTrayAdded := False;
  end;

  if FIconOwned and (FIconHandle <> 0) then
    DestroyIcon(FIconHandle);

  DeallocateHWnd(FMsgWindow);
  FSecureClipboard.Free;
  inherited;
end;

procedure TPMBridge.PrepareNid;
var
  LargeIcon, SmallIcon: HICON;
begin
  // Attempt to extract the small (16×16) icon from the exe.
  // ExtractIconEx returns the number of icons extracted.
  LargeIcon := 0;
  SmallIcon := 0;
  FIconOwned := False;
  if ExtractIconEx(PChar(ParamStr(0)), 0, LargeIcon, SmallIcon, 1) > 0 then
  begin
    if LargeIcon <> 0 then DestroyIcon(LargeIcon); // we only need the small one
    if SmallIcon <> 0 then
    begin
      FIconHandle := SmallIcon;
      FIconOwned := True;
    end;
  end;
  if FIconHandle = 0 then
    FIconHandle := LoadIcon(0, IDI_APPLICATION); // shared system icon, never destroy

  FillChar(FNid, SizeOf(FNid), 0);
  FNid.cbSize           := SizeOf(FNid);
  FNid.Wnd              := FMsgWindow;
  FNid.uID              := 1;
  FNid.uFlags           := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  FNid.uCallbackMessage := WM_TRAY_ICON;
  FNid.hIcon            := FIconHandle;
  // szTip: array[0..127] of WideChar — copy tooltip text safely.
  Move(PChar('Password Manager')^, FNid.szTip[0],
       Min(Length('Password Manager'), High(FNid.szTip)) * SizeOf(Char));
end;

function MainFormHWND(AForm: TForm): HWND;
begin
  Result := WindowHandleToPlatform(AForm.Handle).Wnd;
end;

function TPMBridge.FindFMXAppWindow: HWND;
var
  LWnd: HWND;
  LWndPid, LCurrentPid: DWORD;
begin
  // FMX on Windows creates a hidden per-process window of class "TFMAppClass"
  // that owns the application's taskbar entry — NOT the form's HWND.
  // Hiding the form (via ShowWindow / Visible := False / WS_EX_TOOLWINDOW /
  // ITaskbarList.DeleteTab) is therefore ineffective at removing the taskbar
  // entry: those calls target the wrong window. The correct fix is to find
  // the TFMAppClass window owned by our process and hide IT.
  // Reference: https://stackoverflow.com/q/16768986
  Result := 0;
  LCurrentPid := GetCurrentProcessId;
  LWnd := 0;
  repeat
    LWnd := FindWindowEx(0, LWnd, 'TFMAppClass', nil);
    if LWnd <> 0 then
    begin
      LWndPid := 0;
      GetWindowThreadProcessId(LWnd, LWndPid);
      if LWndPid = LCurrentPid then
        Exit(LWnd);
    end;
  until LWnd = 0;
end;

procedure TPMBridge.MinimizeToTray;
var
  LFormHwnd, LAppHwnd: HWND;
begin
  // Tray icon is added at construction time and persists for the app's
  // lifetime — no NIM_ADD here.

  // Extra safety: clear the clipboard immediately when the user minimizes,
  // rather than waiting for the 30s auto-clear timer to fire. A password
  // the user just copied shouldn't sit in the clipboard while the app is
  // out of sight.
  FSecureClipboard.Clear;

  LFormHwnd := MainFormHWND(FMainForm);
  LAppHwnd  := FindFMXAppWindow;

  // 0. Snapshot the window placement BEFORE hiding so RestoreFromTray can
  //    replay the exact same state (maximised / normal + size + position).
  //    Without this, ShowWindow(SW_RESTORE) below always returns to the
  //    "normal" state — a window that was maximised before hiding comes
  //    back un-maximised.
  FillChar(FSavedPlacement, SizeOf(FSavedPlacement), 0);
  FSavedPlacement.length := SizeOf(FSavedPlacement);
  FHasSavedPlacement := GetWindowPlacement(LFormHwnd, @FSavedPlacement);

  // 1. Hide the visible form via both FMX state and Win32 ShowWindow.
  //    Keeps the form invisible to the user.
  FMainForm.Hide;
  ShowWindow(LFormHwnd, SW_HIDE);

  // 2. Hide the FMX application proxy window (TFMAppClass). THIS is what
  //    removes the entry from the taskbar — the form's HWND was never the
  //    taskbar-visible one in FMX.
  if LAppHwnd <> 0 then
    ShowWindow(LAppHwnd, SW_HIDE);

  // 3. First-time only: pop a balloon notification so the user knows the
  //    app is still running in the tray (and didn't crash).
  if not FBalloonShown then
  begin
    ShowFirstTimeBalloon;
    FBalloonShown := True;
  end;
end;

procedure TPMBridge.ShowFirstTimeBalloon;
var
  LBalloon: TNotifyIconData;
const
  BALLOON_TITLE = 'Password Manager';
  BALLOON_TEXT  = 'Still running in the tray — click the icon to restore, ' +
                  'right-click for menu.';
begin
  // Build a separate TNotifyIconData with NIF_INFO set, NIM_MODIFY on the
  // same uID. szInfo/szInfoTitle carry the balloon content. NIIF_INFO
  // gives the system info icon — no scary warning glyph.
  FillChar(LBalloon, SizeOf(LBalloon), 0);
  LBalloon.cbSize := SizeOf(LBalloon);
  LBalloon.Wnd    := FMsgWindow;
  LBalloon.uID    := 1;
  LBalloon.uFlags := NIF_INFO;
  Move(PChar(BALLOON_TITLE)^, LBalloon.szInfoTitle[0],
       Min(Length(BALLOON_TITLE), High(LBalloon.szInfoTitle)) * SizeOf(Char));
  Move(PChar(BALLOON_TEXT)^, LBalloon.szInfo[0],
       Min(Length(BALLOON_TEXT), High(LBalloon.szInfo)) * SizeOf(Char));
  LBalloon.dwInfoFlags := NIIF_INFO;
  Shell_NotifyIcon(NIM_MODIFY, @LBalloon);
end;

procedure TPMBridge.RestoreFromTray;
var
  LFormHwnd, LAppHwnd: HWND;
begin
  // Tray icon stays in the tray — we only show the window again.
  LFormHwnd := MainFormHWND(FMainForm);
  LAppHwnd  := FindFMXAppWindow;

  // Reverse order: show the app proxy first so the taskbar entry comes back,
  // then show and foreground the form.
  if LAppHwnd <> 0 then
    ShowWindow(LAppHwnd, SW_SHOW);

  FMainForm.Show;

  // Restore to the exact pre-tray state (maximised/normal + size + pos).
  // Falls back to SW_RESTORE if we never captured a placement (e.g. tray
  // restore was triggered without a prior MinimizeToTray call).
  if FHasSavedPlacement then
  begin
    // showCmd governs whether the window comes back maximised or normal;
    // it's what SW_RESTORE clobbers. We force it ourselves.
    if FSavedPlacement.showCmd = SW_SHOWMINIMIZED then
      FSavedPlacement.showCmd := SW_SHOWNORMAL;  // never restore as minimised
    SetWindowPlacement(LFormHwnd, @FSavedPlacement);
  end
  else
  begin
    ShowWindow(LFormHwnd, SW_SHOW);
    ShowWindow(LFormHwnd, SW_RESTORE);
  end;
  SetForegroundWindow(LFormHwnd);
end;

procedure TPMBridge.ShowTrayMenu;
const
  ID_OPEN = 1;
  ID_LOCK = 2;
  ID_QUIT = 3;
var
  LMenu: HMENU;
  LPt: TPoint;
  LCmd: Cardinal;
begin
  LMenu := CreatePopupMenu;
  if LMenu = 0 then Exit;
  try
    AppendMenu(LMenu, MF_STRING, ID_OPEN, 'Open');
    AppendMenu(LMenu, MF_STRING, ID_LOCK, 'Lock vault');
    AppendMenu(LMenu, MF_SEPARATOR, 0, nil);
    AppendMenu(LMenu, MF_STRING, ID_QUIT, 'Quit');

    GetCursorPos(LPt);
    // SetForegroundWindow + WM_NULL post is the canonical Win32 workaround
    // that lets TrackPopupMenu auto-dismiss when the user clicks elsewhere.
    // Without it, the menu can become "sticky" on a hidden window.
    SetForegroundWindow(FMsgWindow);
    // Delphi's TrackPopupMenu is declared as returning BOOL, but with
    // TPM_RETURNCMD it actually returns the selected menu item ID (or 0).
    // Cast through the declared return type to read the real value.
    LCmd := Cardinal(TrackPopupMenu(LMenu,
      TPM_RETURNCMD or TPM_RIGHTBUTTON or TPM_NONOTIFY,
      LPt.X, LPt.Y, 0, FMsgWindow, nil));
    PostMessage(FMsgWindow, WM_NULL, 0, 0);

    case LCmd of
      ID_OPEN: if Assigned(FOnTrayRestore)  then FOnTrayRestore();
      ID_LOCK: if Assigned(FOnLockRequest) then FOnLockRequest();
      ID_QUIT: if Assigned(FOnQuit)         then FOnQuit();
    end;
  finally
    DestroyMenu(LMenu);
  end;
end;

procedure TPMBridge.MsgWindowHandler(var AMsg: TMessage);
var
  LMouseEvent: Word;
begin
  // AllocateHWnd creates the window on the thread that called it (here: the
  // main thread, since TPMBridge.Create runs from FormCreate). Windows
  // dispatches messages on the owning thread, so this handler is already
  // on the main thread — no need to marshal via TThread.Queue/ForceQueue.
  if AMsg.Msg = WM_TRAY_ICON then
  begin
    // For Shell_NotifyIcon callback messages, the mouse event is in the
    // low word of LParam (regardless of NOTIFYICON_VERSION). Extracting
    // it via LOWORD is more portable than comparing the full LPARAM.
    LMouseEvent := Word(AMsg.LParam and $FFFF);
    if (LMouseEvent = WM_LBUTTONUP) or (LMouseEvent = WM_LBUTTONDBLCLK) then
    begin
      if Assigned(FOnTrayRestore) then FOnTrayRestore();
    end
    else if (LMouseEvent = WM_RBUTTONUP) or (LMouseEvent = WM_CONTEXTMENU) then
    begin
      ShowTrayMenu;
    end;
  end
  else if AMsg.Msg = WM_WTSSESSION_CHANGE then
  begin
    if AMsg.WParam = WTS_SESSION_LOCK then
      if Assigned(FOnSystemLock) then FOnSystemLock();
  end

  else if AMsg.Msg = WM_POWERBROADCAST then
  begin
    // Sleep/hibernate fires PBT_APMSUSPEND. Treat it identically to a
    // session lock: the user is leaving the machine unattended, so the
    // vault must be locked. Without this, closing a laptop lid (which
    // doesn't always trigger WTS_SESSION_LOCK if the system goes straight
    // to sleep) would leave the decrypted state in memory until resume.
    // PBT_APMSUSPEND is delivered SYNCHRONOUSLY before the system
    // suspends — fast handler required (no UI prompts, no network).
    if AMsg.WParam = PBT_APMSUSPEND then
      if Assigned(FOnSystemLock) then FOnSystemLock();
  end

  else if (AMsg.Msg <> 0) and (AMsg.Msg = WM_PMShowMessage) then
  begin
    // A second instance was launched and PostMessage'd HWND_BROADCAST.
    // Bring our window back to the front instead of letting that second
    // process spawn its own UI.
    if Assigned(FOnTrayRestore) then FOnTrayRestore();
  end

  else if (AMsg.Msg = WM_HOTKEY) and (AMsg.WParam = DEBUG_HOTKEY_ID) then
  begin
    if Assigned(FOnDebugHotkey) then FOnDebugHotkey();
  end

  else if (AMsg.Msg = WM_HOTKEY) and (AMsg.WParam = NEW_ENTRY_HOTKEY_ID) then
  begin
    if Assigned(FOnNewEntryHotkey) then
    begin
      var LTarget := GetForegroundWindow;
      var LTitle: string;
      SetLength(LTitle, 512);
      var LLen := GetWindowTextW(LTarget, PChar(LTitle), 512);
      SetLength(LTitle, LLen);
      FOnNewEntryHotkey(LTitle);
    end;
  end

  else if (AMsg.Msg = WM_HOTKEY) and Assigned(FOnAutofillRequest) and
          ((AMsg.WParam = AUTOFILL_HOTKEY_ID_FULL) or
           (AMsg.WParam = AUTOFILL_HOTKEY_ID_PWDONLY)) then
  begin
    // Capture the foreground window BEFORE any focus change, then fire the
    // callback so the host can match the title against vault entries.
    var LKind: TAutofillKind;
    if AMsg.WParam = AUTOFILL_HOTKEY_ID_PWDONLY then
      LKind := akPasswordOnly
    else
      LKind := akFull;
    var LTarget := GetForegroundWindow;
    var LTitle: string;
    SetLength(LTitle, 512);
    var LLen := GetWindowTextW(LTarget, PChar(LTitle), 512);
    SetLength(LTitle, LLen);
    FOnAutofillRequest(LKind, LTarget, LTitle);
  end;

  AMsg.Result := DefWindowProc(FMsgWindow, AMsg.Msg, AMsg.WParam, AMsg.LParam);
end;

// =============================================================================
//  TPMBridge — Autofill hotkey + SendInput
// =============================================================================

function TPMBridge.SetAutofillHotkeys(AFullMods, AFullVk,
  APwdMods, APwdVk: Word): Boolean;
begin
  // Tear down whatever is currently registered before installing the new
  // combos. RegisterHotKey would fail if the same ID is already taken.
  if FAutofillFullActive then
  begin
    UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_FULL);
    FAutofillFullActive := False;
  end;
  if FAutofillPwdActive then
  begin
    UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_PWDONLY);
    FAutofillPwdActive := False;
  end;

  // Best-effort registration. A failure (typically MOD_x clash with another
  // app's global hotkey) is silent: the other slot can still be live.
  if (AFullVk <> 0) and (AFullMods <> 0) then
    FAutofillFullActive := RegisterHotKey(FMsgWindow,
      AUTOFILL_HOTKEY_ID_FULL, AFullMods, AFullVk);
  if (APwdVk <> 0) and (APwdMods <> 0) then
    FAutofillPwdActive := RegisterHotKey(FMsgWindow,
      AUTOFILL_HOTKEY_ID_PWDONLY, APwdMods, APwdVk);

  FAutofillRegistered := FAutofillFullActive or FAutofillPwdActive;
  Result := FAutofillFullActive and FAutofillPwdActive;
end;

procedure TPMBridge.ApplyTitleBarTheme(ADark: Boolean);
const
  DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
  // uxtheme.dll private API, stable since Win10 1809. File Explorer, Edge
  // and Office use this to opt their UI (including popup menus, scrollbars,
  // tooltips) into dark mode. Signature changed in 1903 to take an enum:
  //   0=Default 1=AllowDark 2=ForceDark 3=ForceLight 4=Max
  // We use ForceDark / ForceLight for unambiguous behaviour.
  APPMODE_DEFAULT     = 0;
  APPMODE_FORCE_DARK  = 2;
  APPMODE_FORCE_LIGHT = 3;
type
  TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD;
    pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
  TSetPreferredAppMode  = function(AppMode: Integer): Integer; stdcall;
  TFlushMenuThemes      = procedure; stdcall;
var
  DwmLib, UxLib: HMODULE;
  DwmSetWindowAttribute: TDwmSetWindowAttribute;
  SetPreferredAppMode:   TSetPreferredAppMode;
  FlushMenuThemes:       TFlushMenuThemes;
  DarkFlag: BOOL;
  FormHwnd: HWND;
begin
  if FMainForm = nil then Exit;
  FormHwnd := MainFormHWND(FMainForm);
  if FormHwnd = 0 then Exit;

  // 1. Title bar (DWM immersive dark mode).
  DwmLib := LoadLibrary('dwmapi.dll');
  if DwmLib <> 0 then
  try
    @DwmSetWindowAttribute := GetProcAddress(DwmLib, 'DwmSetWindowAttribute');
    if Assigned(DwmSetWindowAttribute) then
    begin
      DarkFlag := ADark;
      DwmSetWindowAttribute(FormHwnd, DWMWA_USE_IMMERSIVE_DARK_MODE,
        @DarkFlag, SizeOf(DarkFlag));
    end;
  finally
    FreeLibrary(DwmLib);
  end;

  // 2. App-wide preferred mode (themes popup menus, scrollbars, tooltips).
  //    Loaded by ordinal because the functions are not exported by name.
  UxLib := LoadLibrary('uxtheme.dll');
  if UxLib <> 0 then
  try
    @SetPreferredAppMode := GetProcAddress(UxLib, MAKEINTRESOURCE(135));
    @FlushMenuThemes     := GetProcAddress(UxLib, MAKEINTRESOURCE(136));
    if Assigned(SetPreferredAppMode) then
    begin
      if ADark then SetPreferredAppMode(APPMODE_FORCE_DARK)
      else          SetPreferredAppMode(APPMODE_FORCE_LIGHT);
      if Assigned(FlushMenuThemes) then FlushMenuThemes;
    end;
  finally
    FreeLibrary(UxLib);
  end;
end;

procedure TPMBridge.RegisterAutofillHotkey;
begin
  // Convenience default — Ctrl+Shift+L (full) + Ctrl+Shift+P (password).
  // Idempotent: calling twice with the same combos is harmless.
  SetAutofillHotkeys(AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('L'),
                     AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('P'));
end;

procedure TPMBridge.UnregisterAutofillHotkey;
begin
  if FAutofillFullActive then
  begin
    UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_FULL);
    FAutofillFullActive := False;
  end;
  if FAutofillPwdActive then
  begin
    UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_PWDONLY);
    FAutofillPwdActive := False;
  end;
  FAutofillRegistered := False;
end;

// Block until the user releases Ctrl, Shift, Alt, and Win, or until ATimeoutMs
// elapses. Without this, an autofill triggered by Ctrl+Shift+L injects
// keystrokes WHILE Ctrl+Shift are physically held — turning our Tab into
// Ctrl+Tab (next tab in Chrome), our 's' into Ctrl+S, etc. 1000 ms is a
// generous bound; typical release happens within 50-150 ms.
procedure WaitForModifierRelease(ATimeoutMs: Cardinal);
var
  LStart: Cardinal;
begin
  LStart := GetTickCount;
  while  ((GetAsyncKeyState(VK_CONTROL) and $8000) <> 0)
      or ((GetAsyncKeyState(VK_SHIFT)   and $8000) <> 0)
      or ((GetAsyncKeyState(VK_MENU)    and $8000) <> 0)    // Alt
      or ((GetAsyncKeyState(VK_LWIN)    and $8000) <> 0)
      or ((GetAsyncKeyState(VK_RWIN)    and $8000) <> 0) do
  begin
    Sleep(15);
    if GetTickCount - LStart > ATimeoutMs then Break;
  end;
end;

// Build (and immediately send) a key-down+up pair for each char in AText
// using KEYEVENTF_UNICODE. Returns nothing — best-effort.
procedure SendUnicodeString(const AText: string);
var
  LInputs: TArray<TInput>;
  LCount, I: Integer;
begin
  if AText = '' then Exit;
  SetLength(LInputs, Length(AText) * 2);
  LCount := 0;
  for I := 1 to Length(AText) do
  begin
    FillChar(LInputs[LCount],     SizeOf(TInput), 0);
    FillChar(LInputs[LCount + 1], SizeOf(TInput), 0);
    LInputs[LCount].Itype      := INPUT_KEYBOARD;
    LInputs[LCount].ki.wScan   := Ord(AText[I]);
    LInputs[LCount].ki.dwFlags := KEYEVENTF_UNICODE;
    LInputs[LCount + 1]            := LInputs[LCount];
    LInputs[LCount + 1].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;
    Inc(LCount, 2);
  end;
  SendInput(LCount, @LInputs[0], SizeOf(TInput));
end;

// Send one virtual-key press (down+up).
procedure SendVKey(AVk: Word);
var
  LInputs: array[0..1] of TInput;
begin
  FillChar(LInputs, SizeOf(LInputs), 0);
  LInputs[0].Itype      := INPUT_KEYBOARD;
  LInputs[0].ki.wVk     := AVk;
  LInputs[1]            := LInputs[0];
  LInputs[1].ki.dwFlags := KEYEVENTF_KEYUP;
  SendInput(2, @LInputs[0], SizeOf(TInput));
end;

procedure SendSelectAllAndDelete;
var
  LInputs: array[0..5] of TInput;
begin
  FillChar(LInputs, SizeOf(LInputs), 0);
  LInputs[0].Itype  := INPUT_KEYBOARD;
  LInputs[0].ki.wVk := VK_CONTROL;
  LInputs[1].Itype  := INPUT_KEYBOARD;
  LInputs[1].ki.wVk := Ord('A');
  LInputs[2].Itype  := INPUT_KEYBOARD;
  LInputs[2].ki.wVk := Ord('A');
  LInputs[2].ki.dwFlags := KEYEVENTF_KEYUP;
  LInputs[3].Itype  := INPUT_KEYBOARD;
  LInputs[3].ki.wVk := VK_CONTROL;
  LInputs[3].ki.dwFlags := KEYEVENTF_KEYUP;
  LInputs[4].Itype  := INPUT_KEYBOARD;
  LInputs[4].ki.wVk := VK_DELETE;
  LInputs[5]        := LInputs[4];
  LInputs[5].ki.dwFlags := KEYEVENTF_KEYUP;
  SendInput(6, @LInputs[0], SizeOf(TInput));
end;

// Always-attach foreground switch. The early SetForegroundWindow shortcut
// was unreliable after the picker click — Win10/11 still refused the focus
// hand-off even when our process was foreground. Always doing the attach
// dance is slightly slower but actually works.
function ForceForegroundWindow(ATargetHwnd: HWND): Boolean;
const
  ForegroundPollIntervalMs = 20;
  ForegroundPollTimeoutMs  = 600;
var
  CallerThread, TargetThread, TargetPid: DWORD;
  ThreadsAttached: Boolean;
  WaitStart: Cardinal;
begin
  Result := False;
  if (ATargetHwnd = 0) or not IsWindow(ATargetHwnd) then Exit;

  TargetPid    := 0;
  TargetThread := GetWindowThreadProcessId(ATargetHwnd, TargetPid);
  CallerThread := GetCurrentThreadId;
  if TargetThread = 0 then Exit;

  ThreadsAttached := (TargetThread <> CallerThread) and
                     AttachThreadInput(CallerThread, TargetThread, True);
  try
    if IsIconic(ATargetHwnd) then
      ShowWindow(ATargetHwnd, SW_RESTORE);
    BringWindowToTop(ATargetHwnd);
    SetWindowPos(ATargetHwnd, HWND_TOP, 0, 0, 0, 0,
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
    SetForegroundWindow(ATargetHwnd);

    WaitStart := GetTickCount;
    while GetForegroundWindow <> ATargetHwnd do
    begin
      if GetTickCount - WaitStart > ForegroundPollTimeoutMs then Break;
      Sleep(ForegroundPollIntervalMs);
      SetForegroundWindow(ATargetHwnd);
    end;
    Result := GetForegroundWindow = ATargetHwnd;
  finally
    if ThreadsAttached then
      AttachThreadInput(CallerThread, TargetThread, False);
  end;
end;

procedure ClickTargetCenterToGrabFocus(ATargetHwnd: HWND);
const
  PostClickSettleMs = 40;
var
  WindowRect: TRect;
  CenterAbsX, CenterAbsY, ScreenW, ScreenH: Integer;
  SavedCursor: TPoint;
  MouseInputs: array[0..2] of TInput;
begin
  if (ATargetHwnd = 0) or not IsWindow(ATargetHwnd) then Exit;
  if not GetWindowRect(ATargetHwnd, WindowRect) then Exit;

  CenterAbsX := (WindowRect.Left + WindowRect.Right)  div 2;
  CenterAbsY := (WindowRect.Top  + WindowRect.Bottom) div 2;
  ScreenW    := GetSystemMetrics(SM_CXSCREEN);
  ScreenH    := GetSystemMetrics(SM_CYSCREEN);
  if (ScreenW <= 0) or (ScreenH <= 0) then Exit;

  GetCursorPos(SavedCursor);

  FillChar(MouseInputs, SizeOf(MouseInputs), 0);
  MouseInputs[0].Itype     := INPUT_MOUSE;
  MouseInputs[0].mi.dx     := (CenterAbsX * 65535) div ScreenW;
  MouseInputs[0].mi.dy     := (CenterAbsY * 65535) div ScreenH;
  MouseInputs[0].mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or MOUSEEVENTF_LEFTDOWN;
  MouseInputs[1]           := MouseInputs[0];
  MouseInputs[1].mi.dwFlags:= MOUSEEVENTF_LEFTUP;
  MouseInputs[2].Itype     := INPUT_MOUSE;
  MouseInputs[2].mi.dx     := (SavedCursor.X * 65535) div ScreenW;
  MouseInputs[2].mi.dy     := (SavedCursor.Y * 65535) div ScreenH;
  MouseInputs[2].mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
  SendInput(3, @MouseInputs[0], SizeOf(TInput));

  Sleep(PostClickSettleMs);
end;

procedure TPMBridge.ExecuteAutofill(ATargetHWND: HWND;
  const AUsername, APassword: string);
const
  MinimizeSettleMs   = 80;
  FocusSettleDelayMs = 120;
var
  OwnFormHwnd: HWND;
begin
  OwnFormHwnd := MainFormHWND(FMainForm);
  if GetForegroundWindow = OwnFormHwnd then
  begin
    ShowWindow(OwnFormHwnd, SW_MINIMIZE);
    Sleep(MinimizeSettleMs);
  end;

  if ATargetHWND <> 0 then
    ForceForegroundWindow(ATargetHWND);

  WaitForModifierRelease(1000);
  Sleep(FocusSettleDelayMs);

  if AUsername = '' then
  begin
    SendSelectAllAndDelete;
    Sleep(60);
    SendUnicodeString(APassword);
    Exit;
  end;

  SendSelectAllAndDelete;
  Sleep(60);
  SendUnicodeString(AUsername);
  Sleep(200);
  SendVKey(VK_TAB);
  Sleep(200);
  SendSelectAllAndDelete;
  Sleep(60);
  SendUnicodeString(APassword);
end;

end.