Zaki/Password-Manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: MFA tools, single-instance, tray polish, prefs persistence

Browse Source 
Session highlights:

- feat(prefs): DPAPI-backed key/value store (PM.UserPrefs) — fixes
  rememberedUsername being lost across reboots due to the random
  ephemeral HTTP port changing the localStorage origin every launch.
  Bridge cmd://prefs/{get,set} round-trips through Delphi.

- feat(tray): icon visible from startup (NIM_ADD at constructor, not
  at first minimize). Tray context menu themed via uxtheme!135
  SetPreferredAppMode so it follows the app's dark/light setting.

- feat(single-instance): named mutex + RegisterWindowMessage broadcast.
  Second launch posts WM_PMSHOW to HWND_BROADCAST and exits; the
  running bridge restores the window from tray. Mutex lives in Local\
  namespace so distinct Windows users can still each run one.

- feat(mfa): Authenticator sidebar view (live TOTP codes for every
  entry with a secret) + standalone TOTP generator modal (paste
  base32 / otpauth:// URI, or generate a random 20-byte secret).

- feat(sidebar): Folders / Tags / Tools sections collapsible with
  chevron toggle. Badge counts stay visible when collapsed. State
  persisted in settings_json (synced across devices).

- feat(autofill): hotkey when vault is locked now restores the app
  and focuses the master password input instead of no-op'ing
  silently. Cleaner UX for the common "I hit Ctrl+Shift+L but the
  vault was locked" path.

- feat(quick-unlock): when enabled, skip lockVault on Windows lock /
  sleep. Rationale: the DPAPI blob already gates access via the
  Windows account, so re-locking on top of the OS lock is redundant.
  Idle auto-lock still fires (separate opt-in).

- fix(quick-unlock): re-sync state.quickUnlockEnabled from DPAPI
  source-of-truth at boot, instead of trusting (now-volatile)
  localStorage.

- docs: CLAUDE.md updated with all new modules, bridge commands,
  and the port-ephemeral pitfall.

Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
This commit is contained in:
Zaki
2026-06-08 21:31:39 +01:00
parent 664db65437
commit 40b3154a34
38 changed files with 8165 additions and 548 deletions
Download Patch File Download Diff File Expand all files Collapse all files
delphi-backend/Source/PM.Bridge.pas
+519 -14
View File
@@ -31,7 +31,8 @@ interface
uses
System.SysUtils, System.Classes, System.Math,
FMX.Types, FMX.Forms,
Winapi.Windows, Winapi.ShellAPI, Winapi.Messages;
Winapi.Windows, Winapi.ShellAPI, Winapi.Messages,
PM.SingleInstance;
type
// -------------------------------------------------------------------------
@@ -44,12 +45,29 @@ type
public
constructor Create;
destructor Destroy; override;
function ReadText: string;
// Copy AText to the clipboard, excluding it from Win+V history.
// AClearAfterMs = 0 disables auto-clear; default is 30 seconds.
procedure SetText(const AText: string; AClearAfterMs: Integer = 30000);
procedure Clear;
end;
// Distinguishes the "fill everything" hotkey (Ctrl+Shift+L) from the
// "password only" hotkey (Ctrl+Shift+P). The host decides what to type
// based on this kind.
TAutofillKind = (akFull, akPasswordOnly);
// Fired when an autofill hotkey is pressed. Args are the foreground
// window HWND and its title (captured before any focus change), plus
// the kind of fill requested.
// Declared as a method pointer (not TProc<>) because Delphi has no implicit
// conversion from "procedure of object" to "reference to procedure" — the
// host wires this with a regular form method (BridgeAutofillRequest).
TAutofillRequestEvent = procedure(AKind: TAutofillKind;
ATargetHWND: HWND; const ATitle: string) of object;
TNewEntryHotkeyEvent = procedure(const AWindowTitle: string) of object;
// -------------------------------------------------------------------------
// TPMBridge
// -------------------------------------------------------------------------
@@ -64,10 +82,28 @@ type
FPowerNotify: THandle; // registration handle from PowerRegisterSuspendResumeNotification
FSecureClipboard: TSecureClipboard;
FBalloonShown: Boolean;
// Window placement captured at MinimizeToTray time. Replayed on
// RestoreFromTray so the window comes back in the same state
// (maximised / normal + position + size) as before hiding.
FSavedPlacement: TWindowPlacement;
FHasSavedPlacement: Boolean;
FOnSystemLock: TProc;
FOnTrayRestore: TProc;
FOnLockRequest: TProc;
FOnQuit: TProc;
// Autofill: global hotkeys → inject credentials into browser. Combos
// are user-configurable from Settings; defaults are Ctrl+Shift+L /
// Ctrl+Shift+P. We track which IDs are actually live so unregister
// doesn't blindly call UnregisterHotKey on unregistered IDs (which
// would set GetLastError noise during shutdown).
FAutofillRegistered: Boolean;
FAutofillFullActive: Boolean;
FAutofillPwdActive: Boolean;
FOnAutofillRequest: TAutofillRequestEvent;
FDebugHotkeyRegistered: Boolean;
FOnDebugHotkey: TProc;
FNewEntryHotkeyRegistered: Boolean;
FOnNewEntryHotkey: TNewEntryHotkeyEvent;
procedure MsgWindowHandler(var AMsg: TMessage);
procedure PrepareNid;
procedure ShowTrayMenu;
@@ -80,8 +116,35 @@ type
procedure MinimizeToTray;
// Restore main window and remove tray icon.
procedure RestoreFromTray;
// Apply Windows dark-mode title bar to the main form. Win10 19044+
// / Win11 only — no-op on older builds. Safe to call repeatedly.
procedure ApplyTitleBarTheme(ADark: Boolean);
// Register the two autofill global hotkeys (full + password-only) with
// the given Win32 modifier flags (MOD_CONTROL/MOD_SHIFT/MOD_ALT/MOD_WIN
// bitmask) and virtual-key codes. Replaces any prior registration —
// safe to call repeatedly to swap combos at runtime.
// Returns True if both hotkeys registered successfully. If one or both
// failed (clash with another app), best-effort: whichever succeeded
// stays active.
function SetAutofillHotkeys(AFullMods, AFullVk,
APwdMods, APwdVk: Word): Boolean;
// Convenience wrapper: register the historical defaults (Ctrl+Shift+L
// and Ctrl+Shift+P). Used by the host on first start; runtime changes
// go through SetAutofillHotkeys.
procedure RegisterAutofillHotkey;
// Unregister both autofill hotkeys.
procedure UnregisterAutofillHotkey;
// Simulate username + Tab + password keystrokes into ATargetHWND.
// ATargetHWND = 0 → type into whatever window has focus.
// If AUsername is empty, only the password is typed (no Tab) — matches
// the password-only hotkey path AND avoids spurious Tab on entries
// without a stored username.
procedure ExecuteAutofill(ATargetHWND: HWND;
const AUsername, APassword: string);
property SecureClipboard: TSecureClipboard read FSecureClipboard;
property TrayAdded: Boolean read FTrayAdded;
property AutofillRegistered: Boolean read FAutofillRegistered;
// Fired on main thread when Windows locks the session (WTS_SESSION_LOCK).
property OnSystemLock: TProc read FOnSystemLock write FOnSystemLock;
// Fired on main thread when the user clicks the tray icon.
@@ -94,6 +157,17 @@ type
// bridge does not call it itself, so the host stays in control of
// shutdown order (server stop, save state, etc.).
property OnQuit: TProc read FOnQuit write FOnQuit;
// Fired on main thread when the autofill hotkey fires.
// Args: (ATargetHWND, AWindowTitle). Handler calls ExecuteJavaScript
// to let JS match the title against vault entries.
property OnAutofillRequest: TAutofillRequestEvent
read FOnAutofillRequest write FOnAutofillRequest;
property OnDebugHotkey: TProc
read FOnDebugHotkey write FOnDebugHotkey;
// Fires on Ctrl+Shift+A. Arg = foreground window title (stripped of
// browser suffix by the JS layer before pre-fill).
property OnNewEntryHotkey: TNewEntryHotkeyEvent
read FOnNewEntryHotkey write FOnNewEntryHotkey;
end;
implementation
@@ -130,6 +204,17 @@ const
PBT_APMRESUMEAUTOMATIC = $0012;
PBT_APMRESUMESUSPEND = $0007;
// Autofill hotkeys — Ctrl+Shift+L (full) and Ctrl+Shift+P (password only).
// IDs must not clash with other RegisterHotKey calls in this process;
// 42-43 are arbitrary and well outside the range used by FMX internals.
const
AUTOFILL_HOTKEY_ID_FULL = 42; // Ctrl+Shift+L → user + Tab + password
AUTOFILL_HOTKEY_ID_PWDONLY = 43; // Ctrl+Shift+P → password only
DEBUG_HOTKEY_ID = 44; // Ctrl+Shift+D → toggle debug panel
NEW_ENTRY_HOTKEY_ID = 45; // Ctrl+Shift+A → quick-add from window title
AF_MOD_CONTROL = $0002; // same value as MOD_CONTROL
AF_MOD_SHIFT = $0004; // same value as MOD_SHIFT
// Dynamic WTS function pointers — wtsapi32.dll is not guaranteed on all
// Windows SKUs (e.g. minimal Server Core without Session Services), so
// we load it at runtime and tolerate absence gracefully.
@@ -256,6 +341,28 @@ begin
end;
end;
function TSecureClipboard.ReadText: string;
var
H: THandle;
P: PChar;
begin
Result := '';
if not OpenClipboard(0) then Exit;
try
H := GetClipboardData(CF_UNICODETEXT);
if H = 0 then Exit;
P := PChar(GlobalLock(H));
if P <> nil then
try
Result := P;
finally
GlobalUnlock(H);
end;
finally
CloseClipboard;
end;
end;
// =============================================================================
// TPMBridge
// =============================================================================
@@ -273,6 +380,14 @@ begin
PrepareNid;
// Add the tray icon eagerly so it's visible from app startup, regardless
// of whether the window is shown or hidden. Without this, the tray icon
// only appears the first time the user minimizes — meaning fresh-launch
// users can't lock/quit from the tray and discover the feature only by
// accident. NIM_DELETE is now only called at shutdown.
if Shell_NotifyIcon(NIM_ADD, @FNid) then
FTrayAdded := True;
// Session-lock detection (fails silently if wtsapi32.dll is absent).
LoadWtsApi;
if Assigned(_WTSRegister) then
@@ -286,10 +401,21 @@ begin
LoadPowerApi;
if Assigned(_PowerRegister) then
_PowerRegister(DEVICE_NOTIFY_WINDOW_HANDLE, FMsgWindow, FPowerNotify);
FDebugHotkeyRegistered := RegisterHotKey(FMsgWindow, DEBUG_HOTKEY_ID,
AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('D'));
FNewEntryHotkeyRegistered := RegisterHotKey(FMsgWindow, NEW_ENTRY_HOTKEY_ID,
AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('A'));
end;
destructor TPMBridge.Destroy;
begin
if FDebugHotkeyRegistered then
UnregisterHotKey(FMsgWindow, DEBUG_HOTKEY_ID);
if FNewEntryHotkeyRegistered then
UnregisterHotKey(FMsgWindow, NEW_ENTRY_HOTKEY_ID);
if (FPowerNotify <> 0) and Assigned(_PowerUnregister) then
_PowerUnregister(FPowerNotify);
@@ -379,11 +505,8 @@ procedure TPMBridge.MinimizeToTray;
var
LFormHwnd, LAppHwnd: HWND;
begin
if not FTrayAdded then
begin
if Shell_NotifyIcon(NIM_ADD, @FNid) then
FTrayAdded := True;
end;
// Tray icon is added at construction time and persists for the app's
// lifetime — no NIM_ADD here.
// Extra safety: clear the clipboard immediately when the user minimizes,
// rather than waiting for the 30s auto-clear timer to fire. A password
@@ -394,6 +517,15 @@ begin
LFormHwnd := MainFormHWND(FMainForm);
LAppHwnd := FindFMXAppWindow;
// 0. Snapshot the window placement BEFORE hiding so RestoreFromTray can
// replay the exact same state (maximised / normal + size + position).
// Without this, ShowWindow(SW_RESTORE) below always returns to the
// "normal" state — a window that was maximised before hiding comes
// back un-maximised.
FillChar(FSavedPlacement, SizeOf(FSavedPlacement), 0);
FSavedPlacement.length := SizeOf(FSavedPlacement);
FHasSavedPlacement := GetWindowPlacement(LFormHwnd, @FSavedPlacement);
// 1. Hide the visible form via both FMX state and Win32 ShowWindow.
// Keeps the form invisible to the user.
FMainForm.Hide;
@@ -442,12 +574,7 @@ procedure TPMBridge.RestoreFromTray;
var
LFormHwnd, LAppHwnd: HWND;
begin
if FTrayAdded then
begin
Shell_NotifyIcon(NIM_DELETE, @FNid);
FTrayAdded := False;
end;
// Tray icon stays in the tray — we only show the window again.
LFormHwnd := MainFormHWND(FMainForm);
LAppHwnd := FindFMXAppWindow;
@@ -457,8 +584,23 @@ begin
ShowWindow(LAppHwnd, SW_SHOW);
FMainForm.Show;
ShowWindow(LFormHwnd, SW_SHOW);
ShowWindow(LFormHwnd, SW_RESTORE);
// Restore to the exact pre-tray state (maximised/normal + size + pos).
// Falls back to SW_RESTORE if we never captured a placement (e.g. tray
// restore was triggered without a prior MinimizeToTray call).
if FHasSavedPlacement then
begin
// showCmd governs whether the window comes back maximised or normal;
// it's what SW_RESTORE clobbers. We force it ourselves.
if FSavedPlacement.showCmd = SW_SHOWMINIMIZED then
FSavedPlacement.showCmd := SW_SHOWNORMAL; // never restore as minimised
SetWindowPlacement(LFormHwnd, @FSavedPlacement);
end
else
begin
ShowWindow(LFormHwnd, SW_SHOW);
ShowWindow(LFormHwnd, SW_RESTORE);
end;
SetForegroundWindow(LFormHwnd);
end;
@@ -543,9 +685,372 @@ begin
// suspends — fast handler required (no UI prompts, no network).
if AMsg.WParam = PBT_APMSUSPEND then
if Assigned(FOnSystemLock) then FOnSystemLock();
end
else if (AMsg.Msg <> 0) and (AMsg.Msg = WM_PMShowMessage) then
begin
// A second instance was launched and PostMessage'd HWND_BROADCAST.
// Bring our window back to the front instead of letting that second
// process spawn its own UI.
if Assigned(FOnTrayRestore) then FOnTrayRestore();
end
else if (AMsg.Msg = WM_HOTKEY) and (AMsg.WParam = DEBUG_HOTKEY_ID) then
begin
if Assigned(FOnDebugHotkey) then FOnDebugHotkey();
end
else if (AMsg.Msg = WM_HOTKEY) and (AMsg.WParam = NEW_ENTRY_HOTKEY_ID) then
begin
if Assigned(FOnNewEntryHotkey) then
begin
var LTarget := GetForegroundWindow;
var LTitle: string;
SetLength(LTitle, 512);
var LLen := GetWindowTextW(LTarget, PChar(LTitle), 512);
SetLength(LTitle, LLen);
FOnNewEntryHotkey(LTitle);
end;
end
else if (AMsg.Msg = WM_HOTKEY) and Assigned(FOnAutofillRequest) and
((AMsg.WParam = AUTOFILL_HOTKEY_ID_FULL) or
(AMsg.WParam = AUTOFILL_HOTKEY_ID_PWDONLY)) then
begin
// Capture the foreground window BEFORE any focus change, then fire the
// callback so the host can match the title against vault entries.
var LKind: TAutofillKind;
if AMsg.WParam = AUTOFILL_HOTKEY_ID_PWDONLY then
LKind := akPasswordOnly
else
LKind := akFull;
var LTarget := GetForegroundWindow;
var LTitle: string;
SetLength(LTitle, 512);
var LLen := GetWindowTextW(LTarget, PChar(LTitle), 512);
SetLength(LTitle, LLen);
FOnAutofillRequest(LKind, LTarget, LTitle);
end;
AMsg.Result := DefWindowProc(FMsgWindow, AMsg.Msg, AMsg.WParam, AMsg.LParam);
end;
// =============================================================================
// TPMBridge — Autofill hotkey + SendInput
// =============================================================================
function TPMBridge.SetAutofillHotkeys(AFullMods, AFullVk,
APwdMods, APwdVk: Word): Boolean;
begin
// Tear down whatever is currently registered before installing the new
// combos. RegisterHotKey would fail if the same ID is already taken.
if FAutofillFullActive then
begin
UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_FULL);
FAutofillFullActive := False;
end;
if FAutofillPwdActive then
begin
UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_PWDONLY);
FAutofillPwdActive := False;
end;
// Best-effort registration. A failure (typically MOD_x clash with another
// app's global hotkey) is silent: the other slot can still be live.
if (AFullVk <> 0) and (AFullMods <> 0) then
FAutofillFullActive := RegisterHotKey(FMsgWindow,
AUTOFILL_HOTKEY_ID_FULL, AFullMods, AFullVk);
if (APwdVk <> 0) and (APwdMods <> 0) then
FAutofillPwdActive := RegisterHotKey(FMsgWindow,
AUTOFILL_HOTKEY_ID_PWDONLY, APwdMods, APwdVk);
FAutofillRegistered := FAutofillFullActive or FAutofillPwdActive;
Result := FAutofillFullActive and FAutofillPwdActive;
end;
procedure TPMBridge.ApplyTitleBarTheme(ADark: Boolean);
const
DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
// uxtheme.dll private API, stable since Win10 1809. File Explorer, Edge
// and Office use this to opt their UI (including popup menus, scrollbars,
// tooltips) into dark mode. Signature changed in 1903 to take an enum:
// 0=Default 1=AllowDark 2=ForceDark 3=ForceLight 4=Max
// We use ForceDark / ForceLight for unambiguous behaviour.
APPMODE_DEFAULT = 0;
APPMODE_FORCE_DARK = 2;
APPMODE_FORCE_LIGHT = 3;
type
TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD;
pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
TSetPreferredAppMode = function(AppMode: Integer): Integer; stdcall;
TFlushMenuThemes = procedure; stdcall;
var
DwmLib, UxLib: HMODULE;
DwmSetWindowAttribute: TDwmSetWindowAttribute;
SetPreferredAppMode: TSetPreferredAppMode;
FlushMenuThemes: TFlushMenuThemes;
DarkFlag: BOOL;
FormHwnd: HWND;
begin
if FMainForm = nil then Exit;
FormHwnd := MainFormHWND(FMainForm);
if FormHwnd = 0 then Exit;
// 1. Title bar (DWM immersive dark mode).
DwmLib := LoadLibrary('dwmapi.dll');
if DwmLib <> 0 then
try
@DwmSetWindowAttribute := GetProcAddress(DwmLib, 'DwmSetWindowAttribute');
if Assigned(DwmSetWindowAttribute) then
begin
DarkFlag := ADark;
DwmSetWindowAttribute(FormHwnd, DWMWA_USE_IMMERSIVE_DARK_MODE,
@DarkFlag, SizeOf(DarkFlag));
end;
finally
FreeLibrary(DwmLib);
end;
// 2. App-wide preferred mode (themes popup menus, scrollbars, tooltips).
// Loaded by ordinal because the functions are not exported by name.
UxLib := LoadLibrary('uxtheme.dll');
if UxLib <> 0 then
try
@SetPreferredAppMode := GetProcAddress(UxLib, MAKEINTRESOURCE(135));
@FlushMenuThemes := GetProcAddress(UxLib, MAKEINTRESOURCE(136));
if Assigned(SetPreferredAppMode) then
begin
if ADark then SetPreferredAppMode(APPMODE_FORCE_DARK)
else SetPreferredAppMode(APPMODE_FORCE_LIGHT);
if Assigned(FlushMenuThemes) then FlushMenuThemes;
end;
finally
FreeLibrary(UxLib);
end;
end;
procedure TPMBridge.RegisterAutofillHotkey;
begin
// Convenience default — Ctrl+Shift+L (full) + Ctrl+Shift+P (password).
// Idempotent: calling twice with the same combos is harmless.
SetAutofillHotkeys(AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('L'),
AF_MOD_CONTROL or AF_MOD_SHIFT, Ord('P'));
end;
procedure TPMBridge.UnregisterAutofillHotkey;
begin
if FAutofillFullActive then
begin
UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_FULL);
FAutofillFullActive := False;
end;
if FAutofillPwdActive then
begin
UnregisterHotKey(FMsgWindow, AUTOFILL_HOTKEY_ID_PWDONLY);
FAutofillPwdActive := False;
end;
FAutofillRegistered := False;
end;
// Block until the user releases Ctrl, Shift, Alt, and Win, or until ATimeoutMs
// elapses. Without this, an autofill triggered by Ctrl+Shift+L injects
// keystrokes WHILE Ctrl+Shift are physically held — turning our Tab into
// Ctrl+Tab (next tab in Chrome), our 's' into Ctrl+S, etc. 1000 ms is a
// generous bound; typical release happens within 50-150 ms.
procedure WaitForModifierRelease(ATimeoutMs: Cardinal);
var
LStart: Cardinal;
begin
LStart := GetTickCount;
while ((GetAsyncKeyState(VK_CONTROL) and $8000) <> 0)
or ((GetAsyncKeyState(VK_SHIFT) and $8000) <> 0)
or ((GetAsyncKeyState(VK_MENU) and $8000) <> 0) // Alt
or ((GetAsyncKeyState(VK_LWIN) and $8000) <> 0)
or ((GetAsyncKeyState(VK_RWIN) and $8000) <> 0) do
begin
Sleep(15);
if GetTickCount - LStart > ATimeoutMs then Break;
end;
end;
// Build (and immediately send) a key-down+up pair for each char in AText
// using KEYEVENTF_UNICODE. Returns nothing — best-effort.
procedure SendUnicodeString(const AText: string);
var
LInputs: TArray<TInput>;
LCount, I: Integer;
begin
if AText = '' then Exit;
SetLength(LInputs, Length(AText) * 2);
LCount := 0;
for I := 1 to Length(AText) do
begin
FillChar(LInputs[LCount], SizeOf(TInput), 0);
FillChar(LInputs[LCount + 1], SizeOf(TInput), 0);
LInputs[LCount].Itype := INPUT_KEYBOARD;
LInputs[LCount].ki.wScan := Ord(AText[I]);
LInputs[LCount].ki.dwFlags := KEYEVENTF_UNICODE;
LInputs[LCount + 1] := LInputs[LCount];
LInputs[LCount + 1].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;
Inc(LCount, 2);
end;
SendInput(LCount, @LInputs[0], SizeOf(TInput));
end;
// Send one virtual-key press (down+up).
procedure SendVKey(AVk: Word);
var
LInputs: array[0..1] of TInput;
begin
FillChar(LInputs, SizeOf(LInputs), 0);
LInputs[0].Itype := INPUT_KEYBOARD;
LInputs[0].ki.wVk := AVk;
LInputs[1] := LInputs[0];
LInputs[1].ki.dwFlags := KEYEVENTF_KEYUP;
SendInput(2, @LInputs[0], SizeOf(TInput));
end;
procedure SendSelectAllAndDelete;
var
LInputs: array[0..5] of TInput;
begin
FillChar(LInputs, SizeOf(LInputs), 0);
LInputs[0].Itype := INPUT_KEYBOARD;
LInputs[0].ki.wVk := VK_CONTROL;
LInputs[1].Itype := INPUT_KEYBOARD;
LInputs[1].ki.wVk := Ord('A');
LInputs[2].Itype := INPUT_KEYBOARD;
LInputs[2].ki.wVk := Ord('A');
LInputs[2].ki.dwFlags := KEYEVENTF_KEYUP;
LInputs[3].Itype := INPUT_KEYBOARD;
LInputs[3].ki.wVk := VK_CONTROL;
LInputs[3].ki.dwFlags := KEYEVENTF_KEYUP;
LInputs[4].Itype := INPUT_KEYBOARD;
LInputs[4].ki.wVk := VK_DELETE;
LInputs[5] := LInputs[4];
LInputs[5].ki.dwFlags := KEYEVENTF_KEYUP;
SendInput(6, @LInputs[0], SizeOf(TInput));
end;
// Always-attach foreground switch. The early SetForegroundWindow shortcut
// was unreliable after the picker click — Win10/11 still refused the focus
// hand-off even when our process was foreground. Always doing the attach
// dance is slightly slower but actually works.
function ForceForegroundWindow(ATargetHwnd: HWND): Boolean;
const
ForegroundPollIntervalMs = 20;
ForegroundPollTimeoutMs = 600;
var
CallerThread, TargetThread, TargetPid: DWORD;
ThreadsAttached: Boolean;
WaitStart: Cardinal;
begin
Result := False;
if (ATargetHwnd = 0) or not IsWindow(ATargetHwnd) then Exit;
TargetPid := 0;
TargetThread := GetWindowThreadProcessId(ATargetHwnd, TargetPid);
CallerThread := GetCurrentThreadId;
if TargetThread = 0 then Exit;
ThreadsAttached := (TargetThread <> CallerThread) and
AttachThreadInput(CallerThread, TargetThread, True);
try
if IsIconic(ATargetHwnd) then
ShowWindow(ATargetHwnd, SW_RESTORE);
BringWindowToTop(ATargetHwnd);
SetWindowPos(ATargetHwnd, HWND_TOP, 0, 0, 0, 0,
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
SetForegroundWindow(ATargetHwnd);
WaitStart := GetTickCount;
while GetForegroundWindow <> ATargetHwnd do
begin
if GetTickCount - WaitStart > ForegroundPollTimeoutMs then Break;
Sleep(ForegroundPollIntervalMs);
SetForegroundWindow(ATargetHwnd);
end;
Result := GetForegroundWindow = ATargetHwnd;
finally
if ThreadsAttached then
AttachThreadInput(CallerThread, TargetThread, False);
end;
end;
procedure ClickTargetCenterToGrabFocus(ATargetHwnd: HWND);
const
PostClickSettleMs = 40;
var
WindowRect: TRect;
CenterAbsX, CenterAbsY, ScreenW, ScreenH: Integer;
SavedCursor: TPoint;
MouseInputs: array[0..2] of TInput;
begin
if (ATargetHwnd = 0) or not IsWindow(ATargetHwnd) then Exit;
if not GetWindowRect(ATargetHwnd, WindowRect) then Exit;
CenterAbsX := (WindowRect.Left + WindowRect.Right) div 2;
CenterAbsY := (WindowRect.Top + WindowRect.Bottom) div 2;
ScreenW := GetSystemMetrics(SM_CXSCREEN);
ScreenH := GetSystemMetrics(SM_CYSCREEN);
if (ScreenW <= 0) or (ScreenH <= 0) then Exit;
GetCursorPos(SavedCursor);
FillChar(MouseInputs, SizeOf(MouseInputs), 0);
MouseInputs[0].Itype := INPUT_MOUSE;
MouseInputs[0].mi.dx := (CenterAbsX * 65535) div ScreenW;
MouseInputs[0].mi.dy := (CenterAbsY * 65535) div ScreenH;
MouseInputs[0].mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or MOUSEEVENTF_LEFTDOWN;
MouseInputs[1] := MouseInputs[0];
MouseInputs[1].mi.dwFlags:= MOUSEEVENTF_LEFTUP;
MouseInputs[2].Itype := INPUT_MOUSE;
MouseInputs[2].mi.dx := (SavedCursor.X * 65535) div ScreenW;
MouseInputs[2].mi.dy := (SavedCursor.Y * 65535) div ScreenH;
MouseInputs[2].mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
SendInput(3, @MouseInputs[0], SizeOf(TInput));
Sleep(PostClickSettleMs);
end;
procedure TPMBridge.ExecuteAutofill(ATargetHWND: HWND;
const AUsername, APassword: string);
const
MinimizeSettleMs = 80;
FocusSettleDelayMs = 120;
var
OwnFormHwnd: HWND;
begin
OwnFormHwnd := MainFormHWND(FMainForm);
if GetForegroundWindow = OwnFormHwnd then
begin
ShowWindow(OwnFormHwnd, SW_MINIMIZE);
Sleep(MinimizeSettleMs);
end;
if ATargetHWND <> 0 then
ForceForegroundWindow(ATargetHWND);
WaitForModifierRelease(1000);
Sleep(FocusSettleDelayMs);
if AUsername = '' then
begin
SendSelectAllAndDelete;
Sleep(60);
SendUnicodeString(APassword);
Exit;
end;
SendSelectAllAndDelete;
Sleep(60);
SendUnicodeString(AUsername);
Sleep(200);
SendVKey(VK_TAB);
Sleep(200);
SendSelectAllAndDelete;
Sleep(60);
SendUnicodeString(APassword);
end;
end.