refactor(android): the unlock screen moves to HTML, Skia and the style go
The caret in an Android TEdit does not land where you touch, which makes a long bearer token impossible to correct - the reason the last FMX screen had to go. A field in the engine inherits the system's text handling (caret, selection, handles, paste) for free. With no FMX control left, two things became dead weight and are gone: the vendored Dark.style, which had nothing left to style, and Skia - 25 MB carried solely so FMX labels would shape Arabic. The engine does its own shaping; checked on the device, an Arabic filename still reads correctly. The APK drops from 22.0 to 12.7 MB. Delphi stays the owner of the server settings; the page only edits them and hands them back when a field loses focus, one navigation per changed field rather than one per keystroke. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
+14
-210
@@ -1,157 +1,36 @@
|
||||
unit PMA.Theme;
|
||||
{
|
||||
Palette et controles peints a la main.
|
||||
La palette, et le fond de la forme.
|
||||
|
||||
POURQUOI PAS UN STYLE : aucun des styles livres avec Delphi n'est pense pour
|
||||
un mobile - degrades gris, angles vifs, cadres epais, tous datent de
|
||||
l'epoque bureau. Et la journee a montre que tout ce qui passe par un gabarit
|
||||
de style peut ne pas exister dans le style charge : le gabarit de ligne de
|
||||
liste, l'invite de recherche, la ligne de detail ont disparu tour a tour.
|
||||
CE QU'IL RESTE D'UN THEME. Cette unite habillait autrefois des boutons, des
|
||||
surfaces et des libelles peints a la main, et chargeait un style pour les
|
||||
controles natifs qu'on ne reecrivait pas. L'interface est passee au moteur du
|
||||
systeme (android-client/web) : il n'y a plus un seul controle FMX a habiller,
|
||||
donc tout cela est parti - avec le style vendu, qui n'avait plus rien a styler.
|
||||
|
||||
Un style RESTE charge malgre tout, comme socle : les champs de saisie, la
|
||||
liste et le memo sont des controles natifs qu'on ne va pas reecrire, et sans
|
||||
style ils s'afficheraient en clair. Tout le reste - boutons, surfaces,
|
||||
couleurs - est peint ici, ou rien ne peut disparaitre.
|
||||
|
||||
Le style vient de Dark.style, livre avec Delphi, recopie dans le depot pour
|
||||
que la compilation ne depende pas d'un chemin d'installation.
|
||||
Ce qui subsiste sert au CADRE, que la page ne peut pas atteindre : le fond de
|
||||
la forme, visible un instant avant le premier rendu du moteur, et les deux
|
||||
couleurs que prennent les barres systeme. Elles doivent suivre celles de
|
||||
app.html, sinon la jonction se voit.
|
||||
}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
// FMX.Graphics pour TBrush, que PaintBackground prend en parametre.
|
||||
System.UITypes, System.Classes, FMX.Types, FMX.Graphics, FMX.Objects,
|
||||
FMX.StdCtrls;
|
||||
System.UITypes, FMX.Types, FMX.Graphics;
|
||||
|
||||
const
|
||||
// Releve sur la recherche globale du telephone, qui est la reference pour
|
||||
// tout ce qui se touche - l'application doit ressembler a l'endroit ou elle
|
||||
// tourne, pas seulement au service qu'elle prolonge.
|
||||
//
|
||||
// CE QUI FAIT CE STYLE, et qu'il faut tenir : un DEGRADE bleu en fond, des
|
||||
// blocs qui ne sont que du BLANC TRANSLUCIDE pose dessus, AUCUNE bordure, de
|
||||
// grands arrondis, du texte blanc. La profondeur vient de la transparence,
|
||||
// pas des filets - c'est pour ca que les cadres ont disparu.
|
||||
// Releve sur la recherche globale du telephone : un degrade bleu, des blocs
|
||||
// qui ne sont que du blanc translucide pose dessus, aucune bordure.
|
||||
COL_BG_TOP = TAlphaColor($FF3E6394); // haut du degrade
|
||||
COL_BG = TAlphaColor($FF1B3563); // bas du degrade, et repli uni
|
||||
COL_SURFACE = TAlphaColor($1FFFFFFF); // bloc : 12 % de blanc
|
||||
COL_RAISED = TAlphaColor($2EFFFFFF); // bouton au repos : 18 %
|
||||
COL_ACCENT = TAlphaColor($4DFFFFFF); // action principale : 30 %
|
||||
COL_LINE = TAlphaColor($00000000); // plus de filet : garde pour l'API
|
||||
COL_TEXT = TAlphaColor($FFFFFFFF);
|
||||
COL_MUTED = TAlphaColor($B3E8F0FA);
|
||||
COL_ON_ACC = TAlphaColor($FFFFFFFF); // le blanc reste lisible sur 30 %
|
||||
|
||||
/// Un seul arrondi pour tout ce qui se touche - champs comme boutons. Il
|
||||
/// doit suivre celui de make-style.ps1, qui l'applique aux champs natifs.
|
||||
RADIUS = 14;
|
||||
|
||||
/// A appeler une fois, avant la creation de la forme.
|
||||
procedure ApplyDarkTheme;
|
||||
|
||||
/// Bouton plat. APrimary le remplit de cyan ; sinon il reste sobre.
|
||||
/// Renvoie un TRectangle et non un TButton : c'est justement pour ne plus
|
||||
/// dependre du gabarit qu'un TButton irait chercher dans le style.
|
||||
function FlatButton(AParent: TFmxObject; const AText: string;
|
||||
AOnClick: TNotifyEvent; APrimary: Boolean = False): TRectangle;
|
||||
|
||||
/// Fixe un arrondi choisi, au lieu de la pilule automatique. Pour les petits
|
||||
/// boutons de ligne, qu'une pilule rendrait presque ovales.
|
||||
procedure SetCornerRadius(AButton: TRectangle; AValue: Single);
|
||||
|
||||
/// Le libelle est un enfant du bouton, retenu par TagObject.
|
||||
procedure SetButtonText(AButton: TRectangle; const AText: string);
|
||||
procedure SetButtonEnabled(AButton: TRectangle; AEnabled: Boolean);
|
||||
|
||||
/// Bloc de fond, coins arrondis, filet discret.
|
||||
function Surface(AParent: TFmxObject): TRectangle;
|
||||
|
||||
/// Intitule au-dessus d'une valeur : petit et discret, sans majuscules.
|
||||
procedure SectionLabel(ALabel: TLabel);
|
||||
COL_BG = TAlphaColor($FF1B3563); // bas du degrade
|
||||
|
||||
/// Applique le degrade bleu du fond. A poser sur le Fill de la forme.
|
||||
procedure PaintBackground(AFill: TBrush);
|
||||
|
||||
/// Met un libelle a la palette. AMuted pour les intitules discrets.
|
||||
procedure Tint(ALabel: TLabel; ASize: Single; AMuted: Boolean = False);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, FMX.Styles, FMX.Controls;
|
||||
|
||||
{$R 'theme\theme.res' 'theme\theme.rc'}
|
||||
|
||||
procedure ApplyDarkTheme;
|
||||
var
|
||||
LStyle: TFmxObject;
|
||||
begin
|
||||
try
|
||||
// La lecture appartient a TStyleStreaming, l'application a TStyleManager.
|
||||
LStyle := TStyleStreaming.LoadFromResource(HInstance, 'PMDARKSTYLE', RT_RCDATA);
|
||||
if LStyle <> nil then
|
||||
TStyleManager.SetStyle(LStyle);
|
||||
except
|
||||
// Rien : l'apparence par defaut reste utilisable.
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
/// Retient l'etat au repos pour le restaurer apres l'appui. Un TRectangle
|
||||
/// n'a pas d'etat « enfonce » : sans retour visuel, on ne sait pas si le
|
||||
/// doigt a porte.
|
||||
TPressFeedback = class(TComponent)
|
||||
public
|
||||
Rest: TAlphaColor;
|
||||
procedure Down(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Single);
|
||||
procedure Up(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Single);
|
||||
procedure Leave(Sender: TObject);
|
||||
end;
|
||||
|
||||
procedure TPressFeedback.Down(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
if Sender is TRectangle then TRectangle(Sender).Opacity := 0.62;
|
||||
end;
|
||||
|
||||
procedure TPressFeedback.Up(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
if Sender is TRectangle then TRectangle(Sender).Opacity := 1;
|
||||
end;
|
||||
|
||||
procedure TPressFeedback.Leave(Sender: TObject);
|
||||
begin
|
||||
if Sender is TRectangle then TRectangle(Sender).Opacity := 1;
|
||||
end;
|
||||
|
||||
function Surface(AParent: TFmxObject): TRectangle;
|
||||
begin
|
||||
Result := TRectangle.Create(AParent);
|
||||
Result.Parent := AParent;
|
||||
Result.Fill.Color := COL_SURFACE;
|
||||
// AUCUNE bordure, et un grand arrondi : c'est la translucidite qui detache
|
||||
// le bloc du fond. Un filet rendrait tout de suite l'air « application de
|
||||
// bureau ».
|
||||
Result.Stroke.Kind := TBrushKind.None;
|
||||
Result.XRadius := 20;
|
||||
Result.YRadius := 20;
|
||||
end;
|
||||
|
||||
/// Intitule au-dessus d'une valeur. Ni majuscules ni petites capitales : rien
|
||||
/// n'est en majuscules dans la reference, le second plan s'y marque par la
|
||||
/// couleur et la taille seules.
|
||||
procedure SectionLabel(ALabel: TLabel);
|
||||
begin
|
||||
ALabel.StyledSettings := [];
|
||||
ALabel.TextSettings.Font.Size := 12;
|
||||
ALabel.TextSettings.FontColor := COL_MUTED;
|
||||
end;
|
||||
|
||||
/// Peint le degrade de fond sur une forme.
|
||||
procedure PaintBackground(AFill: TBrush);
|
||||
begin
|
||||
AFill.Kind := TBrushKind.Gradient;
|
||||
@@ -160,79 +39,4 @@ begin
|
||||
// Rien de plus : un TGradient neuf descend deja du haut vers le bas.
|
||||
end;
|
||||
|
||||
function FlatButton(AParent: TFmxObject; const AText: string;
|
||||
AOnClick: TNotifyEvent; APrimary: Boolean): TRectangle;
|
||||
var
|
||||
LCaption: TLabel;
|
||||
LFeedback: TPressFeedback;
|
||||
begin
|
||||
Result := TRectangle.Create(AParent);
|
||||
Result.Parent := AParent;
|
||||
// MEME ARRONDI QUE LES CHAMPS. Un bouton en pilule a cote d'un champ a 14
|
||||
// donnait deux vocabulaires de forme sur la meme ligne ; la coherence vaut
|
||||
// mieux que la fidelite a la reference sur ce point.
|
||||
Result.XRadius := RADIUS;
|
||||
Result.YRadius := RADIUS;
|
||||
Result.Cursor := crHandPoint;
|
||||
Result.Stroke.Kind := TBrushKind.None;
|
||||
// La difference entre principal et secondaire tient a l'opacite du blanc,
|
||||
// pas a une couleur : la reference n'a aucun accent colore.
|
||||
if APrimary then Result.Fill.Color := COL_ACCENT
|
||||
else Result.Fill.Color := COL_RAISED;
|
||||
Result.OnClick := AOnClick;
|
||||
|
||||
LCaption := TLabel.Create(Result);
|
||||
LCaption.Parent := Result;
|
||||
LCaption.Align := TAlignLayout.Client;
|
||||
LCaption.HitTest := False; // le clic doit atteindre le rectangle
|
||||
LCaption.Text := AText;
|
||||
LCaption.TextSettings.HorzAlign := TTextAlign.Center;
|
||||
LCaption.TextSettings.VertAlign := TTextAlign.Center;
|
||||
LCaption.StyledSettings := []; // on gouverne police ET couleur
|
||||
LCaption.TextSettings.Font.Size := 15;
|
||||
if APrimary then LCaption.TextSettings.FontColor := COL_ON_ACC
|
||||
else LCaption.TextSettings.FontColor := COL_TEXT;
|
||||
Result.TagObject := LCaption;
|
||||
|
||||
// Le retour d'appui appartient au bouton : il vit et meurt avec lui.
|
||||
LFeedback := TPressFeedback.Create(Result);
|
||||
LFeedback.Rest := Result.Fill.Color;
|
||||
Result.OnMouseDown := LFeedback.Down;
|
||||
Result.OnMouseUp := LFeedback.Up;
|
||||
Result.OnMouseLeave := LFeedback.Leave;
|
||||
end;
|
||||
|
||||
procedure SetCornerRadius(AButton: TRectangle; AValue: Single);
|
||||
begin
|
||||
if AButton = nil then Exit;
|
||||
// Detache le recalcul automatique, sinon la prochaine mise en page le
|
||||
// ramenerait a la pilule.
|
||||
AButton.OnResize := nil;
|
||||
AButton.XRadius := AValue;
|
||||
AButton.YRadius := AValue;
|
||||
end;
|
||||
|
||||
procedure SetButtonText(AButton: TRectangle; const AText: string);
|
||||
begin
|
||||
if (AButton <> nil) and (AButton.TagObject is TLabel) then
|
||||
TLabel(AButton.TagObject).Text := AText;
|
||||
end;
|
||||
|
||||
procedure SetButtonEnabled(AButton: TRectangle; AEnabled: Boolean);
|
||||
begin
|
||||
if AButton = nil then Exit;
|
||||
AButton.Enabled := AEnabled;
|
||||
// Enabled seul ne se voit pas sur une forme peinte : sans ce grise, un
|
||||
// bouton inactif invite a insister.
|
||||
if AEnabled then AButton.Opacity := 1 else AButton.Opacity := 0.4;
|
||||
end;
|
||||
|
||||
procedure Tint(ALabel: TLabel; ASize: Single; AMuted: Boolean);
|
||||
begin
|
||||
ALabel.StyledSettings := [];
|
||||
ALabel.TextSettings.Font.Size := ASize;
|
||||
if AMuted then ALabel.TextSettings.FontColor := COL_MUTED
|
||||
else ALabel.TextSettings.FontColor := COL_TEXT;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -3,10 +3,9 @@
|
||||
#
|
||||
# POURQUOI : la cible Deploy de MSBuild reconstruit library\lib avant d'appeler
|
||||
# aapt, ce qui efface toute bibliotheque native ajoutee a la main. Or ce projet
|
||||
# n'a pas d'entrees de deploiement fonctionnelles (voir README), donc libsk4d.so
|
||||
# - le moteur Skia, indispensable au rendu de l'arabe - ne peut y arriver
|
||||
# autrement. On laisse donc Deploy faire son travail, puis on remet la
|
||||
# bibliotheque et on refait aapt / zipalign / signature.
|
||||
# n'a pas d'entrees de deploiement fonctionnelles (voir README), donc nos icones
|
||||
# ne peuvent y arriver autrement. On laisse Deploy faire son travail, puis on
|
||||
# remet ce qu'il a efface et on refait aapt / zipalign / signature.
|
||||
#
|
||||
# A lancer depuis la racine du depot, apres un Deploy reussi.
|
||||
|
||||
@@ -18,10 +17,7 @@ $jdk = 'C:\Program Files\Eclipse Adoptium\jdk-11.0.15.10-hotspot'
|
||||
$pac = "$bds\bin\paclient.exe"
|
||||
$p = '.\Android64\Debug\pmserverApk'
|
||||
|
||||
# 1. Remettre Skia, que Deploy vient d'effacer.
|
||||
Copy-Item "$bds\binandroid64\libsk4d.so" "$p\library\lib\arm64-v8a\libsk4d.so" -Force
|
||||
|
||||
# 1 bis. Nos icones par-dessus celles de Delphi. Meme raison que pour Skia :
|
||||
# 1. Nos icones par-dessus celles de Delphi :
|
||||
# les proprietes Android_LauncherIcon* et Android_AdaptiveIcon* du .dproj
|
||||
# devraient suffire, mais rien ne les deploie ici.
|
||||
Copy-Item "$PSScriptRoot\android-res\*" "$p\res\" -Recurse -Force
|
||||
|
||||
@@ -1,63 +0,0 @@
|
||||
# Fabrique pm-dark.style depuis le Dark.style livre avec Delphi, en recolorant
|
||||
# les deux controles dont le fond reste visible.
|
||||
#
|
||||
# POURQUOI PATCHER PLUTOT QUE RENDRE TRANSPARENT : Dark.style ne contient aucun
|
||||
# gabarit 'transparentedit' ni 'transparentmemostyle' - un StyleLookup vers eux
|
||||
# retombe silencieusement sur le gabarit normal, avec son fond gris. Le champ
|
||||
# de recherche et le journal juraient donc avec le reste de l'interface, qui
|
||||
# est peint.
|
||||
#
|
||||
# Tout le reste de l'application ne depend plus d'aucun gabarit : ce style ne
|
||||
# sert qu'aux controles natifs qu'on ne reecrit pas.
|
||||
#
|
||||
# A relancer si la palette de PMA.Theme change, puis recompiler la ressource :
|
||||
# brcc32 theme.rc -fotheme.res
|
||||
|
||||
$ErrorActionPreference = 'Stop'
|
||||
|
||||
$src = 'C:\Program Files (x86)\Embarcadero\Studio\23.0\Redist\styles\Fmx\Dark.style'
|
||||
$dst = Join-Path $PSScriptRoot 'pm-dark.style'
|
||||
|
||||
# Doivent suivre les constantes de PMA.Theme.
|
||||
# Un champ est CREUX : moins de blanc qu'un bouton (18 %) et bien moins que
|
||||
# l'action principale (30 %). Sans cet ecart, une saisie ressemble a une
|
||||
# commande - le mot de passe avait l'air d'un bouton.
|
||||
$surface = 'x1AFFFFFF'
|
||||
$border = 'x00000000' # plus de filet : la reference n'en a aucun
|
||||
$text = 'xFFFFFFFF' # COL_TEXT
|
||||
|
||||
$lines = Get-Content $src
|
||||
$patched = 0
|
||||
|
||||
foreach ($style in 'editstyle', 'memostyle') {
|
||||
$at = ($lines | Select-String -Pattern "StyleName = '$style'" | Select-Object -First 1).LineNumber
|
||||
if (-not $at) { Write-Warning "$style introuvable"; continue }
|
||||
|
||||
# Un champ de saisie prend la forme d'une pilule, comme la barre de
|
||||
# recherche d'Android ; un memo garde ses coins sobres.
|
||||
# 14, comme les boutons de ligne : une pilule faisait ressembler un champ
|
||||
# de saisie a une commande, et l'arrondi restait excessif meme une fois le
|
||||
# remplissage creuse.
|
||||
$radius = '14.000000000000000000'
|
||||
|
||||
# La fenetre couvre le bloc 'background' qui suit immediatement le nom.
|
||||
for ($i = $at; $i -lt [Math]::Min($at + 24, $lines.Count); $i++) {
|
||||
switch -Regex ($lines[$i]) {
|
||||
'Fill\.Color = x' { $lines[$i] = $lines[$i] -replace 'x[0-9A-Fa-f]{8}', $surface; $patched++ }
|
||||
'Stroke\.Color = x' { $lines[$i] = $lines[$i] -replace 'x[0-9A-Fa-f]{8}', $border; $patched++ }
|
||||
'XRadius = ' { $lines[$i] = $lines[$i] -replace '[\d.]+$', $radius }
|
||||
'YRadius = ' { $lines[$i] = $lines[$i] -replace '[\d.]+$', $radius }
|
||||
}
|
||||
}
|
||||
|
||||
# Couleur du texte saisi : 'foreground' vient juste apres le fond.
|
||||
for ($i = $at; $i -lt [Math]::Min($at + 34, $lines.Count); $i++) {
|
||||
if ($lines[$i] -match "StyleName = 'foreground'") {
|
||||
$lines[$i+1] = $lines[$i+1] -replace 'x[0-9A-Fa-f]{8}', $text
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Set-Content $dst $lines -Encoding UTF8
|
||||
"pm-dark.style ecrit, $patched couleurs remplacees"
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1 +0,0 @@
|
||||
PMDARKSTYLE RCDATA "pm-dark.style"
|
||||
+119
-4
@@ -58,7 +58,12 @@
|
||||
detail - dont les blocs sont eux-memes du blanc translucide. */
|
||||
background: linear-gradient(var(--bg-top), var(--bg-bot));
|
||||
}
|
||||
#detail { transform: translateX(100%); }
|
||||
/* Trois vues sur un rail. Le deverrouillage est a gauche, la liste au
|
||||
milieu, le detail a droite ; deux classes sur le corps disent ou on est. */
|
||||
#list, #detail { transform: translateX(100%); }
|
||||
body.on-list #unlock { transform: translateX(-100%); }
|
||||
body.on-list #list { transform: translateX(0); }
|
||||
body.on-detail #unlock { transform: translateX(-100%); }
|
||||
body.on-detail #list { transform: translateX(-22%); }
|
||||
body.on-detail #detail { transform: translateX(0); }
|
||||
|
||||
@@ -163,6 +168,26 @@
|
||||
.bar i { display: block; height: 100%; background: var(--text);
|
||||
transition: width 1s linear; }
|
||||
|
||||
/* --- deverrouillage ----------------------------------------------------- */
|
||||
.status { color: var(--muted); margin: 22px 4px 14px; min-height: 20px; }
|
||||
.stack { display: flex; flex-direction: column; gap: 8px; }
|
||||
.pair { display: flex; gap: 8px; }
|
||||
.pair .btn { flex: 1; }
|
||||
.field-in {
|
||||
width: 100%; height: 46px; padding: 0 14px; margin-top: 8px;
|
||||
border: 0; border-radius: var(--radius-s);
|
||||
background: rgba(255,255,255,.10); color: var(--text);
|
||||
font: inherit; outline: none;
|
||||
}
|
||||
.field-in::placeholder { color: var(--muted); }
|
||||
#log {
|
||||
margin: 10px 0 0; padding: 10px 12px; max-height: 34vh; overflow: auto;
|
||||
background: rgba(0,0,0,.20); border-radius: var(--radius-s);
|
||||
font: 11px/1.45 monospace; white-space: pre-wrap; word-break: break-all;
|
||||
-webkit-user-select: text; user-select: text;
|
||||
}
|
||||
[hidden] { display: none !important; }
|
||||
|
||||
.toast {
|
||||
position: fixed; left: 12px; right: 12px; bottom: 14px;
|
||||
background: rgba(10,20,40,.92); color: var(--text);
|
||||
@@ -173,6 +198,31 @@
|
||||
.toast.on { opacity: 1; }
|
||||
</style>
|
||||
|
||||
<div class="screen" id="unlock">
|
||||
<div class="scroll">
|
||||
<div class="status" id="status"></div>
|
||||
<div class="stack">
|
||||
<button class="btn wide main" id="btnOpen">➜ Open vault</button>
|
||||
<button class="btn wide" id="btnSync">↻ Sync</button>
|
||||
<div class="pair">
|
||||
<button class="btn" id="btnCfg">⚙ Server settings</button>
|
||||
<button class="btn" id="btnLog">≡ Log</button>
|
||||
</div>
|
||||
</div>
|
||||
<div id="cfg" hidden>
|
||||
<input class="field-in" id="url" placeholder="endpoint URL"
|
||||
autocomplete="off" autocorrect="off" autocapitalize="none"
|
||||
spellcheck="false" inputmode="url">
|
||||
<input class="field-in" id="tok" placeholder="bearer token"
|
||||
autocomplete="off" autocorrect="off" autocapitalize="none"
|
||||
spellcheck="false">
|
||||
<input class="field-in" id="pwd" placeholder="sync password"
|
||||
type="password" autocomplete="off">
|
||||
</div>
|
||||
<pre id="log" hidden></pre>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<div class="screen" id="list">
|
||||
<div class="top">
|
||||
<div class="search">
|
||||
@@ -240,7 +290,41 @@ function drain() {
|
||||
}, 60);
|
||||
}
|
||||
|
||||
var entries = [], folders = [], folder = '', query = '', view = 'list';
|
||||
var entries = [], folders = [], folder = '', query = '', view = 'unlock';
|
||||
|
||||
// --- deverrouillage --------------------------------------------------------
|
||||
var elUrl = document.getElementById('url'),
|
||||
elTok = document.getElementById('tok'),
|
||||
elPwd = document.getElementById('pwd');
|
||||
|
||||
// Les trois valeurs remontent A LA PERTE DU FOCUS, pas a chaque touche : c'est
|
||||
// une navigation par champ modifie au lieu d'une par caractere. Delphi les
|
||||
// garde, la page n'est qu'un editeur.
|
||||
function pushConfig() {
|
||||
send('cfg?u=' + encodeURIComponent(elUrl.value.trim())
|
||||
+ '&t=' + encodeURIComponent(elTok.value.trim())
|
||||
+ '&p=' + encodeURIComponent(elPwd.value));
|
||||
}
|
||||
[elUrl, elTok, elPwd].forEach(function (el) {
|
||||
el.addEventListener('change', pushConfig);
|
||||
el.addEventListener('blur', pushConfig);
|
||||
});
|
||||
|
||||
document.getElementById('btnOpen').addEventListener('click', function () {
|
||||
send('openvault');
|
||||
});
|
||||
document.getElementById('btnSync').addEventListener('click', function () {
|
||||
pushConfig(); // ce qui est tape mais pas encore quitte compte aussi
|
||||
send('sync');
|
||||
});
|
||||
document.getElementById('btnCfg').addEventListener('click', function () {
|
||||
var c = document.getElementById('cfg');
|
||||
c.hidden = !c.hidden;
|
||||
});
|
||||
document.getElementById('btnLog').addEventListener('click', function () {
|
||||
var l = document.getElementById('log');
|
||||
l.hidden = !l.hidden;
|
||||
});
|
||||
|
||||
function esc(s) {
|
||||
return String(s == null ? '' : s).replace(/[&<>"]/g, function (c) {
|
||||
@@ -376,6 +460,7 @@ document.getElementById('fields').addEventListener('click', function (ev) {
|
||||
|
||||
function goList() {
|
||||
document.body.classList.remove('on-detail');
|
||||
document.body.classList.add('on-list');
|
||||
view = 'list';
|
||||
// Les valeurs en clair partent avec la vue, pas seulement de l'ecran.
|
||||
detailRows = [];
|
||||
@@ -393,10 +478,40 @@ var PM = {
|
||||
folder = '';
|
||||
q.value = ''; query = '';
|
||||
document.body.classList.remove('searching', 'on-detail');
|
||||
document.body.classList.add('on-list');
|
||||
view = 'list';
|
||||
renderFolders();
|
||||
renderRows();
|
||||
},
|
||||
|
||||
showUnlock: function () {
|
||||
document.body.classList.remove('on-list', 'on-detail', 'searching');
|
||||
view = 'unlock';
|
||||
},
|
||||
setStatus: function (text) {
|
||||
document.getElementById('status').textContent = text;
|
||||
},
|
||||
/// Etat des deux actions : ouvrir n'a de sens qu'avec un coffre local
|
||||
/// lisible, et synchroniser s'appelle autrement quand il n'y en a pas.
|
||||
setActions: function (canOpen, syncLabel, busy) {
|
||||
var o = document.getElementById('btnOpen'), s = document.getElementById('btnSync');
|
||||
o.hidden = !canOpen;
|
||||
s.innerHTML = '↻ ' + syncLabel;
|
||||
o.disabled = busy; s.disabled = busy;
|
||||
o.style.opacity = busy ? .4 : 1;
|
||||
s.style.opacity = busy ? .4 : 1;
|
||||
},
|
||||
setConfig: function (url, tok, pwd, show) {
|
||||
elUrl.value = url; elTok.value = tok; elPwd.value = pwd;
|
||||
// Replier des champs vides revient a cacher la seule chose a faire.
|
||||
document.getElementById('cfg').hidden = !show;
|
||||
},
|
||||
log: function (line) {
|
||||
var l = document.getElementById('log');
|
||||
l.textContent += line + '\n';
|
||||
l.scrollTop = l.scrollHeight;
|
||||
},
|
||||
clearLog: function () { document.getElementById('log').textContent = ''; },
|
||||
setDetail: function (json) { renderDetail(JSON.parse(json)); },
|
||||
setTotp: function (code, left, period) {
|
||||
var v = document.getElementById('totpv');
|
||||
@@ -424,8 +539,8 @@ var PM = {
|
||||
document.getElementById('fields').innerHTML = '';
|
||||
document.getElementById('folders').innerHTML = '';
|
||||
q.value = '';
|
||||
document.body.classList.remove('on-detail', 'searching');
|
||||
view = 'list';
|
||||
document.body.classList.remove('on-list', 'on-detail', 'searching');
|
||||
view = 'unlock';
|
||||
}
|
||||
};
|
||||
window.PM = PM;
|
||||
|
||||
+98
-190
@@ -2,11 +2,16 @@ unit mainApk;
|
||||
{
|
||||
Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
|
||||
|
||||
DEUX MOITIES. Le deverrouillage est en FMX - il touche a la biometrie et au
|
||||
Keystore, et tient en trois boutons. La liste et le detail sont une page
|
||||
HTML rendue par le moteur du systeme (PMA.WebUI, android-client/web) : les
|
||||
gabarits FMX se sont montres trop incertains sur mobile, et le moteur met en
|
||||
forme l'arabe correctement sans qu'on ait rien a faire.
|
||||
PLUS AUCUN CONTROLE FMX. Les trois ecrans - deverrouillage, liste, detail -
|
||||
sont une page HTML rendue par le moteur du systeme (PMA.WebUI,
|
||||
android-client/web). Cette unite ne tient plus que ce que la page ne peut pas
|
||||
atteindre : Keystore, biometrie, presse-papiers sensible, FLAG_SECURE, reseau
|
||||
et dechiffrement.
|
||||
|
||||
Le dernier a partir a ete l'ecran de deverrouillage : dans un TEdit Android, le
|
||||
curseur ne se place pas ou on le touche, ce qui rend un jeton long
|
||||
incorrigible. Un champ du moteur herite de la saisie du systeme - curseur,
|
||||
selection, poignees, collage - sans qu'on ecrive une ligne.
|
||||
|
||||
Le pont tient en deux gestes : evaluateJavascript pour descendre les donnees,
|
||||
et une navigation cmd:// interceptee pour remonter les actions. Aucun serveur
|
||||
@@ -90,15 +95,11 @@ type
|
||||
// faite sur le poste ferait apparaitre une invite au lancement.
|
||||
FSyncPwd: string;
|
||||
|
||||
// --- ecran 1 : deverrouillage
|
||||
FLayUnlock: TLayout;
|
||||
FUrl, FToken, FPwd: TEdit;
|
||||
FBtnOpen, FBtnSync, FBtnSettings, FBtnLog: TRectangle;
|
||||
FLaySettings: TLayout;
|
||||
FStatus: TLabel;
|
||||
FLog: TMemo;
|
||||
/// Coordonnees du serveur. Delphi en est le detenteur ; la page ne fait
|
||||
/// que les editer et les lui renvoyer quand un champ est quitte.
|
||||
FUrl, FToken, FPwd: string;
|
||||
|
||||
// --- ecrans 2 et 3 : liste et detail, rendus par le moteur du systeme
|
||||
// --- l'interface entiere, rendue par le moteur du systeme
|
||||
FLayWeb: TLayout;
|
||||
FWeb: TWebBrowser;
|
||||
/// La page n'accepte rien avant sa fin de chargement. Ce qui arrive trop
|
||||
@@ -126,8 +127,6 @@ type
|
||||
procedure Touch;
|
||||
procedure OnIdleTimer(Sender: TObject);
|
||||
|
||||
procedure BuildUnlock;
|
||||
|
||||
procedure ShowUnlock;
|
||||
procedure ShowList;
|
||||
procedure OnTotpTick(Sender: TObject);
|
||||
@@ -148,8 +147,6 @@ type
|
||||
procedure AdoptVault(const APlainJson: string);
|
||||
procedure LockVault;
|
||||
|
||||
procedure OnToggleSettings(Sender: TObject);
|
||||
procedure OnToggleLog(Sender: TObject);
|
||||
|
||||
// --- page HTML
|
||||
procedure BuildWeb;
|
||||
@@ -161,6 +158,7 @@ type
|
||||
/// Envoie un appel a la page, ou le met en attente si elle n'est pas prete.
|
||||
procedure WebCall(const AJavaScript: string);
|
||||
procedure PushVault;
|
||||
procedure PushConfig;
|
||||
procedure OpenEntry(AVaultIndex: Integer);
|
||||
procedure OnClipTimer(Sender: TObject);
|
||||
procedure OnHardwareBack(Sender: TObject; var Key: Word;
|
||||
@@ -187,16 +185,20 @@ uses
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
const
|
||||
// Pictogrammes des boutons, EN POINTS DE CODE : ce fichier n'a pas de marque
|
||||
// d'ordre d'octets, Delphi le lit en ANSI, et un caractere ecrit tel quel y
|
||||
// deviendrait deux ou trois glyphes. Tous choisis dans le plan de base et
|
||||
// parmi les plus courants - une police systeme qui n'en aurait pas
|
||||
// afficherait un rectangle vide, ce qui se verrait tout de suite.
|
||||
GLYPH_OPEN = #$279C; // fleche pleine
|
||||
GLYPH_SYNC = #$21BB; // fleche circulaire
|
||||
GLYPH_GEAR = #$2699; // engrenage
|
||||
GLYPH_LOG = #$2261; // trois traits
|
||||
/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
|
||||
/// l'encodage JSON : une apostrophe ou un retour a la ligne dans un nom de
|
||||
/// compte casserait sinon l'appel entier.
|
||||
function JsArg(const AValue: string): string;
|
||||
var
|
||||
LStr: TJSONString;
|
||||
begin
|
||||
LStr := TJSONString.Create(AValue);
|
||||
try
|
||||
Result := LStr.ToJSON;
|
||||
finally
|
||||
LStr.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ----------------------------------------------------------------------------
|
||||
Construction
|
||||
@@ -220,7 +222,6 @@ begin
|
||||
FVault := TVault.Create;
|
||||
|
||||
BuildWeb;
|
||||
BuildUnlock; // cree en dernier a l'ecran = au-dessus de la page
|
||||
|
||||
FClipTimer := TTimer.Create(Self);
|
||||
FClipTimer.Enabled := False;
|
||||
@@ -247,6 +248,7 @@ begin
|
||||
IFMXApplicationEventService, LEvents) then
|
||||
LEvents.SetApplicationEventHandler(HandleAppEvent);
|
||||
|
||||
PushConfig;
|
||||
ShowUnlock;
|
||||
|
||||
// Ouverture automatique du coffre local. Differee apres la construction :
|
||||
@@ -262,141 +264,37 @@ begin
|
||||
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 = 52; APrimary: Boolean = False): TRectangle;
|
||||
begin
|
||||
Result := FlatButton(AParent, AText, AOnClick, APrimary);
|
||||
Result.Align := TAlignLayout.Top;
|
||||
Result.Margins.Rect := RectF(16, 8, 16, 0);
|
||||
Result.Height := AHeight;
|
||||
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;
|
||||
var
|
||||
LUrl, LToken: string;
|
||||
LRow: TLayout;
|
||||
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;
|
||||
// Sans repli, un message d'exception est coupe net au bord du memo - et
|
||||
// c'est toujours la fin qui nomme la cause.
|
||||
FLog.WordWrap := True;
|
||||
FLog.TextSettings.Font.Family := 'monospace';
|
||||
FLog.TextSettings.Font.Size := 11;
|
||||
// Masque par defaut : il ne sert qu'au diagnostic, et il occupait un tiers
|
||||
// de l'ecran a chaque lancement. Le bouton Journal le ramene.
|
||||
FLog.Visible := False;
|
||||
|
||||
// --- du bas vers le haut (voir TopButton)
|
||||
FLaySettings := TLayout.Create(Self);
|
||||
FLaySettings.Parent := FLayUnlock;
|
||||
FLaySettings.Align := TAlignLayout.Top;
|
||||
FLaySettings.Height := 174;
|
||||
// Les trois vont ensemble : ce sont les coordonnees du serveur, dont le mot
|
||||
// de passe fait partie. Il occupait l'ecran d'accueil en permanence alors
|
||||
// qu'on n'y touche qu'une fois. TopEdit empile du bas vers le haut, d'ou
|
||||
// l'ordre inverse ici.
|
||||
FPwd := TopEdit(FLaySettings, 'sync password', TEST_PWD, True);
|
||||
FToken := TopEdit(FLaySettings, 'bearer token', FIRSTRUN_TOKEN);
|
||||
FUrl := TopEdit(FLaySettings, 'endpoint URL', FIRSTRUN_URL);
|
||||
FPwd.Margins.Rect := RectF(16, 8, 16, 0);
|
||||
FToken.Margins.Rect := RectF(16, 8, 16, 0);
|
||||
FUrl.Margins.Rect := RectF(16, 8, 16, 0);
|
||||
// Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
|
||||
if LoadDeviceSettings(LUrl, LToken) then
|
||||
begin
|
||||
FUrl.Text := LUrl;
|
||||
if LToken <> '' then FToken.Text := LToken;
|
||||
end;
|
||||
// Replier des champs vides revient a cacher la seule chose a faire.
|
||||
FLaySettings.Visible := (FUrl.Text.Trim = '') or (FToken.Text.Trim = '')
|
||||
or (FPwd.Text = '');
|
||||
|
||||
// Deux commandes discretes cote a cote : elles ne servent qu'au reglage et
|
||||
// au diagnostic, et n'ont pas a peser autant que les actions principales.
|
||||
LRow := TLayout.Create(Self);
|
||||
LRow.Parent := FLayUnlock;
|
||||
LRow.Align := TAlignLayout.Top;
|
||||
LRow.Height := 48;
|
||||
LRow.Margins.Rect := RectF(16, 8, 16, 0);
|
||||
|
||||
FBtnLog := FlatButton(LRow, GLYPH_LOG + ' Log', OnToggleLog);
|
||||
FBtnLog.Align := TAlignLayout.Right;
|
||||
FBtnLog.Width := 120;
|
||||
FBtnLog.Margins.Left := 8;
|
||||
|
||||
FBtnSettings := FlatButton(LRow, GLYPH_GEAR + ' Server settings', OnToggleSettings);
|
||||
FBtnSettings.Align := TAlignLayout.Client;
|
||||
|
||||
FBtnSync := TopButton(FLayUnlock, GLYPH_SYNC + ' Sync', DoSync);
|
||||
// Accentue : c'est l'action attendue quand aucun coffre n'est encore la.
|
||||
FBtnOpen := TopButton(FLayUnlock, GLYPH_OPEN + ' Open vault', DoOpenLocal, 52, True);
|
||||
|
||||
FStatus := TLabel.Create(Self);
|
||||
FStatus.Parent := FLayUnlock;
|
||||
FStatus.Align := TAlignLayout.Top;
|
||||
FStatus.Margins.Rect := RectF(16, 24, 16, 4);
|
||||
FStatus.Height := 26;
|
||||
Tint(FStatus, 15, True);
|
||||
end;
|
||||
|
||||
procedure TForm8.ShowUnlock;
|
||||
var
|
||||
LCanOpen: Boolean;
|
||||
begin
|
||||
// La vue du moteur est une vraie vue du systeme : elle se peint PAR-DESSUS
|
||||
// tout ce que FMX dessine. Masquer le conteneur ne suffit pas toujours -
|
||||
// masquer les deux, si.
|
||||
FWeb.Visible := False;
|
||||
FLayWeb.Visible := False;
|
||||
FLayUnlock.Visible := True;
|
||||
FLayWeb.Visible := True;
|
||||
FWeb.Visible := True;
|
||||
WebCall('PM.showUnlock()');
|
||||
FWebView := 'unlock';
|
||||
|
||||
// Le bouton d'ouverture n'a de sens que si un coffre local existe ET qu'il
|
||||
// s'est deja laisse ouvrir ; sinon seul le telechargement peut en produire
|
||||
// un utilisable.
|
||||
FBtnOpen.Visible := HasVault and not FVaultUnreadable;
|
||||
if HasVault and not FVaultUnreadable then
|
||||
LCanOpen := HasVault and not FVaultUnreadable;
|
||||
if LCanOpen then
|
||||
begin
|
||||
if VaultNeedsAuth then
|
||||
Status('Vault on this device - protected')
|
||||
else
|
||||
Status('Vault on this device');
|
||||
SetButtonText(FBtnSync, GLYPH_SYNC + ' Sync');
|
||||
WebCall('PM.setActions(true, "Sync", false)');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Status('No local vault - first download');
|
||||
SetButtonText(FBtnSync, GLYPH_SYNC + ' Download vault');
|
||||
WebCall('PM.setActions(false, "Download vault", false)');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm8.ShowList;
|
||||
begin
|
||||
FTotpTimer.Enabled := False;
|
||||
FLayUnlock.Visible := False;
|
||||
FLayWeb.Visible := True;
|
||||
FWeb.Visible := True;
|
||||
FWebView := 'list';
|
||||
@@ -438,21 +336,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm8.OnToggleSettings(Sender: TObject);
|
||||
begin
|
||||
FLaySettings.Visible := not FLaySettings.Visible;
|
||||
// Sa place doit etre REPOSEE a chaque apparition : cree masque, FMX le
|
||||
// replace en tete de la pile quand il devient visible, et les deux champs
|
||||
// se retrouvaient au-dessus du titre. Index 0 le renvoie en bas, juste
|
||||
// au-dessus du journal, ou on attend des reglages.
|
||||
if FLaySettings.Visible then FLaySettings.Index := 0;
|
||||
end;
|
||||
|
||||
procedure TForm8.OnToggleLog(Sender: TObject);
|
||||
begin
|
||||
FLog.Visible := not FLog.Visible;
|
||||
end;
|
||||
|
||||
{ ----------------------------------------------------------------------------
|
||||
La page : liste et detail
|
||||
---------------------------------------------------------------------------- }
|
||||
@@ -462,7 +345,11 @@ begin
|
||||
FLayWeb := TLayout.Create(Self);
|
||||
FLayWeb.Parent := Self;
|
||||
FLayWeb.Align := TAlignLayout.Client;
|
||||
FLayWeb.Visible := False;
|
||||
// VISIBLE DES LE DEPART : la page porte maintenant l'ecran de
|
||||
// deverrouillage, donc il n'y a plus rien d'autre a montrer. Elle n'est
|
||||
// masquee qu'au passage en arriere-plan, pour ne pas laisser la liste des
|
||||
// comptes dans l'apercu des applications recentes.
|
||||
FLayWeb.Visible := True;
|
||||
|
||||
FWeb := TWebBrowser.Create(Self);
|
||||
FWeb.Parent := FLayWeb;
|
||||
@@ -482,6 +369,26 @@ begin
|
||||
SetLength(FWebPending, 0);
|
||||
end;
|
||||
|
||||
/// Descend les coordonnees du serveur dans les champs de la page.
|
||||
procedure TForm8.PushConfig;
|
||||
var
|
||||
LUrl, LToken: string;
|
||||
begin
|
||||
FUrl := FIRSTRUN_URL;
|
||||
FToken := FIRSTRUN_TOKEN;
|
||||
FPwd := TEST_PWD;
|
||||
// Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
|
||||
if LoadDeviceSettings(LUrl, LToken) then
|
||||
begin
|
||||
FUrl := LUrl;
|
||||
if LToken <> '' then FToken := LToken;
|
||||
end;
|
||||
WebCall(Format('PM.setConfig(%s, %s, %s, %s)',
|
||||
[JsArg(FUrl), JsArg(FToken), JsArg(FPwd),
|
||||
// Replier des champs vides revient a cacher la seule chose a faire.
|
||||
LowerCase(BoolToStr((FUrl = '') or (FToken = '') or (FPwd = ''), True))]));
|
||||
end;
|
||||
|
||||
procedure TForm8.WebCall(const AJavaScript: string);
|
||||
begin
|
||||
if FWebReady then
|
||||
@@ -490,21 +397,6 @@ begin
|
||||
FWebPending := FWebPending + [AJavaScript];
|
||||
end;
|
||||
|
||||
/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
|
||||
/// l'encodage JSON : un apostrophe ou un retour a la ligne dans un nom de
|
||||
/// compte casserait sinon l'appel entier.
|
||||
function JsArg(const AValue: string): string;
|
||||
var
|
||||
LStr: TJSONString;
|
||||
begin
|
||||
LStr := TJSONString.Create(AValue);
|
||||
try
|
||||
Result := LStr.ToJSON;
|
||||
finally
|
||||
LStr.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm8.PushVault;
|
||||
begin
|
||||
WebCall('PM.setVault(' + JsArg(VaultToJson(FVault)) + ')');
|
||||
@@ -568,6 +460,22 @@ begin
|
||||
else if LAction = 'lock' then
|
||||
LockVault
|
||||
|
||||
// Les coordonnees du serveur, renvoyees quand un champ est quitte. Delphi
|
||||
// en reste le detenteur : la page n'est qu'un editeur, et rien ne les lui
|
||||
// redemande.
|
||||
else if LAction = 'cfg' then
|
||||
begin
|
||||
FUrl := TNetEncoding.URL.Decode(Param('u')).Trim;
|
||||
FToken := TNetEncoding.URL.Decode(Param('t')).Trim;
|
||||
FPwd := TNetEncoding.URL.Decode(Param('p'));
|
||||
end
|
||||
|
||||
else if LAction = 'openvault' then
|
||||
DoOpenLocal(nil)
|
||||
|
||||
else if LAction = 'sync' then
|
||||
DoSync(nil)
|
||||
|
||||
else if LAction = 'copy' then
|
||||
begin
|
||||
// LES SECRETS NE TRANSITENT PAS PAR LE PONT. La page envoie un rang,
|
||||
@@ -621,6 +529,7 @@ begin
|
||||
// Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
|
||||
// fait partie du verrouillage, pas de l'affichage.
|
||||
FCurrent := Default(TVaultEntry);
|
||||
PushConfig;
|
||||
ShowUnlock;
|
||||
end;
|
||||
|
||||
@@ -686,13 +595,14 @@ begin
|
||||
// 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);
|
||||
FetchAndDecrypt(FUrl, FToken, FSyncPwd, True);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
// Un coffre local illisible se remplace, il ne se repare pas.
|
||||
Log('Local vault corrupt: ' + E.Message);
|
||||
ClearVault;
|
||||
PushConfig;
|
||||
ShowUnlock;
|
||||
end;
|
||||
end;
|
||||
@@ -702,6 +612,7 @@ begin
|
||||
// ShowUnlock AVANT le message : il repositionne le statut selon ce que
|
||||
// l'appareil detient, et ecraserait donc l'explication.
|
||||
FVaultUnreadable := True;
|
||||
PushConfig;
|
||||
ShowUnlock;
|
||||
Log('Local vault unreadable: ' + LastStoreError);
|
||||
Status('Local vault unreadable - see log');
|
||||
@@ -757,6 +668,7 @@ begin
|
||||
FVaultUnreadable := True;
|
||||
Log('No usable protection on this device - vault kept but unreadable');
|
||||
Log(' ' + LastBiometricError);
|
||||
PushConfig;
|
||||
ShowUnlock;
|
||||
Status('Screen lock missing - download again to replace the cache');
|
||||
end;
|
||||
@@ -774,20 +686,18 @@ 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;
|
||||
LUrl := FUrl;
|
||||
LTok := FToken;
|
||||
// Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
|
||||
// range qui ne convient plus.
|
||||
LPwd := FPwd.Text;
|
||||
LPwd := FPwd;
|
||||
if LPwd = '' then LPwd := FSyncPwd;
|
||||
if LPwd = '' then
|
||||
begin
|
||||
Status('Sync password required');
|
||||
Exit;
|
||||
end;
|
||||
FLog.Lines.Clear;
|
||||
WebCall('PM.clearLog()');
|
||||
|
||||
// MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait
|
||||
// qu'a un bouton pres : synchroniser reconstruit le coffre depuis le serveur
|
||||
@@ -1036,11 +946,10 @@ begin
|
||||
// recentes : masquer ici, c'est ne pas y laisser la liste des comptes.
|
||||
// Le masquage est IMMEDIAT et sans condition - c'est lui qui protege.
|
||||
TApplicationEvent.WillBecomeInactive:
|
||||
if FLayWeb.Visible then
|
||||
if FWebView <> 'unlock' then
|
||||
begin
|
||||
FWeb.Visible := False;
|
||||
FLayWeb.Visible := False;
|
||||
FLayUnlock.Visible := True;
|
||||
end;
|
||||
|
||||
// Le clair, lui, survit a un bref passage en arriere-plan.
|
||||
@@ -1063,7 +972,6 @@ begin
|
||||
begin
|
||||
// Retour a temps : on rend l'ecran quitte, pas un autre. La page a
|
||||
// garde son etat, elle n'a ete que masquee.
|
||||
FLayUnlock.Visible := False;
|
||||
FLayWeb.Visible := True;
|
||||
FWeb.Visible := True;
|
||||
Touch;
|
||||
@@ -1079,13 +987,12 @@ end;
|
||||
|
||||
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.
|
||||
// Appele depuis le thread de calcul : le moteur ne se pilote que depuis le
|
||||
// thread principal.
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
FLog.Lines.Add(AMsg);
|
||||
FLog.GoToTextEnd;
|
||||
WebCall('PM.log(' + JsArg(AMsg) + ')');
|
||||
end);
|
||||
end;
|
||||
|
||||
@@ -1111,14 +1018,15 @@ end;
|
||||
|
||||
procedure TForm8.Status(const AMsg: string);
|
||||
begin
|
||||
FStatus.Text := AMsg;
|
||||
WebCall('PM.setStatus(' + JsArg(AMsg) + ')');
|
||||
end;
|
||||
|
||||
procedure TForm8.SetBusy(ABusy: Boolean);
|
||||
begin
|
||||
FBusy := ABusy;
|
||||
SetButtonEnabled(FBtnSync, not ABusy);
|
||||
SetButtonEnabled(FBtnOpen, not ABusy);
|
||||
WebCall(Format('PM.setActions(%s, "Sync", %s)',
|
||||
[LowerCase(BoolToStr(HasVault and not FVaultUnreadable, True)),
|
||||
LowerCase(BoolToStr(ABusy, True))]));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+6
-16
@@ -3,16 +3,6 @@ program pmserverApk;
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
// Skia remplace le moteur de rendu de FMX. Ce n'est pas un choix esthetique :
|
||||
// celui d'origine ne met pas en forme les ecritures complexes - pas de
|
||||
// reordonnancement bidirectionnel, pas de liaison des lettres arabes - et un
|
||||
// nom de piece jointe en arabe s'affichait donc en desordre. Skia embarque
|
||||
// HarfBuzz et fait ce travail correctement.
|
||||
//
|
||||
// Le prix est libsk4d.so, 25 Mo, a poser dans lib/arm64-v8a de l'APK. Le
|
||||
// deploiement automatique s'en chargerait ; ici il ne deploie rien, donc la
|
||||
// bibliotheque est mise en place a la main comme le manifeste et les .dex.
|
||||
FMX.Skia,
|
||||
mainApk in 'mainApk.pas' {Form8},
|
||||
PMA.Crypto in 'android-client\PMA.Crypto.pas',
|
||||
PMA.TestVector in 'android-client\PMA.TestVector.pas',
|
||||
@@ -29,13 +19,13 @@ uses
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
// AVANT Application.Initialize : le canevas est choisi a l'initialisation,
|
||||
// et le basculer ensuite ne rattrape pas ce qui est deja construit.
|
||||
GlobalUseSkia := True;
|
||||
// NI SKIA NI STYLE. Les deux servaient les controles FMX : Skia pour mettre
|
||||
// en forme l'arabe dans les libelles - le moteur d'origine ne lie pas les
|
||||
// lettres et ne reordonne pas le bidirectionnel - et le style pour que les
|
||||
// champs et les listes ne s'affichent pas en clair. L'interface est passee au
|
||||
// moteur du systeme, qui fait les deux lui-meme ; il ne reste plus un seul
|
||||
// controle FMX a habiller. Au passage, libsk4d.so ne pese plus dans l'APK.
|
||||
Application.Initialize;
|
||||
// Le style se pose apres l'initialisation mais avant la forme : l'appliquer
|
||||
// plus tard laisserait les controles deja construits avec l'ancien.
|
||||
ApplyDarkTheme;
|
||||
Application.CreateForm(TForm8, Form8);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user