Программа
PROGRAM Base;
CONST HeadBase='N°п/п Имя Цена'; { Заголовок таблицы базы }
TYPE BaseType=record { Тип элементов базы }
Name:string; { Имя }
Cost:word; { Цена }
end;
FileOfBase=file of BaseType; { Тип - указатель на файл базы }
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 Stop; { Процедура остановки программы }
Begin
WriteLn('Нажмите <Enter>'); { Вывод приглашения нажать <Enter> }
ReadLn { Остановка программы до нажатия <Enter> }
End;
PROCEDURE ReadBaseType(var A:BaseType);
Begin { Процедура ввода полей записи элемента базы }
{ Ввод полей записи: }
Write('Введите имя ');
ReadLn(A.Name);
Write('Введите стоимость ');
ReadLn(A.Cost);
End;
FUNCTION FormatString(S:String;Len:byte):string;
Begin { Функция "форматирования" строки }
while Length(S)<Len do S:=S+' '; { "Вытягивание" строки }
FormatString:=Copy(S,1,Len) { Определение значения функции с усечением строки }
End;
PROCEDURE WriteBaseType(Num:word;A:BaseType);
Begin { Процедура вывода полей записи элемента базы }
Write(Num:3,' ',FormatString(A.Name,10),' ',A.Cost:6);
{ Вывод номера записи и полей }
End;
PROCEDURE WriteLnBaseType(Num:word;A:BaseType);
Begin { Процедура вывода полей записи элемента базы с завершением строки }
WriteBaseType(Num,A); { Вывод номера записи и полей }
WriteLn { Вывод конца строки }
End;
FUNCTION Menu:byte; { Функция вывода меню и полечения ответа }
Var Point:byte; { Пункт меню }
Begin
{ Вывод меню: }
WriteLn; { Пропуск строки }
WriteLn('МЕНЮ:');
WriteLn('0 - Выход');
WriteLn('1 - Создание базы');
WriteLn('2 - Создание базы набором случайных значений');
WriteLn('3 - Просмотр базы');
WriteLn('4 - Сортировка базы');
WriteLn('5 - Удаление элемента из базы');
WriteLn('6 - Вставка элемента в базу');
WriteLn('7 - Редактирование элемента базы');
WriteLn('8 - Поиск элемента базы по заданному критерию');
Write('Введите номер пункта меню - '); { Вывод приглашения }
ReadLn(Point); { Ввод пункта меню }
Menu:=Point; { Определение }
WriteLn { Пропуск строки }
End;
PROCEDURE ViewBase(var F:FileOfBase); { Просмотр базы }
Var Buf:BaseType; { Буферная переменная }
i:word; { Счетчик элементов базы }
Begin
Reset(F); { Открытие файла }
i:=0; { Сброс счетчика элементов базы }
if EOF(F) { Проверка наличия }
then WriteLn('База не содержит записей') { Вывод предупреждения при пустом файле }
else repeat { Цикл просмотра базы }
if i mod 22 =0 then WriteLn(HeadBase); { Вывод названий полей }
Read(F,Buf); { Чтение элемента базы }
WriteLnBaseType(i,Buf); { Вывод элемента базы }
i:=i+1; { Пересчет номера элемента базы }
if (i mod 22 =0) or EOF(F) then Stop; { Остановка программы при
заполнении экрана или достижении конца файла }
until EOF(F); { Выход из цикла при достижении конца файла }
Close(F) { Закрытие файла }
End;
PROCEDURE MakeBase(var F:FileOfBase); { Создание базы }
Var Buf:BaseType; { Буферная переменная }
Begin
Rewrite(F); { Открытие файла }
while Question('Создать запись ?') do { Цикл создания базы }
begin
ReadBaseType(Buf); { Ввод записи }
Write(F,Buf) { Запись элемента базы в файл }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE DeleteElementOfBase(var F:FileOfBase); { Удаление элемента из базы }
Var Buf:BaseType; { Буферная переменная }
Num:word; { Номер-указатель удаляемого элемента }
Begin
Reset(F); { Открытие файла }
Write('Введите номер удаляемой записи '); { Вывод приглашения }
ReadLn(Num); { Ввод номера записи }
while Num+1<FileSize(F) do { Цикл перезаписи хвоста файла }
begin
Seek(F,Num+1);{ Установка указателя на считываемый элемент базы }
Read(F,Buf); { Чтение элемента }
Seek(F,Num); { Установка указателя на перезаписываемый элемент базы }
Write(F,Buf); { Запись элемента }
Num:=Num+1; { Переопределение номера-указателя }
end;
if Num+1=FileSize(F) then
{ Удаление производится только при наличии соответствуюшего элемента в базе }
begin
Seek(F,Num); { Установка указателя на последний элемент базы }
Truncate(F) { Удаление конца файла }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE InsertElementInBase(var F:FileOfBase); { Вставка элемента в базу }
Var Buf:BaseType; { Буферная переменная }
Begin
Reset(F); { Открытие файла }
WriteLn('Ввод элемента базы:'); { Вывод приглашения }
ReadBaseType(Buf); { Ввод записи базы }
Seek(F,FileSize(F)); { Установка указателя на конец файла базы }
Write(F,Buf); { Запись элемента в базу }
Close(F) { Закрытие файла }
End;
PROCEDURE EditElementOfBase(var F:FileOfBase); { Редактирование элемента базы }
Var Buf:BaseType; { Буферная переменная }
Num:word; { Номер-указатель редактируемого элемента }
Begin
Reset(F); { Открытие файла }
Write('Введите номер редактируемой записи '); { Вывод приглашения }
ReadLn(Num); { Ввод номера редактируемой записи }
if Num<FileSize(F) { Проверка корректности введенного номера }
then begin
Seek(F,Num); { Установка указателя на редактируемую запись }
Read(F,Buf); { Чтение записи базы }
WriteLn(HeadBase); { Вывод заголовка }
WriteLnBaseType(Num,Buf); { Вывод записи }
WriteLn('Ввод записи:'); { Вывод подсказки }
ReadBaseType(Buf); { Ввод записи }
Seek(F,Num); { Установка указателя на редактируемую запись }
Write(F,Buf) { Запись элемента в базу }
end
else begin
WriteLn('Указанной записи не существует'); { Вывод предупреждения }
Stop { Остановка программы }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE Find(var F:FileOfBase); { Поиск элемента базы по заданному критерию }
Var Buf,CompareBuf:BaseType; { Буферные переменные }
FindFlag:boolean; { Флаг наличия искомых элементов }
Begin
FindFlag:=FALSE; { Сброс флага }
Write('Введите искомое имя '); { Вывод приглашения }
ReadLn(CompareBuf.Name); { Ввод искомого имени }
Reset(F); { Открытие файла }
while not EOF(F) do { Цикл просмотра базы }
begin
Read(F,Buf); { Чтение записи }
if Buf.Name=CompareBuf.Name then { Сравнение полей }
begin
if not FindFlag then { Определение для первой найденной записи }
begin
WriteLn(HeadBase); { Вывод заголовка }
FindFlag:=TRUE { Подъем флага наличия искомых элементов }
end;
WriteLnBaseType(FilePos(F)-1,Buf) { Вывод записи }
end;
end;
if not FindFlag then WriteLn('Записи не найдены');
{ Вывод сообщения при отсутствии записей удовлетворяющих условию поиска }
Close(F) { Закрытие файла }
End;
PROCEDURE SortAtCost(var F:FileOfBase); { Процедура сортировки базы по полю "Стоимость" }
Var Buf,Max:BaseType; { Буферная переменная }
! NumOfMax:longint; { Номер максимального }
Begin
Reset(F); { Открытие файла }
Close(F) { Закрытие файла }
End;
PROCEDURE RandomMakeBase(var F:FileOfBase); { Создание базы набором случайных значений }
Function Stringer(N:integer):string; { Функция преобразования числа в строку }
Var St:string; { Переменная для преобразования числа в строку }
begin
Str(N,St); { Преобразование }
Stringer:=St { Определение значения функции }
end;
Var Buf:BaseType; { Буферная переменная }
Num:word; { Номер-указатель создаваемого элемента }
Begin
Randomize; { Инициализация генератора случайных чисел }
Rewrite(F); { Открытие файла }
for Num:=0 to Random(25) do { Цикл создания базы }
begin
{ Определение полей записи: }
Buf.Name:=Stringer(Num);
Buf.Cost:=Random(10000);
Write(F,Buf); { Запись элемента в баз }
end;
Close(F) { Закрытие файла }
End;
VAR F:FileOfBase; { Указатель на файл базы }
Exit:boolean; { Флаг выхода из программы }
BEGIN
Assign(F,'BASE.DAT'); { Связывание файловой переменной с именем файла }
Exit:=FALSE; { Сброс флага }
repeat { Цикл работы с базой }
case Menu of
0:Exit:=TRUE; { Подъем флага выхода }
1:begin
MakeBase(F); { Создание базы }
ViewBase(F) { Просмотр базы }
end;
2:begin
RandomMakeBase(F); { Создание базы набором случайных значений }
ViewBase(F) { Просмотр базы }
end;
3:ViewBase(F); { Просмотр базы }
4:begin
SortAtCost(F); { Сортировка базы по полю стоимости }
ViewBase(F) { Просмотр базы }
end;
5:begin
DeleteElementOfBase(F); { Удаление элемента из базы }
ViewBase(F) { Просмотр базы }
end;
6:begin
InsertElementInBase(F); { Вставка элемента в базу }
ViewBase(F) { Просмотр базы }
end;
7:begin
EditElementOfBase(F); { Редактирование элемента базы }
ViewBase(F) { Просмотр базы }
end;
8:Find(F) { Поиск элемента базы по заданному критерию }
end
until Exit
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию