r-zakarya
03a8a6f8a6
The earlier fix only covered the tray restore path, but Show desktop / taskbar restore never runs our code at all — it is pure Windows + FMX, and FMX brings the window back "normal" after forgetting it was maximised. Track the state the user actually settled on (OnResize, ignoring wsMinimized since that is the state we must survive) and re-apply it on OnActivate, which fires however the user returns: taskbar, tray or Alt+Tab. Gated on FWantMaximized so a window the user deliberately un-maximised is left alone. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
1644 lines
64 KiB
ObjectPascal
1644 lines
64 KiB
ObjectPascal
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,
|
|
System.Net.HttpClient, System.Net.URLClient,
|
|
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.PinUnlock, PM.UserPrefs, PM.AutoStart,
|
|
PM.Favicon,
|
|
FMX.Platform.Win, FMX.Menus; // WindowHandleToPlatform → HWND for visibility check
|
|
const
|
|
// Bump on each release. Surfaced to JS via cmd://app/version, displayed
|
|
// in Settings → Account so users can report bugs with the right build.
|
|
APP_VERSION = '1.0.0';
|
|
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
|
|
// Windows minimising the window from the outside (Win+D / Show desktop /
|
|
// taskbar) makes FMX forget it was maximised: the window comes back
|
|
// "normal". None of our restore paths run in that case — the taskbar
|
|
// restore is pure Windows + FMX — so the state is re-applied on activate,
|
|
// which happens however the user comes back. FWantMaximized mirrors the
|
|
// user's LAST deliberate choice, so we never fight a normal-size window.
|
|
FWantMaximized: Boolean;
|
|
FServer: TPMHTTPServer;
|
|
FBridge: TPMBridge;
|
|
// Accumulates base64 chunks for large file saves (attachments too big
|
|
// to fit a single cmd:// URL). Keyed by reqId, flushed on save-commit.
|
|
FFileSaveChunks: TDictionary<string, TStringBuilder>;
|
|
FPendingURL: string;
|
|
FNavTimer: TTimer;
|
|
// Set once WebView2 fires OnInitialized. The nav timer only consumes
|
|
// FPendingURL when this is True — otherwise a timer tick that lands
|
|
// before the engine is ready would Navigate() into the void AND clear
|
|
// FPendingURL, leaving OnInitialized nothing to do → permanent black
|
|
// window on slow cold starts.
|
|
FBrowserInitialized: Boolean;
|
|
FNavRetries: Integer; // bounded retry count for the deferred nav timer
|
|
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;
|
|
// True when the pending autofill should type ONLY the username (quick
|
|
// search "autofill username" — right-click / Shift+Enter in fill mode).
|
|
FAutofillPendingUserOnly: Boolean;
|
|
// Send Ctrl+A + Del before typing each field (user setting, default ON;
|
|
// OFF for targets where Ctrl+A isn't select-all — terminals, RDP).
|
|
FAutofillPendingClear: Boolean;
|
|
// Tray balloon when the fill fails while the window is hidden (user
|
|
// setting "Tray alert when autofill is blocked", default ON).
|
|
FAutofillPendingNotify: 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 FormActivateRestoreState(Sender: TObject);
|
|
procedure FormResizeTrackState(Sender: TObject);
|
|
procedure AutofillTimerTick(Sender: TObject);
|
|
// Shared by cmd://file/save (single-shot) and file/save-commit
|
|
// (chunked): decode the base64, show the Save dialog, write, and fire
|
|
// Bridge.onFileSaveResult back to JS.
|
|
procedure SaveDecodedFile(const AName, AB64, AReqId: string);
|
|
// Silent write to a fixed path (auto-backup / sync pre-backup). Shared
|
|
// by cmd://file/write (single-shot) and file/write-commit (chunked).
|
|
procedure WriteDecodedFile(const APath, AB64, AReqId: string);
|
|
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<TTMSFNCWebBrowserContextMenuItem>);
|
|
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
|
|
// The .fmx ships WindowState = wsMaximized, so that is the starting intent.
|
|
// Wired here (not in the .fmx) to keep the designer file untouched.
|
|
FWantMaximized := (WindowState = TWindowState.wsMaximized);
|
|
OnResize := FormResizeTrackState;
|
|
OnActivate := FormActivateRestoreState;
|
|
|
|
// 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);
|
|
FFileSaveChunks := TDictionary<string, TStringBuilder>.Create;
|
|
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
|
|
// Suppress the first-time tray balloon for autostart launches —
|
|
// it's noise when Windows itself put us in the tray (the user
|
|
// didn't actively minimise). Manual launches still see it once.
|
|
FBridge.BalloonShown := True;
|
|
TThread.ForceQueue(nil,
|
|
procedure
|
|
begin
|
|
FBridge.MinimizeToTray;
|
|
LogLine('Launched with --tray, minimised at startup (balloon suppressed)');
|
|
end);
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
if Assigned(FFileSaveChunks) then
|
|
begin
|
|
for var LSB in FFileSaveChunks.Values do LSB.Free;
|
|
FFileSaveChunks.Free;
|
|
end;
|
|
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.
|
|
FBrowserInitialized := True;
|
|
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;
|
|
// Tray-hidden ONLY (Visible=false). A window merely minimised to the
|
|
// taskbar must NOT count: hide-after would send it to the TRAY on close —
|
|
// it vanishes from the taskbar it came from. Restored-from-iconic just
|
|
// stays open after the modal closes.
|
|
LWasHidden := not Self.Visible;
|
|
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 TRAY-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. Iconic-only
|
|
// (taskbar) does NOT count — see BridgeQuickSearchHotkey.
|
|
LWasHidden := not Self.Visible;
|
|
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;
|
|
|
|
// Windows shutdown / logoff / restart: WM_QUERYENDSESSION flipped the
|
|
// bridge's flag. Let the form close normally so FServer.Free and the
|
|
// FireDAC connection get a chance to checkpoint the WAL — otherwise
|
|
// Windows force-kills us at the shutdown timeout and we leave
|
|
// -shm / -wal files next to vault.db.
|
|
if Assigned(FBridge) and FBridge.ShutdownPending then
|
|
begin
|
|
FQuitting := True;
|
|
LogLine('System shutdown detected — closing normally.');
|
|
Exit;
|
|
end;
|
|
|
|
// 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.SaveDecodedFile(const AName, AB64, AReqId: string);
|
|
var
|
|
LOk: Boolean;
|
|
LPath, LErr: string;
|
|
begin
|
|
LOk := False;
|
|
LPath := '';
|
|
LErr := '';
|
|
try
|
|
var LBytes := TNetEncoding.Base64.DecodeStringToBytes(AB64);
|
|
var LDlg := TSaveDialog.Create(nil);
|
|
try
|
|
LDlg.FileName := AName;
|
|
var LExt := ExtractFileExt(AName);
|
|
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(AReqId, '"', '\"', [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;
|
|
|
|
procedure TMainForm.WriteDecodedFile(const APath, AB64, AReqId: string);
|
|
var
|
|
LOk: Boolean;
|
|
LErr: string;
|
|
begin
|
|
LOk := False;
|
|
LErr := '';
|
|
try
|
|
var LBytes := TNetEncoding.Base64.DecodeStringToBytes(AB64);
|
|
var LStream := TFileStream.Create(APath, 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)', [APath, Length(LBytes)]));
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
LErr := E.Message;
|
|
LogLine('File write FAILED for "' + APath + '": ' + LErr);
|
|
end;
|
|
end;
|
|
var LEscReq := StringReplace(AReqId, '"', '\"', [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;
|
|
|
|
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));
|
|
FNavRetries := 0;
|
|
FNavTimer.Enabled := False;
|
|
FNavTimer.Enabled := True;
|
|
end;
|
|
|
|
procedure TMainForm.NavTimerTick(Sender: TObject);
|
|
begin
|
|
FNavTimer.Enabled := False;
|
|
if FPendingURL = '' then Exit;
|
|
// Engine not ready yet: Navigate() would be silently dropped. Leave
|
|
// FPendingURL intact and re-arm — either this timer catches the engine
|
|
// once it's up, or OnInitialized fires first and does the nav. Whoever
|
|
// wins clears FPendingURL so the other no-ops (no reload flash).
|
|
// Bounded to ~10 retries (15 s): if OnInitialized never fires (missing /
|
|
// broken WebView2 runtime), we stop deferring and attempt Navigate once
|
|
// anyway — best effort beats an eternal retry loop on a blank window.
|
|
if (not FBrowserInitialized) and (FNavRetries < 10) then
|
|
begin
|
|
Inc(FNavRetries);
|
|
LogLine(Format('Nav deferred — WebView2 not initialised (retry %d/10).',
|
|
[FNavRetries]));
|
|
FNavTimer.Enabled := True;
|
|
Exit;
|
|
end;
|
|
if not FBrowserInitialized then
|
|
LogLine('WebView2 still not initialised after retries — attempting nav anyway.');
|
|
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<TTMSFNCWebBrowserContextMenuItem>);
|
|
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<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
|
|
|
|
// ---- PIN unlock (DPAPI blob, PIN-derived wrap of the vault key) ----
|
|
// Same wire model as quickunlock — opaque base64 payload in / out.
|
|
else if ACmd = 'pin/store' then
|
|
begin
|
|
LText := GetParam('data');
|
|
if LText = '' then Exit;
|
|
var LBytes := TNetEncoding.Base64.DecodeStringToBytes(LText);
|
|
if PM.PinUnlock.StorePinUnlock(LBytes) then
|
|
LogLine(Format('PIN blob stored (%d bytes)', [Length(LBytes)]))
|
|
else
|
|
LogLine('PIN blob store FAILED (DPAPI error)');
|
|
end
|
|
|
|
else if ACmd = 'pin/get' then
|
|
begin
|
|
var LBytes: TBytes;
|
|
if PM.PinUnlock.LoadPinUnlock(LBytes) and (Length(LBytes) > 0) then
|
|
begin
|
|
var LB64 := TNetEncoding.Base64.EncodeBytesToString(LBytes);
|
|
LB64 := StringReplace(LB64, #13, '', [rfReplaceAll]);
|
|
LB64 := StringReplace(LB64, #10, '', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onPinResult)' +
|
|
'Bridge.onPinResult("' + LB64 + '")');
|
|
LogLine('PIN blob served');
|
|
end
|
|
else
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onPinResult)Bridge.onPinResult(null)');
|
|
end
|
|
|
|
else if ACmd = 'pin/clear' then
|
|
begin
|
|
PM.PinUnlock.ClearPinUnlock;
|
|
LogLine('PIN blob cleared');
|
|
end
|
|
|
|
else if ACmd = 'pin/status' then
|
|
begin
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onPinStatus)' +
|
|
'Bridge.onPinStatus(' +
|
|
BoolToStr(PM.PinUnlock.HasPinUnlock, 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
|
|
// Slot ids of the combos Windows refused (already held by another app).
|
|
// Ids, not labels: JS owns the wording AND uses them to flag the exact
|
|
// row in Settings. A combo the user cleared (vk=0) is never listed.
|
|
var LFailed := '';
|
|
// Quick-search combo is set unconditionally (independent of the
|
|
// autofill enabled flag) so the picker stays armed even when the
|
|
// autofill hotkeys are turned off.
|
|
if GetParam('qs_vk') <> '' then
|
|
begin
|
|
var LQsMods := Word(StrToIntDef(GetParam('qs_mods'), 6));
|
|
var LQsVk := Word(StrToIntDef(GetParam('qs_vk'), Ord('Q')));
|
|
var LQsOk := FBridge.SetQuickSearchHotkey(LQsMods, LQsVk);
|
|
if (not LQsOk) and (LQsVk <> 0) then LFailed := LFailed + 'quickSearch,';
|
|
LogLine(Format('Quick-search hotkey set — mods:%d vk:%d (ok=%s)',
|
|
[LQsMods, LQsVk, BoolToStr(LQsOk, True)]));
|
|
end;
|
|
// New-entry combo — also independent of the autofill enabled flag
|
|
// (Ctrl+Shift+A works even with autofill turned off).
|
|
if GetParam('ne_vk') <> '' then
|
|
begin
|
|
var LNeMods := Word(StrToIntDef(GetParam('ne_mods'), 6));
|
|
var LNeVk := Word(StrToIntDef(GetParam('ne_vk'), Ord('A')));
|
|
var LNeOk := FBridge.SetNewEntryHotkey(LNeMods, LNeVk);
|
|
if (not LNeOk) and (LNeVk <> 0) then LFailed := LFailed + 'newEntry,';
|
|
LogLine(Format('New-entry hotkey set — mods:%d vk:%d (ok=%s)',
|
|
[LNeMods, LNeVk, BoolToStr(LNeOk, True)]));
|
|
end;
|
|
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')));
|
|
// 2FA combo — vk 0 when the user cleared it, which skips registration.
|
|
var LTotpMods := Word(StrToIntDef(GetParam('totp_mods'), 6));
|
|
var LTotpVk := Word(StrToIntDef(GetParam('totp_vk'), Ord('T')));
|
|
var LAllOk := FBridge.SetAutofillHotkeys(LFullMods, LFullVk,
|
|
LPwdMods, LPwdVk,
|
|
LTotpMods, LTotpVk);
|
|
LogLine(Format('Autofill hotkeys set — full=mods:%d vk:%d pwd=mods:%d vk:%d totp=mods:%d vk:%d (all_ok=%s)',
|
|
[LFullMods, LFullVk, LPwdMods, LPwdVk, LTotpMods, LTotpVk, BoolToStr(LAllOk, True)]));
|
|
if (not FBridge.AutofillFullActive) and (LFullVk <> 0) then
|
|
LFailed := LFailed + 'full,';
|
|
if (not FBridge.AutofillPwdActive) and (LPwdVk <> 0) then
|
|
LFailed := LFailed + 'password,';
|
|
if (not FBridge.AutofillTotpActive) and (LTotpVk <> 0) then
|
|
LFailed := LFailed + 'totp,';
|
|
end;
|
|
// One notification for the whole batch, naming the combos that failed —
|
|
// empty string = everything registered.
|
|
LFailed := LFailed.TrimRight([',', ' ']);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onAutofillHotkeysResult)' +
|
|
'Bridge.onAutofillHotkeysResult("' + LFailed.Replace('"', '') + '")');
|
|
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';
|
|
FAutofillPendingUserOnly := GetParam('field') = 'user';
|
|
FAutofillPendingClear := GetParam('clear') <> '0'; // absent = ON
|
|
FAutofillPendingNotify := GetParam('notify') <> '0'; // absent = ON
|
|
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.
|
|
// Hand the foreground back to the window the hotkey came from (Esc in the
|
|
// quick-search means "never mind, return me to where I was"). We're the
|
|
// foreground process at that moment, so plain SetForegroundWindow works.
|
|
else if ACmd = 'autofill/cancel' then
|
|
begin
|
|
if FAutofillTargetHWND <> 0 then
|
|
SetForegroundWindow(FAutofillTargetHWND);
|
|
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
|
|
// keepclip=1 → don't wipe the clipboard on minimise (quick-search
|
|
// copy-then-hide flow). Default clears it as before.
|
|
FBridge.MinimizeToTray(GetParam('keepclip') <> '1')
|
|
|
|
// 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')
|
|
|
|
// Build/version string exposed to JS for the Settings → About panel.
|
|
// Hardcoded const — bump manually on releases. Kept simple to avoid
|
|
// pulling Windows resource version info at runtime.
|
|
else if ACmd = 'app/version' then
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onVersionResult)' +
|
|
'Bridge.onVersionResult("' + APP_VERSION + '")')
|
|
|
|
// Launch context: the HKCU Run entry passes -tray so we can tell
|
|
// "Windows started me at boot" from "user double-clicked the exe".
|
|
// Useful for Settings → Account display and for conditional behavior
|
|
// (e.g. skip first-time tooltips on autostart).
|
|
else if ACmd = 'app/launch-mode' then
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onLaunchModeResult)' +
|
|
'Bridge.onLaunchModeResult("' +
|
|
IfThen(FindCmdLineSwitch('tray', True), 'auto', 'manual') + '")')
|
|
|
|
// 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
|
|
|
|
// ---- WebDAV remote sync (THTTPClient → WinHTTP, async) --------------
|
|
// cmd://webdav/get | put | test ?reqId=&url=&user=&pwd=[&data=]
|
|
// Callback: Bridge.onWebdavResult(reqId, status, bodyOrError)
|
|
// - GET ok → status=200, body=base64 of response bytes
|
|
// - GET 404 → status=404, body='' (caller treats as "no remote yet")
|
|
// - PUT ok → status=200/201/204, body=''
|
|
// - test → status=200..399 means reachable, body=''
|
|
// Network errors → status=0, body=exception message.
|
|
else if (ACmd = 'webdav/get') or (ACmd = 'webdav/put') or (ACmd = 'webdav/test')
|
|
or (ACmd = 'webdav/put-commit') then
|
|
begin
|
|
var LMethod := ACmd;
|
|
var LReqId := GetParam('reqId');
|
|
var LUrl := GetParam('url');
|
|
var LUser := GetParam('user');
|
|
var LPwd := GetParam('pwd');
|
|
var LData := GetParam('data');
|
|
// put-commit: the (large) body arrived in chunks via file/chunk,
|
|
// accumulated in FFileSaveChunks keyed by reqId. Pull it out and treat
|
|
// the rest as a normal PUT.
|
|
if ACmd = 'webdav/put-commit' then
|
|
begin
|
|
var LSB: TStringBuilder;
|
|
if FFileSaveChunks.TryGetValue(LReqId, LSB) then
|
|
begin
|
|
LData := LSB.ToString;
|
|
LSB.Free;
|
|
FFileSaveChunks.Remove(LReqId);
|
|
end
|
|
else
|
|
LData := '';
|
|
LMethod := 'webdav/put';
|
|
end;
|
|
// Optimistic concurrency: JS passes the ETag it saw at pull time; we
|
|
// send it as If-Match on the push so the server rejects (412) the
|
|
// write when another device changed the file in between.
|
|
var LIfMatch := GetParam('ifmatch');
|
|
TThread.CreateAnonymousThread(
|
|
procedure
|
|
var
|
|
LHttp: System.Net.HttpClient.THTTPClient;
|
|
LResp: System.Net.HttpClient.IHTTPResponse;
|
|
LBodyStream: TBytesStream;
|
|
LReqStream: TBytesStream;
|
|
LBytes: TBytes;
|
|
LBodyB64: string;
|
|
LStatus: Integer;
|
|
LErr: string;
|
|
LEtag: string;
|
|
begin
|
|
LStatus := 0;
|
|
LBodyB64 := '';
|
|
LErr := '';
|
|
LEtag := '';
|
|
try
|
|
LHttp := System.Net.HttpClient.THTTPClient.Create;
|
|
try
|
|
LHttp.ConnectionTimeout := 10000;
|
|
LHttp.ResponseTimeout := 30000;
|
|
if (LUser <> '') then
|
|
begin
|
|
LHttp.CredentialsStorage.AddCredential(
|
|
System.Net.URLClient.TCredentialsStorage.TCredential.Create(
|
|
System.Net.URLClient.TAuthTargetType.Server, '', '', LUser, LPwd));
|
|
end;
|
|
if LMethod = 'webdav/get' then
|
|
begin
|
|
LBodyStream := TBytesStream.Create;
|
|
try
|
|
LResp := LHttp.Get(LUrl, LBodyStream);
|
|
LStatus := LResp.StatusCode;
|
|
LEtag := LResp.HeaderValue['ETag'];
|
|
if (LStatus >= 200) and (LStatus < 300) and (LBodyStream.Size > 0) then
|
|
begin
|
|
SetLength(LBytes, LBodyStream.Size);
|
|
Move(LBodyStream.Bytes[0], LBytes[0], LBodyStream.Size);
|
|
LBodyB64 := TNetEncoding.Base64.EncodeBytesToString(LBytes);
|
|
LBodyB64 := StringReplace(LBodyB64, #13, '', [rfReplaceAll]);
|
|
LBodyB64 := StringReplace(LBodyB64, #10, '', [rfReplaceAll]);
|
|
end;
|
|
finally
|
|
LBodyStream.Free;
|
|
end;
|
|
end
|
|
else if LMethod = 'webdav/put' then
|
|
begin
|
|
LBytes := TNetEncoding.Base64.DecodeStringToBytes(LData);
|
|
LReqStream := TBytesStream.Create(LBytes);
|
|
try
|
|
if LIfMatch <> '' then
|
|
LResp := LHttp.Put(LUrl, LReqStream, nil,
|
|
[System.Net.URLClient.TNetHeader.Create('If-Match', LIfMatch)])
|
|
else
|
|
LResp := LHttp.Put(LUrl, LReqStream);
|
|
LStatus := LResp.StatusCode;
|
|
LEtag := LResp.HeaderValue['ETag'];
|
|
finally
|
|
LReqStream.Free;
|
|
end;
|
|
end
|
|
else // webdav/test — HEAD is widely supported even when PROPFIND isn't
|
|
begin
|
|
LResp := LHttp.Head(LUrl);
|
|
LStatus := LResp.StatusCode;
|
|
end;
|
|
finally
|
|
LHttp.Free;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
LStatus := 0;
|
|
LErr := E.Message;
|
|
end;
|
|
end;
|
|
TThread.Queue(nil,
|
|
procedure
|
|
var
|
|
LEscReq, LEscPayload, LEscEtag: string;
|
|
begin
|
|
LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]);
|
|
// GET success path → ship body base64. Otherwise the field
|
|
// carries either the empty string or the exception message
|
|
// (for status=0 network errors).
|
|
if (LMethod = 'webdav/get') and (LStatus >= 200) and (LStatus < 300) then
|
|
LEscPayload := LBodyB64
|
|
else
|
|
LEscPayload := LErr;
|
|
LEscPayload := StringReplace(LEscPayload, '\', '\\', [rfReplaceAll]);
|
|
LEscPayload := StringReplace(LEscPayload, '"', '\"', [rfReplaceAll]);
|
|
LEscPayload := StringReplace(LEscPayload, #13, '', [rfReplaceAll]);
|
|
LEscPayload := StringReplace(LEscPayload, #10, '\n', [rfReplaceAll]);
|
|
LEscEtag := StringReplace(LEtag, '\', '\\', [rfReplaceAll]);
|
|
LEscEtag := StringReplace(LEscEtag, '"', '\"', [rfReplaceAll]);
|
|
LEscEtag := StringReplace(LEscEtag, #13, '', [rfReplaceAll]);
|
|
LEscEtag := StringReplace(LEscEtag, #10, '', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onWebdavResult)' +
|
|
'Bridge.onWebdavResult("' + LEscReq + '",' +
|
|
IntToStr(LStatus) + ',"' + LEscPayload + '","' + LEscEtag + '")');
|
|
LogLine(Format('%s %s → %d (%d bytes payload, etag=%s)',
|
|
[LMethod, LUrl, LStatus, Length(LEscPayload), LEtag]));
|
|
end);
|
|
end).Start;
|
|
end
|
|
|
|
// ---- Native file save (bypasses WebView2's browser download UI) ------
|
|
// JS sends: cmd://file/save?name=<filename>&data=<base64>&reqId=<id>
|
|
// 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
|
|
// Single-shot: small payload fits in one cmd:// URL.
|
|
SaveDecodedFile(GetParam('name'), GetParam('data'), GetParam('reqId'))
|
|
|
|
// Chunked large-file transfer: accumulate base64 pieces keyed by reqId,
|
|
// ack each so JS can send the next (see Bridge.saveFile chunk path).
|
|
else if ACmd = 'file/chunk' then
|
|
begin
|
|
var LReqId := GetParam('reqId');
|
|
var LData := GetParam('data');
|
|
var LSB: TStringBuilder;
|
|
if not FFileSaveChunks.TryGetValue(LReqId, LSB) then
|
|
begin
|
|
LSB := TStringBuilder.Create;
|
|
FFileSaveChunks.Add(LReqId, LSB);
|
|
end;
|
|
LSB.Append(LData);
|
|
var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onFileChunkAck)' +
|
|
'Bridge.onFileChunkAck("' + LEscReq + '")');
|
|
end
|
|
|
|
// Commit the accumulated chunks: reconstruct the full base64, run the
|
|
// shared save routine, then discard the buffer.
|
|
else if ACmd = 'file/save-commit' then
|
|
begin
|
|
var LReqId := GetParam('reqId');
|
|
var LSB: TStringBuilder;
|
|
if FFileSaveChunks.TryGetValue(LReqId, LSB) then
|
|
begin
|
|
var LFull := LSB.ToString;
|
|
LSB.Free;
|
|
FFileSaveChunks.Remove(LReqId);
|
|
SaveDecodedFile(GetParam('name'), LFull, LReqId);
|
|
end
|
|
else
|
|
begin
|
|
var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onFileSaveResult)' +
|
|
'Bridge.onFileSaveResult("' + LEscReq + '",false,"","no chunks buffered")');
|
|
end;
|
|
end
|
|
|
|
// ---- Auto-backup: folder picker (modal Win32 dialog) -----------------
|
|
// cmd://folder/pick?reqId=<id>
|
|
// 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=<full>&data=<base64>&reqId=<id>
|
|
// Callback: Bridge.onFileWriteResult(reqId, ok, error)
|
|
else if ACmd = 'file/write' then
|
|
// Single-shot silent write (small payload).
|
|
WriteDecodedFile(GetParam('path'), GetParam('data'), GetParam('reqId'))
|
|
|
|
// Chunked silent write: chunks accumulated via file/chunk, committed
|
|
// here (large auto-backups exceed a single cmd:// URL otherwise).
|
|
else if ACmd = 'file/write-commit' then
|
|
begin
|
|
var LReqId := GetParam('reqId');
|
|
var LSB: TStringBuilder;
|
|
if FFileSaveChunks.TryGetValue(LReqId, LSB) then
|
|
begin
|
|
var LFull := LSB.ToString;
|
|
LSB.Free;
|
|
FFileSaveChunks.Remove(LReqId);
|
|
WriteDecodedFile(GetParam('path'), LFull, LReqId);
|
|
end
|
|
else
|
|
begin
|
|
var LEscReq := StringReplace(LReqId, '"', '\"', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onFileWriteResult)' +
|
|
'Bridge.onFileWriteResult("' + LEscReq + '",false,"no chunks buffered")');
|
|
end;
|
|
end
|
|
|
|
// ---- Auto-backup: list files in dir matching name prefix --------------
|
|
// cmd://file/listMatch?dir=<full>&prefix=<str>&reqId=<id>
|
|
// 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=<full>&reqId=<id>
|
|
// 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;
|
|
|
|
// Remember the window state the USER settled on. Minimised is skipped on
|
|
// purpose: that is precisely the state we have to survive, not record.
|
|
procedure TMainForm.FormResizeTrackState(Sender: TObject);
|
|
begin
|
|
if WindowState = TWindowState.wsMaximized then
|
|
FWantMaximized := True
|
|
else if WindowState = TWindowState.wsNormal then
|
|
FWantMaximized := False;
|
|
end;
|
|
|
|
// Re-apply "maximised" when the window comes back from an external minimise.
|
|
// Runs however the user returns (taskbar, tray, Alt+Tab), because none of our
|
|
// own restore paths are involved in a plain taskbar click.
|
|
procedure TMainForm.FormActivateRestoreState(Sender: TObject);
|
|
begin
|
|
if FWantMaximized and (WindowState = TWindowState.wsNormal) then
|
|
WindowState := TWindowState.wsMaximized;
|
|
end;
|
|
|
|
procedure TMainForm.AutofillTimerTick(Sender: TObject);
|
|
var
|
|
TargetHwnd: HWND;
|
|
PendingUser, PendingPass: string;
|
|
HideAfter, UserOnly, ClearFirst, NotifyFail: Boolean;
|
|
ForegroundAfter: HWND;
|
|
begin
|
|
TargetHwnd := FAutofillPendingHWND;
|
|
PendingUser := FAutofillPendingUser;
|
|
PendingPass := FAutofillPendingPass;
|
|
HideAfter := FAutofillPendingHide;
|
|
UserOnly := FAutofillPendingUserOnly;
|
|
ClearFirst := FAutofillPendingClear;
|
|
NotifyFail := FAutofillPendingNotify;
|
|
FAutofillPendingHWND := 0;
|
|
FAutofillPendingUser := '';
|
|
FAutofillPendingPass := '';
|
|
FAutofillPendingHide := False;
|
|
FAutofillPendingUserOnly := False;
|
|
FAutofillPendingClear := False;
|
|
FAutofillPendingNotify := False;
|
|
|
|
TTimer(Sender).Enabled := False;
|
|
TTimer(Sender).Free;
|
|
|
|
// ARestoreAfter = not HideAfter: if the app was open before the hotkey
|
|
// (quick-search beside the target), it stays visible during the fill; if it
|
|
// started hidden, the MinimizeToTray below re-hides it anyway.
|
|
var LFillOk := FBridge.ExecuteAutofill(TargetHwnd, PendingUser, PendingPass,
|
|
UserOnly, not HideAfter, ClearFirst);
|
|
ForegroundAfter := GetForegroundWindow;
|
|
LogLine(Format('Autofill executed — target=%s, foreground_after=%s, ok=%s',
|
|
[IntToHex(TargetHwnd, 8), IntToHex(ForegroundAfter, 8),
|
|
BoolToStr(LFillOk, True)]));
|
|
// Tell JS whether the keystrokes were actually sent — the success toast
|
|
// must not lie when the target runs elevated (UIPI drops our input).
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&typeof Bridge.onAutofillResult==="function")' +
|
|
'Bridge.onAutofillResult(' + BoolToStr(LFillOk, True).ToLower + ')');
|
|
// Window hidden (tray) → the in-app failure toast is invisible; surface
|
|
// the block via a tray balloon instead (gated by the dedicated
|
|
// "Tray alert when autofill is blocked" setting, default ON).
|
|
if (not LFillOk) and NotifyFail and
|
|
((not Self.Visible) or IsIconic(WindowHandleToPlatform(Self.Handle).Wnd)) then
|
|
FBridge.ShowBalloon('Autofill blocked',
|
|
'The target window runs as administrator — Windows silently blocks ' +
|
|
'simulated keystrokes. Copy the password instead.', 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('"', '\"');
|
|
|
|
case AKind of
|
|
akPasswordOnly: LKind := 'password';
|
|
akTotp: LKind := 'totp';
|
|
else LKind := 'full';
|
|
end;
|
|
|
|
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',
|
|
// Keep the renderer responsive while the window is hidden in the tray.
|
|
// Without these, Chromium freezes/throttles a backgrounded renderer, so
|
|
// the first autofill hotkey after a tray-only start (Start with Windows)
|
|
// waits 3-5s for the renderer to wake before onAutofillRequest runs.
|
|
'--disable-background-timer-throttling ' +
|
|
'--disable-backgrounding-occluded-windows ' +
|
|
'--disable-renderer-backgrounding ' +
|
|
'--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.
|