procedure Simple_Merging_Sort (name:string);
var
k, i, j, kol, tmp:longint;
a1, a2:string;
f, f1, f2:text;
begin
kol := 0;
assign(f,name);
assign(f1,'temp1.txt');
assign(f2,'temp2.txt');
{$I-}
reset(f);
{$I+}
if ioresult<>0 then
writeln('')
else
begin
while ( not eof (f) ) do
begin
readln(f,a1);
inc(kol);
end;
close(f);
end;
k := 1;
while ( k < kol ) do
begin
reset(f);
rewrite(f1);
rewrite(f2);
if ( not eof (f) ) then readln(f,a1);
while ( not eof (f) ) do
begin
i := 0;
while ( (i < k) and (not eof (f)) ) do
begin
writeln(f1,a1);
readln(f,a1);
inc(i);
end;
j := 0;
while ( (j < k) and (not eof (f))) do
begin
writeln(f2,a1);
readln(f,a1);
inc(j);
end;
end;
close (f2);
close (f1);
close (f);
rewrite(f);
reset(f1);
reset(f2);
if ( not eof (f1) ) then readln(f1,a1);
if ( not eof (f2) ) then readln(f2,a2);
while ( not eof (f1) and not eof (f2) ) do
begin
i := 0;
j := 0;
while ( (i < k) and (j < k) and (not eof (f1)) and (not eof (f2)) )do
begin
if ( a1 < a2 ) then
begin
writeln(f,a1);
readln(f1,a1);
inc(i) ;
end
else
begin
writeln(f,a2);
readln(f2,a2);
inc(j) ;
end;
end;
while ( (i < k) and (not eof (f1)) ) do
begin
writeln(f,a1);
readln(f1,a1);
inc(i) ;
end;
while ( (j < k) and (not eof (f2)) ) do
begin
writeln(f,a2);
readln(f2,a2);
inc(j) ;
end;
end;
while ( not eof (f1) ) do
begin
writeln(f,a1);
readln(f1,a1);
end;
while ( not eof (f2) ) do
begin
writeln(f,a2);
readln(f2,a2);
end;
close (f2);
close (f1);
close (f);
k :=k*2;
end;
erase(f1);
erase(f2);
end;
Procedura nie łączy poprawnie plików
Po kilku uruchomieniach wydaje mi się że podczas scalania nie kopiuje całego pliku
Jak poprawić tę procedurę