unit UMainForm; interface uses System.SysUtils, System.Classes, System.UITypes, System.NetEncoding, 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.TMSFNCTypes, FMX.TMSFNCUtils, FMX.TMSFNCGraphics, FMX.TMSFNCGraphicsTypes, FMX.TMSFNCCustomControl, FMX.TMSFNCWebBrowser, PM.HTTPServer, PM.Bridge; 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; FNavAttempts: Integer; FQuitting: Boolean; // set when user picks "Quit" in tray menu — bypasses // FormCloseQuery's minimize-to-tray intercept. 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; end; var MainForm: TMainForm; implementation {$R *.fmx} 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; // Wire the cmd:// bridge before any navigation happens. WebBrowser.OnBeforeNavigate := WebBrowserBeforeNavigate; // 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.'); end; procedure TMainForm.FormDestroy(Sender: TObject); begin FBridge.Free; FServer.Free; 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; procedure TMainForm.NavigateToVault; begin FPendingURL := 'http://127.0.0.1:' + edtPort.Text + '/index.html'; LogLine('Will navigate embedded browser in ~1.5s to: ' + FPendingURL); // Schedule a single Navigate after Edge has had time to initialize. FNavTimer.Enabled := False; // restart timer if already running FNavTimer.Enabled := True; end; procedure TMainForm.NavTimerTick(Sender: TObject); begin FNavTimer.Enabled := False; // one-shot if FPendingURL = '' then Exit; LogLine('Navigating to: ' + FPendingURL); WebBrowser.Navigate(FPendingURL); FPendingURL := ''; end; procedure TMainForm.btnStartClick(Sender: TObject); var LPort: Integer; begin LPort := StrToIntDef(edtPort.Text, 8765); try FServer.Start(LPort); UpdateButtons; NavigateToVault; except on E: Exception do begin LogLine('ERROR starting server: ' + E.Message); MessageDlg('Failed to start: ' + E.Message, TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0); 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; 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 LogLine('Bridge: unknown command "' + ACmd + '"'); end; procedure TMainForm.BridgeSystemLock; begin // Windows session locked — lock the vault in the JS layer immediately. LogLine('Windows session locked — locking vault'); WebBrowser.ExecuteJavaScript('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; end.