diff --git a/delphi-backend/UMainForm.pas b/delphi-backend/UMainForm.pas index c9459f5..9d44fed 100644 --- a/delphi-backend/UMainForm.pas +++ b/delphi-backend/UMainForm.pas @@ -1353,8 +1353,23 @@ begin try LQr.Encoding := qrUTF8NoBOM; LQr.QuietZone := 4; - LQr.Data := 'pmserver://sync?u=' + TNetEncoding.URL.Encode(LQrUrl) + - '&t=' + TNetEncoding.URL.Encode(LQrTok); + // LE PLUS COURT POSSIBLE : moins de caracteres = modules plus gros, + // lisibles par une camera. L'adresse du depot plutot que l'URL d'API + // (le telephone la rallonge a l'enregistrement), et seuls les + // caracteres qui casseraient la requete sont echappes - TNetEncoding + // changeait chaque ":" et "/" en trois caracteres. + var LShort := LQrUrl; + var LApi := Pos('/api/v1/repos/', LShort); + if (LApi > 0) and EndsText('/contents/vault-sync.json', LShort) then + LShort := Copy(LShort, 1, LApi) + + Copy(LShort, LApi + Length('/api/v1/repos/'), + Length(LShort) - LApi - Length('/api/v1/repos/') - Length('/contents/vault-sync.json') + 1); + LShort := StringReplace(LShort, '%', '%25', [rfReplaceAll]); + LShort := StringReplace(LShort, '&', '%26', [rfReplaceAll]); + LShort := StringReplace(LShort, '#', '%23', [rfReplaceAll]); + LShort := StringReplace(LShort, '+', '%2B', [rfReplaceAll]); + LShort := StringReplace(LShort, ' ', '%20', [rfReplaceAll]); + LQr.Data := 'pmserver://sync?u=' + LShort + '&t=' + TNetEncoding.URL.Encode(LQrTok); LSize := LQr.Rows; for var R := 0 to LQr.Rows - 1 do for var C := 0 to LQr.Columns - 1 do diff --git a/mainApk.pas b/mainApk.pas index 58ac9c2..8947852 100644 --- a/mainApk.pas +++ b/mainApk.pas @@ -348,10 +348,13 @@ type FScanLay: TLayout; FScanImg: TImage; FCam: TCameraComponent; + FScanLbl: TLabel; + FScanWatch: TTimer; procedure StartScan; procedure BeginScan; procedure StopScan; procedure DoCancelScan(Sender: TObject); + procedure OnScanWatch(Sender: TObject); procedure OnCamFrame(Sender: TObject; const ATime: TMediaTime); function ApplySyncLink(const ALink: string): Boolean; {$IFDEF ANDROID} @@ -397,7 +400,7 @@ 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, System.Permissions, - ZXing.ScanManager, ZXing.BarcodeFormat, ZXing.ReadResult + ZXing.ScanManager, ZXing.BarcodeFormat, ZXing.ReadResult, ZXing.DecodeHintType {$IFDEF ANDROID} , Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes, Androidapi.Helpers, FMX.Platform.Android, Androidapi.JNI.Os @@ -3290,7 +3293,15 @@ begin 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'; + LLbl.WordWrap := True; + FScanLbl := LLbl; + // AUCUNE IMAGE = CAMERA TENUE AILLEURS. Ouverte par l'appareil photo du + // systeme, meme en arriere-plan, elle ne nous est pas donnee - et sans ce + // guet l'ecran restait noir sans un mot. + FScanWatch := TTimer.Create(Self); + FScanWatch.Enabled := False; + FScanWatch.Interval := 3000; + FScanWatch.OnTimer := OnScanWatch; LBtn := TButton.Create(FScanLay); LBtn.Parent := FScanLay; LBtn.Align := TAlignLayout.Bottom; @@ -3321,7 +3332,9 @@ begin except // Pas d'autofocus continu : l'image restera nette a bonne distance. end; + FScanLbl.Text := 'Point the camera at the QR shown on the PC'; FCam.Active := True; + FScanWatch.Enabled := True; Log('QR scan started'); end; @@ -3329,6 +3342,7 @@ procedure TForm8.StopScan; begin if not FScanning then Exit; FScanning := False; + if FScanWatch <> nil then FScanWatch.Enabled := False; if FCam <> nil then FCam.Active := False; if FScanLay <> nil then FScanLay.Visible := False; FLayWeb.Visible := True; @@ -3339,6 +3353,16 @@ begin StopScan; end; +procedure TForm8.OnScanWatch(Sender: TObject); +begin + FScanWatch.Enabled := False; + if FScanning and (FScanFrame = 0) then + begin + FScanLbl.Text := 'Camera busy - close the camera app, then Cancel and scan again'; + Log('QR scan: no camera frame after 3 s'); + end; +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); @@ -3360,17 +3384,30 @@ begin var LMgr: TScanManager; LRes: TReadResult; - LText: string; + LText, LDiag: string; + LHints: TDictionary; + LW, LH: Integer; begin LText := ''; + LDiag := ''; LRes := nil; - LMgr := TScanManager.Create(TBarcodeFormat.QR_CODE, nil); + LW := LBmp.Width; + LH := LBmp.Height; + // TRY_HARDER : le chercheur de motifs balaie chaque ligne au lieu + // d'en sauter - indispensable pour un QR photographie sur un ecran. + LHints := TDictionary.Create; + LHints.Add(TDecodeHintType.TRY_HARDER, nil); + LMgr := TScanManager.Create(TBarcodeFormat.QR_CODE, LHints); // libere les indices try try LRes := LMgr.Scan(LBmp); if LRes <> nil then LText := LRes.Text; except - LText := ''; + on E: Exception do + begin + LText := ''; + LDiag := E.ClassName + ': ' + E.Message; + end; end; finally LRes.Free; @@ -3381,6 +3418,11 @@ begin procedure begin FScanBusy := False; + // DIAG scan (temporaire) : les premiers essais, puis un sur vingt. + if (FScanFrame <= 40) or (FScanFrame mod 80 = 0) then + Log(Format('QR scan frame %d: %dx%d, %s', [FScanFrame, LW, LH, + IfThen(LDiag <> '', LDiag, + IfThen(LText = '', 'nothing found', 'read ' + IntToStr(Length(LText)) + ' chars'))])); if (not FScanning) or (LText = '') then Exit; if StartsText('pmserver://sync?', LText) then begin