Версия для печати темы

program Lab3;
uses CRT;
type
    date=Record
        den:1..31;
        mes:1..12;
        god:00..99
    end;
    filetype=file of date;        {файловый тип, который работает с данными типа date}
    var
   F, F1, F2: text;
   a, b, c, d: filetype;
   s, d1, d2: char;
   n, k, l: integer;
   r,buf:date;
   eor:boolean;

{_____________процедура      ___________}
procedure view;
   var buf:date;
    begin
      reset(c);
        repeat
            read(c, buf);
            writeln(buf.den,' ',buf.mes,' ',buf.god);
        until eof(c);
   readkey;
         end;
{________________процедура ____________}

procedure copy(var x,y:filetype);
     var buf,buf1:date;
       begin
          read(x,buf);
          write(y,buf);
       if eof(x) then eor:=true
       else begin
          read(x,buf1);
          seek(x,filepos(x)-1);
          eor:=buf1.mes<buf.mes
       end;
     end;
{______процедура переписи одной серии из x в y _______________}
   procedure copyrun(var x,y: filetype);
     begin
       repeat copy(x,y)
       until eor
     end;
{_________из файла с в файлы а и b _________}
procedure distribute;
  begin
    reset(c);
    rewrite(a);
    rewrite(b);
    rewrite(d);
      repeat
        copyrun(c, a);
          if not eof(c)
        then copyrun(c, b);
      until eof(c);
    close(a);
    close(b);
    close(c);
  end;
{______из файла a и b в файл d______________________}
procedure Mergerun;
     var bufa, bufb: date;
     begin
     repeat
       read(a,bufa); seek(a,filepos(a)-1);
       read(b,bufb); seek(b,filepos(b)-1);
            if bufa.mes<bufb.mes
                then
                  begin copy (a,d);
            if eor
                  then copyrun(b,d);
            end
         else
           begin copy(b,d);
             if eor
               then copyrun(a,d);
           end;
     until eor
   end;
{___________запись из файлов a и b в файл d  _____________}
procedure merge;
    begin
      reset(a);
      reset(b);
      rewrite(d);
      while (not eof(a)) and (not eof(b)) do
         begin
           mergerun; l:=l+1;
         end;
      while not eof(a) do
         begin
           copyrun(a,d); l:=l+1;
         end;
      while not eof(b) do
         begin
           copyrun(b,d); l:=l+1;
         end;
      close(a);
      close(b);
      close(d);
    end;

{______________процедура вода последовательности_________________}
  procedure Vvod;
  var
     r:date;
  begin
  assign(F,'c:\f.txt');
  rewrite(F);
                                 {откроем файл для записи}
  writeln('Введите дату рождения в формате дд мм гг.');
  repeat
     readln(r.den,r.mes,r.god);n:=n+1;                  {введём с клавиатуры в оперативную память данные}
     writeln(F,r.den,' ',r.mes,' ',r.god);       {записываем данные в файл F}
     writeln('Вы закончили ввод данных? y/n');
     readln(s);
    until s='y';
     writeln('Вы сделали ',n, 'запись');
     readln;
     close(F);
   end;

{_______основная программа______________________________}
   begin
  ClrScr;
  n:=0;
        Vvod;
    assign(C,'c:\f.txt');
    assign(a,'c:\a.txt');
    assign(b,'c:\b.txt');
    assign(d,'c:\d.txt');
       repeat
          distribute; l:=0;
          merge;
       until l=1;
        writeln;
        view;
      end.