ParseText -> StringReplace Lento

[MagoSchmidt]

Senhores,

Tenho uma rotina que busca as NFS-e no WebService de BH usando a função:

ACBrNFSe.WebServices.ConsultaNFSe(DataInicial,DataFinal);

Ao retornar um conjunto grande de notas (acima de 500), verifiquei que a função ACBrUtil.ParseText (que faz a subsituitção dos HTML entities) está muito lenta por causa do tamanho do arquivo XML.

Identifiquei que a lentidão era causada pela ineficiencia da funcao StringReplace. Ao pesquisar na NET vi muita gente falando deste problema e propondo correções. Achei a seguinte função que tornou o processo bem mais rápido. Esta funcionando bem aqui para o meu caso. Se for do interesse de vocês, alterar lá!

Abraços

 

  Function NewStringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
  // Moacir: StringReplace original é muito lenta! Achei este outro na internet!!!
  var
    OldPat,Srch: string; // Srch and Oldp can contain uppercase versions of S,OldPattern
    PatLength,NewPatLength,P,i,PatCount,PrevP: Integer;
    c,d: pchar;
  begin
    PatLength:=Length(OldPattern);
    if PatLength=0 then begin
      Result:=S;
      exit;
    end;

    if rfIgnoreCase in Flags then begin
      Srch:=AnsiUpperCase(S);
      OldPat:=AnsiUpperCase(OldPattern);
    end else begin
      Srch:=S;
      OldPat:=OldPattern;
    end;

    PatLength:=Length(OldPat);
    if Length(NewPattern)=PatLength then begin
      //Result length will not change
      Result:=S;
      P:=1;
      repeat
        P:=PosEx(OldPat,Srch,P);
        if P>0 then begin
          for i:=1 to PatLength do
            Result[P+i-1]:=NewPattern;
          if not (rfReplaceAll in Flags) then exit;
          inc(P,PatLength);
        end;
      until p=0;
    end else begin
      //Different pattern length -> Result length will change
      //To avoid creating a lot of temporary strings, we count how many
      //replacements we're going to make.
      P:=1; PatCount:=0;
      repeat
        P:=PosEx(OldPat,Srch,P);
        if P>0 then begin
          inc(P,PatLength);
          inc(PatCount);
          if not (rfReplaceAll in Flags) then break;
        end;
      until p=0;
      if PatCount=0 then begin
        Result:=S;
        exit;
      end;
      NewPatLength:=Length(NewPattern);
      SetLength(Result,Length(S)+PatCount*(NewPatLength-PatLength));
      P:=1; PrevP:=0;
      c:=pchar(Result); d:=pchar(S);
      repeat
        P:=PosEx(OldPat,Srch,P);
        if P>0 then begin
          for i:=PrevP+1 to P-1 do begin
            c^:=d^;
            inc(c); inc(d);
          end;
          for i:=1 to NewPatLength do begin
            c^:=NewPattern;
            inc(c);
          end;
          if not (rfReplaceAll in Flags) then exit;
          inc(P,PatLength);
          inc(d,PatLength);
          PrevP:=P-1;
        end else begin
          for i:=PrevP+1 to Length(S) do begin
            c^:=d^;
            inc(c); inc(d);
          end;
        end;
      until p=0;
    end;
  end;

 

[Celso Marigo Junior]

@MagoSchmidt para postar contribuições, por favor, poste o arquivo fonte alterado, fica mais facil para fazer o merge.

Desde já obrigado.

[Daniel Simoes]

O ACBr é LGPL, portanto devemos nos preocupar, com a autoria dos fontes...

Esse método, foi desenvolvido  por você, ou você achou na internet ?  Sabe dizer qual a licença de distribuição do mesmo ?

 

[leomees]

Eu criei um "StringReplace" que ficou muito mais rápido que o original. Mas não tenho certeza de como enviar para vocês analisarem, posso postar o arquivo aqui mesmo?

[Daniel Simoes]

Não sei bem se compreendi...

Para qual situação seria usado ?
Quais fontes do ACBr seriam afetados ?
Como você mediu o benchmark ?

[leomees]

Aí esta a função que uso no ParseText ao invés da stringreplace original:

 

function StringReplaceLeo(const S, OldPatern: String; NewPattern: String String;
  Var
   Temp: String;
   Original: String;
  begin
    if pos(OldPatern, S) > 0 then
    Begin
       Original:= S;
       Result:= '';
       while Length(Original) > 0 do
       Begin
          Temp:= Copy(Original,1,100000);
          Original:= Copy(Original,100001,Length(Original));
          Temp:= StringReplace(Temp,OldPatern,NewPattern,[rfReplaceAll]);
          Result:= Result + Temp;
       End;
    End
    else
      Result := S;
  end;

 

Ficou notávelmente mais rápido em xml grandes como o do estoque,

Em Anexo a unit alterada

ACBrUtil.pas

 

Editado 6 Agosto, 2018 por leomees

[Daniel Simoes]

Experimente usar o método abaixo, da synautil.pas

{:Replaces all "Search" string values found within "Value" string, with the
 "Replace" string value.}
function ReplaceString(Value, Search, Replace: AnsiString): AnsiString

ele usa Ponteiros, então deve ser ainda mais rápido...

Em ACBrUtil.pas, ficaria algo como:
 

  function InternalStringReplace(const S, OldPatern: String; NewPattern: AnsiString ): String;
  begin
    if pos(OldPatern, S) > 0 then
      Result := ReplaceString(S, OldPatern, ACBrStr(NewPattern))
    else
      Result := S;
  end;  

 

[Daniel Simoes]

Enviei para o SVN,...

Citar

[*] Melhoria no método "ParseText", para usar substituição mais rápida do que
    StringReplace