ReplaceEx

[Janilabo]

[scar]type

TReplaceFlag = (rfReplaceAll, rfIgnoreCase);

TReplaceFlags = set of TReplaceFlag;

 

function ReplaceEx(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags; Offset: Integer): string;

var

i, tL, f: Integer;

rgx_fs, tmp: string;

m: TStrArray;

r: TRegexMatchArray;

begin

Result := Text;

tL := Length(Text);

if ((tL < 1) or (Offset > tL) or (FindStr = ReplaceStr) or (Length(FindStr) > tL)) then

Exit;

Result := Copy(Text, Offset, ((tL - Offset) + 1));

if (Offset < 1) then

Offset := 1;

rgx_fs := '/' + PregQuote(FindStr) + '/';

if (rfIgnoreCase in Flags) then

rgx_fs := (rgx_fs + 'i');

rgx_fs := (rgx_fs + 'm');

case (rfReplaceAll in Flags) of

True:

begin

tmp := Result;

SetLength(m, Round(tL div Length(FindStr)));

while PregMatchEx(rgx_fs, tmp, r) do

begin

tmp := Replace(tmp, r[0].MatchedText, '');

m[f] := r[0].MatchedText;

SetLength(r, 0);

Inc(f);

end;

if (f > 0) then

for i := 0 to (f - 1) do

Result := Replace(Result, m, ReplaceStr);

SetLength(m, 0);

end;

False:

if PregMatchEx(rgx_fs, Result, r) then

begin

Result := (Copy(Result, 1, (r[0].Offset - 1)) + ReplaceStr + Copy(Result, (r[0].Offset + r[0].Length), (Length(Result) - (r[0].Offset + r[0].Length) + 1)));

SetLength(r, 0);

end;

end;

Result := (Copy(Text, 1, (Offset - 1)) + Result);

end;

 

var

str: string;

 

begin

ClearDebug;

str := 'Testing testing TESTing ... Testing, TESTing!';

WriteLn(ReplaceEx(str, 'Test', 'Tast', [rfReplaceAll], 2));

WriteLn(ReplaceEx(str, 'Test', 'Tast', [rfIgnoreCase, rfReplaceAll], 2));

WriteLn(ReplaceEx(str, 'Test', 'Tast', [rfIgnoreCase], 2));

WriteLn(ReplaceEx(str, 'Test', 'Tast', [], 2));

end.[/scar]

Edited September 13, 2012 by Janilabo
Fixed an infinite loop bug.

[MarkD]

The SCAR version of string.replace, nice!

[Janilabo]

Thanks MarkD.