Слова перевертыши. есть программа нужна проверка, доработка, Вывести все слова перевертыши встречающиеся в тексте Опции

[student___]

Здравствуйте. дана задача: Вывести все слова перевертыши(симметричные слова), встречающиеся в тексте.
вот код программы, работает верно НО

Код

uses crt;
  var s,t,sl,sk,sp: string;
a, e,i,j,k: integer;
f2:text;  begin
assign(f2,'f2.pas');
reset(f2);
while not eof(f2)  do
begin
readln(f2,t);
insert(' ',t,length(t)+1);
for i:=1 to length(t) do
if ( t[i]='.') or (t[i]='-')  or (t[i]=',')
or (t[i]='!') or (t[i]='?')  then t[i]:=' ' else
begin
if t[i]<>' ' then sl:=sl+t[i] else
if length(sl)>0 then
begin
sk:=''; sp:='';
for e:=1 to length(sl) do
sk:=sk+upcase(sl[e]);
for e:=1 to length(sk) do
sp:=sk[e]+sp;
if sp=sk then
begin
inc(k);
writeln(sl,', ');
end;
sl:='';
end;
end;
end;
writeln;
writeln ('‚ в тексте ',k,' перевертышей');
close(f2);
readln;
end.  

таким способом рассмотрены не все знаки препинания, которые могут встретится, а перечислять все-это очень много и не красиво.
преподаватель сказал что цикл for i:=1 to length(t) нерационально использовать. По одной букве добавлять, чтобы выделить слово это не правильно ,лучше воспользоваться циклом while ... do или repeat ... until, а также функциями Pos и Copy, так программа будет работать быстрее.
я программу то переделываю, но вот Pos и Copy употреблять не хочу, пос понимаю зачем-что от пробела до пробела слова проверять , а копи зачем?
на данный момент такой текст программы, но она почемуто не хочет работать нормально, при запуске пишеt Running такая-то прогр. и все

Код

uses crt;
var s,t,sl,sk,sp: string;
p, l, a, e,i,j,k: integer;
f2:text;
begin
assign(f2,'f2.pas');
reset(f2);
while not eof(f2)  do
begin
readln(f2,t);
i:=length(t);
insert(' ',t,length(t)+1);
i:=length(t);
while i <>0  do
begin
t[i]:=lowercase(t[i]);
if t[i] in ['a'..'z'] then
begin
sl:=sl+t[i];
dec(i);
end  else
if ord(t[i]) in [33..47,58..64,91..96,123..126] then dec(i) else
if length(sl)>0 then
begin
sk:=''; sp:='';
for e:=1 to length(sl) do
sk:=sk+upcase(sl[e]);
for e:=1 to length(sk) do
sp:=sk[e]+sp;
dec(i);
if sp=sk then
begin
inc(k);
writeln(sl,', ');
end;
sl:='';
end;
end;
writeln;
writeln ('в тексте  ',k,' перевертышей');
close(f2);
readln;
end;
end.  

почему? в чем беда?

Сообщение отредактировано: student___ - 15.04.2013 19:10

[Гость]

вот код рабочей программы. может кому-нибудь пригодится

Код

uses crt;
var w, s,t,sl,sk,sp: string;
q, p, l, a, e,i,j: integer;
{-----------***********--------------}
aOut:array [1..200] of string; {массив выходных данных}
OutC:byte;{кол-во слов}
Add:boolean;{флаг добавления слова в массив}
{-----------***********--------------}

    f2:text;
begin
OutC:=0;



   l:=1;
assign(f2,'f2.pas');
reset(f2);
   while not eof(f2)  do
        begin
         readln(f2,t);
          insert(' ',t,length(t)+1);

  while Pos(' ',t)<>0 do begin
  q:=Pos(' ',t);
  sl:=Copy(t, 1,q-1);{копируем слово до пробела}
  delete(t,1,q); {удаляем из строки слово вместе с пробелом}
  {----------------------------}
  insert(' ',sl,length(sl)+1);
  while l<length(sl) do
  begin
  if ord(sl[l]) in [33..47,58..64,91..96,123..126] then begin delete(sl,l,1); dec(l) end;
  inc(l);

  end;
  l:=0;delete(sl,length(sl),1);

  sk:=''; sp:='';  

  {---------------------------------------------------------------}
if length(sl)>1 then  {проверяем слово, одну букву словом переверт. не считаем}
                begin
                
                  for e:=1 to length(sl) do
                    sk:=sk+upcase(sl[e]);
                   for e:=1 to length(sk) do
                   sp:=sk[e]+sp;

                  if sp=sk then
                  {---------------------*************---------------------------}
                             begin
                             Add:=True;{добавляем слово в массив}
                                if OutC>0 then{если в массиве уже есть слова, то проверим повторения}
                                for i:=1 to OutC do{ищем повторения}
                                if sp=aOut[i] then{нашли повторения}
                                  begin
                                   Add:=False;{не добавляем повтор. слово}
                                   Break;{прерываем цикл проверки}
                                  end;
                               if Add then
                                begin
                                 inc(OutC);{увеличиваем кол-во слов в массиве}
                                 aOut[Outc]:=sp;{записываем это слово}
                                end;
                             end;
                  {------------------*********************--------------------}
                    sl:='';

                 end;

              end;

              end;
      {-------------------------}
      for i:=1 to OutC do
      writeln(aOut[i],' ');


writeln;



  close(f2);
readln;
end.