Найти длинный остаток от деления двух чисел

program Delenie;
uses crt;
const max=1000;
type mas=array[0..max] of shortInt;
var
  s:boolean;
  m1,m2,ost,t:string;
  a1,a2,mm1,mm2,p:mas;
  cod:Integer;
  f,k,l,i,j,z,c,q,sum:integer;
  m,n1,n2:integer;
{ñðàâíåíèå äëèííûõ ÷èñåë}
function Sravn(m:integer;a1,mm2:mas):boolean;
  var
    k:integer;
  begin
    if m<>n2 then Sravn:=(m>n2)
    else begin
       Sravn:=true;
       k:=1;
       while (k<=m)and(a1[k]=mm2[k])do inc(k);
       if (k<=m)then Sravn:=(a1[k]>mm2[k]);
    end;
  end;
begin
  clrScr;
  writeLn(' Vvedite delimoe');
  readLn(m1);
  n1:=lengTh(m1);
  for i:=1 to n1 do val(m1[i],mm1[i],cod);
  writeln(' Vvedite delitel');
  readLn(m2);
  n2:=lengTh(m2);
  for i:=1 to n2 do val(m2[i],mm2[i],cod);
  for i:=1 To n2-1 do a1[i]:=mm1[i];
  if (n2>n1)or((n2=n1)and(m2[1]>m1[1]))then
    begin
     ost:=m1;
     writeln('Ostatok=',ost);
     readln;
     exit;
    end;
  m:=n2-1;
  i:=m;
  while(i<n1)Do
    begin
      while ((Sravn(m,a1,mm2)=false) and (i<n1)) do
        begin
          sum:=0;
          for q:=1 to m do
            begin
              sum:=sum+a1[q];
              if sum<>0 then break;
            end;
          if ((m>0)and(sum<>0))or(m=0) then m:=m+1;
          i:=i+1;
          a1[m]:=mm1[i];
        end;
      j:=0;
      while(Sravn(m,a1,mm2)=true)do
        begin
          f:=n2+1;
          for k:=m downto m-n2 do
            begin
              f:=f-1;
              if a1[k]>=mm2[f] then a2[k]:=a1[k]-mm2[f]
              else
                begin
                  a1[k]:=a1[k]+10;
                  a1[k-1]:=a1[k-1]-1;
                  for l:=k downto 1 do
                  if a1[l]<0 then
                     begin
                       a1[l-1]:=a1[l-1]-1;
                       a1[l]:=a1[l]+10;
                     end;
                  a2[k]:=a1[k]-mm2[f];
                end;
            end;
          for l:=m-n2-1 downto 1 do
          a2[l]:=a1[l];
          j:=j+1;
          p[i-n2+1]:=j;
          while((a2[1]=0)and(m>0))do
            begin
              for z:=1 to m-1 do
              a2[z]:=a2[z+1];
              m:=m-1;
              a2[m+1]:=0;
            end;
          for z:=1 to m do
          a1[z]:=a2[z];
        end;
      while((a1[1]=0)and(m>0))do
        begin
          for z:=1 to m-1 do
          a1[z]:=a1[z+1];
          m:=m-1;
          a1[m+1]:=0;
        end;
    end;
  ost:='';
  for i:=1 to m do
     begin
      str(a1[i],t);
      ost:=ost+t;
     end;
  writeln('Ostatok=',ost);
  readln;
end.