Добрый день. Есть функция на основе цикла FOR для удаления подстрок из строки за один проход

Код:

(*  09.02.2013  Функция удаления ненужных тегов с содержимым
  Список тегов: script; style; noscript; applet; object
  textarea; audio; button; canvas; comment; datalist; del;
  meter; noembed; optgroup; output; progress. удаление за один проход*)

function DelUseless(const Data:string):string;
var
I,EndTeg,Differ:integer;
Buffer:string; (*накопитель полезных символов*)
DefineTeg:string; (*первые 10 символов после <*)
begin
Differ:=0;
 if Length(Data) = 0 then Exit else
 for I := 1 to Length(Data) do

  begin
   if (Data[i] = '<') then  (*ловим открывающий символ*)
    begin
     DefineTeg:=Copy(Data, I,10); (*получаем десять символов от открывающего*)
      if (PosEx('<script', DefineTeg,1)= 0) then  (*если там нет '<script'*)
        Buffer:=Buffer+Data[i] (*копируем символ в буфер ЕСЛИ не <script*)
      else
        begin
          EndTeg:=PosEx('</script>',Data,I); (*определяем замыкающий тег*)
            if (EndTeg > 0) then Differ:=(EndTeg - I + 9); (* вычисляеи число символов от и до;*)
        end
        end
        else
          if (Differ = 0) then Buffer:=Buffer+Data[i] (*копируем посимвольно в буфер ЕСЛИ не <*)
          else Dec(Differ, 1) (*с каждым тактом в цикле уменьшаем счетчик числа символов в <script hghg>hghghgh</script>*)
  end;
 Result:=Buffer;
end;

Функция почемуто работает не совсем корректно, в частности строку
1<script>2</script>3 4<script>5</script>6
трансформирует в
1< 4<
а должно быть
13 46

Подскажите, кто в курсе, в чем ошибка?
З.Ы. Цикл FOR используется для того чтобы в затем ввести CASE при выборе тега для обработки и как самый быстрый вариант(один проход от первого символа до последнего в строке)

[NumLock]

а самому разобраться как работает функция и найти ошибку никак? не так уж и много строк.

функция и так моя, разбирался как мог, теперь твоя очередь.

[NumLock]

вот это читал:

Сообщение от Dimitry Sibiryakov

Эта процедура написана не программистом. Переписать с нуля.

???

вообщето там функция а не процедура
ну и сам по себе ответ какойто.... ну обойдемся без мата
если уж вылез кто со своим мнением, так уж поведай что конкретно не так, а обобщать не надо

[NumLock]

для Delphi 7 http://zalil.ru/34247888

Код:

uses
  Unit2,
...
Edit1.Text:=NumLockStr('1<script>2</script>3 4<script>5</script>6', 'script');

и что это значит?
сделать декомпеляцию ДЦУ? предлагаешь? ХЕ3 этот файл не компилирует
если не в курсе что не так в приведеном коде конкретно, так и скажи. не надо придумывать какито другие версии функции, у меня их уже штук пять есть , все кстати работают. просто версия с циклом FOR, по теории должна работать быстрее всех?

[Bargest]

Гораздо быстрее было бы что-нибудь вроде

Код:

i := 1;
while i < Length(s) do
begin
  if (i < Length(s) - 7) and (s[i] = '<') then
  begin
    if s.SubStr(i + 1, 6) = 'script' then
    begin
      j := PosEx('>', s, i + 7);
      if j > 0 then
      begin
        j := PosEx('</script>', s, j + 1);
        if j > 0 then
           i := j + 8
        else
           buf := buf + s[i];
      end
      else
           buf := buf + s[i];
    end;
  end
  else
     buf := buf + s[i];
  i := i + 1;
end;

Может в цифрах ошибся, но суть ясна.
А разбирать код, который был оформлен как будто под кайфом, нет желания.

[NumLock]

можно установить Delphi 7 на виртуалку и скомпилировать библиотеку dll с этим модулем, экспортировав функцию, если самому лень найти ошибку в 25 строчках кода.

да мне не лень, просто все варианты иссякли, просто видимо это то чего мне пока не известно.

[Alegun]

А вот такое будет правильно работать?

Код:

function DelUseless(Data, BegTeg, EndTeg: string): string;
var
i: integer;
f1, f2, f3, f4: boolean;
begin
 if Length(Data) = 0 then Exit;
 Result:= '';  f1:= false; f2:= false; f3:= false; f4:= false;

 for i := 1 to Length(Data) do
  begin
   if  (Data[i] = BegTeg[1]) and (not f1)
   and (copy(Data, i, Length(BegTeg) - 1) =
        copy(BegTeg, 1, Length(BegTeg) - 1)) then f1:= true;

   if (Data[i] = BegTeg[Length(BegTeg)]) and (f1) then f2:= true;

   if  (Data[i] = EndTeg[1]) and (f1) and (f2) and (not f3)
   and (copy(Data, i, Length(EndTeg) - 1) =
        copy(EndTeg, 1, Length(EndTeg) - 1))then f3:= true;

   if (Data[i] = EndTeg[Length(EndTeg)]) and (f1) and (f2) and (f3) then
   begin
    f1:= false; f2:= false; f3:= false; f4:= true;
   end;
 if (not f1)and(not f2)and(not f3)and(not f4) then Result:= Result + Data[i];
  if f4 then f4:= false;
  end;

end;

Здесь только нет обработки ошибки (по выходу копой за размерчик входной строки). Использование:

Код:

Edit1.Text:=
DelUseless('1<script 3007876>2</script 89008097>3 4<script defwwww>5</script hhhthtrew>6','<script>','</script>');

Символы "<" и ">" - заменяемо-основные, вдруг какие другие попадутся.

З.Ы. Циклом всё же медленнее, с while можно сразу пропустить лишние интерации, а с for такое не прокатит.

Alegun, спасибо за ответ, НО....
строка 1<script>2</script>3 4<script>5</script>6','<script>','</script> это специально упрощенный тест, просто пример. на самом деле тег script всегда имеет атрибуты, причем много. условно подстрока может иметь вид типа: <script ghghg>fcgfgfgfgfg</script>
не уверен что твой код обработает такие подстроки

[NumLock]

http://zalil.ru/34249929

[M.A.D.M.A.N.]

Книгу по рег. выражениям дать?

Сообщение от M.A.D.M.A.N.

Книгу по рег. выражениям дать?

их у меня есть
но пока Я их не изучаю. рано еще.