Черновик БД (2)

{БД как она есть пока, не отлажена}

program bd;
uses crt;

type
    bibl = record
    name: string [60];
    autor: string [60];
    izdatel: string [30];
    janr: string [30];
    exemplar: byte
  end;

var
f: file of bibl;
key, i, n: integer;
a: bibl;

procedure New;
  begin
  rewrite (f);
  writeln ('Vvedite coliscestvo');
  readln(n);
     for i:=1 to n do begin
     writeln ('name');
     readln (a.name);
     writeln ('autor');
     readln (a.autor);
     writeln ('izdatel');
     readln (a.izdatel);
     writeln ('janr');
     readln (a.janr);
     writeln ('exemplar');
     readln (a.exemplar);
     write (f,a);
     readln;
     clrscr;
     end;
end;

procedure Visuel;
     begin
     reset(f);
     while not eof(f) do begin
     read (f, a);
     writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
end;end;

procedure Dobav;
var size: integer;
     begin
     size:=filesize(f);
     seek (f, size);
     writeln ('Vvedite coliscestvo');
     READLN(N);
     for i:=1 to n do begin
         writeln ('name');
         readln (a.name);
         writeln ('autor');
         readln (a.autor);
         writeln ('izdatel');
         readln (a.izdatel);
         writeln ('janr');
         readln (a.janr);
         writeln ('exemplar');
         readln (a.exemplar);
         write (f,a);
     readln;
     clrscr;
end;

procedure Search;
var
  b: string;
  x, y: integer;
begin
clrscr;
     repeat
          clrscr;
          writeln ('Viberete razdel');
          writeln ('1 - Name');
          writeln ('2 - Autor');
          writeln ('3 - Izdatel');
          writeln ('4 - Janr');
          writeln ('5 - Exemplar');
          writeln ('6 - Return');

          read (key);

               case key of

               1: begin
               write ('Name: ');
               read (b);

               while not eof(f) do begin
               read (f, a);
                  if a.name = b y=then begin
                  writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
                  end; end;
               readln; clrscr;
               end;

               2: begin
               writeln ('Autor: ');
               read (b);

               while not eof(f) do begin
               read (f, a);
                  if a.autor = b then begin
                  writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
                  end; end;
               readln; clrscr;
               end;

               3: begin
               writeln ('Izdatel: ');
               read (b);

               while not eof(f) do begin
               read (f, a);
                  if a.izdatel = b then begin
                  writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
                  end; end;
               readln; clrscr;
               end;

               4: begin
               writeln ('Janr: ');
               read (b);

               while not eof(f) do begin
               read (f, a);
                  if a.janr = b then begin
                  writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
                  end; end;
               readln; clrscr;
               end;

               5: begin
               writeln ('Kolichestvo exemplarov: ');
               read (x);

               while not eof (f) do begin
               read (f, a);
                  if a.exemplar = x then begin
                  writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
                  end; end;
               readln; clrscr;
               end;

               6: begin clrscr; end;
readln;
end;

procedure Delet;
var
d, c: bibl;
b, y: string;
x: integer;
begin
clrscr;
     repeat
          clrscr;
          writeln ('Viberete razdel');
          writeln ('1 - Name');
          writeln ('2 - Autor');
          writeln ('3 - Izdatel');
          writeln ('4 - Janr');
          writeln ('5 - Exemplar');
          writeln ('6 - Name + Autor');
          writeln ('7 - Return');

          read (key);

          1: begin
          writeln ('Name: ');
          read (b);
          n:=filesize(f);

          for i:=1 to n do begin
              read (f, a);
                    if a.name = b then begin
                    c:=a;
                       while not eof(f) do begin
                             seek (f,n);
                             read (f, a);
                             d:=a;
                             seek (f, n-1);
                             write (f, a);
                       end;
                    end;
          end;
          seek (f, n);
          truncate (f);

          writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
          end;

          readl;
          clrscr;
          end;


          2: begin
          writeln ('Autor: ');
          read (b);
          n:=filesize(f);

          for i:=1 to n do begin
              read (f, a);
                    if a.autor = b then begin
                    c:=a;
                       while not eof(f) do begin
                             seek (f,n);
                             read (f, a);
                             d:=a;
                             seek (f, n-1);
                             write (f, a);
                       end;
                    end;
          end;
          seek (f, n);
          truncate (f);

          writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
          end;

          readl;
          clrscr;
          end;

          3: begin
          writeln ('Izdatel: ');
          read (b);
          n:=filesize(f);

          for i:=1 to n do begin
              read (f, a);
                    if a.izdatel = b then begin
                    c:=a;
                       while not eof(f) do begin
                             seek (f,n);
                             read (f, a);
                             d:=a;
                             seek (f, n-1);
                             write (f, a);
                       end;
                    end;
          end;
          seek (f, n);
          truncate (f);

          writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
          end;

          readl;
          clrscr;
          end;

          4: begin
          writeln ('Janr: ');
          read (b);
          n:=filesize(f);

          for i:=1 to n do begin
              read (f, a);
                    if a.janr = b then begin
                    c:=a;
                       while not eof(f) do begin
                             seek (f,n);
                             read (f, a);
                             d:=a;
                             seek (f, n-1);
                             write (f, a);
                       end;
                    end;
          end;
          seek (f, n);
          truncate (f);

          writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
          end;

          readl;
          clrscr;
          end;

          5:begin
          writeln ('Exemplar: ');
          read (x);
          n:=filesize(f);

          for i:=1 to n do begin
                   read (f, a);
                   if a.exemplar = x then begin
                       c:=a;
                       while not eof(f) do begin
                             seek (f,n);
                             read (f, a);
                             d:=a;
                             seek (f, n-1);
                             write (f, a);
                       end;
                    end;
          end;
          seek (f, n);
          truncate (f);

          writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
          end;

          readl;
          clrscr;
          end;

          6:begin
          write ('Name: ');
          readln (b);
          write ('Autor: ');
          readln (y);
          n:=filesize(f);

          for i:=1 to n do begin
                   read (f, a);
                   if (a.name=b) and (a.autor=y)  then begin
                       c:=a;
                       while not eof(f) do begin
                             seek (f,n);
                             read (f, a);
                             d:=a;
                             seek (f, n-1);
                             write (f, a);
                       end;
                    end;
          end;
          seek (f, n);
          truncate (f);

          writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
          end;

          readl;
          clrscr;
          end;

          7: begin clrscr; end;
readln;
end;

procedure Sort;
var y, i: integer;
b: bibl;
begin
  clrscr;
  n:=filesize(f);
  for y:=n dovnto 1 do
    for i:=1 to (y-1) do
    begin
    seek (f, i-1);
    read (f, a);
    read (f, b);
          if a.name<b.name then begin
          seek (f,i-1);
          writeln (f, b);
          seek (f, i);
          writeln (f, a); end;
    end; end;

    while not eof (f) do begin
     read (f, a);
     writeln (a.name,' ',a.autor,' ',a.izdatel,' ',a.janr,' ',a.exemplar);
end;end;

begin
clrscr;

assign (f,'FB.txt');

repeat
     clrscr;
     writeln ('Viberete punct');
     writeln ('1 - new');
     writeln ('2 - visuel');
     writeln ('3 - dobav');
     writeln ('4 - search');
     writeln ('5 - delet');
     writeln ('6 - sort');
     writeln ('7 - exit');

     readln(key);

     case key of

      1: begin New; readln; end;
      2: begin Visuel; readln; end;
      3: begin Dobav; readln;  end;
      4: begin Search; readln;  end;
      5: begin Delet; readln; end;
      6: begin  Sort;  readln;  end;
      7: begin  writeln ('end');  readln;   end;
    end;

     until key=7;
     close (f);
     readln;
     clrscr;
end.