работа с несколькими текстовыми файлами

uses crt;
var f,g,h:text;
    i,j,k:byte;
    nf,ng,nh,s,s1:string;
begin
clrscr;
write('Имя файла для чтения: ');
readln(nf);
nf:=nf+'.txt';
assign(f,nf);
{$I-} reset(f);  {$I+}
if IOResult <> 0 then
 begin
  writeLn('Не могу открыть файл ',nf);
  writeLn('Работа программы завершена. Нажмите ENTER');
  readln;
  exit;
 end;
write('Имя файла для записи нечетных слов: ');
readln(ng);
ng:=ng+'.txt';
assign(g,ng);
rewrite(g);
write('Имя файла для записи четных слов: ');
readln(nh);
nh:=nh+'.txt';
assign(h,nh);
rewrite(h);
k:=0;
while not eof(f) do
 begin
  readln(f,s);
  s:=s+' ';{добавим пробел}
  i:=1;
  while i<=length(s) do
  if s[i]<>' 'then{если не пробел}
   begin
    k:=k+1;{считаем слово}
    s1:='';{составим его}
    j:=i;{с этой позиции}
    while (s[j]<>' ')and(j<=length(s)) do{пока не пробел и не конец строки}
     begin
      s1:=s1+s[j];{слово}
      j:=j+1;
     end;
    if odd(k) then write(g,s1,' '){если нечетное}
    else write(h,s1,' ');{четное}
    i:=i+length(s1){перепрыгиваем через него}
   end
  else i:=i+1;{пробелы попускаем}
 end;
close(f);
close(g);
close(h);
writeln('Нечетные слова из файла ',nf,' переписаны в файл ',ng,' четные в ',nh);
readln
end.