Дан текстовый файл. Удалить из него все лишние пробелы

var f,g:text;
     s:string;
     i:byte;
begin
assign(f,'input.txt');
reset(f);
assign(g,'output.txt');
rewrite(g);
while not eof(f) do
 begin
  readln(f,s);
  while pos('  ',s)>0 do delete(s,pos('  ',s),1);{в апострофах по 2 пробела}
  writeln(g,s);
 end;
close(f);
close(g);
end.

close(f);
close(g);
write('Файл переписан в output.txt');
readln
end.

var
f1,f2:text;
s:string;
i:byte;
w:integer;
 
Procedure sozd;
begin
Assign(F1,'c:\pervi.txt');
Rewrite(F1);
WriteLn('Введите текст: ');
readln(s);
WriteLn(F1,s);
Close(F1);
Writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
end;
 
Procedure perezapis;
begin
assign(f1,'c:\pervi.txt');
reset(f1);
assign(f2,'c:\vtoroi.txt');
rewrite(f2);
while not eof(f1) do begin
readln(f1,s);
while pos('  ',s)>0 do delete(s,pos('  ',s),1);
writeln(f2,s);
writeln('Удаление выполнено!');
Writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
end;
close(f1);
close(f2);
end;
 
Procedure vtoroi;
begin
Assign(F2,'c:\vtoroi.txt');
Reset(F2);
read(f2,s);
writeln(s);
close(F2);end;
 
begin
writeln('Меню');
Writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
while w<>4 do begin
writeln('1- Создание текстового файла,и его заполнение');
writeln('2- Удаление лишних пробелов');
writeln('3- Открытие второго файла');
writeln('4- Выход из программы');
Readln(w);
case w of
1:sozd;
2:perezapis;
3:vtoroi;
end;
end;
end.