Suche StringReplace mit Widestrings

[xaromz]

Hallo,

sieht wohl so aus, als hätte ich doch Zeit mich damit zu beschäftigen; antworte ich mir eben selbst.

Delphi-Quellcode:

function StringReplace(const Source, OldPattern, NewPattern: WideString): WideString;
// Replace every occurrence, case insensitive
var
   C: Integer;
   FoundCount: Integer;
   SourcePosition: Integer;
   Positions: array of Integer;

   SourceLength, OldPatternLength, NewPatternLength: Integer;
   WideCharLength: Integer;
   Helper: Integer;

   PSource, PDest, PNew: PWideChar;
begin
  // Is there anything to do?
  if (OldPattern = NewPattern) or
     (Source = '') or
     (OldPattern = '') then
  begin
    Result := Source;
    Exit;
  end;

  // Initialize some variables
  SourceLength := Length(Source);
  OldPatternLength := Length(OldPattern);
  NewPatternLength := Length(NewPattern);
  WideCharLength := SizeOf(WideChar);

  FoundCount := 0;

  // We *should* range check here, but who has strings > 4GB ?
  SetLength(Positions, SourceLength div OldPatternLength + 1);

  Helper := OldPatternLength * WideCharLength;

  C := 1;
  while C <= SourceLength - OldPatternLength + 1 do
  begin
    if Source[C] = OldPattern[1] then // Check first char before we waste a jump to CompareMem
    begin
      if CompareMem(@Source[C], @OldPattern[1], Helper) then
      begin
        Positions[FoundCount] := C; // Store the found position
        Inc(FoundCount);
        Inc(C, OldPatternLength - 1); // Jump to after OldPattern
      end;
    end;
    Inc(C);
  end;

  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 + FoundCount * (NewPatternLength - OldPatternLength));

    // Initialize some variables
    SourcePosition := 1;
    PSource := PWideChar(Source);
    PDest := PWideChar(Result);
    PNew := PWideChar(NewPattern);
    Helper := NewPatternLength * WideCharLength;

    // Replace...
    for C := 0 to FoundCount - 1 do
    begin
      // Copy original and advance resultpos
      Move(PSource^, PDest^, (Positions[C] - SourcePosition) * WideCharLength);
      Inc(PDest, Positions[C] - SourcePosition);

      // Append NewPattern and advance resultpos
      Move(PNew^, PDest^, Helper);
      Inc(PDest, NewPatternLength);

      // Jump to after OldPattern
      Inc(PSource, Positions[C] - SourcePosition + OldPatternLength);
      SourcePosition := Positions[C] + OldPatternLength;
    end;
    // Append characters after last OldPattern
    Move(PSource^, PDest^, (SourceLength - SourcePosition + 1) * WideCharLength);
  end else
    Result := Source; // Nothing to replace

  // Clean up
  Finalize(Positions);
end;

Bisher schneller als alles, was ich gefunden hab. Vermutlich kann das aber jemand noch verbessern (Freiwillige vor ).

Gruß
xaromz

//Edit: Kleinen Fehler beseitigt