МегаМодератор
СуперМодератор
Регистрация: 09.11.2010
Сообщений: 7,291
|
Код:
program Project3;
{$APPTYPE CONSOLE}
uses
SysUtils,
windows;
type
Tsession = array[1..10, 1..5] of record
name: string[10];
mark: 1..5;
end;
student = record
FIO: string[40];
curs: 1..5;
group: 1..9;
results: Tsession;
end;
TFile = file of student;
var k: integer;
fname: string;
f: TFile;
procedure Read_student(var st: student);
var
i, j: integer;
begin
with st do
begin
write('Введите ФИО: ');
readln(FIO);
write('Введите курс: ');
readln(curs);
write('Введите группу: ');
readln(group);
writeln('Введите результаты сессий:');
i := 1;
repeat
writeln('Сейссия №', i, ': ');
for j := 1 to 5 do
begin
write('Название ', j, '-го экзамена: ');
readln(results[i, j].name);
write('Оценка за ', j, '-й экзамен: ');
readln(results[i, j].mark);
end;
inc(i);
until (i = curs * 2 + 1);
end;
writeln('Ввод закончен!');
end;
procedure write_student(var st: student);
var
i, j: integer;
begin
with st do
begin
writeln(FIO, ', ', curs, ' курс, ', group, ' группа.');
for i := 1 to curs * 2 do
begin
write(' Сессия ', i, ': ');
for j := 1 to 5 do
write(results[i, j].name, ': ', results[i, j].Mark, ', ');
writeln;
end;
end;
end;
procedure New_file(var f: tfile; var name: string);
begin
write('Имя нового файла: ');
readln(name);
if not fileexists(name) then
begin
assign(f, name);
rewrite(f);
writeln('Файл "', name, '" создан!');
closefile(f);
end;
end;
procedure Open_file(var f: tfile; var name: string);
begin
write('Имя файла для открытия: ');
readln(name);
assignfile(f, name);
reset(f);
closefile(f);
writeln('Файл "', name, '" открыт!');
end;
procedure Add_rec(var f: tfile; var name: string);
var
rec: student;
i, n: integer;
begin
reset(f);
seek(f, Filesize(f));
readln(n);
for i := 1 to n do
begin
writeln('Ввод ', i, ' студента из ', n);
Read_student(rec);
write(f, rec);
writeln('Запись добавлена!');
end;
closefile(f)
end;
procedure Task(var f: tfile; var name: string);
var
n, i: integer;
rec: student;
f2: tfile;
b, c, d: boolean;
name2: string;
begin
write('Введите имя файла для результатов: ');
readln(name2);
reset(f);
assign(f2, name2);
rewrite(f2);
writeln('Файл "', name2, '" создан!');
write('Ищем записи, удовлетворяющие условию... ');
for n := 0 to Filesize(f) - 1 do
begin
b := true;
c := true;
i := 1;
d := true;
seek(f, n);
read(f, rec);
while (i <= 5) and d do
begin
if (rec.results[rec.curs * 2, i].mark < 4) then d := false;
inc(i);
end;
i := 1;
if d then
begin
while c and (i <= 5) do
begin
if rec.results[rec.curs * 2, i].mark = 5 then
if b = true then
b := false
else
c := false;
inc(i);
end;
if c then
begin
writeln('Найдена запись ', n + 1);
write(f2, rec);
end;
end;
end;
closefile(f);
closefile(f2);
end;
procedure View_file(var f: tfile; var name: string);
var
i: integer;
rec: student;
begin
reset(f);
for i := 0 to Filesize(f) - 1 do
begin
read(f, rec);
write('№', i + 1, ' ');
write_student(rec);
end;
writeln('Вывод закончен!');
closefile(f);
end;
begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
New_file(f, fname);
Open_file(f, fname);
Add_rec(f, fname);
Task(f, fname);
View_file(f, fname);
readln;
end.
Вот так вывод работает. Как работает task я не понял, пока он вообще ничего не ищет.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
|