Question

For a registration code I want to convert an Int64 to base30 (30 so that only uppercase characters and excluding 0,O,I,1,etc.) and back.

This is not too difficult using functions like:

const
  Base = 30;
  Base30CharSet = '23456789ABCDEFGHJKLMNPRSTVWXYZ';

function ConvertIntToBase30(ANumber: Int64): string;
begin
  if(ANumber = 0) then
    Result := Copy(Base30CharSet, 1, 1)
  else begin
    Result := '';
    while(ANumber <> 0) do begin
      Result := Copy(Base30CharSet, (ANumber mod Base)+1, 1) + Result;
      ANumber := ANumber div Base;
    end;
  end;
end;

function ConvertBase30ToInt(ANumber: string): Int64;
var
  i: integer;
begin
  Result := 0;
  for i := 1 to Length(ANumber) do begin
    Result := Result + (Pos(ANumber[i], Base30CharSet)-1);
    if(i < Length(ANumber)) then
      Result := Result * Base;
  end;
end;

The snag is that I am interested in the Int64’s bits, so I could be dealing with a number like $FFFFFFFFFFFFFFFF = -1.

To work around this I thought I would store and remove the sign (abs()) and include the sign as an extra character appended to the base30 result. The problem the occurs at the lower limit of Int64 as calling abs(-9223372036854775808) results in an overflow.

Does anyone have a solution or better algorithm to solve this problem?

Answer 1

The way to deal with it is having a character to indicate it is a negative number so that you can decode back. For negative number, just flip the bit from 1 to 0 and remove the sign bit before encoding and when decode, do a flip back and add the sign bit. Below is working codes

   function InvertIntOff(const ANumberL, ANumberH: Integer): Int64;
    asm
      XOR EAX,$FFFFFFFF
      XOR EDX,$FFFFFFFF
    end;


function InvertIntOn(const ANumberL, ANumberH: Integer): Int64;
asm
  XOR EAX,$FFFFFFFF
  XOR EDX,$FFFFFFFF
  OR  EDX,$80000000
end;

function ConvertIntToBase(ANumber: Int64): string;
const
  CBaseMap: array[0..31] of Char = (
    '2','3','4','5','6','7','8','9', //0-7
    'A','B','C','D','E','F','G','H', //8-15
    'J','K','L','M','N', //16-20
    'P','Q','R','S','T','U','V','X','W','Y','Z'); //21-31
var
  I: Integer;
begin
  SetLength(Result, 15);
  I := 0;

  if ANumber < 0 then
  begin
    Inc(I);
    Result[I] := '1';
    ANumber := InvertIntOff(ANumber and $FFFFFFFF, (ANumber and $FFFFFFFF00000000) shr 32);
  end;

  while ANumber <> 0 do
  begin
    Inc(I);
    Result[I] := CBaseMap[ANumber and $1F];
    ANumber := ANumber shr 5;
  end;

  SetLength(Result, I);
end;

function ConvertBaseToInt(const ABase: string): Int64;
var
  I, Index: Integer;
  N: Int64;
begin
  Result := 0;
  if Length(ABase) > 0 then
  begin
    if ABase[1] = '1' then
      Index := 2
    else
      Index := 1;
    for I := Index to Length(ABase) do
    begin
      case ABase[I] of
        '2'..'9':
          N := Ord(ABase[I]) - Ord('2');
        'A'..'H':
          N := Ord(ABase[I]) - Ord('A') + 8;
        'J'..'N':
          N := Ord(ABase[I]) - Ord('J') + 16;
        'P'..'Z':
          N := Ord(ABase[I]) - Ord('P') + 21;
        else
          raise Exception.Create('error');
      end;
      if I > Index then
        Result := Result or (N shl ((I - Index) * 5))
      else
        Result := N;
    end;

    if ABase[1] = '1' then
      Result := InvertIntOn(Result and $FFFFFFFF, (Result and $FFFFFFFF00000000) shr 32);
  end;
end;

procedure TestBase32;
var
  S: string;
begin
  S := ConvertIntToBase(-1);
  ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -1');

  S := ConvertIntToBase(-31);
  ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -31');

  S := ConvertIntToBase(1);
  ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? 1');

  S := ConvertIntToBase(123456789);
  ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? 123456789');

  S := ConvertIntToBase(-123456789);
  ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -123456789');
end;