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;
|
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
|
CE QU'IL RESTE D'UN THEME. Cette unite habillait autrefois des boutons, des
|
||||||
un mobile - degrades gris, angles vifs, cadres epais, tous datent de
|
surfaces et des libelles peints a la main, et chargeait un style pour les
|
||||||
l'epoque bureau. Et la journee a montre que tout ce qui passe par un gabarit
|
controles natifs qu'on ne reecrivait pas. L'interface est passee au moteur du
|
||||||
de style peut ne pas exister dans le style charge : le gabarit de ligne de
|
systeme (android-client/web) : il n'y a plus un seul controle FMX a habiller,
|
||||||
liste, l'invite de recherche, la ligne de detail ont disparu tour a tour.
|
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
|
Ce qui subsiste sert au CADRE, que la page ne peut pas atteindre : le fond de
|
||||||
liste et le memo sont des controles natifs qu'on ne va pas reecrire, et sans
|
la forme, visible un instant avant le premier rendu du moteur, et les deux
|
||||||
style ils s'afficheraient en clair. Tout le reste - boutons, surfaces,
|
couleurs que prennent les barres systeme. Elles doivent suivre celles de
|
||||||
couleurs - est peint ici, ou rien ne peut disparaitre.
|
app.html, sinon la jonction se voit.
|
||||||
|
|
||||||
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.
|
|
||||||
}
|
}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
// FMX.Graphics pour TBrush, que PaintBackground prend en parametre.
|
// FMX.Graphics pour TBrush, que PaintBackground prend en parametre.
|
||||||
System.UITypes, System.Classes, FMX.Types, FMX.Graphics, FMX.Objects,
|
System.UITypes, FMX.Types, FMX.Graphics;
|
||||||
FMX.StdCtrls;
|
|
||||||
|
|
||||||
const
|
const
|
||||||
// Releve sur la recherche globale du telephone, qui est la reference pour
|
// Releve sur la recherche globale du telephone : un degrade bleu, des blocs
|
||||||
// tout ce qui se touche - l'application doit ressembler a l'endroit ou elle
|
// qui ne sont que du blanc translucide pose dessus, aucune bordure.
|
||||||
// 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.
|
|
||||||
COL_BG_TOP = TAlphaColor($FF3E6394); // haut du degrade
|
COL_BG_TOP = TAlphaColor($FF3E6394); // haut du degrade
|
||||||
COL_BG = TAlphaColor($FF1B3563); // bas du degrade, et repli uni
|
COL_BG = TAlphaColor($FF1B3563); // bas du degrade
|
||||||
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);
|
|
||||||
|
|
||||||
/// Applique le degrade bleu du fond. A poser sur le Fill de la forme.
|
/// Applique le degrade bleu du fond. A poser sur le Fill de la forme.
|
||||||
procedure PaintBackground(AFill: TBrush);
|
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
|
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);
|
procedure PaintBackground(AFill: TBrush);
|
||||||
begin
|
begin
|
||||||
AFill.Kind := TBrushKind.Gradient;
|
AFill.Kind := TBrushKind.Gradient;
|
||||||
@@ -160,79 +39,4 @@ begin
|
|||||||
// Rien de plus : un TGradient neuf descend deja du haut vers le bas.
|
// Rien de plus : un TGradient neuf descend deja du haut vers le bas.
|
||||||
end;
|
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.
|
end.
|
||||||
|
|||||||
@@ -3,10 +3,9 @@
|
|||||||
#
|
#
|
||||||
# POURQUOI : la cible Deploy de MSBuild reconstruit library\lib avant d'appeler
|
# 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
|
# 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
|
# n'a pas d'entrees de deploiement fonctionnelles (voir README), donc nos icones
|
||||||
# - le moteur Skia, indispensable au rendu de l'arabe - ne peut y arriver
|
# ne peuvent y arriver autrement. On laisse Deploy faire son travail, puis on
|
||||||
# autrement. On laisse donc Deploy faire son travail, puis on remet la
|
# remet ce qu'il a efface et on refait aapt / zipalign / signature.
|
||||||
# bibliotheque et on refait aapt / zipalign / signature.
|
|
||||||
#
|
#
|
||||||
# A lancer depuis la racine du depot, apres un Deploy reussi.
|
# 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"
|
$pac = "$bds\bin\paclient.exe"
|
||||||
$p = '.\Android64\Debug\pmserverApk'
|
$p = '.\Android64\Debug\pmserverApk'
|
||||||
|
|
||||||
# 1. Remettre Skia, que Deploy vient d'effacer.
|
# 1. Nos icones par-dessus celles de Delphi :
|
||||||
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 :
|
|
||||||
# les proprietes Android_LauncherIcon* et Android_AdaptiveIcon* du .dproj
|
# les proprietes Android_LauncherIcon* et Android_AdaptiveIcon* du .dproj
|
||||||
# devraient suffire, mais rien ne les deploie ici.
|
# devraient suffire, mais rien ne les deploie ici.
|
||||||
Copy-Item "$PSScriptRoot\android-res\*" "$p\res\" -Recurse -Force
|
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. */
|
detail - dont les blocs sont eux-memes du blanc translucide. */
|
||||||
background: linear-gradient(var(--bg-top), var(--bg-bot));
|
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 #list { transform: translateX(-22%); }
|
||||||
body.on-detail #detail { transform: translateX(0); }
|
body.on-detail #detail { transform: translateX(0); }
|
||||||
|
|
||||||
@@ -163,6 +168,26 @@
|
|||||||
.bar i { display: block; height: 100%; background: var(--text);
|
.bar i { display: block; height: 100%; background: var(--text);
|
||||||
transition: width 1s linear; }
|
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 {
|
.toast {
|
||||||
position: fixed; left: 12px; right: 12px; bottom: 14px;
|
position: fixed; left: 12px; right: 12px; bottom: 14px;
|
||||||
background: rgba(10,20,40,.92); color: var(--text);
|
background: rgba(10,20,40,.92); color: var(--text);
|
||||||
@@ -173,6 +198,31 @@
|
|||||||
.toast.on { opacity: 1; }
|
.toast.on { opacity: 1; }
|
||||||
</style>
|
</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="screen" id="list">
|
||||||
<div class="top">
|
<div class="top">
|
||||||
<div class="search">
|
<div class="search">
|
||||||
@@ -240,7 +290,41 @@ function drain() {
|
|||||||
}, 60);
|
}, 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) {
|
function esc(s) {
|
||||||
return String(s == null ? '' : s).replace(/[&<>"]/g, function (c) {
|
return String(s == null ? '' : s).replace(/[&<>"]/g, function (c) {
|
||||||
@@ -376,6 +460,7 @@ document.getElementById('fields').addEventListener('click', function (ev) {
|
|||||||
|
|
||||||
function goList() {
|
function goList() {
|
||||||
document.body.classList.remove('on-detail');
|
document.body.classList.remove('on-detail');
|
||||||
|
document.body.classList.add('on-list');
|
||||||
view = 'list';
|
view = 'list';
|
||||||
// Les valeurs en clair partent avec la vue, pas seulement de l'ecran.
|
// Les valeurs en clair partent avec la vue, pas seulement de l'ecran.
|
||||||
detailRows = [];
|
detailRows = [];
|
||||||
@@ -393,10 +478,40 @@ var PM = {
|
|||||||
folder = '';
|
folder = '';
|
||||||
q.value = ''; query = '';
|
q.value = ''; query = '';
|
||||||
document.body.classList.remove('searching', 'on-detail');
|
document.body.classList.remove('searching', 'on-detail');
|
||||||
|
document.body.classList.add('on-list');
|
||||||
view = 'list';
|
view = 'list';
|
||||||
renderFolders();
|
renderFolders();
|
||||||
renderRows();
|
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)); },
|
setDetail: function (json) { renderDetail(JSON.parse(json)); },
|
||||||
setTotp: function (code, left, period) {
|
setTotp: function (code, left, period) {
|
||||||
var v = document.getElementById('totpv');
|
var v = document.getElementById('totpv');
|
||||||
@@ -424,8 +539,8 @@ var PM = {
|
|||||||
document.getElementById('fields').innerHTML = '';
|
document.getElementById('fields').innerHTML = '';
|
||||||
document.getElementById('folders').innerHTML = '';
|
document.getElementById('folders').innerHTML = '';
|
||||||
q.value = '';
|
q.value = '';
|
||||||
document.body.classList.remove('on-detail', 'searching');
|
document.body.classList.remove('on-list', 'on-detail', 'searching');
|
||||||
view = 'list';
|
view = 'unlock';
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
window.PM = PM;
|
window.PM = PM;
|
||||||
|
|||||||
+101
-193
@@ -2,11 +2,16 @@ unit mainApk;
|
|||||||
{
|
{
|
||||||
Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
|
Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
|
||||||
|
|
||||||
DEUX MOITIES. Le deverrouillage est en FMX - il touche a la biometrie et au
|
PLUS AUCUN CONTROLE FMX. Les trois ecrans - deverrouillage, liste, detail -
|
||||||
Keystore, et tient en trois boutons. La liste et le detail sont une page
|
sont une page HTML rendue par le moteur du systeme (PMA.WebUI,
|
||||||
HTML rendue par le moteur du systeme (PMA.WebUI, android-client/web) : les
|
android-client/web). Cette unite ne tient plus que ce que la page ne peut pas
|
||||||
gabarits FMX se sont montres trop incertains sur mobile, et le moteur met en
|
atteindre : Keystore, biometrie, presse-papiers sensible, FLAG_SECURE, reseau
|
||||||
forme l'arabe correctement sans qu'on ait rien a faire.
|
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,
|
Le pont tient en deux gestes : evaluateJavascript pour descendre les donnees,
|
||||||
et une navigation cmd:// interceptee pour remonter les actions. Aucun serveur
|
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.
|
// faite sur le poste ferait apparaitre une invite au lancement.
|
||||||
FSyncPwd: string;
|
FSyncPwd: string;
|
||||||
|
|
||||||
// --- ecran 1 : deverrouillage
|
/// Coordonnees du serveur. Delphi en est le detenteur ; la page ne fait
|
||||||
FLayUnlock: TLayout;
|
/// que les editer et les lui renvoyer quand un champ est quitte.
|
||||||
FUrl, FToken, FPwd: TEdit;
|
FUrl, FToken, FPwd: string;
|
||||||
FBtnOpen, FBtnSync, FBtnSettings, FBtnLog: TRectangle;
|
|
||||||
FLaySettings: TLayout;
|
|
||||||
FStatus: TLabel;
|
|
||||||
FLog: TMemo;
|
|
||||||
|
|
||||||
// --- ecrans 2 et 3 : liste et detail, rendus par le moteur du systeme
|
// --- l'interface entiere, rendue par le moteur du systeme
|
||||||
FLayWeb: TLayout;
|
FLayWeb: TLayout;
|
||||||
FWeb: TWebBrowser;
|
FWeb: TWebBrowser;
|
||||||
/// La page n'accepte rien avant sa fin de chargement. Ce qui arrive trop
|
/// La page n'accepte rien avant sa fin de chargement. Ce qui arrive trop
|
||||||
@@ -126,8 +127,6 @@ type
|
|||||||
procedure Touch;
|
procedure Touch;
|
||||||
procedure OnIdleTimer(Sender: TObject);
|
procedure OnIdleTimer(Sender: TObject);
|
||||||
|
|
||||||
procedure BuildUnlock;
|
|
||||||
|
|
||||||
procedure ShowUnlock;
|
procedure ShowUnlock;
|
||||||
procedure ShowList;
|
procedure ShowList;
|
||||||
procedure OnTotpTick(Sender: TObject);
|
procedure OnTotpTick(Sender: TObject);
|
||||||
@@ -148,8 +147,6 @@ type
|
|||||||
procedure AdoptVault(const APlainJson: string);
|
procedure AdoptVault(const APlainJson: string);
|
||||||
procedure LockVault;
|
procedure LockVault;
|
||||||
|
|
||||||
procedure OnToggleSettings(Sender: TObject);
|
|
||||||
procedure OnToggleLog(Sender: TObject);
|
|
||||||
|
|
||||||
// --- page HTML
|
// --- page HTML
|
||||||
procedure BuildWeb;
|
procedure BuildWeb;
|
||||||
@@ -161,6 +158,7 @@ type
|
|||||||
/// Envoie un appel a la page, ou le met en attente si elle n'est pas prete.
|
/// Envoie un appel a la page, ou le met en attente si elle n'est pas prete.
|
||||||
procedure WebCall(const AJavaScript: string);
|
procedure WebCall(const AJavaScript: string);
|
||||||
procedure PushVault;
|
procedure PushVault;
|
||||||
|
procedure PushConfig;
|
||||||
procedure OpenEntry(AVaultIndex: Integer);
|
procedure OpenEntry(AVaultIndex: Integer);
|
||||||
procedure OnClipTimer(Sender: TObject);
|
procedure OnClipTimer(Sender: TObject);
|
||||||
procedure OnHardwareBack(Sender: TObject; var Key: Word;
|
procedure OnHardwareBack(Sender: TObject; var Key: Word;
|
||||||
@@ -187,16 +185,20 @@ uses
|
|||||||
|
|
||||||
{$R *.fmx}
|
{$R *.fmx}
|
||||||
|
|
||||||
const
|
/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
|
||||||
// Pictogrammes des boutons, EN POINTS DE CODE : ce fichier n'a pas de marque
|
/// l'encodage JSON : une apostrophe ou un retour a la ligne dans un nom de
|
||||||
// d'ordre d'octets, Delphi le lit en ANSI, et un caractere ecrit tel quel y
|
/// compte casserait sinon l'appel entier.
|
||||||
// deviendrait deux ou trois glyphes. Tous choisis dans le plan de base et
|
function JsArg(const AValue: string): string;
|
||||||
// parmi les plus courants - une police systeme qui n'en aurait pas
|
var
|
||||||
// afficherait un rectangle vide, ce qui se verrait tout de suite.
|
LStr: TJSONString;
|
||||||
GLYPH_OPEN = #$279C; // fleche pleine
|
begin
|
||||||
GLYPH_SYNC = #$21BB; // fleche circulaire
|
LStr := TJSONString.Create(AValue);
|
||||||
GLYPH_GEAR = #$2699; // engrenage
|
try
|
||||||
GLYPH_LOG = #$2261; // trois traits
|
Result := LStr.ToJSON;
|
||||||
|
finally
|
||||||
|
LStr.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ ----------------------------------------------------------------------------
|
{ ----------------------------------------------------------------------------
|
||||||
Construction
|
Construction
|
||||||
@@ -220,7 +222,6 @@ begin
|
|||||||
FVault := TVault.Create;
|
FVault := TVault.Create;
|
||||||
|
|
||||||
BuildWeb;
|
BuildWeb;
|
||||||
BuildUnlock; // cree en dernier a l'ecran = au-dessus de la page
|
|
||||||
|
|
||||||
FClipTimer := TTimer.Create(Self);
|
FClipTimer := TTimer.Create(Self);
|
||||||
FClipTimer.Enabled := False;
|
FClipTimer.Enabled := False;
|
||||||
@@ -247,6 +248,7 @@ begin
|
|||||||
IFMXApplicationEventService, LEvents) then
|
IFMXApplicationEventService, LEvents) then
|
||||||
LEvents.SetApplicationEventHandler(HandleAppEvent);
|
LEvents.SetApplicationEventHandler(HandleAppEvent);
|
||||||
|
|
||||||
|
PushConfig;
|
||||||
ShowUnlock;
|
ShowUnlock;
|
||||||
|
|
||||||
// Ouverture automatique du coffre local. Differee apres la construction :
|
// Ouverture automatique du coffre local. Differee apres la construction :
|
||||||
@@ -262,141 +264,37 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
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;
|
procedure TForm8.ShowUnlock;
|
||||||
|
var
|
||||||
|
LCanOpen: Boolean;
|
||||||
begin
|
begin
|
||||||
// La vue du moteur est une vraie vue du systeme : elle se peint PAR-DESSUS
|
FLayWeb.Visible := True;
|
||||||
// tout ce que FMX dessine. Masquer le conteneur ne suffit pas toujours -
|
FWeb.Visible := True;
|
||||||
// masquer les deux, si.
|
WebCall('PM.showUnlock()');
|
||||||
FWeb.Visible := False;
|
FWebView := 'unlock';
|
||||||
FLayWeb.Visible := False;
|
|
||||||
FLayUnlock.Visible := True;
|
|
||||||
|
|
||||||
// Le bouton d'ouverture n'a de sens que si un coffre local existe ET qu'il
|
// 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
|
// s'est deja laisse ouvrir ; sinon seul le telechargement peut en produire
|
||||||
// un utilisable.
|
// un utilisable.
|
||||||
FBtnOpen.Visible := HasVault and not FVaultUnreadable;
|
LCanOpen := HasVault and not FVaultUnreadable;
|
||||||
if HasVault and not FVaultUnreadable then
|
if LCanOpen then
|
||||||
begin
|
begin
|
||||||
if VaultNeedsAuth then
|
if VaultNeedsAuth then
|
||||||
Status('Vault on this device - protected')
|
Status('Vault on this device - protected')
|
||||||
else
|
else
|
||||||
Status('Vault on this device');
|
Status('Vault on this device');
|
||||||
SetButtonText(FBtnSync, GLYPH_SYNC + ' Sync');
|
WebCall('PM.setActions(true, "Sync", false)');
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
Status('No local vault - first download');
|
Status('No local vault - first download');
|
||||||
SetButtonText(FBtnSync, GLYPH_SYNC + ' Download vault');
|
WebCall('PM.setActions(false, "Download vault", false)');
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm8.ShowList;
|
procedure TForm8.ShowList;
|
||||||
begin
|
begin
|
||||||
FTotpTimer.Enabled := False;
|
FTotpTimer.Enabled := False;
|
||||||
FLayUnlock.Visible := False;
|
|
||||||
FLayWeb.Visible := True;
|
FLayWeb.Visible := True;
|
||||||
FWeb.Visible := True;
|
FWeb.Visible := True;
|
||||||
FWebView := 'list';
|
FWebView := 'list';
|
||||||
@@ -438,21 +336,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
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
|
La page : liste et detail
|
||||||
---------------------------------------------------------------------------- }
|
---------------------------------------------------------------------------- }
|
||||||
@@ -462,7 +345,11 @@ begin
|
|||||||
FLayWeb := TLayout.Create(Self);
|
FLayWeb := TLayout.Create(Self);
|
||||||
FLayWeb.Parent := Self;
|
FLayWeb.Parent := Self;
|
||||||
FLayWeb.Align := TAlignLayout.Client;
|
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 := TWebBrowser.Create(Self);
|
||||||
FWeb.Parent := FLayWeb;
|
FWeb.Parent := FLayWeb;
|
||||||
@@ -482,6 +369,26 @@ begin
|
|||||||
SetLength(FWebPending, 0);
|
SetLength(FWebPending, 0);
|
||||||
end;
|
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);
|
procedure TForm8.WebCall(const AJavaScript: string);
|
||||||
begin
|
begin
|
||||||
if FWebReady then
|
if FWebReady then
|
||||||
@@ -490,21 +397,6 @@ begin
|
|||||||
FWebPending := FWebPending + [AJavaScript];
|
FWebPending := FWebPending + [AJavaScript];
|
||||||
end;
|
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;
|
procedure TForm8.PushVault;
|
||||||
begin
|
begin
|
||||||
WebCall('PM.setVault(' + JsArg(VaultToJson(FVault)) + ')');
|
WebCall('PM.setVault(' + JsArg(VaultToJson(FVault)) + ')');
|
||||||
@@ -568,6 +460,22 @@ begin
|
|||||||
else if LAction = 'lock' then
|
else if LAction = 'lock' then
|
||||||
LockVault
|
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
|
else if LAction = 'copy' then
|
||||||
begin
|
begin
|
||||||
// LES SECRETS NE TRANSITENT PAS PAR LE PONT. La page envoie un rang,
|
// 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
|
// Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
|
||||||
// fait partie du verrouillage, pas de l'affichage.
|
// fait partie du verrouillage, pas de l'affichage.
|
||||||
FCurrent := Default(TVaultEntry);
|
FCurrent := Default(TVaultEntry);
|
||||||
|
PushConfig;
|
||||||
ShowUnlock;
|
ShowUnlock;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -686,14 +595,15 @@ begin
|
|||||||
// reseau se debrouille derriere. Sans mot de passe range, on ne peut
|
// reseau se debrouille derriere. Sans mot de passe range, on ne peut
|
||||||
// rien ouvrir de nouveau - inutile d'aller voir.
|
// rien ouvrir de nouveau - inutile d'aller voir.
|
||||||
if FSyncPwd <> '' then
|
if FSyncPwd <> '' then
|
||||||
FetchAndDecrypt(FUrl.Text.Trim, FToken.Text.Trim, FSyncPwd, True);
|
FetchAndDecrypt(FUrl, FToken, FSyncPwd, True);
|
||||||
except
|
except
|
||||||
on E: Exception do
|
on E: Exception do
|
||||||
begin
|
begin
|
||||||
// Un coffre local illisible se remplace, il ne se repare pas.
|
// Un coffre local illisible se remplace, il ne se repare pas.
|
||||||
Log('Local vault corrupt: ' + E.Message);
|
Log('Local vault corrupt: ' + E.Message);
|
||||||
ClearVault;
|
ClearVault;
|
||||||
ShowUnlock;
|
PushConfig;
|
||||||
|
ShowUnlock;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
@@ -702,7 +612,8 @@ begin
|
|||||||
// ShowUnlock AVANT le message : il repositionne le statut selon ce que
|
// ShowUnlock AVANT le message : il repositionne le statut selon ce que
|
||||||
// l'appareil detient, et ecraserait donc l'explication.
|
// l'appareil detient, et ecraserait donc l'explication.
|
||||||
FVaultUnreadable := True;
|
FVaultUnreadable := True;
|
||||||
ShowUnlock;
|
PushConfig;
|
||||||
|
ShowUnlock;
|
||||||
Log('Local vault unreadable: ' + LastStoreError);
|
Log('Local vault unreadable: ' + LastStoreError);
|
||||||
Status('Local vault unreadable - see log');
|
Status('Local vault unreadable - see log');
|
||||||
end;
|
end;
|
||||||
@@ -757,7 +668,8 @@ begin
|
|||||||
FVaultUnreadable := True;
|
FVaultUnreadable := True;
|
||||||
Log('No usable protection on this device - vault kept but unreadable');
|
Log('No usable protection on this device - vault kept but unreadable');
|
||||||
Log(' ' + LastBiometricError);
|
Log(' ' + LastBiometricError);
|
||||||
ShowUnlock;
|
PushConfig;
|
||||||
|
ShowUnlock;
|
||||||
Status('Screen lock missing - download again to replace the cache');
|
Status('Screen lock missing - download again to replace the cache');
|
||||||
end;
|
end;
|
||||||
else
|
else
|
||||||
@@ -774,20 +686,18 @@ var
|
|||||||
LUrl, LTok, LPwd: string;
|
LUrl, LTok, LPwd: string;
|
||||||
begin
|
begin
|
||||||
if FBusy then Exit;
|
if FBusy then Exit;
|
||||||
// Lus ICI, sur le thread principal : toucher un controle FMX depuis le
|
LUrl := FUrl;
|
||||||
// thread de travail est un plantage differe, pas une erreur de compilation.
|
LTok := FToken;
|
||||||
LUrl := FUrl.Text.Trim;
|
|
||||||
LTok := FToken.Text.Trim;
|
|
||||||
// Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
|
// Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
|
||||||
// range qui ne convient plus.
|
// range qui ne convient plus.
|
||||||
LPwd := FPwd.Text;
|
LPwd := FPwd;
|
||||||
if LPwd = '' then LPwd := FSyncPwd;
|
if LPwd = '' then LPwd := FSyncPwd;
|
||||||
if LPwd = '' then
|
if LPwd = '' then
|
||||||
begin
|
begin
|
||||||
Status('Sync password required');
|
Status('Sync password required');
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
FLog.Lines.Clear;
|
WebCall('PM.clearLog()');
|
||||||
|
|
||||||
// MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait
|
// MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait
|
||||||
// qu'a un bouton pres : synchroniser reconstruit le coffre depuis le serveur
|
// 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.
|
// 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.
|
// Le masquage est IMMEDIAT et sans condition - c'est lui qui protege.
|
||||||
TApplicationEvent.WillBecomeInactive:
|
TApplicationEvent.WillBecomeInactive:
|
||||||
if FLayWeb.Visible then
|
if FWebView <> 'unlock' then
|
||||||
begin
|
begin
|
||||||
FWeb.Visible := False;
|
FWeb.Visible := False;
|
||||||
FLayWeb.Visible := False;
|
FLayWeb.Visible := False;
|
||||||
FLayUnlock.Visible := True;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// Le clair, lui, survit a un bref passage en arriere-plan.
|
// Le clair, lui, survit a un bref passage en arriere-plan.
|
||||||
@@ -1063,7 +972,6 @@ begin
|
|||||||
begin
|
begin
|
||||||
// Retour a temps : on rend l'ecran quitte, pas un autre. La page a
|
// Retour a temps : on rend l'ecran quitte, pas un autre. La page a
|
||||||
// garde son etat, elle n'a ete que masquee.
|
// garde son etat, elle n'a ete que masquee.
|
||||||
FLayUnlock.Visible := False;
|
|
||||||
FLayWeb.Visible := True;
|
FLayWeb.Visible := True;
|
||||||
FWeb.Visible := True;
|
FWeb.Visible := True;
|
||||||
Touch;
|
Touch;
|
||||||
@@ -1079,13 +987,12 @@ end;
|
|||||||
|
|
||||||
procedure TForm8.Log(const AMsg: string);
|
procedure TForm8.Log(const AMsg: string);
|
||||||
begin
|
begin
|
||||||
// Appele depuis le thread de calcul : la mise a jour d'un controle FMX doit
|
// Appele depuis le thread de calcul : le moteur ne se pilote que depuis le
|
||||||
// repasser par le thread principal.
|
// thread principal.
|
||||||
TThread.Queue(nil,
|
TThread.Queue(nil,
|
||||||
procedure
|
procedure
|
||||||
begin
|
begin
|
||||||
FLog.Lines.Add(AMsg);
|
WebCall('PM.log(' + JsArg(AMsg) + ')');
|
||||||
FLog.GoToTextEnd;
|
|
||||||
end);
|
end);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -1111,14 +1018,15 @@ end;
|
|||||||
|
|
||||||
procedure TForm8.Status(const AMsg: string);
|
procedure TForm8.Status(const AMsg: string);
|
||||||
begin
|
begin
|
||||||
FStatus.Text := AMsg;
|
WebCall('PM.setStatus(' + JsArg(AMsg) + ')');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm8.SetBusy(ABusy: Boolean);
|
procedure TForm8.SetBusy(ABusy: Boolean);
|
||||||
begin
|
begin
|
||||||
FBusy := ABusy;
|
FBusy := ABusy;
|
||||||
SetButtonEnabled(FBtnSync, not ABusy);
|
WebCall(Format('PM.setActions(%s, "Sync", %s)',
|
||||||
SetButtonEnabled(FBtnOpen, not ABusy);
|
[LowerCase(BoolToStr(HasVault and not FVaultUnreadable, True)),
|
||||||
|
LowerCase(BoolToStr(ABusy, True))]));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
+6
-16
@@ -3,16 +3,6 @@ program pmserverApk;
|
|||||||
uses
|
uses
|
||||||
System.StartUpCopy,
|
System.StartUpCopy,
|
||||||
FMX.Forms,
|
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},
|
mainApk in 'mainApk.pas' {Form8},
|
||||||
PMA.Crypto in 'android-client\PMA.Crypto.pas',
|
PMA.Crypto in 'android-client\PMA.Crypto.pas',
|
||||||
PMA.TestVector in 'android-client\PMA.TestVector.pas',
|
PMA.TestVector in 'android-client\PMA.TestVector.pas',
|
||||||
@@ -29,13 +19,13 @@ uses
|
|||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
begin
|
begin
|
||||||
// AVANT Application.Initialize : le canevas est choisi a l'initialisation,
|
// NI SKIA NI STYLE. Les deux servaient les controles FMX : Skia pour mettre
|
||||||
// et le basculer ensuite ne rattrape pas ce qui est deja construit.
|
// en forme l'arabe dans les libelles - le moteur d'origine ne lie pas les
|
||||||
GlobalUseSkia := True;
|
// 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;
|
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.CreateForm(TForm8, Form8);
|
||||||
Application.Run;
|
Application.Run;
|
||||||
end.
|
end.
|
||||||
|
|||||||
Reference in New Issue
Block a user