К-удивительные числа: программа выдает ран тайм

var
d,j,m,i,n:longint;
k,aa,q,qq,ii,nn,ans:longint;
b,a:array  [0..10000] of integer;
 
 
 
begin
 
 assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
 
readln (n);
qq:=n;
while qq>0 do
  begin
  inc(q);qq:=qq div 10;
  end;
{writeln (q);}
aa:=1;
for qq:=1 to q-2 do
aa:=aa*10;
{writeln (aa);
writeln;}
for i:=aa to n do
 begin
  ii:=i;j:=0;
    while ii>0 do
      begin
      inc(j);
 
      a[j]:=ii mod 10;
      ii:=ii div 10;
      end;
    k:=1;
    while a[k]=0 do inc(k);
    if k<=j then nn:=a[k] else nn:=0;
     for d:=k+1 to j do
      nn:=nn*10+a[d];
 
    if i+nn=n then begin {write (i, ' ',nn );}inc(ans)end;
 
    end;
 
write (ans);
end.

Var x,j,i,n,m: longint;
    f1,f2:text;
 begin
  Assign(f1,'input.txt');
  Assign(f2,'output.txt');
  Reset(f1);
  Rewrite(f2);
  Read(f1,n);
  x:=0;
  for i:=1 to n do
   begin
    j:=i;
    m:=0;
    While j>0 do
     begin
      m:=m*10+j mod 10;
      j:=j div 10;
     end;
    if i+m=n then inc(x);
   end;
  Write(f2,x);
  Close(f2);
 end.