код string

[Rikoshet]

Ввести текст и определить, сколько слов начинается и заканчивается на одинаковую букву. Собрать эти слова в новое предложение, удалив их из старого текста.

мой код работает не совсем правильно, помогите исправить...

uses crt;
var t1,t2:string;
mn: set of char;
i,kb:integer;
begin clrscr;
mn:=[' ',',','-','.',':',';'];
writeln('Vvedite text');
readln(t1);
t1:=t1+'.';
kb:=0;t2:='';
for i:=1 to length(t1) do 
if not(t1[i] in mn) then inc(kb)
else if kb>0 then
if t1[i-kb]=t1[i-1] then begin
t2:=t2+copy(t1,i-kb,kb)+'';
delete(t1,i-kb,kb);
kb:=0;
end;
writeln(t2);
readkey;
end.

[Rikoshet]

Ребят, тут всего пара строчек, может поможет кто?

[Serge_Bliznykov]

так пойдёт?

uses crt;
var t1, t2: string;
  mn: set of char;
  i, kb: integer;
begin clrscr;
  mn := [' ', ',', '-', '.', ':', ';'];

  writeln('Vvedite text');
{  readln(t1);}
  t1 := 'Baba ALLA lubit gruppu ABBA i zaniumatsa ushu tak kak lubit sport';

  t1 := t1 + '.';
  kb := 0; t2 := '';
  i := 0;
  while i<length(t1) do begin
    inc(i);
    if not (t1[i] in mn) then inc(kb)
    else begin
      if kb > 0 then
        if t1[i - kb] = t1[i - 1] then begin
          t2 := t2 + copy(t1, i - kb, kb) + ' ';
          delete(t1,i-kb,kb);
          dec(i,kb);
        end;
      kb := 0;
    end;
  end;
  writeLn('staray stroka: ',t1);
  writeln('novay stroka: ',t2);
  readkey;
end.

[Rikoshet]

Огромное спасибо! Вы опять меня выручили