Программа
CONST FileName1='ENTR_1.DAT'; { Имя основного файла данных }
FileName2='ENTR_2.DAT'; { Имя дополнительного файла данных }
CertificateMarksQuantity=10; { Количество оценок в аттестате }
ExamMarksQuantity=3; { Количество вступительных экзаменов }
TYPE EstimationType=record { Таблица оценок }
Quantity:1..CertificateMarksQuantity; { Количество оценок }
Mark:array [1..CertificateMarksQuantity] of 2..5 { Оценки }
end;
String10=string[10]; { Тип фамилии, имени и отчества }
EntrantType=record { Тип - абитуриент }
Sur,Name,Patronymic:String10; { Ф.И.О.}
BirthYear,FinishSchoolYear:word;
{ года рождения и окончания школы }
Certificate:EstimationType;{ Оценки аттестата }
Hostel:boolean; { Нуждаемость в общежитии }
Exam:EstimationType; { Оценки вступительных экзаменов }
end;
FileOfEntrant=File Of EntrantType; { Тип - файл абитуриентов }
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;
FUNCTION GetRandomStr(Len:byte):string; { Функция получения случайной строки }
Var i:byte; { Счетчик }
Buf:string; { Буфер для формирования строки }
Begin
Buf:=''; { Сброс строки }
for i:=1 to Len do { Цикл формирования строки }
Buf:=Buf+Chr(Ord('A')+Random(26)); { Набор строки }
for i:=Len+1 to 255 do { Цикл дополнения строки пробелами }
Buf:=Buf+' '; { Дополнения пробела }
GetRandomStr:=Buf { Определение значения функции }
End;
PROCEDURE GetMark(var Marks:EstimationType); { Процедура набора таблицы оценок }
Var i:1..CertificateMarksQuantity; { Счетчик }
Begin
for i:=1 to Marks.Quantity do { Цикл набора таблицы }
if Marks.Quantity<5
then Marks.Mark[i]:=2+Random(4)
else Marks.Mark[i]:=3+Random(3); { Определение оценки в таблице }
End;
PROCEDURE GetEntrant(var Entrant:EntrantType); { Процедура формирования записи }
Begin
with Entrant do
begin
Sur:=GetRandomStr(2+Random(9)); { Определение фамилии }
Name:=GetRandomStr(2+Random(9)); { Определение имени }
Patronymic:=GetRandomStr(2+Random(9)); { Определение отчества }
BirthYear:=1980+Random(4); { Определение года рождения }
FinishSchoolYear:=BirthYear+16+Random(3); { Определение года окончания школы }
Certificate.Quantity:=CertificateMarksQuantity; { Определене количества оценок аттестата }
GetMark(Certificate); { Определене оценок аттестата }
Hostel:=Random(2)=0; { Определене нуждаемости в общежитии }
Exam.Quantity:=ExamMarksQuantity; { Определене количества экзаменационных оценок }
GetMark(Exam) { Определене экзаменационных оценок }
end
End;
PROCEDURE ReadMark(var Marks:EstimationType); { Процедура ввода таблицы оценок }
Var i:1..CertificateMarksQuantity; { Счетчик }
Begin
for i:=1 to Marks.Quantity do { Цикл набора таблицы }
begin
Write('Введите ',i,'-ю оценку '); { Вывод подсказки }
ReadLn(Marks.Mark[i]); { Определене оценки в таблице }
end
End;
PROCEDURE Stretch(var S:string10);{ Процедура дополнения строки пробелами }
Begin
while Length(S)<10 do S:=S+' ' { Цикл дополнения }
End;
PROCEDURE ReadEntrant(var Entrant:EntrantType); { Процедура ввода записи }
Var i:byte; { Счетчик }
Begin
with Entrant do
begin
Write('Введите фамилию '); { Вывод приглашения }
ReadLn(Sur); { Ввод фамилии }
Stretch(Sur); { Дополнение строки пробелами }
Write('Введите имя '); { Вывод приглашения }
ReadLn(Name); { Ввод имени }
Stretch(Name); { Дополнение строки пробелами }
Write('Введите отчество '); { Вывод приглашения }
ReadLn(Patronymic); { Ввод отчества }
Stretch(Patronymic); { Дополнение строки пробелами }
Write('Введите год рождения '); { Вывод приглашения }
ReadLn(BirthYear); { Ввод года рождения }
Write('Введите год окончания школы '); { Вывод приглашения }
ReadLn(FinishSchoolYear); { Ввод года окончания школы }
Certificate.Quantity:=CertificateMarksQuantity; { Определене количества оценок аттестата }
WriteLn('Ввод аттестационных оценок'); { Вывод приглашения }
ReadMark(Certificate); { Определене оценок аттестата }
Hostel:=Question('Нуждаемость в общежитии '); { Ввод нуждаемости в общежитии }
Exam.Quantity:=ExamMarksQuantity; { Определене количества экзаменационных оценок }
WriteLn('Ввод экзаменационных оценок'); { Вывод приглашения }
ReadMark(Exam); { Определене экзаменационных оценок }
end
End;
PROCEDURE Make(var F:FileOfEntrant); { Процедура создания файла }
Var Entrant:EntrantType; { Абитуриент }
Begin
Rewrite(F); { Открытие файла }
Randomize; { Инициализация генератора случайных чисел }
if Question('Создать файл автоматически?') { Выбор варианта создания базы }
then while Random(10)>0 do { Цикл создания файла }
begin
GetEntrant(Entrant); { Формирование записи абитуриента }
Write(F,Entrant) { Запись абитуриента в файл }
end
else while Question('Создать запись?') do { Цикл создания файла }
begin
ReadEntrant(Entrant); { Ввод абитуриента }
Write(F,Entrant) { Запись абитуриента в файл }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE Stop; { Процедура остановки программы }
Begin
Write('Нажмите <Enter>'); { Вывод приглашения нажать <Enter> }
ReadLn { Остановка программы до нажатия <Enter> }
End;
FUNCTION GetAverage(Marks:EstimationType):real; { Функция вычисления среднего балла }
Var Sum:word; { Сумма оценок }
i:1..CertificateMarksQuantity; { Счетчик }
Begin
Sum:=0; { Сброс суммы }
for i:=1 to Marks.Quantity do Sum:=Sum+Marks.Mark[i]; { Цикл набора суммы }
GetAverage:=Sum/Marks.Quantity; { Определение значения функции }
End;
PROCEDURE WriteMarks(Marks:EstimationType); { Процедура вывода массива оценок }
Var i:1..CertificateMarksQuantity; { Счетчик }
Begin
for i:=1 to Marks.Quantity do { Цикл вывода оценок }
Write(Marks.Mark[i],' '); { Вывод оценки }
Write('(',GetAverage(Marks):4:2,')'); { Вывод среднего бала }
End;
PROCEDURE WriteEntrant(Entrant:EntrantType); { Процедура вывода записи }
Var i:byte; { Счетчик }
Begin
with Entrant do
begin { Вывод полей записи: }
Write(Sur,' ',Name[1],'.',Patronymic[1],'. ',BirthYear,' ',FinishSchoolYear,' ');
WriteMarks(Certificate); { Вывод массива аттестата }
if Hostel then Write(' √ ') else Write(' '); { Вывод признака нуждаемости в общежитии }
WriteMarks(Exam) { Вывод массива экзаменационных оценок }
end;
WriteLn { Пропуск строки }
End;
PROCEDURE View(Head:string;var F:FileOfEntrant); { Процедура просмотра файла }
Var Entrant:EntrantType; { Абитуриент }
i:byte; { Счетчик строк }
Begin
Reset(F); { Открытие файла }
WriteLn(Head); { Вывод заголовка }
i:=0; { Сброс счетчика строк }
while not EOF(F) do { Цикл просмотра файла }
begin
if i=0 then WriteLn('Фамилия И.О. год р. год.ок.шк. Аттестат (Ср.) Общ. Оценки (Ср.)');
{ Вывод заголовка таблицы }
Inc(i); { Подсчет числа выведенных записей }
Read(F,Entrant); { Чтение записи из файла }
WriteEntrant(Entrant); { Вывод записи }
if (i=22)and not EOF(F) then begin Stop; i:=0 end
{ Остановка программы и сброс счетчика }
end;
Close(F); { Закрытие файла }
Stop { Остановка программы }
End;
FUNCTION CheckForDelete(Entrant:EntrantType):boolean;
Begin { Функция проверки записи для удаления }
with Entrant do
CheckForDelete:=Hostel and (GetAverage(Exam)>4.5) { Определение значения функции }
End;
PROCEDURE Delete(var F:FileOfEntrant;i:longint); { Процедура удаления записи из файла }
Var Entrant:EntrantType; { Абитуриент }
Begin
while i+1<FileSize(F) do { Цикл перезаписи абитуриентов в файле }
begin
Seek(F,i+1); { Установка файлового указателя }
Read(F,Entrant); { Чтение абитуриента }
Seek(F,i); { Установка файлового указателя }
Write(F,Entrant); { Запись абитуриента }
Inc(i) { Переопределение счетчика записей }
end;
Truncate(F) { Удаление последней записи в файле }
End;
PROCEDURE DelRec(var F:FileOfEntrant); { Процедура удаления записей из файла }
Var Entrant:EntrantType; { Абитуриент }
i:longint;{ Счетчик записей файла }
Begin
Reset(F); { Открытие файла }
i:=0; { Сброс счетчика }
while i<FileSize(F) do { Цикл просмотра файла }
begin
Seek(F,i); { Установка файлового указателя на i-компоненту файла }
Read(F,Entrant); { Чтение записи }
if CheckForDelete(Entrant) { Проверка записи }
then Delete(F,i) { Удаление записи из файла }
else Inc(i)
end;
Close(F) { Закрытие файла }
End;
FUNCTION CheckForInsert(Entrant:EntrantType):boolean;
Begin { Функция проверки записи для удаления }
with Entrant do
CheckForInsert:=GetAverage(Exam)<4 { Определение значения функции }
End;
PROCEDURE Add(var F1,F2:FileOfEntrant); { Процедура добавление записей в файл }
Const N:byte=1; { Количество добавляемых записей }
Var Entrant:EntrantType; { Абитуриент }
Begin
Reset(F1); { Открытие файла }
Reset(F2); { Открытие файла }
Seek(F1,FileSize(F1)); { Установка указателя на конец основного файла }
while (N>0)and not EOF(F2) do { Цикл просмотра дополнительного файла }
begin
Read(F2,Entrant); { Цтение записи }
if CheckForInsert(Entrant) then { Проверка записи }
begin
Dec(N); { Переопределение количества добавляемых записей }
Write(F1,Entrant) { Добавление записи }
end
end;
Close(F1); { Закрытие файла }
Close(F2) { Закрытие файла }
End;
VAR F1,F2:FileOfEntrant; { Файл абитуриентов }
BEGIN
Assign(F1,FileName1); { Связывание файловой переменной и имени файла }
Assign(F2,FileName2); { Связывание файловой переменной и имени файла }
WriteLn; { Пропуск строки }
WriteLn('Создание основного файла данных:'); { Вывод подсказки }
Make(F1); { Создание файла }
WriteLn('Создание дополнительного файла данных:'); { Вывод подсказки }
Make(F2); { Создание файла }
WriteLn; { Пропуск строки }
View('ИСХОДНЫЙ ФАЙЛ "'+FileName1+'":',F1); { Просмотр файла }
WriteLn; { Пропуск строки }
View('ДОПОЛНИТЕЛЬНЫЙ ФАЙЛ "'+FileName2+'":',F2); { Просмотр файла }
WriteLn; { Пропуск строки }
DelRec(F1); { Удаление записей }
View('УДАЛЕНИЕ ЗАПИСЕЙ ИЗ ФАЙЛА "'+FileName1+'":',F1); { Просмотр файла }
WriteLn; { Пропуск строки }
Add(F1,F2); { Добавление записей }
View('ДОБАВЛЕНИЕ ЗАПИСЕЙ В ФАЙЛ "'+FileName1+'" ИЗ ФАЙЛА "'+FileName2+'":',F1) { Просмотр файла }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию