Как загрузить зашифрованный URL base64 в TWebBrowser или TImage? - PullRequest
Новая
       130

Как загрузить зашифрованный URL base64 в TWebBrowser или TImage?

0 голосов
/ 05 ноября 2019

У меня есть этот URL , зашифрованный в base64, который является анимированным QRCode.

Как я могу загрузить его в TWebBrowser (или TImage)? Заранее спасибо.

Редактировать:

Вот моя попытка, но безуспешно: 

uses
 IdHTTP, IdSSLOpenSSL, GIFImg, ClipBrd;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetStrFromClipbrd: string;
begin
  if Clipboard.HasFormat(CF_TEXT) then
    Result := Clipboard.AsText
  else
  begin
    ShowMessage('There is no text in the Clipboard!');
    Result := '';
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  MS: TMemoryStream;
  IdHTTP1: TIdHTTP;
  GIF: TGIFImage;
begin
  MS := TMemoryStream.Create;
  try
    IdHTTP1 := TIdHTTP.Create;
    try
      GIF := TGIFImage.Create;
      try
        IdHTTP1.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP1);
        IdHTTP1.HandleRedirects := True;
        IdHTTP1.Get(GetStrFromClipbrd, MS);
        MS.Seek(0, soFromBeginning);
        GIF.LoadFromStream(MS);
        Image1.Picture.Assign(GIF);
        (Image1.Picture.Graphic as TGIFImage).Animate := True;
        //(Image1.Picture.Graphic as TGIFImage).AnimationSpeed := 500;
      finally
        FreeAndNil(GIF);
      end;
    finally
      FreeAndNil(IdHTTP1);
    end;
  finally
    FreeAndNil(MS);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.DoubleBuffered := True;
end;

end.

1 Ответ

6 голосов
/ 06 ноября 2019

data: - это не тот тип URL, который вы можете запросить с помощью TIdHTTP (или любой другой библиотеки HTTP), и в этом нет необходимости, поскольку все данные кодируются непосредственно в самом URL. Так что просто извлеките часть base64 и декодируйте ее, используя любой декодер base64 по вашему выбору.

Поскольку ваш код в любом случае уже использует Indy, вы можете использовать его класс TIdDecoderMIME в модуле IdCoderMIME для декодирования base64данные в двоичный поток, например, с помощью процедуры класса TIdDecoderMIME.DecodeStream(). Затем вы можете загрузить этот поток в соответствующий TGraphic потомок (TGIFImage, TBitmap и т. Д.), А затем, наконец, вы можете загрузить этот графический объект в TImage.

Например: 

uses
  IdGlobal, IdGlobalProtocols, IdCoderMIME, IdHTTP, IdSSLOpenSSL,
  Graphics, GIFImg, JPEG, ClipBrd;

function GetStrFromClipbrd: string;
const
  CTextFormat = {$IFDEF UNICODE}CF_UNICODETEXT{$ELSE}CF_TEXT{$ENDIF};
begin
  if Clipboard.HasFormat(CTextFormat) then
    Result := Clipboard.AsText
  else
    Result := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Graphic: TGraphic;
  MS: TMemoryStream;
  IdHTTP1: TIdHTTP;
  URL, ContentType: string;
begin
  URL := GetStrFromClipbrd;
  if URL = '' then
  begin
    ShowMessage('There is no text in the Clipboard!');
    Exit;
  end;

  Graphic := nil;
  try
    MS := TMemoryStream.Create;
    try
      if TextStartsWith(URL, 'data:') then
      begin
        Fetch(URL, ':');
        ContentType := Fetch(URL, ',');
        if not TextEndsWith(ContentType, ';base64') then
        begin
          ShowMessage('Data is not encoded in base64!');
          Exit;
        end;
        SetLength(ContentType, Length(ContentType)-7);
        TIdDecoderMIME.DecodeStream(URL, MS);
        if ContentType = '' then
          ContentType := 'text/plain;charset=US-ASCII';
      end else
      begin
        IdHTTP1 := TIdHTTP.Create;
        try
          IdHTTP1.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP1);
          IdHTTP1.HandleRedirects := True;
          IdHTTP1.Get(URL, MS);
          ContentType := IdHTTP1.Response.ContentType;
        finally
          IdHTTP1.Free;
        end;
      end;

      MS.Position := 0;

      case PosInStrArray(ExtractHeaderItem(ContentType),
        ['image/gif', 'image/jpeg', 'image/bmp'{, ...}],
        False) of
          0: Graphic := TGIFImage.Create;
          1: Graphic := TJPEGImage.Create;
          2: Graphic := TBitmap.Create;
          // ...
      else
        ShowMessage('Unsupported image type!');
        Exit;
      end;

      { the 'data:' URL you provided is malformed, is says the image type
        is 'image/bmp' even though it is actually a GIF and thus should
        say 'image/gif'.  To avoid problems with the above code determining
        the wrong TGraphic class to use in that case, you can instead look
        at the first few bytes of the decoded data to determinate its actual
        image type, eg...

        const
          Signature_GIF87a: array[0..5] of Byte = ($47,$49,$46,$38,$37,$61);
          Signature_GIF89a: array[0..5] of Byte = ($47,$49,$46,$38,$39,$61);
          Signature_JPEG:   array[0..2] of Byte = ($FF,$D8,$FF);
          Signature_BMP:    array[0..1] of Byte = ($42,$4D);
          ...

        if (MS.Size >= 6) and
           (CompareMem(MS.Memory, @Signature_GIF87a, 6) or
            CompareMem(MS.Memory, @Signature_GIF89a, 6)) then
        begin
          Graphic := TGIFImage.Create;
        end
        else if (MS.Size >= 3) and
                 CompareMem(MS.Memory, @Signature_JPEG, 3) then
        begin
          Graphic := TJPEGImage.Create;
        end
        else if (MS.Size >= 2) and
                 CompareMem(MS.Memory, @Signature_BMP, 2) then
        begin
          Graphic := TBitmap.Create;
        end
        ...
        else
          ShowMessage('Unsupported image type!');
          Exit;
        end;
      }

      Graphic.LoadFromStream(MS);
    finally
      MS.Free;
    end;

    Image1.Picture.Assign(Graphic);
  finally
    Graphic.Free;
  end;

  if Image.Picture.Graphic is TGIFImage then
  begin
    TGIFImage(Image.Picture.Graphic).Animate := True;
    //TGIFImage(Image.Picture.Graphic).AnimationSpeed := 500;
  end;
end;
...