Из Turbo Pascal в PascalABC.NET

const maxn = 10000;
type longint = integer;
var n: integer;
    i, j: integer;
    o, l, r, mx: longint;
    mas: array [1..maxn] of longint;
    k, up: array [1..maxn] of longint;
procedure Sort(ll, rr: word);
var
  ii, jj, xx, yy: word;
begin
  ii := ll; jj := rr; xx := mas[(ll+rr) DIV 2];
  repeat
    while mas[ii] < xx do ii := ii + 1;
    while xx < mas[jj] do jj := jj - 1;
    if ii <= jj then
    begin
      yy := mas[ii]; mas[ii] := mas[jj]; mas[jj] := yy;
      yy := up[ii]; up[ii] := up[jj]; up[jj] :=yy;
      ii := ii + 1; jj := jj - 1;
    end;
  until ii > jj;
  if ll < jj then Sort(ll, jj);
  if ii < rr then Sort(ii, rr);
end;
 
begin
     assign(input, 'input.txt'); reset(input);
     assign(output, 'output.txt'); rewrite(output);
     read(n);
     for i:=1 to n do
     begin
          read(mas[i]);
          up[i]:=i;
     end;
     sort(1, n);
     fillchar(k, sizeof(k), 0);
     for i:=1 to n do
      for j:=i+1 to n do
begin
            mx:=longint(mas[i])+mas[j];
       if mx>mas[n] then break;
                l:=j+1;
                r:=n;
                o:=1; if mx>mas[l] then
                while l<r-1 do
                begin
                     o:=(l+r+1) div 2;
                     if mas[o]<mx then l:=o else r:=o;
                end;
                if mas[l]<>mx then l:=r;
                while mas[l]=mx do
                begin
                     inc(k[up[l]]); inc(l);
                end;
           end;
           for i:=1 to n do
                writeln(k[i]);
end.

for i:=1 to maxn do
       k[i]:=0;

assign(input, 'input.txt'); reset(input);

const
      maxn = 10000;
    var
      n: integer;
      i, j: integer;
      o, l, r, mx: longint;
      mas: array [1..maxn] of longint;
      k, up: array [1..maxn] of longint;
     
    procedure Sort(l, r: word);
    var
      i, j, x, y: word;
    begin
      i := l; j := r; x := mas[(l + r) DIV 2];
      repeat
        while mas[i] < x do i := i + 1;
        while x < mas[j] do j := j - 1;
        if i <= j then
        begin
          y := mas[i]; mas[i] := mas[j]; mas[j] := y;
          y := up[i]; up[i] := up[j]; up[j] := y;
          i := i + 1; j := j - 1;
        end;
      until i > j;
      if l < j then Sort(l, j);
      if i < r then Sort(i, r);
    end;
    begin
      read(n);
      for i := 1 to n do
      begin
        read(mas[i]);
        up[i] := i;
      end;
      sort(1, n);
      for i := 1 to maxn do
        k[i] := 0;
      for i := 1 to n do
        for j := i + 1 to n do
        begin
          mx := longint(mas[i]) + mas[j];
          if mx > mas[n] then break;
          l := j + 1;
          r := n;
          o := 1; if mx > mas[l] then
            while l < r - 1 do
            begin
              o := (l + r + 1) div 2;
              if mas[o] < mx then l := o else r := o;
            end;
          if mas[l] <> mx then l := r;
          while mas[l] = mx do
          begin
            inc(k[up[l]]); inc(l);
          end;
        end;
      for i := 1 to n do
        write(k[i],' ');
    end.