Убрать лишние пробелы между словами

uses crt;
var f:text;
    i:byte;
    nf,s:string;
    c:char;
begin
clrscr;
write('Имя файла для чтения: ');
readln(nf);
nf:=nf+'.dat';
assign(f,nf);
{$I-} reset(f);  {$I+}
if IOResult <> 0 then
 begin
  writeLn('Файл ',nf,' не найден!');
  writeLn('Работа программы завершена. Нажмите ENTER');
  readln;
  exit;
 end;
writeln('Исходный текст файла:');
while not eof(f) do
 begin
  readln(f,s);{просто читаем}
  writeln(s);
 end;
close(f);
write('Нажмите Enter для продолжения:');
readln;
reset(f);
while not eof(f) do
 begin
  readln(f,s);
  while pos('  ',s)>0 do{удаляем лишние пробелы}
  delete(s,pos('  ',s),1);
  for i:=length(s) downto 1 do
  if s[i] in ['.','?','!'] then{если конец предложения}
    begin
     if s[i+1]=' ' then delete(s,i+1,1);{удалим пробел за ним}
     insert(#13+#10,s,i+1);{вставим символы конца строки и перехода на новую строку}
    end;
  writeln(s);
 end;
close(f);
readln
end.

assign(f,nf);
if not fileexists(nf)then
 begin
  writeLn('Файл ',nf,' не найден!');
  writeLn('Работа программы завершена. Нажмите ENTER');
  readln;
  exit;
 end;