function SubStrs(const Text: String; const Ptrn:String): TIntegerArray;
var
  hits,maxhits,h,i: Integer;
begin
  MaxHits := Length(Ptrn);
  Hits := 1;
  h := 0;
  for i:=1 to Length(Text) do
  begin
    if Text[i] = Ptrn[Hits] then
    begin
      Inc(Hits);
      if (Hits >= MaxHits) then
      begin
        SetLength(Result, h+1);
        Result[h] := (i - Hits) + 1;
        Inc(h);
        Hits := 1;
      end;
    end else
      Hits := 1;
  end;
end;


function StrReplace(Text, Ptrn, Rep: String): String;
var
  Hi,HiPtrn,HiRep,i,j,k: Integer;
  Prev,Curr:Integer;
  Subs: TIntegerArray;
begin
  Hi := Length(Text);
  if Hi = 0 then Exit;

  Subs := SubStrs(Text, Ptrn);

  if Length(Subs) = 0 then
    Exit(Copy(Text, 1,Hi));

  HiRep := Length(Rep);
  HiPtrn := Length(Ptrn);

  SetLength(Result, Hi + (Length(Subs) * (HiRep-HiPtrn)));
  k := 1;
  Prev := 1;
  for i:=0 to High(Subs) do
  begin
    Curr := Subs[i];
    for j:=Prev to Curr do
    begin
      Result[k] := Text[j];
      Inc(k);
    end;
    for j:=1 to HiRep do
    begin
      Result[k] := Rep[j];
      Inc(k);
    end;
    Prev := Curr + HiPtrn + 1;
  end;

  //Last remaining part:
  for i:=Prev to Hi do
  begin
    Result[k] := Text[i];
    Inc(k);
  end;
  SetLength(Result, k);
end;

function StrReplace2(text, findStr, replaceStr: string; flags: TReplaceFlags): string;
var
  i, p, c, l, z, q: Integer;
  s, o: string;
  f: Boolean;
  t: Char;
begin
  l := Length(text);
  z := Length(findStr);
  if ((l > 0) and (z > 0) and (findStr <> replaceStr)) then
  begin
    Result := '';
    s := text;
    o := findStr;
    if (rfIgnoreCase in flags) then
    begin
      s := LowerCase(s);
      o := LowerCase(o);
    end;
    i := 1;
    c := 0;
    if (z = 1) then
      t := o[1];
    if (rfReplaceAll in flags) then
    begin
      if not (z = 1) then
      begin
        begin
          q := i;
          repeat
            for p := 1 to z do
            begin
              f := (s[((i + p) - 1)] = o[p]);
              if not f then
                Break;
            end;
            if f then
            begin
              if (c > 0) then
                Result := (Result + Copy(text, q, c));
              Result := (Result + replaceStr);
              i := ((i + z) - 1);
              q := (i + 1);
              c := 0;
            end else
              c := (c + 1);
            i := (i + 1);
          until (i > l);
          if (c > 0) then
            Result := (Result + Copy(text, q, c));
        end;
      end else
        begin
          q := i;
          repeat
            if (s[((i + p) - 1)] = t) then
            begin
              if (c > 0) then
                Result := (Result + Copy(text, q, c));
              Result := (Result + replaceStr);
              i := ((i + z) - 1);
              q := (i + 1);
              c := 0;
            end else
              c := (c + 1);
            i := (i + 1);
          until (i > l);
          if (c > 0) then
            Result := (Result + Copy(text, q, c));
        end;
    end else
    begin
      if not (z = 1) then
      begin
        begin
          repeat
            for p := 1 to z do
            begin
              f := (s[((i + p) - 1)] = o[p]);
              if not f then
                Break;
            end;
            i := (i + 1);
          until (f or (i > l));
          if f then
          begin
            i := (i - 1);
            if (i > 1) then
              Result := (Result + Copy(text, 1, (i - 1)));
            Result := (Result + replaceStr);
            i := (i + z);
            if not (i > l) then
              Result := (Result + Copy(text, i, ((l - i) + 1)));
          end else
            Result := text;
        end;
      end else
      begin
        begin
          repeat
            f := (s[((i + p) - 1)] = t);
            i := (i + 1);
          until (f or (i > l));
          if f then
          begin
            begin
              i := (i - 1);
              if (i > 1) then
                Result := (Result + Copy(text, 1, (i - 1)));
              Result := (Result + replaceStr);
              i := (i + z);
              if not (i > l) then
                Result := (Result + Copy(text, i, ((l - i) + 1)));
            end;
          end else
            Result := text;
        end;
      end;
    end;
  end else
    Result := text;
end;

var
  str: string;
  Text:String;
  i, t: Integer;

begin
  Text := 'this is a | this is a |this is a|';
  for i := 0 to 15 do
    Text := (Text + Text);
  t := GetTimeRunning;
  str := StrReplace(Text, 'i', '|');
  WriteLn('StrReplace took ' + IntToStr(GetTimeRunning - t) + ' ms.');
  WriteLn(MD5(str));
  str := '';
  t := GetTimeRunning;
  str := StrReplace2(Text, 'i', '|', [rfReplaceAll]);
  WriteLn('StrReplace2 took ' + IntToStr(GetTimeRunning - t) + ' ms.');
  WriteLn(MD5(str));
  str := '';
  t := GetTimeRunning;
  str := Replace(Text, 'i', '|', [rfReplaceAll]);
  WriteLn('Replace took ' + IntToStr(GetTimeRunning - t) + ' ms.');
  WriteLn(MD5(str));
end.