unit UEncoding;

{$MODE Delphi}

SysUtils,

TypInfo,

uregexpr,

UCommon,

UCrypto;

{ TCustomRegex }

TCustomRegex = class sealed(TObject)

var

FRegex: TRegExpr;

public

constructor Create(const ARegexExpression: String);

destructor Destroy(); override;

function IsMatch(const AInputString: String): Boolean;

function GetMatchFromName(const AGroupName: String): String;

function Value(): String;

procedure Match(const AInputString: String);

end;

{ TPascalAsciiEncoding }

TPascalAsciiEncoding = class sealed(TObject)

strict private

class var FEscapedStringRegex: TCustomRegex;

class constructor CreatePascalAsciiEncoding();

class destructor DestroyPascalAsciiEncoding();

public

const

EscapeChar: Char = '\';

CharSet = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~';

CharSetEscaped = '"():<>[\]{}';

CharSetUnescaped = ' !#$%&''*+,-./0123456789;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`abcdefghijklmnopqrstuvwxyz|~';

CharPattern = '( |!|\\"|#|\$|%|&|''|\\\(|\\\)|\*|\+|,|-|\.|/|0|1|2|3|4|5|6|7|8|9|\\:|;|\\<|=|\\>|\?|@|A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z|\\\[|\\\\|\\]|\^|_|`|a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|\\\{|\||\\\}|~)';

StringPattern = CharPattern + '+';

class function IsValidEscaped(const ASafeAnsiString: String) : Boolean; static;

class function IsValidUnescaped(const AUnescapedPascalAsciiString: String) : Boolean; static;

class function Escape(const APascalAsciiString: String): String; static;

class function Unescape(const APascalAsciiString: String): String; static;

end;

{ TPascal64Encoding }

TPascal64Encoding = class sealed(TObject)

strict private

class var FEscapedRegex: TCustomRegex;

class constructor CreatePascal64Encoding();

class destructor DestroyPascal64Encoding();

public

const

EscapeChar: Char = '\';

CharSet = 'abcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-+{}[]_:"`|<>,.?/~';

CharSetStart = 'abcdefghijklmnopqrstuvwxyz!@#$%^&*()-+{}[]_:"`|<>,.?/~';

CharSetEscaped = '(){}[]:"<>';

CharSetUnescaped = 'abcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*-+_`|,.?/~';

StartCharPattern = '(a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|!|@|#|\$|%|\^|&|\*|\\\(|\\\)|-|\+|\\\{|\\\}|\\\[|\\]|_|\\:|\\"|`|\||\\<|\\>|,|\.|\?|/|~)';

NextCharPattern = '(a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|0|1|2|3|4|5|6|7|8|9|!|@|#|\$|%|\^|&|\*|\\\(|\\\)|-|\+|\\\{|\\\}|\\\[|\\]|_|\\:|\\"|`|\||\\<|\\>|,|\.|\?|/|~)';

StringPattern = StartCharPattern + NextCharPattern + '*';

StringOnlyPattern = StringPattern + '$';

class function IsValidEscaped(const AEscapedPascal64String: String) : Boolean; static;

class function IsValidUnescaped(const AUnescapedPascal64String: String) : Boolean; static;

class function Escape(const APascal64String: String): String; static;

class function Unescape(const APascal64String: String): String; static;

end;

{ THexEncoding }

THexEncoding = class sealed(TObject)

private

class var FHexStringRegex: TCustomRegex;

class constructor CreateHexEncoding();

class destructor DestroyHexEncoding();

public

const

CharSet = '0123456789abcdef';

NibblePattern = '[0-9a-fA-F]';

BytePattern = NibblePattern + '{2}';

SubStringPattern = '(?:' + BytePattern + ')+';

StringPattern = SubStringPattern + '$';

class function IsValid(const AHexString: String): Boolean; static;

class function Decode(const AHexString: String): TArray<Byte>; static;

class function TryDecode(const AHexString: String; out AResult: TArray<Byte>): Boolean; static;

class function Encode(const ABytes: TArray<Byte>; AOmitPrefix: Boolean = True): String; static;

end;

{ TPascalBase58Encoding }

TPascalBase58Encoding = class sealed(TObject)

private

class var FStringRegex: TCustomRegex;

class constructor CreatePascalBase58Encoding();

class destructor DestroyPascalBase58Encoding();

public

const

CharSet = '123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz';

CharPattern = '[123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz]';

SubStringPattern = CharPattern + '+';

StringPattern = SubStringPattern + '$';

class function IsValid(const ABase58String: String): Boolean; static;

class function Decode(const ABase58String: String): TArray<Byte>; static;

class function TryDecode(const ABase58String: String; out AResult: TArray<Byte>): Boolean; static;

class function Encode(const ABytes: TArray<Byte>): String; static;

end;

{ TPASCEncoding }

TPASCEncoding = class sealed(TObject)

public

class function IsValid(const APasc: String): Boolean; static;

class function Decode(const APasc: String): Int64; static;

class function TryDecode(const APasc: String; out AMolinas: Int64) : Boolean; static;

class function Encode(const AMolinas: Int64): String; static;

end;

{ TStringExtensions }

TStringExtensions = class sealed(TObject)

public

class function Escape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray<Char>): String; static;

class function Unescape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray<Char>): String; static;

class function All(const ANeedle: String; const AStack: String) : Boolean; static;

end;

resourcestring

SUnknownPayloadEncoding = 'Unknown payload encoding.';

SInvalidEPasaFormat = 'Invalid E-PASA format, %s';

SInvalidEPasa = 'Invalid EPASA "%s": %s';

SInvalidHexString = 'Invalid hex-formatted string, %s';

SInvalidBase58String = 'Invalid Base58-formatted string, %s';

SBase58EncodeError = 'Error Encoding to Base58';

SUnRecognizedStartCharacter = 'Unrecognized start character, %s';

SInvalidPASCQuantity = 'Invalid PASC quantity string, %s';

HlpHashFactory,

HlpIHashInfo,

HlpConverters,

UJSONFunctions;

constructor TCustomRegex.Create(const ARegexExpression: String);

inherited Create();

FRegex := TRegExpr.Create(ARegexExpression);

end;

destructor TCustomRegex.Destroy;

FRegex.Free;

inherited Destroy;

end;

function TCustomRegex.GetMatchFromName(const AGroupName: String): String;

i: Int32;

Result := #0;

// carefull: E:\SourceCode\PascalCoin-master\src\libraries\regex must be added to project file

// otherwise wrong unit will be used from:

// Drive:\Tools\Lazarus\fpc\3.2.0\source\packages\regexpr\src

i := FRegex.MatchIndexFromName(AGroupName);

if i >= 0 then begin

Result := FRegex.Match[i];

end;

end;

function TCustomRegex.IsMatch(const AInputString: String): Boolean;

Result := FRegex.Exec(AInputString);

end;

procedure TCustomRegex.Match(const AInputString: String);

FRegex.Exec(AInputString);

end;

function TCustomRegex.Value: String;

Result := FRegex.Match[0];

end;

class function TPascalAsciiEncoding.IsValidEscaped(const ASafeAnsiString : String): Boolean;

Result := FEscapedStringRegex.IsMatch(ASafeAnsiString);

end;

class function TPascalAsciiEncoding.IsValidUnescaped (const AUnescapedPascalAsciiString: String): Boolean;

Result := TStringExtensions.All(AUnescapedPascalAsciiString, CharSet);

end;

class function TPascalAsciiEncoding.Escape(const APascalAsciiString : String): String;

Result := TStringExtensions.Escape(APascalAsciiString, EscapeChar, CharSetEscaped.ToCharArray);

end;

class function TPascalAsciiEncoding.Unescape(const APascalAsciiString : String): String;

Result := TStringExtensions.Unescape(APascalAsciiString, EscapeChar, CharSetEscaped.ToCharArray);

end;

class constructor TPascalAsciiEncoding.CreatePascalAsciiEncoding;

FEscapedStringRegex := TCustomRegex.Create(StringPattern);

end;

class destructor TPascalAsciiEncoding.DestroyPascalAsciiEncoding;

FEscapedStringRegex.Free;

end;

class function TPascal64Encoding.IsValidEscaped(const AEscapedPascal64String : String): Boolean;

Result := FEscapedRegex.IsMatch(AEscapedPascal64String);

end;

class function TPascal64Encoding.IsValidUnescaped(const AUnescapedPascal64String : String): Boolean;

Result := (3 <= AUnescapedPascal64String.Length) and

(AUnescapedPascal64String.Length <= 64) and

(StartCharPattern.Contains(AUnescapedPascal64String[1])) and

(TStringExtensions.All(AUnescapedPascal64String, CharSet));

end;

class function TPascal64Encoding.Escape(const APascal64String: String): String;

Result := TStringExtensions.Escape(APascal64String, EscapeChar,

CharSetEscaped.ToCharArray);

end;

class function TPascal64Encoding.Unescape(const APascal64String : String): String;

Result := TStringExtensions.Unescape(APascal64String, EscapeChar,

CharSetEscaped.ToCharArray);

end;

class constructor TPascal64Encoding.CreatePascal64Encoding;

FEscapedRegex := TCustomRegex.Create(StringOnlyPattern);

end;

class destructor TPascal64Encoding.DestroyPascal64Encoding;

FEscapedRegex.Free;

end;

class function THexEncoding.IsValid(const AHexString: String): Boolean;

Result := FHexStringRegex.IsMatch(AHexString);

end;

class function THexEncoding.Decode(const AHexString: String): TArray<Byte>;

if (not TryDecode(AHexString, Result)) then

raise EArgumentException.CreateResFmt(@SInvalidHexString, ['AHexString']);

end;

class function THexEncoding.TryDecode(const AHexString: String; out AResult: TArray<Byte>): Boolean;

AResult := Nil;

if (not IsValid(AHexString)) then

Exit(False);

Result := TryHex2Bytes(AHexString, AResult);

end;

class function THexEncoding.Encode(const ABytes: TArray<Byte>; AOmitPrefix: Boolean): String;

Result := Bytes2Hex(ABytes, not AOmitPrefix).ToLowerInvariant;

end;

class constructor THexEncoding.CreateHexEncoding;

FHexStringRegex := TCustomRegex.Create(StringPattern);

end;

class destructor THexEncoding.DestroyHexEncoding;

FHexStringRegex.Free;

end;

class function TPascalBase58Encoding.IsValid(const ABase58String : String): Boolean;

Result := FStringRegex.IsMatch(ABase58String);

end;

class function TPascalBase58Encoding.Decode(const ABase58String: String) : TArray<Byte>;

if (not TryDecode(ABase58String, Result)) then

raise EArgumentException.CreateResFmt(@SInvalidBase58String, ['ABase58String']);

end;

class function TPascalBase58Encoding.TryDecode(const ABase58String: String; out AResult: TArray<Byte>): Boolean;

LBN, LBNAux, LBNBase: TBigNum;

i, LOffset: Int32;

Result := False;

LBN := TBigNum.Create(0);

LBNAux := TBigNum.Create;

LBNBase := TBigNum.Create(1);

try

for i := ABase58String.Length downto 1 do begin

LOffset := System.Pos(ABase58String[i], CharSet) - 1;

if LOffset < 0 then begin

Exit(False);

end;

LBNAux.Value := LOffset;

LBNAux.Multiply(LBNBase);

LBN.Add(LBNAux);

LBNBase.Multiply(CharSet.Length);

end;

AResult := THexEncoding.Decode(LBN.HexaValue);

finally

LBN.Free;

LBNAux.Free;

LBNBase.Free;

end;

TArrayTool<Byte>.RemoveAt(AResult, 0);

Result := True;

end;

class function TPascalBase58Encoding.Encode(const ABytes: TArray<Byte>): String;

LBN, LBNMod, LBNDiv: TBigNum;

Result := string.Empty;

LBN := TBigNum.Create;

LBNMod := TBigNum.Create;

LBNDiv := TBigNum.Create(CharSet.Length);

try

LBN.HexaValue := '01' + THexEncoding.Encode(ABytes);

while (not LBN.IsZero) do begin

LBN.Divide(LBNDiv, LBNMod);

If (LBNMod.Value >= 0) and (LBNMod.Value < CharSet.Length) then begin

Result := CharSet[Byte(LBNMod.Value) + 1] + Result;

end else begin

raise Exception.CreateRes(@SBase58EncodeError);

end;

end;

finally

LBN.Free;

LBNMod.Free;

LBNDiv.Free;

end;

end;

class constructor TPascalBase58Encoding.CreatePascalBase58Encoding;

FStringRegex := TCustomRegex.Create(StringPattern);

end;

class destructor TPascalBase58Encoding.DestroyPascalBase58Encoding;

FStringRegex.Free;

end;

class function TPASCEncoding.IsValid(const APasc: String): Boolean;

temp: Int64;

Result := TryDecode(APasc, temp);

end;

class function TPASCEncoding.Decode(const APasc: String): Int64;

if (not TryDecode(APasc, Result)) then

begin

raise EArgumentException.CreateResFmt(@SInvalidPASCQuantity, ['APasc']);

end;

end;

class function TPASCEncoding.TryDecode(const APasc: String; out AMolinas: Int64): Boolean; var s : String;

LPosThousand, LPosDecimal : Integer;

LMoneyString : String;

AMolinas := 0;

LMoneyString := Trim(APasc);

if LMoneyString.Length=0 then begin

Result := true;

exit;

end;

try

LPosThousand := LMoneyString.IndexOf( TPCJSONData.JSONFormatSettings.ThousandSeparator );

LPosDecimal := LMoneyString.IndexOf( TPCJSONData.JSONFormatSettings.DecimalSeparator );

if (LPosThousand>0) then begin

if (LPosThousand < LPosDecimal ) then begin

// Remove thousand values

LMoneyString := LMoneyString.Replace(String(TPCJSONData.JSONFormatSettings.ThousandSeparator),'',[rfReplaceAll]);

end else begin

// Possible 15.123.456,7890 format ( coma (,) = decimal separator )

// Remove decimal "." and convert thousand to decimal

LMoneyString := LMoneyString.Replace(String(TPCJSONData.JSONFormatSettings.DecimalSeparator),'',[rfReplaceAll]);

LMoneyString := LMoneyString.Replace(TPCJSONData.JSONFormatSettings.ThousandSeparator,TPCJSONData.JSONFormatSettings.DecimalSeparator,[rfReplaceAll]);

end;

end;

AMolinas := Round( StrToFloat(LMoneyString,TPCJSONData.JSONFormatSettings)*10000 );

Result := true;

Except

result := false;

end;

end;

class function TPASCEncoding.Encode(const AMolinas: Int64): String;

Result := FormatFloat('#,###0.0000',(AMolinas/10000.0), TPCJSONData.JSONFormatSettings);

end;

class function TStringExtensions.Escape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray<Char>): String;

LPPtr: PChar;

LPeek, LNext: Char;

Result := String.Empty;

LPPtr := PChar(AStr);

while LPPtr^ <> #0 do

begin

LPeek := LPPtr^;

if LPeek = AEscapeSymbol then

begin

Result := Result + LPPtr^; // append escape symbol

System.Inc(LPPtr);

LNext := LPPtr^;

if LNext = #0 then

begin

// end of string, last char was escape symbol

if (TArrayTool<Char>.Contains(AEscapedChars, AEscapeSymbol)) then

begin

// need to escape it

Result := Result + AEscapeSymbol;

end;

end

else if (TArrayTool<Char>.Contains(AEscapedChars, LNext)) then

begin

// is an escape sequence, append next char

Result := Result + LPPtr^;

System.Inc(LPPtr);

end

else

begin

// is an invalid escape sequence

if (TArrayTool<Char>.Contains(AEscapedChars, AEscapeSymbol)) then

begin

// need to escape symbol, since it's an escaped char

Result := Result + AEscapeSymbol;

end;

end;

end

else if (TArrayTool<Char>.Contains(AEscapedChars, LPeek)) then

begin

// char needs escaping

Result := Result + AEscapeSymbol + LPPtr^;

System.Inc(LPPtr);

end

else

begin

// normal char

Result := Result + LPPtr^;

System.Inc(LPPtr);

end;

end;

end;

class function TStringExtensions.Unescape(const AStr: String; AEscapeSymbol: Char; const AEscapedChars: TArray<Char>): String;

LPPtr: PChar;

LPeek: Char;

Result := String.Empty;

LPPtr := PChar(AStr);

while LPPtr^ <> #0 do

begin

LPeek := LPPtr^;

if LPeek = AEscapeSymbol then begin

System.Inc(LPPtr); // omit the escape symbol

LPeek := LPPtr^;

if LPeek = #0 then begin

// last character was the escape symbol, so include it

Result := Result + AEscapeSymbol;

break;

end;

if (not(TArrayTool<Char>.Contains(AEscapedChars, LPeek))) then begin

// was not an escaped char, so include the escape symbol

Result := Result + AEscapeSymbol;

continue;

end;

end;

// include the char (or escaped char)

Result := Result + LPPtr^;

System.Inc(LPPtr);

end;

end;

class function TStringExtensions.All(const ANeedle: String; const AStack: String): Boolean;

c: Char;

Result := True;

for c in ANeedle do

begin

if not AStack.Contains(c) then

Exit(False);

end;

end;

end.