Дана строка. Словом текста считается любая последовательность букв русского алфавита; между соседними словами — не менее одного пробела, за последним словом – точка. Найти и сохранить в строке те слова последовательности, которые отличны от последнего слова и являются симметричными. Все остальные слова удалить — Pascal(Паскаль)

program XXX;
type
  tsetchar=set of char;
 
procedure redfrag(var s:string;s1,s2:string);
var k:integer;
begin
  while pos(s1,s)<>0 do
    begin
      k:=pos(s1,s);
      delete(s,k,length(s1));
      insert(s2,s,k)
    end
end;
 
function control(var s:string; const simb:tsetchar):boolean;
var i:integer;
begin
 
  writeln('Введите несколько слов русскими буквами, в конце точка:');
  readln(s);
 
  if pos('.',s)<=1 then
    begin
      control:=false;
      s:='';
      exit
    end;
 
  s:=copy(s,1,pos('.',s)-1)+' ';
 
  redfrag(s,'  ',' ');
 
  for i:=1 to length(s) do
    if not (s[i] in simb) then
       begin
         control:=false;
         s:='';
         exit
       end;
 
  control:=true
end;
 
function kolslov(s:string):integer;
var i,sum:integer;
begin
  sum:=0;
  for i:=1 to length(s)do
    if s[i]=' ' then sum:=sum+1;
  kolslov:=sum
end;
 
function slovo(s:string;k:integer;var wordpos,wordsize:integer):string;
var kol,i:integer;
begin
  kol:=0;
  i:=1;
  wordsize:=0;
  wordpos:=1;
  while(kol<>k)and(i<=length(s)) do
     begin
       if s[i]=' ' then
         begin
           kol:=kol+1;
           if kol<>k then
              begin
                wordsize:=0;
                wordpos:=i+1
              end
          end
       else wordsize:=wordsize+1;
       i:=i+1
     end;
  if kol=k then
       slovo:=copy(s,wordpos,wordsize)
  else
     begin
       slovo:='';
       wordpos:=0;
       wordsize:=0
     end
end;
 
function simmetr(s:string):boolean;
var i:integer;
begin
  simmetr:=true;
  for i:=1 to length(s) div 2 do
    if s[i]<>s[length(s)-i+1] then simmetr:=false
end;
 
//----------------------
 function Words(str: string): string;//boolean тоже пробовал еще хуже выходит
  var
   i: byte;
   last_word,word: string;
  begin
   last_word:='';
   for i:=length(str) downto 0 do
    begin
     while (str[i] <> '.') and (str <> ' ') do
      last_word:=last_word+str[i];
     if str = ' ' then Break;
    end;
   for i:=0 to length(str) do
    begin
     word:='';
     while (str[i] <> '.') and (str <> ' ') do
      begin
       word:=word+str[i];
       Inc(i);
      end;
     if word <> last_word then Words:=words+' '+word;
    end;
  end;
//----------------------
 
procedure udalen(var s:string);
var  k,beg,kol:integer;
begin
  k:=1;
  while k<=kolslov(s) do
       if not simmetr(slovo(s,k,beg,kol))then
          delete(s,beg,kol+1)
       else k:=k+1;
end;
 
var s:string;
 
begin
  if not control(s,['А'..'Я',' '..'а','я']) then
    begin
      writeln('Неправильный ввод!');
      halt
    end;
 
  udalen(s);
 
  writeln('Результат:');
  if length(s)=0 then
    writeln('Нет слов, удовлетворяющих условиям')
  else
    writeln('Строка : ',s);
 
end.