Stuff

program failai;
 var e,f,f2:string;
     b,m:text;


procedure failas;
 var x,s,c,a,k,i,j,v,d:integer;

begin
   k:=0;
   a:=length(e);
   for i:=1 to a do
   begin
     if (e[i]<> ' ') then
     begin
       k:=k+1;
     end;
     if e[i]=' ' then
     begin
       d:=k;
       k:=0;
       if (d in [2..9])  then
       begin
         j:=i-d;
         v:=i-1;
         for c:=j to v do
         write(m,e[c]);
         write(m,' ');
       end;
     end;
      if (i=a) and (e[i]<>' ') then
      begin
        write('i=a', 'i',i);
        if (k in [2..9]  ) then
        begin
          c:=a-k+1;
          for j:=c to a do
          begin
            write(m,e[j]);
            k:=0;
          end;
          write(m,' ');
         end;
       end;
   end;
end;

begin
  Writeln('Iveskite pirma faila');
  readln(f);
  assign(b,f);
  {$I-}
  reset(b);
  {$I+}

  if IOResult<>0 then begin
  writeln('Klaida,negalima atverti ', f);
  halt;
  end;


  Writeln('Iveskite antra faila');
  readln(f2);
  assign(m,f2);
  {$I-}
  rewrite(m);
  {$I+}

  if IOResult<>0 then begin
  writeln('Klaida,negalima sukurti rezultato failo ',f2);
  halt;
  end;

   while not Eof(b) do
   begin
     readln(b,e);
     failas;
   end;

  close(b);
  close(m);
end.