Автоматизация работы с базами данных

begin

if p <> nil then {уазатель на компоненту}

if x < p^.num then {табельный номер< чем у текущей}

del(x,p^.left) {рекурс. вызов комп. в левом поддереве}

else

if x > p^.num then {табельный номер< чем у текущей}

del(x,p^.right) {рекурс. вызов комп. в правом поддереве}

else

begin {компонента найдена}

print(p); {вывод содержимого компо

ненты}

writeln('Удалить (Y/Д)? ');{запрос на удаление}

d := readkey;

if not (d in ['Y','y','Н','н','L','l','Д','д']) then

begin

writeln('Отмена удаления .');

exit;

end;

q := p; {запоминаем через указатель компоненту}

if q^.right = nil then {если нет правого поддерева}

p := q^.left {исключаем из связи - связь на левое}

else

if q^.left = nil then {если нет левого поддерева}

p := q^.right {исключаем из связи - связь на правое}

else

delt(q^.left); {два поддерева - поиск в левом}

dispose(q); {высвобождение динамической памяти }

writeln('Удален .');

end

else {указатель = nil}

writeln('Введенный табельный номер не найден .');

end;

{Часть инизиализации модуля - содержит команды, которые будут выполняться

до основной программы в программе, к которой подключен модуль}

BEGIN

END.

Основная программа – файл Rab.pas

{Директива $M определяет параметры распределения памяти}

{$M 65520,111000,655360}

{Подключение библиотек:

Crt - стандартная для работы с консолью,

Trees - пользовательский модуль для работы с двоичным деревом поиска.}

Uses crt,trees;

Var

{Описание глобальных переменных}

root : pTree; {указатель на корень дерева}

f,fs : file of CompF; {файловые переменные для типизированного файла}

count : longint; {для хранения количества компонент}

c : char; {для организации диалога}

st : CompF; {для чтения файла, ввода, фактический пар.}

pClear : pointer;{бестиповый указ. для запоминания состояния дин.пам.}

{Процедура добавления работника}

Procedure AddRab;

var

z : integer; {для сохранения расположения курсора}

begin

inc(count); {увеличиваем счетчик на 1}

repeat

clrscr; {очистка экрана}

with st do {оператор присоединения}

begin {ввод данных}

write('Введите ФИО: '); readln(fio);

{$I-} {программный анализ ошибки ввода}

repeat

write('Введите табельный номер: '); readln(num);

until IOResult = 0;

{$I+}

repeat

write('Введите пол: ');

pol := readkey;

writeln(pol);

until pol in ['Ж','ж','М','м'];

write('Введите дату рождения: '); readln(dat);

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

end;

z := WhereY; {организация запроса на подтверждения ввода}

TextColor(Green);

gotoxy(15,25);

write('Занести в базу (Y/Д - да, любая клавиша - нет, ESC - отмена)?');

TextColor(LightGray);

gotoxy(1,z);

c := readkey;

until c in ['Y','y','Н','н','L','l','Д','д',#27];

if c <> #27 then

add(st,root) {вызов процедуры добавления в дерево}

else

dec(count); {отмена добавления - уменьшаем счетчик на 1}

end;

{Процедура удаления работника}

Procedure DelRab;

var

z : word; {для указания табельного номера}

begin

clrscr;

{$I-}

repeat

write('Введите табельный номер: ');

readln(z);

until IOResult = 0;

{$I+}

del(z,root); {вызов процедуры удаления компоненты из дерева}

readkey

end;

{Процедура организации поиска и отбора работников по критерию}

{Метод - обход дерева слева-направо с анализом критерия поиска

и, в случае необходимости, вывод на экран}

procedure SearchRab;

var

tmps : string; {для указания ключа поиска}

tmpc : word; {для указания ключа поиска}

{Локальная рекурсивная процедура обхода дерева слева-направо}

{при проверке критерия используются глобальные по отношению

к процедуре переменные с, tmps и tmpc}

Procedure Search(t : pTree);

begin

if t <> nil then

begin

Search(t^.left); {движение в левое поддерево}

case c of {проверка ключа поиска}

'1' : if pos(tmps,t^.fio) <> 0 then Print(t);

'2' : if pos(tmps,t^.dol) <> 0 then Print(t);

'3' : if tmpc = t^.num then Print(t);

end;

Search(t^.right); {движение в правое поддерево}

end

end;

begin

clrscr;

writeln('Поиск по:'); {выбор критерия поиска}

writeln(' 1. фамилии');

writeln(' 2. должности');

writeln(' 3. табельному номеру');

writeln('Отмена - любая клавиша.');

c := readkey;

write('Введите ключ поиска: ');

{$I-}

case c of

'1','2' : readln(tmps); {ввод ключа поиска}

'3' : readln(tmpc); {ввод ключа поиска}

else

exit

end;

writeln;

if IOResult <> 0 then

writeln('Неверный ввод.')

else

begin

Search(root); {вызов процедуры обхода}

writeln('Поиск окончен .');

end;

{$I+}

readkey

end;

{Рекурсивная процедура вывода всех работников в порядке табельных номеров}

{Метод - обход дерева слева-направо с вызовом процедуры вывода print}

procedure PrintRab(r : pTree);

begin

if r <> nil then

begin

PrintRab(r^.left); {движение в левое поддерево}

Print(r); {вызов процедуры вывода компоненты}

PrintRab(r^.right); {движение в правое поддерево}

end

end;

{Процедура меню - организация простого интерфейса пользователя}

procedure Menu;

begin

repeat

clrscr;

writeln('1. Добавление работника');

writeln('2. Удаление работника ');

writeln('3. Поиск работника по фамилии, табельному номеру, должности');

writeln('4. Вывод работника');

writeln('5. Выход');

gotoxy(44,25);

write('Выберите необходимое действие .');

c := readkey;

case c of

'1' : AddRab;

'2' : DelRab;

'3' : SearchRab;

'4' : begin

clrscr;

if root = nil then

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

else

PrintRab(root);

readkey

end;

'5',#27 : break;

else

begin

gotoxy(44,25);

write('Неверный выбор. Введите от 1 до 5.');

end;

end;

until false;

end;

{Процедура загрузки данных из файла при запуске программы}

Procedure LoadOfFile;

begin

assign(f,'Rab.dat'); {связь файловой переменной с физическим файлом}

{$I-} {отключение реакции на ошибки ввода-вывода}

reset(f); {открытия файла на чтение/запись}

if IOresult <> 0 then {ошибка открытия}

begin

writeln('Файл с данными не найден.',#13#10,

'Файл Rab.dat будет создан .',#13#10);

rewrite(f); {открытие файла на запись и создание его}

end

else {файл открыт}

while not eof(f) do {пока не конец файла}

begin

count := filepos(f); {запоминаем номер текущей компоненты файла}

read(f,st); {считываем компоненту}

Writeln('Считан из файла - ',count,'. ',st.fio);

add(st,root); {вызов процедура добавления в дерево}

 Скачать реферат