unit PM.ScreenQr;

// Lit un QR affiche a l'ecran - le secret 2FA qu'un site montre a l'activation.
// Capture de TOUS les ecrans (bureau virtuel) en memoire, jamais sur le disque,
// puis decodage par ZXing.Delphi (Apache 2.0, deja vendu pour l'APK dans
// android-client\ThirdParty\ZXing). Aucune selection de zone : le decodeur
// trouve le QR n'importe ou dans l'image.
//
// GDI pur et octets bruts, pas de TBitmap FMX : tout se fait dans un thread
// d'arriere-plan, et le decodage d'un bureau entier prend un moment.

interface

/// Texte du premier QR trouve a l'ecran, '' si aucun.
function ScanScreenForQr: string;

implementation

uses
  Winapi.Windows, System.SysUtils, System.Generics.Collections,
  ZXing.LuminanceSource, ZXing.RGBLuminanceSource, ZXing.HybridBinarizer,
  ZXing.BinaryBitmap, ZXing.MultiFormatReader, ZXing.BarcodeFormat,
  ZXing.DecodeHintType, ZXing.ReadResult;

const
  CAPTURE_BLT = $40000000;   // absente de Winapi.Windows ; inclut les fenetres superposees

function CaptureVirtualScreen(out AWidth, AHeight: Integer): TArray<Byte>;
var
  LX, LY: Integer;
  LScreenDC, LMemDC: HDC;
  LBmp: HBITMAP;
  LOld: HGDIOBJ;
  LInfo: TBitmapInfo;
begin
  Result := nil;
  LX := GetSystemMetrics(SM_XVIRTUALSCREEN);
  LY := GetSystemMetrics(SM_YVIRTUALSCREEN);
  AWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
  AHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
  if (AWidth <= 0) or (AHeight <= 0) then Exit;

  LScreenDC := GetDC(0);
  LMemDC := CreateCompatibleDC(LScreenDC);
  LBmp := CreateCompatibleBitmap(LScreenDC, AWidth, AHeight);
  try
    LOld := SelectObject(LMemDC, LBmp);
    BitBlt(LMemDC, 0, 0, AWidth, AHeight, LScreenDC, LX, LY, SRCCOPY or CAPTURE_BLT);
    SelectObject(LMemDC, LOld);

    FillChar(LInfo, SizeOf(LInfo), 0);
    LInfo.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
    LInfo.bmiHeader.biWidth := AWidth;
    LInfo.bmiHeader.biHeight := -AHeight;   // negatif = de haut en bas
    LInfo.bmiHeader.biPlanes := 1;
    LInfo.bmiHeader.biBitCount := 32;
    LInfo.bmiHeader.biCompression := BI_RGB;
    SetLength(Result, AWidth * AHeight * 4);
    if GetDIBits(LMemDC, LBmp, 0, AHeight, @Result[0], LInfo, DIB_RGB_COLORS) = 0 then
      Result := nil;
  finally
    DeleteObject(LBmp);
    DeleteDC(LMemDC);
    ReleaseDC(0, LScreenDC);
  end;
end;

function ScanScreenForQr: string;
var
  LPixels: TArray<Byte>;
  LW, LH: Integer;
  LSource: TLuminanceSource;
  LBinarizer: THybridBinarizer;
  LImage: TBinaryBitmap;
  LReader: TMultiFormatReader;
  LHints: TDictionary<TDecodeHintType, TObject>;
  LFormats: TList<TBarcodeFormat>;
  LRes: TReadResult;
begin
  Result := '';
  LPixels := CaptureVirtualScreen(LW, LH);
  if LPixels = nil then Exit;

  LFormats := TList<TBarcodeFormat>.Create;
  LFormats.Add(TBarcodeFormat.QR_CODE);
  LHints := TDictionary<TDecodeHintType, TObject>.Create;
  LHints.Add(TDecodeHintType.POSSIBLE_FORMATS, LFormats);
  LHints.Add(TDecodeHintType.TRY_HARDER, nil);
  LReader := TMultiFormatReader.Create;
  LReader.Hints := LHints;
  // BGR32 et non BGRA32 : le 4e octet d'une capture GDI vaut 0, et la
  // conversion BGRA le lirait comme une transparence totale - image blanche.
  LSource := TRGBLuminanceSource.Create(LPixels, LW, LH, TBitmapFormat.BGR32);
  LBinarizer := THybridBinarizer.Create(LSource);
  LImage := TBinaryBitmap.Create(LBinarizer);
  LRes := nil;
  try
    try
      LRes := LReader.decode(LImage, True);
      if LRes <> nil then Result := Trim(LRes.Text);
    except
      Result := '';
    end;
  finally
    LRes.Free;
    LImage.Free;
    LBinarizer.Free;
    LSource.Free;
    LReader.Free;
    LFormats.Free;
    LHints.Free;
  end;
end;

end.