Поиск

uses crt;
type
biblioteka=record
shifr : string[5];
fio:string[20];
name:string[15];
 year : integer;
end;
tfile=file of biblioteka;
var 
a:biblioteka;
f:tfile;
b:boolean;
n:integer;
g:text;
 {чтение из файла}
procedure print;
begin
clrscr;
assign(f,'D:\Новая папка\prog\lol.dat');
reset(f);
writeln('Список книг:');
 begin
writeln('|Шифр книги| Автор | Название книги |Год выпуска |');
  while not eof(f) do
   begin
  read(f,a);
    writeln('------------------------------');
    writeln('|',a.shifr   ,'| ',a.fio,'| ',a.name, '| ',a.year, '|');
    writeln('------------------------------');
   end;
 end;
close(f);
writeln('для продолжения нажмите Enter');
readln;
end;
{добавление записи в файл}
Procedure add;
begin
clrscr;
assign(f,'D:\Новая папка\prog\lol.dat');
reset(f);
with a do
 begin
  writeln('Введите шифр книги');
  readln(shifr);
  writeln('Введите автора');
  readln(fio);
    writeln('Введите название книги');
  readln(name);
  writeln('Введите год выпуска');
  readln(year);
 end;
seek(f,filesize(f));
write(f,a);
close(f);
writeln('Запись добавлена');
writeln('для продолжения нажмите Enter');
readln
end;
{удаление записи из файла}
procedure del;
var c:biblioteka;
    n:string[20];
    i,j,k,b:integer;
begin
clrscr;
assign(f,'D:\Новая папка\prog\lol.dat');
reset(f);
write('фамилия автора : fio=');
readln(n);
i:=0;
b:=-1;
while (i<filesize(f))and(b=-1) do{ищем нужный номер}
 begin
  seek(f,i);
  read(f,a);
  if a.fio=n then b:=i
  else i:=i+1
 end;
if b=-1 then writeln('Такого автора  нет')
else
 begin
  if b=filesize(f)-1 then{если последний}
   begin
    seek(f,filesize(f)-1);{встаем в последнюю запись}
    truncate(f);{обрезаем файл}
   end
  else
   begin
    for j:=b to filesize(f)-2 do{идем вперед}
     begin
      seek(f,j+1);{переставляем - сдвигаем - записи вверх на 1}
      read(f,c);
      seek(f,j);
      write(f,c);
     end;
    seek(f,filesize(f)-1);{встаем в последнюю запись}
    truncate(f);{обрезаем файл}
   end;
   writeln('Запись удалена')
 end;
close(f);
writeln('для продолжения нажмите Enter');
readln;
end;
{Сортировка записей в файле}
procedure sort;
var 
tmp,b:biblioteka;
i,j:byte;
t:tfile;
begin
clrscr;
assign(f,'D:\Новая папка\prog\lol.dat');
reset(f);
 for i:=0 to filesize(f)-2 do
 for j:=i+1 to filesize(f)-1 do
 begin
 seek(f,i);
 read(f,a);
 seek(f,j);
 read(f,b);
 if a.fio>b.fio then
 begin
 tmp:=a;
 a:=b;
 b:=tmp;
 seek(f,i);
write(f,a);
seek(f,j);
write(f,b);
assign(g,'D:\Новая папка\prog\file.txt');
rewrite(g);
writeln(g,a);
writeln(g,b);
writeln;
assign(t,'D:\Новая папка\prog\ff.dat');
rewrite(t);
write(t,a);
write(t,b);
end;
end;
close(f);
close(g);
close(t);
end;
{розпечатка в txt}
Procedure txt;
var
i: integer;
begin
clrscr;
assign(f, 'D:\Новая папка\prog\lol.dat');
assign(g, 'D:\Новая папка\prog\lel.txt');
reset(f);
rewrite(g);
i := 1;
writeln('|Шифр книги| Автор | Название книги |Год выпуска |');
while not (eof(f)) do
begin
read(f, a);
writeln(g,'_____________________________________________________');
     writeln(g,'|',a.shifr   ,'| ',a.fio,'| ',a.name, '| ',a.year, '|');
i := i + 1;
end;
close(f);
close(g);
writeln('Информация сохранена в ТХТ');
Readln;
end;
{Пойск по фамилии}
procedure Find;
var 
    fam:string[15];
    k:integer;
begin
clrscr;
assign(f,'D:\Новая папка\prog\lol.dat');
reset(f);
write('Введите фамилию для поиска: ');
readln(fam);
k:=0;
while not eof(f) do
 begin
  read(f,a);
  if a.fio=fam then
   begin
    k:=1;
     writeln( a.name);
end;
end; 
if k=0 then writeln('Такого автора нет ');
    assign(g, 'D:\Новая папка\prog\mas.txt');
rewrite(g);
writeln(g,a.name);
close(f);
Close(g);
writeln('для продолжения нажмите Enter');
readln;
end;
procedure search;
var s:string; y,i,k:integer;
begin
clrscr;
write('Введите шифр для поиска: '); readln(s);
write('Введите год издания: '); readln(y);
writeln('Результаты:');
if (a.shifr=s)and(a.year<y) then
writeln(a.shifr:5,' ',a.fio:15,' ',a.name:15,' ',a.year:11);
end;
var
  w:char;
begin
clrscr;
b:=false;
repeat
clrscr;
writeln('Выберите действие:');
writeln('1-прочитать файл');
writeln('2-добавить запись в файл');
writeln('3-удалить запись из файла');
writeln('4-сортировка файла');
writeln('5-розпечатать в txt '); 
writeln('6-найти запись '); 
writeln('7-найти запись '); 
writeln('0-выход');
readln(w);
case w of
'1':print;
'2':add;
'3':del;
'4':sort;
'5':txt;
'6':find;
'7':search;
'0':
begin
writeln('Нажмите Enter для выхода');
Readln;
exit;
end
else 
      begin
        writeln('Нажмите Enter и повторите ваш ввод');
        Readln;
      end;
    end;
  until False;
end.