Program fgyr;
 
procedure delPROB (var s:string);{начало процедуры, удаляющей лишний пробел}
var  i:integer;
begin
i:=1;
repeat
if copy(s,i,2)='  ' then delete(s,i,1) else inc(i);
until i>length(s);
end; {конец процедуры, удаляющей лишний пробел}
 
var g,f:text; {переменные двух файлов}
    s:string; {переменная строки}
 
begin
assign (f,'stroki.txt' ); reset (f); {открываем файл для чтения}
assign (g,'stroki2.txt' ); rewrite (g); {открываем файл для записи}
 
while not eof(f) do begin {считываем файл}
readln(f,s); {считываем текущую строку}
delPROB(s);  {удаляем в этой строке лишние пробелы}
if length(s)>0 then writeln(g,s); {записываем результирующую строку в другой файл}
end;
 
writeln('Isxodnyi text perepisan v fail "stroki2.txt"...');
close(f); close(g); {закрываем файлы}
readln;
end.