unit UMainForm; // ---------------------------------------------------------------------- // WebBrowser engine switch — compile-time directive. // // Uncomment USE_EDGE_BROWSER to build against TTMSFNCEdgeWebBrowser // (Windows-only, direct WebView2 wrapper). Default = TTMSFNCWebBrowser // (cross-platform abstraction also on WebView2 under Windows). Both // expose the same TTMSFNCCustomWebBrowser API for OnBeforeNavigate / // ExecuteJavaScript / Navigate, so the bridge cmd:// glue is unchanged. // ---------------------------------------------------------------------- {$DEFINE USE_EDGE_BROWSER} interface uses System.SysUtils, System.Classes, System.UITypes, System.NetEncoding, System.StrUtils, System.Generics.Collections, System.IOUtils, System.JSON, Winapi.Windows, Winapi.ShellAPI, 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, // ICoreWebView2 / ICoreWebView2Settings3 COM interface declarations — // used to disable browser accelerator keys (Ctrl+P, Ctrl+J, F12, etc.) // via the AreBrowserAcceleratorKeysEnabled property that Settings.* doesn't // expose at the TMS wrapper level. FMX.TMSFNCWebBrowser.Win, {$IFDEF USE_EDGE_BROWSER} FMX.TMSFNCEdgeWebBrowser, {$ENDIF} PM.HTTPServer, PM.Bridge, PM.QuickUnlock, PM.UserPrefs, PM.AutoStart, PM.Favicon, FMX.Platform.Win, FMX.Menus; // WindowHandleToPlatform → HWND for visibility check type // Concrete class chosen at compile time. Both inherit from // TTMSFNCCustomWebBrowser so we use that as the field type — events // and ExecuteJavaScript live on the base class. {$IFDEF USE_EDGE_BROWSER} TWebBrowserClass = TTMSFNCEdgeWebBrowser; {$ELSE} TWebBrowserClass = TTMSFNCWebBrowser; {$ENDIF} 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; PopupMenu1: TPopupMenu; 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; // True when the JS layer asked us to hide back to the tray AFTER the // autofill SendInput completes. Used by the Ctrl+Shift+Q hotkey path // when invoked while the app was in the tray — we can't hide before // SendInput because Win10/11 anti-focus-stealing rules then refuse to // hand focus to the target window. FAutofillPendingHide: Boolean; // Created dynamically in FormCreate so the directive can pick either // TTMSFNCWebBrowser or TTMSFNCEdgeWebBrowser at compile time without // needing two .fmx variants. Aligned to Client to fill the remaining // space between PanelTop (top) and PanelLog/Splitter (bottom). WebBrowser: TWebBrowserClass; 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 WebBrowserGetContextMenu(Sender: TObject; ATarget: TTMSFNCWebBrowserTargetItem; AContextMenu: TObjectList); 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 BridgeQuickSearchHotkey(AKind: TAutofillKind; ATargetHWND: HWND; const ATitle: string); 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 // Create the WebBrowser control programmatically so the {$IFDEF // USE_EDGE_BROWSER} directive can swap the concrete class without a // second .fmx variant. Align Client to fill the area below PanelTop // and above the (collapsible) PanelLog + Splitter. WebBrowser := TWebBrowserClass.Create(Self); // Wire events BEFORE Parent assignment: setting Parent triggers the // TMS browser's async WebView2 init, which fires OnInitialized when // Edge Chromium is ready. If we assigned the handlers afterwards we'd // miss the event on fast / pre-warmed Edge installs (and the // Settings.EnableContextMenu / SetAcceleratorKeys calls inside would // never run, leaving the native context menu and Ctrl+P/J live). WebBrowser.OnBeforeNavigate := WebBrowserBeforeNavigate; WebBrowser.OnInitialized := WebBrowserInitialized; {$IFDEF USE_EDGE_BROWSER} // On TTMSFNCEdgeWebBrowser the event is published. // On TTMSFNCWebBrowser the same property is only re-published inside a // conditional ($IFNDEF FNCLIB) block — depending on the FNC build, it // may not be accessible. Restricting the assignment to the Edge build // keeps the unconditional path TTMSFNCWebBrowser-safe. WebBrowser.OnGetContextMenu := WebBrowserGetContextMenu; {$ENDIF} WebBrowser.Parent := Self; WebBrowser.Align := TAlignLayout.Client; 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.OnQuickSearchHotkey := BridgeQuickSearchHotkey; FBridge.RegisterAutofillHotkey; // Ctrl+Shift+L active from startup FBridge.ApplyTitleBarTheme(True); // dark by default, JS may toggle later FAutofillTargetHWND := 0; // 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 - d 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); var LUnk: IUnknown; LCtrl: ICoreWebView2Controller; LWv2: ICoreWebView2; LSettings: ICoreWebView2Settings; LSettings3: ICoreWebView2Settings3; LPtr: Pointer; begin // Disable native Edge context menu + DevTools via the TMS-wrapped settings. // Disable browser-level accelerator keys (Ctrl+P / Ctrl+J / Ctrl+H / // Ctrl+S / F12 / etc.). TMS's NativeBrowser returns the // ICoreWebView2Controller, not the ICoreWebView2 — so we walk the chain: // Controller → get_CoreWebView2 → get_Settings → QI(Settings3) → set_. // Pointer→Interface cast must go through an explicit AddRef to keep the // refcount balanced (otherwise the auto-Release at scope exit frees a // reference TMS is still holding → AV at next use). LPtr := WebBrowser.NativeBrowser; if LPtr <> nil then begin Pointer(LUnk) := LPtr; LUnk._AddRef; if Supports(LUnk, ICoreWebView2Controller, LCtrl) then begin LCtrl.get_CoreWebView2(LWv2); if Assigned(LWv2) then begin LWv2.get_Settings(LSettings); if Assigned(LSettings) and Supports(LSettings, ICoreWebView2Settings3, LSettings3) then LSettings3.set_AreBrowserAcceleratorKeysEnabled(False); end; end; end; {$IFDEF USE_EDGE_BROWSER} WebBrowser.Settings.EnableContextMenu := False; WebBrowser.Settings.EnableShowDebugConsole := False; {$ELSE} WebBrowser.EnableContextMenu := False; WebBrowser.EnableShowDebugConsole := False; WebBrowser.PopupMenu := PopupMenu1; {$ENDIF} // 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.BridgeQuickSearchHotkey(AKind: TAutofillKind; ATargetHWND: HWND; const ATitle: string); var LWasHidden: Boolean; LWasHiddenJs: string; begin // Ctrl+Shift+Q anywhere — save the foreground HWND so the JS layer's // cmd://autofill/execute (fired after the user picks an entry) sends // the password into it. Then pop the modal in fill mode. if not FServer.Active then Exit; FAutofillTargetHWND := ATargetHWND; LWasHidden := (not Self.Visible) or IsIconic(WindowHandleToPlatform(Self.Handle).Wnd); FBridge.RestoreFromTray; LWasHiddenJs := BoolToStr(LWasHidden, True).ToLower; // Second arg forFill=true tells JS to SendInput on pick instead of copy. WebBrowser.ExecuteJavaScript( 'if(window.Bridge&&typeof Bridge.openQuickSearch==="function")' + 'Bridge.openQuickSearch(' + LWasHiddenJs + ',true)'); LogLine(Format('Quick-search hotkey — target=%s, title="%s"', [IntToHex(ATargetHWND, 8), ATitle])); 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 // WebBrowser.Navigate('about:blank'); // exit; 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.WebBrowserGetContextMenu(Sender: TObject; ATarget: TTMSFNCWebBrowserTargetItem; AContextMenu: TObjectList); begin // Clearing the items leaves WebView2 with nothing to show → the native // right-click menu is suppressed entirely. The JS layer renders a // custom Cut/Copy/Paste menu on text inputs via installCustomContextMenu(). AContextMenu.Clear; end; 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; 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; FAutofillPendingHide := GetParam('hide_after') = '1'; 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') // Open the entry's site in the user's default browser. We restrict the // scheme to http(s) so JS can't smuggle a file:// or other handler that // would invoke arbitrary Windows applications. else if ACmd = 'app/open-url' then begin var LUrl := GetParam('url'); if (LUrl <> '') and (LUrl.ToLower.StartsWith('http://') or LUrl.ToLower.StartsWith('https://')) then begin ShellExecute(0, 'open', PChar(LUrl), nil, nil, 1); // SW_SHOWNORMAL = 1 LogLine('Opened URL: ' + LUrl); end else LogLine('Refused to open non-http(s) URL: ' + LUrl); end // ---- 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 // ---- Native file save (bypasses WebView2's browser download UI) ------ // JS sends: cmd://file/save?name=&data=&reqId= // Delphi opens GetSaveFileName, writes the decoded bytes, then calls // Bridge.onFileSaveResult(reqId, ok, path). All synchronous on the UI // thread — payloads are small (a vault JSON export is well under 1 MB). else if ACmd = 'file/save' then begin var LName := GetParam('name'); var LData := GetParam('data'); var LReqId := GetParam('reqId'); var LOk := False; var LPath := ''; var LErr := ''; try var LBytes := TNetEncoding.Base64.DecodeStringToBytes(LData); var LDlg := TSaveDialog.Create(nil); try LDlg.FileName := LName; var LExt := ExtractFileExt(LName); if LExt = '.json' then LDlg.Filter := 'JSON file (*.json)|*.json|All files (*.*)|*.*' else if LExt = '.csv' then LDlg.Filter := 'CSV file (*.csv)|*.csv|All files (*.*)|*.*' else LDlg.Filter := 'All files (*.*)|*.*'; LDlg.DefaultExt := LExt.TrimLeft(['.']); LDlg.Options := LDlg.Options + [TOpenOption.ofOverwritePrompt]; if LDlg.Execute then begin LPath := LDlg.FileName; var LStream := TFileStream.Create(LPath, fmCreate); try if Length(LBytes) > 0 then LStream.WriteBuffer(LBytes[0], Length(LBytes)); finally LStream.Free; end; LOk := True; LogLine(Format('File saved: %s (%d bytes)', [LPath, Length(LBytes)])); end else LogLine('File save cancelled by user'); finally LDlg.Free; end; except on E: Exception do begin LErr := E.Message; LogLine('File save FAILED: ' + LErr); end; end; var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]); var LEscPath := StringReplace(LPath, '\', '\\', [rfReplaceAll]); LEscPath := StringReplace(LEscPath, '"', '\"', [rfReplaceAll]); var LEscErr := StringReplace(LErr, '\', '\\', [rfReplaceAll]); LEscErr := StringReplace(LEscErr, '"', '\"', [rfReplaceAll]); WebBrowser.ExecuteJavaScript( 'if(window.Bridge&&Bridge.onFileSaveResult)' + 'Bridge.onFileSaveResult("' + LEscReq + '",' + BoolToStr(LOk, True).ToLower + ',"' + LEscPath + '","' + LEscErr + '")'); end // ---- Auto-backup: folder picker (modal Win32 dialog) ----------------- // cmd://folder/pick?reqId= // Callback: Bridge.onFolderPickResult(reqId, path) (path = '' on cancel) else if ACmd = 'folder/pick' then begin var LReqId := GetParam('reqId'); var LDir := ''; SelectDirectory('Choose backup folder', '', LDir); var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]); var LEscDir := StringReplace(LDir, '\', '\\', [rfReplaceAll]); LEscDir := StringReplace(LEscDir, '"', '\"', [rfReplaceAll]); WebBrowser.ExecuteJavaScript( 'if(window.Bridge&&Bridge.onFolderPickResult)' + 'Bridge.onFolderPickResult("' + LEscReq + '","' + LEscDir + '")'); if LDir <> '' then LogLine('Folder picked: ' + LDir); end // ---- Auto-backup: silent file write (no dialog) ---------------------- // cmd://file/write?path=&data=&reqId= // Callback: Bridge.onFileWriteResult(reqId, ok, error) else if ACmd = 'file/write' then begin var LPath := GetParam('path'); var LData := GetParam('data'); var LReqId := GetParam('reqId'); var LOk := False; var LErr := ''; try var LBytes := TNetEncoding.Base64.DecodeStringToBytes(LData); var LStream := TFileStream.Create(LPath, fmCreate); try if Length(LBytes) > 0 then LStream.WriteBuffer(LBytes[0], Length(LBytes)); finally LStream.Free; end; LOk := True; LogLine(Format('File written: %s (%d bytes)', [LPath, Length(LBytes)])); except on E: Exception do begin LErr := E.Message; LogLine('File write FAILED for "' + LPath + '": ' + LErr); end; end; var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]); var LEscErr := StringReplace(LErr, '\', '\\', [rfReplaceAll]); LEscErr := StringReplace(LEscErr, '"', '\"', [rfReplaceAll]); WebBrowser.ExecuteJavaScript( 'if(window.Bridge&&Bridge.onFileWriteResult)' + 'Bridge.onFileWriteResult("' + LEscReq + '",' + BoolToStr(LOk, True).ToLower + ',"' + LEscErr + '")'); end // ---- Auto-backup: list files in dir matching name prefix -------------- // cmd://file/listMatch?dir=&prefix=&reqId= // Callback: Bridge.onFileListResult(reqId, jsonArr) // Each item: {name, size, mtime} (mtime = ISO). else if ACmd = 'file/listMatch' then begin var LDir := GetParam('dir'); var LPrefix := GetParam('prefix'); var LReqId := GetParam('reqId'); var LArr := TJSONArray.Create; try if (LDir <> '') and TDirectory.Exists(LDir) then begin var LFiles := TDirectory.GetFiles(LDir, LPrefix + '*'); for var F in LFiles do begin var LObj := TJSONObject.Create; LObj.AddPair('name', ExtractFileName(F)); LObj.AddPair('size', TJSONNumber.Create(TFile.GetSize(F))); LObj.AddPair('mtime', FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', TFile.GetLastWriteTime(F))); LArr.Add(LObj); end; end; var LJSON := LArr.ToString; var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]); var LEscJson := StringReplace(LJSON, '\', '\\', [rfReplaceAll]); LEscJson := StringReplace(LEscJson, '"', '\"', [rfReplaceAll]); WebBrowser.ExecuteJavaScript( 'if(window.Bridge&&Bridge.onFileListResult)' + 'Bridge.onFileListResult("' + LEscReq + '","' + LEscJson + '")'); finally LArr.Free; end; end // ---- Auto-backup: delete a single file (for retention pruning) ------- // cmd://file/delete?path=&reqId= // Callback: Bridge.onFileDeleteResult(reqId, ok) else if ACmd = 'file/delete' then begin var LPath := GetParam('path'); var LReqId := GetParam('reqId'); var LOk := False; try if TFile.Exists(LPath) then begin TFile.Delete(LPath); LOk := True; LogLine('File deleted: ' + LPath); end; except on E: Exception do LogLine('File delete FAILED for "' + LPath + '": ' + E.Message); end; var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]); WebBrowser.ExecuteJavaScript( 'if(window.Bridge&&Bridge.onFileDeleteResult)' + 'Bridge.onFileDeleteResult("' + LEscReq + '",' + BoolToStr(LOk, 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; HideAfter: Boolean; ForegroundAfter: HWND; begin TargetHwnd := FAutofillPendingHWND; PendingUser := FAutofillPendingUser; PendingPass := FAutofillPendingPass; HideAfter := FAutofillPendingHide; FAutofillPendingHWND := 0; FAutofillPendingUser := ''; FAutofillPendingPass := ''; FAutofillPendingHide := False; 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)])); // Hide-after (Ctrl+Shift+Q from tray): SendInput is done, the target // already has focus — now we can safely tray ourselves without // confusing the Win10/11 foreground-stealing watchdog. if HideAfter then begin FBridge.MinimizeToTray; LogLine('Hidden back to tray (post-autofill).'); end; 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.