unit PM.Handler.Entries; (* GET /entries?search=&deleted=0 -> JSON array of entries POST /entries body {site,username,encrypted_password,iv,folder} -> {id,site,username,folder} PUT /entries/{id} body {site,username,encrypted_password,iv,folder} -> {message} DELETE /entries/{id}?permanent=0|1 -> {message} POST /entries/{id}/restore -> {message} POST /entries/{id}/favorite -> {message} DELETE /entries/trash/empty -> {message} *) interface implementation uses System.SysUtils, System.JSON, System.StrUtils, System.NetEncoding, System.Generics.Collections, Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param, IdCustomHTTPServer, IdGlobalProtocols, IdURI, PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit; function GetQueryParam(ARequest: TIdHTTPRequestInfo; const AName: string; const ADefault: string = ''): string; begin Result := ARequest.Params.Values[AName]; if Result = '' then Result := ADefault; 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 // what the JS frontend parses. function ISODateTimeField(AField: TField): string; begin if AField.IsNull then Result := '' else Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', AField.AsDateTime); end; // ===== GET /entries ========================================================== procedure HandleGetEntries(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LQ: TFDQuery; LArr: TJSONArray; LObj: TJSONObject; LSearch, LDeletedStr: string; LDeleted: Integer; begin try LUserId := Authenticate(ARequest, AResponse); except on ESessionRejected do Exit; end; LSearch := GetQueryParam(ARequest, 'search', ''); LDeletedStr := GetQueryParam(ARequest, 'deleted', '0'); if LDeletedStr = '1' then LDeleted := 1 else LDeleted := 0; LArr := TJSONArray.Create; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; if LSearch <> '' then begin LQ.SQL.Text := 'SELECT * FROM vault_entries ' + 'WHERE user_id = :uid AND deleted = :del ' + 'AND (site LIKE :q OR username LIKE :q) ' + 'ORDER BY updated_at DESC'; LQ.ParamByName('q').AsString := '%' + LSearch + '%'; end else begin LQ.SQL.Text := 'SELECT * FROM vault_entries ' + 'WHERE user_id = :uid AND deleted = :del ' + 'ORDER BY updated_at DESC'; end; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('del').AsInteger := LDeleted; LQ.Open; while not LQ.Eof do begin LObj := TJSONObject.Create; LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger)); LObj.AddPair('site', LQ.FieldByName('site').AsString); LObj.AddPair('title', LQ.FieldByName('title').AsString); LObj.AddPair('username', LQ.FieldByName('username').AsString); LObj.AddPair('encrypted_password', LQ.FieldByName('encrypted_password').AsString); LObj.AddPair('iv', LQ.FieldByName('iv').AsString); LObj.AddPair('encryption_method', LQ.FieldByName('encryption_method').AsString); LObj.AddPair('folder', LQ.FieldByName('folder').AsString); LObj.AddPair('deleted', TJSONNumber.Create(LQ.FieldByName('deleted').AsInteger)); if LQ.FieldByName('deleted_at').IsNull then LObj.AddPair('deleted_at', TJSONNull.Create) else LObj.AddPair('deleted_at', ISODateTimeField(LQ.FieldByName('deleted_at'))); LObj.AddPair('favorite', TJSONNumber.Create(LQ.FieldByName('favorite').AsInteger)); LObj.AddPair('tags', LQ.FieldByName('tags').AsString); // TOTP fields are NULL when the entry has no 2FA configured. We emit // JSON null instead of '' so the client can distinguish "no TOTP" from // "TOTP configured with empty ciphertext" (which shouldn't happen). if LQ.FieldByName('totp_secret').IsNull then LObj.AddPair('totp_secret', TJSONNull.Create) else LObj.AddPair('totp_secret', LQ.FieldByName('totp_secret').AsString); if LQ.FieldByName('totp_iv').IsNull then LObj.AddPair('totp_iv', TJSONNull.Create) else LObj.AddPair('totp_iv', LQ.FieldByName('totp_iv').AsString); // Cached favicon (base64 data URI). NULL = no icon cached yet — // the JS layer falls back to first-letter avatar. if LQ.FieldByName('icon_b64').IsNull then LObj.AddPair('icon_b64', TJSONNull.Create) else LObj.AddPair('icon_b64', LQ.FieldByName('icon_b64').AsString); LObj.AddPair('created_at', ISODateTimeField(LQ.FieldByName('created_at'))); LObj.AddPair('updated_at', ISODateTimeField(LQ.FieldByName('updated_at'))); LArr.Add(LObj); LQ.Next; end; finally LQ.Free; end; finally DB.Unlock; end; TJSONHelper.SendJSON(AResponse, LArr); end; // ===== POST /entries ========================================================= procedure HandleCreateEntry(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LNewId: Integer; LBody, LObj: TJSONObject; LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LSite := Trim(LBody.GetValue('site', '')); LTitle := Trim(LBody.GetValue('title', '')); LUser := Trim(LBody.GetValue('username', '')); LFolder := Trim(LBody.GetValue('folder', 'All')); LEnc := LBody.GetValue('encrypted_password', ''); LIV := LBody.GetValue('iv', ''); LTags := Trim(LBody.GetValue('tags', '')); // TOTP secret + IV — optional. Empty string = no TOTP configured. LTotpSec := LBody.GetValue('totp_secret', ''); LTotpIv := LBody.GetValue('totp_iv', ''); finally LBody.Free; end; if (LSite = '') or (LEnc = '') then begin TJSONHelper.SendError(AResponse, 400, 'Site & password required'); Exit; end; LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now); DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'INSERT INTO vault_entries ' + '(user_id, site, title, username, encrypted_password, iv, encryption_method, ' + ' folder, tags, totp_secret, totp_iv, created_at, updated_at) ' + 'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('s').AsString := LSite; LQ.ParamByName('tt').AsString := LTitle; LQ.ParamByName('u').AsString := LUser; LQ.ParamByName('e').AsString := LEnc; LQ.ParamByName('i').AsString := LIV; LQ.ParamByName('f').AsString := LFolder; LQ.ParamByName('t').AsString := LTags; // FireDAC needs an explicit DataType on params that are sometimes // assigned a string and sometimes Clear()ed to NULL — without a // prior typed assignment, .Clear raises "data type unknown" on // SQLite. Declare ftString up front for the optional TOTP fields. LQ.ParamByName('ts').DataType := ftString; LQ.ParamByName('tiv').DataType := ftString; // Store empty TOTP fields as NULL so the GET endpoint emits JSON null // rather than '' — keeps client-side "has TOTP?" checks unambiguous. if LTotpSec = '' then LQ.ParamByName('ts').Clear else LQ.ParamByName('ts').AsString := LTotpSec; if LTotpIv = '' then LQ.ParamByName('tiv').Clear else LQ.ParamByName('tiv').AsString := LTotpIv; LQ.ParamByName('c').AsString := LNow; LQ.ParamByName('c2').AsString := LNow; LQ.ExecSQL; LNewId := DB.Connection.GetLastAutoGenValue('vault_entries'); finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'add_entry', GetClientIP(ARequest)); LObj := TJSONObject.Create; LObj.AddPair('id', TJSONNumber.Create(LNewId)); LObj.AddPair('site', LSite); LObj.AddPair('title', LTitle); LObj.AddPair('username', LUser); LObj.AddPair('folder', LFolder); LObj.AddPair('tags', LTags); TJSONHelper.SendJSON(AResponse, LObj); end; // ===== PUT /entries/{id} ===================================================== procedure HandleUpdateEntry(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LId: Integer; LBody: TJSONObject; LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LId := StrToIntDef(AParams[0], 0); if LId = 0 then begin TJSONHelper.SendError(AResponse, 400, 'Invalid id'); Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LSite := Trim(LBody.GetValue('site', '')); LTitle := Trim(LBody.GetValue('title', '')); LUser := Trim(LBody.GetValue('username', '')); LFolder := Trim(LBody.GetValue('folder', 'All')); LEnc := LBody.GetValue('encrypted_password', ''); LIV := LBody.GetValue('iv', ''); LTags := Trim(LBody.GetValue('tags', '')); LTotpSec := LBody.GetValue('totp_secret', ''); LTotpIv := LBody.GetValue('totp_iv', ''); finally LBody.Free; end; if (LSite = '') or (LEnc = '') then begin TJSONHelper.SendError(AResponse, 400, 'Site & password required'); Exit; end; LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now); DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE vault_entries ' + 'SET site=:s, title=:tt, username=:u, encrypted_password=:e, iv=:i, ' + ' folder=:f, tags=:t, totp_secret=:ts, totp_iv=:tiv, ' + ' updated_at=:c ' + 'WHERE id=:id AND user_id=:uid'; LQ.ParamByName('s').AsString := LSite; LQ.ParamByName('tt').AsString := LTitle; LQ.ParamByName('u').AsString := LUser; LQ.ParamByName('e').AsString := LEnc; LQ.ParamByName('i').AsString := LIV; LQ.ParamByName('f').AsString := LFolder; LQ.ParamByName('t').AsString := LTags; // Declare TOTP param types so .Clear works on first use (FireDAC // needs an inferred or explicit DataType before NULL binding). LQ.ParamByName('ts').DataType := ftString; LQ.ParamByName('tiv').DataType := ftString; // Clearing TOTP (user removed 2FA from this entry) is signaled by an // empty string in the request → store NULL in the DB. if LTotpSec = '' then LQ.ParamByName('ts').Clear else LQ.ParamByName('ts').AsString := LTotpSec; if LTotpIv = '' then LQ.ParamByName('tiv').Clear else LQ.ParamByName('tiv').AsString := LTotpIv; LQ.ParamByName('c').AsString := LNow; LQ.ParamByName('id').AsInteger := LId; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'edit_entry', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Updated'); end; // ===== DELETE /entries/{id} ================================================== procedure HandleDeleteEntry(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LId: Integer; LPermanent: Boolean; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LId := StrToIntDef(AParams[0], 0); if LId = 0 then begin TJSONHelper.SendError(AResponse, 400, 'Invalid id'); Exit; end; LPermanent := GetQueryParam(ARequest, 'permanent', '0') = '1'; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; if LPermanent then LQ.SQL.Text := 'DELETE FROM vault_entries WHERE id=:id AND user_id=:uid' else LQ.SQL.Text := 'UPDATE vault_entries SET deleted=1, deleted_at=datetime(''now'') ' + 'WHERE id=:id AND user_id=:uid'; LQ.ParamByName('id').AsInteger := LId; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; if LPermanent then LogAudit(LUserId, 'permanent_delete', GetClientIP(ARequest)) else LogAudit(LUserId, 'delete_entry', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Deleted'); end; // ===== POST /entries/{id}/restore ============================================ procedure HandleRestoreEntry(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LId: Integer; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LId := StrToIntDef(AParams[0], 0); if LId = 0 then begin TJSONHelper.SendError(AResponse, 400, 'Invalid id'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE vault_entries SET deleted=0, deleted_at=NULL, ' + ' updated_at=datetime(''now'') ' + 'WHERE id=:id AND user_id=:uid'; LQ.ParamByName('id').AsInteger := LId; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'restore_entry', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Restored'); end; // ===== POST /entries/{id}/favorite =========================================== procedure HandleToggleFavorite(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LId: Integer; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LId := StrToIntDef(AParams[0], 0); if LId = 0 then begin TJSONHelper.SendError(AResponse, 400, 'Invalid id'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE vault_entries ' + 'SET favorite = CASE WHEN favorite=1 THEN 0 ELSE 1 END ' + 'WHERE id=:id AND user_id=:uid'; LQ.ParamByName('id').AsInteger := LId; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'toggle_favorite', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Toggled'); end; // ===== POST /entries/{id}/icon =============================================== // Stores (or clears) a cached favicon for one entry. Separate endpoint so the // client can save the icon without re-PUT-ing the full entry (which would // require re-encrypting the password). Body: {"icon_b64":"data:image/...;base64,..."} // — empty string clears the cached icon. procedure HandleSetEntryIcon(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LId: Integer; LBody: TJSONObject; LIcon: string; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LId := StrToIntDef(AParams[0], 0); if LId = 0 then begin TJSONHelper.SendError(AResponse, 400, 'Invalid id'); Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LIcon := LBody.GetValue('icon_b64', ''); finally LBody.Free; end; // Soft cap to prevent a misbehaving fetcher from ballooning the DB. // 32x32 PNG favicons rarely exceed 4 KB; 64 KB leaves room for SVG / 64x64. if Length(LIcon) > 65536 then begin TJSONHelper.SendError(AResponse, 413, 'Icon too large'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE vault_entries SET icon_b64 = :ic ' + 'WHERE id=:id AND user_id=:uid'; LQ.ParamByName('ic').DataType := ftMemo; // long text → ftMemo on SQLite if LIcon = '' then LQ.ParamByName('ic').Clear else LQ.ParamByName('ic').AsString := LIcon; LQ.ParamByName('id').AsInteger := LId; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; TJSONHelper.SendOK(AResponse, 'Icon saved'); end; // ===== DELETE /entries/icons/all ============================================= // Bulk-clear cached favicons for all entries of the current user. Used by the // Settings "Clear cached icons" button. procedure HandleClearAllIcons(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE vault_entries SET icon_b64 = NULL WHERE user_id = :uid'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'clear_icons', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Icons cleared'); end; // ===== DELETE /entries/trash/empty =========================================== procedure HandleEmptyTrash(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'DELETE FROM vault_entries WHERE user_id=:uid AND deleted=1'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'empty_trash', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Trash emptied'); end; // ===== POST /entries/bulk-import ============================================= // Accepts an array of already-encrypted entries (the client encrypts each // entry with the vault key before posting). Inserts them all in a single // transaction so a partial failure rolls back cleanly. Used by the JSON / CSV // import flow — much faster than N sequential POST /entries for large vaults. procedure HandleBulkImport(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, I, LImported: Integer; LBody, LObj, LEntry: TJSONObject; LArr: TJSONArray; LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LTotpSec, LTotpIv, LNow: string; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LArr := LBody.GetValue('entries'); if (LArr = nil) or (LArr.Count = 0) then begin TJSONHelper.SendError(AResponse, 400, 'Missing or empty entries array'); Exit; end; // Sanity cap. A real vault rarely has > 10k entries; if someone uploads // a 100k-row CSV it's probably an attack or a mistake. if LArr.Count > 10000 then begin TJSONHelper.SendError(AResponse, 413, 'Too many entries (max 10000 per request)'); Exit; end; LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now); LImported := 0; DB.Lock; try DB.Connection.StartTransaction; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'INSERT INTO vault_entries ' + '(user_id, site, title, username, encrypted_password, iv, encryption_method, ' + ' folder, tags, totp_secret, totp_iv, created_at, updated_at) ' + 'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)'; // Declare optional TOTP 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 // for a row without TOTP. LQ.ParamByName('ts').DataType := ftString; LQ.ParamByName('tiv').DataType := ftString; for I := 0 to LArr.Count - 1 do begin LEntry := LArr.Items[I] as TJSONObject; LSite := Trim(LEntry.GetValue('site', '')); LTitle := Trim(LEntry.GetValue('title', '')); LUser := Trim(LEntry.GetValue('username', '')); LFolder := Trim(LEntry.GetValue('folder', 'All')); LEnc := LEntry.GetValue('encrypted_password', ''); LIV := LEntry.GetValue('iv', ''); LTags := Trim(LEntry.GetValue('tags', '')); LTotpSec := LEntry.GetValue('totp_secret', ''); LTotpIv := LEntry.GetValue('totp_iv', ''); // Skip silently if a row is missing the minimum required fields // (site + ciphertext). Better than failing the whole batch on // one bad row when the user is importing 500+ entries. if (LSite = '') or (LEnc = '') or (LIV = '') then Continue; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('s').AsString := LSite; LQ.ParamByName('tt').AsString := LTitle; LQ.ParamByName('u').AsString := LUser; LQ.ParamByName('e').AsString := LEnc; LQ.ParamByName('i').AsString := LIV; LQ.ParamByName('f').AsString := LFolder; LQ.ParamByName('t').AsString := LTags; if LTotpSec = '' then LQ.ParamByName('ts').Clear else LQ.ParamByName('ts').AsString := LTotpSec; if LTotpIv = '' then LQ.ParamByName('tiv').Clear else LQ.ParamByName('tiv').AsString := LTotpIv; LQ.ParamByName('c').AsString := LNow; LQ.ParamByName('c2').AsString := LNow; LQ.ExecSQL; Inc(LImported); end; finally LQ.Free; end; DB.Connection.Commit; except DB.Connection.Rollback; raise; end; finally DB.Unlock; end; finally LBody.Free; end; LogAudit(LUserId, Format('bulk_import %d entries', [LImported]), GetClientIP(ARequest)); LObj := TJSONObject.Create; LObj.AddPair('imported', TJSONNumber.Create(LImported)); TJSONHelper.SendJSON(AResponse, LObj); end; procedure HandleEntriesCount(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LActive, LTrashed: Integer; LQ: TFDQuery; LObj: TJSONObject; begin try LUserId := Authenticate(ARequest, AResponse); except on ESessionRejected do Exit; end; LActive := 0; LTrashed := 0; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'SELECT deleted, COUNT(*) AS cnt FROM vault_entries ' + 'WHERE user_id = :uid GROUP BY deleted'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.Open; while not LQ.Eof do begin if LQ.FieldByName('deleted').AsInteger = 0 then LActive := LQ.FieldByName('cnt').AsInteger else LTrashed := LQ.FieldByName('cnt').AsInteger; LQ.Next; end; finally LQ.Free; end; finally DB.Unlock; end; LObj := TJSONObject.Create; LObj.AddPair('active', TJSONNumber.Create(LActive)); LObj.AddPair('trashed', TJSONNumber.Create(LTrashed)); TJSONHelper.SendJSON(AResponse, LObj); end; initialization // /entries/trash/empty must be registered BEFORE /entries/{id} to win the regex match. // Same logic for /entries/bulk-import — register before the catch-all /entries/{id}. Router.Register('DELETE', '/entries/trash/empty', HandleEmptyTrash); Router.Register('DELETE', '/entries/icons/all', HandleClearAllIcons); Router.Register('POST', '/entries/bulk-import', HandleBulkImport); Router.Register('POST', '/entries/(\d+)/restore', HandleRestoreEntry); Router.Register('POST', '/entries/(\d+)/favorite', HandleToggleFavorite); Router.Register('POST', '/entries/(\d+)/icon', HandleSetEntryIcon); Router.Register('GET', '/entries/count', HandleEntriesCount); Router.Register('GET', '/entries', HandleGetEntries); Router.Register('POST', '/entries', HandleCreateEntry); Router.Register('PUT', '/entries/(\d+)', HandleUpdateEntry); Router.Register('DELETE', '/entries/(\d+)', HandleDeleteEntry); end.