Строки!Помогите. пожалуйста Опции

[Дымка]

Дана строка, содержащая текст на русском языке. В предложениях некоторые из слов записаны подряд несколько раз (предложение заканчивается точкой или восклицательным знаком). Получить в новой строке отредактированный текст, в котором удалены подряд идущие вхождения слов в предложениях.
Не понимаю, как ее сделать!!Помогите, пожалуйста!!

[Дымка]

Че-то я совсем запуталась...

Код

Program Stroki;
uses crt;
Function StrUpper(s: String): String;
Var i: Byte;
 Begin
   For i := 1 To Ord(s[0]) Do
     Case s[i] Of
       'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
       #160 .. #175: s[i] := Chr(Ord(s[i])-$20);
       #224 .. #239: s[i] := Chr(Ord(s[i])-$50)
     End;
   StrUpper := s
 End;
Function StrLower(s: String):String;
 Var i: Byte;
 Begin
   For i := 1 To Ord(s[0]) Do
     Case s[i] Of
       'A' .. 'Z': s[i] := Chr(Ord(s[i])+$20);
       #128 .. #143: s[i] := Chr(Ord(s[i])+$20);
       #144 .. #159: s[i] := Chr(Ord(s[i])+$50)
     End;
   StrLower := s
 End;

const
  stUpper  = ['A' .. 'Z', #128 .. #159];
  abc = ['a'..'z','A'..'Z','1'..'9'];
var
  s_res, prev, word: string;
  p: integer;
  S: string;
  stnew: string;
  blank: boolean;
  i: integer;
begin
  clrscr;
  Write('Vvedite stroku,kotoraya zakan4ivaetsya');
  Writeln(' na vosklicatelniy znak ili to4ku');
  Readln(s);
  s_res :=StrUpper(s);
  prev := '';
  p := 1;
  repeat
     while not (s_res[p] in abc) and (p <= length(s_res)) do
        P:=p+1;
     while (s_res[p] in abc) and (p <= length(s_res)) do
     begin
        word := word + s_res[p];
        P:=p+1;
     end;
     if word = prev then
     begin
        delete(s_res, p - length(word), length(word));
        dec(p, length(word));
     end
     else
        prev := word;
     word := '';
  until p > length(s_res);
  blank:= false;
  stnew:= ' ';
  for i:= 1 to length(s_res) do
  begin
     if s_res[i] <>' ' then
     begin
        stnew:= stnew + s_res[i];
        blank:= false;
     end
     else if (not blank) then
     begin
         stnew:= stnew +s_res[i];
         blank:=true;
     end;
  end;
  while stnew[1]=' ' do
     stnew:=copy(stnew,2,255);
  while stnew[length(stnew)]=' ' do
     delete(stnew,length(stnew),1);
     s_res:=StrLower(stnew);
  writeln (s_res);

end.