Ivanov Ivan Ivanych
2 2004 3 3 2005 5 5 
Sidorov Semen Semenych
1 2000 4 4 
Petrov Petr Petrovich
2 1990 12 3 1999 7 27

uses crt;

const
 nowadays = 2013;
 n = 10;

type
 datar = record
          den: 1..31;
          mes: 1..12;
          god: 1900..nowadays;
         end;
 rabotnic = record
             fio: string;
             koldet: 1..10;
             data: array [1..10] of datar;
            end;

var
 ftext: text;
 ftip: file of rabotnic;
 i,pMax: Byte;
 p: boolean;
 c:Char;

procedure Vvod;
var t:rabotnic;
begin
 reset(ftext);
 rewrite(ftip);
 while not eof(ftext) do
  with t do
   begin
    readln(ftext, fio);
    read(ftext,koldet);
    for i:=1 to koldet do
     read(ftext, data[i].god, data[i].mes, data[i].den);
    readln(ftext);
    write(ftip, t);
   end;
 close(ftext);
 close(ftip);
end;

procedure WrInf(t:rabotnic);
begin
 writeln('FIO: '+t.fio);
 writeln('Kolichestvo detey: ',t.koldet);
 write('data: ');
 for i:=1 to t.koldet do
  write(t.data[i].den,'.',t.data[i].mes,'.',t.data[i].god,' ');
 writeln;
end;

procedure SearchFIO;
var
 j:byte;
 x:string;
 b:rabotnic;
begin
 j:= 0;
 Reset(ftip);
 writeln('vvedite familiyu, imya , otchestvo');
 readln(x);
 while not Eof(ftip) do
  begin
   read(ftip,b);
   if (b.fio=x) then
    begin
     WrInf(b);
     Inc(j);
    end;
  end;
 if j=0 then writeln('nichego ne naideno');
 writeln;
end;

procedure DelRec;
var
 j:byte;
 x:string;
 b:rabotnic;
begin
 j:= 0;
 Rewrite(ftext);
 Reset(ftip);
 writeln('vvedite familiyu, imya , otchestvo');
 readln(x);
 while not Eof(ftip) do
  begin
   read(ftip,b);
   with b do
    begin
     if (fio<>x) then
      begin
       Writeln(ftext,fio);
       Write(ftext,koldet,' ');
       for i:=1 to koldet do
        with data[i] do
          write(ftext,god,' ',mes,' ',den,' ');
       writeln(ftext);
      end
      else inc(j);
    end;
  end;
 Close(ftip);
 Close(ftext);
 Vvod;
 if j=0 then writeln('nichego ne naideno');
end;

procedure AddRec;
var
 b:rabotnic;
 x:string;
 Ndet,d,m:byte;
 y:word;
begin
 Append(ftext);
 writeln('vvedite familiyu, imya , otchestvo');
 readln(x);
 Writeln(ftext,x);
 Write('Vvedite kolichestvo detey: ');
 Readln(Ndet);
 Write(ftext,Ndet,' ');
 for i:=1 to Ndet do
  begin
   write('rebenok N',i,' (dd mm yyyy): ');
   readln(d,m,y);
   write(ftext,y,' ',m,' ',d,' ');
  end;
 writeln(ftext);
 Close(ftext);
 writeln;
 Vvod;
end;

procedure SearchNdet;
var
 Ndet,j:byte;
 b:rabotnic;
begin
 j:=0;
 Reset(ftip);
 write('vvedite kolichestvo detey ');
 readln(Ndet);
 while not Eof(ftip) do
  begin
   read(ftip, b);
   if (b.koldet=Ndet) then
    begin
     WrInf(b);
     Inc(j);
    end;
  end;
 if j=0 then writeln('nichego ne naideno');
 writeln;
end;

Procedure MaxPos;
var
 t:rabotnic;
 k:Byte;
 NameMax: string;

begin
 reset(ftip);
 pMax:=0;
 repeat
  read(ftip,t);
  k:=0;
  for i:=1 to t.koldet do
    if (nowadays - t.data[i].god)<18 then inc(k);
  writeln('Rabochiy ', t.fio:40,' ',k, ' posobiy(a)');
  if k>pMax then
   begin
    pMax:=k;
    NameMax:=t.fio;
   end;
 until EoF(ftip);
 Close(ftip);
 writeln('Max kol posobij = ',pMax,' u ', NameMax);
end;

Procedure GlobalInf;
var
 t:rabotnic;
begin
 reset(ftip);
 repeat
  read(ftip,t);
  WrInf(t);
 until EoF(ftip);
 Close(ftip);
 Writeln;
end;

begin
 ClrScr;
 assign(ftext, 'record.txt');
 assign(ftip, 'ftip.rec');
 Vvod;
 MaxPos;
 Repeat
  writeln;
  p:=false;
  writeln('1=poisk zapisi po fio');
  writeln('2=poisk zapisi po kolichestvu detey');
  writeln('3=vivod zapisey');
  writeln('4=udalenie zapisey po FIO');
  writeln('5=dobavlenie novoy zapisi v file');
  writeln('6=EXIT');
  c:=ReadKey;
  writeln;
  case C of
   '1': SearchFIO;
   '2': SearchNdet;
   '3': GlobalInf;
   '4': DelRec;
   '5': AddRec;
   '6': p:=true;
  end;
 Until p;
end.