Курсовая "Базы данных" на pascal

        2:begin str1:=te1^.tabl.t2; str2:=te2^.tabl.t2; end;

        3:begin str1:=te1^.tabl.t3; str2:=te2^.tabl.t3; end;

        4:begin str1:=te1^.tabl.t4; str2:=te2^.tabl.t4; end;

        5:begin str1:=te1^.tabl.t5; str2:=te2^.tabl.t5; end;

      end;

      if str1>str2 then begin

        ttrtt:=te1^.tabl;

        te1^.tabl:=te2^.tabl;

       te2^.tabl:=ttrtt;

      end;

    te2:=te2^.sled;

   end;

  te1:=te1^.sled;

  end;

  tabl1(tek,rab,false);

end; 

procedure obrabotka(iz,t:integer; var rab:cc); {Обработка записей}

var dlud:string;

  bis:boolean;

  tems,temr,tem:cc;

begin

  clrscr;

  if iz=1 then begin          {добавление записи}

     if rab<>nil then begin

       tem:=rab;

       while tem^.sled<>nil do tem:=tem^.sled;

       new(tem^.sled);

       tem:=tem^.sled;

     end

     else begin

       new(rab);

       tem:=rab;

     end;

      writeln(mm[t,1]);readln(tem^.tabl.t1);

      writeln(mm[t,2]);readln(tem^.tabl.t2);

      writeln(mm[t,3]);readln(tem^.tabl.t3);

      writeln(mm[t,4]);readln(tem^.tabl.t4);

      writeln(mm[t,5]);readln(tem^.tabl.t5);

      tem^.sled:=nil;

      tem:=rab;

      izm:=0;

      nast:=menu1;

      menus(nast,nast.m);

      tek:=2; iz:=0;

    end

  else if iz=2 then begin       {Удаление записи}

  tems:=rab;

  tabl1(tek,rab,true);

  writeln('Введите уникальный номер'); readln(dlud);

  bis:=true;

  if rab^.tabl.t1 = dlud then begin

    rab:=rab^.sled;

    bis:=false;

  end

    else begin

      while tems<>nil do begin

        if tems^.sled^.tabl.t1=dlud then begin

          tem:=tems^.sled;

          tems^.sled:=tems^.sled^.sled;

          dispose(tem);

          bis:=false;

          break;

        end;

        tems:=tems^.sled;

      end;

      end;

    if bis then writeln('Данной записи не обнаруженно');

     nast:=menu1;

     menus(nast,nast.m);

     tabl1(tek,rab,false);

     izm:=0;

     tek:=2;

  end

  else if iz=3 then begin   {изменение данных}

    tems:=rab;

    tabl1(tek,rab,true);

    writeln('Введите уникальный номер'); readln(dlud);

    bis:=true;

      while tems<>nil do begin

        if tems^.tabl.t1=dlud then begin

          writeln(mm[t,1]);readln(tems^.tabl.t1);

          writeln(mm[t,2]);readln(tems^.tabl.t2);

          writeln(mm[t,3]);readln(tems^.tabl.t3);

          writeln(mm[t,4]);readln(tems^.tabl.t4);

          writeln(mm[t,5]);readln(tems^.tabl.t5);

          break;

        end;

        tems:=tems^.sled;

      end;

    if bis then writeln('Данной записи не обнаруженно');

     nast:=menu1;

     menus(nast,nast.m);

     tabl1(tek,rab,false);

     izm:=0; tek:=2;

  end;

end; 

procedure zapros(num:integer);    {Запросы}

var str1,str2,str3:string;

tem1,tem2:cc;

nay:boolean;

zz:tabl2;

begin

  clrscr;

  nay:=false;

  case num of

  2:begin         

    tem1:=tt1;

    writeln('Введите фамилию автора книги'); readln(str1);

    writeln('Регистрационный номер книги');readln(str2);

    while tem1<>nil do begin

      if tem1^.tabl.t2=str1 then begin str1:=tem1^.tabl.t1; break; end;

      tem1:=tem1^.sled;

    end;

    tem1:=tt2;

    while tem1<>nil do begin

      if tem1^.tabl.t2=str2 then begin  str2:=tem1^.tabl.t1; break; end;

      tem1:=tem1^.sled;

    end;

    tem1:=tt4;

    while tem1<>nil do begin

      if ((tem1^.tabl.t5=str2) and (tem1^.tabl.t4=str1)) then begin

        textcolor(red);

        writeln('Номере читательского билета, у кого книга на руках-',tem1^.tabl.t1);

        nay:=true; break;

      end;

      tem1:=tem1^.sled;

    end;

  end;

  3:begin                   

    writeln('Введите фамилию читателя');

    readln(str1);

    tem1:=tt2;

    while tem1<>nil do begin

      if tem1^.tabl.t2=str1 then begin  str1:=tem1^.tabl.t3; break; end;

      tem1:=tem1^.sled;

    end;

    tem1:=tt3;

    while tem1<>nil do begin

      if tem1^.tabl.t1=str1 then begin

        textcolor(red);

        writeln('Издательство-');

        with tem1^.tabl do write('     ',t2,', ',t3,', ',t4);

        nay:=true; break;

      end;

      tem1:=tem1^.sled;

    end;

  end;

  4:begin                   

    writeln('Введите автора книги');

    readln(str1);

    tem1:=tt1;

    while tem1<>nil do begin

      if tem1^.tabl.t2=str1 then begin

        textcolor(red);

       writeln('Код издательства, в котором издана книга-',tem1^.tabl.t5);

        nay:=true; break;

      end;

      tem1:=tem1^.sled;

    end;

    end;

  5:begin               

    writeln('Введите дату выдачи книги');

    readln(str1);

    tem1:=tt4; tem2:=tt1;

    textcolor(red);

    while tem1<>nil do begin

      if tem1^.tabl.t2=str1 then begin

        str2:=tem1^.tabl.t4;

        while tem2<>nil do begin

          if tem2^.tabl.t1=str2 then begin

            with tem2^.tabl do

               writeln('Данные о книге-',t3,' ',t4,' ',t2);

            nay:=true;

          end;

          tem2:=tem2^.sled;

        end;

      end;

      tem2:=tt1;   tem1:=tem1^.sled;

    end;

  end;

  6:begin           

  writeln('Введите  фамилию читателя');

  readln(str1);

    tem1:=tt2;

    while tem1<>nil do begin

      if tem1^.tabl.t2=str1 then begin  str1:=tem1^.tabl.t1; break; end;

      tem1:=tem1^.sled;

    end;

    tem1:=tt4;

    while tem1<>nil do begin

      if tem1^.tabl.t5=str1 then begin

        textcolor(red);

        writeln('Дата возврата книги-',tem1^.tabl.t3);

        nay:=true;

      end;

      tem1:=tem1^.sled;

    end;

  end;

  end;

textcolor(red);

if not nay then writeln('Запрос невыполним');

  textcolor(3); readln;

  nast:=menu1;  menus(nast,nast.m);

  tek:=2;

end; 

procedure writetip(temr:cc);

begin

clrscr;

write('Введите имя файла');

 writeln('в котором хотите сохранить данные');

 readln(names);

for i:=1 to 4 do begin

   if temr<>nil then begin temr:=nil; end;

   case i of

     1:begin temr:=tt1; namer:='1'+names; end;

     2:begin temr:=tt2; namer:='2'+names; end;

     3:begin temr:=tt3; namer:='3'+names; end;

     4:begin temr:=tt4; namer:='4'+names; end;

   end;

   assign(outf,namer);  rewrite(outf);

   while temr<>nil do begin

    write(outf, temr^.tabl);

    temr:=temr^.sled;

   end;

CLOSE(outf);

end;

nast:=menu1;  menus(nast,nast.m);  tek:=2;

end; 

procedure readtip(temr:cc);

var tems:cc;

begin

clrscr;

write('Введите имя файла');

 writeln('из которого надо взять данные'); readln(names);

   for i:=1 to 4 do begin

   if temr<>nil then begin  temr:=nil; end;

   if tems<>nil then begin  tems:=nil; end;

   case i of

     1:begin new(tt1); temr:=tt1; namer:='1'+names; end;

     2:begin new(tt2); temr:=tt2; namer:='2'+names; end;

     3:begin new(tt3); temr:=tt3; namer:='3'+names; end;

     4:begin new(tt4); temr:=tt4; namer:='4'+names; end;

   end;

   assign(outf,namer);  reset(outf);

   if eof(outf) then begin

     case i of

     1:begin dispose(tt1);tt1:=nil;end;

     2:begin dispose(tt2);tt2:=nil;end;

     3:begin dispose(tt3);tt3:=nil;end;

     4:begin dispose(tt4);tt4:=nil;end;

     end;

   end

   else begin

   tems:=temr;

   while temr<>nil do begin

    if eof(outf) then break;

    read(outf,temr^.tabl);

    if eof(outf) then break;

    new(temr^.sled);

    temr:=temr^.sled;

   end;

   temr^.sled:=nil;

case i of

     1:tt1:=tems;

     2:tt2:=tems;

     3:tt3:=tems;

     4:tt4:=tems;

end;

   end;

  CLOSE(outf);

end;

nast:=menu1;  menus(nast,nast.m);  tek:=2;

end; 

procedure main;

begin

key:=#0;

  if nast.st[1]=menu1.st[1] then begin {Если меню - основное}

    case tek of

    2:readtip(temr);

    3:writetip(temr);

    4,5,7:begin

      nast:=menu2;  menus(nast,nast.m);

      if tek=7 then issor:=true;

      if tek=4 then vfile:=true