Разбить строку на слова

uses crt;
Const
 gl=['a','e','i','o','u','y'];                                                               
 sogl=['b','c','d','f','g','h','j','k','l','m','n','p','q','r','s','t','v','w','x','z'];     
 Var
   i,k: integer;
   s,s1,razd1,razd,slovo : string;
begin
  k:=0;
  razd1:= ',';                                                                    
  razd:=' ';                                                                       
  slovo:='';
  writeln('vvedite predlojenie');
  readln(s);
  for i:=length(s) downto 1 do                                                     
  begin
    if k<=0 then
    begin
      if (s[i]=razd) or (s[i]=razd1) then
      begin
        s1:=copy(s,i+1,length(s)-i-1);
        delete(s,i+1,length(s)-i);
        k:=k+1;
      end;
     end;
  end;
  for i:=1 to length(s) do
    begin
    if (pos(s[i],razd1)=0) or (pos(s[i],razd)=0) then                           
    slovo:=slovo+s[i]
    else
    begin
      if (slovo<>s1) and (slovo[1] in gl) and (slovo[length(slovo)] in sogl) then  
      begin
        write(slovo,' ');                                                              
        slovo:='';
      end
      else
      slovo:='';
    end;
  end;
end.

if (pos(s[i],razd1)=0) or (pos(s[i],razd)=0) then

program Project1;
 
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  //Множество гласных букв.
  Da = [
    //Русские гласные буквы.
    'А', 'Я', 'О', 'Ё', 'Ы', 'И', 'Э', 'Е', 'У', 'Ю',
    'а', 'я', 'о', 'ё', 'ы', 'и', 'э', 'е', 'у', 'ю',
    //Гласные буквы латиницы.
    'A', 'E', 'I', 'O', 'U', 'Y',
    'a', 'e', 'i', 'o', 'u', 'y'
  ];
  //Множество согласных букв.
  Db = [
    //Русские согласные буквы.
    'Б', 'В', 'Г', 'Д', 'Й', 'Ж', 'З', 'К', 'Л', 'М', 'Н', 'П',
    'Р', 'С', 'Т', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ',
    'б', 'в', 'г', 'д', 'й', 'ж', 'з', 'к', 'л', 'м', 'н', 'п',
    'р', 'с', 'т', 'ф', 'х', 'ц', 'ч', 'ш', 'щ',
    //Согласные буквы латиницы.
    'B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'L', 'M', 'N', 'P',
    'Q', 'R', 'S', 'T', 'V', 'W', 'X', 'Z',
    'b', 'c', 'd', 'f', 'g', 'h', 'j', 'k', 'l', 'm', 'n', 'p',
    'q', 'r', 's', 't', 'v', 'w', 'x', 'z'
  ];
var
  S, Sw, Slw : String;
  i, Len, LenW, Cnt : Integer;
begin
  repeat
    Writeln('Задайте строку:');
    Readln(S);
 
    Len := Length(S);
    Slw := ''; //Последнее слово в строке.
    LenW := 0; //Длина очередного слова.
    Cnt := 0; //Счётчик искомых слов.
    //Перебор символов строки справа-налево.
    for i := Len downto 1 do begin
      //Если символ не является разделителем.
      if not (S[i] in D) then begin
        //Учитываем очередную букву в длине слова.
        Inc(LenW);
        //Отслеживаем начало слова.
        if (i = 1) or (S[i - 1] in D) then begin
          //Выделяем очередное слово.
          Sw := Copy(S, i, LenW);
          //Запоминаем последнее слово в тексте.
          if Slw = '' then Slw := Sw;
          //Если слово начинается на гласную, а заканчивается на согласную
          //и это слово отличается от последнего в тексте, то распечатываем его.
          if (S[i] in Da) and (S[i + LenW - 1] in Db) and (Sw <> Slw) then begin
            Inc(Cnt);
            if Cnt > 1 then Write(', ');
            Write(Sw);
          end;
          LenW := 0; //Сброс длины слова.
        end;
      end;
    end;
    Writeln;
    Writeln('Всего искомых слов: ', Cnt);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

Const
  gl=['a','e','i','o','u','y'];
  sep=[' ',',','.','!','?',':',';',];
 
function findword(var arg:string):string;
var
  i:integer;
  s:string;
begin
  s:='';
  i:=length(arg);
  while arg[i] in sep do
    dec(i);
  while not (arg[i] in sep) do begin
    s:=arg[i]+s;
    dec(i);
  end;
  findword:=s;
end;
 
Var
   i,k:integer;
   s,st,word:string;
begin
  writeln('введите предложение');
  readln(s);
  if s[length(s)]<>'.' then
    s:=s+'.';
  st:='';
  word:=findword(s);
  k:=0;
  for i:=1 to length(s) do
    if not (s[i] in sep) then
      st:=st+s[i]
    else begin
      if length(st)>0 then begin
        if (st<>word) and (st[1] in gl)
        and (not (st[length(st)] in gl)) then begin
          writeln(st);
          inc(k);
        end;
      end;
      st:='';
    end;
    if k=0 then writeln('условие задания не выполняется');
  readln
end.