procedure punkt0; {Очистка базы}

var cc,k,ch:char; i:integer;

key:char;

begin

assign(sotrud,'sotrudn.dat');

cc:=chr(13);

{cc:=readkey;}

if cc=chr(13) then

begin

gotoxy(25,10);

writeln('Вы уверены,что хотите удалить базу????');

gotoxy(25,11);

Writeln('Enter-ДА, Esc-НЕТ');

key:=readkey;

if key=chr(13) then

begin

gotoxy(11,4);

write('0%');

gotoxy(63,4);

write('100%');

gotoxy(13,4);

for i:=1 to 20 do

begin

write('=');

delay(500);

end;

for i:=21 to 34 do

begin

write('=');

delay(1300);

end;

for i:=35 to 50 do

begin

write('=');

delay(200);

end;

rewrite(sotrud);

gotoxy(32,18);

write('База очищена');

gotoxy(32,19);

write('Нажмите клавишу Esc');

end;

end;

end;

procedure punkt1; {Новый сотрудник}

var k,ch:char;

begin

clrscr;

gotoxy(12,wherey);writeln('*************************************');

gotoxy(12,wherey);writeln('Добавьте в базу информацию о новом сотруднике - "Enter"');

gotoxy(12,wherey);writeln('*************************************');

ch:=readkey;

if ch<>chr(27) then

begin

new(Cur);

writeln(' Введите информацию');

write('Регистрационный номер: ');

readln(Cur^.rnom);

write('Фамилия: ');

readln(Cur^.fam);

write('Имя: ');

readln(Cur^.name);

write('Отчество: ');

readln(Cur^.otch);

write('Год и Дата рождения: ');

readln(Cur^.date);

write('Пол: ');

readln(Cur^.pol);

write('Стаж работы: ');

readln(Cur^.stag);

write('Домашний адрес: ');

readln(Cur^.adress);

write('Телефон: ');

readln(Cur^.tel);

write('Должность: ');

readln(Cur^.dolg);

write('Оклад: ');

readln(Cur^.oklad);

Cur^.link:=Top;

Top:=Cur;

end;

end;

procedure Punkt2; {Уволить}

var

rnom1:integer;

fam1,name1, otch1:string[20];

pos,f:integer;

key:char;

begin

clrscr;

writeln(' *******************************************');

writeln(' Будите удалять сотрудика из базы - "Enter"');

writeln(' *******************************************');

ch:=readkey;

if ch=chr(13) then

begin

clrscr;

if top=nil then begin

writeln('База пуста');

readln;

end

else

BEGIN

writeln(' **********************');

writeln(' Увольнение сотрудника');

writeln(' **********************');

writeln('Пожалуйста введите');

Writeln('Регистрационный номер увольняемого ');readln(rnom1);

writeln('Фамилия увольняемого: ');readln(fam1);

writeln('Имя увольняемого: ');readln(name1);

writeln('Отчество увольняемого: ');readln(otch1);

Cur:=Top;

pos:=1;

repeat

f:=0;

If Cur^.rnom=rnom1 then

If Cur^.fam=fam1 then

If Cur^.Name=name1 then

if Cur^.otch=otch1 then

begin

writeln('Вы действительно хотите удалить данного сотрудника');

Writeln('Enter-ДА, Esc-НЕТ');

key:=readkey;

if key=chr(13) then

begin

if Cur^.link=nil then begin dispose(Cur); f:=1; end

else

If Cur=Top then begin

If Top^.link<>nil then

begin

Top:=Top^.link;

dispose(Cur);

f:=1;

end;

end

else

begin

Position(pos-1);

Prev:=Cur;

Cur:=Cur^.link;

Next:=Cur^.link;

Prev^.link:=Next;

Dispose(Cur);

f:=1;

end;

writeln('Сотрудник ' ,fam1,' ',name1,' ',otch1, ' уволен ');

readkey;

end;

end;

Cur:=Cur^.link;

pos:=pos+1;

if (cur=nil) and (f=0) then

begin

WriteLn('Искомый сотрудник не числется.');

writeln('Возможно имя или фамилия были введены с маленькой буквы');

Write('Для продолжения нажмите любую клавишу.');

readkey;

break;

end;

until f=1;

end;

END;

end;

procedure Punkt3; {Просмотр}

var ch:char;

begin

clrscr;

sortirovka;

writeln(' **********************');

writeln(' Список сотрудников');

writeln(' **********************');

Cur:=Top;

if top=nil then write('nichego netu')

else

Repeat

write('Регистрационный номер: ');writeln(Cur^.rnom);

write('Фамилия: ');write(Cur^.fam);

gotoxy(40,wherey); write('Год и Дата рождения: ');writeln(Cur^.date);

write('Имя: ');write(Cur^.name);

gotoxy(40,wherey);write('Домашний адрес: ');writeln(Cur^.adress);

write('Отчество: ');write(Cur^.otch);

gotoxy(40, wherey);write('Телефон: ');writeln(Cur^.tel);

write('Пол: ');write(Cur^.pol);

gotoxy(40,wherey);write('Должность: ');writeln(Cur^.dolg);

write('Стаж работы: ');write(Cur^.stag);

gotoxy(40,wherey);write('Оклад: ');writeln(Cur^.oklad);

writeLn('**********************************************');writeln;

Cur:=Cur^.link;

ch:=ReadKey;

if ch<>chr(13) then break;

if cur=nil then

begin

Write('список окончен');

readkey;

break;

end;

until (Cur=nil) or (ch<>chr(13));

end;

procedure Punkt4; {Упорядочить}

var ch:char;

begin

clrscr;

Uporyad;

writeln(' **********************');

writeln(' Список сотрудников');

writeln(' **********************');

Cur:=Top;

if top=nil then write('Файл пуст')

else

Repeat

write('Регистрационный номер: ');writeln(Cur^.rnom);

write('Фамилия: ');write(Cur^.fam);

gotoxy(40,wherey); write('Имя: ');writeln(Cur^.name);

write('Отчество: ');write(Cur^.otch);

gotoxy(40,wherey);write('Оклад: ');writeln(Cur^.oklad);

writeLn('**********************************************');writeln;

Cur:=Cur^.link;

ch:=ReadKey;

if ch<>chr(13) then break;

if cur=nil then

begin

Write('список окончен');

readkey;

break;

end;

until (Cur=nil) or (ch<>chr(13));

end;

Procedure Punkt5; {Поиск сотрудника}

var

dol:String[10];

sch,kol:integer;

search:boolean;

sotr:array[1..10] of base;

begin

clrscr;

gotoxy(33,wherey); writeln('****************');

gotoxy(33,wherey); writeln('Поиск сотрудника');

gotoxy(33,wherey); writeln('****************');

write('Введите должность сотрудника: ');readln(dol);

clrscr;

gotoxy(30,wherey); writeln('********************');

gotoxy(30,wherey); writeln('Найденные сотрудники');

gotoxy(30,wherey); writeln('********************');

Sch:=0;

I:=0;

Search:=false;

Cur:=Top;

While Cur<>nil do

begin

If Cur^.Dolg = dol then begin

i:=i+1;

sotr[i]:=Cur^;

Sch:=Sch+1;

search:=true;

end;

Cur:=Cur^.link;

if (search=false) and (Cur=nil) then

begin

Write('Искомых сотрудников нет в базе.');

writeln('Возможно должность введена с маленькой буквы');

end;

end;

If Search=true then

begin

WriteLn('Искомая должность: ',dol);

WriteLn('');

For i:=1 to Sch do

begin

write('Регистрационный номер: ');writeln(Sotr[i].rnom);

write('Фамилия: ');write(Sotr[i].fam);

gotoxy(40,wherey); write('Год и Дата рождения: ');writeln(Sotr[i].date);

write('Имя: ');write(Sotr[i].name);

gotoxy(40,wherey);write('Домашний адрес: ');writeln(Sotr[i].adress);

write('Отчество: ');write(Sotr[i].otch);

gotoxy(40, wherey);write('Телефон: ');writeln(Sotr[i].tel);

write('Пол: ');write(Sotr[i].pol);

gotoxy(40,wherey);write('Должность: ');writeln(Sotr[i].dolg);

write('Стаж работы: ');write(Sotr[i].stag);

gotoxy(40,wherey);write('Оклад: ');writeln(Sotr[i].oklad);

writeLn('***************************************************');

ch:=ReadKey;

if ch<>chr(13) then break;

end;

end;

readkey;

end;

Begin

clrscr;

gotoxy(28,wherey);writeln('**************************');

gotoxy(28,wherey);writeln('БАЗА ДАННЫХ ПО СОТРУДНИКАМ');

gotoxy(28,wherey);writeln('**************************');

Top:=nil;

menu[1]:='1. НОВЫЙ СОТРУДНИК';

menu[2]:='2. УВОЛИТЬ СОТРУДНИКА';

menu[3]:='3. ПРОСМОТРЕТЬ СПИСОК';

menu[4]:='4. УПОРЯДОЧИТЬ СПИСОК';

menu[5]:='5. НАЙТИ СОТРУДНИКА';

menu[6]:='6. ВЫХОД';

menu[8]:= '1. Очистить базу ';

menu[9]:= '2. Продолжить базу';

menu[10]:='3. ВЫХОД';

menu[11]:='';

punkt:=8; x:=30; y:=-2; textattr:=norm;

n:=10; p:=8;

Menus;

repeat

ch:=ReadKey;

if ch=chr(0) then

begin

ch:=ReadKey;

case ch of

chr(80) : { стрелка вниз }

if punkt<=n+1 then begin

if punkt=10 then begin

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

if punkt=10 then punkt:=7;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

punkt:=punkt+1;

textattr:=sel;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

chr(72) : { стрелка вверх }

if (punkt<=n) and not(punkt<p) then begin

if punkt=8 then begin

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

if punkt=8 then punkt:=11;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

punkt:=punkt-1;

textattr:=sel;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

end; {case : of }

end

else

if ch=chr(13) then {нажата клавиша <Enter>}

begin

case punkt of

8 : punkt0 ;

9 : ch:=chr(27) ;

10 : exit ; {выход}

end;

End;

until ch= chr(27) ; {27 - код <Esc>}

{clrscr;}

punkt:=1; x:=30; y:=5; textattr:=norm;

n:=6; p:=1;

Menus;

filetodin;

repeat

ch:=ReadKey;

if ch=chr(0) then

begin

ch:=ReadKey;

case ch of

chr(80) : { стрелка вниз }

if punkt<=n+1 then begin

if punkt=6 then begin

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

if punkt=6 then punkt:=0;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

punkt:=punkt+1;

textattr:=sel;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

chr(72) : { стрелка вверх }

if (punkt<=n) and not(punkt<1) then begin

if punkt=1 then begin

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

if punkt=1 then punkt:=7;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

punkt:=punkt-1;

textattr:=sel;

gotoxy(x,y+punkt-1);

write(menu[punkt]);

textattr:= norm;

end;

end; {case : of }

end

else

if ch=chr(13) then {нажата клавиша <Enter>}

begin

case punkt of

1 : punkt1 ;

2 : punkt2 ;

3 : punkt3 ;

4 : punkt4 ;

5 : punkt5 ;

6 : ch:=chr(27) ; {выход}

end;

Menus;

End;

until ch= chr(27) ; {27 - код <Esc>}

{clrscr;}

dintofile;

End.

Приложение 2

Распечатка структуры базы даны

**********************

Список сотрудников

**********************

Регистрационный номер: 2

Фамилия: Бояршина Год и Дата рождения: 2.06.85

Имя: Елена Домашний адрес: Гая

Отчество: Александровна Телефон: 28666

Пол: ж Должность: Уборщица

Стаж работы: 5 Оклад: 2000

*************************************************************

Регистрационный номер: 6

Фамилия: Герасимов Год и Дата рождения: 21.12.80

Имя: Евгений Домашний адрес: Ворошилова 34-34

Отчество: Алексеивич Телефон: -23077

Пол: м Должность: Секретарь

Стаж работы: 3 Оклад: 4000

*************************************************************

Регистрационный номер: 3

Фамилия: Григорьев Год и Дата рождения: 10.07.85

Имя: Александр Домашний адрес: Голосова 103-108

Отчество: Владимирович Телефон: 2632

Пол: м Должность: Директор

Стаж работы: 4 Оклад: 30000

*************************************************************

Регистрационный номер: 4

Фамилия: Матросов Год и Дата рождения: 16.07.85

Имя: Игорь Домашний адрес: Голосова 102-102

Отчество: Витальевич Телефон: 2027

Пол: м Должность: Бухгалтер

Стаж работы: 2 Оклад: 6000

*************************************************************

Регистрационный номер: 1

Фамилия: Прохоров Год и Дата рождения: 23.11.80

Имя: Виктор Домашний адрес: Баныкина

Отчество: Сергеевич Телефон: -856

Пол: м Должность: Охранник

Стаж работы: 3 Оклад: 5500

*************************************************************

Регистрационный номер: 5

Фамилия: Ромашенко Год и Дата рождения: 12.05.80

Имя: Владимир Домашний адрес: Баныкина

Отчество: Владимирович Телефон: -4124

Пол: м Должность: Мэнеджер

Стаж работы: 5 Оклад: 10000

*************************************************************

список окончен

Приложение 3

Распечатку результатов решения задачи по данным контрольного примера

Уволен служащий с ФИО - Матросов Игорь Витальевич

Принят на работу новый сотрудник с ФИО - Сурьянинова Алена

Структура база данных выглядит следующим образом:

**********************

Список сотрудников

**********************

Регистрационный номер: 2

Фамилия: Бояршина Год и Дата рождения: 2.06.85

Имя: Елена Домашний адрес: Гая

Отчество: Александровна Телефон: 28666

Пол: ж Должность: Уборщица

Стаж работы: 5 Оклад: 2000

*************************************************************

Регистрационный номер: 6

Фамилия: Герасимов Год и Дата рождения: 21.12.80

Имя: Евгений Домашний адрес: Ворошилова 34-34

Отчество: Алексеивич Телефон: -23077

Пол: м Должность: Секретарь

Стаж работы: 3 Оклад: 4000

*************************************************************

Регистрационный номер: 3

Фамилия: Григорьев Год и Дата рождения: 10.07.85

Имя: Александр Домашний адрес: Голосова 103-108

Отчество: Владимирович Телефон: 2632

Пол: м Должность: Директор

Стаж работы: 4 Оклад: 30000

*************************************************************

Регистрационный номер: 1

Фамилия: Прохоров Год и Дата рождения: 23.11.80

Имя: Виктор Домашний адрес: Баныкина

Отчество: Сергеевич Телефон: -856

Пол: м Должность: Охранник

Стаж работы: 3 Оклад: 5500

*************************************************************

Регистрационный номер: 5

Фамилия: Ромашенко Год и Дата рождения: 12.05.80

Имя: Владимир Домашний адрес: Баныкина

Отчество: Владимирович Телефон: -4124

Пол: м Должность: Мэнеджер

Стаж работы: 5 Оклад: 10000

*************************************************************

Регистрационный номер: 7

Фамилия: Сурьянинова Год и Дата рождения: 12.05.80

Имя: Алёна Домашний адрес: Революционная

Отчество: Александровна Телефон: 16676

Пол: ж Должность: Секретарь

Стаж работы: 10 Оклад: 5000

*************************************************************

список окончен

Страницы: 1, 2