Здравствуйте, Ska4kov A U.

Вот программа, выполняющая данные действия.

Приложение:
{
Программа создает на диске файл - ведомость успевающих учащихся класса,
в котором записана следущая информация:
- фамилия и имя учащегося
- название предмета
- оценки за две контрольные работы по трем предметам
Программа обеспечивает ввод , редактирование данных
и вывод списков учащихся, выполнивших первую работу по всем предметам на 5
}

Program Pupils;

Const
cSubjectNumber = 3;
cWorkBySubject = 2;

cFileName = 'pupils.dat';

Type
TName = string [20]; { ограниченный строковый тип для названий предметов и ФИО }
TMark = 0..5; { оценки: 0 - не писал; 1-5 - оценка за работу }

TWork = array [1..cWorkBySubject] of TMark; { список оценок за работы по предмету }

{ Тип для описания одного предмета: название + список оценок за работы }
TSubject = Record
title : TName;
works : TWork;
end;

TSubjectList = array [1..cSubjectNumber] of TSubject; { список предметов }

{ Тип для описания учащегося }
TPupil = Record
family : TName;
name : TName;
subjects : TSubjectList;
end;

TPupilFile = file of TPupil; { типизированный файл для хранения информации об учащихся }

Var
f : TPupilFile;

pupil : TPupil;

s : 1..cSubjectNumber;
w : 1..cWorkBySubject;

sel : Char;

{ Процедура очистки экрана }
Procedure ClrScr; assembler;
asm
mov ax, 3
int 10h
end;

{ Процедура очистки записи об учащемся }
Procedure ClearRecord;
begin
with pupil do
begin
family := '';
name := '';

for s := 1 to cSubjectNumber do
with subjects [s] do
begin
title := '';

for w := 1 to cWorkBySubject do
works [w] := 0;
end
end;
end;

{ Процедура вывода информации об учащемся }
Procedure PrintRecord;
begin
ClrScr;

with pupil do
begin
writeln ('Фамилия учащегося --> ', family);
writeln ('Имя учащегося --> ', name);

for s := 1 to cSubjectNumber do
with subjects [s] do
begin
writeln ('Название предмета --> ', title);

for w := 1 to cWorkBySubject do
writeln (' Оценка за ', w , '-ю контрольную --> ', works [w]);
end;
end;
end;

{
Функция ввода информации об учащемся
Возвращает true при корректном вводе
и false для окончания ввода
}
Function InputRecord : Boolean;

begin
ClrScr;
ClearRecord;

InputRecord := false;

with pupil do
begin
write ('Введите фамилию учащегося (точка - завершение ввода) --> '); readln (family);

if family = '.' then exit;

write ('Введите имя учащегося --> '); readln (name);

writeln ('Введите информацию о предметах:');
for s := 1 to cSubjectNumber do
with subjects [s] do
begin
write ('Название предмета --> '); readln (title);

for w := 1 to cWorkBySubject do
begin
write ('Оценка за ', w , '-ю контрольную --> '); readln (works [w]);
end;
end;
end;

InputRecord := true;
end;

{
Процедура редактирования записи
}
Procedure EditRecord;
var
answer : Char;

begin
ClrScr;

with pupil do
begin
writeln ('Учащийся: ', family, ' ', name);
write ('Изменить [Y/N]? '); readln (answer);
if answer in ['y', 'Y', 'д', 'Д'] then begin
write ('Введите фамилию учащегося --> '); readln (family);
write ('Введите имя учащегося --> '); readln (name);
end;

for s := 1 to cSubjectNumber do
with subjects [s] do
begin
writeln ('Название предмета --> ', title);
for w := 1 to cWorkBySubject do
writeln (' Оценка за ', w , '-ю контрольную --> ', works [w]);

write ('Изменить [Y/N]? '); readln (answer);
if answer in ['y', 'Y', 'д', 'Д'] then begin
write ('Введите новое название предмета --> '); readln (title);

for w := 1 to cWorkBySubject do
begin
write ('Оценка за ', w , '-ю контрольную --> '); readln (works [w]);
end;
end;
end;
end;
end;

{ Процедура создания файла }
Procedure Create;

begin
ClrScr;

{$I-}
Assign (f, cFileName); Rewrite (f);
{$I+}

if IOResult <> 0 then begin
writeln ('Не могу создать файл ', cFileName, '!');
halt (1);
end;

while InputRecord do write (f, pupil);

close (f);
end;

{ Процедура редактирования файла }
Procedure Edit;
var
recNum : Word;
answer : Char;
res : Boolean;

begin
ClrScr;

{$I-}
Assign (f, cFileName); Reset (f);
{$I+}

if IOResult <> 0 then begin
writeln ('Не могу открыть файл ', cFileName, '!');
halt (1);
end;

recNum := 0;
while not eof (f) do
begin
read (f, pupil);
Inc (recNum);
PrintRecord;

writeln;
write ('Желаете отредактировать запись [Y/N]? '); readln (answer);

if answer in ['y', 'Y', 'д', 'Д'] then begin
EditRecord;
Seek (f, recNum - 1);
write (f, pupil);
end;
end;

write ('Желаете добавить новые записи [Y/N]? '); readln (answer);

if answer in ['y', 'Y', 'д', 'Д'] then
while InputRecord do write (f, pupil);

close (f);
end;

{ Процедура поиска и вывода списка учащихся, выполнивших первую работу по всем предметам на 5 }
Procedure Search;
var
count : Word;
flag : Boolean;

begin
ClrScr;
count := 0;

{$I-}
Assign (f, cFileName); Reset (f);
{$I+}

if IOResult <> 0 then begin
writeln ('Не могу открыть файл ', cFileName, '!');
halt (1);
end;

with pupil do
while not eof (f) do
begin
read (f, pupil);

flag := true;

for s := 1 to cSubjectNumber do
if subjects [s].works [1] <> 5 then flag := false;

if flag then begin
writeln (family, ' ', name);
Inc (count);
end;
end;

writeln ('Всего ', count, ' учащихся');

close (f);

write ('Для продолжения нажмите Enter: '); readln;
end;

Begin
Repeat
ClrScr;

writeln;
writeln;
writeln (' Список действий');
writeln ('----------------------');
writeln;
writeln ('1 - создать файл');
writeln ('2 - редактировать файл');
writeln ('3 - выбрать отличников');
writeln;
writeln ('0 - завершить работу');
writeln;
write ('Выберите действие --> '); readln (sel);

case sel of
'1' : Create;
'2' : Edit;
'3' : Search;
end;
Until sel = '0';

ClrScr;
End.