задача на системы счисления

[heaton]

задача заключается в том что во входном файле содержится число (в десятеричной системе счисления) , это число нужно проверить на "круглость" т.е. если это число в любой сстеме счисления имеет вид n0000, где n это чило от 1 до макс. числа в этой системе счисления (системы счисления от двоичной до шестнадцатеричной), но заковырка в том что нужно в выходной файл записать минимальное число в (в десятичной системе счисления) которое нужно прибавить к исходному число чтобы оно стало " круглым" в какойто системе счисления....
вот я пытался решить эту задачку

program qwe;
 procedure per(x,y:longint; Var t:string);
 Var c:integer; sc:string;

  Begin
    t:='';
    while x<>0 do begin
      c:=x mod y;
      if c<10 then begin
        str(c,sc);
        t:=sc+t; end
      else
        case c of
          15: t:='F'+t;
          14: t:='E'+t;
          13: t:='D'+t;
          12: t:='C'+t;
          11: t:='B'+t;
          10: t:='A'+t;
        end;
      x:=x div y;
    end;
  End;
  function krugl (s:string):boolean;
  var k,i:integer;
  begin
  k:=0;
  for i:=1 to length (s) do
  if s[i]='0' then inc(k);
  if k=length(s)-1 then krugl:=true else
  krugl:=false;
  end;

 var a,g,i,k:longint;   f1,f2:text;
  b:array[1..100] of integer; s:string;
 begin
 assign (f1,'input.txt');
 reset (f1);
 assign (f2,'output.txt');
 rewrite(f2);
 read(f1,a);
 g:=a;
 while (k>=2) and (k<=16) do begin
 per (a,k,s);
 if krugl(s)=true then      write  (f2,'0',' ',k)
 else begin while  (krugl(s)<>true) and (k>=2) and (k<=16)        do  begin

 a:=a+1;
 per (a,k,s);
 end;
 end;
 end;
 write (f2,a-g,' ',k);
 close (f1);
 close (f2);

 end.

Но пока что-то неполучается...в выходной фаил она записыает два нуля и всё...помогите пожалуйста эту задачу решить..