function Pos(const SubStr, Str: UnicodeString; Offset: Integer): Integer; overload;
var
  I, LIterCnt, L, J: Integer;
  PSubStr, PS: PChar;
  LCh: Char;
begin
  PSubStr := Pointer(SubStr);
  PS := Pointer(Str);
  if (PSubStr = nil) or (PS = nil) or (Offset < 1) then
    Exit(0);
  L := __StringLength(SubStr);
  { Calculate the number of possible iterations. }
  LIterCnt := __StringLength(Str) - Offset - L + 2;
  if (L > 0) and (LIterCnt > 0) then
  begin
    Inc(PS, Offset - 1);
    I := 0;
    LCh := PSubStr[0];
    if L = 1 then   // Special case when Substring length is 1
      repeat
        if PS[I] = LCh then
          Exit(I + Offset);
        Inc(I);
      until I = LIterCnt
    else
      repeat
        if PS[I] = LCh then
        begin
          J := 1;
          repeat
            if PS[I + J] = PSubStr[J] then
            begin
              Inc(J);
              if J = L then
                Exit(I + Offset);
            end
            else
              Break;
          until False;
        end;
        Inc(I);
      until I = LIterCnt;
  end;

  Result := 0;
end;

function StringReplace(const Source, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
  Str: string;
  xOldPattern: string;
  FoundPos: Integer;
  I, J: Integer;
  SourceIdx: Integer;
  DestIdx: Integer;
  LCharsToCopy: Integer;
  FindCount: Integer;
  PosArray: array of Integer;
  LenOP: Integer;
  LenNP: Integer;
  LenS: Integer;
  ArrLen: Integer;
  LPResult, LPSource, LPNewPattern: PChar;
  LReplaceAll: Boolean;
begin
  LenOP := Length(OldPattern);
  LenS := Length(Source);
  if (LenOP = 0) or (LenS = 0) then
    Exit(Source);

  if rfIgnoreCase in Flags then
  begin
    xOldPattern := AnsiUpperCase(OldPattern);
    LenOP := Length(xOldPattern);
    if SameStr(xOldPattern, AnsiLowerCase(OldPattern)) then // Special case, for example only symbols (+ - , * .....)
      Str := Source
    else
    begin
      Str := AnsiUpperCase(Source);
      LenS := Length(Str);
    end;
  end
  else
  begin
    xOldPattern := OldPattern;
    Str := Source;
  end;

  if Str.Length <> Source.Length then
  begin
    Result := '';
    I := Low(string);
    while I <= High(Source) do
    begin
      if string.Compare(Source, I - Low(string), OldPattern, 0, LenOP, True) = 0 then
      begin
        Result := Result + NewPattern;
        Inc(I, LenOP);
        if not (rfReplaceAll in Flags) then
        begin
          Result := Result + Source.Substring(I - Low(string), MaxInt);
          Break;
        end;
      end
      else
      begin
        Result := Result + Source[I];
        Inc(I);
      end;
    end;
  end
  else
  begin
    FoundPos := 1;
    FindCount := 0;
    ArrLen := 0;
    LReplaceAll := not (rfReplaceAll in Flags);
    repeat
      FoundPos := Pos(xOldPattern, Str, FoundPos);
      if FoundPos = 0 then
        Break;

      Inc(FindCount);
      if ArrLen < FindCount then
      begin
        if ArrLen = 0 then
          ArrLen := 32
        else
          ArrLen := ArrLen * 2;
        SetLength(PosArray, ArrLen);   // call SetLength less frequently makes a huge difference when replacing multiple occurrences
      end;
      PosArray[FindCount - 1] := FoundPos - 1; // Zero based array
      Inc(FoundPos, LenOP);
    until LReplaceAll;

    if FindCount > 0 then
    begin
      LenNP := Length(NewPattern);
      LPSource := Pointer(Source);           // We use a pointer cast to avoid the _UStrToPWChar call injected by the compiler
      LPNewPattern := Pointer(NewPattern);  // We use a pointer cast to avoid the _UStrToPWChar call injected by the compiler
      if LenNP = LenOP then
      begin                           // special case where Length(OldPattern) = Length(NewPattern)
        SetLength(Result, LenS);      // in this case, we can optimize it even further
        LPResult := Pointer(Result);    // We use a pointer cast to avoid the uniquestring call injected by the compiler
        Move(LPSource^, LPResult^, LenS * SizeOf(Char));
        if LenNP = 1 then
          for I := 0 to FindCount - 1 do
            LPResult[PosArray[I]] := LPNewPattern^
        else if LenNP <= 8 then
          for I := 0 to FindCount - 1 do
            for J := 0 to LenNP -1  do
              LPResult[PosArray[I] + J] := LPNewPattern[J]
        else
          for I := 0 to FindCount - 1 do
            Move(LPNewPattern^, LPResult[PosArray[I]], LenNP * SizeOf(Char));
      end
      else
      begin
        SetLength(Result, LenS + ((LenNP - LenOP) * FindCount));
        LPResult := Pointer(Result);    // We use a pointer cast to avoid the uniquestring call injected by the compiler
        SourceIdx := 0;
        DestIdx := 0;
        if LenNP = 0 then
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            Inc(SourceIdx, LenOP);
          end
        else if LenNP = 1 then
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            LPResult[DestIdx] := LPNewPattern[0];
            Inc(DestIdx);
            Inc(SourceIdx, LenOP);
          end
        else
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            Move(LPNewPattern^, LPResult[DestIdx], LenNP * SizeOf(Char));
            Inc(DestIdx, LenNP);
            Inc(SourceIdx, LenOP);
          end;

        LCharsToCopy := LenS - SourceIdx;
        if LCharsToCopy > 0 then
          Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
      end;
    end
    else
      Result := Source;
  end;
end;

   repeat
        if PS[I] = LCh then
        begin
          J := 1;
          repeat
            if PS[I + J] = PSubStr[J] then
            begin
              Inc(J);
              if J = L then
                Exit(I + Offset);
            end
            else
              Break;
          until False;
        end;
        Inc(I);
      until I = LIterCnt;

  repeat
      j := Pos('  ',S);
      if j > 0 then S := StringReplace(S,'  ',' ',[rfReplaceAll]);
    until j = 0;