interface
...................................
function _ValLong(const S: string; var Code: Integer): Integer;
function _ValInt64(const S: string; var Code: Integer): Int64;
function ConvertToBase64(Value: Int64; Base: LongInt; var Buffer): LongInt;
function _StrInt64(Val: Int64; Width: Integer): ShortString;
procedure _StrLong(Val, Width: Integer; Result: PShortString);
function _Str0Int64(Val: Int64): ShortString;
procedure _Str0Long(Val: Integer; Result: PShortString);
procedure _WriteInt64(var t: TTextRec; val: Int64; Width: Integer);
procedure _Write0Int64(var t: TTextRec; val: Int64);
...................................
implementation
...................................
const
VAL_HEX_DIGITS: array[0..54] of Byte = (
0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
0, 0, 0, 0, 0, 0, 0,
$A, $B, $C, $D, $E, $F,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
$a, $b, $c, $d, $e, $f);
// in code below (shl 4) & (shl 1) + (shl 3) used to avoid long multiply by 16 and 10
function _ValInt64(const S: string; var Code: Integer): Int64;
var
i: LongInt;
Neg, Hex: Boolean;
begin
Result := 0;
Code := 1;
if S = '' then Exit;
Neg := False;
Hex := False;
i := 1;
while (s[i] = ' ') do Inc(i);
case s[i] of
'-':
begin
Neg := True;
Inc(i);
end;
'+':
Inc(i);
'0':
begin
Hex := (S[i + 1] in ['X', 'x']);
if Hex then Inc(i, 2);
end;
'$', 'X', 'x':
begin
Hex := True;
Inc(i);
end;
end;
if Hex then
while (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) and (Result >= 0) do
begin
Result := Result shl 4 + VAL_HEX_DIGITS[Ord(S[i]) - Ord('0')];
Inc(I);
end
else
while (s[i] in ['0'..'9']) and (Result >= 0) do
begin
Result := Result shl 1 + Result shl 3 + Ord(S[i]) - Ord('0');
Inc(I);
end;
if Neg then
Result := -Result;
if s[i] <> #0 then
code := i
else
code := 0;
end;
// in code below (shl 4) & (shl 1) + (shl 3) used to avoid multiply by 16 and 10
function _ValLong(const S: string; var Code: Integer): Integer;
var
i: LongInt;
Neg, Hex: Boolean;
begin
Result := 0;
Code := 1;
if S = '' then Exit;
Neg := False;
Hex := False;
i := 1;
while (s[i] = ' ') do Inc(i);
case s[i] of
'-':
begin
Neg := True;
Inc(i);
end;
'+':
Inc(i);
'0':
begin
Hex := (S[i + 1] in ['X', 'x']);
if Hex then Inc(i, 2);
end;
'$', 'X', 'x':
begin
Hex := True;
Inc(i);
end;
end;
if Hex then
while (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) and (Result >= 0) do
begin
Result := Result shl 4 + VAL_HEX_DIGITS[Ord(S[i]) - Ord('0')];
Inc(I);
end
else
while (s[i] in ['0'..'9']) and (Result >= 0) do
begin
Result := Result shl 1 + Result shl 3 + Ord(S[i]) - Ord('0');
Inc(I);
end;
if Neg then
Result := -Result;
if s[i] <> #0 then
code := i
else
code := 0;
end;
// Convert Value into the Buffer with a given Base
// function returns count of digits of a Value
// Example(convert to hexadecimal):
// ConvertToBase64(1357902481234567890, 16, mystring)
// Result: mystring = "12D83D1CB99BA2D2"
// Value treated as unsigned
// 2 <= Base <= 36
// SizeOf(Buffer) => (64 + 1)
function ConvertToBase64(Value: Int64; Base: LongInt; var Buffer): LongInt;
const
DIGITS: array [0..35] of AnsiChar = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
asm
push ebx
push esi
push edi
push ebp
mov esi, edx // Buffer
mov ecx, eax // Base
mov ebx, [dword ptr Value + 4] // Value.Hi
mov ebp, [dword ptr Value] // Value.Lo
mov edi, esi // +0 +63
add esi, 64 // base2(0xFFFFFFFFFFFFFFFF) = 11111111111111...1111111111111111b
mov [esi], byte ptr 0 // end of string
@next:
xor edx, edx
mov eax, ebx // hi
div ecx
mov ebx, eax // hi
mov eax, ebp // lo
div ecx
mov ebp, eax // lo
dec esi
mov dl, [edx + DIGITS] // (put digit
mov [esi], dl // to buffer)
or eax, ebx // IF (hi <> 0) & (lo <> 0) THEN jump @next
jnz @next //
// shift result string to buffer beginning
mov eax, esi
sub eax, edi
mov ecx, 64 + 1
sub ecx, eax
lea eax, [ecx - 1] // return count
rep movsb
pop ebp
pop edi
pop esi
pop ebx
end;
procedure StrInteger(Val: Int64; Width: LongInt; Result: PShortString);
var
Buf: array[0..65] of AnsiChar;
i, n, m: LongInt;
begin
i := 0;
if Val < 0 then
begin
Buf[i] := '-';
Val := -Val;
Inc(i);
end;
Inc(i, ConvertToBase64(Val, 10, Buf[i]));
if Width > 255 then
Width := 255;
// Fill the Result with the appropriate number of blanks
n := 1;
while n <= width - i do
begin
Result^[n] := ' ';
Inc(n);
end;
// Fill the Result with the number
m := 0;
while m < i do
begin
Result^[n] := Buf[m];
Inc(n);
Inc(m);
end;
// Result is n - 1 characters long
SetLength(Result^, n - 1);
end;
function _StrInt64(Val: Int64; Width: Integer): ShortString;
begin
StrInteger(Val, Width, @Result);
end;
procedure _StrLong(Val, Width: Integer; Result: PShortString);
begin
StrInteger(Val, Width, Result);
end;
function _Str0Int64(Val: Int64): ShortString;
begin
Result := _StrInt64(Val, 0);
end;
procedure _Str0Long(Val: Integer; Result: PShortString);
begin
_StrLong(Val, 0, Result);
end;
procedure _WriteInt64(var t: TTextRec; val: Int64; Width: Integer);
var
S: ShortString;
begin
S := _StrInt64(val, Width);
ConsoleInterface.WritePCharLen(@S[1], LongWord(S[0]));
end;
procedure _Write0Int64(var t: TTextRec; val: Int64);
begin
_WriteInt64(t, val, 0);
end;
