Program FileCopy;
var
   FFrom,FTo: Text;
   NameFrom,NameTo: string;
   d:string[60];
   IsError:boolean;
   i,j:integer;
Procedure Pechat(i,j:integer);
begin
Reset(FTo);
Rewrite(FFrom);
writeln(FFrom,'------------------------- Page',j,' ------------------------------');
while not SeekEof(FTo) do
   begin
      Read(FTo,d);
      i:=i+1;
      if i=70 then
         begin
         j:=j+1;
         i:=0;
         writeln(FFrom,'------------------------- Page',j,' ------------------------------');
         end;
      Writeln(FFrom,d);
   end;
end;
begin
   j:=1;
   IsError:=True;
   while IsError do
   begin
      Writeln('Specify a name of a file which is necessary for copying:');
      Readln(NameFrom);
      Assign(FFrom, NameFrom);
      {$I-}
      Reset(FFrom);
      {$I+}
      IsError:=IOResult>0;
      if IsError then writeln('File not found!!!');
   end;
   Writeln('Specify a name of a file of appointment:');
   Readln(NameTo);
   Assign(FTo, NameTo);
   Rewrite(FTo);
   while not SeekEof(FFrom) do
   begin
      Read(FFrom,d);
      Write(FTo,d);
   end;
   Pechat(i,j);
   Close(FTo);
   Close(FFrom);
end.

Procedure Pechat;
var i,j,k,l,h,lb,bs,bw:integer;
begin
i:= 0; j:= 1; k:= 0; buf:= ''; h:= 0;
Reset(FTo);
Rewrite(FFrom);
writeln(FFrom,'------------------------- Page',j,' ------------------------------');
while not SeekEof(FTo) do
   begin

      Read (FTo,d);
	  h:=0; 
	  d:= buf+d;
	  l:= length (d);
	  buf:= '';
	  while (h<l) do
	  begin
	   bs:= h;
	   while (h<l) and (d[h]=' ') do inc (h);
	   if (h-bs>=5) then
	   begin 
		if (buf<>'') then writeln(FFrom, buf);
	    writeln(FFrom); 
		buf:='';
	   end;
	   while (h<l) and (d[h]<>' ') do inc (h);
	   if (h-bs+length(buf)<=60) then buf:= buf+copy (d, bs, h-bs)
	   else begin
	    buf:= buf+copy (d, bs, 59-(h-bs+length(buf)))+'-';
		writeln (FFrom, buf);
		buf:= '';
        i:=i+1;
        if i=50 then
          begin
           j:=j+1;
           i:=0;
           writeln(FFrom,'------------------------- Page',j,' ------------------------------');
          end;
	   end;
	 end;
 end;
 if (buf<>'') then writeln (FFrom, buf);
Close(FTo);
Close(FFrom);
end;

uses crt;
Var f1,f2:text; s,s1:string; fname1,fname2:string; IsError:boolean; k,j:integer;
Begin

clrscr;
IsError:=True;
while IsError do
begin
Writeln('Specify a name of a file which is necessary for copying:');
readln(fname1); 
assign(f1,fname1);
{$I-}
reset(f1);
{I+}
IsError:=IOResult>0;
if IsError then writeln('File not found!!!');
end;
Writeln('Specify a name of a file of appointment:');
readln(fname2);
assign(f2,fname2);
rewrite(f2);
writeln(fname2,'------------------------- Page',j,' ------------------------------');
s1:=''; 
repeat
readln(f1,s);
s:=s1+s;
if length(s)>60 then
begin
s1:=copy(s,61,length(s)-60);
delete(s,61,length(s)-60);
end;
k:=k+1;
if k=45 then begin j:=j+1; writeln(fname2,'------------------------- Page',j,' ------------------------------'); k:=0; end;
writeln(s); writeln(f2,s);
until eof(f1);
if length(s1)>0 then 
begin
writeln(s1); writeln(f2,s1);
end;
close(f1); close(f2);
end.