Base64

From Lazarus wiki
Jump to navigationJump to search

Various code example to handle Base64 encoded strings.

Convert Base64 string to picture

This unit is from forum member KodeZwerg. You must install the BGRABitmap component.

unit ubase64image;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Graphics, ExtCtrls,
  Base64,
  BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet;

function FileToStream(const AFilename: string): TStream;
function StreamToBase64(const AStream: TStream): AnsiString;
function Base64ToStream(const ABase64String: AnsiString): TStream;
procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);

implementation

function FileToStream(const AFilename: string): TStream;
var
  FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    Result := TMemoryStream.Create;
    try
      Result.CopyFrom(FileStream, FileStream.Size);
    finally
      Result.Position := 0;
    end;
  finally
    FileStream.Free;
  end;
end;

function StreamToBase64(const AStream: TStream): string;
var
  EncodedStream: TStringStream;
  Encoder: TBase64EncodingStream;
begin
  EncodedStream := TStringStream.Create('');
  Encoder := TBase64EncodingStream.Create(EncodedStream);
  try
    AStream.Position := 0;
    Encoder.CopyFrom(AStream, AStream.Size);
    Encoder.Flush;
    Result := EncodedStream.DataString;
    AStream.Position := 0;
  finally
    Encoder.Free;
    EncodedStream.Free;
  end;
end;

function Base64ToStream(const ABase64String: AnsiString): TStream;
var
  DecodedStream: TBase64DecodingStream;
  Base64Stream: TStringStream;
begin
  Base64Stream := TStringStream.Create(ABase64String);
  try
    DecodedStream := TBase64DecodingStream.Create(base64stream);
    try
      Result := TMemoryStream.Create;
      try
        Result.CopyFrom(DecodedStream, DecodedStream.Size);
      finally
        Result.Position := 0;
      end;
    finally
      DecodedStream.Free;
    end;
  finally
    Base64Stream.Free;
  end;
end;

function BGRABitmapToPNGStream(const ABGRABitmap: TBGRABitmap): TStream;
begin
  Result := TMemoryStream.Create;
  try
    ABGRABitmap.SaveToStreamAsPng(Result);
  finally
    Result.Position := 0;
  end;
end;

function BGRABitmapToBitmap(const ABGRABitmap: TBGRABitmap): TBitmap;
begin
  Result := TBitmap.Create;
  try
    Result.PixelFormat := ABGRABitmap.Bitmap.PixelFormat;
    Result.Transparent := ABGRABitmap.HasTransparentPixels or ABGRABitmap.HasSemiTransparentPixels;
    Result.SetSize(ABGRABitmap.Width, ABGRABitmap.Height);
    Result.Canvas.Lock;
    try
      Result.Canvas.Draw(0, 0, ABGRABitmap.Bitmap);
    finally
      Result.Canvas.Unlock;
    end;
  finally
  end;
end;

procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage;
  const AFastMode: Boolean = False);
var
  BGRABitmap: TBGRABitmap;
  Stream: TStream;
  bmp: TBitmap;
begin
  AImage.Picture.Clear;
  Stream := Base64ToStream(ABase64String);
  if (DetectFileFormat(Stream) <> ifUnknown) then
    begin
      BGRABitmap := TBGRABitmap.Create;
      try
        try
          BGRABitmap.LoadFromStream(Stream);
        finally
          Stream.Free;
        end;
        if AFastMode then
          begin
            bmp := BGRABitmapToBitmap(BGRABitmap);
            try
              AImage.Transparent := bmp.Transparent;
              AImage.Picture.Assign(bmp);
            finally
              bmp.Free;
            end;
          end
        else
          begin
            Stream := BGRABitmapToPNGStream(BGRABitmap);
            try
              AImage.Transparent := BGRABitmap.HasTransparentPixels or BGRABitmap.HasSemiTransparentPixels;
              AImage.Picture.PNG.LoadFromStream(Stream);
            finally
              Stream.Free;
            end;
          end;
      finally
        BGRABitmap.Free;
      end;
    end
    else
      Stream.Free;
end;

initialization
  BGRASVG.RegisterSvgFormat;
  BGRAOpenRaster.RegisterOpenRasterFormat;
  BGRAPhoxo.RegisterPhoxoFormat;
  BGRAPaintNet.RegisterPaintNetFormat;
end.