delphi和fpc共用的base64和binhex编码

delphi和fpc共用的base64和binhex编码

unit core.encode;

// cxg 2025-4-21 fit fpc + delphi
interface
{$ifdef fpc}
{$mode delphi}{$H+}
{$endif}
uses
{$IFNDEF fpc}
  System.NetEncoding,
{$ELSE}
  base64,
{$ENDIF}
  SysUtils, Classes, db;

type
  str = String;

  TBase64 = record
    //base64 encode
    function Encode(const AText: str): str; overload;
    function Encode(const ABytes: TBytes): str; overload;
    function Encode(const AStream: TStream): str; overload;
    function Encode(const ABlobField: TField): str; overload;
    //base64 decode
    function Decode(const AText: str): str; overload;
    function DecodeHexToBytes(const AText: str): TBytes;
    procedure Decode(const AText: str; const AStream: TStream); overload;
    procedure Decode(const AText: str; const ABlobField: TField); overload;
  end;

  TBinHex = record
    //hex encode
    procedure Encode(const AStream: TMemoryStream; var AText: str); overload;
    procedure Encode(const ABlobField: TField; var AText: str); overload;
    //hex decode
    procedure Decode(const AText: str; const AStream: TStream); overload;
    procedure Decode(const AText: str; const ABlobField: TField); overload;
  end;

implementation

procedure TBase64.Decode(const AText: str; const ABlobField: TField);
var
  LMemoryStream: TMemoryStream;
begin
  if ABlobField = nil then
    Exit;
  LMemoryStream := TMemoryStream.Create;
  try
    Decode(AText, LMemoryStream);
    TBlobField(ABlobField).LoadFromStream(LMemoryStream);
  finally
    LMemoryStream.Free;
  end;
end;

function TBase64.DecodeHexToBytes(const AText: str): TBytes;
{$IFDEF fpc}
var
  LSource, LDest: TBytesStream;
  LDecoder: TBase64DecodingStream;
{$ENDIF}
begin
  if Length(AText) = 0 then
    Exit;
{$IFNDEF fpc}
  Result := TNetEncoding.base64.DecodeStringToBytes(AText);
{$ELSE}
  LSource := TBytesStream.Create(ABytes);
  try
    LDest := TBytesStream.Create;
    try
      LDecoder := TBase64DecodingStream.Create(LSource);
      try
        LDest.CopyFrom(LDecoder, LDecoder.Size);
        Result := LDest.Bytes;
      finally
        LDecoder.Free;
      end;
    finally
      LDest.Free;
    end;
  finally
    LSource.Free;
  end;
{$ENDIF}
end;

function TBase64.Decode(const AText: str): str;
begin
{$IFNDEF fpc}
  Result := TNetEncoding.base64.Decode(AText);
{$ELSE}
  Result := DecodeStringBase64(AText);
{$ENDIF}
end;

procedure TBase64.Decode(const AText: str; const AStream: TStream);
var
  LStringStream: TStringStream;
{$IFDEF fpc}
  LDecoder: TBase64DecodingStream;
{$ENDIF}
begin
  LStringStream := TStringStream.Create(AText);
  try
{$IFNDEF fpc}
    TNetEncoding.base64.Decode(LStringStream, AStream);
{$ELSE}
    LDecoder := TBase64DecodingStream.Create(LStringStream);
    try
      AStream.CopyFrom(LDecoder, LDecoder.Size);
    finally
      LDecoder.Free;
    end;
{$ENDIF}
    AStream.Position := 0;
  finally
    LStringStream.Free;
  end;
end;

function TBase64.Encode(const ABytes: TBytes): str;
{$IFDEF fpc}
var
  LEncoder: TBase64EncodingStream;
  LBytesStream: TBytesStream;
{$ENDIF}
begin
  if Length(ABytes) = 0 then
    Exit;
{$IFNDEF fpc}
  Result := TNetEncoding.base64.EncodeBytesToString(ABytes);
{$ELSE}
  LBytesStream := TBytesStream.Create;
  try
    LEncoder := TBase64EncodingStream.Create(LBytesStream);
    try
      LEncoder.Write(ABytes[0], Length(ABytes));
    finally
      LEncoder.Free;
    end;
    Result := LBytesStream.Bytes;
  finally
    LBytesStream.Free;
  end;
{$ENDIF}
end;

function TBase64.Encode(const AText: str): str;
begin
{$IFNDEF fpc}
  Result := TNetEncoding.base64.Encode(AText);
{$ELSE}
  Result := EncodeStringBase64(AText);
{$ENDIF}
end;

function TBase64.Encode(const AStream: TStream): str;
var
  LStringStream: TStringStream;
{$IFDEF fpc}
  LEncoder: TBase64EncodingStream;
{$ENDIF}
begin
  if AStream = nil then
    Exit;
  LStringStream := TStringStream.Create;
  try
    AStream.Position := 0;
{$IFNDEF fpc}
    TNetEncoding.base64.Encode(AStream, LStringStream);
    Result := LStringStream.DataString;
{$ELSE}
    LEncoder := TBase64EncodingStream.Create(LStringStream);
    try
      LEncoder.CopyFrom(AStream, AStream.Size);
      Result := LStringStream.DataString;
    finally
      LEncoder.Free;
    end;
{$ENDIF}
  finally
    LStringStream.Free;
  end;
end;

function TBase64.Encode(const ABlobField: TField): str;
var
  LMemoryStream: TMemoryStream;
begin
  LMemoryStream := TMemoryStream.Create;
  try
    TBlobField(ABlobField).SaveToStream(LMemoryStream);
    Result := Encode(LMemoryStream);
  finally
    LMemoryStream.Free;
  end;
end;

{ TBinHex }
procedure TBinHex.Decode(const AText: str; const AStream: TStream);
begin
  if AStream = nil then Exit;
  AStream.Size := Length(AText) div 2;
  HexToBin(PChar(AText), TMemoryStream(AStream).Memory, AStream.Size);
end;

procedure TBinHex.Decode(const AText: str; const ABlobField: TField);
var
  LMemoryStream: TMemoryStream;
begin
  if ABlobField = nil then
    Exit;
  LMemoryStream := TMemoryStream.Create;
  try
    Decode(AText, LMemoryStream);
    TBlobField(ABlobField).LoadFromStream(LMemoryStream);
  finally
    LMemoryStream.Free;
  end;
end;

procedure TBinHex.Encode(const AStream: TMemoryStream; var AText: str);
begin
  if AStream = nil then Exit;
  SetLength(AText, AStream.Size * 2);
  BinToHex(AStream.Memory, PChar(AText), AStream.Size);
end;

procedure TBinHex.Encode(const ABlobField: TField; var AText: str);
var
  LMemoryStream: TMemoryStream;
begin
  LMemoryStream := TMemoryStream.Create;
  try
    TBlobField(ABlobField).SaveToStream(LMemoryStream);
    Encode(LMemoryStream, AText);
  finally
    LMemoryStream.Free;
  end;
end;

end.