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

feat: WebDAV sync + batch DnD + clean shutdown + center-modal UX bundle

Browse Source 
- Sync (WebDAV, auto-merge): UUID + tombstones foundations (server +
  JS), THTTPClient bridge cmds (get/put/test), runSyncNow engine with
  pull/merge/push flow, Settings UI, pre-sync backup option. Test
  connection now treats 404 as OK (snapshot not yet created) and 401/
  403 as auth failure with dedicated toast.
- Batch drag-drop: cards + table rows carry checked-set ids (CSV) when
  dragged from an active selection; folder + trash drop handlers parse
  and apply in batch via new moveEntriesToFolder helper that preserves
  TOTP / custom_fields / kind in the full PUT payload.
- Clean shutdown: WM_QUERYENDSESSION / WM_ENDSESSION captured in the
  bridge message-only window; FormCloseQuery bypasses the tray-minimize
  intercept on system shutdown / restart / logoff so FireDAC closes the
  SQLite WAL cleanly instead of leaving -shm / -wal residue after a
  force-kill.
- Center-mode modal: blur+dim backdrop via body::before pseudo-element
  in editor-position=center, swallows clicks below the panel so the
  existing outside-click handlers reliably dismiss the slideover /
  settings panel.
- Batch bar state fixes: state.checked cleared before render in
  moveEntriesToFolder, emptyTrash, and per-card restoreEntry /
  permanentDelete / deleteEntry so the action bar disappears once the
  selection is fully processed.
- Save-then-discard duplicate fix: soState reset to null before
  openSlideOver re-opens the freshly saved entry, otherwise the dirty
  check fired on the soState.id=null → newId switch and a Cancel left
  the form in new-entry mode (second Save → POST duplicate).
- TEST_SYNC.md: end-to-end checklist for validating the WebDAV sync
  with 2 real instances.

Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
This commit is contained in:
r-zakarya
2026-06-30 00:32:12 +01:00
parent b00da43ab0
commit 6869b7c692
10 changed files with 1132 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
delphi-backend/Handlers/PM.Handler.Entries.pas
+174 -7
View File
@@ -28,6 +28,21 @@ begin
if Result = '' then Result := ADefault;
end;
// RFC 4122 v4 UUID — lowercase canonical hex with dashes, no braces.
// Used as the cross-device stable identity for vault_entries.
function NewUUIDv4: string;
var
G: TGUID;
S: string;
begin
CreateGUID(G);
S := GUIDToString(G);
// Strip surrounding braces RTL adds, lowercase the rest.
if (Length(S) > 0) and (S[1] = '{') then
S := Copy(S, 2, Length(S) - 2);
Result := LowerCase(S);
end;
// SQLite DATETIME columns: FireDAC parses to TDateTime internally, then AsString
// would format in system locale (DD/MM/YYYY in French). Force ISO format
// 'yyyy-mm-dd hh:nn:ss' which is what api.php / SQLite text storage uses and
@@ -132,6 +147,8 @@ begin
LObj.AddPair('template', TJSONNull.Create)
else
LObj.AddPair('template', LQ.FieldByName('template').AsString);
// Stable cross-device identity (always populated post-migration).
LObj.AddPair('uuid', LQ.FieldByName('uuid').AsString);
// Custom fields: opaque ciphertext + IV, treated identically to
// password / totp_secret. NULL → JSON null so the client can
// distinguish "never set" from "empty array stored".
@@ -165,6 +182,117 @@ begin
TJSONHelper.SendJSON(AResponse, LArr);
end;
// ===== GET /entries/tombstones ==============================================
// Sync helper — returns the uuid + deleted_at of every permanently-removed
// entry so the merge engine can propagate deletes to other devices.
procedure HandleGetTombstones(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId: Integer;
LQ: TFDQuery;
LArr: TJSONArray;
LObj: TJSONObject;
begin
try
LUserId := Authenticate(ARequest, AResponse);
except
on ESessionRejected do Exit;
end;
LArr := TJSONArray.Create;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'SELECT uuid, deleted_at FROM entry_tombstones ' +
'WHERE user_id = :uid ORDER BY deleted_at DESC';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
while not LQ.Eof do
begin
LObj := TJSONObject.Create;
LObj.AddPair('uuid', LQ.FieldByName('uuid').AsString);
LObj.AddPair('deleted_at', ISODateTimeField(LQ.FieldByName('deleted_at')));
LArr.Add(LObj);
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendJSON(AResponse, LArr);
end;
// ===== POST /entries/tombstones =============================================
// Sync helper — body {uuids: ["x","y", ...]} adds tombstones for entries
// deleted on another device. Idempotent (UNIQUE constraint).
procedure HandlePostTombstones(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, I, LAdded: Integer;
LBody: TJSONObject;
LArr: TJSONArray;
LQ: TFDQuery;
LUuid: string;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
LAdded := 0;
try
LArr := LBody.GetValue<TJSONArray>('uuids');
if (LArr = nil) or (LArr.Count = 0) then
begin
TJSONHelper.SendOK(AResponse, 'No tombstones');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'VALUES (:uid, :u)';
for I := 0 to LArr.Count - 1 do
begin
LUuid := Trim(LArr.Items[I].Value);
if LUuid = '' then Continue;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('u').AsString := LUuid;
LQ.ExecSQL;
if LQ.RowsAffected > 0 then Inc(LAdded);
end;
// Hard-delete any local entries whose UUID just received a
// tombstone — propagates remote deletes during sync pull.
LQ.SQL.Text :=
'DELETE FROM vault_entries WHERE user_id = :uid AND uuid IN ' +
' (SELECT uuid FROM entry_tombstones WHERE user_id = :uid)';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
finally
LBody.Free;
end;
TJSONHelper.SendOK(AResponse, IntToStr(LAdded) + ' tombstones added');
end;
// ===== POST /entries =========================================================
procedure HandleCreateEntry(ARequest: TIdHTTPRequestInfo;
@@ -173,7 +301,7 @@ var
LUserId, LNewId: Integer;
LBody, LObj: TJSONObject;
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv,
LKind, LCf, LCfIv, LIcon, LTemplate: string;
LKind, LCf, LCfIv, LIcon, LTemplate, LUuid: string;
LQ: TFDQuery;
begin
try
@@ -200,6 +328,10 @@ begin
LCfIv := LBody.GetValue<string>('custom_fields_iv', '');
LIcon := LBody.GetValue<string>('icon_b64', '');
LTemplate:= Trim(LBody.GetValue<string>('template', ''));
// Caller may bring its own UUID (sync restore / import preserving
// identity). Otherwise the server mints a fresh one.
LUuid := Trim(LBody.GetValue<string>('uuid', ''));
if LUuid = '' then LUuid := NewUUIDv4;
finally
LBody.Free;
end;
@@ -229,9 +361,9 @@ begin
'INSERT INTO vault_entries ' +
'(user_id, site, title, username, encrypted_password, iv, encryption_method, ' +
' folder, tags, totp_secret, totp_iv, kind, custom_fields, custom_fields_iv,' +
' icon_b64, template, created_at, updated_at, password_changed_at) ' +
' icon_b64, template, uuid, created_at, updated_at, password_changed_at) ' +
'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :k, ' +
' :cf, :cfiv, :ic, :tpl, :c, :c2, :c)';
' :cf, :cfiv, :ic, :tpl, :uuid, :c, :c2, :c)';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('s').AsString := LSite;
LQ.ParamByName('tt').AsString := LTitle;
@@ -266,6 +398,7 @@ begin
LQ.ParamByName('tpl').DataType := ftString;
if LTemplate = '' then LQ.ParamByName('tpl').Clear
else LQ.ParamByName('tpl').AsString := LTemplate;
LQ.ParamByName('uuid').AsString := LUuid;
LQ.ParamByName('c').AsString := LNow;
LQ.ParamByName('c2').AsString := LNow;
LQ.ExecSQL;
@@ -280,6 +413,7 @@ begin
LogAudit(LUserId, 'add_entry', GetClientIP(ARequest));
LObj := TJSONObject.Create;
LObj.AddPair('id', TJSONNumber.Create(LNewId));
LObj.AddPair('uuid', LUuid);
LObj.AddPair('site', LSite);
LObj.AddPair('title', LTitle);
LObj.AddPair('username', LUser);
@@ -475,7 +609,19 @@ begin
try
LQ.Connection := DB.Connection;
if LPermanent then
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE id=:id AND user_id=:uid'
begin
// Record a tombstone BEFORE the delete so the sync engine can
// propagate this removal to other devices. UPSERT semantics —
// re-deleting an already-tombstoned uuid is a no-op.
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'SELECT user_id, uuid FROM vault_entries ' +
'WHERE id = :id AND user_id = :uid AND uuid IS NOT NULL';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE id=:id AND user_id=:uid';
end
else
LQ.SQL.Text :=
'UPDATE vault_entries SET deleted=1, deleted_at=datetime(''now'') ' +
@@ -870,6 +1016,16 @@ begin
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
// Tombstones FIRST so the sync engine can propagate the purge.
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'SELECT user_id, uuid FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = 1 AND uuid IS NOT NULL ' +
' AND deleted_at IS NOT NULL ' +
' AND (julianday(''now'') - julianday(deleted_at)) >= :d';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('d').AsInteger := LDays;
LQ.ExecSQL;
LQ.SQL.Text :=
'DELETE FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = 1 ' +
@@ -914,6 +1070,12 @@ begin
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'SELECT user_id, uuid FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = 1 AND uuid IS NOT NULL';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE user_id=:uid AND deleted=1';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
@@ -940,7 +1102,7 @@ var
LBody, LObj, LEntry: TJSONObject;
LArr, LIds: TJSONArray;
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LTotpSec, LTotpIv, LNow,
LKind, LCf, LCfIv, LIcon, LTemplate: string;
LKind, LCf, LCfIv, LIcon, LTemplate, LUuid: string;
LQ: TFDQuery;
begin
try
@@ -985,9 +1147,9 @@ begin
'INSERT INTO vault_entries ' +
'(user_id, site, title, username, encrypted_password, iv, encryption_method, ' +
' folder, tags, totp_secret, totp_iv, kind, custom_fields, custom_fields_iv,' +
' icon_b64, template, created_at, updated_at) ' +
' icon_b64, template, uuid, created_at, updated_at) ' +
'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :k, ' +
' :cf, :cfiv, :ic, :tpl, :c, :c2)';
' :cf, :cfiv, :ic, :tpl, :uuid, :c, :c2)';
// Declare optional param types ONCE — the prepared statement is
// reused across every imported entry, and FireDAC needs the
// type set before the first .Clear call would otherwise fail
@@ -1021,6 +1183,8 @@ begin
LCfIv := LEntry.GetValue<string>('custom_fields_iv', '');
LIcon := LEntry.GetValue<string>('icon_b64', '');
LTemplate:= Trim(LEntry.GetValue<string>('template', ''));
LUuid := Trim(LEntry.GetValue<string>('uuid', ''));
if LUuid = '' then LUuid := NewUUIDv4;
// Ciphertext is always required. Site is required only for
// logins — notes legitimately have no site (their body lives
@@ -1055,6 +1219,7 @@ begin
if LIcon = '' then LQ.ParamByName('ic').Clear else LQ.ParamByName('ic').Value := LIcon;
if LTemplate = '' then LQ.ParamByName('tpl').Clear
else LQ.ParamByName('tpl').AsString := LTemplate;
LQ.ParamByName('uuid').AsString := LUuid;
LQ.ParamByName('c').AsString := LNow;
LQ.ParamByName('c2').AsString := LNow;
LQ.ExecSQL;
@@ -1136,6 +1301,8 @@ initialization
Router.Register('DELETE', '/entries/trash/empty', HandleEmptyTrash);
Router.Register('DELETE', '/entries/trash/old', HandleAutoPurgeTrash);
Router.Register('DELETE', '/entries/icons/all', HandleClearAllIcons);
Router.Register('GET', '/entries/tombstones', HandleGetTombstones);
Router.Register('POST', '/entries/tombstones', HandlePostTombstones);
Router.Register('POST', '/entries/bulk-import', HandleBulkImport);
Router.Register('POST', '/entries/(\d+)/restore', HandleRestoreEntry);
Router.Register('POST', '/entries/(\d+)/favorite', HandleToggleFavorite);
delphi-backend/Source/PM.Bridge.pas
+21
View File
@@ -92,6 +92,12 @@ type
FSavedPlacement: TWindowPlacement;
FHasSavedPlacement: Boolean;
FOnSystemLock: TProc;
// Set TRUE the moment Windows tells us the session is ending
// (WM_QUERYENDSESSION / WM_ENDSESSION). FormCloseQuery checks this
// to bypass the "minimize to tray" intercept so the form closes
// normally and the DB connection is checkpointed instead of being
// force-killed (which leaves -shm / -wal files behind).
FShutdownPending: Boolean;
FOnTrayRestore: TProc;
FOnLockRequest: TProc;
FOnQuit: TProc;
@@ -158,6 +164,9 @@ type
property AutofillRegistered: Boolean read FAutofillRegistered;
// Fired on main thread when Windows locks the session (WTS_SESSION_LOCK).
property OnSystemLock: TProc read FOnSystemLock write FOnSystemLock;
// True once WM_QUERYENDSESSION (or WM_ENDSESSION) has been received.
// FormCloseQuery uses this to allow normal close during shutdown.
property ShutdownPending: Boolean read FShutdownPending;
// Fired on main thread when the user clicks the tray icon.
property OnTrayRestore: TProc read FOnTrayRestore write FOnTrayRestore;
// Fired when the user picks "Lock vault" from the tray menu. Handler
@@ -735,6 +744,18 @@ begin
if Assigned(FOnSystemLock) then FOnSystemLock();
end
else if (AMsg.Msg = WM_QUERYENDSESSION) or (AMsg.Msg = WM_ENDSESSION) then
begin
// Windows is logging off / shutting down / restarting. Flip the flag
// so FormCloseQuery lets the form actually close instead of
// minimizing to tray — otherwise Windows force-kills us after the
// shutdown timeout and SQLite's WAL/SHM never get checkpointed.
// Return TRUE (do not block shutdown). DefWindowProc returns TRUE
// by default for WM_QUERYENDSESSION, so we just don't assign Result.
FShutdownPending := True;
AMsg.Result := 1;
end
else if (AMsg.Msg <> 0) and (AMsg.Msg = WM_PMShowMessage) then
begin
// A second instance was launched and PostMessage'd HWND_BROADCAST.
delphi-backend/Source/PM.Database.pas
+36
View File
@@ -314,6 +314,42 @@ begin
// Drives the card/table label so notes-with-fields read as "Credit card"
// instead of the generic "Encrypted note" placeholder.
AddColumnIfMissing('vault_entries', 'template', 'TEXT');
// Stable identity that survives export/import + cross-device sync.
// SQLite `id` is autoincrement local-only — useless to match the same
// logical entry across two installs. Populate existing rows with a
// fresh UUID v4 below so the migration is non-destructive.
AddColumnIfMissing('vault_entries', 'uuid', 'TEXT');
FConn.ExecSQL(
'CREATE INDEX IF NOT EXISTS idx_entries_uuid ' +
' ON vault_entries(uuid)');
// Backfill UUIDs for legacy rows that landed before the column existed.
// SQLite has no native uuid() — emit one via hex(randomblob) + manual
// dashes (RFC 4122 v4 = 8-4-4-4-12 hex, version nibble forced to 4,
// variant nibble high bits 10).
FConn.ExecSQL(
'UPDATE vault_entries SET uuid = ' +
' lower(hex(randomblob(4))) || ''-'' || ' +
' lower(hex(randomblob(2))) || ''-4'' || ' +
' substr(lower(hex(randomblob(2))), 2) || ''-'' || ' +
' substr(''89ab'', 1 + (abs(random()) % 4), 1) || ' +
' substr(lower(hex(randomblob(2))), 2) || ''-'' || ' +
' lower(hex(randomblob(6))) ' +
'WHERE uuid IS NULL OR uuid = ''''');
// Tombstones: every hard-delete inserts a row here so the sync engine
// can propagate deletes to other devices without leaving deleted
// entries to silently reappear at next pull.
FConn.ExecSQL(
'CREATE TABLE IF NOT EXISTS entry_tombstones (' +
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
' user_id INTEGER NOT NULL,' +
' uuid TEXT NOT NULL,' +
' deleted_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
' FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE,' +
' UNIQUE(user_id, uuid)' +
')');
FConn.ExecSQL(
'CREATE INDEX IF NOT EXISTS idx_tombstones_user ' +
' ON entry_tombstones(user_id, deleted_at DESC)');
// Per-folder customisation. NULL = no override → JS uses the default
// accent + i-folder symbol.
AddColumnIfMissing('folders', 'color', 'TEXT');
delphi-backend/UMainForm.pas
+126
View File
@@ -18,6 +18,7 @@ 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,
@@ -370,6 +371,18 @@ begin
// 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
@@ -932,6 +945,119 @@ begin
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') 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');
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;
begin
LStatus := 0;
LBodyB64 := '';
LErr := '';
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;
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
LResp := LHttp.Put(LUrl, LReqStream);
LStatus := LResp.StatusCode;
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: 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]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onWebdavResult)' +
'Bridge.onWebdavResult("' + LEscReq + '",' +
IntToStr(LStatus) + ',"' + LEscPayload + '")');
LogLine(Format('%s %s → %d (%d bytes payload)',
[LMethod, LUrl, LStatus, Length(LEscPayload)]));
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
delphi-backend/assets/assets.res
BIN
View File
Binary file not shown.