72f9acd733
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
116 lines
3.6 KiB
ObjectPascal
116 lines
3.6 KiB
ObjectPascal
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.
|