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.