function FindBin(ost,b:Plong;const sp:integer):longint;
var up,down:word;
  c:Plong;
begin
 new(c);
 down:=0;up:=_osn;
 while up-1>down do
    begin
       MulLongShort(b,(up+down) div 2,c);
       case MoreSdvigLong(ost,c,sp) of
        0:down:=(up+down) div 2;
        1:up:=(up+down) div 2;
        2:begin
             up:=(up+down) div 2;
             down:=up;
          end;
       end;
    end;
 MulLongShort(b,(up+down) div 2,c);
 if MoreSdvigLong(ost,c,0)=0 then SubLongTwo(ost,c,sp) else
    begin
       SubLongTwo(c,ost,sp);
       ost:=c;
    end;
 FindBin:=(up+down) div 2;
 dispose(c);
end;



procedure MakeDel(a,b,res,ost:Plong);
var sp:integer;
begin
 ost^:=a^;
 sp:=a^[0]-b^[0];
 if MoreSdvigLong(a,b,sp)=1 then dec(sp);{!!!!!!!!!}
 res^[0]:=sp+1;
 while sp>=0 do
    begin
       res^[sp+1]:=FindBin(ost,b,sp);
       dec(sp);
    end;
end;



procedure DivLongTwo(a,b,res,ost:Plong);
begin
 fillchar(res^,sizeof(res^),0);res^[0]:=1;
 fillchar(ost^,sizeof(ost^),0);ost^[0]:=1;
 case MoreSdvigLong(a,b,0) of
  0:MakeDel(a,b,res,ost);
  1:ost^:=a^;
  2:res^[1]:=1;
 end;
end;

что бы разделить a на b вызовите : DivLongTwo(a,b,res,ost);
res -- результат деления a на b; ost -- остаток от деления.

У меня прога пошла. Все ок.
program;
uses crt;
function sum(x,y:string):string;
var i:integer;
   lx,ly,yy,s:byte;
   res:string;
   mem:byte;
begin
 if length(x)<length(y) then
 begin
   res:=x;
   x:=y;
   y:=res;
 end;
 lx:=length(x);
 ly:=length(y);
 mem:=0;
 res:='';
 for i:=0 to lx-1 do
 begin
    if ly-i<1 then yy:=0
    else yy:=ord(y[ly-i])-48;
    s:=(ord(x[lx-i])-48)+yy+mem;
    res:=chr((s mod 10)+48)+res;
    mem:= s div 10;
 end;
 if mem>0 then res:=chr(mem+48)+res;
 sum:=res;
end;

function rasn(x,y:string):string;
var j,i:integer;
   lx,ly,xx,yy,s:byte;
   res:string;
   mem:byte;
begin
 lx:=length(x);
 ly:=length(y);
 mem:=0;
 res:='';
 for i:=0 to lx-1 do
 begin
    if ly-i<1 then yy:=0
    else yy:=ord(y[ly-i])-48;
    xx:=ord(x[lx-i])-48;
    if xx>=yy then res:=chr(xx-yy+48)+res
    else
    begin
      j:=lx-i-1;
      while (x[j]='0')and(j>0) do
      begin
        x[j]:='9';
        dec(j);
      end;
      dec(x[j]);
      res:=chr(10+xx-yy+48)+res;
    end;
 end;
 while (res[1]='0')and(length(res)>1)  do delete(res,1,1);
 rasn:=res;
end;

procedure chas(x, y :string; var res, ost:string);
begin
 res:='0';
 ost:=x;
 while (length(ost)>length(y)) or (ost>=y) do
 begin
   ost:=rasn(ost,y);
   res:=sum(res,'1');
 end;
end;

var
   sx, sy :string;
   key:char;
   r,o:string;
begin
  sx:='';
  sy:='';

  write('BBeguTe nepBoe 4uc/\o: ');
  repeat
  key:= readkey;
  if(key>='0')and(key<='9')then
  begin
     sx:=sx+key;
     write(key);
  end;
  until key=#13;
  writeln;
  write('BBeguTe Btopoe 4uc/\o: ');
  repeat
  key:= readkey;
  if(key>='0')and(key<='9')then
  begin
     sy:=sy+key;
     write(key);
  end;
  until key=#13;
  writeln;
  chas(sx,sy,r,o);
  writeln('4acTHoe= ',r,' octaTok= ',o);
  readln;
end.