const name_len = 11; phone_len = 9; separators = [4,7]; type PPhoneEntry = ^TPhoneEntry; TPhoneEntry = record Name : string[name_len]; Phone : string[phone_len]; Next : PPhoneEntry; end; {----------------------------------------} Procedure AddEntry(var CPEntry : PPhoneEntry;aName,aPhone : string); var NE : PPhoneEntry; num : string; i : integer; begin New(NE); with NE^ do begin Name := aName; Phone := aPhone; Next := CPEntry; end; CPEntry := NE; end;{AddEntry} {----------------------------------------} Procedure SortNum(var L:PPhoneEntry); var c,t,m : PPhoneEntry; begin if L^.Next = nil then exit; C:=L^.next; M:=L; while (C^.Next <> nil) do begin if C^.Next^.Phone > M^.Next^.Phone then M:=C; C:=C^.Next; end; if M^.Next^.Phone > L^.Phone then begin T:=M^.Next; M^.Next:=T^.Next; T^.Next:=L; L:=T; end; M:=L; while M^.Next^.Next <> nil do begin c:=M^.Next; while C^.Next <> nil do begin if C^.Next^.Phone > M^.Next^.Phone then begin T:=C^.NEXT; C^.NEXT:=T^.NEXT; T^.NEXT:=M^.NEXT; M^.NEXT:=T; end else C:=C^.Next; end; M:=M^.Next; end; end;{SortNum} {----------------------------------------} var DB,c : PPhoneEntry; INP : text; Name : string[Name_Len]; Phone : string[Phone_Len]; i : integer; begin Assign(INP,'phones.txt'); Assign(Output,'out5.txt'); Rewrite(Output); {$I-} Reset(INP); If IOResult <> 0 then begin WriteLn('File ''phones.txt'' not found'); Halt(255); end; {$I+} DB:=nil; While not EOF(INP) do begin Read(INP,Name); ReadLn(INP,Phone); AddEntry(DB,Name,Phone); WriteLn(Name,Phone); end; Close(INP); WriteLn('Result:'); SortNum(DB); c:=DB; while C<>nil do begin WriteLn(C^.Name,C^.Phone); C:=C^.Next; end; WriteLn('End.'); while DB<>nil do begin C:=DB^.Next; Dispose(DB); DB:=C; end; end.