ITMO task 3 (sorting)

input.txt

ABCDEFGHIJ
ACHH
ACHA
ACGJ
ACGB
ADJA
ADJD
ADIE
ADIC
BEAI
BEAF
BEFC
BEFH
BFGB
BFGI
BFJD
BFJG

task.pas

var 
  conn: array of array of boolean;
  alph: array[0..1000] of integer;
  s, sa: string;
  fl: Text;
  n: integer;
  
  status: Array of byte;
  sorted: Array of integer;
  top: integer;
  
procedure DFS(const u: integer);
begin
  status[u] := 1;
  for var v := 0 to n-1 do
  begin
    if conn[u][v] then
    begin
      if status[v] = 1 then
      begin
        Writeln('Cycle detected, cannot be decoded, sorry((');
        Halt;
      end;
      if status[v] = 0 then
        DFS(v);
    end;
  end;
    
  status[u] := 2;
  sorted[top] := u;
  inc(top);
end;
   
procedure topo_sort;
begin
  var start := 0;
  
  for var i:=0 to n-1 do
  begin
    var ctr := 0;
    for var j:=0 to n-1 do
    begin
      if conn[j][i] then
        Inc(ctr);
    end;
    
    if ctr = 0 then
      start := i;
  end;
  
  top := 0;
  status := new byte[n];
  sorted := new integer[n];
  for var u := 0 to n-1 do
    status[u] := 0;
  DFS(start);
  
  if top < (n-1) then
  begin
    Writeln('Info is not complete...');
    Halt;
  end;
end;
  
begin
  assign (fl , 'input.txt');
  reset(fl);
  
  Readln(fl, s);
  sa := s;
  n := sa.Length;
  for var i := 1 to sa.Length do
  begin
    alph[Ord(sa[i])] := i - 1;
  end;
  
  setlength(conn, n);
  for var j := 0 to n-1 do
  begin
    setlength(conn[j], n);
  end;
  
  var j := 0;
  var sp: string;
  while not eof(fl) do
  begin
    readln(fl, s);
    if j > 0 then
    begin
      for var k := 1 to s.length do
      begin
        if s[k] <> sp[k] then
        begin
          var o1 := alph[Ord(s[k])];
          var o2 := alph[Ord(sp[k])];
          conn[o1][o2] := true;
          break;
        end;
      end;
    end;
    
    Inc(j);
    sp := s;
  end;
  close(fl);
  
  topo_sort();
  
  for var i := 0 to n-1 do
  begin
    Write(i);
    Write(' -> ');
    Writeln(sa[1 + sorted[i]]);
  end;
end.