DECFormat.pas

{*****************************************************************************
  The DEC team (see file NOTICE.txt) licenses this file
  to you under the Apache License, Version 2.0 (the
  "License"); you may not use this file except in compliance
  with the License. A copy of this licence is found in the root directory
  of this project in the file LICENCE.txt or alternatively at

    http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing,
  software distributed under the License is distributed on an
  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  KIND, either express or implied.  See the License for the
  specific language governing permissions and limitations
  under the License.
*****************************************************************************}

/// <summary>
///   This unit provides a standardisized way for applying format conversions
///   to data
/// </summary>
unit DECFormat;
{$INCLUDE DECOptions.inc}

interface


uses
  {$IFDEF FPC}
  SysUtils, Classes,
  {$ELSE}
  System.SysUtils, System.Classes,
  {$ENDIF}
  DECBaseClass, DECFormatBase, DECUtil;

type
  /// <summary>
  ///   wrapper (allows omitting DECFormatBase in user code)
  /// </summary>
  TDECFormat            = DECFormatBase.TDECFormat;
  /// <summary>
  ///   wrapper (allows omitting DECFormatBase in user code)
  /// </summary>
  TDECFormatClass       = DECFormatBase.TDECFormatClass;
  /// <summary>
  ///   wrapper (allows omitting DECFormatBase in user code)
  /// </summary>
  TFormat_Copy          = DECFormatBase.TFormat_Copy;

  TFormat_HEX           = class;
  TFormat_HEXL          = class;

  TFormat_Base16        = class;
  TFormat_Base16L       = class;

  TFormat_DECMIME32     = class;

  TFormat_Base32        = class;

  TFormat_Base64        = class;
  TFormat_MIME64        = class;

  TFormat_Radix64       = class;
  TFormat_PGP           = class;
  TFormat_BCryptBSD = class;

  TFormat_UU            = class;
  TFormat_XX            = class;
  TFormat_ESCAPE        = class;

  TFormat_BigEndian16   = class;
  TFormat_BigEndian32   = class;

  TFormat_UTF8          = class;

  /// <summary>
  ///   Hexadecimal in Uppercase, Base16, see http://tools.ietf.org/html/rfc4648
  /// </summary>
  TFormat_HEX = class(TDECFormat)
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <exception cref="EDECFormatException">
    ///   Exception raised if there is a failure in the data format.
    /// </exception>
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function DoIsValid(const Data; Size: Integer): Boolean; override;
  public
    class function CharTableBinary: TBytes; virtual;
    class function FilterChars: string; override;
  end;

  /// <summary>
  ///   Hexadecimal in lowercase, Base16, see http://tools.ietf.org/html/rfc4648
  /// </summary>
  TFormat_HEXL = class(TFormat_HEX)
  public
    class function CharTableBinary: TBytes; override;
    class function FilterChars: string; override;
  end;

  /// <summary>
  ///   Same as TFormat_HEX, use TFormat_HEX instead
  /// </summary>
  TFormat_Base16 = class(TFormat_HEX)
  end deprecated 'Use TFormat_HEX instead';

  /// <summary>
  ///   Same as TFormat_HEXL, use TFormat_HEXL instead
  /// </summary>
  TFormat_Base16L = class(TFormat_HEXL)
  end deprecated 'Use TFormat_HEXL instead';

  /// <summary>
  ///   Proprietary variant of MINE32, kept for backwards compatibility with old
  ///   DEC versions
  /// </summary>
  /// <remarks>
  ///   This formatting should only be used for supporting legacy projects which
  ///   already use this format. It is being considered to be more or less deprecated.
  /// </remarks>
  TFormat_DECMIME32 = class(TFormat_HEX)
  protected
    /// <summary>
    ///   Encodes data passed to this method in the proprietary DECMIME32 format.
    /// </summary>
    /// <remarks>
    ///   This formatting should only be used for supporting legacy projects which
    ///   already use this format. It is being considered to be more or less deprecated.
    /// </remarks>
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <summary>
    ///   Decodes data passed to this method in the proprietary DECMIME32 format
    ///   into an array of normal bytes.
    /// </summary>
    /// <remarks>
    ///   This formatting should only be used for supporting legacy projects which
    ///   already use this format. It is being considered to be more or less deprecated.
    /// </remarks>
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <summary>
    ///   Checks if certain data adheres to the rules for this formatting.
    /// </summary>
    /// <remarks>
    ///   This formatting should only be used for supporting legacy projects which
    ///   already use this format. It is being considered to be more or less deprecated.
    /// </remarks>
    class function DoIsValid(const Data; Size: Integer): Boolean; override;

  public
    class function CharTableBinary: TBytes; override;
  end;

  /// <summary>
  ///   Same as DECMIME32, which itsself should only be used for legacy projects
  /// </summary>
  TFormat_MIME32 = class(TFormat_DECMIME32)
  end deprecated 'Use TFormat_DECMIME32 instead';

  /// <summary>
  ///   Base32, see http://tools.ietf.org/html/rfc4648
  /// </summary>
  TFormat_Base32 = class(TFormat_HEX)
  private const
    /// <summary>
    ///   The data will be encoded using only these chars
    /// </summary>
    cBase32 : RawByteString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';
    /// <summary>
    ///   Char used to fill up the output when performing encoding
    /// </summary>
    cPaddingChar = '=';
  private
    /// <summary>
    ///   Table used for decoding, initialized on first use
    /// </summary>
    class var FBase32DecodeTable : array [#0..'z'] of Byte;

    /// <summary>
    ///   Initializes the contents of FBase32DecodeTable, which is only required
    ///   when DoDecode is called for the very first time.
    /// </summary>
    class procedure PrepareTable;
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <exception cref="EDECFormatException">
    ///   Exception raised if the format of <c>Source</c> contains invalid data.
    /// </exception>
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
    class function FilterChars: string; override;
  end;

  /// <summary>
  ///   Base64 (without soft wraps), see http://tools.ietf.org/html/rfc4648
  /// </summary>
  TFormat_Base64 = class(TFormat_HEX)
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
    class function CharTableBinary: TBytes; override;
    class function FilterChars: string; override;
  end;

  /// <summary>
  ///   Same as TFormat_Base64, use TFormat_Base64 instead, kept for backwards
  ///   compatibility only
  /// </summary>
  TFormat_MIME64 = class(TFormat_Base64)
  end deprecated 'Use TFormat_Base64 instead';

  /// <summary>
  ///   OpenPGP/PGP Base64 with 24-bit Checksums, see http://tools.ietf.org/html/rfc4880
  /// </summary>
  TFormat_Radix64 = class(TFormat_Base64)
  /// <summary>
  ///   Here the section needs to be private so that the variable can be accessed
  ///   for initialization in the initialization section, which is needed since
  ///   all functionality of the class is implemented as class methods
  /// </summary>
  private
    /// <summary>
    ///   Maximum number of chars for one line of message text
    /// </summary>
    class var FCharsPerLine : UInt32;
  protected
    /// <summary>
    ///   Extracts the CRC24 checksum from Radix64 encoded data
    /// </summary>
    /// <param name="Data">
    ///   Data to extract the checksum from
    /// </param>
    /// <param name="Size">
    ///   Size of the data in byte
    /// </param>
    /// <returns>
    ///   CRC24 checksum if present, otherwise $FFFFFFFF
    /// </returns>
    class function DoExtractCRC(const Data; var Size: Integer): UInt32;
    /// <summary>
    ///   If the data given exceeds FCharsPerLine, means the maximum allowed
    ///   line lenth, a CR/LF pair needs to be inserted at that position.
    /// </summary>
    /// <param name="Source">
    ///   Data to insert a CR/LF into if necessary
    /// </param>
    /// <param name="Dest">
    ///   In this byte array the processed data will be returned
    /// </param>
    /// <param name="LineLength">
    ///   Maximum length of a line in byte. At this position the CR/LF will be
    ///   inserted if the source passed in exceeds this length.
    /// </param>
    class procedure InsertCRLF(const Source: TBytes; var Dest: TBytes; LineLength: Integer);
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <exception cref="EDECFormatException">
    ///   Exception raised if the calculated CRC value does not match the one
    ///   given in <c>Source</c>.
    /// </exception>
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;

    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
    /// <summary>
    ///   Changes the number of chars after which a line break is being added
    /// </summary>
    /// <param name="Value">
    ///   Maximum number of chars for a single line. Values < 1 result in an
    ///   EArgumentOutOfRangeException being raised
    /// </param>
    /// <exception cref="EArgumentOutOfRangeException">
    ///   Exception raised if <c>Value</c> is < 1.
    /// </exception>
    class procedure SetCharsPerLine(const Value: UInt32);
    /// <summary>
    ///   Returns the number of chars after which a line break will be introduced
    /// </summary>
    /// <returns>
    ///   Maximum number of chars per line
    /// </returns>
    /// <remarks>
    ///   Cannot be a property, as properties cannot access class vars
    /// </remarks>
    class function GetCharsPerLine: UInt32;
  end;

  /// <summary>
  ///   Same as TFormat_Radix64, use TFormat_Radix64 instead, kept for backwards
  ///   compatibility only
  /// </summary>
  TFormat_PGP = class(TFormat_Radix64)
  end deprecated 'Use TFormat_Radix64 instead';

  /// <summary>
  ///   BCrypt's Radix64 variant
  /// </summary>
  TFormat_BCryptBSD = class(TFormat_Base64)
  protected
    /// <summary>
    /// Internal method for the actual format conversion. This method needs to
    /// be overridden in all the child classes. Converts into the format.
    /// </summary>
    /// <param name="Source">
    /// Data to be converted
    /// </param>
    /// <param name="Dest">
    /// Into this parameter the converted data will be written into.
    /// </param>
    /// <param name="Size">
    /// Number of bytes from source which will get converted.
    /// </param>
    class procedure DoEncode(const Source; var Dest: TBytes;
      Size: Integer); override;
    /// <summary>
    /// Internal method for the actual format conversion. This method needs to
    /// be overridden in all the child classes. Converts from the format into
    /// the format the data had before encoding it.
    /// </summary>
    /// <param name="Source">
    /// Data to be converted
    /// </param>
    /// <param name="Dest">
    /// Into this parameter the converted data will be written into.
    /// </param>
    /// <param name="Size">
    /// Number of bytes from source which will get converted.
    /// </param>
    class procedure DoDecode(const Source; var Dest: TBytes;
      Size: Integer); override;
    /// <summary>
    /// Internal method for checking whether all bytes of the data to be
    /// processed are valid for this particular formatting. This method needs
    /// to be overridden in all the child classes.
    /// </summary>
    /// <param name="Data">
    /// Data to be checked
    /// </param>
    /// <param name="Size">
    /// Number of bytes from data which will get checked.
    /// </param>
    class function DoIsValid(const Data; Size: Integer): Boolean; override;
  public  
    class function CharTableBinary: TBytes; override;
  end;

  /// <summary>
  ///   Unix UU format
  /// </summary>
  TFormat_UU = class(TDECFormat)
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <exception cref="EDECFormatException">
    ///   Exception raised if the format of <c>Source</c> contains invalid data.
    /// </exception>
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
    class function CharTableBinary: TBytes; virtual;
  end;

  /// <summary>
  ///   Unix XX format
  /// </summary>
  TFormat_XX = class(TFormat_UU)
  public
    class function CharTableBinary: TBytes; override;
  end;

  /// <summary>
  ///   Escaped format
  /// </summary>
  TFormat_ESCAPE = class(TDECFormat)
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    /// <exception cref="EDECFormatException">
    ///   Exception raised if the format of <c>Source</c> contains invalid data.
    /// </exception>
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
    class function CharTableBinary: TBytes; virtual;
  end;

  /// <summary>
  ///   Conversion from/to 16 bit big endian
  /// </summary>
  TFormat_BigEndian16 = class(TDECFormat)
  private
    class procedure DoSawp(const Source; var Dest: TBytes; Size: Integer); inline;
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
  end;

  /// <summary>
  ///   Conversion from/to UTF16 strings
  /// </summary>
  TFormat_UTF16 = class(TFormat_BigEndian16);

  /// <summary>
  ///   Conversion from/to 32 bit big endian
  /// </summary>
  TFormat_BigEndian32 = class(TDECFormat)
  private
    class procedure DoSawp(const Source; var Dest: TBytes; Size: Integer); inline;
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
  end;

  /// <summary>
  ///   Conversion from/to 64 bit big endian
  /// </summary>
  TFormat_BigEndian64 = class(TDECFormat)
  private
    class procedure DoSawp(const Source; var Dest: TBytes; Size: Integer); inline;
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer): Boolean; override;
  public
  end;

  /// <summary>
  ///   Conversion from/to UTF8
  /// </summary>
  TFormat_UTF8 = class(TDECFormat)
  protected
    class procedure DoEncode(const Source; var Dest: TBytes; Size: Integer); override;
    class procedure DoDecode(const Source; var Dest: TBytes; Size: Integer); override;
    class function  DoIsValid(const Data; Size: Integer{;IsEncode: boolean}): Boolean; override;
  end;


implementation

uses
  DECTypes, DECCRC; // needed by TFormat_Radix64

resourcestring
  sInvalidStringFormat   = 'Input is not an valid %s format';
  sInvalidInputCharacter = 'Invalid character (#%d) in input';

class function TFormat_HEX.CharTableBinary: TBytes;
begin
  SetLength(result, 48);
  // special and skipped chars
  // '0123456789ABCDEFX$ abcdefhHx()[]{},;:-_/\*+"'''+CHR(9)+CHR(10)+CHR(13);

  {$IFDEF HAVE_ASSIGN_ARRAY}
  result := [$30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $41, $42, $43,
             $44, $45, $46, $58, $24, $20, $61, $62, $63, $64, $65, $66, $68,
             $48, $78, $28, $29, $5B, $5D, $7B, $7D, $2C, $3B, $3A, $2D, $5F,
             $2F, $5C, $2A, $2B, $22, $27, $09, $0A, $0D];
  {$ELSE}
  // Remove this initialisation variant as soon as XE7+ is the new minimum
  // supported Delphi version
  result[ 0]:=$30;
  result[ 1]:=$31;
  result[ 2]:=$32;
  result[ 3]:=$33;
  result[ 4]:=$34;
  result[ 5]:=$35;
  result[ 6]:=$36;
  result[ 7]:=$37;
  result[ 8]:=$38;
  result[ 9]:=$39;
  result[10]:=$41;
  result[11]:=$42;
  result[12]:=$43;
  result[13]:=$44;
  result[14]:=$45;
  result[15]:=$46;
  result[16]:=$58;
  result[17]:=$24;
  result[18]:=$20;
  result[19]:=$61;
  result[20]:=$62;
  result[21]:=$63;
  result[22]:=$64;
  result[23]:=$65;
  result[24]:=$66;
  result[25]:=$68;
  result[26]:=$48;
  result[27]:=$78;
  result[28]:=$28;
  result[29]:=$29;
  result[30]:=$5B;
  result[31]:=$5D;
  result[32]:=$7B;
  result[33]:=$7D;
  result[34]:=$2C;
  result[35]:=$3B;
  result[36]:=$3A;
  result[37]:=$2D;
  result[38]:=$5F;
  result[39]:=$2F;
  result[40]:=$5C;
  result[41]:=$2A;
  result[42]:=$2B;
  result[43]:=$22;
  result[44]:=$27;
  result[45]:=$09;
  result[46]:=$0A;
  result[47]:=$0D;
  {$ENDIF}
end;

class procedure TFormat_HEX.DoEncode(const Source; var Dest: TBytes; Size: Integer);
var
  S     : PByte;
  Table : TBytes;
  i     : Integer;
begin
  if Size <= 0 then Exit;
  SetLength(Dest, Size * 2);

  Table := CharTableBinary;

  S     := PByte(@Source);
  i     := 0;

  while Size > 0 do
  begin
    Dest[i]     := Table[S^ shr  4];
    Dest[i + 1] := Table[S^ and $F];

    Inc(S);
    Dec(Size);
    Inc(i, 2);
  end;
end;

class procedure TFormat_HEX.DoDecode(const Source; var Dest: TBytes; Size: Integer);
var
  S: PByte;
  D: PByte;
  T: TBytes;
  I,P: Integer;

  HasIdent: Boolean;
begin
  SetLength(Dest, 0);
  if Size <= 0 then Exit;
  SetLength(Dest, Size div 2); //  + 1);

  T := CharTableBinary;

  D := PByte(Dest);
  S := PByte(@Source);
  I := 0;
  HasIdent := False;
  while Size > 0 do
  begin
    P := TableFindBinary(S^, T, 18);
    if P < 0 then P := TableFindBinary(UpCaseBinary(S^), T, 16);
    if P < 0 then
      raise EDECFormatException.CreateResFmt(@sInvalidStringFormat, [self.GetShortClassName]);
    Inc(S);
    if P >= 0 then
      if P > 16 then
      begin
        if not HasIdent then
        begin
          HasIdent := True;
          I := 0;
          D := PByte(Dest);
        end;
      end
      else
      begin
        if Odd(I) then
        begin
          D^ := D^ or P;
          Inc(D);
        end
        else
          D^ := P shl 4;
        Inc(I);
      end;
    Dec(Size);
  end;
end;

class function TFormat_HEX.DoIsValid(const Data; Size: Integer): Boolean;
var
  T: TBytes;
  S: PByte;
begin
  if not odd(Size) then
  begin
    Result := True;
    T := CharTableBinary;
    S := @Data;
    while Result and (Size > 0) do
    begin
      if TableFindBinary(S^, T, length(T)) >= 0 then
      begin
        Inc(S);
        Dec(Size);
      end
      else
        Result := False;
    end;
  end
  else
    result := false;
end;

class function TFormat_HEX.FilterChars: string;
begin
  result := '0123456789ABCDEF';
end;

class function TFormat_HEXL.CharTableBinary: TBytes;
begin
  SetLength(result, 48);
  // special and skipped chars
  // '0123456789abcdefX$ ABCDEFhHx()[]{},;:-_/\*+"'''+CHR(9)+CHR(10)+CHR(13);

  {$IFDEF HAVE_ASSIGN_ARRAY}
  result := [$30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $61, $62, $63,
             $64, $65, $66, $68, $58, $24, $20, $41, $42, $43, $44, $45, $46,
             $48, $78, $28, $29, $5B, $5D, $7B, $7D, $2C, $3B, $3A, $2D, $5F,
             $2F, $5C, $2A, $2B, $22, $27, $09, $0A, $0D];
  {$ELSE}
  // Remove this initialisation variant as soon as XE7+ is the new minimum
  // supported Delphi version
  result[ 0]:=$30;
  result[ 1]:=$31;
  result[ 2]:=$32;
  result[ 3]:=$33;
  result[ 4]:=$34;
  result[ 5]:=$35;
  result[ 6]:=$36;
  result[ 7]:=$37;
  result[ 8]:=$38;
  result[ 9]:=$39;
  result[10]:=$61;
  result[11]:=$62;
  result[12]:=$63;
  result[13]:=$64;
  result[14]:=$65;
  result[15]:=$66;
  result[16]:=$68;
  result[17]:=$58;
  result[18]:=$24;
  result[19]:=$20;
  result[20]:=$41;
  result[21]:=$42;
  result[22]:=$43;
  result[23]:=$44;
  result[24]:=$45;
  result[25]:=$46;
  result[26]:=$48;
  result[27]:=$78;
  result[28]:=$28;
  result[29]:=$29;
  result[30]:=$5B;
  result[31]:=$5D;
  result[32]:=$7B;
  result[33]:=$7D;
  result[34]:=$2C;
  result[35]:=$3B;
  result[36]:=$3A;
  result[37]:=$2D;
  result[38]:=$5F;
  result[39]:=$2F;
  result[40]:=$5C;
  result[41]:=$2A;
  result[42]:=$2B;
  result[43]:=$22;
  result[44]:=$27;
  result[45]:=$09;
  result[46]:=$0A;
  result[47]:=$0D;
  {$ENDIF}
end;

class function TFormat_HEXL.FilterChars: string;
begin
  result := '0123456789abcdef';
end;

class function TFormat_DECMIME32.CharTableBinary: TBytes;
begin
  // special and skipped chars
  // 'abcdefghijklnpqrstuwxyz123456789 =$()[]{},;:-_\*"'''+CHR(9)+CHR(10)+CHR(13);
  SetLength(result, 53);
  result := [$61, $62, $63, $64, $65, $66, $67, $68, $69, $6A, $6B, $6C, $6E, $70,
             $71, $72, $73, $74, $75, $77, $78, $79, $7A, $31, $32, $33, $34, $35,
             $36, $37, $38, $39, $20, $3D, $24, $28, $29, $5B, $5D, $7B, $7D, $2C,
             $3B, $3A, $2D, $5F, $5C, $2A, $22, $27, $09, $0A, $0D];
end;

class procedure TFormat_DECMIME32.DoEncode(const Source; var Dest: TBytes; Size: Integer);
var
  T   : TBytes;
  Src : TBytes;
  S, D: PByte;
  i, n: Integer;
begin
  SetLength(Dest, 0);
  if Size <= 0 then
    Exit;

  // The passed in source parameter has to be converted into an array with
  // added additional 0 value. This is because in the original form a string was
  // being passed in as source parameter, which automatically contained a #00 at
  // the end and depending on length of the data passed in, the @S[i shr 3] index
  // calculation can result in an index which represents the last byte of the
  // source parameter. That one is accessed as PWord then which results in
  // reading the first byte behind that source parameter as well! This led to
  // wrong data errors in the unit tests.
  SetLength(Src, Size + 1);
  Move(Source, Src[0], Size);
  Src[length(Src)-1] := 0;

  Size := Size * 8;
  SetLength(Dest, Size div 5 + 5);

  D := @Dest[0];
  T := CharTableBinary;
  S := @Src[0];

  i := 0; n := 0;
  while i < Size do
  begin
    D^ := T[PWord(@S[i shr 3])^ shr (i and $7) and $1F];

    Inc(D);
    Inc(i, 5);

    Inc(n);
  end;

  SetLength(Dest, n);
  SetLength(Src, 0);
end;

class function TFormat_DECMIME32.DoIsValid(const Data; Size: Integer): Boolean;
var
  T: TBytes;
  S: PByte;
begin
  Result := True;
  T := CharTableBinary;
  S := @Data;
  while Result and (Size > 0) do
  begin
    if TableFindBinary(S^, T, length(T)) >= 0 then
    begin
      Inc(S);
      Dec(Size);
    end
    else
      Result := False;
  end;
end;

class procedure TFormat_DECMIME32.DoDecode(const Source; var Dest: TBytes; Size: Integer);
var
  T: TBytes;
  S: PByte;
  D: PByte;
  i, V: Integer;
begin
  SetLength(Dest, 0);
  if Size <= 0 then
    Exit;

  Size := Size * 5;
  SetLength(Dest, Size div 8);

  T := CharTableBinary;
  S := @Source;
  D := @Dest[0];

  FillChar(D^, Length(Dest), 0);
  i := 0;

  while i < Size do
  begin
    V := TableFindBinary(S^, T, 32);
    if V < 0 then
      V := TableFindBinary(UpCaseBinary(S^), T, 32);
    if V >= 0 then
    begin
      PWord(@D[i shr 3])^ := PWord(@D[i shr 3])^ or (V shl (i and $7));
      Inc(i, 5);
    end
    else
      Dec(Size, 5);
    Inc(S);
  end;

  SetLength(Dest, Size div 8);
end;

class function TFormat_Base64.CharTableBinary: TBytes;
begin
  //  'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=' +
  //  ' $()[]{},;:-_\*"'''+CHR(9)+CHR(10)+CHR(13); // special and skipped chars
  SetLength(result, 85);

  result := [$41, $42, $43, $44, $45, $46, $47, $48, $49, $4A, $4B, $4C, $4D,
             $4E, $4F, $50, $51, $52, $53, $54, $55, $56, $57, $58, $59, $5A,
             $61, $62, $63, $64, $65, $66, $67, $68, $69, $6A, $6B, $6C, $6D,
             $6E, $6F, $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A,
             $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $2B, $2F, $3D,
             $20, $24, $28, $29, $5B, $5D, $7B, $7D, $2C, $3B, $3A, $2D, $5F,
             $5C, $2A, $22, $27, $09, $0A, $0D];
end;

class function TFormat_Base64.FilterChars: string;
begin
  result := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
end;

class procedure TFormat_Base64.DoEncode(const Source; var Dest: TBytes; Size: Integer);
var
  T: TBytes;
  S: PByte;
  D: PByte;
  B: UInt32;
  i: Integer;
  n: Integer;
begin
  SetLength(Dest, 0);
  if Size <= 0 then
    Exit;

  SetLength(Dest, Size * 4 div 3 + 4);

  T := CharTableBinary;
  S := @Source;
  D := @Dest[0];

  n := 0;
  while Size >= 3 do
  begin
    Dec(Size, 3);
    B := Byte(S[0]) shl 16 or Byte(S[1]) shl 8 or Byte(S[2]);
    D[0] := T[B shr 18 and $3F];
    D[1] := T[B shr 12 and $3F];
    D[2] := T[B shr  6 and $3F];
    D[3] := T[B        and $3F];
    Inc(D, 4);
    S := @S[3];
    Inc(n, 4);
  end;

  while Size > 0 do
  begin
    B := 0;
    for i := 0 to 2 do
    begin
      B := B shl 8;
      if Size > 0 then
      begin
        B := B or Byte(S[0]);
        S := @S[1];
      end;
      Dec(Size);
    end;
    for i := 3 downto 0 do
    begin
      if Size < 0 then
      begin
        D[i] := T[64];
        Inc(Size);
      end
      else
        D[i] := T[B and $3F];
      B := B shr 6;
    end;
    Inc(D, 4);
    Inc(n, 4);
  end;

  // original calculation was substract dest ptr d - start of dest
  SetLength(Dest, n);
end;

class procedure TFormat_Base64.DoDecode(const Source; var Dest: TBytes; Size: Integer);
var
  T: TBytes;
  S: PByte;
  D, L: PByte; // 1) to make pointer arithmetic work 2) P/TByteArray is limited to 32768 bytes
  B: UInt32;
  i, j, n: Integer;
begin
  SetLength(Dest, 0);
  if Size <= 0 then
    Exit;

  SetLength(Dest, Size);

  T := CharTableBinary;
  S := @Source;
  D := @Dest[0];

  Move(Source, Dest[0], Size);

  L := S + Size;
  j := 0;
  n := 0;
  while S < L do
  begin
    B := 0;
    j := 4;
    while (j > 0) and (S < L) do
    begin
      i := TableFindBinary(S^, T, 65);
      Inc(S);
      if i >= 0 then
      begin
        if i < 64 then
        begin
          B := B shl 6 or Byte(i);
          Dec(j);
        end
        else
          L := S;
      end;
    end;
    if j > 0 then
    begin
      if j >= 4 then
      begin
        j := 0;
        Break;
      end
      else
        B := B shl (6 * j);
    end;
    i := 2;
    while i >= 0 do
    begin
      D[i] := Byte(B);
      B := B shr 8;
      Dec(i);
    end;
    Inc(D, 3);
    Inc(n, 3);
  end;

  SetLength(Dest, n-j);
end;

class function TFormat_Base64.DoIsValid(const Data; Size: Integer): Boolean;
var
  S: PByte;
begin
  Result := True;
  S := @Data;
  while Result and (Size > 0) do
  begin
    // A-Z, a-z, 0-9, +, = and / and CR/LF
    if S^ in [$41..$5A, $61..$7A, $2B, $2F..$39, $3D, $0D, $0A] then
    begin
      Inc(S);
      Dec(Size);
    end
    else
      Result := False;
  end;
end;

class function TFormat_Radix64.DoExtractCRC(const Data; var Size: Integer): UInt32;
var
  L: PByte; // 1) to make pointer arithmetic work 2) P/TByteArray is limited to 32768 bytes
  C: Byte;
  R: TBytes;
begin
  Result := $FFFFFFFF;
  C := CharTableBinary[64]; // get padding char, per default '='
  L := PByte(@Data) + Size;
  while L <> @Data do
  begin
    if L^ = C then
      Break
    else
      Dec(L); // scan reverse for padding char
  end;
  if L - PByte(@Data) >= Size - 5 then // remaining chars must be > 4, e.g. '=XQRT'
  try
    Inc(L);
    inherited DoDecode(L^, R, Size - (L - PByte(@Data)));
    if Length(R) >= 3 then
    begin
      Result := 0;
      Move(R[0], Result, 3);
      Size := L - PByte(@Data);