Динамические однонаправленые списки

uses crt;
type
       link = ^kom;
       kom  = record
               Nomer : integer;
               Avtor : string[40];
               Nazvanie : String[40];
               God : integer;
               Na_ruk : String[40];
               next : link;
          end;
       fl = file of kom;
var
     spisok, nach, nach2 : link;
                       z : kom;
        k, i, n, menu, m : integer;
                       a : char;
                       f : fl;
                  FlName : string;
 
{Ввод списка с клавиатуры}
procedure create(var sp1, nach1:link; var z : kom);
begin
  write('Nomer knigi:');  {Ввод данных с клавиатуры}
  readln(z.nomer);
  write('Avtor knigi: ');
  readln(z.avtor);
  write('Nazvanie knigi: ');
  readln(z.nazvanie);
  write('God izdaniya:');
  readln(z.god);
  Write('Na rukah:');
  readln(z.na_ruk);
  z.next := nil;
  if nach1 = nil then     {формирование списка согласно введеным данным с клавиатуры}
  begin
    new(nach1);
    nach1^ := z;
    sp1 := nach1;
    nach1^.next:=nil;
  end
  else
  begin
    new(sp1^.next);
    sp1:=sp1^.next;
    sp1^ := z;
    sp1^.next:=nil;
  end;
end;{ create }
 
{Вывод списка на экран }
procedure print(nach1 : link);
var
  sp1 : link;
begin
 sp1:=nach1;
 if sp1=nil then writeln('Spisok Pust!') {проверка если ли в списке данные}
 else
 begin                       {печать списка}
   write('|------------------------------------------------------------------------------|');
   write('| Nomer Knigi | Avtor knigi      | Nazvanie knigi | God izdaniya | Na rukah    |');
   write('|------------------------------------------------------------------------------|');
   while sp1<>nil do
   begin
     gotoXY(5,whereY);write('|',sp1^.nomer);
     gotoXY(21,whereY);write('|',sp1^.avtor);
     gotoXY(50,whereY);write('|  ',sp1^.nazvanie);
     gotoXY(60,whereY);write('|  ',sp1^.god);
     gotoXY(70,whereY);write('|  ',sp1^.na_ruk);
     sp1:=sp1^.next;
   end;
   writeln('|------------------------------------------------------------------------------|');
 end;
 writeln;
end; { print }
 
{Добавление элемента в список }
procedure add(var nach1 : link; z : kom; num:integer);
var
   sp1, sp2 : link;
   i : integer;
begin
   new(sp1);   {выделение памяти}
   sp1^ :=z;   {добавление элемента в список}
   if nach1=nil then
   begin
     nach1:= sp1;
     sp1^.next:=nil;
   end
   else
   if num=1 then       {вставка в начало списка введенного элемента}
   begin
     sp1^.next:=nach1;   {сдвигаем список на один элемента}
     nach1:= sp1;        {добавляем элемент в список}
   end
   else            {если же введена не первая позиция для добавления}
   begin
      i:=0;
      sp2:= nach1;
      while (i<>num-2) and (sp2^.next<>nil) do {поиск позиции для добавления элемента}
      begin
        i:= i+1;
        sp2:= sp2^.next;
      end;
      sp1^.next:=sp2^.next;
      sp2^.next:= sp1;      {добавление элемента в список}
   end;
end; { add }
 
{Редактирование элемента списка}
procedure edit(var sp1, nach1:link; var z : kom);
var
 n:integer;
begin
  Write('Vvedite nomer elementa:');
  readln(n);  sp1:=nach1;
  For I:=1 to n do sp1:=sp1^.next;
  write('Nomer knigi:');  {Ввод данных с клавиатуры}
  readln(z.nomer);
  write('Avtor knigi: ');
  readln(z.avtor);
  write('Nazvanie knigi: ');
  readln(z.nazvanie);
  write('God izdaniya:');
  readln(z.god);
  Write('Na rukah:');
  readln(z.na_ruk);
  z.next := nil;
  if nach1 = nil then     {формирование списка согласно введеным данным с клавиатуры}
  begin
    new(nach1);
    nach1^ := z;
    sp1 := nach1;
    nach1^.next:=nil;
  end
  else
  begin
    sp1^ := z;
    sp1^.next:=nil;
  end;
end;{ edit }
 
{Удаление элемента из списка}
procedure del(var nach1 : link; num : integer);
var
   sp1, sp2 : link;
   i : integer;
begin
   if nach1<>nil then
   begin
     if num=1 then   {удаление первого элемента из списка}
     begin
       sp1:=nach1;
       nach1:=nach1^.next;
       dispose(sp1);  {освобождение памяти(удаление элемента)}
     end
     else
     begin       {если введена не первая позиция для удаления}
       i:=0;      {ищем введенную позицию, чтобы удалить элемент}
       sp2:=nach1;
       while (i<>num-2) and (sp2^.next<>nil) do {поиск введенной позиции для удаления элемента}
       begin
         i:=i+1;
         sp2:=sp2^.next;
       end;
       if sp2^.next<>nil then
       begin
         sp1:=sp2^.next;
         sp2^.next:=sp1^.next;
         dispose(sp1); {освобождение памяти(удаление элемента)}
       end;
     end;
   end;
end; { del }
 
{Поиск элемента в списке}
Procedure FindElement(nach : link; m:integer; z:kom);
var
  p : link;
  srb, eps : real; {добавление переменной real наименование srb, чтобы у z было z.srb}
begin
  eps:=0.01;  {т.к. переменные не целого типа равны бывают очень редко, то введём точность}
  p := nach;  {указывает на первую запись}
  while p <> nil do {Поиск элемента в списке по соответствующему условию}
  begin
    case m of
      1 : if p^.nomer=z.nomer then print(p);   {Печать найденного элемента}
      2 : if p^.avtor=z.avtor then print(p);
      3 : if p^.nazvanie=z.nazvanie then print(p);
      4 : if p^.god=z.god then print(p);
      5 : if p^.na_ruk=z.na_ruk then print(p);
    end;
    p := p^.next;
  end;
end;
 
{Создание нового списка nach2 отсортированного по алфавиту (сортировка по фамилии)}
procedure AddInSortSpisok(z: kom; var nach2: link);
var
  p, pr, t: link ;
begin
  new(t);
  t^ := z; {новый элемент}
  p := nach2;
  pr := nil;
  while (p<>nil) and (p^.nomer<z.nomer) do {ищем место привязки по фамилии}
  begin
    pr := p;
    p:= p^.next;
  end;
  t^.next := p; {вставка, привязка на нужное место "между" p и pr}
  if pr = nil then nach2 := t {будет первый эл-т в списке}
              else
                pr^.next := t;  print(nach);
end;
 
{Открывает список из файла}
procedure SpisokFromFile(var f: fl; var nach: link);
var spisok: link;
begin
  write('Vvedite put do fayla: ');
  readln(FlName);
  assign(f, FlName); {файл должен существовать!!!}
  reset(f);
  nach := nil;
  spisok:= nil;
  while not eof(f) do       {формирование списка из файла}
  begin
    read(f, z);    {чтение файла}
    z.next := nil; {на всякий случай... }
    if nach = nil then
    begin
      new(nach);
      nach^ := z;
      spisok := nach;
      nach^.next:=nil;
    end
    else
    begin
      new(spisok^.next);
      spisok:=spisok^.next;
      spisok^ := z;
      spisok^.next:=nil;
    end;
  end;
  close(f);
end;
 
{Сохраняет список в файл}
procedure SpisokToFile(var f: fl; var nach: link);
var
  spisok: link;
begin
  write('Vvedite put do fayla: ');
  readln(FlName);
  assign(f, FlName); {файл может и не существовать}
  rewrite(f);         {если в списке были данные, они будут заменены новыми, старые утеряны}
  spisok:= nach;
  while spisok<>nil do   {сохранение списка в файл}
  begin
    z := spisok^;
    write(f, z);
    spisok:=spisok^.next;
  end;
  close(f);
end;
 
begin
  clrscr;
  nach := nil;
  spisok:= nil;
  menu:=1;
  while menu<>0 do
  begin
    writeln('1 - Create new list.');
    writeln('2 - Added element in list.');
    writeln('3 - Output list.');
    Writeln('4 - Edit element of list');
    writeln('5 - Deleted element of list.');
    writeln('6 - Search');
    writeln('7 - Sortirovka spiska.');
    writeln('8 - Save and Open.');
    writeln('0 - Exit');
    writeln;
    write('Vibirite punkt menu: ');
    readln(menu);
    if (menu in [1..8,0]) then {проверка правильности ввода данных}
    begin
      case menu of  {Основное меню программы}
        1 : begin
              clrscr;
              repeat
                create(spisok,nach,z);
                writeln('Vi }l{elaete prodol}l{it vvod danih? Y/N ');
                readln(a);
              until (a = 'n') or (a = 'N');
            end;
        3 : begin
              clrscr;
              print(nach);
            end;
        2 : begin
              write('Nomer knigi: ');
              readln(z.nomer);
              write('Avtor knigi: ');
              readln(z.avtor);
              write('Nazvanie Knigi: ');
              readln(z.nazvanie);
              write('God izdaniya:');
              readln(z.god);
              Write('Na rukah:');
              readln(z.na_ruk);
              write('Vvedite Poziciyu dlya novogo elementa: ');
              readln(n);
              add(nach,z,n);
              writeln;
            end;
        5 : begin
              write('Vvedite nomer elementa kotorigo hotite udolit: ');
              readln(n);
              del(nach,n);
            end;
        6 : begin
              clrscr;
              writeln('Vibirite kriteriy poiska: ');
              writeln('1 - Po nomeru');
              writeln('2 - Po avtoru');
              writeln('3 - Po nazvaniyu');
              writeln('4 - Po godu izdaniya');
              writeln('5 - Na rukah');
              writeln('0 - Exit');
              writeln;
              write('Выберите пунк меню: ');
              readln(m);
              if m in [1,2,3,4,5,0] then  {Подменю программы}
              begin
                case m of
                  1 : begin
                        write('Nomer knigi: ');
                        readln(z.nomer);
                        FindElement(nach,m,z);
                      end;
                  2 : begin
                        write('Avtor knigi: ');
                        readln(z.avtor);
                        FindElement(nach,m,z);
                      end;
                  3 : begin
                        write('Nazvanie knigi: ');
                        readln(z.nazvanie);
                        FindElement(nach,m,z);
                      end;
                  4 : begin
                        write('God Izdaniya: ');
                        readln(z.god);
                        FindElement(nach,m,z);
                      end;
                  5 : begin
                        write('Na rukah: ');
                        readln(z.na_ruk);
                        FindElement(nach,m,z);
                      end;
 
                end;
              end
            end;
        7 : begin
              clrscr;
              AddInSortSpisok(z,nach2);
              writeln('Otsortirovaniy spisok:');
              print(nach2);
            end;
        4 : edit(spisok,nach,z);
        8 : begin
               clrscr;
               repeat
                 writeln('1 - Open fail');
                 writeln('2 - Save fail');
                 writeln('0 - Exit');
                 writeln;
                 write('Vibirite deystvie s failom: ');
                 readln(m);
                 if m in [1,2,0] then {Подменю программы}
                 begin
                   case m of
                     1 : SpisokFromFile(f,nach);
                     2 : SpisokToFile(f,nach);
                   end;
                 end
                 else
                   begin
                     writeln;
                     writeln('Ne verniy vvod, dospupni tolko 1, 2 i 0');
                     writeln;
                   end;
                 writeln;
                until m = 0;
            end;
 
      end; {case}
    end
    else
    begin
      writeln;
      writeln('Dostupni tolko 1,2,3,4,5,6,7,8,0');
      writeln;
    end;
  end; {while}
end.