old/PAS/!SPbSTU/1st/2.pas

const
 count		= 20;
 len		= 20;
 first_numb	= 12;

var
  DB	     : array [1..count] of string;
  INP	     : text;
  k          : integer;

Procedure Exchange(var s1,s2 : string);
var
 tmp : string;
begin
  tmp := s1;
  s1 := s2;
  s2 := tmp;
end;

Procedure SortNum(num : integer);
var
 i, j : integer;
begin
  for i := 1 to count-1 do
   for j:=count-1 downto i do
    begin
     if DB[j+1,num] > DB[j,num] then Exchange(DB[j], DB[j+1]);
    end;
end;

begin
  Assign(INP,'phones.txt');
  {$I-}
    Reset(INP);
    If IOResult <> 0 then
     begin
       WriteLn('File ''phones.txt'' not found');
       Halt(255);
     end;
  {$I+}

  for k := 1 to count do
     ReadLn(INP,DB[k]);
  Close(INP);

  for k := first_numb+8 downto first_numb do
   if not (k in [first_numb+3,first_numb+6]) then
     SortNum(k);

  for k := 1 to count do
    WriteLn(DB[k]);
  WriteLn('End.');
end.