Janilabo | StrMultiReplace[2]

type
  TReplaceFlag = (rfReplaceAll, rfIgnoreCase);
  TReplaceFlags = set of TReplaceFlag;
  TMatchMethod = (mmAll, mmBackward, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW);
  TMatchMethods = set of TMatchMethod;
  TMultiReplace = record
    oldStr, newStr: string;
    offset: Integer;
    replaceFlags: TReplaceFlags;
  end;
  TMultiReplaceArray = array of TMultiReplace;
  TMultiReplace2 = record
    oldStr, newStr: string;
    offset: Integer;
    matchMethods: TMatchMethods;
  end;
  TMultiReplaceArray2 = array of TMultiReplace2;

function MultiReplace(oldStr, newStr: string; offset: Integer; replaceFlags: TReplaceFlags): TMultiReplace;
begin
  Result.oldStr := oldStr;
  Result.newStr := newStr;
  Result.offset := offset;
  Result.replaceFlags := replaceFlags;
end;

function MultiReplace2(oldStr, newStr: string; offset: Integer; matchMethods: TMatchMethods): TMultiReplace2;
begin
  Result.oldStr := oldStr;
  Result.newStr := newStr;
  Result.offset := offset;
  Result.matchMethods := matchMethods;
end;

function StrMultiReplace(Text: string; MRA: TMultiReplaceArray): string;
var
  h, i, x, tL, f: Integer;
  rgx_fs, tmp: string;
  m: TStrArray;
  r: TRegexMatchArray;
begin
  h := High(MRA);
  tL := Length(Text);
  if ((h < 0) or (tL < 1)) then
    Exit;
  for i := 0 to h do
    if ((MRA[i].oldStr <> '') and (tL > MRA[i].offset) and (tL >= Length(MRA[i].oldStr)))  then
    begin
      Result := Copy(Text, MRA[i].offset, ((tL - MRA[i].offset) + 1));
      if (MRA[i].offset < 1) then
        MRA[i].offset := 1;
      rgx_fs := '/' + PregQuote(MRA[i].oldStr) + '/';
      if (rfIgnoreCase in MRA[i].replaceFlags) then
        rgx_fs := (rgx_fs + 'i');
      rgx_fs := (rgx_fs + 'm');
      case (rfReplaceAll in MRA[i].replaceFlags) of
        True:
        begin
          tmp := Result;
          f := 0;
          SetLength(m, Round(tL div Length(MRA[i].oldStr)));
          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 x := 0 to (f - 1) do
              Result := Replace(Result, m[x], MRA[i].newStr);
          SetLength(m, 0);
        end;
        False:
        if PregMatchEx(rgx_fs, Result, r) then
        begin
          Result := (Copy(Result, 1, (r[0].Offset - 1)) + MRA[i].newStr + 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, (MRA[i].offset - 1)) + Result);
      Text := Result;
    end;
end;

function StrMultiReplace2(Text: string; MRA2: TMultiReplaceArray2): string;
var
  fsL, tL, h, i, c, e, t, x: Integer;
  rgx_fs, tmp: string;
  r: TRegexMatchArray;
  p: TIntArray;
begin
  Result := Text;
  h := High(MRA2);
  if ((h < 0) or (Text = '')) then
    Exit;
  for i := 0 to h do
  begin
    tL := Length(Text);
    fsL := Length(MRA2[i].oldStr);
    if ((tL < 1) or (Length(MRA2[i].oldStr) > tL) or (MRA2[i].oldStr = '')) then
      Exit;
    if (MRA2[i].offset < 1) then
      MRA2[i].offset := 1;
    MRA2[i].oldStr := PregQuote(MRA2[i].oldStr);
    if (mmWholeWords in MRA2[i].matchMethods) then
    begin
      if (mmStrictWW in MRA2[i].matchMethods) then
        rgx_fs := '/(?<!\S)' + MRA2[i].oldStr + '(?!\S)/'
      else
        rgx_fs := '/(^|\b|(?<=\s))' + MRA2[i].oldStr + '((?=\s)|\b|$)/'
    end else
      rgx_fs := '/' + MRA2[i].oldStr + '/';
    if (mmIgnoreCase in MRA2[i].matchMethods) then
      rgx_fs := (rgx_fs + 'i');
    rgx_fs := (rgx_fs + 'm');
    case (mmBackward in MRA2[i].matchMethods) of
      True:
      begin
        Result := Copy(Text, 1, MRA2[i].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 MRA2[i].matchMethods) then
          begin
            Delete(Result, p[0], fsL);
            Insert(MRA2[i].newStr, Result, p[0]);
          end else
          case (not (mmWholeWords in MRA2[i].matchMethods) and (mmOverlap in MRA2[i].matchMethods)) of
            True:
            for x := 0 to (c - 1) do
            begin
              e := fsL;
              if (x > 0) then
                if ((p[(x - 1)] - p[x]) <= fsL) then
                  e := (p[(x - 1)] - p[x]);
              Delete(Result, p[x], e);
              Insert(MRA2[i].newStr, Result, p[x]);
            end;
            False:
            begin
              e := 0;
              if (mmWholeWords in MRA2[i].matchMethods) then
                e := 1;
              for x := 0 to (c - 1) do
              begin
                Inc(t);
                if (x > 0) then
                  if ((p[(x - t)] - p[x]) < (fsL - e)) then
                    Continue;
                Delete(Result, p[x], fsL);
                Insert(MRA2[i].newStr, Result, p[x]);
                t := 0;
              end;
            end;
          end;
        Result := (Result + Copy(Text, (MRA2[i].offset + 1), (Length(Text) - MRA2[i].offset)));
      end;
      False:
      begin
        Result := Copy(Text, MRA2[i].offset, ((tL - MRA2[i].offset) + 1));
        case (mmAll in MRA2[i].matchMethods) of
          True:
          begin
            if (not (mmWholeWords in MRA2[i].matchMethods) and (mmOverlap in MRA2[i].matchMethods)) 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 x := (c - 1) downto 0 do
              begin
                e := fsL;
                if (x < (c - 1)) then
                  if ((p[(x + 1)] - p[x]) <= fsL) then
                    e := (p[(x + 1)] - p[x]);
                Delete(Result, p[x], e);
                Insert(MRA2[i].newStr, Result, p[x]);
              end;
            end else
              Result := PregReplace(rgx_fs, MRA2[i].newStr, Result);
          end;
          False:
          if PregMatchEx(rgx_fs, Result, r) then
          begin
            Result := (Copy(Result, 1, (r[0].Offset - 1)) + MRA2[i].newStr + 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, (MRA2[i].offset - 1)) + Result);
      end;
    end;
    SetLength(p, 0);
    tmp := '';
    Text := Result;
  end;
end;

var
  TEXT, TEXT2: String;
  MRA: TMultiReplaceArray;
  MRA2: TMultiReplaceArray2;

begin
  ClearDebug;
  TEXT := 'Janilabo was here.. Right? Well, janilabo is a NEWBIE for REAL.';
  MRA := [MultiReplace('Janilabo', 'Newbie', 1, [rfReplaceAll, rfIgnoreCase]), MultiReplace('Newbie', 'Master', 1, [rfReplaceAll])];
  TEXT2 := StrMultiReplace(TEXT, MRA);
  WriteLn(TEXT2);
  SetLength(MRA, 0);
  MRA2 := [MultiReplace2('Janilabo', 'Newbie', 1, [mmAll, mmIgnoreCase]), MultiReplace2('Newbie', 'Master', 1, [mmAll])];
  TEXT2 := StrMultiReplace2(TEXT, MRA2);
  WriteLn(TEXT2);
  SetLength(MRA2, 0);
end.