Отсортировать строки фамилия-номер по убыванию номеров

program pr1;
 type t=array [1..24] of char;
 tt=array [1..10] of t;
 var a:tt; i,j:byte;
begin
 assign(input,'dan1.inp');
 reset(input);
 assign(output,'res1.out');
 rewrite(output);
  for i:=1 to 10 do
  begin
   for j:=1 to 24 do
   begin
    read(a[i,j]);
    write(a[i,j]);
   end;
    readln;
    writeln;
  end;
  close(input);
  close(output)
end.

uses Classes;
var
  i,j:integer;
  S:TStringList;
begin
   s:=TStringlist.Create;
   s.loadfromfile('dan1.inp');
   for i:=0 to s.count-2 do
     for j:=i+1 to s.count-1 do
     if copy(s[i],16,length(s[i]))<copy(s[j],16,length(s[j])) then s.exchange(i,j);
   s.savetofile('res1.out');
   s.free;
end.

{$mode objfpc} 
uses classes, sysutils;
function f(List: TStringList; I1, I2: Integer): Integer;
begin
  result := comparestr(copy(list[i1], 16, 255), copy(list[i2], 16, 255));
end;
 
var s : string;
begin
  with tstringlist.create do
  try
    loadfromfile('dan1.inp');
    customsort(@f);
    savetofile('res1.out');
  finally
    free;
  end;
end.

result := comparestr(copy(list[i2], 16, 255), copy(list[i1], 16, 255));

const m=10; n=24; p=16;
var
  a: array [1..m,1..n] of Char;
  i, j, k: Integer; t: Char;
begin
  FillChar(a,SizeOf(a),' ');
  Assign(input,'dan1.inp'); Reset(input);
  Assign(output,'res1.out'); Rewrite(output);
  while not EoF and (i<m) do begin
    Inc(i); j:=0;
    while not EoLn and (j<n) do begin
      Inc(j); Read(a[i,j]);
    end; ReadLn;
  end;
  for i:=m downto 2 do for j:=2 to i do begin
    k:=p; while (k<=n) and (a[j-1,k]=a[j,k]) do Inc(k);
    if (k<=n) and (a[j-1,k]<a[j,k]) then
      for k:=1 to n do begin
        t:=a[j-1,k]; a[j-1,k]:=a[j,k]; a[j,k]:=t;
      end;
  end;
  for i:=1 to m do begin
    for j:=1 to n do Write(a[i,j]); WriteLn;
  end;
  Close(input); Close(output);
end.

const m=10; n=24; p=15;
var
  a: array [1..m,0..n] of Char;
  i, j, k: Integer; t: Char;
begin
  Assign(input,'dan1.inp'); Reset(input);
  Assign(output,'res1.out'); Rewrite(output);
  while not EoF and (i<m) do ReadLn(a[i]);
  for i:=m downto 2 do for j:=2 to i do begin
    k:=p; while (k<n) and (a[j-1,k]=a[j,k]) do Inc(k);
    if (k<n) and (a[j-1,k]<a[j,k]) then
      for k:=0 to n-1 do begin
        t:=a[j-1,k]; a[j-1,k]:=a[j,k]; a[j,k]:=t;
      end;
  end;
  for i:=1 to m do WriteLn(a[i]);
  Close(input); Close(output);
end.