r-zakarya
9a4170c44f
Works through the plan's §2 and §3 items that need no hardware and no platform decision. - allowBackup="false". The private directory holds vault.bin; a cloud backup has no business in a password manager's path, even though what would leave is encrypted by a key that stays in the chip. - FLAG_SECURE, Release builds only - in debug it also blocks development screenshots. Complementary to hiding on WillBecomeInactive rather than redundant: that one covers the recents preview, the flag also covers manual captures, screen recording and casting to an external display. - List sorted by name (snapshot order is DB order, arbitrary to the eye), entry icons decoded once per vault rather than on every keystroke, and a folder dropdown whose selection survives a background refresh. No tag filter: text search already matches tags. - template and updated_at read and shown in the detail. updated_at is also step 1 of the write path - nothing is arbitrable without it. Android code is now type-checked without deploying: dccaarm64 reaches the link step and fails only on the NDK's ldandroid.exe. A JNI declaration that does not compile no longer waits for an APK to say so. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1189 lines
39 KiB
ObjectPascal
1189 lines
39 KiB
ObjectPascal
unit mainApk;
|
|
{
|
|
Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
|
|
|
|
Trois ecrans dans une seule forme, montres a tour de role - une forme par
|
|
ecran couterait un fichier .fmx chacun pour trois dispositions triviales.
|
|
|
|
1. Deverrouillage : ouvre le coffre local (biometrie), ou telecharge le
|
|
conteneur et le dechiffre si l'appareil n'en a pas encore.
|
|
2. Liste : recherche + entrees.
|
|
3. Detail : les champs d'une entree, mot de passe masque.
|
|
|
|
DEUX REGLES DE SURETE tenues ici, pas ailleurs :
|
|
- le coffre en clair est EFFACE des que l'application passe en arriere-plan
|
|
(sinon il reste dans l'apercu des applications recentes) ;
|
|
- le presse-papiers est VIDE apres un delai, et seulement si son contenu
|
|
est toujours celui qu'on y a mis.
|
|
|
|
L'ecriture n'existe pas : le poste Windows reste la source. Modifier ici
|
|
demanderait le PUT cote serveur et une fusion cote client.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
|
System.Diagnostics, System.Rtti, System.NetEncoding,
|
|
System.Generics.Collections,
|
|
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform,
|
|
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
|
|
FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox,
|
|
PMA.Vault;
|
|
|
|
const
|
|
// Parametres du banc d'essai, pre-remplis pour ne pas les retaper.
|
|
//
|
|
// Le port differe selon la plateforme : sur Windows on attaque Apache
|
|
// directement (80), sur Android on passe par "adb reverse tcp:8080 tcp:80",
|
|
// qui fait voir le PC comme 127.0.0.1 - ce qui satisfait au passage
|
|
// l'exemption HTTPS de l'endpoint, reservee a la boucle locale.
|
|
{$IF DEFINED(ANDROID)}
|
|
TEST_URL = 'http://127.0.0.1:8080/server-php/sync.php';
|
|
{$ELSE}
|
|
TEST_URL = 'http://127.0.0.1/server-php/sync.php';
|
|
{$ENDIF}
|
|
// Jeton d'un serveur de test local. Il n'authentifie qu'un appareil et ne
|
|
// donne acces qu'a du chiffre - mais a remplacer avant toute mise en ligne.
|
|
TEST_TOKEN = '8765e5bf426039e9888f44bfbab27d489d12b7dbaaa54c8c695ae6af8b2a820e';
|
|
|
|
// Assez pour aller coller dans une autre application, trop court pour qu'un
|
|
// mot de passe traine dans l'historique du presse-papiers.
|
|
CLIPBOARD_CLEAR_SECONDS = 45;
|
|
|
|
// TEST_PWD vient d'un fichier LOCAL, hors depot : il ouvre le coffre entier
|
|
// une fois le conteneur telecharge. Absent apres un clone -> recopier
|
|
// PMA.LocalConfig.template.inc.
|
|
{$I android-client\PMA.LocalConfig.inc}
|
|
|
|
type
|
|
/// Une ligne du detail, avant tout controle. Site, identifiant, mot de
|
|
/// passe et champs personnalises se ramenent tous a la meme chose : un
|
|
/// intitule, une valeur, et le fait qu'elle soit secrete ou non. Les traiter
|
|
/// separement dupliquerait revelation et copie quatre fois.
|
|
TDetRow = record
|
|
Caption, Value: string;
|
|
Secret: Boolean;
|
|
end;
|
|
|
|
TForm8 = class(TForm)
|
|
private
|
|
FVault: TVault;
|
|
FFiltered: TArray<Integer>; // indices dans FVault, resultat de la recherche
|
|
FCurrent: TVaultEntry;
|
|
// L'ETag n'est conserve QUE si le dechiffrement qui a suivi a reussi :
|
|
// envoyer If-None-Match sans detenir le clair correspondant fait
|
|
// economiser un telechargement pour se retrouver sans donnees.
|
|
FETag: string;
|
|
FBusy: Boolean;
|
|
// Mot de passe de sync tel qu'il a ete range avec le coffre. Il rend le
|
|
// rafraichissement de fond silencieux : sans lui, chaque modification
|
|
// faite sur le poste ferait apparaitre une invite au lancement.
|
|
FSyncPwd: string;
|
|
|
|
// --- ecran 1 : deverrouillage
|
|
FLayUnlock: TLayout;
|
|
FUrl, FToken, FPwd: TEdit;
|
|
FBtnOpen, FBtnSync, FBtnSettings: TButton;
|
|
FLaySettings: TLayout;
|
|
FStatus: TLabel;
|
|
FLog: TMemo;
|
|
|
|
// --- ecran 2 : liste
|
|
FLayList: TLayout;
|
|
FSearch: TEdit;
|
|
FFolderBox: TComboBox;
|
|
FList: TListBox;
|
|
FCount: TLabel;
|
|
/// Icones decodees une fois par coffre, pas a chaque frappe : la liste est
|
|
/// reconstruite a chaque caractere tape, et decoder du PNG a ce rythme se
|
|
/// voit. Cle = indice dans le coffre.
|
|
FIcons: TObjectDictionary<Integer, TBitmap>;
|
|
|
|
// --- ecran 3 : detail
|
|
// Les lignes sont construites PAR ENTREE : leur nombre depend des champs
|
|
// personnalises. On garde de quoi les detruire et de quoi retrouver
|
|
// l'etiquette de valeur d'une ligne pour la reveler.
|
|
FLayDetail: TLayout;
|
|
FDetBody: TVertScrollBox;
|
|
FDetTitle, FDetToast: TLabel;
|
|
FRows: TArray<TDetRow>;
|
|
FRowCtls: TArray<TLayout>;
|
|
FRowValues: TArray<TLabel>;
|
|
FRowShown: TArray<Boolean>;
|
|
|
|
// --- TOTP : une ligne vivante, rafraichie chaque seconde
|
|
FTotpTimer: TTimer;
|
|
FTotpValue: TLabel;
|
|
FTotpCode: string;
|
|
|
|
// --- presse-papiers
|
|
FClipTimer: TTimer;
|
|
FCopied: string;
|
|
|
|
procedure BuildUnlock;
|
|
procedure BuildList;
|
|
procedure BuildDetail;
|
|
|
|
procedure ShowUnlock;
|
|
procedure ShowList;
|
|
procedure ShowDetail(AVaultIndex: Integer);
|
|
procedure ClearDetailRows;
|
|
procedure OnTotpTick(Sender: TObject);
|
|
|
|
procedure DoOpenLocal(Sender: TObject);
|
|
// Separee de DoOpenLocal : une methode anonyme ne peut pas appeler une
|
|
// procedure imbriquee (E2555), et le rappel de la biometrie en est une.
|
|
procedure OpenLocalNow;
|
|
procedure DoSync(Sender: TObject);
|
|
/// ASilent : rafraichissement de fond. Le coffre local est deja affiche,
|
|
/// donc un echec reseau ne doit rien reclamer a l'utilisateur - il garde
|
|
/// ce qu'il a. Seul un instantane NOUVEAU se voit.
|
|
procedure FetchAndDecrypt(const AUrl, ATok, APwd: string;
|
|
ASilent: Boolean = False);
|
|
procedure AdoptVault(const APlainJson: string);
|
|
procedure LockVault;
|
|
|
|
procedure OnSearchChanged(Sender: TObject);
|
|
procedure PopulateFolders;
|
|
procedure RebuildIcons;
|
|
procedure OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
|
|
procedure OnRevealTap(Sender: TObject);
|
|
procedure OnCopyTap(Sender: TObject);
|
|
procedure OnBackTap(Sender: TObject);
|
|
procedure OnToggleSettings(Sender: TObject);
|
|
procedure OnClipTimer(Sender: TObject);
|
|
procedure OnHardwareBack(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
|
|
procedure CopyToClipboard(const AText, ALabel: string);
|
|
function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
|
|
procedure Log(const AMsg: string);
|
|
procedure Status(const AMsg: string);
|
|
procedure SetBusy(ABusy: Boolean);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
var
|
|
Form8: TForm8;
|
|
|
|
implementation
|
|
|
|
uses
|
|
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
|
|
PMA.ScreenGuard;
|
|
|
|
{$R *.fmx}
|
|
|
|
const
|
|
// Puces en points de code, PAS en caracteres litteraux : un .pas sans BOM
|
|
// est lu comme de l'ANSI, et un bullet UTF-8 y devient trois glyphes.
|
|
BULLET = #$2022;
|
|
MASK = BULLET+BULLET+BULLET+BULLET+BULLET+BULLET+
|
|
BULLET+BULLET+BULLET+BULLET+BULLET+BULLET;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Construction
|
|
---------------------------------------------------------------------------- }
|
|
|
|
constructor TForm8.Create(AOwner: TComponent);
|
|
var
|
|
LEvents: IFMXApplicationEventService;
|
|
begin
|
|
inherited;
|
|
Caption := 'Coffre';
|
|
SecureScreen; // avant tout affichage de contenu
|
|
FVault := TVault.Create;
|
|
FIcons := TObjectDictionary<Integer, TBitmap>.Create([doOwnsValues]);
|
|
|
|
BuildDetail; // cree en dernier a l'ecran = au-dessus des autres
|
|
BuildList;
|
|
BuildUnlock;
|
|
|
|
FClipTimer := TTimer.Create(Self);
|
|
FClipTimer.Enabled := False;
|
|
FClipTimer.Interval := CLIPBOARD_CLEAR_SECONDS * 1000;
|
|
FClipTimer.OnTimer := OnClipTimer;
|
|
|
|
FTotpTimer := TTimer.Create(Self);
|
|
FTotpTimer.Enabled := False;
|
|
FTotpTimer.Interval := 1000;
|
|
FTotpTimer.OnTimer := OnTotpTick;
|
|
|
|
// Le bouton retour materiel arrive comme une touche : sans ce gestionnaire
|
|
// il ferme l'application depuis le detail, au lieu de revenir a la liste.
|
|
OnKeyUp := OnHardwareBack;
|
|
|
|
if TPlatformServices.Current.SupportsPlatformService(
|
|
IFMXApplicationEventService, LEvents) then
|
|
LEvents.SetApplicationEventHandler(HandleAppEvent);
|
|
|
|
ShowUnlock;
|
|
|
|
// Ouverture automatique du coffre local. Differee apres la construction :
|
|
// l'invite biometrique s'afficherait sinon avant la premiere peinture de la
|
|
// fenetre, sur un fond vide.
|
|
if HasVault then
|
|
TThread.ForceQueue(nil, procedure begin DoOpenLocal(nil); end);
|
|
end;
|
|
|
|
destructor TForm8.Destroy;
|
|
begin
|
|
FIcons.Free;
|
|
FVault.Free;
|
|
inherited;
|
|
end;
|
|
|
|
/// Cree un bouton empile en haut. En FMX, des controles alignes en haut
|
|
/// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en
|
|
/// haut. Chaque Build* cree donc du bas vers le haut.
|
|
function TopButton(AParent: TFmxObject; const AText: string;
|
|
AOnClick: TNotifyEvent; AHeight: Single = 48): TButton;
|
|
begin
|
|
Result := TButton.Create(AParent);
|
|
Result.Parent := AParent;
|
|
Result.Align := TAlignLayout.Top;
|
|
Result.Margins.Rect := RectF(8, 4, 8, 0);
|
|
Result.Height := AHeight;
|
|
Result.Text := AText;
|
|
Result.OnClick := AOnClick;
|
|
end;
|
|
|
|
function TopEdit(AParent: TFmxObject; const APrompt, AText: string;
|
|
APassword: Boolean = False): TEdit;
|
|
begin
|
|
Result := TEdit.Create(AParent);
|
|
Result.Parent := AParent;
|
|
Result.Align := TAlignLayout.Top;
|
|
Result.Margins.Rect := RectF(8, 4, 8, 0);
|
|
Result.TextPrompt := APrompt;
|
|
Result.Text := AText;
|
|
Result.Password := APassword;
|
|
end;
|
|
|
|
procedure TForm8.BuildUnlock;
|
|
begin
|
|
FLayUnlock := TLayout.Create(Self);
|
|
FLayUnlock.Parent := Self;
|
|
FLayUnlock.Align := TAlignLayout.Client;
|
|
|
|
// Journal en bas : il ne sert plus qu'au diagnostic, mais un echec reseau ou
|
|
// JNI sans trace se debugue a l'aveugle.
|
|
FLog := TMemo.Create(Self);
|
|
FLog.Parent := FLayUnlock;
|
|
FLog.Align := TAlignLayout.Bottom;
|
|
FLog.Height := 150;
|
|
FLog.Margins.Rect := RectF(8, 8, 8, 8);
|
|
FLog.ReadOnly := True;
|
|
FLog.TextSettings.Font.Family := 'monospace';
|
|
FLog.TextSettings.Font.Size := 11;
|
|
|
|
// --- du bas vers le haut (voir TopButton)
|
|
FLaySettings := TLayout.Create(Self);
|
|
FLaySettings.Parent := FLayUnlock;
|
|
FLaySettings.Align := TAlignLayout.Top;
|
|
FLaySettings.Height := 116;
|
|
FLaySettings.Visible := False;
|
|
FToken := TopEdit(FLaySettings, 'jeton Bearer', TEST_TOKEN);
|
|
FUrl := TopEdit(FLaySettings, 'URL de l''endpoint', TEST_URL);
|
|
|
|
FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur',
|
|
OnToggleSettings, 36);
|
|
FBtnSettings.TextSettings.Font.Size := 12;
|
|
|
|
FBtnSync := TopButton(FLayUnlock, 'Synchroniser', DoSync);
|
|
FBtnOpen := TopButton(FLayUnlock, 'Ouvrir le coffre', DoOpenLocal);
|
|
|
|
// Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci.
|
|
FPwd := TopEdit(FLayUnlock, 'mot de passe de sync', TEST_PWD, True);
|
|
FPwd.Margins.Top := 12;
|
|
|
|
FStatus := TLabel.Create(Self);
|
|
FStatus.Parent := FLayUnlock;
|
|
FStatus.Align := TAlignLayout.Top;
|
|
FStatus.Margins.Rect := RectF(8, 16, 8, 0);
|
|
FStatus.Height := 24;
|
|
FStatus.StyledSettings := FStatus.StyledSettings - [TStyledSetting.Size];
|
|
FStatus.TextSettings.Font.Size := 15;
|
|
end;
|
|
|
|
procedure TForm8.BuildList;
|
|
var
|
|
LBar, LTop: TLayout;
|
|
LBtnLock: TButton;
|
|
begin
|
|
FLayList := TLayout.Create(Self);
|
|
FLayList.Parent := Self;
|
|
FLayList.Align := TAlignLayout.Client;
|
|
FLayList.Visible := False;
|
|
|
|
LBar := TLayout.Create(Self);
|
|
LBar.Parent := FLayList;
|
|
LBar.Align := TAlignLayout.Bottom;
|
|
LBar.Height := 52;
|
|
|
|
LBtnLock := TButton.Create(Self);
|
|
LBtnLock.Parent := LBar;
|
|
LBtnLock.Align := TAlignLayout.Left;
|
|
LBtnLock.Margins.Rect := RectF(8, 4, 0, 8);
|
|
LBtnLock.Width := 130;
|
|
LBtnLock.Text := 'Verrouiller';
|
|
LBtnLock.OnClick := OnBackTap;
|
|
LBtnLock.Tag := 1; // 1 = verrouiller, 0 = simple retour (voir OnBackTap)
|
|
|
|
FCount := TLabel.Create(Self);
|
|
FCount.Parent := LBar;
|
|
FCount.Align := TAlignLayout.Client;
|
|
FCount.Margins.Rect := RectF(12, 4, 8, 8);
|
|
FCount.TextSettings.HorzAlign := TTextAlign.Trailing;
|
|
FCount.TextSettings.VertAlign := TTextAlign.Center;
|
|
|
|
FList := TListBox.Create(Self);
|
|
FList.Parent := FLayList;
|
|
FList.Align := TAlignLayout.Client;
|
|
FList.Margins.Rect := RectF(4, 0, 4, 0);
|
|
FList.ItemHeight := 56;
|
|
FList.OnItemClick := OnItemTap;
|
|
|
|
LTop := TLayout.Create(Self);
|
|
LTop.Parent := FLayList;
|
|
LTop.Align := TAlignLayout.Top;
|
|
LTop.Height := 48;
|
|
LTop.Margins.Rect := RectF(8, 8, 8, 8);
|
|
|
|
// Pas de filtre d'etiquette : la recherche texte couvre deja les etiquettes,
|
|
// en taper le nom suffit. Les dossiers, eux, ne se devinent pas.
|
|
FFolderBox := TComboBox.Create(Self);
|
|
FFolderBox.Parent := LTop;
|
|
FFolderBox.Align := TAlignLayout.Right;
|
|
FFolderBox.Width := 140;
|
|
FFolderBox.Margins.Left := 8;
|
|
FFolderBox.OnChange := OnSearchChanged;
|
|
|
|
FSearch := TEdit.Create(Self);
|
|
FSearch.Parent := LTop;
|
|
FSearch.Align := TAlignLayout.Client;
|
|
FSearch.TextPrompt := 'Rechercher';
|
|
FSearch.OnChangeTracking := OnSearchChanged;
|
|
end;
|
|
|
|
/// Intitule discret au-dessus d'une valeur. Meme forme pour toutes les
|
|
/// lignes, y compris celle du TOTP.
|
|
function MakeRow(AParent: TFmxObject; const ACaption: string;
|
|
out AValue: TLabel): TLayout;
|
|
var
|
|
LCap: TLabel;
|
|
begin
|
|
Result := TLayout.Create(nil); // detruite a la main, voir ClearDetailRows
|
|
Result.Parent := AParent;
|
|
Result.Align := TAlignLayout.Top;
|
|
Result.Height := 62;
|
|
Result.Margins.Rect := RectF(12, 10, 12, 0);
|
|
|
|
LCap := TLabel.Create(Result);
|
|
LCap.Parent := Result;
|
|
LCap.Align := TAlignLayout.Top;
|
|
LCap.Height := 20;
|
|
LCap.Text := ACaption;
|
|
LCap.Opacity := 0.6;
|
|
LCap.StyledSettings := LCap.StyledSettings - [TStyledSetting.Size];
|
|
LCap.TextSettings.Font.Size := 12;
|
|
|
|
AValue := TLabel.Create(Result);
|
|
AValue.Parent := Result;
|
|
AValue.Align := TAlignLayout.Client;
|
|
AValue.StyledSettings := AValue.StyledSettings - [TStyledSetting.Size];
|
|
AValue.TextSettings.Font.Size := 16;
|
|
end;
|
|
|
|
function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer;
|
|
AOnClick: TNotifyEvent): TButton;
|
|
begin
|
|
Result := TButton.Create(ARow);
|
|
Result.Parent := ARow;
|
|
Result.Align := TAlignLayout.Right;
|
|
Result.Margins.Left := 6;
|
|
Result.Width := 90;
|
|
Result.Text := AText;
|
|
Result.Tag := ATag;
|
|
Result.OnClick := AOnClick;
|
|
end;
|
|
|
|
procedure TForm8.BuildDetail;
|
|
var
|
|
LBtnBack: TButton;
|
|
begin
|
|
FLayDetail := TLayout.Create(Self);
|
|
FLayDetail.Parent := Self;
|
|
FLayDetail.Align := TAlignLayout.Client;
|
|
FLayDetail.Visible := False;
|
|
|
|
LBtnBack := TButton.Create(Self);
|
|
LBtnBack.Parent := FLayDetail;
|
|
LBtnBack.Align := TAlignLayout.Bottom;
|
|
LBtnBack.Height := 48;
|
|
LBtnBack.Margins.Rect := RectF(8, 8, 8, 8);
|
|
LBtnBack.Text := 'Retour';
|
|
LBtnBack.Tag := 0;
|
|
LBtnBack.OnClick := OnBackTap;
|
|
|
|
FDetToast := TLabel.Create(Self);
|
|
FDetToast.Parent := FLayDetail;
|
|
FDetToast.Align := TAlignLayout.Bottom;
|
|
FDetToast.Height := 22;
|
|
FDetToast.Margins.Rect := RectF(12, 0, 12, 0);
|
|
FDetToast.StyledSettings := FDetToast.StyledSettings - [TStyledSetting.Size];
|
|
FDetToast.TextSettings.Font.Size := 12;
|
|
FDetToast.Opacity := 0.7;
|
|
|
|
// Defilant : une entree avec dix champs personnalises depasse l'ecran d'un
|
|
// telephone, et les lignes ne sont connues qu'a l'ouverture.
|
|
FDetBody := TVertScrollBox.Create(Self);
|
|
FDetBody.Parent := FLayDetail;
|
|
FDetBody.Align := TAlignLayout.Client;
|
|
|
|
FDetTitle := TLabel.Create(Self);
|
|
FDetTitle.Parent := FLayDetail;
|
|
FDetTitle.Align := TAlignLayout.Top;
|
|
FDetTitle.Height := 44;
|
|
FDetTitle.Margins.Rect := RectF(12, 12, 12, 0);
|
|
FDetTitle.StyledSettings := FDetTitle.StyledSettings - [TStyledSetting.Size];
|
|
FDetTitle.TextSettings.Font.Size := 22;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Navigation
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.ShowUnlock;
|
|
begin
|
|
FLayDetail.Visible := False;
|
|
FLayList.Visible := False;
|
|
FLayUnlock.Visible := True;
|
|
|
|
// Le bouton d'ouverture n'a de sens que si un coffre local existe ; sinon
|
|
// seul le telechargement peut en produire un.
|
|
FBtnOpen.Visible := HasVault;
|
|
if HasVault then
|
|
begin
|
|
if VaultNeedsAuth then
|
|
Status('Coffre present sur cet appareil - protege')
|
|
else
|
|
Status('Coffre present sur cet appareil');
|
|
FBtnSync.Text := 'Synchroniser';
|
|
end
|
|
else
|
|
begin
|
|
Status('Aucun coffre local - premier telechargement');
|
|
FBtnSync.Text := 'Telecharger le coffre';
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.ShowList;
|
|
begin
|
|
// Quitter le detail rend ses valeurs en clair, et arrete le compte a rebours.
|
|
ClearDetailRows;
|
|
FLayUnlock.Visible := False;
|
|
FLayDetail.Visible := False;
|
|
FLayList.Visible := True;
|
|
FSearch.Text := '';
|
|
OnSearchChanged(nil);
|
|
end;
|
|
|
|
procedure TForm8.ClearDetailRows;
|
|
var
|
|
LRow: TLayout;
|
|
begin
|
|
// Appelable avant la fin du constructeur (ShowList), d'ou la garde.
|
|
if FTotpTimer <> nil then FTotpTimer.Enabled := False;
|
|
FTotpValue := nil;
|
|
FTotpCode := '';
|
|
// Detruites explicitement plutot que par DeleteChildren : le conteneur est
|
|
// un TVertScrollBox, dont les enfants comprennent ses propres barres.
|
|
for LRow in FRowCtls do LRow.Free;
|
|
SetLength(FRowCtls, 0);
|
|
SetLength(FRowValues, 0);
|
|
SetLength(FRowShown, 0);
|
|
SetLength(FRows, 0);
|
|
end;
|
|
|
|
procedure TForm8.ShowDetail(AVaultIndex: Integer);
|
|
var
|
|
LMeta, LPwdCaption: string;
|
|
I: Integer;
|
|
LRow: TLayout;
|
|
LValue: TLabel;
|
|
|
|
procedure Add(const ACaption, AValue: string; ASecret: Boolean);
|
|
begin
|
|
if AValue = '' then Exit; // une ligne vide n'apprend rien
|
|
SetLength(FRows, Length(FRows) + 1);
|
|
FRows[High(FRows)].Caption := ACaption;
|
|
FRows[High(FRows)].Value := AValue;
|
|
FRows[High(FRows)].Secret := ASecret;
|
|
end;
|
|
|
|
begin
|
|
ClearDetailRows;
|
|
FCurrent := FVault.Entry(AVaultIndex);
|
|
FDetTitle.Text := FCurrent.Display;
|
|
FDetToast.Text := '';
|
|
|
|
// Le corps d'une note est stocke dans le champ mot de passe : meme donnee,
|
|
// autre intitule, et pas de raison de la masquer comme un secret.
|
|
if FCurrent.IsNote then LPwdCaption := 'Contenu' else LPwdCaption := 'Mot de passe';
|
|
|
|
Add('Site', FCurrent.Site, False);
|
|
Add('Identifiant', FCurrent.Username, False);
|
|
Add(LPwdCaption, FCurrent.Password, not FCurrent.IsNote);
|
|
for I := 0 to High(FCurrent.Fields) do
|
|
Add(FCurrent.Fields[I].Caption, FCurrent.Fields[I].Value,
|
|
FCurrent.Fields[I].Secret);
|
|
|
|
LMeta := FCurrent.Folder;
|
|
if FCurrent.Tags <> '' then
|
|
begin
|
|
if LMeta <> '' then LMeta := LMeta + ' - ';
|
|
LMeta := LMeta + FCurrent.Tags;
|
|
end;
|
|
Add('Dossier / etiquettes', LMeta, False);
|
|
// Le sous-type n'existe que pour les modeles (carte, cle SSH, serveur...) ;
|
|
// Add ignore une valeur vide, donc rien a tester ici.
|
|
Add('Type', FCurrent.Template, False);
|
|
// Horodatage tel quel : c'est de l'ISO 8601 UTC, lisible, et le reformater
|
|
// demanderait de decider d'un fuseau alors qu'il n'y a rien a arbitrer.
|
|
Add('Modifie le', FCurrent.UpdatedAt, False);
|
|
|
|
SetLength(FRowValues, Length(FRows));
|
|
SetLength(FRowShown, Length(FRows));
|
|
SetLength(FRowCtls, Length(FRows));
|
|
|
|
// A REBOURS : des controles alignes en haut s'empilent dans l'ordre inverse
|
|
// de leur creation, donc la derniere ligne se cree en premier.
|
|
for I := High(FRows) downto 0 do
|
|
begin
|
|
LRow := MakeRow(FDetBody, FRows[I].Caption, LValue);
|
|
FRowCtls[I] := LRow;
|
|
FRowValues[I] := LValue;
|
|
FRowShown[I] := False;
|
|
if FRows[I].Secret then
|
|
begin
|
|
LValue.Text := MASK;
|
|
AddRowButton(LRow, 'Afficher', I, OnRevealTap);
|
|
end
|
|
else
|
|
LValue.Text := FRows[I].Value;
|
|
AddRowButton(LRow, 'Copier', I, OnCopyTap);
|
|
end;
|
|
// La derniere ligne affichee touche sinon le bord du defilement, ce qui la
|
|
// fait passer pour tronquee alors qu'elle est juste collee.
|
|
if Length(FRowCtls) > 0 then
|
|
FRowCtls[High(FRows)].Margins.Bottom := 12;
|
|
|
|
// Le TOTP est la seule ligne vivante : creee en dernier, donc affichee en
|
|
// tete, parce que c'est ce qu'on vient chercher sur un telephone.
|
|
if FCurrent.Totp <> '' then
|
|
begin
|
|
LRow := MakeRow(FDetBody, 'Code 2FA', FTotpValue);
|
|
SetLength(FRowCtls, Length(FRowCtls) + 1);
|
|
FRowCtls[High(FRowCtls)] := LRow;
|
|
FTotpValue.TextSettings.Font.Size := 26;
|
|
AddRowButton(LRow, 'Copier', -1, OnCopyTap);
|
|
OnTotpTick(nil); // pas d'attente d'une seconde a l'ouverture
|
|
FTotpTimer.Enabled := True;
|
|
end;
|
|
|
|
FLayList.Visible := False;
|
|
FLayDetail.Visible := True;
|
|
end;
|
|
|
|
procedure TForm8.OnTotpTick(Sender: TObject);
|
|
var
|
|
LLeft, LPeriod: Integer;
|
|
begin
|
|
if FTotpValue = nil then
|
|
begin
|
|
FTotpTimer.Enabled := False;
|
|
Exit;
|
|
end;
|
|
FTotpCode := TotpNow(FCurrent.Totp, LLeft, LPeriod);
|
|
if FTotpCode = '' then
|
|
begin
|
|
// Un secret illisible ne doit pas passer pour un code : le dire.
|
|
FTotpValue.Text := 'secret illisible';
|
|
FTotpTimer.Enabled := False;
|
|
Exit;
|
|
end;
|
|
// Coupe en deux, comme partout ailleurs : six chiffres d'affilee se
|
|
// recopient mal.
|
|
FTotpValue.Text := Copy(FTotpCode, 1, Length(FTotpCode) div 2) + ' ' +
|
|
Copy(FTotpCode, Length(FTotpCode) div 2 + 1, MaxInt) +
|
|
' ' + LLeft.ToString + ' s';
|
|
end;
|
|
|
|
procedure TForm8.OnBackTap(Sender: TObject);
|
|
begin
|
|
// Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail.
|
|
if (Sender is TButton) and (TButton(Sender).Tag = 1) then
|
|
LockVault
|
|
else
|
|
ShowList;
|
|
end;
|
|
|
|
procedure TForm8.OnHardwareBack(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
begin
|
|
if Key <> vkHardwareBack then Exit;
|
|
if FLayDetail.Visible then
|
|
begin
|
|
ShowList;
|
|
Key := 0; // consomme : sinon Android ferme l'application
|
|
end
|
|
else if FLayList.Visible then
|
|
begin
|
|
LockVault;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.OnToggleSettings(Sender: TObject);
|
|
begin
|
|
FLaySettings.Visible := not FLaySettings.Visible;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Ouverture, synchronisation, verrouillage
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.LockVault;
|
|
begin
|
|
// Le clair dispararait de la memoire ET de l'ecran. Le fichier local reste :
|
|
// il est chiffre par le materiel, c'est tout l'interet du cache.
|
|
//
|
|
// L'ETAG PART AVEC LUI. Il decrit le clair detenu, pas un telechargement :
|
|
// le garder ferait repondre 304 au serveur alors qu'on n'a plus rien a
|
|
// afficher - et sur un poste sans cache local (hors Android), plus aucun
|
|
// moyen de rouvrir le coffre sans relancer l'application.
|
|
FETag := '';
|
|
FVault.Clear;
|
|
FList.Clear;
|
|
FIcons.Clear;
|
|
// Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
|
|
// fait partie du verrouillage, pas de l'affichage.
|
|
ClearDetailRows;
|
|
FCurrent := Default(TVaultEntry);
|
|
ShowUnlock;
|
|
end;
|
|
|
|
procedure TForm8.AdoptVault(const APlainJson: string);
|
|
begin
|
|
FVault.LoadFromJson(APlainJson);
|
|
Log(' ' + FVault.LiveCount.ToString + ' entrees, ' +
|
|
FVault.TrashCount.ToString + ' en corbeille');
|
|
RebuildIcons;
|
|
PopulateFolders;
|
|
// Deja dans l'application : reconstruire la liste SANS y ramener
|
|
// l'utilisateur. Obligatoire meme s'il est dans le detail - les lignes de
|
|
// la liste portent des indices vers l'ancien coffre, et un appui ouvrirait
|
|
// la mauvaise entree.
|
|
if FLayList.Visible or FLayDetail.Visible then
|
|
OnSearchChanged(nil)
|
|
else
|
|
ShowList;
|
|
end;
|
|
|
|
procedure TForm8.OpenLocalNow;
|
|
var
|
|
LPlain, LETag, LPwd: string;
|
|
begin
|
|
if LoadVault(LPlain, LETag, LPwd) then
|
|
begin
|
|
FETag := LETag;
|
|
if LPwd <> '' then FSyncPwd := LPwd;
|
|
try
|
|
AdoptVault(LPlain);
|
|
// Afficher d'abord, synchroniser ensuite : le coffre est a l'ecran, le
|
|
// reseau se debrouille derriere. Sans mot de passe range, on ne peut
|
|
// rien ouvrir de nouveau - inutile d'aller voir.
|
|
if FSyncPwd <> '' then
|
|
FetchAndDecrypt(FUrl.Text.Trim, FToken.Text.Trim, FSyncPwd, True);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
// Un coffre local illisible se remplace, il ne se repare pas.
|
|
Log('Coffre local corrompu : ' + E.Message);
|
|
ClearVault;
|
|
ShowUnlock;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Status('Coffre local illisible - retelechargement necessaire');
|
|
ShowUnlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.DoOpenLocal(Sender: TObject);
|
|
begin
|
|
if FBusy then Exit;
|
|
// L'authentification affiche un dialogue systeme : elle doit rester sur le
|
|
// thread principal, et PRECEDER toute lecture du coffre.
|
|
if not VaultNeedsAuth then
|
|
begin
|
|
OpenLocalNow;
|
|
Exit;
|
|
end;
|
|
|
|
Status('Authentification...');
|
|
AuthenticateThen('Acceder au coffre',
|
|
procedure(AOutcome: TBioOutcome)
|
|
begin
|
|
case AOutcome of
|
|
boOK: OpenLocalNow;
|
|
boCancelled: Status('Annule');
|
|
boUnavailable:
|
|
begin
|
|
// La protection a ete retiree de l'appareil depuis l'ecriture du
|
|
// cache : celui-ci est devenu illisible pour toujours.
|
|
Log('Plus aucune protection sur l''appareil - cache efface');
|
|
ClearVault;
|
|
ShowUnlock;
|
|
end;
|
|
else
|
|
Status('Echec de l''authentification');
|
|
end;
|
|
end);
|
|
end;
|
|
|
|
procedure TForm8.DoSync(Sender: TObject);
|
|
var
|
|
LUrl, LTok, LPwd: string;
|
|
begin
|
|
if FBusy then Exit;
|
|
// Lus ICI, sur le thread principal : toucher un controle FMX depuis le
|
|
// thread de travail est un plantage differe, pas une erreur de compilation.
|
|
LUrl := FUrl.Text.Trim;
|
|
LTok := FToken.Text.Trim;
|
|
// Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
|
|
// range qui ne convient plus.
|
|
LPwd := FPwd.Text;
|
|
if LPwd = '' then LPwd := FSyncPwd;
|
|
if LPwd = '' then
|
|
begin
|
|
Status('Mot de passe de sync requis');
|
|
Exit;
|
|
end;
|
|
FLog.Lines.Clear;
|
|
FetchAndDecrypt(LUrl, LTok, LPwd);
|
|
end;
|
|
|
|
procedure TForm8.FetchAndDecrypt(const AUrl, ATok, APwd: string;
|
|
ASilent: Boolean);
|
|
begin
|
|
SetBusy(True);
|
|
if not ASilent then Status('Telechargement...');
|
|
TThread.CreateAnonymousThread(
|
|
procedure
|
|
var
|
|
LClient: TSyncClient;
|
|
LRes: TSyncResult;
|
|
LPlain, LCached, LCachedETag, LCachedPwd: string;
|
|
LSw: TStopwatch;
|
|
begin
|
|
// Le coffre local d'abord : s'il est la, on connait deja l'ETag et on
|
|
// evite les 4 secondes de derivation quand rien n'a change.
|
|
if (FETag = '') and LoadVault(LCached, LCachedETag, LCachedPwd) then
|
|
FETag := LCachedETag;
|
|
|
|
LClient := TSyncClient.Create(AUrl, ATok);
|
|
// try/finally et NON un simple enchainement : les Exit des branches
|
|
// d'erreur ci-dessous sautent la fin de la procedure, ce qui laissait
|
|
// l'interface bloquee apres le premier echec.
|
|
try
|
|
try
|
|
Log('GET ' + AUrl);
|
|
if FETag <> '' then Log(' If-None-Match: ' + FETag);
|
|
LSw := TStopwatch.StartNew;
|
|
LRes := LClient.Fetch(FETag);
|
|
LSw.Stop;
|
|
Log(' HTTP ' + LRes.HttpCode.ToString + ' en ' +
|
|
LSw.ElapsedMilliseconds.ToString + ' ms');
|
|
|
|
case LRes.Status of
|
|
ssNotModified:
|
|
begin
|
|
// C'est ICI que le cache paie : pas de telechargement, pas de
|
|
// derivation, le coffre vient du fichier local.
|
|
// Rien n'a change cote serveur : le clair est deja quelque part,
|
|
// soit en memoire, soit dans le cache lu en debut de procedure.
|
|
// Surtout PAS de relecture du fichier ici - elle peut echouer
|
|
// (authentification expiree) et laisserait l'utilisateur sans
|
|
// rien apres un appel pourtant reussi.
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
if FVault.Count > 0 then
|
|
// Rien a faire : ce qui est affiche est deja a jour. En
|
|
// rafraichissement de fond c'est le cas courant, et il
|
|
// doit passer inapercu - surtout pas de retour a la liste
|
|
// alors que l'utilisateur consulte une entree.
|
|
Log(' 304 : inchange, coffre deja ouvert')
|
|
else if LCached <> '' then
|
|
begin
|
|
Log(' 304 : inchange, coffre servi depuis le cache');
|
|
try
|
|
AdoptVault(LCached);
|
|
except
|
|
on E: Exception do Status('Cache illisible : ' + E.Message);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Un ETag sans clair correspondant : l'invariant est rompu.
|
|
// On le jette pour que l'appel suivant retelecharge.
|
|
FETag := '';
|
|
if not ASilent then
|
|
Status('Cache absent - appuyer a nouveau pour telecharger');
|
|
end;
|
|
end);
|
|
Exit;
|
|
end;
|
|
ssNoSnapshot:
|
|
begin
|
|
// Le serveur repond pareil dans les deux cas, par conception.
|
|
Log(' 404 : pas d''instantane OU jeton invalide');
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure
|
|
begin Status('Rien a telecharger (404)'); end);
|
|
Exit;
|
|
end;
|
|
ssRefused, ssHttpError, ssNetworkError:
|
|
begin
|
|
// En fond, un echec reseau ne se signale pas : le coffre local
|
|
// est affiche, hors ligne est un etat normal, et une alerte ici
|
|
// apprendrait a l'utilisateur a ignorer les alertes.
|
|
Log(' echec : ' + LRes.Error);
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure
|
|
begin Status('Echec reseau'); end);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Log(' recu ' + Length(LRes.Container).ToString + ' octets');
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure begin Status('Dechiffrement...'); end);
|
|
|
|
LSw := TStopwatch.StartNew;
|
|
// Volontairement AVANT de retenir l'ETag : un echec ici doit laisser
|
|
// FETag vide pour que le prochain essai retelecharge.
|
|
LPlain := DecryptContainer(LRes.Container, APwd);
|
|
LSw.Stop;
|
|
FETag := LRes.ETag;
|
|
Log(' dechiffre en ' + LSw.ElapsedMilliseconds.ToString + ' ms');
|
|
|
|
// Ecrit APRES un dechiffrement reussi seulement, et avec son ETag :
|
|
// les deux doivent rester coherents.
|
|
try
|
|
// True : on DEMANDE la protection par authentification. PMA.Store
|
|
// retombe tout seul sur une cle simple si l'appareil n'a ni
|
|
// empreinte ni code, plutot que de renoncer au cache.
|
|
// Le mot de passe part avec le coffre : c'est lui qui permettra au
|
|
// prochain lancement de rafraichir sans rien demander.
|
|
SaveVault(LPlain, FETag, APwd, True);
|
|
if VaultNeedsAuth then
|
|
Log(' cache ecrit - protege par biometrie/code')
|
|
else
|
|
Log(' cache ecrit - AUCUNE protection sur cet appareil');
|
|
except
|
|
// La classe compte autant que le message : "methode introuvable"
|
|
// designe une signature JNI fausse, pas un probleme de stockage.
|
|
on E: Exception do
|
|
Log(' cache non ecrit : ' + E.ClassName + ' - ' + E.Message);
|
|
end;
|
|
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
FSyncPwd := APwd; // il vient d'ouvrir un conteneur : il est bon
|
|
try
|
|
AdoptVault(LPlain);
|
|
except
|
|
on E: Exception do
|
|
if not ASilent then
|
|
Status('Instantane illisible : ' + E.Message);
|
|
end;
|
|
end);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Log('ERREUR ' + E.ClassName + ' : ' + E.Message);
|
|
// Le cas de loin le plus frequent, et le message par defaut ne le
|
|
// dit pas : GCM echoue a la verification quand la cle est fausse.
|
|
//
|
|
// En fond, cela veut dire que le mot de passe range ne convient
|
|
// plus - le poste a change de mot de passe de sync. On ne le jette
|
|
// PAS : il faudra le retaper, mais garder l'ancien laisse au moins
|
|
// le champ prerempli, et le coffre local reste consultable.
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure
|
|
begin Status('Echec - mot de passe de sync incorrect ?'); end);
|
|
end;
|
|
end;
|
|
finally
|
|
LClient.Free;
|
|
TThread.Queue(nil, procedure begin SetBusy(False); end);
|
|
end;
|
|
end).Start;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Liste et recherche
|
|
---------------------------------------------------------------------------- }
|
|
|
|
/// Data URI -> bitmap, ou nil. Les icones peuvent etre du SVG, que FMX ne
|
|
/// sait pas charger : l'echec est normal et se solde par les initiales.
|
|
function BitmapFromDataUri(const AUri: string): TBitmap;
|
|
var
|
|
LComma: Integer;
|
|
LStream: TBytesStream;
|
|
begin
|
|
Result := nil;
|
|
if not AUri.StartsWith('data:') then Exit;
|
|
LComma := Pos(',', AUri);
|
|
if LComma = 0 then Exit;
|
|
try
|
|
LStream := TBytesStream.Create(TNetEncoding.Base64.DecodeStringToBytes(
|
|
Copy(AUri, LComma + 1, MaxInt)));
|
|
try
|
|
Result := TBitmap.Create;
|
|
Result.LoadFromStream(LStream);
|
|
finally
|
|
LStream.Free;
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.RebuildIcons;
|
|
var
|
|
I: Integer;
|
|
LBmp: TBitmap;
|
|
begin
|
|
FIcons.Clear;
|
|
// ponytail: tout decode a l'adoption du coffre, sur le thread principal.
|
|
// Quelques centaines de vignettes de 16 px ne se sentent pas ; deporter
|
|
// dans un thread le jour ou l'ouverture marque un temps.
|
|
for I := 0 to FVault.Count - 1 do
|
|
begin
|
|
if FVault.Entry(I).IconB64 = '' then Continue;
|
|
LBmp := BitmapFromDataUri(FVault.Entry(I).IconB64);
|
|
if LBmp <> nil then FIcons.Add(I, LBmp);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.PopulateFolders;
|
|
var
|
|
LF, LPrev: string;
|
|
I: Integer;
|
|
begin
|
|
// Le choix courant survit a un rafraichissement de fond : le voir retomber
|
|
// sur "tous" tout seul, sans avoir rien touche, serait deroutant.
|
|
LPrev := '';
|
|
if FFolderBox.ItemIndex > 0 then
|
|
LPrev := FFolderBox.Items[FFolderBox.ItemIndex];
|
|
|
|
FFolderBox.Items.BeginUpdate;
|
|
try
|
|
FFolderBox.Items.Clear;
|
|
FFolderBox.Items.Add('Tous les dossiers');
|
|
for LF in FVault.Folders do FFolderBox.Items.Add(LF);
|
|
finally
|
|
FFolderBox.Items.EndUpdate;
|
|
end;
|
|
|
|
I := FFolderBox.Items.IndexOf(LPrev);
|
|
if I < 0 then I := 0;
|
|
FFolderBox.ItemIndex := I;
|
|
end;
|
|
|
|
procedure TForm8.OnSearchChanged(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
LItem: TListBoxItem;
|
|
E: TVaultEntry;
|
|
LFolder: string;
|
|
LBmp: TBitmap;
|
|
begin
|
|
// ponytail: refonte complete de la liste a chaque frappe. Sur un coffre de
|
|
// quelques centaines d'entrees c'est imperceptible ; passer a un modele
|
|
// virtuel (TListView) le jour ou ca rame.
|
|
LFolder := '';
|
|
if FFolderBox.ItemIndex > 0 then // 0 = tous les dossiers
|
|
LFolder := FFolderBox.Items[FFolderBox.ItemIndex];
|
|
FFiltered := FVault.Search(FSearch.Text, LFolder);
|
|
|
|
FList.BeginUpdate;
|
|
try
|
|
FList.Clear;
|
|
for I := 0 to High(FFiltered) do
|
|
begin
|
|
E := FVault.Entry(FFiltered[I]);
|
|
LItem := TListBoxItem.Create(FList);
|
|
LItem.Parent := FList;
|
|
LItem.Text := E.Display;
|
|
LItem.ItemData.Detail := E.Username;
|
|
LItem.StyleLookup := 'listboxitembottomdetail';
|
|
// Le setter copie le bitmap : le cache garde la propriete du sien.
|
|
if FIcons.TryGetValue(FFiltered[I], LBmp) then
|
|
LItem.ItemData.Bitmap := LBmp;
|
|
LItem.Tag := FFiltered[I]; // indice dans le coffre, pas dans la liste
|
|
end;
|
|
finally
|
|
FList.EndUpdate;
|
|
end;
|
|
|
|
if (FSearch.Text.Trim = '') and (LFolder = '') then
|
|
FCount.Text := FVault.LiveCount.ToString + ' entrees'
|
|
else
|
|
FCount.Text := Length(FFiltered).ToString + ' / ' +
|
|
FVault.LiveCount.ToString;
|
|
end;
|
|
|
|
procedure TForm8.OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
|
|
begin
|
|
if AItem <> nil then ShowDetail(AItem.Tag);
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Detail : reveler et copier
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.OnRevealTap(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if not (Sender is TButton) then Exit;
|
|
I := TButton(Sender).Tag;
|
|
if (I < 0) or (I > High(FRows)) then Exit;
|
|
|
|
FRowShown[I] := not FRowShown[I];
|
|
if FRowShown[I] then
|
|
begin
|
|
FRowValues[I].Text := FRows[I].Value;
|
|
TButton(Sender).Text := 'Masquer';
|
|
end
|
|
else
|
|
begin
|
|
FRowValues[I].Text := MASK;
|
|
TButton(Sender).Text := 'Afficher';
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.OnCopyTap(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if not (Sender is TButton) then Exit;
|
|
I := TButton(Sender).Tag;
|
|
// -1 : la ligne du TOTP, qui n'est pas dans FRows - sa valeur change chaque
|
|
// periode et ne vit que dans FTotpCode. Copie sans l'espace d'affichage.
|
|
if I = -1 then
|
|
CopyToClipboard(FTotpCode, 'Code 2FA')
|
|
else if (I >= 0) and (I <= High(FRows)) then
|
|
CopyToClipboard(FRows[I].Value, FRows[I].Caption);
|
|
end;
|
|
|
|
procedure TForm8.CopyToClipboard(const AText, ALabel: string);
|
|
var
|
|
LClip: IFMXClipboardService;
|
|
begin
|
|
if AText = '' then Exit;
|
|
if not TPlatformServices.Current.SupportsPlatformService(
|
|
IFMXClipboardService, LClip) then Exit;
|
|
LClip.SetClipboard(AText);
|
|
FCopied := AText;
|
|
// Reprogramme depuis zero : deux copies successives donnent au second
|
|
// contenu son delai complet, pas le reste de celui du premier.
|
|
FClipTimer.Enabled := False;
|
|
FClipTimer.Enabled := True;
|
|
// ponytail: le message reste jusqu'a la prochaine navigation, pas de minuterie
|
|
// pour l'effacer. Un deuxieme TTimer pour deux secondes d'affichage serait
|
|
// plus de code que ce que ca apporte.
|
|
FDetToast.Text := ALabel + ' copie - presse-papiers efface dans ' +
|
|
CLIPBOARD_CLEAR_SECONDS.ToString + ' s';
|
|
end;
|
|
|
|
procedure TForm8.OnClipTimer(Sender: TObject);
|
|
var
|
|
LClip: IFMXClipboardService;
|
|
begin
|
|
FClipTimer.Enabled := False;
|
|
if FCopied = '' then Exit;
|
|
if TPlatformServices.Current.SupportsPlatformService(
|
|
IFMXClipboardService, LClip) then
|
|
// Seulement si c'est TOUJOURS notre texte : l'utilisateur a pu copier
|
|
// autre chose entre-temps, et le lui effacer serait une surprise.
|
|
if LClip.GetClipboard.ToString = FCopied then
|
|
LClip.SetClipboard('');
|
|
FCopied := '';
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Cycle de vie
|
|
---------------------------------------------------------------------------- }
|
|
|
|
function TForm8.HandleAppEvent(AAppEvent: TApplicationEvent;
|
|
AContext: TObject): Boolean;
|
|
begin
|
|
Result := True;
|
|
case AAppEvent of
|
|
// WillBecomeInactive arrive AVANT la capture d'ecran des applications
|
|
// recentes : masquer ici, c'est ne pas y laisser la liste des comptes.
|
|
TApplicationEvent.WillBecomeInactive:
|
|
if FLayList.Visible or FLayDetail.Visible then
|
|
begin
|
|
FLayDetail.Visible := False;
|
|
FLayList.Visible := False;
|
|
FLayUnlock.Visible := True;
|
|
end;
|
|
// Et le clair est reellement jete quand l'application passe derriere.
|
|
TApplicationEvent.EnteredBackground:
|
|
if FVault.Count > 0 then LockVault;
|
|
end;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Journal
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.Log(const AMsg: string);
|
|
begin
|
|
// Appele depuis le thread de calcul : la mise a jour d'un controle FMX doit
|
|
// repasser par le thread principal.
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
FLog.Lines.Add(AMsg);
|
|
FLog.GoToTextEnd;
|
|
end);
|
|
end;
|
|
|
|
procedure TForm8.Status(const AMsg: string);
|
|
begin
|
|
FStatus.Text := AMsg;
|
|
end;
|
|
|
|
procedure TForm8.SetBusy(ABusy: Boolean);
|
|
begin
|
|
FBusy := ABusy;
|
|
FBtnSync.Enabled := not ABusy;
|
|
FBtnOpen.Enabled := not ABusy;
|
|
end;
|
|
|
|
end.
|