Program L10_9;
{sortirovka}
uses
crt;
var
g:text;
s:string;
Procedure Sort(name: string; var f: text);
Var
s1,s2,a1,a2,where,tmp: integer;
f1,f2: text;
Begin
s1:=5;
s2:=5;
Assign(f,name);
Assign(f1,'{as} ');
Assign(f2,'{sasd} ');
While (s1>1) and (s2>=1) do
begin
where:=1;
s1:=0;
s2:=0;
Reset(f);
Rewrite(f1);
Rewrite(f2);
Read(f,a1);
Write(f1,a1,' ');
While not EOF(f) do
begin
read(f,a2);
If (a2<a1) then
begin
Case where of
1: begin
where:=2;
inc(s1);
End;
2: begin
where:=1;
inc(s2);
End;
End;
End;
Case where of
1: write(f1,a2,' ');
2: write(f2,a2,' ');
End;
a1:=a2;
End;
If where=2 then
inc(s2)
else
inc(s1);
Close(f);
Close(f1);
Close(f2);
Rewrite(f);
Reset(f1);
Reset(f2);
Read(f1,a1);
Read(f2,a2);
While (not EOF(f1)) and (not EOF(f2)) do
begin
If (a1<=a2) then
begin
Write(f,a1,' ');
Read(f1,a1);
End
else
begin
Write(f,a2,' ');
Read(f2,a2);
End;
End;
While not EOF(f1) do
begin
tmp:=a1;
Read(f1,a1);
If not EOF(f1) then
Write(f,tmp,' ')
else
Write(f,tmp);
End;
While not EOF(f2) do
begin
tmp:=a2;
Read(f2,a2);
If not EOF(f2) then
Write(f,tmp,' ')
else
Write(f,tmp);
End;
Close(f);
Close(f1);
Close(f2);
End;
Erase(f1);
Erase(f2);
End;
begin
clrscr;
write('name file: ');
readln(s);
s:=s+'.txt';
Sort(s,g);
write('fail otsortirovan');
readkey
end.