feat(apk): scanner le QR du poste depuis l'app (ZXing.Delphi, Apache 2.0)
Le scanner du systeme demandait avec quoi ouvrir le lien. L'app ouvre la camera arriere, decode une image sur quatre et remplit URL + jeton des qu'un lien pmserver://sync est lu. Rien n'est enregistre avant Save. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
r-zakarya
+175
-16
@@ -36,7 +36,7 @@ uses
|
||||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform,
|
||||
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
|
||||
FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox, FMX.Objects,
|
||||
FMX.WebBrowser, System.Messaging,
|
||||
FMX.WebBrowser, System.Messaging, FMX.Media,
|
||||
PMA.Vault;
|
||||
|
||||
const
|
||||
@@ -341,7 +341,18 @@ type
|
||||
/// que le proprietaire ne connaitrait pas.
|
||||
procedure SetUnlockCode(const ANew: string);
|
||||
procedure PushUnlockMode;
|
||||
procedure PasteSyncSettings;
|
||||
// Scanner du QR affiche par le poste (ZXing.Delphi, Apache 2.0).
|
||||
var
|
||||
FScanning, FScanBusy: Boolean;
|
||||
FScanFrame: Integer;
|
||||
FScanLay: TLayout;
|
||||
FScanImg: TImage;
|
||||
FCam: TCameraComponent;
|
||||
procedure StartScan;
|
||||
procedure BeginScan;
|
||||
procedure StopScan;
|
||||
procedure DoCancelScan(Sender: TObject);
|
||||
procedure OnCamFrame(Sender: TObject; const ATime: TMediaTime);
|
||||
function ApplySyncLink(const ALink: string): Boolean;
|
||||
{$IFDEF ANDROID}
|
||||
procedure OnActivityMessage(const Sender: TObject; const M: TMessage);
|
||||
@@ -385,10 +396,11 @@ implementation
|
||||
uses
|
||||
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
|
||||
PMA.ScreenGuard, PMA.Clipboard, PMA.Theme, PMA.WebUI, PMA.VaultPatch,
|
||||
PMA.SaveFile, PMA.Favicon, System.JSON
|
||||
PMA.SaveFile, PMA.Favicon, System.JSON, System.Permissions,
|
||||
ZXing.ScanManager, ZXing.BarcodeFormat, ZXing.ReadResult
|
||||
{$IFDEF ANDROID}
|
||||
, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes,
|
||||
Androidapi.Helpers, FMX.Platform.Android
|
||||
Androidapi.Helpers, FMX.Platform.Android, Androidapi.JNI.Os
|
||||
{$ENDIF};
|
||||
|
||||
{$R *.fmx}
|
||||
@@ -602,6 +614,12 @@ procedure TForm8.OnHardwareBack(Sender: TObject; var Key: Word;
|
||||
var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
if Key <> vkHardwareBack then Exit;
|
||||
if FScanning then
|
||||
begin
|
||||
StopScan;
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
if not FLayWeb.Visible then Exit;
|
||||
// LE CLAVIER D'ABORD. Quand il est deplie, cette touche est le bouton qui le
|
||||
// replie - c'est tout ce qu'elle veut dire. La vue web n'etant pas un champ
|
||||
@@ -1834,12 +1852,10 @@ begin
|
||||
SetUnlockCode(TNetEncoding.URL.Decode(Param('c')));
|
||||
end
|
||||
|
||||
// REGLAGES COLLES DEPUIS LE QR DU POSTE. L'appareil photo a lu le QR et
|
||||
// copie son texte : {"pmsync":1,"u":URL,"t":JETON}. On remplit les champs
|
||||
// des reglages SANS enregistrer - Save reste le geste qui valide - et on
|
||||
// vide le presse-papiers, qui porte le jeton.
|
||||
else if LAction = 'pastecfg' then
|
||||
PasteSyncSettings
|
||||
// SCANNER LE QR DU POSTE depuis l'app : le scanner du systeme envoyait
|
||||
// le lien a une recherche web ou demandait avec quoi l'ouvrir.
|
||||
else if LAction = 'scanqr' then
|
||||
StartScan
|
||||
|
||||
else if LAction = 'pinclear' then
|
||||
ClearUnlockCode(TNetEncoding.URL.Decode(Param('c')))
|
||||
@@ -2890,8 +2906,9 @@ 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 FWebView <> 'unlock' then
|
||||
if FScanning or (FWebView <> 'unlock') then
|
||||
begin
|
||||
StopScan; // la camera ne reste pas ouverte en arriere-plan
|
||||
FWeb.Visible := False;
|
||||
FLayWeb.Visible := False;
|
||||
end;
|
||||
@@ -3225,12 +3242,154 @@ begin
|
||||
if HasLocalContainer then Result := 'vault password' else Result := 'sync password';
|
||||
end;
|
||||
|
||||
procedure TForm8.PasteSyncSettings;
|
||||
procedure TForm8.StartScan;
|
||||
begin
|
||||
if ApplySyncLink(CurrentClipboard.Trim) then
|
||||
ClearClipboard
|
||||
else
|
||||
WebCall('PM.toast("No settings in the clipboard - copy the link of the QR shown on the PC first")');
|
||||
if FScanning or FBusy then Exit;
|
||||
{$IFDEF ANDROID}
|
||||
PermissionsService.RequestPermissions(
|
||||
[JStringToString(TJManifest_permission.JavaClass.CAMERA)],
|
||||
procedure(const APermissions: TClassicStringDynArray;
|
||||
const AGrantResults: TClassicPermissionStatusDynArray)
|
||||
begin
|
||||
if (Length(AGrantResults) = 1) and
|
||||
(AGrantResults[0] = TPermissionStatus.Granted) then
|
||||
BeginScan
|
||||
else
|
||||
WebCall('PM.toast("Camera not allowed - type the settings instead")');
|
||||
end);
|
||||
{$ELSE}
|
||||
BeginScan;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
/// L'apercu est FMX, pas web : la vue web est une vue native posee PAR-DESSUS
|
||||
/// les controles FMX, il faut donc la masquer pendant le scan.
|
||||
procedure TForm8.BeginScan;
|
||||
var
|
||||
LBg: TRectangle;
|
||||
LBtn: TButton;
|
||||
LLbl: TLabel;
|
||||
begin
|
||||
if FScanLay = nil then
|
||||
begin
|
||||
FScanLay := TLayout.Create(Self);
|
||||
FScanLay.Parent := Self;
|
||||
FScanLay.Align := TAlignLayout.Contents;
|
||||
LBg := TRectangle.Create(FScanLay);
|
||||
LBg.Parent := FScanLay;
|
||||
LBg.Align := TAlignLayout.Contents;
|
||||
LBg.Fill.Color := TAlphaColors.Black;
|
||||
LBg.Stroke.Kind := TBrushKind.None;
|
||||
LBg.HitTest := False;
|
||||
LLbl := TLabel.Create(FScanLay);
|
||||
LLbl.Parent := FScanLay;
|
||||
LLbl.Align := TAlignLayout.Top;
|
||||
LLbl.Height := 72;
|
||||
LLbl.Margins.Top := 24;
|
||||
LLbl.StyledSettings := [];
|
||||
LLbl.TextSettings.FontColor := TAlphaColors.White;
|
||||
LLbl.TextSettings.Font.Size := 16;
|
||||
LLbl.TextSettings.HorzAlign := TTextAlign.Center;
|
||||
LLbl.Text := 'Point the camera at the QR shown on the PC';
|
||||
LBtn := TButton.Create(FScanLay);
|
||||
LBtn.Parent := FScanLay;
|
||||
LBtn.Align := TAlignLayout.Bottom;
|
||||
LBtn.Height := 56;
|
||||
LBtn.Margins.Rect := TRectF.Create(24, 8, 24, 32);
|
||||
LBtn.Text := 'Cancel';
|
||||
LBtn.OnClick := DoCancelScan;
|
||||
FScanImg := TImage.Create(FScanLay);
|
||||
FScanImg.Parent := FScanLay;
|
||||
FScanImg.Align := TAlignLayout.Client;
|
||||
FScanImg.WrapMode := TImageWrapMode.Fit;
|
||||
FScanImg.HitTest := False;
|
||||
FCam := TCameraComponent.Create(Self);
|
||||
FCam.OnSampleBufferReady := OnCamFrame;
|
||||
end;
|
||||
HideSoftKeyboard;
|
||||
FScanning := True;
|
||||
FScanBusy := False;
|
||||
FScanFrame := 0;
|
||||
FLayWeb.Visible := False;
|
||||
FScanLay.Visible := True;
|
||||
FScanLay.BringToFront;
|
||||
FCam.Active := False;
|
||||
FCam.Kind := TCameraKind.BackCamera;
|
||||
FCam.Quality := TVideoCaptureQuality.MediumQuality;
|
||||
try
|
||||
FCam.FocusMode := TFocusMode.ContinuousAutoFocus;
|
||||
except
|
||||
// Pas d'autofocus continu : l'image restera nette a bonne distance.
|
||||
end;
|
||||
FCam.Active := True;
|
||||
Log('QR scan started');
|
||||
end;
|
||||
|
||||
procedure TForm8.StopScan;
|
||||
begin
|
||||
if not FScanning then Exit;
|
||||
FScanning := False;
|
||||
if FCam <> nil then FCam.Active := False;
|
||||
if FScanLay <> nil then FScanLay.Visible := False;
|
||||
FLayWeb.Visible := True;
|
||||
end;
|
||||
|
||||
procedure TForm8.DoCancelScan(Sender: TObject);
|
||||
begin
|
||||
StopScan;
|
||||
end;
|
||||
|
||||
/// Une image sur quatre part au decodage, jamais deux a la fois : ZXing prend
|
||||
/// quelques dizaines de ms, et empiler les images figerait l'apercu.
|
||||
procedure TForm8.OnCamFrame(Sender: TObject; const ATime: TMediaTime);
|
||||
begin
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
var
|
||||
LBmp: TBitmap;
|
||||
begin
|
||||
if not FScanning then Exit;
|
||||
FCam.SampleBufferToBitmap(FScanImg.Bitmap, True);
|
||||
Inc(FScanFrame);
|
||||
if FScanBusy or (FScanFrame mod 4 <> 0) then Exit;
|
||||
FScanBusy := True;
|
||||
LBmp := TBitmap.Create;
|
||||
LBmp.Assign(FScanImg.Bitmap);
|
||||
TThread.CreateAnonymousThread(
|
||||
procedure
|
||||
var
|
||||
LMgr: TScanManager;
|
||||
LRes: TReadResult;
|
||||
LText: string;
|
||||
begin
|
||||
LText := '';
|
||||
LRes := nil;
|
||||
LMgr := TScanManager.Create(TBarcodeFormat.QR_CODE, nil);
|
||||
try
|
||||
try
|
||||
LRes := LMgr.Scan(LBmp);
|
||||
if LRes <> nil then LText := LRes.Text;
|
||||
except
|
||||
LText := '';
|
||||
end;
|
||||
finally
|
||||
LRes.Free;
|
||||
LMgr.Free;
|
||||
LBmp.Free;
|
||||
end;
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
FScanBusy := False;
|
||||
if (not FScanning) or (LText = '') then Exit;
|
||||
if StartsText('pmserver://sync?', LText) then
|
||||
begin
|
||||
StopScan;
|
||||
ApplySyncLink(LText);
|
||||
end;
|
||||
end);
|
||||
end).Start;
|
||||
end);
|
||||
end;
|
||||
|
||||
/// pmserver://sync?u=URL&t=JETON -> champs des reglages remplis, RIEN
|
||||
|
||||
Reference in New Issue
Block a user