Составить программу, которая находит все совершенные числа в интервале

uses crt;
var
s,j,i:integer;
st,stt:string;
begin
clrscr;
for j:=1 to 1000 do
 begin
  for i:=1 to j do
    if (j mod i = 0) and (j>i) then begin s:=s+i;str(i,stt);st:=st+'+'+stt;end;
    st[1]:=' ';
    if s=j then
    writeln(j,' sovershennoe 4islo, t.k.',j,' =',st);
    s:=0;st:='';
  end;
end.

program deliteli;
uses crt;
var b,a,c,x,sum,r:integer;
    begin
clrscr;
a:=56;
repeat
for b:=a downto 1 do begin
c:=a div b;
if a mod b = 0 then begin
sum:=sum+c;
if c=a then begin
c:=0;
sum:=sum-a;
end;
writeln(c);
end;
end;
writeln(sum);
if sum=a then begin
r:=r+1;
end;
a:=a+1;
x:=x+1;
sum:=0;
until x=10000;
writeln(r);
readkey;
end.

program deliteli;
uses crt;
var b,a,c,x,sum,r:integer;
begin
clrscr;
a:=1;   { Если тут оставить 56 (диапазон 56..10000), как у тебя было, то выведит 2, (т.к. не возмёт числа 6 и 28), а если поставить 1, то выводит 4, т.е. четыре числа - это совершенные числа диапазона 1..10000. }
repeat
 
 for b:=a downto 1 do begin  
 c:=a div b;  
 if a mod b = 0 then begin  
 sum:=sum+c; 
 if c=a then begin                     {или так if b=1 then}
 c:=0;
 sum:=sum-a;
 end;
{writeln(c);}  { -  это можно убрать }
 end;
 end;
{ writeln(sum);} { - и это }
 if sum=a then begin
 r:=r+1;
 end;
 a:=a+1;
 x:=x+1;
 sum:=0;
until x=10000;   { - числа на инт. 1..10000 }
 
writeln(r);
readkey;
end.