include "chartype.s7i";
include "bytedata.s7i";
const func string: toBase64 (in string: byteStri) is func
result
var string: base64 is "";
local
const string: coding is "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
var integer: index is 1;
var integer: subIndex is 1;
var char: ch is ' ';
var integer: threeBytes is 0;
var string: fourBytes is " ";
var integer: posToAddNewline is 58;
begin
for index range 1 to length(byteStri) step 3 do
threeBytes := 0;
for subIndex range index to index + 2 do
threeBytes <<:= 8;
if subIndex <= length(byteStri) then
ch := byteStri[subIndex];
if ch >= '\256;' then
raise RANGE_ERROR;
end if;
threeBytes +:= ord(ch);
end if;
end for;
fourBytes @:= [1] coding[succ( threeBytes >> 18)];
fourBytes @:= [2] coding[succ((threeBytes >> 12) mod 64)];
fourBytes @:= [3] coding[succ((threeBytes >> 6) mod 64)];
fourBytes @:= [4] coding[succ( threeBytes mod 64)];
if index = posToAddNewline then
base64 &:= "\n";
posToAddNewline +:= 57;
end if;
base64 &:= fourBytes;
end for;
index := length(base64);
if length(byteStri) rem 3 = 2 then
base64 @:= [index] '=';
elsif length(byteStri) rem 3 = 1 then
base64 @:= [pred(index)] "==";
end if;
end func;
const func string: fromBase64 (in string: base64) is func
result
var string: decoded is "";
local
const array integer: decode is [] (
62, -1, -1, -1, 63,
52, 53, 54, 55, 56, 57, 58, 59, 60, 61,
-1, -1, -1, 0, -1, -1, -1,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
-1, -1, -1, -1, -1, -1,
26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51);
var integer: index is 1;
var integer: subIndex is 1;
var integer: number is 0;
var integer: fourBytes is 0;
var string: threeBytes is " ";
begin
while index <= length(base64) - 3 do
if base64[index] >= '+' then
fourBytes := 0;
for subIndex range index to index + 3 do
number := decode[ord(base64[subIndex]) - ord(pred('+'))];
if number = -1 then
raise RANGE_ERROR;
end if;
fourBytes := (fourBytes << 6) + number;
end for;
threeBytes @:= [1] chr( fourBytes >> 16);
threeBytes @:= [2] chr((fourBytes >> 8) mod 256);
threeBytes @:= [3] chr( fourBytes mod 256);
decoded &:= threeBytes;
index +:= 4;
elsif base64[index] = '\n' or base64[index] = '\r' then
incr(index);
else
raise RANGE_ERROR;
end if;
end while;
if index <> succ(length(base64)) or
(length(base64) >= 2 and
pos(base64[.. length(base64) - 2], '=') <> 0) then
raise RANGE_ERROR;
end if;
if length(base64) >= 2 and base64[pred(length(base64)) fixLen 2] = "==" then
decoded := decoded[.. length(decoded) - 2];
elsif length(base64) >= 1 and base64[length(base64)] = '=' then
decoded := decoded[.. pred(length(decoded))];
end if;
end func;
const func string: toQuotedPrintable (in string: byteStri) is func
result
var string: quoted is "";
local
var integer: index is 0;
var integer: startPos is 1;
var integer: counter is 1;
var char: ch is ' ';
begin
for index range 1 to length(byteStri) do
ch := byteStri[index];
if ch >= '\256;' then
raise RANGE_ERROR;
elsif ch = '\n' or (ch = '\r' and
index < length(byteStri) and byteStri[succ(index)] = '\n') then
if index > 1 then
ch := byteStri[pred(index)];
if ch = ' ' or ch = '\t' then
quoted &:= byteStri[startPos .. index - 2];
if counter >= 76 then
quoted &:= "=\n";
counter := 1;
end if;
quoted &:= "=" <& ord(byteStri[pred(index)]) RADIX 16 lpad0 2;
counter +:= 3;
startPos := index;
end if;
end if;
counter := 1;
elsif ch >= '\127;' or ch = '=' or (ch < ' ' and ch <> '\9;') then
quoted &:= byteStri[startPos .. pred(index)];
if counter >= 74 then
quoted &:= "=\n";
counter := 1;
end if;
quoted &:= "=" <& ord(ch) RADIX 16 lpad0 2;
startPos := succ(index);
counter +:= 3;
elsif counter >= 76 then
quoted &:= byteStri[startPos .. pred(index)] & "=\n";
startPos := index;
counter := 2;
else
incr(counter);
end if;
end for;
quoted &:= byteStri[startPos ..];
end func;
const func string: fromQuotedPrintable (in string: quoted) is func
result
var string: decoded is "";
local
var integer: startPos is 1;
var integer: equalSignPos is 0;
var string: twoChars is "";
begin
equalSignPos := pos(quoted, "=");
while equalSignPos <> 0 do
decoded &:= quoted[startPos .. pred(equalSignPos)];
if equalSignPos < length(quoted) and
quoted[succ(equalSignPos)] = '\n' then
startPos := equalSignPos + 2;
elsif equalSignPos <= length(quoted) - 2 then
twoChars := quoted[succ(equalSignPos) fixLen 2];
if twoChars[1] in hexdigit_char and
twoChars[2] in hexdigit_char then
decoded &:= chr(integer(twoChars, 16));
elsif twoChars <> "\r\n" then
raise RANGE_ERROR;
end if;
startPos := equalSignPos + 3;
else
raise RANGE_ERROR;
end if;
equalSignPos := pos(quoted, "=", startPos);
end while;
decoded &:= quoted[startPos ..];
end func;
const func string: toUuencoded (in string: byteStri) is func
result
var string: uuencoded is "";
local
var integer: index is 1;
var integer: subIndex is 1;
var char: ch is ' ';
var integer: threeBytes is 0;
var string: fourBytes is " ";
var integer: posToAddNewline is 43;
begin
if length(byteStri) <> 0 then
if length(byteStri) < 45 then
uuencoded &:= chr(32 + length(byteStri));
else
uuencoded &:= "M";
end if;
for index range 1 to length(byteStri) step 3 do
threeBytes := 0;
for subIndex range index to index + 2 do
threeBytes <<:= 8;
if subIndex <= length(byteStri) then
ch := byteStri[subIndex];
if ch >= '\256;' then
raise RANGE_ERROR;
end if;
threeBytes +:= ord(ch);
end if;
end for;
fourBytes @:= [1] chr(32 + (threeBytes >> 18));
fourBytes @:= [2] chr(32 + (threeBytes >> 12) mod 64);
fourBytes @:= [3] chr(32 + (threeBytes >> 6) mod 64);
fourBytes @:= [4] chr(32 + threeBytes mod 64);
uuencoded &:= fourBytes;
if index = posToAddNewline and length(byteStri) > index + 2 then
if length(byteStri) - index - 2 < 45 then
uuencoded &:= "\n" <& chr(32 + length(byteStri) - index - 2);
else
uuencoded &:= "\nM";
end if;
posToAddNewline +:= 45;
end if;
end for;
uuencoded &:= "\n";
end if;
uuencoded &:= "`\n";
end func;
const func string: fromUuencoded (in string: uuencoded) is func
result
var string: decoded is "";
local
var integer: lineLength is 1;
var integer: index is 1;
var integer: subIndex is 1;
var integer: number is 0;
var integer: fourBytes is 0;
var string: threeBytes is " ";
begin
lineLength := ord(uuencoded[1]) - 32;
while lineLength <> 0 and lineLength <> 64 do
incr(index);
while lineLength >= 1 do
fourBytes := 0;
for subIndex range index to index + 3 do
number := ord(uuencoded[subIndex]) - 32;
if number = 64 then
number := 0;
elsif number < 0 or number > 64 then
raise RANGE_ERROR;
end if;
fourBytes := (fourBytes << 6) + number;
end for;
threeBytes @:= [1] chr( fourBytes >> 16);
threeBytes @:= [2] chr((fourBytes >> 8) mod 256);
threeBytes @:= [3] chr( fourBytes mod 256);
decoded &:= threeBytes[ .. lineLength];
lineLength -:= 3;
index +:= 4;
end while;
while index <= length(uuencoded) and uuencoded[index] <> '\n' do
incr(index);
end while;
if index < length(uuencoded) then
incr(index);
lineLength := ord(uuencoded[index]) - 32;
else
lineLength := 0;
end if;
end while;
end func;
const func string: toPercentEncoded (in string: byteStri) is func
result
var string: percentEncoded is "";
local
const set of char: unreservedChars is alphanum_char | {'-', '_', '.', '~'};
var integer: pos is 0;
var integer: start is 1;
var char: ch is ' ';
begin
for ch key pos range byteStri do
if ch > '\255;' then
raise RANGE_ERROR;
elsif ch not in unreservedChars then
percentEncoded &:= byteStri[start .. pred(pos)];
percentEncoded &:= "%" <& ord(ch) RADIX 16 lpad0 2;
start := succ(pos);
end if;
end for;
percentEncoded &:= byteStri[start ..];
end func;
const func string: fromPercentEncoded (in string: percentEncoded) is func
result
var string: decoded is "";
local
var integer: pos is 0;
var integer: start is 1;
begin
pos := pos(percentEncoded, '%');
while pos <> 0 do
if pos <= length(percentEncoded) - 2 and
percentEncoded[succ(pos)] in hexdigit_char and
percentEncoded[pos + 2] in hexdigit_char then
decoded &:= percentEncoded[start .. pred(pos)];
decoded &:= char(integer(percentEncoded[succ(pos) fixLen 2], 16));
pos +:= 2;
start := succ(pos);
end if;
pos := pos(percentEncoded, '%', succ(pos));
end while;
decoded &:= percentEncoded[start ..];
end func;
const func string: toUrlEncoded (in string: byteStri) is func
result
var string: urlEncoded is "";
local
const set of char: unreservedChars is alphanum_char | {'-', '_', '.', '~'};
var integer: pos is 0;
var integer: start is 1;
var char: ch is ' ';
begin
for ch key pos range byteStri do
if ch > '\255;' then
raise RANGE_ERROR;
elsif ch = ' ' then
urlEncoded &:= byteStri[start .. pred(pos)];
urlEncoded &:= '+';
start := succ(pos);
elsif ch not in unreservedChars then
urlEncoded &:= byteStri[start .. pred(pos)];
urlEncoded &:= "%" <& ord(ch) RADIX 16 lpad0 2;
start := succ(pos);
end if;
end for;
urlEncoded &:= byteStri[start ..];
end func;
const func string: fromUrlEncoded (in string: urlEncoded) is func
result
var string: decoded is "";
local
var integer: pos is 0;
var integer: start is 1;
var char: ch is ' ';
begin
for ch key pos range urlEncoded do
if ch = '%' and pos <= length(urlEncoded) - 2 and
urlEncoded[succ(pos)] in hexdigit_char and
urlEncoded[pos + 2] in hexdigit_char then
decoded &:= urlEncoded[start .. pred(pos)];
decoded &:= chr(integer(urlEncoded[succ(pos) fixLen 2], 16));
start := pos + 3;
elsif ch = '+' then
decoded &:= urlEncoded[start .. pred(pos)];
decoded &:= ' ';
start := succ(pos);
end if;
end for;
decoded &:= urlEncoded[start ..];
end func;
const func string: toAscii85 (in string: byteStri) is func
result
var string: ascii85 is "";
local
var integer: index is 0;
var integer: subIndex is 0;
var integer: fourBytes is 0;
var string: fiveBytes is " ";
var integer: partialGroupSize is 0;
var char: ch is ' ';
begin
for index range 1 to length(byteStri) - 3 step 4 do
fourBytes := bytes2Int(byteStri[index fixLen 4], UNSIGNED, BE);
if fourBytes = 0 then
ascii85 &:= 'z';
else
for subIndex range 5 downto 1 do
fiveBytes @:= [subIndex] chr(ord('!') + fourBytes rem 85);
fourBytes := fourBytes div 85;
end for;
ascii85 &:= fiveBytes;
end if;
end for;
partialGroupSize := length(byteStri) mod 4;
if partialGroupSize <> 0 then
index := succ(pred(length(byteStri)) mdiv 4 * 4);
fourBytes := bytes2Int(byteStri[index ..] &
"\0;" mult 4 - partialGroupSize,
UNSIGNED, BE);
for subIndex range 5 downto 1 do
fiveBytes @:= [subIndex] chr(ord('!') + fourBytes rem 85);
fourBytes := fourBytes div 85;
end for;
ascii85 &:= fiveBytes[.. succ(partialGroupSize)];
end if;
end func;
const func string: fromAscii85 (in string: ascii85) is func
result
var string: decoded is "";
local
const set of char: whiteSpace is {'\0;', '\t', '\n', '\f', '\r', ' '};
var char: ch is ' ';
var integer: digitIndex is 0;
var integer: base85Number is 0;
var integer: idx is 0;
begin
for ch range ascii85 until ch = '~' do
if ch >= '!' and ch <= 'u' then
incr(digitIndex);
base85Number := base85Number * 85 + (ord(ch) - ord('!'));
if digitIndex = 5 then
decoded &:= bytes(base85Number, UNSIGNED, BE, 4);
digitIndex := 0;
base85Number := 0;
end if;
elsif ch = 'z' and digitIndex = 0 then
decoded &:= "\0;\0;\0;\0;";
elsif ch not in whiteSpace then
raise RANGE_ERROR;
end if;
end for;
if digitIndex <> 0 then
for idx range 1 to 5 - digitIndex do
base85Number := base85Number * 85 + 84;
end for;
decoded &:= bytes(base85Number, UNSIGNED, BE, 4)[.. pred(digitIndex)];
end if;
end func;
const func string: toAsciiHex (in string: byteStri) is func
result
var string: asciiHex is "";
local
const char: endOfData is '>';
const integer: encodingsPerLine is 32;
var integer: index is 1;
begin
while index <= length(byteStri) do
asciiHex &:= hex(byteStri[index len encodingsPerLine]);
asciiHex &:= "\n";
index +:= encodingsPerLine;
end while;
asciiHex &:= endOfData;
end func;
const func string: fromAsciiHex (in string: asciiHex) is func
result
var string: stri is "";
local
const char: endOfData is '>';
const set of char: whiteSpace is {'\0;', '\t', '\n', '\f', '\r', ' '};
var integer: index is 1;
begin
while index < length(asciiHex) and asciiHex[index] <> endOfData do
if asciiHex[index] not in whiteSpace then
if asciiHex[succ(index)] = endOfData then
stri &:= char(integer(asciiHex[index fixLen 1] & "0", 16));
incr(index);
else
stri &:= char(integer(asciiHex[index fixLen 2], 16));
index +:= 2;
end if;
else
incr(index);
end if;
end while;
if index = length(asciiHex) and asciiHex[index] <> endOfData and
asciiHex[index] not in whiteSpace then
stri &:= char(integer(asciiHex[index fixLen 1] & "0", 16));
end if;
end func;
const func string: toBase (in bigInteger: number, in string: digits) is func
result
var string: encoded is "";
local
var bigInteger: base is 0_;
var quotRem: quotientAndRemainder is quotRem.value;
begin
base := bigInteger(length(digits));
quotientAndRemainder.quotient := number;
while quotientAndRemainder.quotient <> 0_ do
quotientAndRemainder := quotientAndRemainder.quotient divRem base;
encoded &:= digits[succ(ord(quotientAndRemainder.remainder))];
end while;
encoded := reverse(encoded);
end func;
const func bigInteger: fromBaseToBigInt (in string: encoded, in string: digits) is func
result
var bigInteger: number is 0_;
local
var bigInteger: base is 0_;
var bigInteger: factor is 1_;
var integer: index is 0;
var integer: digit is 0;
begin
base := bigInteger(length(digits));
for index range length(encoded) downto 1 do
digit := pred(pos(digits, encoded[index]));
if digit = -1 then
raise RANGE_ERROR;
else
number +:= factor * bigInteger(digit);
factor *:= base;
end if;
end for;
end func;
const func string: toBase (in string: byteStri, in string: digits) is func
result
var string: encoded is "";
local
var integer: index is 1;
begin
if byteStri <> "" then
encoded := toBase(bytes2BigInt(byteStri, UNSIGNED, BE), digits);
while index <= length(byteStri) and byteStri[index] = '\0;' do
incr(index);
end while;
if index > 1 then
encoded := str(digits[1]) mult pred(index) & encoded;
end if;
end if;
end func;
const func string: fromBase (in string: encoded, in string: digits) is func
result
var string: decoded is "";
local
var bigInteger: number is 0_;
var integer: index is 1;
begin
number := fromBaseToBigInt(encoded, digits);
if number <> 0_ then
decoded := bytes(number, UNSIGNED, BE);
end if;
while index <= length(encoded) and encoded[index] = digits[1] do
incr(index);
end while;
if index > 1 then
decoded := "\0;" mult pred(index) & decoded;
end if;
end func;
const string: defaultBase58Digits is "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz";
const func string: toBase58 (in string: byteStri) is
return toBase(byteStri, defaultBase58Digits);
const func string: fromBase58 (in string: base58) is
return fromBase(base58, defaultBase58Digits);