Программа
TYPE BookType=record { Тип - книга }
FIO:string[15]; { Автор }
Title:string[20]; { Название }
Quantity, { Тираж }
Cost, { Цена }
QuantPage:word { Кол-во страниц }
end;
LibraryType=file of BookType; { Тип - библиотека }
FUNCTION Menu:integer; { Функция вывода меню и получения ответа }
Const QuantityMenuPoint=6; { Количество пунктов меню }
ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
Var Point:integer; { Текущий пункт меню }
AnswerBuf:char; { Переменная для получения ответа на меню }
Begin
repeat { Цикл чтения клавиатуры }
WriteLn; { Пропуск строки }
WriteLn('МЕНЮ:');
WriteLn('[1] Просмотр базы');
WriteLn('[2] Редактирование');
WriteLn('[3] Добавление записи');
WriteLn('[4] Удаление записи');
WriteLn('[5] Поиск');
WriteLn('[6] Выход');
Write('Введите пункт меню ');
ReadLn(AnswerBuf); { Чтение ответа на меню }
Point:=Ord(AnswerBuf)-Ord('0'); { Перевод полученного символа в пункт меню }
until (0<Point) and (Point<=QuantityMenuPoint);
{ Выход из цикла при пролучении корректного ответа }
{ Определение значения функции: }
if Point=ExitPoint then Menu:=255
else Menu:=Point
End;
FUNCTION FullLen(S:string;Len:byte):string;
Begin { Функция добавления конечных пробелов в строке }
while Length(S)<Len do S:=S+' '; { Цикл добавления пробелов }
FullLen:=S { Определение значения функции }
End;
PROCEDURE Review(var F:LibraryType); { Процедура просмотра базы}
Var Buf:BookType; { Буфер чтения-записи данных по книге }
i:longint; { Счетчик записей файла }
Begin
WriteLn; { Пропуск строки }
Reset(F); { Открытие файла }
i:=0; { Сброс счетчика записей }
if EOF(F) then WriteLn('База пуста'); { Вывод сообщения при пустой базе }
while not EOF(F) do { Цикл просмотра файла }
begin
if i mod 23=0 then WriteLn(' № Фамилия И.О. Название книги Тираж Цена Кол.стр.'); {Вывод заголовка таблицы}
Read(F,Buf); { Чтение записи файла }
with Buf do WriteLn(i:3,' ',FullLen(FIO,15),' ',FullLen(Title,20),
' ',Quantity:6,' ',Cost:5,' ',QuantPage:8); { Вывод записи }
i:=i+1; { Пересчет номера записи }
if (i mod 23=0)and not EOF(F) then
begin { Остановка программы при заполнении экрана }
Write('Для продолжения просмотра нажмите <Enter>');
ReadLn
end
end;
Close(F); { Закрытие файла }
Write('Для выхода нажмите <Enter>');
ReadLn
End;
FUNCTION Question(S:string):boolean; { Функция получения ответа на вопрос }
Var Ch:char; { Буфер }
Begin
repeat
Write(S,' [Y/N] '); { Вывод вопроса }
ReadLn(Ch) { Ввод символа }
until Ch in ['Y','y','N','n','Н','н','Т','т'];
{ Выход из цикла при получении корректного ответа }
Question:=Ch in ['Y','y','Н','н'] { Определение значения функции }
End;
PROCEDURE Edit(var F:LibraryType); { Процедура редактирования записи }
Var Buf:BookType; { Буфер чтения-записи данных по книге }
Num:longint; { Номер редактируемой записи }
Begin
WriteLn; { Пропуск строки }
Reset(F); { Открытие файла }
Write('Введите номер редактируемой записи ');{ Вывод приглашения }
ReadLn(Num); { Ввод номера записи }
if (0<=Num)and(Num<FileSize(F)) { Проверка существования записи }
then begin { Редактирование записи: }
Seek(F,Num); { Установка указателя на компоненту }
Read(F,Buf); { Чтение компоненты файла }
with Buf do { Вывод записи: }
begin
WriteLn('Запись №',Num);
WriteLn('Автор ',FIO);
WriteLn('Название ',Title);
WriteLn('Тираж ',Quantity);
WriteLn('Цена ',Cost);
WriteLn('Кол. стр. ',QuantPage);
if Question('Редактировать поле "Автор"?') then
begin { Вывод вопроса и выбор действия }
Write('Введите фамилию автора '); { Вывод подсказки }
ReadLn(FIO) { Ввод нового значения поля }
end;
if Question('Редактировать поле "Название"?') then
begin { Вывод вопроса и выбор действия }
Write('Введите название книги '); { Вывод подсказки }
ReadLn(Title) { Ввод нового значения поля }
end;
if Question('Редактировать поле "Тираж"?') then
begin { Вывод вопроса и выбор действия }
Write('Введите тираж книги '); { Вывод подсказки }
ReadLn(Quantity) { Ввод нового значения поля }
end;
if Question('Редактировать поле "Цена"?') then
begin { Вывод вопроса и выбор действия }
Write('Введите стоимость книги '); { Вывод подсказки }
ReadLn(Cost) { Ввод нового значения поля }
end;
if Question('Редактировать поле "Количество страниц"?') then
begin { Вывод вопроса и выбор действия }
Write('Введите количество страниц '); { Вывод подсказки }
ReadLn(QuantPage) { Ввод нового значения поля }
end
end;
Seek(F,Num); { Установка указателя файла на компоненту }
if Question('Перезаписать изменения?') then
Write(F,Buf) { Запись данных в файл }
end
else WriteLn('Номер записи неверен'); { Вывод сообщения об ошибки }
Close(F) { Закрытие файла }
End;
PROCEDURE Addition(var F:LibraryType); { Процедура добавления записи }
Var Buf:BookType; { Буфер чтения-записи данных по книге }
Begin
WriteLn; { Пропуск строки }
with Buf do { Вывод записи: }
begin
Write('Введите фамилию автора '); { Вывод подсказки }
ReadLn(FIO); { Ввод значения поля }
Write('Введите название книги '); { Вывод подсказки }
ReadLn(Title); { Ввод значения поля }
Write('Введите тираж книги '); { Вывод подсказки }
ReadLn(Quantity); { Ввод значения поля }
Write('Введите стоимость книги '); { Вывод подсказки }
ReadLn(Cost); { Ввод значения поля }
Write('Введите количество страниц '); { Вывод подсказки }
ReadLn(QuantPage); { Ввод значения поля }
WriteLn; { Пропуск строки }
{ Дополнительный вывод полей: }
WriteLn('Автор ',FIO);
WriteLn('Название ','"'+Title+'"');
WriteLn('Тираж ',Quantity);
WriteLn('Цена ',Cost);
WriteLn('Кол. стр. ',QuantPage);
end;
Reset(F); { Открытие файла }
Seek(F,FileSize(F)); { Установка файлового указателя на конец файла }
if Question('Добавить запись?') then
Write(F,Buf); { Запись данных в файл }
Close(F) { Закрытие файла }
End;
PROCEDURE Delete(var F:LibraryType); { Процедура удаления записи }
Var Buf:BookType; { Буфер чтения-записи данных по книге }
Num:longint; { Номер удаляемой записи }
Begin
WriteLn; { Пропуск строки }
Write('Введите номер удаляемой записи ');{ Вывод приглашения }
ReadLn(Num); { Ввод номера записи }
Reset(F); { Открытие файла }
if (0<=Num)and(Num<FileSize(F)) { Проверка существования записи }
then begin
while Num+1<FileSize(F) do
begin { Цикл смещения "хвоста" файла на одну компоненту вперед }
Seek(F,Num+1); { Установка указателя на первую перемещаемую компоненту }
Read(F,Buf); { Чтение компоненты }
Seek(F,Num); { "Возврат" указателя }
Write(F,Buf); { Запись компоненты }
Num:=Num+1 { Пересчет номера "удаляемой" компоненты }
end;
Seek(F,FileSize(F)-1); { Установка указателя на последнюю запись }
Truncate(F) { Удаление последней записи в файле }
end
else WriteLn('Номер записи неверен'); { Вывод сообщения об ошибки }
Close(F) { Закрытие файла }
End;
PROCEDURE Search(var F:LibraryType); { Процедура поиска записи }
Var Buf:BookType; { Буфер чтения-записи данных по книге }
Num:longint; { Количество найденных книг }
FIO:string[15]; { "Искомый автор" }
Begin
WriteLn; { Пропуск строки }
Num:=0; { Сброс счетчика }
Write('Введите автора '); { Вывод приглашения }
ReadLn(FIO); { Ввод фамилии }
Reset(F); { Открытие файла }
while not EOF(F) do
begin
Read(F,Buf); { Чтение компоненты }
if Buf.FIO=FIO then
begin
if Num mod 23=0 then WriteLn(' № Фамилия И.О. Название книги Тираж Цена Кол.стр.');
{Вывод заголовка таблицы}
with Buf do WriteLn(FilePos(F)-1:3,' ',FullLen(FIO,15),' ',FullLen(Title,20),
' ',Quantity:6,' ',Cost:5,' ',QuantPage:8); { Вывод записи }
Num:=Num+1; { Пересчет номера записи }
if (Num mod 23=0)and not EOF(F) then
begin { Остановка программы при заполнении экрана }
Write('Для продолжения просмотра нажмите <Enter>');
ReadLn
end
end
end;
Close(F); { Закрытие файла }
if Num=0 then WriteLn('Книг указанного автора не найдено');
Write('Для выхода нажмите <Enter>');
ReadLn
End;
VAR LibraryVar:LibraryType; { Библиотека }
Exit:boolean; { Флаг выхода }
BEGIN
WriteLn; { Пропуск строки }
Assign(LibraryVar,'LIBRARY.DAT'); { Связывание файловой переменной с именем файла }
Exit:=FALSE; { Сброс флага выход }
repeat { Основной цикл работы программы }
case Menu of { Вывод меню и выбор действия по ответу }
1:Review(LibraryVar); { Посмотр базы }
2:Edit(LibraryVar); { Редактирование }
3:Addition(LibraryVar); { Добавление }
4:Delete(LibraryVar); { Удаление }
5:Search(LibraryVar); { Поиск }
255:Exit:=True { Подъем флага "ВЫХОД" }
end
until Exit { Выход из цикла }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию