type TArrayString= Array of String;
procedure MinLen( var s: String; iLen: Integer );
begin
while Length( s )< iLen do s:= '0'+ s;
end;
// Addition of multiple long numbers
function Summe( aSummand: TArrayString ): String;
var
iLenMax, iA, iPos, iSum, iAdvance: Integer;
c: Char;
begin
result:= '0';
case Length( aSummand ) of
0: exit; // Nothing to add at all
1: begin
result:= aSummand[Low( aSummand )]; // Sum equals the only summand
exit;
end;
end;
// Find the longest text, then make all texts as long as the longest,
// so we can simply access an existing character at that position.
iLenMax:= 0;
for iA:= Low( aSummand ) to High( aSummand ) do begin
if Length( aSummand[iA] )> iLenMax then iLenMax:= Length( aSummand[iA] );
end;
for iA:= Low( aSummand ) to High( aSummand ) do MinLen( aSummand[iA], iLenMax );
MinLen( result, iLenMax );
// All have the same length: process from the least significant digit
// (right) to the most significant digit (left).
for iPos:= iLenMax downto 1 do begin
// Manual addition: write all numbers in one row, then add single
// digits per row. Nobody will ever give this function so many
// summands that the sum of single digits will come near the Integer
// capacity.
iSum:= 0;
for iA:= Low( aSummand ) to High( aSummand ) do begin
Inc( iSum, Ord( aSummand[iA][iPos] )- $30 ); // Add digit from each number
end;
Inc( iSum, Ord( result[iPos] )- $30 ); // Also add result's digit from potential previous carry
// Turn that Integer sum into text again, digit by digit
iAdvance:= 0; // Exceeding the current position if we need to carry
while iSum> 0 do begin
c:= Chr( (iSum mod 10)+ $30 ); // Only the rightmost digit
if iPos- iAdvance< 1 then begin // Outside the String?
result:= c+ result; // Prepend
end else begin
result[iPos- iAdvance]:= c; // Set new digit in overall sum
end;
iSum:= iSum div 10; // This digit has been process, go to next one
Inc( iAdvance ); // Not in the current position anymore, but processing potential carries
end;
end;
end;
// Multiplication of two long numbers
function Produkt( s1, s2: String ): String;
var
iPos, iStep, iA, iNine: Integer;
aSummand, aStep: TArrayString;
begin
// For each digit of one factor we will make a separate multiplication
SetLength( aSummand, Length( s1 ) );
// This time it doesn't matter how long both numbers are: just again go
// from least significant digit (right) to most significant digit (left).
for iPos:= Length( s1 ) downto 1 do begin
iA:= Length( s1 )- iPos; // Array index per digit
// As per our position the sum must be shifted by 10: first (rightmost)
// digit needs no shift (0), second needs one (10), third needs two (100)...
MinLen( aSummand[iA], iA );
// Current digit
iStep:= Ord( s1[iPos] )- $30;
case iStep of
0: ; // Multiplication by 0 always results in 0, an empty summand equals one of "0"
1: aSummand[iA]:= s2+ aSummand[iA]; // No multiplication needed, just prepend with factor
else
// Cheap multiplication: use addition with 2 to 9 times the same summand
SetLength( aStep, iStep );
for iNine:= 0 to iStep- 1 do aStep[iNine]:= s2;
aSummand[iA]:= Summe( aStep )+ aSummand[iA]; // Prepend sum, zeroes must be trailing
end;
end;
// Now just add all sums that we got per digit
result:= Summe( aSummand );
end;
// Convert base 2..36 long number into base 10 long number
function ConvertToDecimal( sFrom: String; sBase: String= '16' ): String;
var
sStep, sPos: String;
cFrom: Char;
// a: TArrayString;
a: TArrayString;
begin
SetLength( a, 2 );
a[0]:= '0'; // Overall sum = result
sPos:= '1'; // Current digit's power
while Length( sFrom )> 0 do begin // Process least significant digit (right)
cFrom:= sFrom[Length( sFrom )];
case cFrom of // For now at max base 36 is supported, which includes hexadecimal
'0'.. '9': sStep:= cFrom; // Same as text
'A'.. 'Z': sStep:= IntToStr( Ord( cFrom )- $41+ 10 ); // Turn "B" into "11"
end;
a[1]:= Produkt( sPos, sStep ); // Multiply current digit's value by current position's power
a[0]:= Summe( a ); // Add both product and current overall result
sPos:= Produkt( sPos, sBase ); // Increase power to next digit position
Delete( sFrom, Length( sFrom ), 1 ); // Remove rightmost digit
end;
result:= a[0];
end;
Good idea to test valid Hex in front:
function HexIsValid(s: string): Boolean;
var
i: integer;
begin
Result := True;
for i := 1 to length(s) do
if not (s[i] in ['0'..'9','A'..'F','a'..'f']) then
begin
Result := False;
exit;
end;
end;