2ef636ce30
Unified create/edit slideover
- openSlideOver(id) now accepts null for new entries. Same UI
(icon, name, site, user, password, TOTP, folder, tags) for both
create and edit. Drops the separate entry modal — no more "save
first, then add TOTP" two-step.
- "+ New" button, Ctrl+K → New entry, and Ctrl+Shift+A all route
through the slideover. Ctrl+Shift+A pre-fills the title with the
foreground window's name.
- Save button visible from the start in new mode (no dirty wait).
- Title shows mode unambiguously: cyan "+ New entry" vs
"Edit · <name>".
Custom icon upload (soIconField)
- 56×56 preview at the top of every slideover + Upload icon /
Remove buttons. Same POST /entries/{id}/icon endpoint as the
auto-fetch path. Validates type / size (64 KB cap matching server).
- Solves the case where DDG doesn't index a domain (self-hosted
apps, private sites): the user pastes any image and it sticks.
Favicon: privacy-first, DDG only
- Removed the direct-fetch fallback steps (3-5). Privacy stance:
zero DNS leak outside icons.duckduckgo.com. Domains DDG doesn't
cover stay icon-less until the user uploads a custom one.
- PM.Favicon.FetchFaviconDataUri takes an optional TFaviconLog
callback so UMainForm can stream per-step trace into LogLine for
diagnostics.
Fixes
- Slideover z-index 30 → 50. The topbar's backdrop-filter creates a
stacking context at z-index 40 which was clipping the slideover
header (title + close button hidden behind topbar).
- RestoreFromTray no longer un-maximises a maximised window when
called outside a tray-restore context (Ctrl+Shift+A, Ctrl+Shift+L
picker, app/focus cmd). SW_RESTORE on a maximised window reverts
to normal — now we only SW_RESTORE if IsIconic.
- "Show all"/"Show less" per-category state survives renderGrid
re-renders (healthExpanded map).
- "+ New" and dashboard "Fix" buttons stopPropagation so the
document-level click-outside handler doesn't close the slideover
they just opened.
- soDirtyCheck keeps Save visible while in new mode regardless of
diff.
- openSlideover → openSlideOver typo fix across all call sites.
Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
739 lines
25 KiB
ObjectPascal
739 lines
25 KiB
ObjectPascal
unit UMainForm;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, System.UITypes, System.NetEncoding,
|
|
System.StrUtils,
|
|
Winapi.Windows,
|
|
FMX.Forms, FMX.Controls, FMX.Controls.Presentation, FMX.StdCtrls,
|
|
FMX.Memo, FMX.Memo.Types, FMX.ScrollBox, FMX.Edit, FMX.Layouts, FMX.Types,
|
|
FMX.Dialogs, FMX.DialogService,
|
|
FMX.TMSFNCTypes, FMX.TMSFNCUtils, FMX.TMSFNCGraphics, FMX.TMSFNCGraphicsTypes,
|
|
FMX.TMSFNCCustomControl, FMX.TMSFNCWebBrowser,
|
|
PM.HTTPServer, PM.Bridge, PM.QuickUnlock, PM.UserPrefs, PM.AutoStart,
|
|
PM.Favicon;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
PanelTop: TPanel;
|
|
btnStart: TButton;
|
|
btnStop: TButton;
|
|
lblStatus: TLabel;
|
|
edtPort: TEdit;
|
|
lblPort: TLabel;
|
|
btnToggleLog: TButton;
|
|
btnReload: TButton;
|
|
PanelLog: TPanel;
|
|
Memo: TMemo;
|
|
Splitter: TSplitter;
|
|
WebBrowser: TTMSFNCWebBrowser;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure btnStartClick(Sender: TObject);
|
|
procedure btnStopClick(Sender: TObject);
|
|
procedure btnToggleLogClick(Sender: TObject);
|
|
procedure btnReloadClick(Sender: TObject);
|
|
private
|
|
FServer: TPMHTTPServer;
|
|
FBridge: TPMBridge;
|
|
FPendingURL: string;
|
|
FNavTimer: TTimer;
|
|
FRequireAccessToken: Boolean;
|
|
FRequireProcessCheck: Boolean;
|
|
FQuitting: Boolean; // set when user picks "Quit" in tray menu — bypasses
|
|
// FormCloseQuery's minimize-to-tray intercept.
|
|
FAutofillTargetHWND: HWND; // saved at hotkey time, consumed on /execute
|
|
// Pending payload for the 60ms delay timer (focus settle before SendInput).
|
|
// Cleared inside AutofillTimerTick.
|
|
FAutofillPendingHWND: HWND;
|
|
FAutofillPendingUser: string;
|
|
FAutofillPendingPass: string;
|
|
procedure AutofillTimerTick(Sender: TObject);
|
|
procedure LogLine(const AMsg: string);
|
|
procedure UpdateButtons;
|
|
procedure NavigateToVault;
|
|
procedure NavTimerTick(Sender: TObject);
|
|
// JS↔Delphi bridge
|
|
procedure WebBrowserBeforeNavigate(Sender: TObject;
|
|
var Params: TTMSFNCCustomWebBrowserBeforeNavigateParams);
|
|
procedure HandleBridgeCommand(const ACmd, AParams: string);
|
|
procedure BridgeSystemLock;
|
|
procedure BridgeTrayRestore;
|
|
procedure BridgeLockRequest;
|
|
procedure BridgeQuit;
|
|
procedure BridgeAutofillRequest(AKind: TAutofillKind;
|
|
ATargetHWND: HWND; const ATitle: string);
|
|
procedure BridgeDebugHotkey;
|
|
procedure BridgeNewEntryHotkey(const AWindowTitle: string);
|
|
procedure WebBrowserInitialized(Sender: TObject);
|
|
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;
|
|
FBridge.OnAutofillRequest := BridgeAutofillRequest;
|
|
FBridge.OnDebugHotkey := BridgeDebugHotkey;
|
|
FBridge.OnNewEntryHotkey := BridgeNewEntryHotkey;
|
|
FBridge.RegisterAutofillHotkey; // Ctrl+Shift+L active from startup
|
|
FBridge.ApplyTitleBarTheme(True); // dark by default, JS may toggle later
|
|
FAutofillTargetHWND := 0;
|
|
|
|
WebBrowser.OnBeforeNavigate := WebBrowserBeforeNavigate;
|
|
WebBrowser.OnInitialized := WebBrowserInitialized;
|
|
|
|
// Delayed-Navigate timer: TTMSFNCWebBrowser (WebView2 backend) ignores
|
|
// Navigate() calls until Edge Chromium finishes its async init (~1-2s).
|
|
// We wait 1.5 s after Start, then issue a SINGLE Navigate — no retry loop
|
|
// (retrying caused the loaded page to reload every interval, making icons
|
|
// flash). If Edge needed longer than 1.5 s, user clicks Reload.
|
|
FNavTimer := TTimer.Create(Self);
|
|
FNavTimer.Interval := 1500;
|
|
FNavTimer.Enabled := False;
|
|
FNavTimer.OnTimer := NavTimerTick;
|
|
|
|
UpdateButtons;
|
|
LogLine('Password Manager - Delphi backend ready.');
|
|
LogLine('Click Start to launch server + embedded web vault.');
|
|
PanelTop.Visible := False;
|
|
FRequireAccessToken := True;
|
|
FRequireProcessCheck := True;
|
|
edtPort.Text := '0';
|
|
if FileExists('config.txt') then
|
|
begin
|
|
var configList := TStringList.Create;
|
|
configList.LoadFromFile('config.txt');
|
|
try
|
|
var defPort := StrToIntDef(configList.Values['port'], 0);
|
|
edtPort.Text := defPort.ToString;
|
|
PanelTop.Visible := configList.Values['debug'].ToLower.Equals('true');
|
|
if configList.Values['require_token'].ToLower.Equals('false') then
|
|
FRequireAccessToken := False;
|
|
if configList.Values['require_process_check'].ToLower.Equals('false') then
|
|
FRequireProcessCheck := False;
|
|
finally
|
|
FreeAndNil(configList);
|
|
end;
|
|
end;
|
|
btnStartClick(Nil);
|
|
btnToggleLogClick(nil);
|
|
|
|
// CLI flag --tray (set by the "Start with Windows" registry entry):
|
|
// launch directly into the tray instead of popping a window during
|
|
// the Windows login. Defer to ForceQueue so the form has finished its
|
|
// initial Show before we hide it — minimises the visible flash.
|
|
if FindCmdLineSwitch('tray', True) then
|
|
begin
|
|
TThread.ForceQueue(nil,
|
|
procedure
|
|
begin
|
|
FBridge.MinimizeToTray;
|
|
LogLine('Launched with --tray, minimised at startup');
|
|
end);
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
FBridge.Free;
|
|
FServer.Free;
|
|
end;
|
|
|
|
procedure TMainForm.WebBrowserInitialized(Sender: TObject);
|
|
begin
|
|
WebBrowser.EnableContextMenu := False;
|
|
WebBrowser.EnableShowDebugConsole := False;
|
|
end;
|
|
|
|
procedure TMainForm.BridgeNewEntryHotkey(const AWindowTitle: string);
|
|
var
|
|
EscapedTitle: string;
|
|
begin
|
|
if not FServer.Active then Exit;
|
|
FBridge.RestoreFromTray;
|
|
EscapedTitle := StringReplace(AWindowTitle, '\', '\\', [rfReplaceAll]);
|
|
EscapedTitle := StringReplace(EscapedTitle, '"', '\"', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&typeof Bridge.onNewEntryFromTitle==="function")' +
|
|
'Bridge.onNewEntryFromTitle("' + EscapedTitle + '")');
|
|
LogLine('New entry hotkey — title: "' + AWindowTitle + '"');
|
|
end;
|
|
|
|
procedure TMainForm.BridgeDebugHotkey;
|
|
begin
|
|
if not FileExists('config.txt') then
|
|
Exit;
|
|
PanelTop.Visible := not PanelTop.Visible;
|
|
LogLine('Debug panel ' + IfThen(PanelTop.Visible, 'shown', 'hidden') +
|
|
' via Ctrl+Shift+D');
|
|
end;
|
|
|
|
Procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
// The tray-menu "Quit" handler sets FQuitting before triggering close,
|
|
// so we bypass the minimize-to-tray intercept in that case.
|
|
if FQuitting then Exit;
|
|
|
|
// Otherwise: minimize to tray on close instead of quitting, so the vault
|
|
// stays available without the dev-panel being visible.
|
|
// When the server is stopped, allow normal close — there's no vault to
|
|
// keep alive in the background.
|
|
if FServer.Active then
|
|
begin
|
|
CanClose := False;
|
|
FBridge.MinimizeToTray;
|
|
LogLine('Minimized to tray. Click the tray icon to restore.');
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.LogLine(const AMsg: string);
|
|
begin
|
|
// Synchronize handles both cases: if already on main thread, runs inline;
|
|
// otherwise marshals. Avoids overload resolution issues with TThread.Queue.
|
|
TThread.Synchronize(nil,
|
|
procedure
|
|
begin
|
|
Memo.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' ' + AMsg);
|
|
Memo.GoToTextEnd;
|
|
end);
|
|
end;
|
|
|
|
procedure TMainForm.UpdateButtons;
|
|
begin
|
|
btnStart.Enabled := not FServer.Active;
|
|
btnStop.Enabled := FServer.Active;
|
|
btnReload.Enabled := FServer.Active;
|
|
edtPort.Enabled := not FServer.Active;
|
|
if FServer.Active then
|
|
lblStatus.Text := 'Running on http://127.0.0.1:' + edtPort.Text
|
|
else
|
|
lblStatus.Text := 'Stopped';
|
|
end;
|
|
|
|
function MaskAccessToken(const AUrl: string): string;
|
|
var
|
|
TokenPos: Integer;
|
|
begin
|
|
Result := AUrl;
|
|
TokenPos := Pos('?pmt=', Result);
|
|
if TokenPos > 0 then
|
|
Result := Copy(Result, 1, TokenPos + 4) + '***';
|
|
end;
|
|
|
|
procedure TMainForm.NavigateToVault;
|
|
begin
|
|
FPendingURL := 'http://127.0.0.1:' + FServer.BoundPort.ToString + '/index.html';
|
|
if FServer.RequireAccessToken then
|
|
FPendingURL := FPendingURL + '?pmt=' + FServer.AccessToken;
|
|
LogLine('Will navigate embedded browser in ~1.5s to: ' + MaskAccessToken(FPendingURL));
|
|
FNavTimer.Enabled := False;
|
|
FNavTimer.Enabled := True;
|
|
end;
|
|
|
|
procedure TMainForm.NavTimerTick(Sender: TObject);
|
|
begin
|
|
FNavTimer.Enabled := False;
|
|
if FPendingURL = '' then Exit;
|
|
LogLine('Navigating to: ' + MaskAccessToken(FPendingURL));
|
|
WebBrowser.Navigate(FPendingURL);
|
|
FPendingURL := '';
|
|
end;
|
|
|
|
procedure TMainForm.btnStartClick(Sender: TObject);
|
|
var
|
|
LPort: Integer;
|
|
begin
|
|
LPort := StrToIntDef(edtPort.Text, 8765);
|
|
try
|
|
FServer.Start(LPort, True, FRequireAccessToken, FRequireProcessCheck);
|
|
edtPort.Text := FServer.BoundPort.ToString;
|
|
UpdateButtons;
|
|
NavigateToVault;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
LogLine('ERROR starting server: ' + E.Message);
|
|
TDialogService.MessageDialog('Failed to start: ' + E.Message,
|
|
TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0, nil);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.btnStopClick(Sender: TObject);
|
|
begin
|
|
FServer.Stop;
|
|
UpdateButtons;
|
|
FPendingURL := '';
|
|
FNavTimer.Enabled := False;
|
|
WebBrowser.Navigate('about:blank');
|
|
end;
|
|
|
|
procedure TMainForm.btnReloadClick(Sender: TObject);
|
|
begin
|
|
if FServer.Active then NavigateToVault;
|
|
end;
|
|
|
|
procedure TMainForm.btnToggleLogClick(Sender: TObject);
|
|
begin
|
|
PanelLog.Visible := not PanelLog.Visible;
|
|
Splitter.Visible := PanelLog.Visible;
|
|
if PanelLog.Visible then
|
|
btnToggleLog.Text := 'Hide log'
|
|
else
|
|
btnToggleLog.Text := 'Show log';
|
|
end;
|
|
|
|
// ---------------------------------------------------------------------------
|
|
// JS↔Delphi bridge
|
|
// ---------------------------------------------------------------------------
|
|
|
|
procedure TMainForm.WebBrowserBeforeNavigate(Sender: TObject;
|
|
var Params: TTMSFNCCustomWebBrowserBeforeNavigateParams);
|
|
var
|
|
URL, Cmd, ParamStr: string;
|
|
P: Integer;
|
|
begin
|
|
URL := Params.URL;
|
|
if not URL.StartsWith('cmd://') then Exit;
|
|
|
|
Params.Cancel := True;
|
|
URL := URL.Substring(6); // strip 'cmd://'
|
|
|
|
P := Pos('?', URL);
|
|
if P > 0 then
|
|
begin
|
|
Cmd := Copy(URL, 1, P - 1);
|
|
ParamStr := Copy(URL, P + 1, MaxInt);
|
|
end
|
|
else
|
|
begin
|
|
Cmd := URL;
|
|
ParamStr := '';
|
|
end;
|
|
|
|
// Defer to avoid WebView2 re-entrance issues.
|
|
TThread.ForceQueue(nil,
|
|
procedure
|
|
begin
|
|
HandleBridgeCommand(Cmd, ParamStr);
|
|
end);
|
|
end;
|
|
|
|
procedure TMainForm.HandleBridgeCommand(const ACmd, AParams: string);
|
|
|
|
function GetParam(const AKey: string): string;
|
|
var
|
|
Parts: TArray<string>;
|
|
Part, K, V: string;
|
|
EqPos: Integer;
|
|
begin
|
|
Result := '';
|
|
Parts := AParams.Split(['&']);
|
|
for Part in Parts do
|
|
begin
|
|
EqPos := Pos('=', Part);
|
|
if EqPos > 0 then
|
|
begin
|
|
K := Copy(Part, 1, EqPos - 1);
|
|
V := Copy(Part, EqPos + 1, MaxInt);
|
|
if SameText(K, AKey) then
|
|
begin
|
|
Result := TNetEncoding.URL.Decode(V);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
LText: string;
|
|
LClearMs: Integer;
|
|
begin
|
|
if ACmd = 'clipboard/copy' then
|
|
begin
|
|
LText := GetParam('text');
|
|
LClearMs := StrToIntDef(GetParam('clear'), 30000);
|
|
FBridge.SecureClipboard.SetText(LText, LClearMs);
|
|
LogLine(Format('Secure clipboard set (auto-clear in %ds)', [LClearMs div 1000]));
|
|
end
|
|
|
|
else if ACmd = 'clipboard/clear' then
|
|
begin
|
|
FBridge.SecureClipboard.Clear;
|
|
LogLine('Clipboard cleared by JS request');
|
|
end
|
|
|
|
else if ACmd = 'clipboard/read' then
|
|
begin
|
|
var ClipText := FBridge.SecureClipboard.ReadText;
|
|
var Escaped := StringReplace(ClipText, '\', '\\', [rfReplaceAll]);
|
|
Escaped := StringReplace(Escaped, '"', '\"', [rfReplaceAll]);
|
|
Escaped := StringReplace(Escaped, #13, '\r', [rfReplaceAll]);
|
|
Escaped := StringReplace(Escaped, #10, '\n', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onClipboardRead)Bridge.onClipboardRead("' + Escaped + '")');
|
|
end
|
|
|
|
// ---- Quick unlock (DPAPI persistence of the vault key) ----
|
|
// store: client provides a base64-encoded blob (UTF-8 JSON, content
|
|
// opaque to us). We DPAPI-encrypt and stash on disk.
|
|
// get: we DPAPI-decrypt, base64-encode, send back via ExecuteJavaScript.
|
|
// clear: forget-me.
|
|
else if ACmd = 'quickunlock/store' then
|
|
begin
|
|
LText := GetParam('data'); // base64 of UTF-8 JSON blob
|
|
if LText = '' then Exit;
|
|
var LBytes := TNetEncoding.Base64.DecodeStringToBytes(LText);
|
|
if PM.QuickUnlock.StoreQuickUnlock(LBytes) then
|
|
LogLine(Format('Quick unlock stored (%d bytes)', [Length(LBytes)]))
|
|
else
|
|
LogLine('Quick unlock store FAILED (DPAPI error)');
|
|
end
|
|
|
|
else if ACmd = 'quickunlock/get' then
|
|
begin
|
|
var LBytes: TBytes;
|
|
if PM.QuickUnlock.LoadQuickUnlock(LBytes) and (Length(LBytes) > 0) then
|
|
begin
|
|
var LB64 := TNetEncoding.Base64.EncodeBytesToString(LBytes);
|
|
// Strip newlines that the Base64 encoder may insert (line-wrapping
|
|
// breaks the JS-side decoder) before injecting into a JS string.
|
|
LB64 := StringReplace(LB64, #13, '', [rfReplaceAll]);
|
|
LB64 := StringReplace(LB64, #10, '', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onQuickUnlockResult)' +
|
|
'Bridge.onQuickUnlockResult("' + LB64 + '")');
|
|
LogLine('Quick unlock served');
|
|
end
|
|
else
|
|
begin
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onQuickUnlockResult)' +
|
|
'Bridge.onQuickUnlockResult(null)');
|
|
end;
|
|
end
|
|
|
|
else if ACmd = 'quickunlock/clear' then
|
|
begin
|
|
PM.QuickUnlock.ClearQuickUnlock;
|
|
LogLine('Quick unlock cleared');
|
|
end
|
|
|
|
else if ACmd = 'quickunlock/status' then
|
|
begin
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onQuickUnlockStatus)' +
|
|
'Bridge.onQuickUnlockStatus(' +
|
|
BoolToStr(PM.QuickUnlock.HasQuickUnlock, True).ToLower + ')');
|
|
end
|
|
|
|
// ---- Autofill --------------------------------------------------------
|
|
// configure: JS calls this on page load / settings change to sync the
|
|
// hotkey registration state with the user's localStorage preference.
|
|
// Uses the historical defaults (Ctrl+Shift+L / Ctrl+Shift+P) — for
|
|
// custom combos, JS sends cmd://autofill/hotkeys instead.
|
|
else if ACmd = 'autofill/configure' then
|
|
begin
|
|
if GetParam('enabled') = '1' then
|
|
begin
|
|
FBridge.RegisterAutofillHotkey;
|
|
LogLine('Autofill hotkeys registered (defaults)');
|
|
end
|
|
else
|
|
begin
|
|
FBridge.UnregisterAutofillHotkey;
|
|
LogLine('Autofill hotkeys unregistered');
|
|
end;
|
|
end
|
|
|
|
// hotkeys: JS pushes the user-configured combos. Params:
|
|
// enabled = '1' | '0'
|
|
// full_mods = MOD_x bitmask (decimal), full_vk = VK code (decimal)
|
|
// pwd_mods, pwd_vk = same for the password-only hotkey
|
|
// If enabled=0, we just unregister and ignore the rest. If enabled=1,
|
|
// we register both with the supplied combos (replacing any prior).
|
|
else if ACmd = 'autofill/hotkeys' then
|
|
begin
|
|
if GetParam('enabled') <> '1' then
|
|
begin
|
|
FBridge.UnregisterAutofillHotkey;
|
|
LogLine('Autofill hotkeys unregistered (custom)');
|
|
end
|
|
else
|
|
begin
|
|
var LFullMods := Word(StrToIntDef(GetParam('full_mods'), 6)); // Ctrl+Shift
|
|
var LFullVk := Word(StrToIntDef(GetParam('full_vk'), Ord('L')));
|
|
var LPwdMods := Word(StrToIntDef(GetParam('pwd_mods'), 6));
|
|
var LPwdVk := Word(StrToIntDef(GetParam('pwd_vk'), Ord('P')));
|
|
var LAllOk := FBridge.SetAutofillHotkeys(LFullMods, LFullVk,
|
|
LPwdMods, LPwdVk);
|
|
LogLine(Format('Autofill hotkeys set — full=mods:%d vk:%d pwd=mods:%d vk:%d (all_ok=%s)',
|
|
[LFullMods, LFullVk, LPwdMods, LPwdVk, BoolToStr(LAllOk, True)]));
|
|
// Notify JS of the result so the UI can flag a failed-to-register combo
|
|
// (typically a clash with another app's global hotkey).
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onAutofillHotkeysResult)' +
|
|
'Bridge.onAutofillHotkeysResult(' + BoolToStr(LAllOk, True).ToLower + ')');
|
|
end;
|
|
end
|
|
|
|
// execute: JS has matched an entry, decrypted the password, and is
|
|
// telling Delphi to type username + Tab + password into the saved HWND.
|
|
else if ACmd = 'autofill/execute' then
|
|
begin
|
|
FAutofillPendingUser := GetParam('username');
|
|
FAutofillPendingPass := GetParam('password');
|
|
FAutofillPendingHWND := FAutofillTargetHWND;
|
|
FAutofillTargetHWND := 0;
|
|
|
|
// Small timer so SetForegroundWindow has time to take effect before
|
|
// SendInput fires — avoids the first keystrokes going to our window.
|
|
// TTimer.OnTimer is a TNotifyEvent (method, not anon proc) → we use a
|
|
// dedicated method on the form and stash the payload in fields.
|
|
var LTimer := TTimer.Create(Self);
|
|
LTimer.Interval := 60;
|
|
LTimer.OnTimer := AutofillTimerTick;
|
|
LTimer.Enabled := True;
|
|
end
|
|
|
|
// cancel: JS found no match or user dismissed the picker — nothing to type.
|
|
else if ACmd = 'autofill/cancel' then
|
|
begin
|
|
FAutofillTargetHWND := 0;
|
|
LogLine('Autofill cancelled (no match or dismissed)');
|
|
end
|
|
|
|
// focus: JS asks us to bring the main window to front (e.g. when the
|
|
// autofill picker opens — without this the picker is shown in the
|
|
// WebView but the user might not notice if our window was minimised
|
|
// or behind other apps). The Target HWND stays saved; ExecuteAutofill
|
|
// restores it later via ForceForegroundWindow.
|
|
else if ACmd = 'app/focus' then
|
|
begin
|
|
FBridge.RestoreFromTray;
|
|
LogLine('App brought to front (autofill picker)');
|
|
end
|
|
|
|
else if ACmd = 'app/ready' then
|
|
begin
|
|
WebBrowser.SetFocus;
|
|
WebBrowser.ExecuteJavaScript(
|
|
'setTimeout(()=>{var u=document.getElementById("loginUsername"),' +
|
|
'p=document.getElementById("loginPassword");' +
|
|
'if(u&&u.value){p&&p.focus();}else{u&&u.focus();}},0)');
|
|
end
|
|
|
|
else if ACmd = 'app/theme' then
|
|
FBridge.ApplyTitleBarTheme(GetParam('mode') = 'dark')
|
|
|
|
// ---- Device-bound prefs (DPAPI key/value) ----------------------------
|
|
// Used for prefs that must survive the ephemeral-port reset of the
|
|
// WebView2 localStorage (rememberedUsername, etc.).
|
|
else if ACmd = 'prefs/get' then
|
|
begin
|
|
var LKey := GetParam('key');
|
|
if LKey = '' then Exit;
|
|
var LVal := PM.UserPrefs.GetPref(LKey);
|
|
var LEscapedKey := StringReplace(LKey, '\', '\\', [rfReplaceAll]);
|
|
LEscapedKey := StringReplace(LEscapedKey, '"', '\"', [rfReplaceAll]);
|
|
var LEscapedVal := StringReplace(LVal, '\', '\\', [rfReplaceAll]);
|
|
LEscapedVal := StringReplace(LEscapedVal, '"', '\"', [rfReplaceAll]);
|
|
LEscapedVal := StringReplace(LEscapedVal, #13, '\r', [rfReplaceAll]);
|
|
LEscapedVal := StringReplace(LEscapedVal, #10, '\n', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onPrefResult)' +
|
|
'Bridge.onPrefResult("' + LEscapedKey + '","' + LEscapedVal + '")');
|
|
end
|
|
|
|
else if ACmd = 'prefs/set' then
|
|
begin
|
|
var LKey := GetParam('key');
|
|
if LKey = '' then Exit;
|
|
PM.UserPrefs.SetPref(LKey, GetParam('value'));
|
|
end
|
|
|
|
// ---- Start with Windows (HKCU Run registry) --------------------------
|
|
else if ACmd = 'autostart/get' then
|
|
begin
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onAutoStartStatus)' +
|
|
'Bridge.onAutoStartStatus(' +
|
|
BoolToStr(PM.AutoStart.IsAutoStartEnabled, True).ToLower + ')');
|
|
end
|
|
|
|
// ---- Favicon proxy (Delphi-side fetch to keep CSP tight + privacy
|
|
// centralised on one upstream domain). Async: the HTTP GET would
|
|
// block the main thread for up to 5 s on slow networks.
|
|
else if ACmd = 'favicon/fetch' then
|
|
begin
|
|
var LHost := GetParam('host');
|
|
var LReqId := GetParam('reqId'); // opaque, echoed back to JS resolver
|
|
if LHost = '' then Exit;
|
|
LogLine('favicon/fetch host="' + LHost + '" reqId=' + LReqId);
|
|
TThread.CreateAnonymousThread(
|
|
procedure
|
|
var
|
|
LDataUri: string;
|
|
begin
|
|
LDataUri := PM.Favicon.FetchFaviconDataUri(LHost,
|
|
procedure(const ALine: string)
|
|
begin
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
LogLine('favicon[' + LHost + ']: ' + ALine);
|
|
end);
|
|
end);
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
if LDataUri = '' then
|
|
LogLine('favicon: NO RESULT for "' + LHost +
|
|
'" (TLS error? OpenSSL DLLs missing? DDG 404?)')
|
|
else
|
|
LogLine(Format('favicon: got %d bytes for "%s"',
|
|
[Length(LDataUri), LHost]));
|
|
end);
|
|
TThread.Queue(nil,
|
|
procedure
|
|
var
|
|
LEscHost, LEscData, LEscReq: string;
|
|
begin
|
|
LEscHost := StringReplace(LHost, '\', '\\', [rfReplaceAll]);
|
|
LEscHost := StringReplace(LEscHost, '"', '\"', [rfReplaceAll]);
|
|
LEscReq := StringReplace(LReqId, '\', '\\', [rfReplaceAll]);
|
|
LEscReq := StringReplace(LEscReq, '"', '\"', [rfReplaceAll]);
|
|
// The data URI is base64 (ASCII-safe) plus a small prefix —
|
|
// no embedded quotes by construction, but escape anyway.
|
|
LEscData := StringReplace(LDataUri, '\', '\\', [rfReplaceAll]);
|
|
LEscData := StringReplace(LEscData, '"', '\"', [rfReplaceAll]);
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onFaviconResult)' +
|
|
'Bridge.onFaviconResult("' + LEscReq + '","' + LEscHost + '","' +
|
|
LEscData + '")');
|
|
end);
|
|
end).Start;
|
|
end
|
|
|
|
else if ACmd = 'autostart/set' then
|
|
begin
|
|
var LOk := PM.AutoStart.SetAutoStart(GetParam('enabled') = '1');
|
|
LogLine(Format('Autostart set to %s (ok=%s)',
|
|
[GetParam('enabled'), BoolToStr(LOk, True)]));
|
|
// Echo back the resulting state so the UI re-syncs (covers the
|
|
// case where the registry write was blocked silently).
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&Bridge.onAutoStartStatus)' +
|
|
'Bridge.onAutoStartStatus(' +
|
|
BoolToStr(PM.AutoStart.IsAutoStartEnabled, True).ToLower + ')');
|
|
end
|
|
|
|
else
|
|
LogLine('Bridge: unknown command "' + ACmd + '"');
|
|
end;
|
|
|
|
procedure TMainForm.BridgeSystemLock;
|
|
begin
|
|
// Windows session locked or system suspending — delegate to Bridge.onSystemLock
|
|
// in JS which honours the "quick unlock" opt-out (DPAPI already gates
|
|
// access via the Windows account, so re-locking on top of Windows lock
|
|
// is redundant for users who enabled it).
|
|
LogLine('Windows session locked / suspend — notifying JS');
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&typeof Bridge.onSystemLock==="function")Bridge.onSystemLock();' +
|
|
'else if(typeof lockVault==="function")lockVault()');
|
|
end;
|
|
|
|
procedure TMainForm.BridgeTrayRestore;
|
|
begin
|
|
FBridge.RestoreFromTray;
|
|
// Notify the JS layer: the UI may want to reset the auto-lock timer,
|
|
// refresh state, or show a "welcome back" toast.
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&typeof Bridge.onTrayRestore==="function")Bridge.onTrayRestore()');
|
|
LogLine('Restored from tray');
|
|
end;
|
|
|
|
procedure TMainForm.BridgeLockRequest;
|
|
begin
|
|
// User picked "Lock vault" from the tray menu. Trigger lockVault() in
|
|
// JS — same path as the WTS_SESSION_LOCK auto-lock.
|
|
LogLine('Lock requested from tray menu');
|
|
WebBrowser.ExecuteJavaScript('if(typeof lockVault==="function")lockVault()');
|
|
end;
|
|
|
|
procedure TMainForm.BridgeQuit;
|
|
begin
|
|
// Re-entry guard: if Quit was already requested, ignore further calls.
|
|
if FQuitting then Exit;
|
|
|
|
LogLine('>>> BridgeQuit invoked (Quit from tray menu)');
|
|
FQuitting := True;
|
|
// Restore the form first so the tray icon goes away and FormDestroy
|
|
// executes from a normal (non-hidden) state. RestoreFromTray also
|
|
// deletes the tray icon.
|
|
FBridge.RestoreFromTray;
|
|
Application.Terminate;
|
|
end;
|
|
|
|
procedure TMainForm.AutofillTimerTick(Sender: TObject);
|
|
var
|
|
TargetHwnd: HWND;
|
|
PendingUser, PendingPass: string;
|
|
ForegroundAfter: HWND;
|
|
begin
|
|
TargetHwnd := FAutofillPendingHWND;
|
|
PendingUser := FAutofillPendingUser;
|
|
PendingPass := FAutofillPendingPass;
|
|
FAutofillPendingHWND := 0;
|
|
FAutofillPendingUser := '';
|
|
FAutofillPendingPass := '';
|
|
|
|
TTimer(Sender).Enabled := False;
|
|
TTimer(Sender).Free;
|
|
|
|
FBridge.ExecuteAutofill(TargetHwnd, PendingUser, PendingPass);
|
|
ForegroundAfter := GetForegroundWindow;
|
|
LogLine(Format('Autofill executed — target=%s, foreground_after=%s, match=%s',
|
|
[IntToHex(TargetHwnd, 8), IntToHex(ForegroundAfter, 8),
|
|
BoolToStr(ForegroundAfter = TargetHwnd, True)]));
|
|
end;
|
|
|
|
procedure TMainForm.BridgeAutofillRequest(AKind: TAutofillKind;
|
|
ATargetHWND: HWND; const ATitle: string);
|
|
var
|
|
LTitle, LKind: string;
|
|
begin
|
|
if not FServer.Active then Exit;
|
|
FAutofillTargetHWND := ATargetHWND;
|
|
|
|
// Escape the title for safe injection into a JS string literal.
|
|
LTitle := ATitle;
|
|
LTitle := LTitle.Replace('\', '\\');
|
|
LTitle := LTitle.Replace('"', '\"');
|
|
|
|
if AKind = akPasswordOnly then LKind := 'password' else LKind := 'full';
|
|
|
|
WebBrowser.ExecuteJavaScript(
|
|
'if(window.Bridge&&typeof Bridge.onAutofillRequest==="function")' +
|
|
'Bridge.onAutofillRequest("' + LTitle + '","' + LKind + '")');
|
|
LogLine('Autofill hotkey (' + LKind + ') — foreground: "' + ATitle + '"');
|
|
end;
|
|
|
|
end.
|