Пожалуйста посмотрите и подскажите в чём дело, не работает программа. Нужно использовать сортировку последовательных файлов слиянием. Процедуры вроде бы верны - смотрела по учебному пособию. Но что-то не так, не могу понять, толкусь на одном месте.
Код
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.
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.