Pascal. Текстовая задачка

[kempers]

Вобщем такая ситуация:

Создать текст. Вывести на печать все слова, у которых есть двойные буквы (класс, группа и т.д.).

[Naeel Maqsudov]

Откуда берется текст? Из файла или с клавиатуры? Если с клавиатуры, то он однострочный или многострочный (массив строк)? Если текст (в массиве или файле, неважно) многострочный, то переносв на другую строку надо учесть? (Слово может быть перенесено как раз на удвоенной согласной, следовательно будет шанс его проскочить.)

[Хыиуду]

Разбиение строки на слова есть в разделе "алгоритмы". Далее, если s - слово
for i:=1 to length(s)-1 do
if s=s[i+1] then begin writeln(s); break; end;

[kempers]

Текст берется из файла

[Naeel Maqsudov]

Это для Turbo Pascal 7.
Нет ограничений на длину файла.
Ограничение на длину строки - 256. (Снимается при компиляции в Object Pascal)
Учитывает поля в тексте
Учитывает переносы слов
Безразличен к регистру букв

Код: Выделить всё

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.

[kempers]

Спасибо =)