program PascalGuru;
 
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;
{--------------------------------------------------}
function odinakovo(s:string):boolean; {отпределяет одинаковы ли элементы в строке "s"}
var i:integer;
    rez:boolean;
begin
for i:=1 to length(s) do
if s[i]=' ' then delete(s,i,1); {удвляет все пробелы}
rez:=true;
for i:=2 to length(s) do
if s[i-1]<>s[i] then rez:=false; {смотрит одинаковы ли элементы}
odinakovo:=rez;
end;
{--------------------------------------------------}
 
var str:string;
    g,f:text; {переменные двух файлов}
 
begin
assign (f,'bd.txt' ); reset (f); {открываем файл для чтения}
assign (g,'rezult.txt' ); rewrite (g); {открываем файл для записи}
 
while not eof(f) do begin {считываем файл}
readln(f,str); {считываем текущую строку}
delPROB(str);  {удаляем в этой строке лишние пробелы}
if odinakovo(str) then writeln(g,str);
end;
 
writeln('Odinakovye stroki matricy perepisany v fail "rezult.txt"...');
close(f); close(g); {закрываем файлы}
readln;
end.