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;

type
  // -------------------------------------------------------------------------
  //  TSecureClipboard
  // -------------------------------------------------------------------------
  TSecureClipboard = class
  private
    FClearTimer: TTimer;
    procedure ClearTimerTick(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    // 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;

  // -------------------------------------------------------------------------
  //  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;
    FOnSystemLock: TProc;
    FOnTrayRestore: TProc;
    FOnLockRequest: TProc;
    FOnQuit: TProc;
    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;
    property SecureClipboard: TSecureClipboard read FSecureClipboard;
    property TrayAdded: Boolean read FTrayAdded;
    // 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;
  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;

// 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;

// =============================================================================
//  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;

  // 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);
end;

destructor TPMBridge.Destroy;
begin
  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
  if not FTrayAdded then
  begin
    if Shell_NotifyIcon(NIM_ADD, @FNid) then
      FTrayAdded := True;
  end;

  // 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;

  // 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
  if FTrayAdded then
  begin
    Shell_NotifyIcon(NIM_DELETE, @FNid);
    FTrayAdded := False;
  end;

  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;
  ShowWindow(LFormHwnd, SW_SHOW);
  ShowWindow(LFormHwnd, SW_RESTORE);
  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;

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

end.