old/PAS/!SPbSTU/1st/5.BAK

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.