Vichingo455-RePacks
/
xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity
xtool/contrib/DelphiEncryptionCompendium/Source/DECFormat.pas

1891 lines
44 KiB
ObjectPascal
Raw Blame History

{*****************************************************************************
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;
interface
{$INCLUDE DECOptions.inc}
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_Base64 = class;
TFormat_MIME64 = class;
TFormat_Radix64 = class;
TFormat_PGP = class;
TFormat_UU = class;
TFormat_XX = class;
TFormat_ESCAPE = class;
TFormat_BigEndian16 = class;
TFormat_BigEndian32 = 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;
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>
/// Hexadecimal in lowercase, Base16, see http://tools.ietf.org/html/rfc4648
/// </summary>
TFormat_HEXL = class(TFormat_HEX)
public
class function CharTableBinary: TBytes; 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>
/// 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;
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;
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>
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>
/// Unix UU format
/// </summary>
TFormat_UU = 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): 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;
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 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;
implementation
uses
DECCRC; // needed by TFormat_Radix64
resourcestring
sInvalidStringFormat = 'Input is not an valid %s format';
class function TFormat_HEX.CharTableBinary: TBytes;
begin
SetLength(result, 48);
// special and skipped chars
// '0123456789ABCDEFX$ abcdefhHx()[]{},;:-_/\*+"'''+CHR(9)+CHR(10)+CHR(13);
{$IF CompilerVersion >= 28.0}
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;
{$IFEND}
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 EDECException.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_HEXL.CharTableBinary: TBytes;
begin
SetLength(result, 48);
// special and skipped chars
// '0123456789abcdefX$ ABCDEFhHx()[]{},;:-_/\*+"'''+CHR(9)+CHR(10)+CHR(13);
{$IF CompilerVersion >= 28.0}
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;
{$IFEND}
end;
class function TFormat_DECMIME32.CharTableBinary: TBytes;
begin
// special and skipped chars
// 'abcdefghijklnpqrstuwxyz123456789 =$()[]{},;:-_\*"'''+CHR(9)+CHR(10)+CHR(13);
SetLength(result, 53);
{$IF CompilerVersion >= 28.0}
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];
{$ELSE}
// Remove this initialisation variant as soon as XE7+ is the new minimum
// supported Delphi version
result[ 0]:=$61;
result[ 1]:=$62;
result[ 2]:=$63;
result[ 3]:=$64;
result[ 4]:=$65;
result[ 5]:=$66;
result[ 6]:=$67;
result[ 7]:=$68;
result[ 8]:=$69;
result[ 9]:=$6A;
result[10]:=$6B;
result[11]:=$6C;
result[12]:=$6E;
result[13]:=$70;
result[14]:=$71;
result[15]:=$72;
result[16]:=$73;
result[17]:=$74;
result[18]:=$75;
result[19]:=$77;
result[20]:=$78;
result[21]:=$79;
result[22]:=$7A;
result[23]:=$31;
result[24]:=$32;
result[25]:=$33;
result[26]:=$34;
result[27]:=$35;
result[28]:=$36;
result[29]:=$37;
result[30]:=$38;
result[31]:=$39;
result[32]:=$20;
result[33]:=$3D;
result[34]:=$24;
result[35]:=$28;
result[36]:=$29;
result[37]:=$5B;
result[38]:=$5D;
result[39]:=$7B;
result[40]:=$7D;
result[41]:=$2C;
result[42]:=$3B;
result[43]:=$3A;
result[44]:=$2D;
result[45]:=$5F;
result[46]:=$5C;
result[47]:=$2A;
result[48]:=$22;
result[49]:=$27;
result[50]:=$09;
result[51]:=$0A;
result[52]:=$0D;
{$IFEND}
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);
{$IF CompilerVersion >= 28.0}
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];
{$ELSE}
// Remove this initialisation variant as soon as XE7+ is the new minimum
// supported Delphi version
result[0 ]:=$41;
result[1 ]:=$42;
result[2 ]:=$43;
result[3 ]:=$44;
result[4 ]:=$45;
result[5 ]:=$46;
result[6 ]:=$47;
result[7 ]:=$48;
result[8 ]:=$49;
result[9 ]:=$4A;
result[10]:=$4B;
result[11]:=$4C;
result[12]:=$4D;
result[13]:=$4E;
result[14]:=$4F;
result[15]:=$50;
result[16]:=$51;
result[17]:=$52;
result[18]:=$53;
result[19]:=$54;
result[20]:=$55;
result[21]:=$56;
result[22]:=$57;
result[23]:=$58;
result[24]:=$59;
result[25]:=$5A;
result[26]:=$61;
result[27]:=$62;
result[28]:=$63;
result[29]:=$64;
result[30]:=$65;
result[31]:=$66;
result[32]:=$67;
result[33]:=$68;
result[34]:=$69;
result[35]:=$6A;
result[36]:=$6B;
result[37]:=$6C;
result[38]:=$6D;
result[39]:=$6E;
result[40]:=$6F;
result[41]:=$70;
result[42]:=$71;
result[43]:=$72;
result[44]:=$73;
result[45]:=$74;
result[46]:=$75;
result[47]:=$76;
result[48]:=$77;
result[49]:=$78;
result[50]:=$79;
result[51]:=$7A;
result[52]:=$30;
result[53]:=$31;
result[54]:=$32;
result[55]:=$33;
result[56]:=$34;
result[57]:=$35;
result[58]:=$36;
result[59]:=$37;
result[60]:=$38;
result[61]:=$39;
result[62]:=$2B;
result[63]:=$2F;
result[64]:=$3D;
result[65]:=$20;
result[66]:=$24;
result[67]:=$28;
result[68]:=$29;
result[69]:=$5B;
result[70]:=$5D;
result[71]:=$7B;
result[72]:=$7D;
result[73]:=$2C;
result[74]:=$3B;
result[75]:=$3A;
result[76]:=$2D;
result[77]:=$5F;
result[78]:=$5C;
result[79]:=$2A;
result[80]:=$22;
result[81]:=$27;
result[82]:=$09;
result[83]:=$0A;
result[84]:=$0D;
{$IFEND}
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
T: TBytes;
S: PByte;
begin
Result := True;
T := CharTableBinary;
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);
end;
except
end;
end;
class function TFormat_Radix64.DoIsValid(const Data; Size: Integer): Boolean;
var
crc24 : UInt32;
Dest : TBytes;
begin
// Radix64 is like Base64 but with additional CRC24 checksum
result := TFormat_Base64.IsValid(Data, Size);
// Check contained checksum as well
if result then
begin
crc24 := DoExtractCRC(Data, Size);
// we need to decode, because it removes the CR/LF linebreaks which would
// invalidate the checksum
inherited DoDecode(Data, Dest, Size);
if crc24 <> $FFFFFFFF then
begin
// recalc CRC and compare
SwapBytes(crc24, 3);
result := crc24 = CRCCalc(CRC_24, Dest[0], Length(Dest));
end
else
result := false;
end;
end;
class function TFormat_Radix64.GetCharsPerLine: UInt32;
begin
result := FCharsPerLine;
end;
class procedure TFormat_Radix64.InsertCRLF(const Source: TBytes; var Dest: TBytes; LineLength: Integer);
var
S, D: PByte;
i: Integer;
begin
i := Length(Source);
if (LineLength <= 0) or (i <= LineLength) then
begin
SetLength(Dest, i);
Move(Source[0], Dest[0], i);
Exit;
end;
SetLength(Dest, i + i * 2 div LineLength + 2);
S := @Source[0];
D := @Dest[0];
repeat
Move(S^, D^, LineLength);
Inc(S, LineLength);
Inc(D, LineLength);
D^ := Ord(#13);
Inc(D);
D^ := Ord(#10);
Inc(D);
Dec(i, LineLength);
until i < LineLength;
Move(S^, D^, i);
Inc(D, i);
SetLength(Dest, PByte(D) - PByte(Dest));
end;
class procedure TFormat_Radix64.SetCharsPerLine(const Value: UInt32);
begin
Assert(Value > 0, 'Invalid number of chars per line: ' + IntToStr(Value));
if (Value > 0) then
FCharsPerLine := Value
else
raise EArgumentOutOfRangeException.Create('Invalid number of chars per line: ' +
IntToStr(Value));
end;
class procedure TFormat_Radix64.DoEncode(const Source; var Dest: TBytes; Size: Integer);
var
TempData : TBytes;
CRC : UInt32;
CRCData : TBytes;
Position : Integer;
begin
SetLength(Dest, 0);
if Size <= 0 then
Exit;
// use Base64
inherited DoEncode(Source, TempData, Size);
// split lines
InsertCRLF(TempData, Dest, FCharsPerLine);
SetLength(TempData, 0);
CRC := CRCCalc(CRC_24, Source, Size); // calculate 24-bit Checksum
SwapBytes(CRC, 3); // PGP use Big Endian
// check and insert LF if needed
Position := Length(Dest) - 1; // last char
if Dest[Position] <> $0A then
begin
// insert CR needed, CRC must be in the next line
Position := Length(Dest);
SetLength(Dest, Position + 2);
Dest[Position] := $0D; // append CR
Dest[Position+1] := $0A; // append LF
end;
// encode CRC with Base64 too
inherited DoEncode(CRC, CRCData, 3);
// if CRC is too long insert CRLF. -1 to compensate the later added = char
InsertCRLF(CRCData, TempData, FCharsPerLine - 1);
CRCData := TempData;
// append encoded CRC
Position := Length(Dest);
SetLength(Dest, Position + 1 + Length(CRCData));
Dest[Position] := Ord('=');
Move(CRCData[0], Dest[Position + 1], Length(CRCData));
end;
class procedure TFormat_Radix64.DoDecode(const Source; var Dest: TBytes; Size: Integer);
var
CRC: UInt32;
begin
SetLength(Dest, 0);
if Size <= 0 then
Exit;
CRC := DoExtractCRC(Source, Size);
inherited DoDecode(Source, Dest, Size);
if CRC <> $FFFFFFFF then // check CRC if found
begin
SwapBytes(CRC, 3);
if CRC <> CRCCalc(CRC_24, Dest[0], Length(Dest)) then
raise EDECFormatException.CreateResFmt(@sInvalidStringFormat, [self.GetShortClassName]);
end;
end;
class function TFormat_UU.CharTableBinary: TBytes;
begin
// '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_' +
// ' '+CHR(9)+CHR(10)+CHR(13);
SetLength(result, 68);
{$IF CompilerVersion >= 28.0}
result := [$60, $21, $22, $23, $24, $25, $26, $27, $28, $29, $2A, $2B, $2C,
$2D, $2E, $2F, $30, $31, $32, $33, $34, $35, $36, $37, $38, $39,
$3A, $3B, $3C, $3D, $3E, $3F, $40, $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, $5B, $5C, $5D, $5E, $5F, $20,
$09, $0A, $0D];
{$ELSE}
// Remove this initialisation variant as soon as XE7+ is the new minimum
// supported Delphi version
result[ 0]:=$60;
result[ 1]:=$21;
result[ 2]:=$22;
result[ 3]:=$23;
result[ 4]:=$24;
result[ 5]:=$25;
result[ 6]:=$26;
result[ 7]:=$27;
result[ 8]:=$28;
result[ 9]:=$29;
result[10]:=$2A;
result[11]:=$2B;
result[12]:=$2C;
result[13]:=$2D;
result[14]:=$2E;
result[15]:=$2F;
result[16]:=$30;
result[17]:=$31;
result[18]:=$32;
result[19]:=$33;
result[20]:=$34;
result[21]:=$35;
result[22]:=$36;
result[23]:=$37;
result[24]:=$38;
result[25]:=$39;
result[26]:=$3A;
result[27]:=$3B;
result[28]:=$3C;
result[29]:=$3D;
result[30]:=$3E;
result[31]:=$3F;
result[32]:=$40;
result[33]:=$41;
result[34]:=$42;
result[35]:=$43;
result[36]:=$44;
result[37]:=$45;
result[38]:=$46;
result[39]:=$47;
result[40]:=$48;
result[41]:=$49;
result[42]:=$4A;
result[43]:=$4B;
result[44]:=$4C;
result[45]:=$4D;
result[46]:=$4E;
result[47]:=$4F;
result[48]:=$50;
result[49]:=$51;
result[50]:=$52;
result[51]:=$53;
result[52]:=$54;
result[53]:=$55;
result[54]:=$56;
result[55]:=$57;
result[56]:=$58;
result[57]:=$59;
result[58]:=$5A;
result[59]:=$5B;
result[60]:=$5C;
result[61]:=$5D;
result[62]:=$5E;
result[63]:=$5F;
result[64]:=$20;
result[65]:=$09;
result[66]:=$0A;
result[67]:=$0D;
{$IFEND}
end;
class procedure TFormat_UU.DoEncode(const Source; var Dest: TBytes; Size: Integer);
var
T: TBytes;
S: PByte;
D: PByte; // 1) to make pointer arithmetic work 2) P/TByteArray is limited to 32768 bytes
L, i: Integer;
B: Cardinal;
begin
SetLength(Dest, 0);
if Size <= 0 then
Exit;
SetLength(Dest, Size * 4 div 3 + Size div 45 + 10);
T := CharTableBinary;
S := @Source;
D := @Dest[0];
while Size > 0 do
begin
L := Size;
if L > 45 then
L := 45;
Dec(Size, L);
D^ := T[L];
while L > 0 do
begin
B := 0;
for i := 0 to 2 do
begin
B := B shl 8;
if L > 0 then
begin
B := B or S^;
Inc(S);
end;
Dec(L);
end;
for i := 4 downto 1 do
begin
D[i] := T[B and $3F];
B := B shr 6;
end;
Inc(D, 4);
end;
Inc(D);
end;
SetLength(Dest, PByte(D) - PByte(Dest));
end;
class procedure TFormat_UU.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
i, E: Integer;
B: UInt32;
begin
SetLength(Dest, 0);
if Size <= 0 then
Exit;
SetLength(Dest, Size);
T := CharTableBinary;
S := @Source;
D := @Dest[0];
L := PByte(S) + Size;
repeat
Size := TableFindBinary(S^, T, 64);
if (Size < 0) or (Size > 45) then
raise EDECException.CreateResFmt(@sInvalidStringFormat, [self.GetShortClassName]);
Inc(S);
while Size > 0 do
begin
B := 0;
i := 4;
while (i > 0) and (S <= L) do
begin
E := TableFindBinary(S^, T, 64);
if E >= 0 then
begin
B := B shl 6 or Byte(E);
Dec(i);
end;
Inc(S);
end;
i := 2;
repeat
D[i] := Byte(B);
B := B shr 8;
Dec(i);
until i < 0;
if Size > 3 then
Inc(D, 3)
else
Inc(D, Size);
Dec(Size, 3);
end;
until S >= L;
SetLength(Dest, PByte(D) - PByte(Dest));
end;
class function TFormat_UU.DoIsValid(const Data; Size: Integer): Boolean;
var
T: TBytes;
S: PByte;
Len, P, i: Integer;
begin
Result := False;
T := CharTableBinary;
Len := Length(T);
S := @Data;
P := 0;
while Size > 0 do
begin
i := TableFindBinary(S^, T, Len);
if i >= 0 then
begin
Dec(Size);
Inc(S);
if P = 0 then
begin
if i > 45 then
Exit;
P := (i * 4 + 2) div 3;
end
else
if i < 64 then
Dec(P);
end
else
Exit;
end;
if P <> 0 then
Exit;
Result := True;
end;
class function TFormat_XX.CharTableBinary: TBytes;
begin
// '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' +
// ' "()[]'''+CHR(9)+CHR(10)+CHR(13);
SetLength(result, 74);
{$IF CompilerVersion >= 28.0}
result := [$2B, $2D, $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $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, $20,
$22, $28, $29, $5B, $5D, $27, $09, $0A, $0D];
{$ELSE}
// Remove this initialisation variant as soon as XE7+ is the new minimum
// supported Delphi version
result[ 0]:=$2B;
result[ 1]:=$2D;
result[ 2]:=$30;
result[ 3]:=$31;
result[ 4]:=$32;
result[ 5]:=$33;
result[ 6]:=$34;
result[ 7]:=$35;
result[ 8]:=$36;
result[ 9]:=$37;
result[10]:=$38;
result[11]:=$39;
result[12]:=$41;
result[13]:=$42;
result[14]:=$43;
result[15]:=$44;
result[16]:=$45;
result[17]:=$46;
result[18]:=$47;
result[19]:=$48;
result[20]:=$49;
result[21]:=$4A;
result[22]:=$4B;
result[23]:=$4C;
result[24]:=$4D;
result[25]:=$4E;
result[26]:=$4F;
result[27]:=$50;
result[28]:=$51;
result[29]:=$52;
result[30]:=$53;
result[31]:=$54;
result[32]:=$55;
result[33]:=$56;
result[34]:=$57;
result[35]:=$58;
result[36]:=$59;
result[37]:=$5A;
result[38]:=$61;
result[39]:=$62;
result[40]:=$63;
result[41]:=$64;
result[42]:=$65;
result[43]:=$66;
result[44]:=$67;
result[45]:=$68;
result[46]:=$69;
result[47]:=$6A;
result[48]:=$6B;
result[49]:=$6C;
result[50]:=$6D;
result[51]:=$6E;
result[52]:=$6F;
result[53]:=$70;
result[54]:=$71;
result[55]:=$72;
result[56]:=$73;
result[57]:=$74;
result[58]:=$75;
result[59]:=$76;
result[60]:=$77;
result[61]:=$78;
result[62]:=$79;
result[63]:=$7A;
result[64]:=$20;
result[65]:=$22;
result[66]:=$28;
result[67]:=$29;
result[68]:=$5B;
result[69]:=$5D;
result[70]:=$27;
result[71]:=$09;
result[72]:=$0A;
result[73]:=$0D;
{$IFEND}
end;
var
// Initlialized in initialization section, cannot be const because of the
// TBytes requirement
ESCAPE_CodesL: TBytes; //array[0..6] of Byte = ($61, $62, $74, $6E, $76, $66, $72);
ESCAPE_CodesU: TBytes; //array[0..6] of Byte = ($41, $42, $54, $4E, $56, $46, $52);
class function TFormat_ESCAPE.CharTableBinary: TBytes;
begin
Result := TFormat_HEX.CharTableBinary;
end;
class procedure TFormat_ESCAPE.DoEncode(const Source; var Dest: TBytes; Size: Integer);
var
T: TBytes;
S: PByte;
D: PByte; // 1) to make pointer arithmetic work 2) P/TByteArray is limited to 32768 bytes
i: Integer;
begin
SetLength(Dest, 0);
if Size <= 0 then
Exit;
SetLength(Dest, Size + 8);
T := CharTableBinary;
S := @Source;
D := @Dest[0];
i := Size;
while Size > 0 do
begin
if i <= 0 then
begin
i := D - PByte(Dest);
SetLength(Dest, i + Size + 8);
D := PByte(Dest) + i;
i := Size;
end;
if (S^ < 32) or (S^ > $7F) then
begin
if (S^ >= 7) and (S^ <= 13) then
begin
D^ := $5C; // \ char
Inc(D);
D^ := ESCAPE_CodesL[S^ - 7];
Inc(D);
Dec(i, 2);
end
else
begin
D^ := $5C; // \ char
Inc(D);
D^ := $78; // x
Inc(D);
D^ := T[S^ shr 4];
Inc(D);
D^ := T[S^ and $F];
Inc(D);
Dec(i, 4);
end
end
else
begin
// S^is \ char?
if S^ = $5C then
begin
D^ := $5C; // \ char
Inc(D);
D^ := $5C; // \ char
Inc(D);
Dec(i, 2);
end
else
// S^ is " char?
if S^ = $22 then
begin
D^ := $5C; // \ char
Inc(D);
D^ := $22; // " char
Inc(D);
Dec(i, 2);
end
else
begin
D^ := S^;
Inc(D);
Dec(i);
end;
end;
Dec(Size);
Inc(S);
end;
SetLength(Dest, PByte(D) - PByte(Dest));
end;
class function TFormat_ESCAPE.DoIsValid(const Data; Size: Integer): Boolean;
var
T: TBytes;
S: PByte;
begin
Result := False;
T := CharTableBinary;
S := @Data;
while Size > 0 do
begin
if (S^ > $7F) or (S^ < 32) then
Exit;
// start of an escape sequence
if S^ = $5C then
begin
Dec(Size);
Inc(S);
// \ at the end
if Size <= 0 then
Exit;
// X for hex notation
if UpCaseBinary(S^) = $58 then
begin
Inc(S);
Dec(Size);
// incomplete hex notation follows?
if (Size < 2) or (TableFindBinary(UpCaseBinary(S^), T, 16) < 0) then
Exit;
Inc(S);
Dec(Size);
if (TableFindBinary(UpCaseBinary(S^), T, 16) < 0) then
Exit;
Inc(S);
Dec(Size);
end
else
begin
// \ with invalid following char?
if TableFindBinary(UpCaseBinary(S^), TBytes(ESCAPE_CodesU), 7) < 0 then
Exit;
Dec(Size);
Inc(S);
end;
end
else
begin
Dec(Size);
Inc(S);
end;
end;
Result := True;
end;
class procedure TFormat_ESCAPE.DoDecode(const Source; var Dest: TBytes; Size: Integer);
var
T: TBytes;
S: PByte; // 1) to make pointer arithmetic work 2) P/TByteArray is limited to 32768 bytes
D: PByte;
L: PByte; // 1) to make pointer arithmetic work 2) P/TByteArray is limited to 32768 bytes
i: Integer;
begin
if Size <= 0 then
Exit;
SetLength(Dest, Size);
T := CharTableBinary;
S := @Source;
D := @Dest[0];
L := S + Size;
while S < L do
begin
// S^ is \ char?
if S^ = $5C then
begin
Inc(S);
if S > L then Break;
// S^ is X char?
if UpCaseBinary(S^) = $58 then
begin
if S + 2 > L then
raise EDECFormatException.CreateResFmt(@sInvalidStringFormat, [self.GetShortClassName]);
Inc(S);
i := TableFindBinary(UpCaseBinary(S^), T, 16);
if i < 0 then
raise EDECFormatException.CreateResFmt(@sInvalidStringFormat, [self.GetShortClassName]);
D^ := i shl 4;
Inc(S);
i := TableFindBinary(UpCaseBinary(S^), T, 16);
if i < 0 then
raise EDECFormatException.CreateResFmt(@sInvalidStringFormat, [self.GetShortClassName]);
D^ := D^ or i;
end
else
begin
i := TableFindBinary(UpCaseBinary(S^), TBytes(ESCAPE_CodesU), 7);
if i >= 0 then
D^ := i + 7
else
D^ := S^;
end;
end
else
D^ := S^;
Inc(D);
Inc(S);
end;
SetLength(Dest, PByte(D) - PByte(Dest));
end;
{ TFormat_BigEndian16 }
class procedure TFormat_BigEndian16.DoDecode(const Source; var Dest: TBytes;
Size: Integer);
begin
DoSawp(Source, Dest, Size);
end;
class procedure TFormat_BigEndian16.DoEncode(const Source; var Dest: TBytes;
Size: Integer);
begin
DoSawp(Source, Dest, Size);
end;
class function TFormat_BigEndian16.DoIsValid(const Data;
Size: Integer): Boolean;
begin
// swapping bytes in 16 bit mode requires even number of bytes
result := not Odd(Size);
end;
class procedure TFormat_BigEndian16.DoSawp(const Source; var Dest: TBytes;
Size: Integer);
var
i : Integer;
begin
if (Size < 0) or Odd(Size) then
Exit;
SetLength(Dest, Size);
if (Size > 0) then
begin
Move(Source, Dest[0], Size);
i := 0;
while (i < length(Dest)) do
begin
DECUtil.SwapBytes(Dest[i], 2);
inc(i, 2);
end;
end;
end;
{ TFormat_BigEndian32 }
class procedure TFormat_BigEndian32.DoDecode(const Source; var Dest: TBytes;
Size: Integer);
begin
DoSawp(Source, Dest, Size);
end;
class procedure TFormat_BigEndian32.DoEncode(const Source; var Dest: TBytes;
Size: Integer);
begin
DoSawp(Source, Dest, Size);
end;
class function TFormat_BigEndian32.DoIsValid(const Data;
Size: Integer): Boolean;
begin
result := (Size mod 4) = 0;
end;
class procedure TFormat_BigEndian32.DoSawp(const Source; var Dest: TBytes;
Size: Integer);
var
i : Integer;
SwapRes : UInt32;
begin
if (Size < 0) or ((Size mod 4) <> 0) then
Exit;
SetLength(Dest, Size);
if (Size > 0) then
begin
Move(Source, Dest[0], Size);
i := 0;
while (i < length(Dest)) do
begin
Move(Dest[i], SwapRes, 4);
SwapRes := DECUtil.SwapUInt32(SwapRes);
Move(SwapRes, Dest[i], 4);
inc(i, 4);
end;
end;
end;
{ TFormat_BigEndian64 }
class procedure TFormat_BigEndian64.DoDecode(const Source; var Dest: TBytes;
Size: Integer);
begin
DoSawp(Source, Dest, Size);
end;
class procedure TFormat_BigEndian64.DoEncode(const Source; var Dest: TBytes;
Size: Integer);
begin
DoSawp(Source, Dest, Size);
end;
class function TFormat_BigEndian64.DoIsValid(const Data;
Size: Integer): Boolean;
begin
result := (Size mod 8) = 0;
end;
class procedure TFormat_BigEndian64.DoSawp(const Source; var Dest: TBytes;
Size: Integer);
var
i : Integer;
SwapRes : Int64;
begin
if (Size < 0) or ((Size mod 8) <> 0) then
Exit;
SetLength(Dest, Size);
if (Size > 0) then
begin
Move(Source, Dest[0], Size);
i := 0;
while (i < length(Dest)) do
begin
Move(Dest[i], SwapRes, 8);
SwapRes := DECUtil.SwapInt64(SwapRes);
Move(SwapRes, Dest[i], 8);
inc(i, 8);
end;
end;
end;
initialization
SetLength(ESCAPE_CodesL, 7);
ESCAPE_CodesL[0] := $61;
ESCAPE_CodesL[1] := $62;
ESCAPE_CodesL[2] := $74;
ESCAPE_CodesL[3] := $6E;
ESCAPE_CodesL[4] := $76;
ESCAPE_CodesL[5] := $66;
ESCAPE_CodesL[6] := $72;
SetLength(ESCAPE_CodesU, 7);
ESCAPE_CodesU[0] := $41;
ESCAPE_CodesU[1] := $42;
ESCAPE_CodesU[2] := $54;
ESCAPE_CodesU[3] := $4E;
ESCAPE_CodesU[4] := $56;
ESCAPE_CodesU[5] := $46;
ESCAPE_CodesU[6] := $52;
{$IFNDEF ManualRegisterClasses}
TFormat_HEX.RegisterClass(TDECFormat.ClassList);
TFormat_HEXL.RegisterClass(TDECFormat.ClassList);
TFormat_DECMIME32.RegisterClass(TDECFormat.ClassList);
TFormat_Base64.RegisterClass(TDECFormat.ClassList);
TFormat_Radix64.RegisterClass(TDECFormat.ClassList);
TFormat_UU.RegisterClass(TDECFormat.ClassList);
TFormat_XX.RegisterClass(TDECFormat.ClassList);
TFormat_ESCAPE.RegisterClass(TDECFormat.ClassList);
TFormat_BigEndian16.RegisterClass(TDECFormat.ClassList);
TFormat_BigEndian32.RegisterClass(TDECFormat.ClassList);
TFormat_BigEndian64.RegisterClass(TDECFormat.ClassList);
{$ENDIF}
// Init the number of chars per line as per RFC 4880 to 76 chars
TFormat_Radix64.FCharsPerLine := 76;
finalization
end.
Reference in New Issue View Git Blame Copy Permalink