Files
Password-Manager/delphi-backend/UMainForm.pas
T
Zaki f047fba9a3 feat: tray quick-search + privacy hardening + race fixes
Quick search from tray
- New "Quick search…" entry in the tray context menu (between Open
  and Lock vault).
- Compact modal with live-filtered top-8 entries, arrow keys / Enter
  to copy the password (Shift+Enter copies the username instead),
  Esc to dismiss. Each row shows the favicon when cached.
- Locked vault → focus the master password input instead of opening
  the modal (same pattern as the locked-autofill-hotkey path).
- Window-state restore: Delphi remembers whether the window was
  hidden before the menu was opened and tells JS via the
  Bridge.openQuickSearch(wasHidden) arg. After the copy (or cancel)
  we hide back to the tray so the previously-foreground app comes
  back and Ctrl+V drops the password in.

Tray notifications toggle
- New Settings → Security "Show tray notifications" toggle. Gates
  Shell_NotifyIcon NIF_INFO balloons (currently only the "still
  running in the tray" first-time popup). Default ON, synced via
  settings_json so it follows the user across devices.
- PM.Bridge.ShowNotifications exposed as a public property; JS
  pushes the value on every settings sync.

Privacy: WebView2 phone-home killed
- WEBVIEW2_ADDITIONAL_BROWSER_ARGUMENTS set in the unit
  initialization section (before the TMS WebBrowser instantiates
  its CoreWebView2Environment). Disables: background networking,
  sync, component updates, breakpad/crashpad, domain reliability,
  client-side phishing detection, experiments, UMA upload,
  MediaRouter, OptimizationHints, SafeBrowsing enhanced, autofill
  server, privacy sandbox APIs. Verified via Resource Monitor: only
  127.0.0.1 connections remain (plus DDG when favicons are on).

Fixes
- Blank-window-on-launch race: the 1.5 s navigation timer assumes
  WebView2 finishes init in time, but on slow machines Edge
  Chromium needs 2-3 s and the Navigate() call is silently
  dropped. WebBrowserInitialized now also navigates if a URL is
  still pending — first to run wins.

Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
2026-06-10 19:35:37 +01:00

828 lines
29 KiB
ObjectPascal

unit UMainForm;
interface
uses
System.SysUtils, System.Classes, System.UITypes, System.NetEncoding,
System.StrUtils,
Winapi.Windows,
FMX.Forms, FMX.Controls, FMX.Controls.Presentation, FMX.StdCtrls,
FMX.Memo, FMX.Memo.Types, FMX.ScrollBox, FMX.Edit, FMX.Layouts, FMX.Types,
FMX.Dialogs, FMX.DialogService,
FMX.TMSFNCTypes, FMX.TMSFNCUtils, FMX.TMSFNCGraphics, FMX.TMSFNCGraphicsTypes,
FMX.TMSFNCCustomControl, FMX.TMSFNCWebBrowser,
PM.HTTPServer, PM.Bridge, PM.QuickUnlock, PM.UserPrefs, PM.AutoStart,
PM.Favicon,
FMX.Platform.Win; // WindowHandleToPlatform → HWND for visibility check
type
TMainForm = class(TForm)
PanelTop: TPanel;
btnStart: TButton;
btnStop: TButton;
lblStatus: TLabel;
edtPort: TEdit;
lblPort: TLabel;
btnToggleLog: TButton;
btnReload: TButton;
PanelLog: TPanel;
Memo: TMemo;
Splitter: TSplitter;
WebBrowser: TTMSFNCWebBrowser;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure btnToggleLogClick(Sender: TObject);
procedure btnReloadClick(Sender: TObject);
private
FServer: TPMHTTPServer;
FBridge: TPMBridge;
FPendingURL: string;
FNavTimer: TTimer;
FRequireAccessToken: Boolean;
FRequireProcessCheck: Boolean;
FQuitting: Boolean; // set when user picks "Quit" in tray menu — bypasses
// FormCloseQuery's minimize-to-tray intercept.
FAutofillTargetHWND: HWND; // saved at hotkey time, consumed on /execute
// Pending payload for the 60ms delay timer (focus settle before SendInput).
// Cleared inside AutofillTimerTick.
FAutofillPendingHWND: HWND;
FAutofillPendingUser: string;
FAutofillPendingPass: string;
procedure AutofillTimerTick(Sender: TObject);
procedure LogLine(const AMsg: string);
procedure UpdateButtons;
procedure NavigateToVault;
procedure NavTimerTick(Sender: TObject);
// JS↔Delphi bridge
procedure WebBrowserBeforeNavigate(Sender: TObject;
var Params: TTMSFNCCustomWebBrowserBeforeNavigateParams);
procedure HandleBridgeCommand(const ACmd, AParams: string);
procedure BridgeSystemLock;
procedure BridgeTrayRestore;
procedure BridgeLockRequest;
procedure BridgeQuit;
procedure BridgeAutofillRequest(AKind: TAutofillKind;
ATargetHWND: HWND; const ATitle: string);
procedure BridgeDebugHotkey;
procedure BridgeNewEntryHotkey(const AWindowTitle: string);
procedure BridgeQuickSearchRequest;
procedure WebBrowserInitialized(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
{$R *.fmx}
// Forward — used by WebBrowserInitialized (which sits above the actual
// definition lower in the unit).
function MaskAccessToken(const AUrl: string): string; forward;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FServer := TPMHTTPServer.Create;
FServer.OnLog := LogLine;
FBridge := TPMBridge.Create(Self);
FBridge.OnSystemLock := BridgeSystemLock;
FBridge.OnTrayRestore := BridgeTrayRestore;
FBridge.OnLockRequest := BridgeLockRequest;
FBridge.OnQuit := BridgeQuit;
FBridge.OnAutofillRequest := BridgeAutofillRequest;
FBridge.OnDebugHotkey := BridgeDebugHotkey;
FBridge.OnNewEntryHotkey := BridgeNewEntryHotkey;
FBridge.OnQuickSearchRequest := BridgeQuickSearchRequest;
FBridge.RegisterAutofillHotkey; // Ctrl+Shift+L active from startup
FBridge.ApplyTitleBarTheme(True); // dark by default, JS may toggle later
FAutofillTargetHWND := 0;
WebBrowser.OnBeforeNavigate := WebBrowserBeforeNavigate;
WebBrowser.OnInitialized := WebBrowserInitialized;
// Delayed-Navigate timer: TTMSFNCWebBrowser (WebView2 backend) ignores
// Navigate() calls until Edge Chromium finishes its async init (~1-2s).
// We wait 1.5 s after Start, then issue a SINGLE Navigate — no retry loop
// (retrying caused the loaded page to reload every interval, making icons
// flash). If Edge needed longer than 1.5 s, user clicks Reload.
FNavTimer := TTimer.Create(Self);
FNavTimer.Interval := 1500;
FNavTimer.Enabled := False;
FNavTimer.OnTimer := NavTimerTick;
UpdateButtons;
LogLine('Password Manager - Delphi backend ready.');
LogLine('Click Start to launch server + embedded web vault.');
PanelTop.Visible := False;
FRequireAccessToken := True;
FRequireProcessCheck := True;
edtPort.Text := '0';
if FileExists('config.txt') then
begin
var configList := TStringList.Create;
configList.LoadFromFile('config.txt');
try
var defPort := StrToIntDef(configList.Values['port'], 0);
edtPort.Text := defPort.ToString;
PanelTop.Visible := configList.Values['debug'].ToLower.Equals('true');
if configList.Values['require_token'].ToLower.Equals('false') then
FRequireAccessToken := False;
if configList.Values['require_process_check'].ToLower.Equals('false') then
FRequireProcessCheck := False;
finally
FreeAndNil(configList);
end;
end;
btnStartClick(Nil);
btnToggleLogClick(nil);
// CLI flag --tray (set by the "Start with Windows" registry entry):
// launch directly into the tray instead of popping a window during
// the Windows login. Defer to ForceQueue so the form has finished its
// initial Show before we hide it — minimises the visible flash.
if FindCmdLineSwitch('tray', True) then
begin
TThread.ForceQueue(nil,
procedure
begin
FBridge.MinimizeToTray;
LogLine('Launched with --tray, minimised at startup');
end);
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FBridge.Free;
FServer.Free;
end;
procedure TMainForm.WebBrowserInitialized(Sender: TObject);
begin
WebBrowser.EnableContextMenu := False;
WebBrowser.EnableShowDebugConsole := False;
// Race-safe navigation fallback: the 1.5 s timer in NavigateToVault
// assumes WebView2 finishes its async init within that window. On slow
// boots / cold-start machines Edge Chromium can take 2-3 s, and the
// timer's Navigate() call lands while the browser is still uninitialised
// → silently dropped → blank window forever. OnInitialized fires once
// the engine is ready, so if a navigation is still pending here, do it
// now. The timer either already ran (FPendingURL == '') or runs later
// and no-ops on the empty string.
FNavTimer.Enabled := False;
if FPendingURL <> '' then
begin
LogLine('OnInitialized fallback nav to: ' + MaskAccessToken(FPendingURL));
WebBrowser.Navigate(FPendingURL);
FPendingURL := '';
end;
end;
procedure TMainForm.BridgeQuickSearchRequest;
var
LWasHidden: Boolean;
LWasHiddenJs: string;
begin
// Tray menu "Quick search…" — bring the window back so the user can
// see the modal, then ask JS to open it. JS handles the locked-vault
// case (shows the auth screen with master-pw focused instead).
if not FServer.Active then Exit;
// Remember whether the window was hidden BEFORE we restore — after the
// user picks an entry the JS layer asks us to minimize back so they can
// paste into the target app without an extra alt-tab.
LWasHidden := (not Self.Visible) or
IsIconic(WindowHandleToPlatform(Self.Handle).Wnd);
FBridge.RestoreFromTray;
LWasHiddenJs := BoolToStr(LWasHidden, True).ToLower;
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.openQuickSearch==="function")' +
'Bridge.openQuickSearch(' + LWasHiddenJs + ')');
LogLine('Quick search requested from tray menu (wasHidden=' + LWasHiddenJs + ')');
end;
procedure TMainForm.BridgeNewEntryHotkey(const AWindowTitle: string);
var
EscapedTitle: string;
begin
if not FServer.Active then Exit;
FBridge.RestoreFromTray;
EscapedTitle := StringReplace(AWindowTitle, '\', '\\', [rfReplaceAll]);
EscapedTitle := StringReplace(EscapedTitle, '"', '\"', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onNewEntryFromTitle==="function")' +
'Bridge.onNewEntryFromTitle("' + EscapedTitle + '")');
LogLine('New entry hotkey — title: "' + AWindowTitle + '"');
end;
procedure TMainForm.BridgeDebugHotkey;
begin
if not FileExists('config.txt') then
Exit;
PanelTop.Visible := not PanelTop.Visible;
LogLine('Debug panel ' + IfThen(PanelTop.Visible, 'shown', 'hidden') +
' via Ctrl+Shift+D');
end;
Procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
// The tray-menu "Quit" handler sets FQuitting before triggering close,
// so we bypass the minimize-to-tray intercept in that case.
if FQuitting then Exit;
// Otherwise: minimize to tray on close instead of quitting, so the vault
// stays available without the dev-panel being visible.
// When the server is stopped, allow normal close — there's no vault to
// keep alive in the background.
if FServer.Active then
begin
CanClose := False;
FBridge.MinimizeToTray;
LogLine('Minimized to tray. Click the tray icon to restore.');
end;
end;
procedure TMainForm.LogLine(const AMsg: string);
begin
// Synchronize handles both cases: if already on main thread, runs inline;
// otherwise marshals. Avoids overload resolution issues with TThread.Queue.
TThread.Synchronize(nil,
procedure
begin
Memo.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' ' + AMsg);
Memo.GoToTextEnd;
end);
end;
procedure TMainForm.UpdateButtons;
begin
btnStart.Enabled := not FServer.Active;
btnStop.Enabled := FServer.Active;
btnReload.Enabled := FServer.Active;
edtPort.Enabled := not FServer.Active;
if FServer.Active then
lblStatus.Text := 'Running on http://127.0.0.1:' + edtPort.Text
else
lblStatus.Text := 'Stopped';
end;
function MaskAccessToken(const AUrl: string): string;
var
TokenPos: Integer;
begin
Result := AUrl;
TokenPos := Pos('?pmt=', Result);
if TokenPos > 0 then
Result := Copy(Result, 1, TokenPos + 4) + '***';
end;
procedure TMainForm.NavigateToVault;
begin
FPendingURL := 'http://127.0.0.1:' + FServer.BoundPort.ToString + '/index.html';
if FServer.RequireAccessToken then
FPendingURL := FPendingURL + '?pmt=' + FServer.AccessToken;
LogLine('Will navigate embedded browser in ~1.5s to: ' + MaskAccessToken(FPendingURL));
FNavTimer.Enabled := False;
FNavTimer.Enabled := True;
end;
procedure TMainForm.NavTimerTick(Sender: TObject);
begin
FNavTimer.Enabled := False;
if FPendingURL = '' then Exit;
LogLine('Navigating to: ' + MaskAccessToken(FPendingURL));
WebBrowser.Navigate(FPendingURL);
FPendingURL := '';
end;
procedure TMainForm.btnStartClick(Sender: TObject);
var
LPort: Integer;
begin
LPort := StrToIntDef(edtPort.Text, 8765);
try
FServer.Start(LPort, True, FRequireAccessToken, FRequireProcessCheck);
edtPort.Text := FServer.BoundPort.ToString;
UpdateButtons;
NavigateToVault;
except
on E: Exception do
begin
LogLine('ERROR starting server: ' + E.Message);
TDialogService.MessageDialog('Failed to start: ' + E.Message,
TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0, nil);
end;
end;
end;
procedure TMainForm.btnStopClick(Sender: TObject);
begin
FServer.Stop;
UpdateButtons;
FPendingURL := '';
FNavTimer.Enabled := False;
WebBrowser.Navigate('about:blank');
end;
procedure TMainForm.btnReloadClick(Sender: TObject);
begin
if FServer.Active then NavigateToVault;
end;
procedure TMainForm.btnToggleLogClick(Sender: TObject);
begin
PanelLog.Visible := not PanelLog.Visible;
Splitter.Visible := PanelLog.Visible;
if PanelLog.Visible then
btnToggleLog.Text := 'Hide log'
else
btnToggleLog.Text := 'Show log';
end;
// ---------------------------------------------------------------------------
// JS↔Delphi bridge
// ---------------------------------------------------------------------------
procedure TMainForm.WebBrowserBeforeNavigate(Sender: TObject;
var Params: TTMSFNCCustomWebBrowserBeforeNavigateParams);
var
URL, Cmd, ParamStr: string;
P: Integer;
begin
URL := Params.URL;
if not URL.StartsWith('cmd://') then Exit;
Params.Cancel := True;
URL := URL.Substring(6); // strip 'cmd://'
P := Pos('?', URL);
if P > 0 then
begin
Cmd := Copy(URL, 1, P - 1);
ParamStr := Copy(URL, P + 1, MaxInt);
end
else
begin
Cmd := URL;
ParamStr := '';
end;
// Defer to avoid WebView2 re-entrance issues.
TThread.ForceQueue(nil,
procedure
begin
HandleBridgeCommand(Cmd, ParamStr);
end);
end;
procedure TMainForm.HandleBridgeCommand(const ACmd, AParams: string);
function GetParam(const AKey: string): string;
var
Parts: TArray<string>;
Part, K, V: string;
EqPos: Integer;
begin
Result := '';
Parts := AParams.Split(['&']);
for Part in Parts do
begin
EqPos := Pos('=', Part);
if EqPos > 0 then
begin
K := Copy(Part, 1, EqPos - 1);
V := Copy(Part, EqPos + 1, MaxInt);
if SameText(K, AKey) then
begin
Result := TNetEncoding.URL.Decode(V);
Exit;
end;
end;
end;
end;
var
LText: string;
LClearMs: Integer;
begin
if ACmd = 'clipboard/copy' then
begin
LText := GetParam('text');
LClearMs := StrToIntDef(GetParam('clear'), 30000);
FBridge.SecureClipboard.SetText(LText, LClearMs);
LogLine(Format('Secure clipboard set (auto-clear in %ds)', [LClearMs div 1000]));
end
else if ACmd = 'clipboard/clear' then
begin
FBridge.SecureClipboard.Clear;
LogLine('Clipboard cleared by JS request');
end
else if ACmd = 'clipboard/read' then
begin
var ClipText := FBridge.SecureClipboard.ReadText;
var Escaped := StringReplace(ClipText, '\', '\\', [rfReplaceAll]);
Escaped := StringReplace(Escaped, '"', '\"', [rfReplaceAll]);
Escaped := StringReplace(Escaped, #13, '\r', [rfReplaceAll]);
Escaped := StringReplace(Escaped, #10, '\n', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onClipboardRead)Bridge.onClipboardRead("' + Escaped + '")');
end
// ---- Quick unlock (DPAPI persistence of the vault key) ----
// store: client provides a base64-encoded blob (UTF-8 JSON, content
// opaque to us). We DPAPI-encrypt and stash on disk.
// get: we DPAPI-decrypt, base64-encode, send back via ExecuteJavaScript.
// clear: forget-me.
else if ACmd = 'quickunlock/store' then
begin
LText := GetParam('data'); // base64 of UTF-8 JSON blob
if LText = '' then Exit;
var LBytes := TNetEncoding.Base64.DecodeStringToBytes(LText);
if PM.QuickUnlock.StoreQuickUnlock(LBytes) then
LogLine(Format('Quick unlock stored (%d bytes)', [Length(LBytes)]))
else
LogLine('Quick unlock store FAILED (DPAPI error)');
end
else if ACmd = 'quickunlock/get' then
begin
var LBytes: TBytes;
if PM.QuickUnlock.LoadQuickUnlock(LBytes) and (Length(LBytes) > 0) then
begin
var LB64 := TNetEncoding.Base64.EncodeBytesToString(LBytes);
// Strip newlines that the Base64 encoder may insert (line-wrapping
// breaks the JS-side decoder) before injecting into a JS string.
LB64 := StringReplace(LB64, #13, '', [rfReplaceAll]);
LB64 := StringReplace(LB64, #10, '', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onQuickUnlockResult)' +
'Bridge.onQuickUnlockResult("' + LB64 + '")');
LogLine('Quick unlock served');
end
else
begin
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onQuickUnlockResult)' +
'Bridge.onQuickUnlockResult(null)');
end;
end
else if ACmd = 'quickunlock/clear' then
begin
PM.QuickUnlock.ClearQuickUnlock;
LogLine('Quick unlock cleared');
end
else if ACmd = 'quickunlock/status' then
begin
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onQuickUnlockStatus)' +
'Bridge.onQuickUnlockStatus(' +
BoolToStr(PM.QuickUnlock.HasQuickUnlock, True).ToLower + ')');
end
// ---- Autofill --------------------------------------------------------
// configure: JS calls this on page load / settings change to sync the
// hotkey registration state with the user's localStorage preference.
// Uses the historical defaults (Ctrl+Shift+L / Ctrl+Shift+P) — for
// custom combos, JS sends cmd://autofill/hotkeys instead.
else if ACmd = 'autofill/configure' then
begin
if GetParam('enabled') = '1' then
begin
FBridge.RegisterAutofillHotkey;
LogLine('Autofill hotkeys registered (defaults)');
end
else
begin
FBridge.UnregisterAutofillHotkey;
LogLine('Autofill hotkeys unregistered');
end;
end
// hotkeys: JS pushes the user-configured combos. Params:
// enabled = '1' | '0'
// full_mods = MOD_x bitmask (decimal), full_vk = VK code (decimal)
// pwd_mods, pwd_vk = same for the password-only hotkey
// If enabled=0, we just unregister and ignore the rest. If enabled=1,
// we register both with the supplied combos (replacing any prior).
else if ACmd = 'autofill/hotkeys' then
begin
if GetParam('enabled') <> '1' then
begin
FBridge.UnregisterAutofillHotkey;
LogLine('Autofill hotkeys unregistered (custom)');
end
else
begin
var LFullMods := Word(StrToIntDef(GetParam('full_mods'), 6)); // Ctrl+Shift
var LFullVk := Word(StrToIntDef(GetParam('full_vk'), Ord('L')));
var LPwdMods := Word(StrToIntDef(GetParam('pwd_mods'), 6));
var LPwdVk := Word(StrToIntDef(GetParam('pwd_vk'), Ord('P')));
var LAllOk := FBridge.SetAutofillHotkeys(LFullMods, LFullVk,
LPwdMods, LPwdVk);
LogLine(Format('Autofill hotkeys set — full=mods:%d vk:%d pwd=mods:%d vk:%d (all_ok=%s)',
[LFullMods, LFullVk, LPwdMods, LPwdVk, BoolToStr(LAllOk, True)]));
// Notify JS of the result so the UI can flag a failed-to-register combo
// (typically a clash with another app's global hotkey).
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onAutofillHotkeysResult)' +
'Bridge.onAutofillHotkeysResult(' + BoolToStr(LAllOk, True).ToLower + ')');
end;
end
// execute: JS has matched an entry, decrypted the password, and is
// telling Delphi to type username + Tab + password into the saved HWND.
else if ACmd = 'autofill/execute' then
begin
FAutofillPendingUser := GetParam('username');
FAutofillPendingPass := GetParam('password');
FAutofillPendingHWND := FAutofillTargetHWND;
FAutofillTargetHWND := 0;
// Small timer so SetForegroundWindow has time to take effect before
// SendInput fires — avoids the first keystrokes going to our window.
// TTimer.OnTimer is a TNotifyEvent (method, not anon proc) → we use a
// dedicated method on the form and stash the payload in fields.
var LTimer := TTimer.Create(Self);
LTimer.Interval := 60;
LTimer.OnTimer := AutofillTimerTick;
LTimer.Enabled := True;
end
// cancel: JS found no match or user dismissed the picker — nothing to type.
else if ACmd = 'autofill/cancel' then
begin
FAutofillTargetHWND := 0;
LogLine('Autofill cancelled (no match or dismissed)');
end
// focus: JS asks us to bring the main window to front (e.g. when the
// autofill picker opens — without this the picker is shown in the
// WebView but the user might not notice if our window was minimised
// or behind other apps). The Target HWND stays saved; ExecuteAutofill
// restores it later via ForceForegroundWindow.
else if ACmd = 'app/focus' then
begin
FBridge.RestoreFromTray;
LogLine('App brought to front (autofill picker)');
end
// Used by the quick-search modal: after the user picks an entry the
// password is on the clipboard — if the app was hidden when invoked
// from the tray menu, hide it again so the user can paste straight
// into the target app without alt-tabbing.
else if ACmd = 'app/minimize' then
FBridge.MinimizeToTray
// Tray balloon notifications on/off. JS pushes the user setting at
// startup (settings_json sync) and whenever they flip the toggle.
else if ACmd = 'tray/notifications' then
begin
FBridge.ShowNotifications := GetParam('enabled') = '1';
LogLine('Tray notifications ' +
IfThen(FBridge.ShowNotifications, 'enabled', 'disabled'));
end
else if ACmd = 'app/ready' then
begin
WebBrowser.SetFocus;
WebBrowser.ExecuteJavaScript(
'setTimeout(()=>{var u=document.getElementById("loginUsername"),' +
'p=document.getElementById("loginPassword");' +
'if(u&&u.value){p&&p.focus();}else{u&&u.focus();}},0)');
end
else if ACmd = 'app/theme' then
FBridge.ApplyTitleBarTheme(GetParam('mode') = 'dark')
// ---- Device-bound prefs (DPAPI key/value) ----------------------------
// Used for prefs that must survive the ephemeral-port reset of the
// WebView2 localStorage (rememberedUsername, etc.).
else if ACmd = 'prefs/get' then
begin
var LKey := GetParam('key');
if LKey = '' then Exit;
var LVal := PM.UserPrefs.GetPref(LKey);
var LEscapedKey := StringReplace(LKey, '\', '\\', [rfReplaceAll]);
LEscapedKey := StringReplace(LEscapedKey, '"', '\"', [rfReplaceAll]);
var LEscapedVal := StringReplace(LVal, '\', '\\', [rfReplaceAll]);
LEscapedVal := StringReplace(LEscapedVal, '"', '\"', [rfReplaceAll]);
LEscapedVal := StringReplace(LEscapedVal, #13, '\r', [rfReplaceAll]);
LEscapedVal := StringReplace(LEscapedVal, #10, '\n', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onPrefResult)' +
'Bridge.onPrefResult("' + LEscapedKey + '","' + LEscapedVal + '")');
end
else if ACmd = 'prefs/set' then
begin
var LKey := GetParam('key');
if LKey = '' then Exit;
PM.UserPrefs.SetPref(LKey, GetParam('value'));
end
// ---- Start with Windows (HKCU Run registry) --------------------------
else if ACmd = 'autostart/get' then
begin
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onAutoStartStatus)' +
'Bridge.onAutoStartStatus(' +
BoolToStr(PM.AutoStart.IsAutoStartEnabled, True).ToLower + ')');
end
// ---- Favicon proxy (Delphi-side fetch to keep CSP tight + privacy
// centralised on one upstream domain). Async: the HTTP GET would
// block the main thread for up to 5 s on slow networks.
else if ACmd = 'favicon/fetch' then
begin
var LHost := GetParam('host');
var LReqId := GetParam('reqId'); // opaque, echoed back to JS resolver
if LHost = '' then Exit;
LogLine('favicon/fetch host="' + LHost + '" reqId=' + LReqId);
TThread.CreateAnonymousThread(
procedure
var
LDataUri: string;
begin
LDataUri := PM.Favicon.FetchFaviconDataUri(LHost,
procedure(const ALine: string)
begin
TThread.Queue(nil,
procedure
begin
LogLine('favicon[' + LHost + ']: ' + ALine);
end);
end);
TThread.Queue(nil,
procedure
begin
if LDataUri = '' then
LogLine('favicon: NO RESULT for "' + LHost +
'" (TLS error? OpenSSL DLLs missing? DDG 404?)')
else
LogLine(Format('favicon: got %d bytes for "%s"',
[Length(LDataUri), LHost]));
end);
TThread.Queue(nil,
procedure
var
LEscHost, LEscData, LEscReq: string;
begin
LEscHost := StringReplace(LHost, '\', '\\', [rfReplaceAll]);
LEscHost := StringReplace(LEscHost, '"', '\"', [rfReplaceAll]);
LEscReq := StringReplace(LReqId, '\', '\\', [rfReplaceAll]);
LEscReq := StringReplace(LEscReq, '"', '\"', [rfReplaceAll]);
// The data URI is base64 (ASCII-safe) plus a small prefix —
// no embedded quotes by construction, but escape anyway.
LEscData := StringReplace(LDataUri, '\', '\\', [rfReplaceAll]);
LEscData := StringReplace(LEscData, '"', '\"', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onFaviconResult)' +
'Bridge.onFaviconResult("' + LEscReq + '","' + LEscHost + '","' +
LEscData + '")');
end);
end).Start;
end
else if ACmd = 'autostart/set' then
begin
var LOk := PM.AutoStart.SetAutoStart(GetParam('enabled') = '1');
LogLine(Format('Autostart set to %s (ok=%s)',
[GetParam('enabled'), BoolToStr(LOk, True)]));
// Echo back the resulting state so the UI re-syncs (covers the
// case where the registry write was blocked silently).
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onAutoStartStatus)' +
'Bridge.onAutoStartStatus(' +
BoolToStr(PM.AutoStart.IsAutoStartEnabled, True).ToLower + ')');
end
else
LogLine('Bridge: unknown command "' + ACmd + '"');
end;
procedure TMainForm.BridgeSystemLock;
begin
// Windows session locked or system suspending — delegate to Bridge.onSystemLock
// in JS which honours the "quick unlock" opt-out (DPAPI already gates
// access via the Windows account, so re-locking on top of Windows lock
// is redundant for users who enabled it).
LogLine('Windows session locked / suspend — notifying JS');
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onSystemLock==="function")Bridge.onSystemLock();' +
'else if(typeof lockVault==="function")lockVault()');
end;
procedure TMainForm.BridgeTrayRestore;
begin
FBridge.RestoreFromTray;
// Notify the JS layer: the UI may want to reset the auto-lock timer,
// refresh state, or show a "welcome back" toast.
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onTrayRestore==="function")Bridge.onTrayRestore()');
LogLine('Restored from tray');
end;
procedure TMainForm.BridgeLockRequest;
begin
// User picked "Lock vault" from the tray menu. Trigger lockVault() in
// JS — same path as the WTS_SESSION_LOCK auto-lock.
LogLine('Lock requested from tray menu');
WebBrowser.ExecuteJavaScript('if(typeof lockVault==="function")lockVault()');
end;
procedure TMainForm.BridgeQuit;
begin
// Re-entry guard: if Quit was already requested, ignore further calls.
if FQuitting then Exit;
LogLine('>>> BridgeQuit invoked (Quit from tray menu)');
FQuitting := True;
// Restore the form first so the tray icon goes away and FormDestroy
// executes from a normal (non-hidden) state. RestoreFromTray also
// deletes the tray icon.
FBridge.RestoreFromTray;
Application.Terminate;
end;
procedure TMainForm.AutofillTimerTick(Sender: TObject);
var
TargetHwnd: HWND;
PendingUser, PendingPass: string;
ForegroundAfter: HWND;
begin
TargetHwnd := FAutofillPendingHWND;
PendingUser := FAutofillPendingUser;
PendingPass := FAutofillPendingPass;
FAutofillPendingHWND := 0;
FAutofillPendingUser := '';
FAutofillPendingPass := '';
TTimer(Sender).Enabled := False;
TTimer(Sender).Free;
FBridge.ExecuteAutofill(TargetHwnd, PendingUser, PendingPass);
ForegroundAfter := GetForegroundWindow;
LogLine(Format('Autofill executed — target=%s, foreground_after=%s, match=%s',
[IntToHex(TargetHwnd, 8), IntToHex(ForegroundAfter, 8),
BoolToStr(ForegroundAfter = TargetHwnd, True)]));
end;
procedure TMainForm.BridgeAutofillRequest(AKind: TAutofillKind;
ATargetHWND: HWND; const ATitle: string);
var
LTitle, LKind: string;
begin
if not FServer.Active then Exit;
FAutofillTargetHWND := ATargetHWND;
// Escape the title for safe injection into a JS string literal.
LTitle := ATitle;
LTitle := LTitle.Replace('\', '\\');
LTitle := LTitle.Replace('"', '\"');
if AKind = akPasswordOnly then LKind := 'password' else LKind := 'full';
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onAutofillRequest==="function")' +
'Bridge.onAutofillRequest("' + LTitle + '","' + LKind + '")');
LogLine('Autofill hotkey (' + LKind + ') — foreground: "' + ATitle + '"');
end;
initialization
// WebView2 ships with a long list of "phone home" behaviours enabled by
// default (SmartScreen lookups, component updates, sync, UMA telemetry,
// domain reliability beacons, optimisation hints, etc.). For a vault
// that's meant to be 100% offline we disable them by passing flags
// through WEBVIEW2_ADDITIONAL_BROWSER_ARGUMENTS — the standard way to
// configure the embedded Chromium without touching system policy.
//
// Must be set BEFORE the TMS FNC WebBrowser instantiates its
// CoreWebView2Environment, hence the unit initialization block.
SetEnvironmentVariable('WEBVIEW2_ADDITIONAL_BROWSER_ARGUMENTS',
'--disable-background-networking ' +
'--disable-sync ' +
'--disable-component-update ' +
'--no-default-browser-check ' +
'--no-pings ' +
'--disable-client-side-phishing-detection ' +
'--disable-domain-reliability ' +
'--disable-breakpad ' +
'--disable-crash-reporter ' +
'--no-experiments ' +
'--metrics-recording-only ' +
'--disable-features=MediaRouter,OptimizationHints,InterestFeedContentSuggestions,' +
'CalculateNativeWinOcclusion,HardwareMediaKeyHandling,Translate,' +
'NetworkServiceInProcess,BackgroundFetch,SafeBrowsingEnhancedProtection,' +
'AutofillServerCommunication,PrivacySandboxAdsAPIsOverride'
);
end.