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