![]() |
Mehrere Strings auf einmal ersetzen
xaromz hat
![]() ![]() Die Parameter sind eigentlich selbsterklärend. ;)
Delphi-Quellcode:
Der Code würde als praktische Ergänzung zu
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; ![]() |
Re: Mehrere Strings auf einmal ersetzen
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:
Gruß
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; xaromz |
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:54 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz