Создать программу для умножения двух чисел в позиционной системе счисления

function Examen(var s : String) : Boolean;
var
  i : Integer;
begin
  while (s[1] = '0') and (Length(s) > 1) do Delete(s, 1, 1);
  if Length(s) = 0 then begin Examen := False; Exit; end;
  for i := 1 to Length(s) do if Not(s[i] in ['0'..'9']) then begin Examen := False; Exit; end;
  Examen := True;
end;
 
function Mul10(a : String) : String;
begin
  if a = '0' then begin Mul10 := '0'; Exit; end;
  Mul10 := a + '0';
end;
 
function MulN(a : String; b : Char) : String;
var
  i, n, p : Integer;
  r : String;
begin
  if (a = '0') or (b = '0') then begin MulN := '0'; Exit; end;
  n := Ord(b) - Ord('0');
  p := 0;
  r := '';
  for i := Length(a) downto 1 do
    begin
      p := p + (Ord(a[i]) - Ord('0')) * n;
      r := Chr(Ord('0') + p mod 10) + r;
      p := p div 10;
    end;
  if p > 0 then
    r := Chr(Ord('0') + p) + r;
  MulN := r;
end;
 
function Add(a, b : String) : String;
var
  i, p : Integer;
begin
  while Length(a) < Length(b) do a := '0' + a;
  while Length(b) < Length(a) do b := '0' + b;
  p := 0;
  for i := Length(a) downto 1 do
    begin
      p := p + Ord(a[i]) + Ord(b[i]) - Ord('0') * 2;
      a[i] := Chr(Ord('0') + p mod 10);
      p := p div 10;
    end;
  if p > 0 then
    a := Chr(Ord('0') + p) + a;
  Add := a;
end;
 
function Mul(a, b : String) : String;
var
  r, d : String;
  i : Integer;
begin
  if (a = '0') or (b = '0') then begin Mul := '0'; Exit; end;
  if a = '1' then begin Mul := b; Exit; end;
  if b = '1' then begin Mul := a; Exit; end;
  r := '0';
  for i := 1 to Length(b) do
    begin
      r := Mul10(r);
      d := MulN(a, b[i]);
      r := Add(r, d);
    end;
  Mul := r;
end;
 
var
  a, b, c : String;
begin
  Write('a: '); ReadLn(a); if Not Examen(a) then begin WriteLn('не целое число'); Halt; end;
  Write('b: '); ReadLn(b); if Not Examen(b) then begin WriteLn('не целое число'); Halt; end;
  c := Mul(a, b);
  WriteLn('c: ', c);
end.

const
  dig = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; //цифры
 
type
  num = array[1..512] of word; //тип-массив для числа
 
//Процедура: ввод числа, проверка числа, разделение знака и модуля числа
//s: приглашение
//z: знак числа, если отрицательное, то z = true
//t: модулшь числа
//len: длина модуля числа
//cc: основание системы счисления
procedure Read_Q(s: string; var z: boolean; var t: num; var len: integer; cc: integer);
var
  i: integer; //счётчик
  x: string; //буфер для ввода числа
begin
  repeat //*** цикл ввода числа
    writeln(s); //печатаем приглашение
    readln(x); //вводим число
    for i := 1 to length(x) do if x[i] in ['a'..'z'] then dec(x[i], ord('a') - ord('A')); //приведение букв к верхнему регистру
    i := length(x);
    while (i > 0) and (pos(x[i], dig) in [1..cc]) do dec(i); //проверка цифр
    z := false; //знак пока "+"
    if i = 1 then //если первый символ не цифра, то
      begin
        z := x[i] = '-'; //если первый символ "-", то число отрицательное
        if x[i] in ['+', '-'] then delete(x, 1, 1) else x := '' //если первый символ "+" или "-", удаляем его, иначе стираем число
      end
    else if i > 1 then x := ''; //если не цифровых символов более одного, то удаляем число
    if length(x) = 0 then writeln('Неверный формат числа, повторите ввод.') //если число не введено, печатаем сообщение
  until length(x) > 0; //*** повторяем до тех пор, пока число не будет введено
  len := length(x); //вычисляем длину модуля числа
  for i := len downto 1 do t[len-i+1] := pos(x[i], dig) - 1 //переносим модуль числа из буфера в переменную
end;
 
//Процедура печати числа
//s: сообщение
//z: знак числа
//t: модуль числа
//len: длина модуля числа
procedure Prn(s: string; const z: boolean; const t: num; const len: integer);
var
  i: integer; //счётчик
begin
  writeln(s); //печатаем сообщение
  if z then write('-'); //если число отрицательное, печатаем "-"
  for i := len downto 1 do write(dig[t[i]+1]); //печатаем цифры модуля числа
  writeln; //переход на новую строку
end;
 
//основная программа
var
  c, ce, i, j, k: integer; //система счисления, перенос, счётчики
  m, n, s, p: num; //модули первого и второго сомножителей, результата, произведения первого сомножителя на один разряд второго сомножителя
  mlen, nlen, slen, plen: integer; //длины вышеперечисленных модулей чисел
  zm, zn, zs: boolean; //знаки сомножителей и результата
begin
  repeat //ввод основания системы счисления с проверкой
    write('Введите основание системы счисления [2..', length(dig), ']: ');
    readln(c)
  until c in [2..length(dig)];
  Read_Q('Введите первый сомножитель:', zm, m, mlen, c); //ввод сомножителей
  Read_Q('Введите второй сомножитель:', zn, n, nlen, c);
  zs := zm xor zn; //вычисление знака произведения
  for i := 1 to nlen do //цикл по цифрам второго сомножителя
    begin
      if n[i] > 0 then //если цифра > 0, то
        begin
          for j := 1 to mlen do p[j] := m[j]; //копируем первый сомножитель в произведение
          plen := mlen; //длина произведения пока равна длине первого сомножителя
          if n[i] > 1 then //если цифра > 1, то
            begin //перемножаем первый сомножитель на цифру второго сомножителя
              ce := 0; //перенос пока = 0
              for j := 1 to mlen do //цикл по цифрам второго сомножителя
                begin
                  p[j] := p[j] * n[i] + ce; //умножаем цифру первого сомножителя на цифру второго сомножителя
                  ce := p[j] div c; //новый перенос
                  p[j] := p[j] mod c //коррекция цифры
                end;
              if ce > 0 then //если после умножения всё ещё есть перенос, то распространяем перенос
                begin
                  inc(plen); //увеличиваем длину результата на 1
                  p[plen] := ce //добавляем перенос
                end
            end;
          for j := 1 to plen do //добавляем полученное произведение к результату (со сдвигами по цифрам)
            begin
              k := j + i - 1; //сдвинутая позиция
              inc(s[k], p[j]); //складываем результат и полученное произведение
              if s[k] >= c then //распространяем перенос
                begin
                  dec(s[k], c); //корректируем цифру
                  inc(k); //вычисляем позицию для следующего переноса
                  inc(s[k]) //добавляем перенос
                end
            end;
          if k > slen then slen := k //если перенос распространился за пределы числа, то удлиняем число
        end
    end;
  prn('Результат:', zs, s, slen); //печатаем результат
  readln
end.