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, 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 TForm8 = class(TForm) private FVault: TVault; FFiltered: TArray; // indices dans FVault, resultat de la recherche FCurrent: TVaultEntry; FPwdShown: Boolean; // 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; // --- 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; FList: TListBox; FCount: TLabel; // --- ecran 3 : detail FLayDetail: TLayout; FDetTitle: TLabel; FDetSite, FDetUser, FDetPwd, FDetMeta, FDetToast: TLabel; FBtnReveal: TButton; // --- presse-papiers FClipTimer: TTimer; FCopied: string; procedure BuildUnlock; procedure BuildList; procedure BuildDetail; procedure ShowUnlock; procedure ShowList; procedure ShowDetail(AVaultIndex: Integer); 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); procedure FetchAndDecrypt(const AUrl, ATok, APwd: string); procedure AdoptVault(const APlainJson: string); procedure LockVault; procedure OnSearchChanged(Sender: TObject); 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; {$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'; FVault := TVault.Create; 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; // 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; end; destructor TForm8.Destroy; begin 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: 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; FSearch := TEdit.Create(Self); FSearch.Parent := FLayList; FSearch.Align := TAlignLayout.Top; FSearch.Margins.Rect := RectF(8, 8, 8, 8); FSearch.TextPrompt := 'Rechercher'; FSearch.OnChangeTracking := OnSearchChanged; end; /// Une ligne du detail : intitule discret, valeur, bouton Copier. /// ATag porte ce qu'il faut copier (1 site, 2 identifiant, 3 mot de passe). function DetailRow(AParent: TFmxObject; const ACaption: string; ATag: Integer; AOnCopy: TNotifyEvent; out AValue: TLabel): TLayout; var LCap: TLabel; LBtn: TButton; begin Result := TLayout.Create(AParent); Result.Parent := AParent; Result.Align := TAlignLayout.Top; Result.Height := 62; Result.Margins.Rect := RectF(12, 10, 12, 0); // Pas de bouton sur une ligne purement informative (dossier, etiquettes) : // un "Copier" inerte se clique quand meme. if Assigned(AOnCopy) then begin LBtn := TButton.Create(Result); LBtn.Parent := Result; LBtn.Align := TAlignLayout.Right; LBtn.Width := 90; LBtn.Text := 'Copier'; LBtn.Tag := ATag; LBtn.OnClick := AOnCopy; end; 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; procedure TForm8.BuildDetail; var LRowPwd: TLayout; 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; // Du bas vers le haut : dossier/tags, mot de passe, identifiant, site, titre. DetailRow(FLayDetail, 'Dossier / etiquettes', 0, nil, FDetMeta); LRowPwd := DetailRow(FLayDetail, 'Mot de passe', 3, OnCopyTap, FDetPwd); FBtnReveal := TButton.Create(LRowPwd); FBtnReveal.Parent := LRowPwd; FBtnReveal.Align := TAlignLayout.Right; FBtnReveal.Margins.Right := 6; FBtnReveal.Width := 90; FBtnReveal.Text := 'Afficher'; FBtnReveal.OnClick := OnRevealTap; DetailRow(FLayDetail, 'Identifiant', 2, OnCopyTap, FDetUser); DetailRow(FLayDetail, 'Site', 1, OnCopyTap, FDetSite); 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 FLayUnlock.Visible := False; FLayDetail.Visible := False; FLayList.Visible := True; FSearch.Text := ''; OnSearchChanged(nil); end; procedure TForm8.ShowDetail(AVaultIndex: Integer); var LMeta: string; begin FCurrent := FVault.Entry(AVaultIndex); FPwdShown := False; FDetTitle.Text := FCurrent.Display; FDetSite.Text := FCurrent.Site; FDetUser.Text := FCurrent.Username; FDetPwd.Text := MASK; FDetToast.Text := ''; FBtnReveal.Text := 'Afficher'; LMeta := FCurrent.Folder; if FCurrent.Tags <> '' then begin if LMeta <> '' then LMeta := LMeta + ' - '; LMeta := LMeta + FCurrent.Tags; end; FDetMeta.Text := LMeta; FLayList.Visible := False; FLayDetail.Visible := True; 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; FCurrent := Default(TVaultEntry); FDetPwd.Text := MASK; FPwdShown := False; ShowUnlock; end; procedure TForm8.AdoptVault(const APlainJson: string); begin FVault.LoadFromJson(APlainJson); Log(' ' + FVault.LiveCount.ToString + ' entrees, ' + FVault.TrashCount.ToString + ' en corbeille'); ShowList; end; procedure TForm8.OpenLocalNow; var LPlain, LETag: string; begin if LoadVault(LPlain, LETag) then begin FETag := LETag; try AdoptVault(LPlain); 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; LPwd := FPwd.Text; 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); begin SetBusy(True); Status('Telechargement...'); TThread.CreateAnonymousThread( procedure var LClient: TSyncClient; LRes: TSyncResult; LPlain, LCached, LCachedETag: 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) 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 begin Log(' 304 : inchange, coffre deja ouvert'); ShowList; end 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 := ''; 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'); TThread.Queue(nil, procedure begin Status('Rien a telecharger (404)'); end); Exit; end; ssRefused, ssHttpError, ssNetworkError: begin Log(' echec : ' + LRes.Error); TThread.Queue(nil, procedure begin Status('Echec reseau'); end); Exit; end; end; Log(' recu ' + Length(LRes.Container).ToString + ' octets'); 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. SaveVault(LPlain, FETag, 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 try AdoptVault(LPlain); except on E: Exception do 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. 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 ---------------------------------------------------------------------------- } procedure TForm8.OnSearchChanged(Sender: TObject); var I: Integer; LItem: TListBoxItem; E: TVaultEntry; 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. FFiltered := FVault.Search(FSearch.Text); 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'; LItem.Tag := FFiltered[I]; // indice dans le coffre, pas dans la liste end; finally FList.EndUpdate; end; if FSearch.Text.Trim = '' 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); begin FPwdShown := not FPwdShown; if FPwdShown then begin FDetPwd.Text := FCurrent.Password; FBtnReveal.Text := 'Masquer'; end else begin FDetPwd.Text := MASK; FBtnReveal.Text := 'Afficher'; end; end; procedure TForm8.OnCopyTap(Sender: TObject); begin if not (Sender is TButton) then Exit; case TButton(Sender).Tag of 1: CopyToClipboard(FCurrent.Site, 'Site'); 2: CopyToClipboard(FCurrent.Username, 'Identifiant'); 3: CopyToClipboard(FCurrent.Password, 'Mot de passe'); end; 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.