同一个贴子不要重复发两次

program game;
var a:array [3..1000] of longint;
procedure pre;
var i,j:integer;
begin
  fillchar(a,sizeof(a),0);
  for i:=3 to 1000 do
    for j:=1 to i-1 do
      if (i mod j=0) then a[i]:=a[i]+j;
end;
procedure main;
var i:integer;
    used:array [3..1000] of boolean;
begin
  fillchar(used,sizeof(used),false);
  for i:=3 to 1000 do
    if (a[a[i]]=i) and (i<>a[i]) and (not(used[i]) or not(used[a[i]])) then
    begin
      writeln(i,' ',a[i]);
      used[i]:=true;
      used[a[i]]:=true;
    end;
end;
begin
  pre;
  main;
end.