Janilabo Posted August 31, 2012 Share Posted August 31, 2012 (edited) Here it is! Finally done. While working on this, I got around some little bugs that were left in Find(). So I fixed em aswell. Included test script. const TEXT = 'TestesTESTTestest test TEST Test Test.'; FIND_STR = 'test'; REPLACE_STR = '*'; type TMatchMethod = (mmAll, mmBackward, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW); TMatchMethods = set of TMatchMethod; function ReplaceEx2(Text, FindStr, ReplaceStr: string; Methods: TMatchMethods; Offset: Integer): string; var fsL, tL, i, c, e, t: Integer; rgx_fs, tmp: string; r: TRegexMatchArray; p: TIntArray; begin Result := Text; tL := Length(Text); fsL := Length(FindStr); if ((tL < 1) or (Length(FindStr) > tL) or (FindStr = '')) then Exit; if (Offset < 1) then Offset := 1; FindStr := PregQuote(FindStr); if (mmWholeWords in Methods) then begin if (mmStrictWW in Methods) then rgx_fs := '/(?<!\S)' + FindStr + '(?!\S)/' else rgx_fs := '/(^|\(?<=\s))' + FindStr + '((?=\s)|\$)/' end else rgx_fs := '/' + FindStr + '/'; if (mmIgnoreCase in Methods) then rgx_fs := (rgx_fs + 'i'); rgx_fs := (rgx_fs + 'm'); case (mmBackward in Methods) of True: begin Result := Copy(Text, 1, Offset); tmp := Result; SetLength(p, Length(tmp)); while PregMatchEx(rgx_fs, tmp, r) do begin p[c] := (r[0].Offset + c); Inc(c); Delete(tmp, r[0].Offset, 1); SetLength(r, 0); end; SetLength(p, c); TIAUnique(p); c := Length(p); InvertTIA(p); if (c > 0) then if not (mmAll in Methods) then begin Delete(Result, p[0], fsL); Insert(ReplaceStr, Result, p[0]); end else case (not (mmWholeWords in Methods) and (mmOverlap in Methods)) of True: for i := 0 to (c - 1) do begin e := fsL; if (i > 0) then if ((p[(i - 1)] - p[i]) <= fsL) then e := (p[(i - 1)] - p[i]); Delete(Result, p[i], e); Insert(ReplaceStr, Result, p[i]); end; False: begin e := 0; if (mmWholeWords in Methods) then e := 1; for i := 0 to (c - 1) do begin Inc(t); if (i > 0) then if ((p[(i - t)] - p[i]) < (fsL - e)) then Continue; Delete(Result, p[i], fsL); Insert(ReplaceStr, Result, p[i]); t := 0; end; end; end; Result := (Result + Copy(Text, (Offset + 1), (Length(Text) - Offset))); end; False: begin Result := Copy(Text, Offset, ((tL - Offset) + 1)); case (mmAll in Methods) of True: begin if (not (mmWholeWords in Methods) and (mmOverlap in Methods)) then begin tmp := Result; SetLength(p, Length(tmp)); while PregMatchEx(rgx_fs, tmp, r) do begin p[c] := (r[0].Offset + c); Inc(c); Delete(tmp, r[0].Offset, 1); SetLength(r, 0); end; SetLength(p, c); TIAUnique(p); c := Length(p); for i := (c - 1) downto 0 do begin e := fsL; if (i < (c - 1)) then if ((p[(i + 1)] - p[i]) <= fsL) then e := (p[(i + 1)] - p[i]); Delete(Result, p[i], e); Insert(ReplaceStr, Result, p[i]); end; end else Result := PregReplace(rgx_fs, ReplaceStr, Result); 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; end; SetLength(p, 0); tmp := ''; end; var rTEXT: string; l, i, s, o: Integer; m_sets: array of TMatchMethods; TSA: TStrArray; procedure BuildSets(find_method: (fmBackward, fmForward)); begin case find_method of fmForward: begin TSA := ['[]', '[mmIgnoreCase]', '[mmIgnoreCase, mmAll]', '[mmIgnoreCase, mmAll, mmOverlap]', '[mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]', '[mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]']; l := Length(FIND_STR); o := 1; s := High(TSA); SetLength(m_sets, (s + 1)); m_sets[0] := []; m_sets[1] := [mmIgnoreCase]; m_sets[2] := [mmIgnoreCase, mmAll]; m_sets[3] := [mmIgnoreCase, mmAll, mmOverlap]; m_sets[4] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]; m_sets[5] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]; end; fmBackward: begin TSA := ['[mmBackward]', '[mmBackward, mmIgnoreCase]', '[mmBackward, mmIgnoreCase, mmAll]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]']; l := Length(FIND_STR); o := Length(TEXT); s := High(TSA); SetLength(m_sets, (s + 1)); m_sets[0] := [mmBackward]; m_sets[1] := [mmBackward, mmIgnoreCase]; m_sets[2] := [mmBackward, mmIgnoreCase, mmAll]; m_sets[3] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap]; m_sets[4] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]; m_sets[5] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]; end; end; end; begin ClearDebug; BuildSets(fmForward); WriteLn('FORWARD:'); for i := 0 to s do begin rTEXT := ReplaceEx2(TEXT, FIND_STR, REPLACE_STR, m_sets[i], o); WriteLn('ReplaceEx2(''' + TEXT + ''', ''' + FIND_STR + ''', ''' + REPLACE_STR + ''', ' + TSA[i] + ', ' + IntToStr(o) + ')'); WriteLn('TEXT: ' + rTEXT); if (i < s) then WriteLn(''); end; BuildSets(fmBackward); WriteLn('BACKWARD:'); for i := 0 to s do begin rTEXT := ReplaceEx2(TEXT, FIND_STR, REPLACE_STR, m_sets[i], o); WriteLn('ReplaceEx2(''' + TEXT + ''', ''' + FIND_STR + ''', ''' + REPLACE_STR + ''', ' + TSA[i] + ', ' + IntToStr(o) + ')'); WriteLn('TEXT: ' + rTEXT); if (i < s) then WriteLn(''); end; SetLength(m_sets, 0); SetLength(TSA, 0); end. Edited August 31, 2012 by Janilabo Fixes. Quote Link to comment Share on other sites More sharing options...
Bixby Sayz Posted August 31, 2012 Share Posted August 31, 2012 I love seeing creativity like this. Quote Link to comment Share on other sites More sharing options...