Вывести на экран все пары дружественных чисел, которые не превышают заданного натурального числа

program zadacha_15;
 
uses
  crt;
 
var
  a: longint;{первое число}                                                  
  b: integer;{делители числа s}                                              
  i: integer; {делители числа a}                                             
  s: integer;{сумма делителей первого числа}                        
  s1: integer;{сумма делителей s}                                           
 
begin
  clrscr;                                                                  
  writeln('Программа, находящая все дружественные');        
  writeln('числа в интервале от 1 до 10000');                          
  readln;                                                               
  for a := 2 to 10000 do {цикл для проверки первых чисел}            
  begin
    s := 0;                                                              
    for i := 1 to a - 1 do {находим все делители числа а,
                                 исключая само число}
    begin
      if a mod i = 0 then {находится сумма делителей числа а}         
      begin
        s := s + i;                                                      
      end;                                                           
    end;                                                             
    s1 := 0;                                                         
    for b := 1 to s - 1 do{цикл для проверки вторых чисел, 
                                   которые являются суммой                  
                                   делителей первого числа}
    begin
      if s mod b = 0 then {находим все делители чила s  
                                                 (сумма делителей числа а)}
      begin
        s1 := s1 + b;                                              
      end;                                                         
    end;                                                       
    if (s1 = a) and (s <> a) then {сумма делителей суммы        
                                           делителей числа а должна           
                                           быть равна числу а, а              
                                           сумма делителей числа а        
                                           не должна быть равна        
                                           этому числу}
    begin
      writeln('Числа ', a, ' и ', s, ' - дружественные');  
    end;             
  end;                    
  readln;               
end.

procedure sdiv(x: longint; var s: longint);
var i: longint;
begin
  s := 1;
  for i := 2 to x div 2 do if x mod i = 0 then s := s + i
end;
 
var i, j, n, d1, d2: longint;
begin
  repeat
    write('n = ');
    readln(n);
    if n < 284 then writeln('n must be >= 284, reenter.')
  until n >= 284;
  writeln('Amicable numbers in [220..', n, ']:');
  i := 219;
  while i < n
    do begin
      inc(i);
      sdiv(i, d1);
      for j := i + 1 to n
        do begin
          sdiv(j, d2);
          write(i, #13); {чтобы не скучно ждать было (можно убрать эту строку)}
          if (d1 = j) and (d2 = i)
            then begin
              writeln(i, ', ', j);
              i := j;
              break
            end
        end
    end;
  write('Search complete.           ', #13); {а заодно и эту}
  readln
end.

procedure SummaDeliteley(A : longint; var sum : longint);
var i : longint;
begin
  sum := 0;
  for i := 1 to A - 1 do
      if A mod i = 0 then
        sum := sum + i;
end;
 
var
  a,n, s, s1 : longint;
begin
  write('Введите n: ');
  readln(n);
  for a := 2 to n do
  begin
    SummaDeliteley( a, s);
    SummaDeliteley( s, s1);
    if (s1 = a) and (s <> a) then
      writeln('Числа ', a, ' и ', s, ' - дружественные');
  end;
  readln;
end.