Функция COPY. Быстродействие.

[Pcrepair]

долго думал на предложенным алгоритмом

Я бы сделал так.
Count = 1.
Ищу первое вхождение < после Count.
Копирую 10 символов с этой позиции во временную строку.
Смотрю на нужный тег. Если не нужный - ищу следующую < с этой позиции. Если нужный - копирую от Count до текущей позиции, ищу к нему закрывающий и Count = концу закрывающего.
Вернуться в начало.

получилось следующее

function DelUseless(const Data:string):string;
var
Len,J:integer;
DefineTeg:string; (*первые N символов после <*)
starttime,endtime,q:int64;

Count:integer; (*счетчик позиции символа в строке*)
Pos1:integer; (*позиция вхождения < в строке*)
TegEnd:Integer; (*позиция окончания тега*)
Pattern:string; (*выделенный Тег из строки*)
SubStr:string;
begin                     starttime:=GetTickCount;
Len:=Length(Data);
J:=0;
if Length(Data) = 0 then Exit else
Count:=1;
(*-----------------ЦИКЛ-----------------------------*)
repeat
Pos1:=PosEx('<', Data,Count);   (*поиск первого вхождения символа < в строке*)
if Pos1 = 0 then
     begin
      if Count = 1 then  (*эта ветка на тот случай если вообще нет тегов в странице*)
        begin
          Result:=Data;
          Break;
        end  else
        begin            (*эта ветка копирует все после того как закончатся <*)
          SubStr:=Copy(Data, Count, Len-Count-1);  
          J:=Length(SubStr)+Length(Result);        
          Insert(SubStr, Result, J+1);
          Break;
        end;
     end  else
 begin  (*тут конечно можно проще, но на скорость это не влияет*)
  DefineTeg:=Copy(Data, Pos1, 10); (*копируем первые 11 символов с позиции первого вхождения*)
  TegEnd:=PosEx(' ',DefineTeg,1); (*позиция первого пробела *)
  if TegEnd = 0 then (*если пробела нет ищем >*)
  TegEnd:=PosEx('>',DefineTeg,1); (*позиция первого >*)
  Pattern:=Copy(DefineTeg, 1, (TegEnd-1)); (*выделяем паттерн тега*)
  (*----------------------------------------------------------*)
  (*далее определяем есть ли в Перем нужный тег(<script)*)
    if Pattern = '<script' then 
     begin
       SubStr:=Copy(Data, Count, Pos1-Count);    (*копировать от Count до позиции Pos1*)
       J:=Length(SubStr)+Length(Result);         (*число символов в ВЫХОДЕ!!!!!*)
       Insert(SubStr, Result, J+1);              
       Count:=PosEx('</script>', Data, Pos1)+9;  (*переводим позицию на следующий символ*)
     end
     else
      begin
        SubStr :=Copy(Data, Count, Pos1-Count+1);  (*копировать все gghh<*)
        J:=Length(SubStr)+Length(Result);          
        Insert(SubStr, Result, J+1);               
        Count:=Pos1+1;                             (*переводим позицию на следующий символ*)
      end;
 end
until Pos1 = 0 ;
(*-----------------конец-----------------------------*)
endtime:=GetTickCount; q:=endtime-starttime;  ShowMessage('TIME = '+IntToStr(q));
end;  (*все работает 50 мС для 3 мБ*)

Но результат практически вдвое хуже чем в варианте с посимвольным копированием в цикле FOR
Если возможно, укажите на узкие участки и как их заменить, но без использования указателей. это пока не совсем понятно

[Sibedir]

1. Определение времени вынеси за пределы функции. Это позволит более корректно определить время её работы.

starttime:=GetTickCount;
// преобразование массива строк (вызов DelUseless в цикле)
endtime:=GetTickCount; q:=endtime-starttime;  ShowMessage('TIME = '+IntToStr(q));

2.

Но результат практически вдвое хуже чем в варианте с посимвольным копированием в цикле FOR

Здесь дело не совсем в FOR, а в том, что вариант с посимвольным поиском запускает механизм удаления подстрок по элементарному условию

ch := Data[i];
if ch = '<' then

А вариант

Pos1:=PosEx('<', Data,Count);

это:
- вызов доп процедуры (сам вызов и передача туда параметров)
- избыточный для данной задачи алгоритм (внутри PosEx)
- выполнение не нужных в данном случае проверок (внутри PosEx)

// Вместо Pos1:=PosEx('<', Data,Count);
Pos1 := 0;
for i := Pos1+1 to Len do begin
  ch := Data[i];
  if ch = '<' then begin
    Pos1 := i;
    Break;
  end;
end;

while Pos1 <> 0 do begin
  // Процесс поиска и удаления тегов
  // Pos1 := {последний символ удаленного гега};
  // Повторяем 'имитатор' Pos1:=PosEx('<', Data,Count);. Кода больше, но с точки зрения выполнения более рационально
  // Можно оформить в виде inline функции, но так нагляднее
  for i := Pos1+1 to Len do begin
    ch := Data[i];
    if ch = '<' then begin
      Pos1 := i;
      Break;
    end;
  end;
end;

Это позволит почти мгновенно обрабатывать строки БЕЗ тегов.

3. Вообще, функция перегружена всякими Copy, Insert и PosEx.
4.

но без использования указателей. это пока не совсем понятно

Указатель позволяет избавиться от лишнего копирования данных из одной переменной в другую. Вместо этого они дают механизм представления данных одного типа как другого.
Например

s := PChar(@Data[I-1]);

заставляет программу думать, что s - это строка PChar, которая начинается с I-ого элемента строки Data. Но при этом самого копирования подстроки не происходит. Правда при этом программисту самому придётся следить за границами строки, и в этом смысле в предложенном мною варианте

for K:=1 to 8 do
        if s[K] <> BS[K] then begin
          BeginFlag := False;
          Break;
        end;

таится ошибка. Если I - это номер, скажем, предпоследнего символа Data, то s[8] лежит уже за пределами строки Data, но программа обратится к нему без тени сомнения, и получит непредсказуемый результат (или вообще произойдет ошибка).
Copy - более надежная функция, но смысл в том, что и от неё можно избавится.

Вывод
Тут 2 пути:
1. Писать более громоздкий и сложный код и оптимизировать его до талого (в идеале на голом BASM)
2. Оставить всё как есть (если скорость и корректность работы устраивает), устранив только самые явные 'тормоза'.

[Sibedir]

Ваш вариант съедает последние цифры, а при некоторых тестах зацикливается.
Написал вот что

const
  TEG_NAME = 'script';

function Sib_DelUseless (AData: String): String;
var
  I_Data, I_Res, I_Find, Len_Data: Integer;
  CurDataChar: Char;

  procedure NextDataChar;
  begin
    Inc (I_Data);
    CurDataChar := AData[I_Data];
  end;

  procedure AddResChar;
  begin
    Inc (I_Res);
    Result[I_Res] := CurDataChar;
  end;


  procedure FinishRemainder;
  begin
    while I_Data <= Len_Data do begin
      Inc (I_Res);
      Result[I_Res] := AData[I_Data];
      Inc (I_Data);
    end;
  end;

  function NextStrIs (AFindStr: String): Boolean;
  var
    i, c: Integer;
  begin
    Result := True;
    c := Length (AFindStr);
    for i := 1 to c do begin
      Inc (I_Find);
      if (I_Find > Len_Data) or (AFindStr[i] <> AData[I_Find]) then begin
        Result := False;
        Break;
      end;
    end;
  end;

  function FindForwardStr (AFindStr: String): Boolean;
  var
    ch: Char;
    i, c: Integer;
  begin
    if AFindStr = '' then begin
      Result := True;
    end
    else begin
      Result := False;
      ch := AFindStr[1];
      c := Length (AFindStr);
      while I_Find < Len_Data do begin
        Inc (I_Find);
        if AData[I_Find] = ch then begin
          i := I_Find;
          Dec (I_Find);
          if NextStrIs (AFindStr) then begin
            Result := True;
            Break;
          end;
          I_Find := i;
        end;
      end;
    end;
  end;

  function FindForwardChar (AFindChar: Char): Boolean;
  begin
    Result := False;
    while I_Find < Len_Data do begin
      Inc (I_Find);
      if AData[I_Find] = AFindChar then begin
        Result := True;
        Break;
      end;
    end;
  end;

begin
  Len_Data := Length (AData);
  if Len_Data = 0 then Exit;
  SetLength (Result, Len_Data);
  I_Data := 0;
  I_Res  := 0;
  while I_Data < Len_Data do begin
    NextDataChar;
    if CurDataChar = '<' then begin
      I_Find := I_Data;
      if NextStrIs (TEG_NAME) then begin
        Inc (I_Find);
        case AData[I_Find] of
          ' ': begin
            if FindForwardChar ('>') then begin
              if FindForwardStr ('</' + TEG_NAME + '>') then begin
                I_Data := I_Find;
              end
              else begin
                FinishRemainder;
                Break;
              end;
            end
            else begin
              FinishRemainder;
              Break;
            end
          end;
          '>': begin
            if FindForwardStr ('</' + TEG_NAME + '>') then begin
              I_Data := I_Find;
            end
            else begin
              FinishRemainder;
              Break;
            end;
          end;
          else begin
            AddResChar;
          end;
        end;
      end
      else begin
        AddResChar;
      end;
    end
    else begin
      AddResChar;
    end;
  end;
  SetLength (Result, I_Res);
end;

[Sibedir]

Проверял на строках

111111111112222222222233333333334444444444444445555555555555555
11111111111<script>222222222223333333333444444444444444</script>5555555555555555
11111111111<script >222222222223333333333444444444444444</script>5555555555555555
11111111111<script qqq>222222222223333333333444444444444444</script>5555555555555555
11111111111<script qqq 222222222223333333333444444444444444</script>5555555555555555
11111111111<script->222222222223333333333444444444444444</script>5555555555555555
11111111111<script>222222222223333333333444444444444444</script->5555555555555555
11111111111<script>22222222222</script>3333333333<script >444444444444444</script>5555555555555555
11111111111<script->22222222222</script>3333333333<script qqq>444444444444444</script>5555555555555555
11111111111<script>22222222222</script->3333333333<script>444444444444444</script>5555555555555555
11111111111<script >22222222222</script->3333333333<script qqq>444444444444444</script>5555555555555555
11111111111<script  22222222222</script->3333333333<script qqq>444444444444444</script>5555555555555555
11111111111<script>22222222222</script>3333333333<script->444444444444444</script>5555555555555555
11111111111<script></script>3333333333<script>444444444444444</script->
11111111111<script  >22222222222</script>3333333333<script>444444444444444</script->5555555555555555
11111111111<script>22222222222</script->3333333333<script>444444444444444</script->5555555555555555
11111111111<script  >22222222222</script->3333333333<script>444444444444444</script->5555555555555555
11111111111<script  >22222222222</script>3333333333<script>444444444444444</script>5555555555555555
11111111111<script></script>3333333333<script>444444444444444</script>

Должно получиться

111111111112222222222233333333334444444444444445555555555555555
111111111115555555555555555
111111111115555555555555555
111111111115555555555555555
11111111111<script qqq 222222222223333333333444444444444444</script>5555555555555555
11111111111<script->222222222223333333333444444444444444</script>5555555555555555
11111111111<script>222222222223333333333444444444444444</script->5555555555555555
1111111111133333333335555555555555555
11111111111<script->22222222222</script>33333333335555555555555555
111111111115555555555555555
111111111115555555555555555
111111111115555555555555555
111111111113333333333<script->444444444444444</script>5555555555555555
111111111113333333333<script>444444444444444</script->
111111111113333333333<script>444444444444444</script->5555555555555555
11111111111<script>22222222222</script->3333333333<script>444444444444444</script->5555555555555555
11111111111<script  >22222222222</script->3333333333<script>444444444444444</script->5555555555555555
1111111111133333333335555555555555555
111111111113333333333

Вот этот файл input.zip (TXT = 3 МБ) вот такой код

procedure TForm1.Button5Click(Sender: TObject);
var
  b, e: Cardinal;
  DateS, ResS: String;
  i, j, c: Integer;
  SL: TStringList;
begin
  SL := TStringList.Create;
  SL.LoadFromFile ('input.txt');
  c := SL.Count - 1;
  b := GetTickCount;
  for j := 0 to c do begin
    DateS := SL.Strings[j];
    ResS := Sib_DelUseless (DateS);
  end;
  e := GetTickCount;
  Button5.Caption := IntToStr (e-b);
  SL.Free;
end;

На Lazarus'е 1.0.4 (FPC 2.6.0) обрабатывается за 30~32 мс (сама погрешность ~ результату) (Pentium Dual-Core E5700 3.00GHz).

[Somebody]

Вообще надо сначала уточнить, что же всё-таки делать, когда синтаксис тегов неправильный. Если это XML, то на это можно забить, всё равно не распарсится. А если это HTML и надо реально удалить все скрипты, то надо учитывать поведение браузеров, чтобы что-нибудь не то не осталось.

<script foo=":D></script>">boo!</script>

и т. д.

[Pcrepair]

Всем большое спасибо. Пока буду изучать примеры и пробовать написать что то работающее.

пока этот вариант быстрее всего, но может обрабатывать массив тегов только в конвеере

procedure TForm2.Button1Click(Sender: TObject);
(*-------------------------------------*)
(*  21.02.2013  Функция удаления ненужных тегов с содержимым
    максимальное быстродействие за счет алгоритма и использования
    циклов FOR для посимвольного копирования
    функция модифицированна для работы в конвеере*)
function DelUseless (Data: String): String;
const Teg ='script';
var
  Pos1,  (*позиция вхождения Тега*)
  Pos2,  (*позиция закрывающего тега*)
  i,      (*счетчик в цикле*)
  Count, (*счетчик текущей позиции в строке*)
  LenOut, (*число символов в выходе, текущая позиция*)
  Len: Integer; (*число символов строки*)
begin
  Len := Length(Data);
  SetLength(Result, Len);
  Pos1 := 1;
  Count := 1;
  LenOut := 0;
  while True do
    begin  (*---------------ЦИКЛ----------------------------*)
    Pos1 := PosEx(('<' + Teg), Data, Count); (*ищем позицию вхождения*)
      if Pos1 = 0 then Break else (*если нет ни одного <teg выход из цикла*)
        begin
          Pos2 := PosEx('</'+Teg+'>', Data, Pos1+(Length('</'+Teg+'>')-1));(*ищем позицию закрытия*)
           if Pos2 = 0 then Break else
              begin
                for i := Count to Pos1-1 do  (*ЦИКЛ*)
                  Result[i-LenOut] := Data[i]; (*посимвольно копируем все до <teg*)

                  Count := Pos2 + 9; (*меняем позицию счетчика за </teg>*)
                  LenOut := LenOut + (Count - Pos1); (*меняем позицию в счетчике выхода*)
              end;
        end;
    end;  (*копируем все до последнего </script>*)
(*-----------конец цикла--------------------------*)
for i := Count to Len do (*ЦИКЛ от последней позиции до конца строки*)
Result[i-LenOut] := Data[i]; (*посимвольно копируем*)

SetLength (Result, Len-LenOut); (*ограничить размер строки*)
end;  (*все работает 15 - 30 - 45 мС, пока лучший результат*)
(*-------------------------------------*)

var DataIn, DataOut:string; starttime,endtime,q:int64;
begin
   DataIn:=AnsiLowerCase(Memo1.Text);
       starttime:=GetTickCount;
   DataOut:=DelUseless(DataIn);
       endtime:=GetTickCount; q:=endtime-starttime;  ShowMessage('TIME = '+IntToStr(q));
   Memo2.Text:=DataOut;
end;

можно начинать критиковать

[Somebody]

Вообще я бы первым делом попробовал найти какую-нибудь библиотеку для работы с регулярными выражениями и проверить быстродействие. И только если будет тормозить, тогда изобретать велосипеды.