feat: Delphi backend + JS↔Delphi bridge (clipboard, tray, auto-lock)
Introduces the Delphi 12 FMX backend (PMServer) that hosts the embedded
WebView2 vault on 127.0.0.1, and a native bridge between JS and Delphi
that wires three privacy-focused features:
1. Secure clipboard
Copying a password registers the Win32 "ExcludeClipboardContentFromMonitorProcessing"
format alongside CF_UNICODETEXT, so Win+V clipboard history never sees
the value. Auto-clears after 30s via TTimer. Bridge.copySecure() in
app.js routes all password/username/secret copy paths through the
native layer when running inside the Delphi WebView2 (falls back to
navigator.clipboard for the PHP standalone).
2. Tray icon (X-to-tray when server running)
Closing the dev panel hides both the form HWND and the TFMAppClass
per-process proxy window that owns the FMX taskbar entry — the form's
HWND alone is not the taskbar-visible one in FMX (took some iteration
to discover). Tray menu: Open, Lock vault, Quit. Clipboard is force-
cleared on minimize as extra safety. First-time minimize fires a
balloon notification so the user knows the app is still running.
3. Auto-lock on Windows session lock (Win+L)
wtsapi32.dll!WTSRegisterSessionNotification on a dedicated message-only
window. On WM_WTSSESSION_CHANGE / WTS_SESSION_LOCK, the bridge calls
ExecuteJavaScript('lockVault()'). Same path used by the tray "Lock vault"
menu item.
Bridge architecture:
- JS → Delphi via cmd:// URLs intercepted in OnBeforeNavigate
(pattern lifted from DeskInsight Monaco). Currently exposes
cmd://clipboard/copy?text=...&clear=... and cmd://clipboard/clear.
- Delphi → JS via TTMSFNCWebBrowser.ExecuteJavaScript with guarded
calls (typeof check) so the bridge degrades cleanly if app.js isn't
loaded yet.
Files:
- Source/PM.Bridge.pas (new) — TSecureClipboard + TPMBridge
- UMainForm.pas/.fmx — bridge wiring, FormCloseQuery intercept, tray
callbacks (BridgeTrayRestore / BridgeLockRequest / BridgeQuit)
- js/app.js — Bridge object, 5 navigator.clipboard sites migrated to
Bridge.copySecure with PHP-compatible fallback, Bridge.onTrayRestore
handler that resets the auto-lock timer
.gitignore extended with Delphi build artifacts (*.dcu, Win32/, Win64/,
__history/, __recovery/, *.identcache, *.dsk, *.local, etc.) so source
checkouts stay clean.
This commit is contained in:
@@ -0,0 +1,115 @@
|
||||
unit PM.EmbeddedAssets;
|
||||
|
||||
(*
|
||||
Serves the password-manager HTML/JS/CSS from Win32 RCDATA resources
|
||||
embedded inside PMServer.exe by BuildAssets.ps1.
|
||||
|
||||
Workflow:
|
||||
1. Edit ../../index.html, ../../js/*.js, ../../css/*.css
|
||||
2. Run delphi-backend/assets/BuildAssets.ps1
|
||||
3. Rebuild — exe ships self-contained
|
||||
4. Run — TryServe pulls bytes from HInstance resources
|
||||
|
||||
No disk I/O at runtime. No external files needed beside PMServer.exe.
|
||||
|
||||
The manifest (URL path -> resource name) is generated alongside the .res:
|
||||
delphi-backend/assets/assets.inc, included below via {$I}. If the file
|
||||
does not exist (BuildAssets.ps1 never ran), the compile-time fallback
|
||||
registers no assets and TryServe always returns False.
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes,
|
||||
IdCustomHTTPServer;
|
||||
|
||||
type
|
||||
TEmbeddedAsset = record
|
||||
UrlPath: string;
|
||||
ResName: string;
|
||||
end;
|
||||
|
||||
function TryServeEmbedded(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Winapi.Windows;
|
||||
|
||||
// The manifest is auto-generated. A stub is checked in so the project
|
||||
// compiles before BuildAssets.ps1 ever runs; running the script overwrites
|
||||
// it with the real list.
|
||||
{$I ..\assets\assets.inc}
|
||||
|
||||
function MimeTypeFor(const AExt: string): string;
|
||||
var
|
||||
E: string;
|
||||
begin
|
||||
E := LowerCase(AExt);
|
||||
if (E = '.html') or (E = '.htm') then Exit('text/html; charset=utf-8');
|
||||
if E = '.js' then Exit('application/javascript; charset=utf-8');
|
||||
if E = '.mjs' then Exit('application/javascript; charset=utf-8');
|
||||
if E = '.css' then Exit('text/css; charset=utf-8');
|
||||
if E = '.json' then Exit('application/json; charset=utf-8');
|
||||
if E = '.svg' then Exit('image/svg+xml');
|
||||
if E = '.png' then Exit('image/png');
|
||||
if E = '.jpg' then Exit('image/jpeg');
|
||||
if E = '.jpeg' then Exit('image/jpeg');
|
||||
if E = '.gif' then Exit('image/gif');
|
||||
if E = '.ico' then Exit('image/x-icon');
|
||||
if E = '.woff' then Exit('font/woff');
|
||||
if E = '.woff2' then Exit('font/woff2');
|
||||
Result := 'application/octet-stream';
|
||||
end;
|
||||
|
||||
function FindResourceFor(const AUrlPath: string; out AResName: string): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
LPath: string;
|
||||
begin
|
||||
LPath := AUrlPath;
|
||||
if (LPath = '') or (LPath = '/') then LPath := '/index.html';
|
||||
for I := 0 to EMBEDDED_ASSET_COUNT - 1 do
|
||||
if SameText(EMBEDDED_ASSETS[I].UrlPath, LPath) then
|
||||
begin
|
||||
AResName := EMBEDDED_ASSETS[I].ResName;
|
||||
Exit(True);
|
||||
end;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TryServeEmbedded(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo): Boolean;
|
||||
var
|
||||
LResName, LExt: string;
|
||||
LStream: TResourceStream;
|
||||
LMS: TMemoryStream;
|
||||
begin
|
||||
Result := False;
|
||||
if not SameText(ARequest.Command, 'GET') then Exit;
|
||||
if not FindResourceFor(ARequest.Document, LResName) then Exit;
|
||||
if FindResource(HInstance, PChar(LResName), RT_RCDATA) = 0 then Exit;
|
||||
|
||||
LExt := ExtractFileExt(ARequest.Document);
|
||||
if (LExt = '') and ((ARequest.Document = '') or (ARequest.Document = '/')) then
|
||||
LExt := '.html';
|
||||
AResponse.ContentType := MimeTypeFor(LExt);
|
||||
|
||||
LStream := TResourceStream.Create(HInstance, LResName, RT_RCDATA);
|
||||
try
|
||||
// Copy into a TMemoryStream so Indy can own and free it after the response.
|
||||
LMS := TMemoryStream.Create;
|
||||
LMS.CopyFrom(LStream, 0);
|
||||
LMS.Position := 0;
|
||||
AResponse.ContentStream := LMS;
|
||||
AResponse.FreeContentStream := True;
|
||||
finally
|
||||
LStream.Free;
|
||||
end;
|
||||
AResponse.ResponseNo := 200;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user