Код: Выделить всё
var
F:Text;
Buf:string; {буфер чтения файла}
Pos:integer; {позиция в буфере}
WordBuf:string; {буфер накопления слова}
i:integer;
const
WordChars:set of char=['A'..'Z','a'..'z','А'..'Я','а'..'я'];
Hiphens:set of char=['-'];
SpaceChars:set of char=[' ',#09];
begin
assign(F,'c:\text.txt');
reset(F);
Buf:='';
Pos:=1;
WordBuf:='';
while (not eof(F)) or (Pos<=length(Buf)) do begin
if (Pos>length(Buf)) and (not eof(F)) then begin {если буфер исчерпан, то подчитываем еще}
readln(F,Buf);
{если текст набран с полями, то удаляем пустое пространство в начале и в конце}
while Buf[1] in SpaceChars do delete(Buf,1,1);
while Buf[length(Buf)] in SpaceChars do delete(Buf,length(Buf),1);
{если строка пустая или не заканчивается переносом , то прибавляем к ней терминальный символ}
if (length(Buf)=0) or (not (Buf[length(Buf)] in Hiphens)) then Buf:=Buf+'.';
Pos:=1;
end;
if Pos<=length(Buf) then begin {если в буфере еще/уже что-то есть...}
if Buf[Pos] in WordChars then begin {идет накопление слова}
WordBuf:=WordBuf+UpCase(Buf[Pos]);
end else if not (Buf[Pos] in Hiphens) then begin {слово закончилось (и не было переноса)}
if length(WordBuf)>0 then begin {если что-то накопилось}
{проверяем наличие удвоенной буквы и выводим}
i:=1;
while (i<length(WordBuf)-1) and (WordBuf[i]<>WordBuf[i+1]) do inc(i);
if (i<=length(WordBuf)-1) and (WordBuf[i]=WordBuf[i+1]) then writeln(WordBuf);
{сброс буфера}
WordBuf:='';
end;
end;
inc(Pos);
end;
end;
end.