Тестирование СУБД осуществить на БД «Библиотека»

 
program SemesterWork; 
uses CRT; 
const NZ=4; 
      NM=7; 
      NF=7; 
      COLOR1=blue; 
      COLOR2=yellow; 
      Group='АУ-120'; 
      NAME='ИВАНОВ ИВАН'; 
      MX=25; 
    MY=80; 
      X=27; 
      Y=10; 
      OUTCOD = '*'; 
type 
  TDate = Record 
    d,m:byte; 
    y:word; 
    end; 
  Trec = Record 
    f1:string[30]; 
    f2:TDate; 
    f3:string[30]; 
    f4:TDate; 
    f5:word; 
    f6:string[70]; 
    f7:string[30]; 
    end; 
  TDB = file of Trec; 
  TZA = array[1..NZ]of string; 
  TMA = array[1..NM]of string; 
  TNF = array[1..NF]of string; 
const 
  Z:TZA = ('Список новорожденных, отсортированный  
по датам рождения', 
           'Список новорожденных, зарегистрированных в 
 определенный день', 
           'Данные о ребенке по данным о родителях', 
           'Выход'); 
  M:TMA = ('Создание БД', 
           'Вывод БД', 
           'Добавление записей в БД', 
           'Удаление записей из БД', 
           'Корректировка сведений в БД', 
           'Запрос', 
           'Выход'); 
  FLD:TNF = ('ФИО', 
             'Дата рождения', 
             'Место рождения', 
             'Дата регистрации', 
             'Номер записи в книге регистрации', 
             'Сведения о родителях', 
             'Свидетельство о рождении'); 
var 
  F:TDB; 
  R:Trec; 
  C:Char; 
  D,i:Byte; 
{процедура вывода титульного листа} 
procedure TitulnyList; 
begin 
  clrScr; 
  textbackground(COLOR1); 
  textcolor(COLOR2); 
  clrScr; 
  GotoXY(14,2); 
  write('ВОЛГОГРАДСКИЙ ГОСУДАРСТВЕННЫЙ  
ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ'); 
  GotoXY(24,4); 
  write('КАФЕДРА "ВЫЧИСЛИТЕЛЬНАЯ ТЕХНИКА"'); 
  GotoXY(32,8); 
  write('СЕМЕСТРОВАЯ РАБОТА'); 
  GotoXY(45,16); 
  write('ВЫПОЛНИЛ СТУДЕНТ ГРУППЫ: ',group); 
  GotoXY(45,17); 
  write(NAME); 
  GotoXY(45,19); 
  write('ПРОВЕРИЛ:'); 
  GotoXY(45,20); 
  write('ПЕТРОВ А.Р.'); 
  GotoXY(33,24); 
  write('ВОЛГОГРАД, 2007'); 
  readKey; 
end; 
 
{процедура вывода заголовка при вводе записи} 
procedure IFF(var R:Trec); 
var k:integer; 
    c:char; 
begin 
  clrScr; 
  write(FLD[1],' (',OUTCOD,' - конец ввода):
  readln(r.f1); 
end; 
 
{процедура ввода даты} 
procedure InputDate(var D:TDate); 
begin 
  writeLn; 
  write('День: '); 
  readln(D.d); 
  write('Месяц: '); 
  readln(D.m); 
  write('Год: '); 
  readln(D.y); 
end; 
{процедура ввода записи} 
procedure InputRecord(var R:Trec); 
begin 
  write(FLD[2],': '); 
  InputDate(R.f2); 
  write(FLD[3],': '); 
  readln(R.f3); 
  write(FLD[4],': '); 
  InputDate(R.f4); 
  write(FLD[5],': '); 
  readln(R.f5); 
  write(FLD[6],': '); 
  readln(R.f6); 
  write(FLD[7],': '); 
  readln(R.f7); 
end; 
 
{процедура, которая вызывает ввод записи и проверяет 
 признак конца ввода} 
procedure CF(var F:TDB); 
begin 
  IFF(R); 
  while R.f1<>OUTCOD do 
    begin 
      InputRecord(R); 
      write(F,R); 
      IFF(R); 
    end; 
end; 
 
{процедура, которая создает файл и производит вызов 
 процедуры его заполнения} 
procedure VV(var F:TDB); 
begin 
  clrScr; 
  rewrite(F); 
  CF(F); 
  close(F); 
end; 
 
{процедура, вывода экземпляра записи} 
procedure PrintRecord(R:Trec); 
begin 
  clrScr; 
  writeLn(FLD[1],': ',r.f1); 
  writeLn(FLD[2],': ',r.f2.d,'.',r.f2.m,'.',r.f2.y); 
  writeLn(FLD[3],': ',r.f3); 
  writeLn(FLD[4],': ',r.f4.d,'.',r.f4.m,'.',r.f4.y); 
  writeLn(FLD[5],': ',r.f5); 
  writeLn(FLD[6],': ',r.f6); 
  writeLn(FLD[7],': ',r.f7); 
end; 
 
{процедура печати базы} 
procedure PrintBase(var F:TDB); 
begin 
  reset(F); 
  while not eof(F) do 
    begin 
      read(F,R); 
      PrintRecord(R); 
      readKey; 
    end; 
  close(F); 
end; 
 
{процедура добавления записи}  
procedure AddRecords(var F:TDB); 
begin 
  clrScr; 
  reset(F); 
  seek(F,Filesize(F)); 
  CF(F); 
  close(F); 
end; 
 
{процедура удаления записи} 
procedure DeleteRecords(var F:TDB); 
var 
  I:Longint; 
begin 
  reset(F); 
  while not eof(F) do 
    begin 
      read(F,R); 
      PrintRecord(R); 
      writeLn('Удалить ? (1-Да)'); 
      C:=readKey; 
      if C='1' then 
        begin 
          I:=filepos(F)-1; 
          While not eof(f) do 
            begin 
              read(F,R); 
              seek(F,filepos(F)-2); 
              write(F,R); 
              seek(F,filepos(F)+1); 
            end; 
 seek(F,filesize(F)-1); 
          truncate(F); 
          seek(F,I); 
        end; 
    end; 
  close(F); 
end; 
 
{процедура корректировки записи} 
procedure CorrectRecords(var F:TDB); 
begin 
  reset(F); 
  while not eof(F) do 
    begin 
      read(F,R); 
      PrintRecord(R); 
      writeLn('Корректировать ? (1-Да)'); 
      C:=readKey; 
      If C='1' then 
        begin 
          IFF(R); 
          InputRecord(R); 
          seek(F,Filepos(F)-1); 
          write(F,R); 
        end; 
    end; 
  close(F); 
end; 
 
{процедура выделения цветом пункта меню} 
procedure SetLineColor(NP,NS: Byte); 
begin 
  if NP=NS then 
    begin 
      textbackground(COLOR2); 
      textcolor(COLOR1); 
    end 
  else 
    begin 
      textbackground(COLOR1); 
      textcolor(COLOR2); 
    end 
end; 
 {функция меню запроса} 
function MenuZ(X,Y:Byte):byte; 
var k:Byte; 
begin 
  k:=1; 
  repeat 
    textbackground(COLOR1); 
    textcolor(COLOR2); 
    clrScr; 
    for i:=1 to NZ do 
      begin 
        GotoXY(X,Y+i-1); 
        SetLineColor(k,i); 
        write(Z[i]); 
      end; 
    C:=readKey; 
    case Ord(C) of 
      72:begin 
           if k=1 then k:=NZ 
                 else k:=k-1 
         end; 
      80:begin 
           if k=NZ then k:=1 
                   else k:=k+1 
         end; 
      end; 
  until Ord(C)=13; 
  MenuZ:=k; 
end; 
{логическая функция сравнения полей записи} 
function Logic(r,r1:TRec):boolean; 
begin 
  Logic:=(r.f2.y>r1.f2.y) OR 
  ( 
    (r.f2.y=r1.f2.y) AND (r.f2.m>r1.f2.m) 
   ) OR 
  ( 
   (r.f2.y=r1.f2.y) AND  
   (r.f2.m=r1.f2.m) AND(r.f2.d>r1.f2.d) 
  ); 
end; 
 {процедура сортировки файла с записями} 
procedure SortFile(var f:TDB); 
var r1:Trec; 
    l:boolean; 
begin 
 repeat 
   reset(f); 
   L:=true; 
   read(f,r); 
   while NOT EOF(f) do 
    begin 
      read(f,r1); 
      if Logic(r,r1) then 
         begin 
           seek(f,filepos(f)-2); 
           write(f,r1); 
           write(f,r); 
           l:=false; 
         end 
      else 
         r:=r1; 
    end; 
 until L; 
end; 
 
{процедура формирования нового файла} 
procedure Z1(var F:TDB); 
var g:tdb; 
begin 
  clrScr; 
  reset(f); 
  assign(g,'g.db'); 
  rewrite(g); 
  while not EOF(f) do 
    begin 
      read(f,r); 
      write(g,r); 
    end; 
  SortFile(g); 
  PrintBase(g); 
end; 
 {процедура запроса по родителям} 
procedure Z3(var F:TDB); 
var s:string[70]; 
begin 
  clrScr; 
  write('Введите данные о родителях: '); 
  readln(s); 
  writeLn; 
  reset(f); 
  While not eof(f) do 
    begin 
      read(f,r); 
      if r.f6=s then 
        begin 
         PrintRecord(R); 
         readKey; 
        end; 
    end; 
  close(F) 
end; 
 
{процедура запроса по дате регистрации} 
procedure Z2(var F:TDB); 
var s:TDate; 
begin 
 clrScr; 
  write('Введите дату регистрации: '); 
  InputDate(s); 
  writeLn; 
  reset(f); 
  while not eof(f) do 
    begin 
      read(f,r); 
      if (r.f4.d=s.d) and 
         (r.f4.m=s.m) and 
         (r.f4.y=s.y) then 
          begin 
            PrintRecord(R); 
            readKey; 
         end; 
    end; 
  close(F); 
end; 
{процедура для работы с вложенным меню}
procedure Z0(var F:TDB); 
var x,y,ml:integer; 
begin 
  ml:=length(z[1]); 
  for i:=1 to NZ do 
    if length(z[i])>ml then 
      ml:=length(z[i]); 
  y:=((MX-NZ) div 2) + 1; 
  x:=((MY-ml) div 2) + 1; 
  repeat 
    D:=MenuZ(x,y); 
    case D of 
      1:z1(F); 
      2:z2(F); 
      3:z3(f); 
    end; 
    until D=NZ; 
end; 
 
{функция вывода главного меню} 
function Menu(X,Y:Byte):byte; 
var k:Byte; 
begin 
  k:=1; 
 repeat 
    textbackground(COLOR1); 
    textcolor(COLOR2); 
    clrScr; 
    for I:=1 to NM do 
      begin 
        GotoXY(X,Y+I-1); 
        SetLineColor(k,I); 
        write(M[I]); 
      end; 
    C:=readKey; 
    case Ord(C) of 
      72:begin 
         if k=1 then k:=NM 
                else k:=k-1; 
         end; 
      80:begin 
         if k=NM then k:=1 
                else k:=k+1; 
         end 
      end; 
  until Ord(C)=13; 
  Menu:=k; 
end; 
{основная программа} 
begin 
  assign(F,'Data.db'); 
  TitulnyList; 
    repeat 
      D:=Menu(x,y); 
      case D of 
        1:VV(F); 
        2:PrintBase(F); 
        3:AddRecords(F); 
        4:DeleteRecords(F); 
        5:CorrectRecords(F); 
        6:Z0(F); 
      end; 
    until D=NM; 
end.