Fast replace$() function

[mdijkens]

What is flawed?
My point posting this was performance with big strings...
This is veery slow with big strings

Here all 3 compared:

Code: (Select All)

$Console:Only

Const SIZE = 2000000



txt$ = String$(SIZE, 0)

For p& = 1 To SIZE

  Asc(txt$, p&) = 32 + p& Mod 96

Next p&



t! = Timer(.001#)

result$ = replace$(txt$, "A", "Hello")

Print Using "      replace$: ##.### seconds"; Timer(.001#) - t!



t! = Timer(.001#)

result$ = mreplace$(txt$, "A", "Hello")

Print Using "     mreplace$: ##.### seconds"; Timer(.001#) - t!



t! = Timer(.001#)

ReplaceString3 txt$, "A", "Hello", 0

result$ = mreplace$(txt$, "A", "Hello")

Print Using "ReplaceString3: ##.### seconds"; Timer(.001#) - t!



End





Function replace$ (content$, from$, to$)

  content2$ = content$

  flen& = Len(from$): tlen& = Len(to$)

  p& = InStr(content2$, from$)

  If flen& = Len(to$) Then

    Do While p& > 0

      Mid$(content2$, p&, flen&) = to$

      p& = InStr(p& + tlen&, content2$, from$)

    Loop

  Else

    Do While p& > 0

      content2$ = Left$(content2$, p& - 1) + to$ + Mid$(content2$, p& + flen&)

      p& = InStr(p& + tlen&, content2$, from$)

    Loop

  End If

  replace$ = content2$

End Function





Function mreplace$ (content$, from$, to$)

  Dim mp As Long, pp As Long, m As _MEM

  m = _MemNew(Len(content$) * 2): mp = 0: pp = 1

  flen& = Len(from$): tlen& = Len(to$)

  p& = InStr(content$, from$)

  Do While p& > 0

    _MemPut m, m.OFFSET + mp, Mid$(content$, pp, p& - pp): mp = mp + p& - pp

    _MemPut m, m.OFFSET + mp, to$: mp = mp + tlen&: pp = p& + flen&

    p& = InStr(p& + flen&, content$, from$)

  Loop

  _MemPut m, m.OFFSET + mp, Mid$(content$, pp): mp = mp + Len(Mid$(content$, pp))

  content2$ = String$(mp, 0): _MemGet m, m.OFFSET, content2$: _MemFree m

  mreplace$ = content2$

End Function



Sub ReplaceString3 (tx As String, sfind As String, repl As String, numtimes As _Unsigned Long)

  Dim As String s, t, searc, replac

  Dim As _Unsigned Long ls, count, u, j

  Dim As _Byte goahead

  If (tx = "") Or (sfind = "") Or (sfind = repl) Or (Len(sfind) > Len(tx)) Then Exit Sub

  For j = 1 To 2

    If j = 1 Then

      searc = sfind

      replac = Chr$(255)

    Else

      searc = Chr$(255)

      replac = repl

    End If

    s = UCase$(searc)

    t = UCase$(tx)

    ls = Len(s)

    count = 0

    goahead = 1

    Do

      u = InStr(t, s)

      If u > 0 Then

        tx = Left$(tx, u - 1) + replac + Mid$(tx, u + ls)

        t = UCase$(tx)

        If numtimes > 0 Then count = count + 1: If count >= numtimes Then goahead = 0

      Else

        goahead = 0

      End If

    Loop While goahead

  Next

End Sub