Zaki/Password-Manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: Delphi backend + JS↔Delphi bridge (clipboard, tray, auto-lock)

Browse Source 
Introduces the Delphi 12 FMX backend (PMServer) that hosts the embedded
WebView2 vault on 127.0.0.1, and a native bridge between JS and Delphi
that wires three privacy-focused features:

1. Secure clipboard
   Copying a password registers the Win32 "ExcludeClipboardContentFromMonitorProcessing"
   format alongside CF_UNICODETEXT, so Win+V clipboard history never sees
   the value. Auto-clears after 30s via TTimer. Bridge.copySecure() in
   app.js routes all password/username/secret copy paths through the
   native layer when running inside the Delphi WebView2 (falls back to
   navigator.clipboard for the PHP standalone).

2. Tray icon (X-to-tray when server running)
   Closing the dev panel hides both the form HWND and the TFMAppClass
   per-process proxy window that owns the FMX taskbar entry — the form's
   HWND alone is not the taskbar-visible one in FMX (took some iteration
   to discover). Tray menu: Open, Lock vault, Quit. Clipboard is force-
   cleared on minimize as extra safety. First-time minimize fires a
   balloon notification so the user knows the app is still running.

3. Auto-lock on Windows session lock (Win+L)
   wtsapi32.dll!WTSRegisterSessionNotification on a dedicated message-only
   window. On WM_WTSSESSION_CHANGE / WTS_SESSION_LOCK, the bridge calls
   ExecuteJavaScript('lockVault()'). Same path used by the tray "Lock vault"
   menu item.

Bridge architecture:
 - JS → Delphi via cmd:// URLs intercepted in OnBeforeNavigate
   (pattern lifted from DeskInsight Monaco). Currently exposes
   cmd://clipboard/copy?text=...&clear=... and cmd://clipboard/clear.
 - Delphi → JS via TTMSFNCWebBrowser.ExecuteJavaScript with guarded
   calls (typeof check) so the bridge degrades cleanly if app.js isn't
   loaded yet.

Files:
 - Source/PM.Bridge.pas (new) — TSecureClipboard + TPMBridge
 - UMainForm.pas/.fmx — bridge wiring, FormCloseQuery intercept, tray
   callbacks (BridgeTrayRestore / BridgeLockRequest / BridgeQuit)
 - js/app.js — Bridge object, 5 navigator.clipboard sites migrated to
   Bridge.copySecure with PHP-compatible fallback, Bridge.onTrayRestore
   handler that resets the auto-lock timer

.gitignore extended with Delphi build artifacts (*.dcu, Win32/, Win64/,
__history/, __recovery/, *.identcache, *.dsk, *.local, etc.) so source
checkouts stay clean.
This commit is contained in:
Zaki
2026-05-22 23:47:57 +01:00
parent 159e02ae81
commit 506aee7e6f
28 changed files with 6172 additions and 1458 deletions
Download Patch File Download Diff File Expand all files Collapse all files
delphi-backend/Source/PM.Bridge.pas
+487
View File
@@ -0,0 +1,487 @@
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;
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;
// 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;
// =============================================================================
// 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);
end;
destructor TPMBridge.Destroy;
begin
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;
AMsg.Result := DefWindowProc(FMsgWindow, AMsg.Msg, AMsg.WParam, AMsg.LParam);
end;
end.