Антипалиндром (pascal)

[RAVAL(c)]

Здравствуйте!Помогите, пожалуйста!

Задача:
Вывести антипалиндром (не перевертыш) максимальной длинны.
(если все подстроки - палиндромы, вывести "NO SOLUTION"
Пр.
Ввод: abba
Вывод: abb


Вот мой код:

VAR
  d,l,i : Longint;
  s,f  : AnsiString;
BEGIN
  ReadLn(s);
  d:=Length(s);
  f:='';
  While f<>s Do
    Begin
      i:=1;
      While i<=d Do
        Begin
         f:=s[i]+f;
         Inc(i);
        End;
      If f=s
        Then
          Begin
            Delete(s,d,1);
            Dec(d);
            f:='';
            i:=0;
            If s=''
             Then
               Begin
                 WriteLn('NO SOLUTION');
                 Halt;
               End;
          End
        Else Break;
    End;
    WriteLn(s);
END.

У меня не проходит по времени. Можно как-нибудь ускорить?
Ну или "накройняк" подскажите другой способ решения.

[_-Re@l-_]

У тебя не то чтобы по времени не проходит, у тебя она в принципе неправильно работает: ввожу abba и мне выдаёт "abba". На твоём месте я бы сделал отдельную процедуру проверки строки на палиндромичность, и потом уже всё остальное.

[Serge_Bliznykov]

вот мой вариант. просто тупой перебор...

function isPalindrom(const ss : string) : boolean;
var i, k : integer;
begin
  i := 1;
  k := length(ss);
  while (i<= (k div 2)) and 
    ( ss[i] = ss[k-i+1]) do inc(i);
  isPalindrom := i>(k div 2);
end;

var 
 s : string;
 i, k : integer;
 isFound : boolean;
begin
  s := 'abba';

  isFound := false;
  for k:=length(s) downto 2 do begin
    for i:=1 to length(s)-k+1 do
      if Not isPalindrom(Copy(s,i,k)) then begin
        WriteLn('Found: '+Copy(s,i,k));
        isFound := true;
        Break;
      end;
    if isFound then Break;
  end;

  if Not isFound then WriteLn('NO SOLUTION!');

end.