Программа
PROGRAM Base;
CONST HeadBase=' N° Назв.программы Цена Формат Скорость Скорость Количество '
+' п/п составления сортировки пользователей '
+' отчета ';
{ Заголовок таблицы базы }
TYPE BaseType=record { Тип элементов базы }
Name:string; { Имя }
Cost:word; { Цена }
Format:0..1; { Формат }
V_report:word; { Скорость составления отчета }
V_sort:word; { Скорость сортировки }
Quantity_Users: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);
Write('Введите формат: 0 - DBF, 1 - SQL '); ReadLn(A.Format);
Write('Введите скорость составления отчета '); ReadLn(A.V_report);
Write('Введите скорость сортировки '); ReadLn(A.V_sort);
Write('Введите количество пользователей '); ReadLn(A.Quantity_Users)
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);
if A.Format=0 then Write(' DBF ') else Write(' SQL ');
Write(A.V_report:7,' ',A.V_sort:6,' ',A.Quantity_Users:9)
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 - Создание базы набором случайных значений');
Write('Введите номер пункта меню - '); { Вывод приглашения }
ReadLn(Point); { Ввод пункта меню }
Menu:=Point; { Определение }
WriteLn { Пропуск строки }
End;
PROCEDURE ViewBase(var F:FileOfBase); { Просмотр базы }
Var Buf:BaseType; { Буферная переменная }
i:word; { Счетчик элементов базы }
Begin
WriteLn; { Пропуск строки }
Reset(F); { Открытие файла }
i:=0; { Сброс счетчика элементов базы }
if EOF(F) { Проверка наличия }
then WriteLn('База не содержит записей') { Вывод предупреждения при пустом файле }
else repeat { Цикл просмотра базы }
if i mod 20 =0 then WriteLn(HeadBase); { Вывод названий полей }
Read(F,Buf); { Чтение элемента базы }
WriteLnBaseType(i,Buf); { Вывод элемента базы }
i:=i+1; { Пересчет номера элемента базы }
if (i mod 20 =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;
FUNCTION GetRating(A,Lo,Hi:BaseType):byte; { Функция оценки записи }
Begin
GetRating:= Ord((Lo.Cost<=A.Cost) and (A.Cost<=Hi.Cost))
+Ord(Lo.Format=A.Format)
+Ord((Lo.V_report<=A.V_report) and (A.V_report<=Hi.V_report))
+Ord((Lo.V_sort<=A.V_sort) and (A.V_sort<=Hi.V_sort))
+Ord((Lo.Quantity_Users<=A.Quantity_Users) and (A.Quantity_Users<=Hi.Quantity_Users))
End;
PROCEDURE Find(var F:FileOfBase); { Поиск элемента базы по заданному критерию }
Var Buf,CompareBufLo,CompareBufHi:BaseType; { Буферные переменные }
Rating,RatingBest,RatingBad:byte; { Критериальные оценки }
NumBest,NumBad:word; { Лучшая и худшая записи }
Begin
{ Ввод параметров поиска: }
Write('Введите нижнюю границу стоимости программы '); ReadLn(CompareBufLo.Cost);
Write('Введите верхнюю границу стоимости программы '); ReadLn(CompareBufHi.Cost);
Write('Введите формат: 0 - DBF, 1 - SQL '); ReadLn(CompareBufLo.Format);
Write('Введите нижнюю границу скорости составления отчета '); ReadLn(CompareBufLo.V_report);
Write('Введите верхнюю границу скорости составления отчета '); ReadLn(CompareBufHi.V_report);
Write('Введите нижнюю границу скорости сортировки '); ReadLn(CompareBufLo.V_sort);
Write('Введите верхнюю границу скорости сортировки '); ReadLn(CompareBufHi.V_sort);
Write('Введите нижнюю границу количества пользователей '); ReadLn(CompareBufLo.Quantity_Users);
Write('Введите верхнюю границу количества пользователей '); ReadLn(CompareBufHi.Quantity_Users);
WriteLn; { Пропуск строки }
Reset(F); { Открытие файла }
if EOF(F)
then WriteLn('Записи не найдены') { Вывод сообщения при отсутствии записей }
else begin
Read(F,Buf); { Чтение записи }
RatingBest:=GetRating(Buf,CompareBufLo,CompareBufHi);
RatingBad:=RatingBest;
NumBest:=0;
NumBad:=NumBest;
while not EOF(F) do { Цикл просмотра файла }
begin
Read(F,Buf); { Чтение записи }
Rating:=GetRating(Buf,CompareBufLo,CompareBufHi);
if Rating>RatingBest
then begin
RatingBest:=Rating;
NumBest:=FilePos(F)-1
end
else if Rating<RatingBad
then begin
RatingBad:=Rating;
NumBad:=FilePos(F)-1
end
end;
WriteLn(HeadBase); { Вывод заголовка полей }
WriteLn('Наиболее подходящая система:');
Seek(F,NumBest); { Установка файлового указателя }
Read(F,Buf); { Чтение записи }
WriteLnBaseType(NumBest,Buf); { Вывод записи }
WriteLn('Наименее подходящая система:');
Seek(F,NumBad); { Установка файлового указателя }
Read(F,Buf); { Чтение записи }
WriteLnBaseType(NumBad,Buf); { Вывод записи }
end;
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(10) do { Цикл создания базы }
begin
{ Определение полей записи: }
Buf.Name:=Stringer(Num);
Buf.Cost:=Random(10000);
Buf.Format:=Random(2);
Buf.V_report:=Random(1000);
Buf.V_sort:=Random(1000);
Buf.Quantity_Users:=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:ViewBase(F); { Просмотр базы }
3:begin
DeleteElementOfBase(F); { Удаление элемента из базы }
ViewBase(F) { Просмотр базы }
end;
4:begin
InsertElementInBase(F); { Вставка элемента в базу }
ViewBase(F) { Просмотр базы }
end;
5:begin
EditElementOfBase(F); { Редактирование элемента базы }
ViewBase(F) { Просмотр базы }
end;
6:Find(F); { Поиск элемента базы по заданному критерию }
7:begin
RandomMakeBase(F); { Создание базы набором случайных значений }
ViewBase(F) { Просмотр базы }
end
end
until Exit
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию