Здравствуйте, SHERRY! Могу предложить такой способ решения. Надеюсь я Вам помог.


Приложение:
Program z1; uses crt; const a=[‘ ‘,‘,‘,‘!‘,‘?‘,‘.‘]; var s,s1,polin:string; i,j:integer; k:byte; q:boolean; procedure reWriteString (s1:string; var polin:string); var l:integer; begin polin:=‘‘; for l:=ord(s1[0]) downto 1 do polin:=polin+s1[l]; end; function poisk (s:string):byte; begin k:=0; i:=0; j:=1; q:=false; repeat inc(i); if (s[i] in a) then j:=i+1 else begin repeat inc(i); if s[i] in a then q:=false else q:=true; until (q=false) or (i=ord(s[0])+1); s1:=copy(s,j,i-j); dec(i); reWriteString(s1,polin); Writeln(polin); if s1 = polin then inc(k); end; until i=ord(s[0]); poisk:=k;end;beginWrite(‘Введите строку: ‘);Readln(s); Writeln(‘Число полиндромов= ‘,poisk(s)); readlnend.

Здравствуйте, SHERRY!

Смотрите приложение. Проверяются все варианты методом перебора.
Вопрос можно сформулировать следующим образом: Дана последовательность символов, найти последовательность-полиндром максимальной длины, соблюдая очередность символов в последовательности.
Думаю переделать программу в функцию, для Вас не проблема.
Удачи!

Приложение:
var a:string; b,c:array[0..255]of integer; d,e,f:integer; z:boolean; begin write(‘Enter:‘); readln(a); {сбрасываем массивы и максимум} for d:=0 to 255 do b[d]:=0; c:=b; f:=0; repeat {настраиваемся на начало и конец строки} d:=1; e:=length(a); z:=true; {проверяем полиндром} while z and (d<e)do begin {прорускаем икслючаемые символы} while(b[d]>0)and(d<e)do inc(d); while(b[e]>0)and(d<e)do dec(e); z:=z and(a[d]=a[e]); dec(e); inc(d); end; {если полиндром} if z then begin e:=0; {считаем количество символов} for d:=1 to length(a) do e:=e+1-b[d]; {и проверяем максимум} if e>f then begin f:=e; c:=b; end; end; {двоичный счетчик} d:=0; repeat b[d]:=b[d] mod 2; inc(d); inc(b[d]); until (b[d]<2)or(d>length(a)); until d>length(a); {вывод результата} writeln(‘длина:‘,f:4); for d:=1 to length(a) do if c[d]=0 then write(a[d]); writeln;end.