прикладная математика

Program Dovidnik;
uses
  crt;
type
  Tinf=string[30];
  List=^TList;
  TList=record
    sname, name, mname, adr:TInf;
    tel: word;
    next:List;
  end;

Procedure AddElem(var stek1:List;znach1,znach2,znach3,znach4:TInf;znach5:word);
var
  tmp:List;
begin
  GetMem(tmp,sizeof(TList));
  tmp^.next:=stek1;
  tmp^.sname:=znach1;
  tmp^.name:=znach2;
  tmp^.mname:=znach3;
  tmp^.adr:=znach4;
  tmp^.tel:=znach5;
  stek1:=tmp;
end;

Procedure Print(tmp:List);
var
  i:integer;
begin
   i:=0;
   clrscr;
   Writeln('Вивiд всіх записiв');
   writeln;
        if tmp=nil then
          begin
           writeln('Записiв не знайдено.');
           exit;
          end;
   while tmp<>nil do
        begin
         i:=i+1;
         writeln (i,' запис.');
         write (tmp^.sname,' ');
         write (tmp^.name[1],'.');
         writeln (tmp^.mname[1],'.');
         writeln (tmp^.adr);
         writeln (tmp^.tel);
         writeln;
         tmp:=tmp^.next
        end;
   writeln ('Всього записiв: ',i);
end;

Procedure FreeStek(stek1:List);
var
  tmp:List;
begin
  while stek1<>nil do
  begin
    tmp:=stek1;
    stek1:=stek1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;

Function SearchElemZnach(stek1:List;znach1:TInf):List;
begin
  clrscr;
  if stek1<>nil then
    while (Stek1<>nil) and (znach1<>stek1^.sname) do
      stek1:=stek1^.next;
  SearchElemZnach:=stek1;
end;

Function SearchElemZnach2(stek1:List;znach5:word):List;
begin
  clrscr;
  if stek1<>nil then
    while (Stek1<>nil) and (znach5<>stek1^.tel) do
      stek1:=stek1^.next;
  SearchElemZnach2:=stek1;
end;

Procedure DelElem(var stek1:List;tmp:List); //видалення за назвою
var
  tmpi:List;
begin
  if (stek1=nil) or (tmp=nil) then
    exit;
  if tmp=stek1 then
  begin
    stek1:=tmp^.next;
    FreeMem(tmp,SizeOf(word));
  end
  else
  begin
    tmpi:=stek1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    FreeMem(tmp,sizeof(TList));
  end;
end;

Procedure DelElemZnach(var Stek1:List;znach1:word);   //видалення за значенням
var
  tmp:List;
begin
  if Stek1=nil then
  begin
    Writeln('Записiв не знайдено.');
    exit;
  end;
  tmp:=SearchElemZnach2(stek1,znach1);
  if tmp=nil then
  begin
    writeln('Елемент' ,znach1, ' вiдсутнiй.');
    exit;
  end;
  DelElem(stek1,tmp);
  Writeln('Елемент видалено');
end;

Var
  Stk,  //Вершина
  tmpl:List;
  znach1,znach2,znach3,znach4:Tinf;
  znach5:word;
  ch:char;

Begin
    Stk:=nil;
    repeat
    clrscr;
    Writeln('Електронний телефонний довідник');
    Writeln;
    Writeln ('Меню');
    Writeln('1) Створення нового запису');
    Writeln('2) Вивiд всіх записів');
    Writeln('3) Пошук запису за прiзвищем');
    Writeln('4) Видалити запис за тел. номером');
    Writeln('5) Вихiд');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin
            clrscr;
            write('Введiть прiзвище: ');
            readln(znach1);
            write('Введiть iм''я: ');
            readln(znach2);
            write('Введiть по батьковi: ');
            readln(znach3);
            write('Введiть адресу: ');
            readln(znach4);
            write('Введiть номер телефону: ');
            readln(znach5);
            AddElem(Stk,znach1,znach2,znach3,znach4,znach5);
          end;

      '2':begin
            clrscr;
            Print(Stk);
            readkey;
          end;

     '3':begin
            clrscr;
            write('Введiть прiзвище: ');
            readln(znach1);
            tmpl:=SearchElemZnach(Stk,znach1);
            if tmpl=nil then
              write('Запис вiдсутнiй')
            else
               write (tmpl^.sname,' ');
               write (tmpl^.name,' ');
               writeln (tmpl^.mname);
               writeln (tmpl^.adr);
               writeln (tmpl^.tel);
               writeln;
               readkey;
         end;

     '4':begin
            clrscr;
            Write('Введіть тел. номер: ');
            readln(znach5);
            DelElemznach(Stk,znach5);
            readkey;
          end;
   end;

  until ch='5';
  FreeStek(Stk);
End.