StringReplace Alternativen zur Verbesserung der Leistung

Question

Ich verwende StringReplace, um > und < durch das Zeichen selbst in einer generierten XML-Datei wie dieser zu ersetzen:

StringReplace(xml.Text,'>','>',[rfReplaceAll]) ;
StringReplace(xml.Text,'&lt;','<',[rfReplaceAll]) ;

Das Problem ist, dass es viel zu lange dauert, jedes Vorkommen von > zu ersetzen.

Haben Sie eine bessere Idee, um es schneller zu machen?

Answer 1

Ungetestete Konvertierung des von Jorge Ferreira geschriebenen C#-Codes.

function ReplaceLtGt(const s: string): string;
var
  inPtr, outPtr: integer;
begin
  SetLength(Result, Length(s));
  inPtr := 1;
  outPtr := 1;
  while inPtr <= Length(s) do begin
    if (s[inPtr] = '&') and ((inPtr + 3) <= Length(s)) and
       (s[inPtr+1] in ['l', 'g']) and (s[inPtr+2] = 't') and
       (s[inPtr+3] = ';') then
    begin
      if s[inPtr+1] = 'l' then
        Result[outPtr] :=  '<'
      else
        Result[outPtr] := '>';
      Inc(inPtr, 3);
    end
    else begin
      Result[outPtr] := Result[inPtr];
      Inc(inPtr);
    end;
    Inc(outPtr);
  end;
  SetLength(Result, outPtr - 1);
end;

Answer 2

Systools (Turbopower, jetzt quelloffen ) verfügt über eine Funktion ReplaceStringAllL, die alle diese Funktionen in einer Zeichenkette ausführt.

Answer 3

Es funktioniert wie ein Zauber, so schnell, vertrauen Sie ihm

    Function NewStringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
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[i];
        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[i];
          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;