Текстовые файлы, нужно вывести ответ в сам блокнот...

var f:text;
    s,s1:string;
    i,c,k,ks,kch:integer;
    r:longint;
begin
assign(f,'file1.txt');
write('Имя файла для чтения: ');
readln(s);
s:=s+'.txt';
assign(f,s);
reset(f);
ks:=0;kch:=0;
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
    ks:=ks+1;{считаем все слова}
    k:=i;s1:='';
    while (s[k]<>' ')and(k<=length(s))do {пока не пробел и не конец строки}
     begin
      s1:=s1+s[k];{составляем слово}
      k:=k+1;{идем вперед}
     end;
    val(s1,r,c);{пробуем преобразовать в число}
    if c=0 then kch:=kch+1;{если код ошибки=0, значит число, считаем}
    i:=i+length(s1);{перепрыгиваем через число}
   end
  else i:=i+1;{иначе идем дальше}
 end;
write('Общее количество слов=',ks,'  в т.ч. чисел=',kch);
close(f);
readln;
end.

uses crt;
var f:text;
    name,s,s1:string;
    i,c,k,ks,kch:integer;
    r:longint;
begin
clrscr;
assign(f,'file1.txt');
write('Имя файла для чтения: ');
readln(name);
name:=name+'.txt';
assign(f,name);
reset(f);
ks:=0;kch:=0;
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
    ks:=ks+1;{считаем все слова}
    k:=i;s1:='';
    while (s[k]<>' ')and(k<=length(s))do {пока не пробел и не конец строки}
     begin
      s1:=s1+s[k];{составляем слово}
      k:=k+1;{идем вперед}
     end;
    val(s1,r,c);{пробуем преобразовать в число}
    if c=0 then kch:=kch+1;{если код ошибки=0, значит число, считаем}
    i:=i+length(s1);{перепрыгиваем через число}
   end
  else i:=i+1;{иначе идем дальше}
 end;
writeln('Общее количество слов=',ks,'  в т.ч. чисел=',kch);
append(f);
writeln(f,'');
write(f,'Obshee kolichestvo slov=',ks,'  v t.ch. chisel=',kch);
close(f);
write('Результат дописан в файл ',name);
readln;
end.