Найти число от 1 до n с максимальной суммой делителей

Program b;
Var
n,i,j,max,maxn:Integer;
a:Array[1..1000000] Of Integer;
BEGIN
      Readln(n);
      j:=1;
      For i:=1 To n Do
        a[i]:=1;
      For i:=2 To n Do
        Begin
              j:=i;
              While j<=n Do
              Begin
                a[j]:=a[j]+i;
                j:=j+i;
              End;
        End;
      max:=a[1];
      maxn:=1;
      For i:=1 To n Do
        If (a[i]>max) Then
        Begin
              max:=a[i];
              maxn:=i;
        End;
      Writeln(maxn);
END.

Program b;
var n,i,j,k,max,maxn:Integer;
begin
readln(n);
max:=1;
maxn:=1;
for i:=2 To n Do
 begin
  k:=2;//1 и само 
  for j:=2 to trunc(sqrt(i)) do//считаем делители до корня из числа и умножаем на 2
  if i mod j=0 then inc(k,2);
  if frac(sqrt(i))=0 then dec(k);//если число полный квадрат, то минус 1
  if k>max then
   begin
    max:=k;
    maxn:=i;
   end;
  end;
write(maxn);
end.

Program b;
Var
n,i,j,max,maxn:Longint;
a:Array[1..1000000] Of Longint;
BEGIN
      Readln(n);
      j:=1;
      For i:=1 To n Do
        a[i]:=1;
      For i:=2 To n Do
        Begin
              j:=i;
              While j<=n Do
              Begin
                a[j]:=a[j]+i;
                j:=j+i;
              End;
        End;
      max:=a[1];
      maxn:=1;
      For i:=1 To n Do
        If (a[i]>max) Then
        Begin
              max:=a[i];
              maxn:=i;
        End;
      Writeln(maxn);
END.