Помощь с дистанционным обучением: тесты, экзамены, сессия

Программный код модуля KURS_RV6.PAS

Uses Crt;

Type
Person=Record
Fam: String[15]; {Фамилия сотрудника}
Im: String[10]; {Имя сотрудника}
Otch:String[20]; {Отчество сотрудника}
D: 1..31;
M: 1..12;
Y: word;
end;

Var
Op: byte; {Номер выполняемой операции с файлом}

F: file of Person;

Procedure MainMenu; forward;

Procedure NewF;

{Процедура очистки списка сотрудников,
т.е. cоздание нового пустого исходного файла}
begin
Rewrite(F);
Close(F);
ClrScr;
WriteLn('Имеющийся список сотрудников очищен!');
WriteLn;
Write('Для продолжения нажмите любую клавишу...');
ReadKey; {Ожидание нажатия любой клавиши}
MainMenu; {Возврат в главное меню}
end;

Procedure NewS;

{Процедура ввода данных сотрудника}
var
P: Person;
begin
ClrScr;
Reset(F);
WriteLn(' ':20,'Ввод данных нового сотрудника');
WriteLn;
Write('Фамилия: '); ReadLn(P.Fam);
Write('Имя: '); ReadLn(P.Im);
Write('Отчество: '); ReadLn(P.Otch);
Write('День рождения: '); ReadLn(P.D);
Write('Месяц рождения: '); ReadLn(P.M);
Write('Год рождения: '); ReadLn(P.Y);
Seek(F,FileSize(F)); {Перемещаем указатель в конец файла}
Write(F,P);
Close(F);
WriteLn;
WriteLn('Данные нового сотрудника успешно добавлены!');
WriteLn;
Write('Для продолжения нажмите любую клавишу...');
ReadKey; {Ожидание нажатия любой клавиши}
MainMenu; {Возврат в главное меню}
end;

Procedure EditS;

{Процедура изменения данных сотрудника,
найденного по фамилии}
var
P: Person;
Fam: string[15];
begin
ClrScr;
Reset(F);
WriteLn(' ':20,'Редактирование данных сотрудника');
WriteLn;
Write('Введите Фамилию сотрудника: '); ReadLn(Fam);
WriteLn;
While Not Eof(F) do begin
Read(F,P);
If P.Fam=Fam then begin
WriteLn(' ':25,'Найденный сотрудник');
WriteLn('Фамилия: ',P.Fam);
WriteLn('Имя: ', P.Im);
WriteLn('Отчество: ', P.Otch);
WriteLn('День рождения: ', P.D);
WriteLn('Месяц рождения: ', P.M);
WriteLn('Год рождения: ', P.Y);
break;
end;
end;
WriteLn;
WriteLn(' ':20,'Введите новые данные сотрудника');
Write('Фамилия: '); ReadLn(P.Fam);
Write('Имя: '); ReadLn(P.Im);
Write('Отчество: '); ReadLn(P.Otch);
Write('День рождения: '); ReadLn(P.D);
Write('Месяц рождения: '); ReadLn(P.M);
Write('Год рождения: '); ReadLn(P.Y);
Seek(F,FilePos(F)-1); {Перемещаем указатель в ...}
Write(F,P);
Close(F);
WriteLn;
WriteLn('Данные сотрудника успешно изменены!');
WriteLn;
Write('Для продолжения нажмите любую клавишу...');
ReadKey; {Ожидание нажатия любой клавиши}
MainMenu; {Возврат в главное меню}
end;

Procedure DelS;

{Процедура удаления сведений о сотруднике,
найденного по фамилии}
var
P: Person;
Ftmp: file of Person;
Fam: string[15];
begin
ClrScr;
Reset(F);
Assign(Ftmp,'tmp.dat');
Rewrite(Ftmp);
WriteLn(' ':20,'Удаление данных о сотруднике');
WriteLn;
Write('Введите Фамилию удаляемого сотрудника: '); ReadLn(Fam);
While Not Eof(F) do begin
Read(F,P);
If P.Fam<>Fam then Write(Ftmp,P);
end;
Close(F);
Close(Ftmp);
Erase(F);
Rename(Ftmp,'drs.dat');
WriteLn;
WriteLn('Данные сотрудника успешно удалены!');
WriteLn;
Write('Для продолжения нажмите любую клавишу...');
ReadKey; {Ожидание нажатия любой клавиши}
MainMenu; {Возврат в главное меню}
end;

Procedure VivodS;

{Процедура вывода списка сотрудников, которые
отмечают свой день рождения в указанном месяце}
var
P: Person;
F2: text;
nm: 1..12;
begin
Reset(F);
Assign(F2,'drsm.txt');
Rewrite(F2);
ClrScr;
WriteLn(' ':14,'Вывод списка сотрудников с ДР в указанном месяце');
WriteLn;
Write('Введите номер месяца: '); ReadLn(nm);
WriteLn;
WriteLn(' ':25,'Список сотрудников:');
While Not Eof(F) do begin
Read(F,P);
If P.M=nm then begin
WriteLn(F2,P.Fam,' ',P.Im,' ',P.Otch);
WriteLn(P.Fam,' ',P.Im,' ',P.Otch);
end;
end;
Close(F);
Close(F2);
WriteLn; WriteLn;
WriteLn('Создан текстовый файл (drsm.txt) с выведенным списком!');
WriteLn; WriteLn;
Write('Для продолжения нажмите любую клавишу...');
ReadKey; {Ожидание нажатия любой клавиши}
MainMenu; {Возврат в главное меню}
end;

Procedure MainMenu;

{Процедура отображения на экране главного меню команд}
begin
Repeat
ClrScr;
WriteLn(' ':19, 'Сведения о датах рождения сотрудников');
WriteLn;
WriteLn('1 - Очистить список сотрудников');
WriteLn('2 - Ввести сведения нового сотрудника');
WriteLn('3 - Изменить сведения сотрудника');
WriteLn('4 - Удалить сведения о сотруднике');
WriteLn('5 - Вывод сотрудников с ДР в указанном месяце');
WriteLn('6 - Завершить работу'); WriteLn;
Write('Введите номер операции: '); ReadLn(Op);
Case Op of
1: NewF;
2: NewS;
3: EditS;
4: DelS;
5: VivodS;
end;
Until Op=6;
end;

Begin
Assign(F,'drs.dat');

{$I-} {Отключаем контроль ошибок ввода-вывода}
Reset(F);
{$I+} {Включаем контроль ошибок ввода-вывода}
If IOResult <> 0 then begin
Rewrite(F);
Close(F);
end
else Close(F);
MainMenu; {Выводим на экран главное меню}
End.