Janilabo | ReplaceEx2()

const
  TEXT = '||| || |||| |||||';
  FIND_STR = '||';
  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 := '/(^|\b|(?<=\s))' + FindStr + '((?=\s)|\b|$)/'
  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.