Энциклопедия Turbo Pascal. Главы 1-4
Страница 27. Список адресов почтовых корреспонденций, построенный в виде списка с двумя связями


Список адресов почтовых корреспонденций, построенный в виде списка с двумя связями

     Ниже приведена простая программа для списка почтовых коррес-
понденций,  построенного  в  виде списка с двойной связью.  Здесь
весь список содержится в оперативной  памяти.  Однако,  программа
может быть изменена для хранения списка на диске.
    {простая  программа для списка адресов почтовых корреспон-
    денций, иллюстрирующая применение списков с двойной связью}
   program mailing_list;

     type
       str80 = string[80];
       AddrPointer = -address;
       address = record
         name: string[30];
         street: string[40];
         city: string[20];
         state: string[2];
         zip: string[9];
         next: AddrPointer;  { указатель  на следующую запись }
         prior: AddrPointer; { указатель на предыдущую запись }
       end;

       DataItem = address;
       filtype = file of address;

     var
       t, t2: integer;
       mlist: FilType;
       start, last: AddrPointer;
       done: boolean;

     { вызов меню }
     function MenuSelect: char;
     var
       ch: char;
           begin
             Writeln('1. Enter names');
             Writeln('2. Delete a name');
             Writeln('3. Display the list');
             Writeln('4. Search for a name');
             Writeln('5. Save the list');
             Writeln('6. Load the list');
             Writeln('7. Quit');
             repeat
               Writeln;
               Write('Enter your choice: ');
               Readln(ch);
               ch := UpCase(ch);
             until (ch>='1') and (ch<='7')
             MenuSelect := ch;
             end;{ конец выбора по меню }

{ упорядоченная установка элементов в список с двойной связью }
           function DSL_Store(info, start: AddrPointer;
                              var last: AddrPointer): AddrPointer;
  { вставка элементов в соответствующее место с сохранением
                      порядка }
           var
             old, top: AddrPointer;
             done: boolean;
           begin
             top := start;
             old := nil;
             done := FALSE;

             if start = nil then begin { первый элемент списка }
               info^.next := nil;
               last := info;
               info^.prior :=nil;
               DSL_Store := info;
             end else
             begin
               while (start<>nil) and (not done) do
               begin
                 if start^.name < info^.name then
                 begin
                   old := start;
                   start := start^.next;
                 end else
                 begin { вставка в середину }
                   if old <>nil then
                     begin
                     old^.next := info;
                     info^.next := start;
                     start^.prior := info;
                     info^.prior := old;
                     DSL_Store := top; { сохранение начала }
                     done := TRUE;
                   end else
                   begin
                     info^.next := start;{новый первый элемент }
                     info^.prior := nil;
                     DSL_Store := info;
                     done := TRUE;
                   end;
                 end;
               end;  { конец цикла }
               if not done then begin
                 last^.next := info;
                 info^.next := nil;
                 info^.prior := last;
                 last := info;
                 DSL_Store := top; { сохранение начала }
               end;
             end;
           end;  { конец функции DSL_Store }

        { удалить элемент из списка с двойной связью }
           function DL_Delete(start: AddrPointer
                              key: str[80]): AddrPointer
           var
             temp, temp2: AddrPointer
             done: boolean;
           begin
             if star^.name = key then begin { первый элемент
           списка }
              DL_Delete := start^.next;
              if temp^.next <> nil then
              begin
                temp := start^.next;
                temp^.prior := nil;
              end;
              dispose(start);
           end else
           begin
             done := FALSE;
             temp := start^.next;
             temp2 := start;
             while (temp <> nil) and (not done) do
             begin
               if temp^.next <> nil then
                  temp^.next^.prior := temp2
                  done := TRUE
                  dispose(temp);
             end else
               begin
                 temp2 := temp;
                 temp := temp^.next;
               end;
             end;
             DL_Delete := start; { начало не изменяется }
             if not done then Writeln('not found');
           end;
         end; { конец функции DL_Delete }

          { удаление адреса из списка }
           procedure remove;
           var
             name:str80;
           begin
             Writeln('Enter name to delete: ');
             Readln(name);
             start := DL_Delete(start,name);
           end;  { конец процедуры удаления адреса из списка }

           procedure Enter;
           var
             info: AddrPointer;
             done: boolean;
           begin
             done := FALSE;
             repeat
             new(info)  { получить новую запись }
             Write('Enter name: ');
             Readln(info^.name);
             if Length(info^.name)=0 then done := TRUE
             else
             begin
               Write(Enter street: ');
               Readln(info.street);
               Write(Enter city: ');
               Readln(info.city);
               Write(Enter state: ');
               Readln(info.state);
               Write(Enter zip: ');
               Readln(info.zip);
               start := DSL_Store(info, start, last); { вставить
           запись }
             end;
           until done;
         end;  { конец ввода }

           { вывести список }
           procedure Display(start:AddrPointer);
           begin
             while start <> nil do begin
               Writeln(start^.name);
               Writeln(start^.street);
               Writeln(start^.city);
               Writeln(start^.state);
               Writeln(start^.zip);
               start := start^.next
               Writeln;
             end;
           end;

          { найти элемент с адресом }
           function Search(start: AddrPointer; name: str80):
                          AddrPointer;
           var
             done: boolean;
           begin
             done := FALSE
             while (start <> nil) and (not done) do begin
               if name = start^.name then begin
                 search := start;
                 done := TRUE;
               end else
               start := star^.next;
             end;
             if start = nil then search := nil; { нет в списке }
           end; { конец поиска }

           { найти адрес по фамилии }
           procedure Find;
           var
             loc: Addrpointer;
             name: str80;
           begin
             Write('Enter name to find: ');
             Readln(name);
             loc := Search(start, name);
             if loc <> nil then
             begin
               Writeln(loc^.name);
               Writeln(loc^.street);
               Writeln(loc^.city);
               Writeln(loc^.state);
               Writeln(loc^.zip);
             end;
             else Writeln('not in list')
              Writeln;
           end; { Find }

           { записать список на диск }
           procedure Save(var f:FilType; start: AddrPointer):
           begin
             Writeln('saving file');
             Rewrite(f);
             while start <> nil do begin
             write(f,start);
             start := start^.next;
             end;
          end;
                       { загрузить список с файла }
           procedure Load(var f:FilType; start: AddrPointer):
                        AddrPointer;
           var
             temp, temp2: AddrPointer
             first: boolean;
           begin
             Writeln('load file');
             Reset(f);
             while start <> nil do begin  { освобождение памяти
                                           при необходимости }
               temp := start^.next
               dispose(start);
               start := temp;
             end;

             start := nil; last := nil;
             if not eof(f) then begin
               New(temp);
               Read(i, temp^);
               temp^.next := nil;  temp^.prior:= nil;
               load := temp;  { указатель на начало списка }
             end;

               while not eof(f) do begin
                 New(temp2);
                 Read(i, temp2^);
                 temp^.next := temp2; { построить список }
                 temp2^.next := nil;
                 temp^.prior := temp2;
                 temp := temp2;
               end;
               last := temp2;
             end; { конец загрузки }

             begin
               start := nil; { сначала список пустой }
               last := nil;
               done := FALSE;

               Assign(mlist, 'mlistd.dat');

               repeat
                 case MenuSelect of
                   '1': Enter;
                   '2': Remove;
                   '3': Display(start);
                   '4': Find;
                   '5': Save(mlist, start);
                   '6': start := Load(mlist, start);
                   '7': done := TRUE;
                 end;
               until done=TRUE;
           end. { конец программы }

 
« Предыдущая статья