Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

vlad / prog / BIB

.PAS
Скачиваний:
3
Добавлен:
12.02.2016
Размер:
8.36 Кб
Скачать
program biblio;
uses crt;
type lib=record
book_n:string;
book_a:string;
book_p:real;
book_y:integer;
book_v:string;
end;
{record}

f1=file of lib;
var f:f1;
user_case:byte;
{____________________________________________}
procedure Fill (var fz:f1);
var y_n:char;
el:lib;
i,k,nom:integer;
BEGIN
assign(fz,'file1.txt');
reset(fz);
if ioresult <>0 then
begin
rewrite(fz);
writeln('File created');
end;
writeln ('File is opening');
writeln('jaksho vi bajaete stvoriti novij fajl, natisnit (1)');
writeln('jaksho vi zminiti dani natisnit (2)');
writeln('nerobiti nichogo (0)');
readln(y_n);
if y_n='1' then
begin
seek(fz,filesize(fz));
writeln('budlaska vvedit kilkist knig, dlia dozapisu : ');
readln(k);
for i:=1 to k do
begin
with el do
begin
clrscr;
write('vedit nazvu knigi : ');
readln(book_n);
clrscr;
write('vedit avtora knigi : ');
readln(book_a);
clrscr;
writeln('vedit napriam knigi : ');
writeln('naukova - n ');
writeln('hudojnia - h ');
writeln('gumanitarna - g ');
writeln('tehnichna - t ');
writeln('specialna - s ');
writeln('metodichna - m ');

readln(book_v);
clrscr;
write('vedit cinu knigi : ');
readln(book_p);
clrscr;
writeln('vvedit rik vidanija :');
readln(book_y);
end;
write(fz,el);
end;

end
else
if y_n='2' then
begin
writeln('vvedit nomer knigi glja provedenna zmin\zapisu');
readln(nom);
seek(fz,nom-1);
with el do
begin
clrscr;
write('vedit nazvu knigi : ');
readln(book_n);
clrscr;
write('vedit avtora knigi : ');
readln(book_a);
clrscr;
writeln('vedit napriam knigi : ');
writeln('naukova - n ');
writeln('hudojnia - h ');
writeln('gumanitarna - g ');
writeln('tehnichna - t ');
writeln('specialna - s ');
writeln('metodichna - m ');

readln(book_v);
clrscr;
write('vedit cinu knigi : ');
readln(book_p);
clrscr;
writeln('vvedit rik vidanija :');
readln(book_y);
end;
write(fz,el);
end;
End;
{____________________________________________}
procedure Tabl;
begin
writeln('|---------------|--------------|--------------|---------------|--------------|');
writeln('| Nazva | AVTOR | CINA | NAPRIJAM | Rik |');
writeln('|---------------|--------------|--------------|---------------|--------------|');
end;
{____________________________________________}
procedure Rfail(var fz:f1);
var el:lib;
Begin
tabl;
seek(fz,0);
while not eof(fz) do
begin
read(fz,el);
with el do
writeln('',book_n:14,' ',book_a:7,' ',book_p:4:2,' ',book_v:1 ,' ',book_y:5,' ');
writeln('|_______________|______________|______________|_______________|______________|');
end; end;
{____________________________________________}
procedure d1(var fz:f1);
var el:lib;
net:integer;
name:string;
Begin
net:=0;
writeln('Vvedit nazvu knigi dlia poshuku :');
readln(name);
writeln('Knigi po zaprosu :');
writeln;
tabl;
seek(fz,0);
while not eof(fz) do
begin
read(fz,el);
if (el.book_n=name) then
begin
with el do
writeln(book_n:14,' ',book_a:7,' ',book_p:4:2,' ',book_v:1 ,' ',book_y:5);
writeln('|_______________|______________|______________|_______________|______________|');
net:=net+1;
end; end;
if net=0 then
begin
writeln(' VIBACHTE PO DANOMU ZAPITU NICHOGO NEZNAJDENO! ');
writeln('|_______________|______________|______________|_______________|______________|');


end;

End;
{____________________________________________}
procedure d2(var fz:f1);
var el:lib;
net:integer;
prise:real;
Begin
net:=0;
writeln('Vvedit cinu knigi dlia poshuku :');
readln(prise);
writeln('Knigi po zaprosu :');
writeln;
tabl;
seek(fz,0);
while not eof(fz) do
begin
read(fz,el);
if (el.book_p=prise) then
begin
with el do
writeln('',book_n:14,' ',book_a:7,' ',book_p:4:2,' ',book_v:1 ,' ',book_y:5,' ');
writeln('|_______________|______________|______________|_______________|______________|');
net:=net+1;
end; end;
if net=0 then
begin
writeln(' VIBACHTE PO DANOMU ZAPITU NICHOGO NEZNAJDENO! ');
writeln('|_______________|______________|______________|_______________|______________|');


end;
end;

{____________________________________________}
procedure d3(var fz:f1);
var el:lib;
author:string;
net:integer;
Begin
net:=0;
writeln('vvedit imja avtora dlija poshuku :');
readln(author);
writeln('Knigi po zaprosu :');
writeln;
tabl;
seek(fz,0);
while not eof (fz) do
begin
read(fz,el);
if (el.book_a=author) then
begin
with el do
writeln('',book_n:14,' ',book_a:7,' ',book_p:4:2,' ',book_v:1 ,' ',book_y:5,' ');
writeln('|_______________|______________|______________|_______________|______________|');
net:=net+1;
end; end;
if net=0 then
begin
writeln(' VIBACHTE PO DANOMU ZAPITU NICHOGO NEZNAJDENO! ');
writeln('|_______________|______________|______________|_______________|______________|');


end;
end;
{____________________________________________}
procedure d4(var fz:f1);
var el:lib;
tip:string;
net:integer;
Begin
net:=0;
writeln('vvedit napriam iz podanogo spiska:');

writeln('naukova - n ');
writeln('hudojnia - h ');
writeln('gumanitarna - g ');
writeln('tehnichna - t ');
writeln('specialna - s ');
writeln('metodichna - m ');
readln(tip);
writeln('Knigi po zaprosu :');
writeln;
tabl;
seek(fz,0);
while not eof (fz) do
begin
read(fz,el);
if (el.book_v=tip) then
begin
with el do
writeln('',book_n:14,' ',book_a:7,' ',book_p:4:2,' ',book_v:1 ,' ',book_y:5,' ');
writeln('|_______________|______________|______________|_______________|______________|');
net:=net+1;
end; end;
if net=0 then
begin
writeln(' VIBACHTE PO DANOMU ZAPITU NICHOGO NEZNAJDENO! ');
writeln('|_______________|______________|______________|_______________|______________|');


end;
end;


{____________________________________________}

BEGIN
clrscr;
Fill(f);
repeat clrscr;
writeln('BUDLASKA VIBERIT ODIN IZ PUNKTIV');
writeln('Vedit cifru i natisnit <Enter>');
writeln;
writeln('1 - menu 1');
writeln('2 - vivod vsih zapisiv');
writeln('3 - poshuk po nazvi knigi');
writeln('4 - poshuk po cini');
writeln('5 - poshuk po avtoru');
writeln('6 - poshuk po tipu');
writeln('7 - Exit');
readln(user_case);
case user_case of


1: begin
clrscr;
Fill(f);
end;
2: begin
clrscr;
Rfail(f);
end;
3: begin clrscr;
d1(f);
end;
4: begin clrscr;
d2(f);
end;
5: begin clrscr;
d3(f);
end;
6: begin clrscr;
d4(f);
end;
7: halt;

end;{case}

writeln;readln;

until user_case=7;
readln;
End.


Соседние файлы в папке prog