Сортировка последовательных файлов слиянием Опции

[Ирина]

Здравствуйте все!!!
Пожалуйста посмотрите и подскажите в чём дело, не работает программа. Нужно использовать сортировку последовательных файлов слиянием. Процедуры вроде бы верны - смотрела по учебному пособию. Но что-то не так, не могу понять, толкусь на одном месте.

Код

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.

[volvo]

Ирина,
а зачем тебе понадобилось вносить данные в текстовый файл, а потом его же открывать как типизированный? Это, извини, не значит, что ты конвертировала данные в нужный формат... Пиши сразу в процедуре Vvod в типизированный... Вот так я когда-то делал (copyrun сделал функцией, чтобы с ней было удобнее работать):

program naturalmerge;
uses CRT;

type
  item =Record
    den:1..31;
    mes:1..12;
    god:0..99;
  end;

  filetype = file of item;

var
  a, b, c: filetype;
  z: integer;
  eor: boolean;

procedure view;
var buf:item;
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: item;
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;

function copyrun(var x, y: filetype): byte;
begin
  repeat
    copy(x, y);
  until eor;
  copyrun := 1;
end;

procedure distribute;
begin
  reset( c );rewrite(a);rewrite(b);
  repeat
    copyrun(c,a);
    if not eof( c ) then copyrun(c,b);
  until eof( c );
  close(a);close(b);close( c );
end;


procedure merge;

  procedure make(var x, y: filetype);
  begin
    copy(x, c);
    if eor then copyrun(y, c);
  end;

var bufa,bufb:item;
begin
  reset(a); reset(b); rewrite( c );
  while (not eof(a)) and (not eof(b)) do begin

    repeat
      read(a, bufa);seek(a, filepos(a)-1);
      read(b, bufb);seek(b, filepos(b)-1);

      if bufa.mes < bufb.mes then make(a, b)
      else make(b, a);
    until eor;
    inc(z);

  end;

  while not eof(a) do
    inc(z, copyrun(a, c));
  while not eof(b) do
    inc(z, copyrun(b, c));
  close(a);close(b);close( c );
end;

procedure Vvod;
var
  r:item;
  n: integer;
  s: string;
begin
  rewrite( c );
  writeln('enter: dd mm yy');
  n := 0;
  repeat
    readln(r.den, r.mes, r.god); n:=n+1;
    write(c, r);
    writeln('finished [y/n] ?');
    readln(s);
  until s='y';
  writeln('you entered ', n, ' records');
  readln;
  close( c );
end;


begin {main}
  assign(a,'a.txt');
  assign(b,'b.txt');
  assign(c,'c.txt');
  vvod;
  repeat
    distribute;
    z:=0;
    merge;
  until z=1;
  writeln;
  view;
end.