Mehrere Strings auf einmal ersetzen

[Matze]

xaromz hat hier eine Routine gepostet, die es ermöglicht, mehrere Strings auf einmal zu ersetzen, somit entfält der mehrmalige Aufruf von StringReplace.

Die Parameter sind eigentlich selbsterklärend.

Delphi-Quellcode:

uses
  SysUtils;

...

function StringReplaceMultiple(const Source: AnsiString;
  const OldPatterns, NewPatterns: array of AnsiString;
  CaseSensitive: Boolean = True): AnsiString;
// Replace every occurrence

type
  TFoundPos = record
    Position: Integer;
    PatternNum: Integer;
  end;

var
  C: Integer;
  FoundCount: Integer;
  SourcePosition: Integer;
  PatternCount: Integer;
  Positions: array of TFoundPos;
  PositionLength: Integer;

  PatternNum: Integer;
  SourceLength, OldPatternLength, NewPatternLength: Integer;
  OldLengths, NewLengths: array of Integer;
  DeltaOld: Integer;

  Delta: Integer;

  PSource, PDest, PNew: PAnsiChar;

  SearchSource: AnsiString;
  CasePatterns: array of AnsiString;

  I: Integer;
begin
  if (Source = '') or (Length(OldPatterns) <> Length(NewPatterns)) then
  begin
    Result := Source;
    Exit;
  end;

  try
    // Initialize some variables
    PatternCount := Length(OldPatterns);
    SourceLength := Length(Source);
    SetLength(OldLengths, PatternCount);
    SetLength(NewLengths, PatternCount);
    Delta := 0;
    DeltaOld := 0;
    for C := 0 to PatternCount - 1 do
    begin
      OldLengths[C] := Length(OldPatterns[C]);
      NewLengths[C] := Length(NewPatterns[C]);
      Inc(DeltaOld, OldLengths[C]);
    end;
    DeltaOld := Round(DeltaOld / PatternCount);

    SetLength(CasePatterns, PatternCount);
    if CaseSensitive then
    begin
      SearchSource := Source;
      for C := 0 to PatternCount - 1 do
        CasePatterns[C] := OldPatterns[C];
    end else
    begin
      SearchSource := AnsiLowerCase(Source);
      for C := 0 to PatternCount - 1 do
        CasePatterns[C] := AnsiLowerCase(OldPatterns[C]);
    end;

    FoundCount := 0;

    // ----------------------------------
    // Check the amount of replaces
    // ----------------------------------

    // We *should* range check here, but who has strings > 2GB ?
    PositionLength := SourceLength div DeltaOld + 1;
    SetLength(Positions, PositionLength);

    C := 1;
    while C <= SourceLength do
    begin
      for PatternNum := 0 to PatternCount - 1 do
      begin
        if (SearchSource[C]) = (CasePatterns[PatternNum][1]) then // Check first char before we waste a jump to CompareMem
        begin
          if CompareMem(@SearchSource[C], @CasePatterns[PatternNum][1], OldLengths[PatternNum]) then
          begin
            if FoundCount >= PositionLength then
            begin
              Inc(PositionLength, 4);
              SetLength(Positions, PositionLength);
            end;

            Positions[FoundCount].Position := C; // Store the found position
            Positions[FoundCount].PatternNum := PatternNum;
            Inc(FoundCount);
            Inc(C, OldLengths[PatternNum] - 1); // Jump to after OldPattern
            Inc(Delta, NewLengths[PatternNum] - OldLengths[PatternNum]);
            Break;
          end;
        end;
      end;
      Inc(C);
    end;

    SetLength(CasePatterns, 0);

    // ----------------------------------
    // Actual replace
    // ----------------------------------

    if FoundCount > 0 then // Have we found anything?
    begin
      // We know the length of the result
      // Again, we *should* range check here...
      SetLength(Result, SourceLength + Delta);

      // Initialize some variables
      SourcePosition := 1;
      PSource := PAnsiChar(Source);
      PDest := PAnsiChar(Result);

      // Replace...

      for C := 0 to FoundCount - 1 do
      begin
        // Copy original and advance resultpos
        PNew := PAnsiChar(NewPatterns[Positions[C].PatternNum]);

        Move(PSource^, PDest^, Positions[C].Position - SourcePosition);
        Inc(PDest, Positions[C].Position - SourcePosition);

        // Append NewPattern and advance resultpos
        Move(PNew^, PDest^, NewLengths[Positions[C].PatternNum]);
        Inc(PDest, NewLengths[Positions[C].PatternNum]);

        // Jump to after OldPattern
        Inc(PSource, Positions[C].Position - SourcePosition + OldLengths[Positions[C].PatternNum]);
        SourcePosition := Positions[C].Position + OldLengths[Positions[C].PatternNum];
      end;

      // Append characters after last OldPattern
      Move(PSource^, PDest^, SourceLength - SourcePosition + 1);
    end else
      Result := Source; // Nothing to replace

    // Clean up
    Finalize(Positions);
  except
  end;
end;

Der Code würde als praktische Ergänzung zu diesem Code dienen.

[xaromz]

Hallo,

ich hab' meinen Code nochmal etwas überarbeitet und aufgeräumt. Je länger die zu ersetzenden Strings sind, desto schneller ist der neue Code im Vergleich zum alten.

Delphi-Quellcode:

function StringReplaceMultiple(const Source: AnsiString;
  const OldPatterns, NewPatterns: array of AnsiString;
  CaseSensitive: Boolean = True): AnsiString;
// Replace every occurrence

type
  TFoundPos = record
    Position: Integer;
    PatternNum: Integer;
  end;

  TPattern = record
    Old: AnsiString;
    New: PAnsiChar;
    LengthOld: Integer;
    LengthNew: Integer;
    Diff: Integer;
  end;

var
  C: Integer;
  FoundCount: Integer;

  Positions: array of TFoundPos;
  PositionLength: Integer;

  Patterns: array of TPattern;
  PatternCount: Integer;
  PNum: Integer;

  SourcePosition: Integer;
  SourceLength: Integer;
  SearchSource: AnsiString;

  DeltaOld: Integer;
  Delta: Integer;

  PSource, PDest, PNew: PAnsiChar;
begin
  // Is there anything to do at all?
  if (Source = '') or (Length(OldPatterns) <> Length(NewPatterns)) then
  begin
    Result := Source;
    Exit;
  end;

  // Initialize the Pattern records
  PatternCount := Length(OldPatterns);

  FoundCount := 0;
  SetLength(Patterns, PatternCount);
  for C := 0 to PatternCount - 1 do
    if (OldPatterns[C] <> '') and (OldPatterns[C] <> NewPatterns[C]) then
    begin
      if CaseSensitive then
        Patterns[FoundCount].Old := OldPatterns[C]
      else
        Patterns[FoundCount].Old := AnsiLowerCase(OldPatterns[C]);
      Patterns[FoundCount].LengthOld := Length(OldPatterns[C]);
      Patterns[FoundCount].New := PAnsiChar(NewPatterns[C]);
      Patterns[FoundCount].LengthNew := Length(NewPatterns[C]);
      Patterns[FoundCount].Diff :=
        Patterns[FoundCount].LengthNew - Patterns[FoundCount].LengthOld;

      Inc(FoundCount);
    end;
  PatternCount := FoundCount;
  SetLength(Patterns, PatternCount);

  // Nothing to replace
  if PatternCount = 0 then
  begin
    Result := Source;
    Exit;
  end;

  if CaseSensitive then
    SearchSource := Source
  else
    SearchSource := AnsiLowerCase(Source);

  try
    // Initialize some variables
    SourceLength := Length(SearchSource);
    Delta := 0;

    DeltaOld := 0;
    for C := 0 to PatternCount - 1 do
      Inc(DeltaOld, Patterns[C].LengthOld);
    DeltaOld := Round(DeltaOld / PatternCount);

    FoundCount := 0;

    // ----------------------------------
    // Check the amount of replaces
    // ----------------------------------

    // We *should* range check here, but who has strings > 2GB ?
    PositionLength := SourceLength div DeltaOld + 1;
    SetLength(Positions, PositionLength);

    C := 1;
    while C <= SourceLength do
    begin
      for PNum := 0 to PatternCount - 1 do
      begin
        // Check first char before we waste a jump to CompareMem
        if (SearchSource[C]) = (Patterns[PNum].Old[1]) then
        begin
          if CompareMem(@SearchSource[C], @Patterns[PNum].Old[1], Patterns[PNum].LengthOld) then
          begin
            if FoundCount >= PositionLength then
            begin
              // Make room for more Positions
              Inc(PositionLength, 4);
              SetLength(Positions, PositionLength);
            end;

            Positions[FoundCount].Position := C; // Store the found position
            Positions[FoundCount].PatternNum := PNum;
            Inc(FoundCount);
            Inc(C, Patterns[PNum].LengthOld - 1); // Jump to after OldPattern
            Inc(Delta, Patterns[PNum].Diff);
            Break;
          end;
        end;
      end;
      Inc(C);
    end;

    // ----------------------------------
    // Actual replace
    // ----------------------------------

    if FoundCount > 0 then // Have we found anything?
    begin
      // We know the length of the result
      // Again, we *should* range check here...
      SetLength(Result, SourceLength + Delta);

      // Initialize some variables
      SourcePosition := 1;
      PSource := PAnsiChar(Source);
      PDest := PAnsiChar(Result);

      // Replace...

      for C := 0 to FoundCount - 1 do
      begin
        PNum := Positions[C].PatternNum;

        // Copy original and advance resultpos
        PNew := Patterns[PNum].New;

        Delta := Positions[C].Position - SourcePosition;
        Move(PSource^, PDest^, Delta);
        Inc(PDest, Delta);

        // Append NewPattern and advance resultpos
        Move(PNew^, PDest^, Patterns[PNum].LengthNew);
        Inc(PDest, Patterns[PNum].LengthNew);

        // Jump to after OldPattern
        Inc(PSource, Delta + Patterns[PNum].LengthOld);
        SourcePosition := Positions[C].Position + Patterns[PNum].LengthOld;
      end;

      // Append characters after last OldPattern
      Move(PSource^, PDest^, SourceLength - SourcePosition + 1);
    end else
      Result := Source; // Nothing to replace

  finally
    // Clean up
    Finalize(Positions);
    Finalize(Patterns);
  end;
end;

Gruß
xaromz