Разработка базы данных работников с использование записей типизированного файла — Pascal(Паскаль)

uses crt;
type
rabotnik=record{тип запись работники}
         f_i_o:string[20];{фио}
         k_prd:integer;{кол. Продукции за месяц}
         vd_pr:string;{вид продукции}
         st_ed:integer;{стоимость единицы}
         zarpl:longint;{зарплата за месяц}
         end;
t_file=file of rabotnik;{типизированный файл записей}
const fname='rabotnik.dat';{постоянное имя файла}
procedure NewFile(var f:t_file);{процедура создания нового файла}
var n,i:integer;
    rab:rabotnik;
begin
rewrite(f);
write('Сколько записей ввести в файл? n=');
readln(n);
writeln('Введите данные о работниках:');
for i:=1 to n do
with rab do
 begin
  writeln('Работник ',i);
  write(' Фамилия И.О.: ');readln(f_i_o);
  write(' Количество продукции за месяц: ');readln(k_prd);
  write(' Вид продукции: ');readln(vd_pr);
  write(' Стоимость единицы продукции: ');readln(st_ed);
  zarpl:=k_prd*st_ed;{считаем зарплату}
  write(f,rab);{заносим запись в файл}
 end;
close(f);
write('Press Enter...');
readln
end;
procedure AddZap(var f:t_file);{добавление одной записи}
var rab:rabotnik;
    i,k:byte;
begin
{$I-}reset(f);{$I+}{пробуем открыть для чтения}
if IOResult<>0 then rewrite(f);{если нет, открываем для записи}
writeln('Введите данные о работнике:');
with rab do
 begin
  write(' Фамилия И.О.: ');readln(f_i_o);
  write(' Количество продукции за месяц: ');readln(k_prd);
  write(' Вид продукции: ');readln(vd_pr);
  write(' Стоимость единицы продукции: ');readln(st_ed);
  zarpl:=k_prd*st_ed;
 end;
seek(f,filesize(f));{встаем в конец файла}
write(f,rab);{добавляем запись}
close(f);
write('Press Enter...');
readln
end;
 
procedure ResFile(var f:t_file);{вспомогательная процедура для открытия файла на чтение}
begin
{$I-}reset(f);{$I+}
if IOResult<>0 then
 begin
  writeln('Файл еще не создан!');
  write('Press Enter...');
  readln;
  exit;
 end;
end;
procedure RedZap(var f:t_file);{процедура редактирования записи}
var n,i:integer;
    c:char;
    rab:rabotnik;
begin
write('Редактировать запись № ');
readln(n);
ResFile(f);
if (filesize(f)<n)or(n<0) then{если отрицательный, или больше чем записей в файле}
 begin
  writeln('В файле нет такой записи');
  close(f);
  write('Press Enter...');
  readln;
  exit;
 end;
writeln('Введите новые данные:');
with rab do
 begin
  write(' Фамилия И.О.: ');readln(f_i_o);
  write(' Количество продукции за месяц: ');readln(k_prd);
  write(' Вид продукции: ');readln(vd_pr);
  write(' Стоимость единицы продукции: ');readln(st_ed);
  zarpl:=k_prd*st_ed;
 end;
seek(f,n-1);{встаем в запись(на 1 меньше, отсчет с ноля)}
write(f,rab);{записываем новые данные}
close(f);
write('Press Enter...');
readln
end;
procedure DelZap(var f:t_file);{удаление записи}
var n,i:integer;
    rab:rabotnik;
begin
write('Удалить запись № ');
readln(n);
ResFile(f);
if (filesize(f)<n)or(n<0) then
 begin
  writeln('В файле нет такой записи');
  close(f);
  write('Press Enter...');
  readln;
  exit;
 end;
seek(f,n-1);{встаем на запись}
for i:=n-1 to filesize(f)-2 do{сдвигаем хвост файла на один к верху, запись исчезает}
 begin
  seek(f,i+1);
  read(f,rab);
  seek(f,i);
  write(f,rab);
 end;
seek(f,filesize(f)-1);{встаем за последней записью}
truncate(f);{обрезаем файл}
close(f);
write('Press Enter...');
readln
end;
 
procedure Tablica;{вспомогательная процедура для рисования заголовка таблиц}
begin
writeln;
writeln('----------------------------------------------------------------------');
writeln('| Фамилия И.О. | Выпуск, мес | Вид продукции | Стоим. едн.| Зарплата |');
writeln('----------------------------------------------------------------------');
end;
 
procedure PoiskFam(var f:t_file);{поиск по фамилии}
var fm:string[20];
    rab:rabotnik;
    k:byte;
begin
clrscr;
ResFile(f);
k:=0;
writeln('Введите ФИО для поиска');
readln(fm);
Tablica;
while not eof(f) do
 begin
  read(f,rab);
  if rab.f_i_o=fm then{если нашли фамилию}
  with rab do
   begin
    k:=1;{фиксируем}
    gotoXY(1,whereY);write('| ',f_i_o);{выводим}
    gotoXY(16,whereY); write('|',k_prd:6);
    gotoXY(30,whereY); write('| ',vd_pr);
    gotoXY(46,whereY); write('|',st_ed:6);
    gotoXY(59,whereY); write('|',zarpl:6);
    gotoXY(70,whereY); writeln('|');
   end;
 end;
writeln('----------------------------------------------------------------------');
if k=0 then writeln('Работника с такой фамилией нет!');
write('Press Enter...');
readln
end;
 
procedure PoiskProd(var f:t_file);{поиск по виду продукции, точно также}
var pr:string;
    rab:rabotnik;
    k:byte;
begin
clrscr;
ResFile(f);
k:=0;
writeln('Введите вид продукции для поиска');
readln(pr);
Tablica;
while not eof(f) do
 begin
  read(f,rab);
  if rab.vd_pr=pr then
  with rab do
   begin
    k:=1;
    gotoXY(1,whereY);write('| ',f_i_o);
    gotoXY(16,whereY); write('|',k_prd:6);
    gotoXY(30,whereY); write('| ',vd_pr);
    gotoXY(46,whereY); write('|',st_ed:6);
    gotoXY(59,whereY); write('|',zarpl:6);
    gotoXY(70,whereY); writeln('|');
   end;
 end;
writeln('----------------------------------------------------------------------');
if k=0 then writeln('Такой продукции нет!');
write('Press Enter...');
readln
end;
 
procedure ReadFile(var f:t_file);{чтение файла}
var rab:rabotnik;
begin
clrscr;
ResFile(f);
writeln('Содержание файла:':40);
Tablica;
while not eof(f) do
 begin
  read(f,rab);
  with rab do
   begin
    gotoXY(1,whereY);write('| ',f_i_o);
    gotoXY(16,whereY); write('|',k_prd:6);
    gotoXY(30,whereY); write('| ',vd_pr);
    gotoXY(46,whereY); write('|',st_ed:6);
    gotoXY(59,whereY); write('|',zarpl:6);
    gotoXY(70,whereY); writeln('|');
   end;
 end;
writeln('----------------------------------------------------------------------');
write('Press Enter...');
readln
end;
 
var z:rabotnik;
    f:t_file;
    n:integer;
    w:char;
begin
clrscr;
assign(f,fname);{связываем переменную с файлом на диске}
repeat
clrscr;
writeln('Выберите действие:');{меню программы}
writeln('1-cоздать новый файл');
writeln('2-добавить запись');
writeln('3-редактировать запись');
writeln('4-удалить запись');
writeln('5-прочитать файл');
writeln('6-поиск по фамилии');
writeln('7-поиск по виду продукции');
writeln('другое-выход');
readln(w);
case w of
'1':NewFile(f);
'2':AddZap(f);
'3':RedZap(f);
'4':DelZap(f);
'5':ReadFile(f);
'6':PoiskFam(f);
'7':PoiskProd(f);
else exit;
end;
until not(w in ['1'..'7']);
end.