Перевод систем счисления из десятичной в восьмеричную и обратно

program Project1;
 
type
  //Тип, задающий основания систем счисления.
  TBase = 2..20;
 
//Переводит запись числа в системе счисления по основанию aBase - в число.
function XToNum(const aStr : String; aBase : TBase) : Longint;
var
  StrBin : String;
  i, Sign : Integer;
  Res, Weight : Longint;
begin
  XToNum := 0;
  if aStr = '' then Exit;
 
  Res := 0;
 
  //Определяем знак и получаем запись числа без знака.
  if aStr[1] = '-' then begin
    Sign := -1;
    StrBin := Copy(aStr, 2, Length(aStr) - 1);
  end else begin
    Sign := 1;
    StrBin := aStr;
  end;
 
  Weight := 1;
  //Движемся по разрядам беззнакового числа справа-налево.
  for i := Length(StrBin) downto 1 do begin
    case StrBin[i] of
      '0' : Res := Res + 0 * Weight;
      '1' : Res := Res + 1 * Weight;
      '2' : Res := Res + 2 * Weight;
      '3' : Res := Res + 3 * Weight;
      '4' : Res := Res + 4 * Weight;
      '5' : Res := Res + 5 * Weight;
      '6' : Res := Res + 6 * Weight;
      '7' : Res := Res + 7 * Weight;
      '8' : Res := Res + 8 * Weight;
      '9' : Res := Res + 9 * Weight;
      'A', 'a' : Res := Res + 10 * Weight;
      'B', 'b' : Res := Res + 11 * Weight;
      'C', 'c' : Res := Res + 12 * Weight;
      'D', 'd' : Res := Res + 13 * Weight;
      'E', 'e' : Res := Res + 14 * Weight;
      'F', 'f' : Res := Res + 15 * Weight;
      'G', 'g' : Res := Res + 16 * Weight;
      'H', 'h' : Res := Res + 17 * Weight;
      'I', 'i' : Res := Res + 18 * Weight;
      'J', 'j' : Res := Res + 19 * Weight;
      else
        raise Exception.Create('Ошибка! Незарегистрированная цифра!');
    end;
    //Вес следующего разряда.
    Weight := Weight * aBase;
  end;
 
  //Учитываем знак.
  XToNum := Sign * Res;
end;
 
//Переводит число в систему счисления по основанию aBase.
function NumToX(const aNum : Longint; const aBase : TBase) : String;
var
  Num : Longint;
  Dig : Byte;
  Res : String;
begin
  Res := '';
  Num := Abs(aNum);
  repeat
    //Определяем очередной младший разряд числа.
    Dig := Num mod aBase;
    case Dig of
      0  : Res := '0' + Res;
      1  : Res := '1' + Res;
      2  : Res := '2' + Res;
      3  : Res := '3' + Res;
      4  : Res := '4' + Res;
      5  : Res := '5' + Res;
      6  : Res := '6' + Res;
      7  : Res := '7' + Res;
      8  : Res := '8' + Res;
      9  : Res := '9' + Res;
      10 : Res := 'A' + Res;
      11 : Res := 'B' + Res;
      12 : Res := 'C' + Res;
      13 : Res := 'D' + Res;
      14 : Res := 'E' + Res;
      15 : Res := 'F' + Res;
      16 : Res := 'G' + Res;
      17 : Res := 'H' + Res;
      18 : Res := 'I' + Res;
      19 : Res := 'J' + Res;
    end;
    //Удаляем из числа очередной младший разряд.
    Num := Num div aBase;
  until Num = 0;
 
  //Учитываем знак.
  if aNum < 0 then Res := '-' + Res;
  NumToX := Res;
end;
 
//Переводит число, представленное в системе счисления по основанию aBase1,
//в систему счисления по основанию aBase2.
function XToY(const aStr : String; const aBase1, aBase2 : TBase) : String;
begin
  XToY := NumToX( XToNum(aStr, aBase1), aBase2 );
end;
 
var
  B1, B2 : TBase;
  S : String;
begin
  repeat
    Writeln('Задайте основание исходной системы счисления: 2..20:');
    Readln(B1);
    Writeln('Задайте целое число в системе счисления по основанию ', B1, ':');
    Readln(S);
    Writeln('Задайте основание целевой системы счисления:');
    Readln(B2);
 
    S := XToY(S, B1, B2);
 
    Writeln('Полученная запись числа в системе счисления по основанию ', B2, ':');
    Writeln(S);
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

uses crt;
const zn:string[8]='01234567';//символы в СС 8
var s:string;//глобальные переменные число и строка
    r:longint;
procedure DecToOct;//10 в 8
begin
clrscr;
write('Введите целое число в СС 10 r=');
readln(r);
s:='';
while r>0 do
 begin
  s:=zn[r mod 8+1]+s;
  r:=r div 8;
 end;
writeln('Число в СС 8=',s);
readln
end;
 
procedure OctToDec;//8 в 10
var i,k,j:integer;
    f:longint;
begin
clrscr;
repeat
k:=0;
write('Введите целое число в СС 8 s=');
readln(s);
for i:=1 to length(s) do
if not(s[i] in ['0'..'7'])then
 begin
  writeln('Это не число в СС 8!, повторите ввод.');
  k:=1;
 end;
until k=0;
r:=0;f:=1;
for i:=length(s) downto 1 do
 begin
  r:=r+f*(ord(s[i])-48);
  f:=f*8;
 end;
writeln('Число в СС 10=',r);
readln
end;
 
var w:char;//локальная переменная для выбора действия
begin
clrscr;
repeat
clrscr;
writeln('Выберите направление перевода:');
writeln('1-из десятичной в восьмеричную');
writeln('2-из восьмеричной в десятичную');
writeln('другое - выход');
readln(w);
case w of
'1':DecToOct;
'2':OctToDec;
else exit;
end;
until not (w in ['1','2']);
end.