Public Function Replace01(Expression As String, _
    sOld As String, _
    sNew As String, _
    Optional ByVal Start As Long = 1, _
    Optional Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As String

' by Donald, donald@xbeat.net, 20000918
  Dim cntReplace As Long
  Dim lenOld As Long
  Dim lenNew As Long
  
  Replace01 = Expression
  lenOld = Len(sOld)
  
  If lenOld Then
    lenNew = Len(sNew)
    ' silently correct illegal Start value
    If Start < 1 Then
      Start = 1
    End If
    Do Until cntReplace = Count
      Start = InStr(Start, Replace01, sOld, Compare)
      If Start Then
        ' replace
        Replace01 = Left$(Replace01, Start - 1) & sNew & Mid$(Replace01, Start + lenOld)
        cntReplace = cntReplace + 1
        ' next pos
        Start = Start + lenNew
      Else
        Exit Do
      End If
    Loop
  End If
  
End Function

Public Function Replace02(Expression As String, _
    sOld As String, _
    sNew As String, _
    Optional ByVal Start As Long = 1, _
    Optional Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As String

' by Donald, donald@xbeat.net, 20000918
  Dim cntReplace As Long
  Dim lenOld As Long
  Dim lenNew As Long
  
  Replace02 = Expression
  lenOld = Len(sOld)
  
  If lenOld Then
    ' silently correct illegal Start value
    If Start < 1 Then
      Start = 1
    End If
    ' fixed value to fast var
    lenNew = Len(sNew)
    
    If lenOld = lenNew Then
      ' can use faster replace algorithm
      Do Until cntReplace = Count
        Start = InStr(Start, Replace02, sOld, Compare)
        If Start Then
          ' replace
          Mid$(Replace02, Start) = sNew
          cntReplace = cntReplace + 1
          ' next pos
          Start = Start + lenNew
        Else
          Exit Do
        End If
      Loop
    
    Else
      Do Until cntReplace = Count
        Start = InStr(Start, Replace02, sOld, Compare)
        If Start Then
          ' replace
          Replace02 = Left$(Replace02, Start - 1) & sNew & Mid$(Replace02, Start + lenOld)
          cntReplace = cntReplace + 1
          ' next pos
          Start = Start + lenNew
        Else
          Exit Do
        End If
      Loop
    End If
  End If
  
End Function

Public Function Replace03(Expression As String, _
    sOld As String, _
    sNew As String, _
    Optional ByVal Start As Long = 1, _
    Optional Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As String

' by Donald, donald@xbeat.net, 20000918
  Dim cntReplace As Long
  Dim lenOld As Long
  Dim lenNew As Long
  Dim StartPrev As Long
  Dim posReplace As Long
  
  lenOld = Len(sOld)
  
  If lenOld Then
    ' silently correct illegal Start value
    If Start < 1 Then
      Start = 1
    End If
    ' fixed value to fast var
    lenNew = Len(sNew)
    
    If lenOld = lenNew Then
      ' can use faster replace algorithm
      Replace03 = Expression
      Do Until cntReplace = Count
        Start = InStr(Start, Replace03, sOld, Compare)
        If Start Then
          ' replace
          Mid$(Replace03, Start) = sNew
          cntReplace = cntReplace + 1
          ' next pos
          Start = Start + lenNew
        Else
          Exit Do
        End If
      Loop
    
    Else
      If lenNew Then
        ' make space for largest possible return
        ' Crashes when the resulting string is too large!
        Replace03 = Space$(Len(Expression) * lenNew)
      Else
        Replace03 = Space$(Len(Expression))
      End If
      StartPrev = 1
      posReplace = 1
      Do Until cntReplace = Count
        Start = InStr(Start, Expression, sOld, Compare)
        If Start Then
          ' replace: insert using fast Mid$ statement
          Mid$(Replace03, posReplace) = Mid$(Expression, StartPrev, Start - StartPrev)
          Mid$(Replace03, posReplace + (Start - StartPrev)) = sNew
          ' next pos in Replace
          posReplace = posReplace + (Start - StartPrev) + lenNew
          ' next search pos in Expression
          Start = Start + lenOld
          ' store
          StartPrev = Start
          ' count
          cntReplace = cntReplace + 1
        Else
          Exit Do
        End If
      Loop
      ' trim unused target buffer and add source remainder
      Replace03 = Left$(Replace03, posReplace - 1) & Mid$(Expression, StartPrev)
    End If
  Else
    Replace03 = Expression
  End If
  
End Function

Public Function Replace04(sExpression As String, _
                          sOld As String, _
                          sNew As String, _
           Optional ByVal lStart As Long = 1, _
                 Optional lCount As Long = -1, _
                 Optional lCompare As VbCompareMethod = vbBinaryCompare) As String

' by Donald, donald@xbeat.net, 20000918
' modified by Keith, kmatzen@ispchannel.com
 
   Dim lNumReplaced As Long
   Dim lLenOld      As Long
   Dim lLenNew      As Long
   Dim lPosExpr     As Long
   Dim lPosRepl     As Long
   Dim lStrLen      As Long
   Dim lLenExpr     As Long
   
   lLenOld = Len(sOld)
   
   If lLenOld Then
      ' silently correct illegal lStart value
      If lStart < 1 Then
         lStart = 1
      End If
      ' fixed value to fast var
      lLenNew = Len(sNew)
      
      If lLenOld = lLenNew Then
      
         ' can use faster replace algorithm
         Replace04 = sExpression
         Do Until lNumReplaced = lCount
            lStart = InStr(lStart, Replace04, sOld, lCompare)
            If lStart Then
               ' replace
               Mid$(Replace04, lStart) = sNew
               lStart = lStart + lLenNew   ' next pos
               lNumReplaced = lNumReplaced + 1
            Else
               Exit Do
            End If
         Loop
     
      Else
      
         lLenExpr = Len(sExpression)
         If lLenNew > lLenOld Then
            ' make space for largest possible return
            ' Save memory for case when lLenOld <> 1
            ' Crashes when the resulting string is too large!
            Replace04 = Space$(lLenExpr + (lLenExpr \ lLenOld) * (lLenNew - lLenOld))
         Else
            Replace04 = sExpression
         End If
         
         lPosExpr = 1
         lPosRepl = 1
         Do Until lNumReplaced = lCount
            lStart = InStr(lStart, sExpression, sOld, lCompare)
            If lStart Then
               ' replace: insert using fast Mid$ statement
               lStrLen = lStart - lPosExpr
               Mid$(Replace04, lPosRepl) = Mid$(sExpression, lPosExpr, lStrLen)
               lPosRepl = lPosRepl + lStrLen
               Mid$(Replace04, lPosRepl) = sNew
               ' next pos in Replace
               lPosRepl = lPosRepl + lLenNew
               ' next search pos in sExpression
               lStart = lStart + lLenOld
               ' store
               lPosExpr = lStart
               ' lCount
               lNumReplaced = lNumReplaced + 1
            Else
               Exit Do
            End If
         Loop
         If lPosExpr <= lLenExpr Then
            Mid$(Replace04, lPosRepl) = Mid$(sExpression, lPosExpr)
         End If
         
         ' trim unused target buffer
         Replace04 = Left$(Replace04, lLenExpr + lPosRepl - lPosExpr)
         
      End If
      
   Else
   
      Replace04 = sExpression
      
   End If
  
End Function

Public Static Function Replace05( _
    ByRef Text As String, _
    ByRef sOld As String, _
    ByRef sNew As String, _
    Optional ByVal Start As Long = 1, _
    Optional ByVal Count As Long = 2147483647, _
    Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
  ) As String
' by Jost Schwider, jost@schwider.de, 20001124
  
  Dim OldLen As Long
  Dim NewLen As Long
  Dim TextLen As Long
  Dim CopyLen As Long
  Dim SourcePos As Long
  Dim BufferPos As Long
  Dim BufferPosNew As Long
  Dim BufferPosNext As Long
  Dim Buffer As String
  Dim BufferLen As Long
  
  OldLen = Len(sOld)
  If OldLen Then
  
    'Ersten Treffer bestimmen:
    Start = InStr(Start, Text, sOld, Compare)
    If Start Then
    
      NewLen = Len(sNew)
      If OldLen <> NewLen Then
        'Unterschiedliche Länge, also "basteln":
        
        SourcePos = 1
        BufferPos = 1
        For Count = 1 To Count
          'Einfüge-Positionen bestimmen:
          CopyLen = Start - SourcePos
          BufferPosNew = BufferPos + CopyLen
          BufferPosNext = BufferPosNew + NewLen
          
          'Ggf. Buffer vergrößern:
          If BufferPosNext > BufferLen Then
            Buffer = Buffer & Space$(BufferPosNext)
            BufferLen = Len(Buffer)
          End If
          
          'Ggf. Übersprungendes kopieren:
          If CopyLen Then _
              Mid$(Buffer, BufferPos) = Mid$(Text, SourcePos, CopyLen)
          
          'Einzufügenden String kopieren:
          Mid$(Buffer, BufferPosNew) = sNew
          BufferPos = BufferPosNext
          
          'Nächsten Treffer suchen:
          SourcePos = Start + OldLen
          Start = InStr(SourcePos, Text, sOld, Compare)
          If Start = 0 Then Exit For
        Next Count
        
        'Passenden Buffer-Ausschnitt zurückgeben:
        TextLen = Len(Text)
        If SourcePos <= TextLen Then 'Rest kopieren:
          BufferPosNext = TextLen - SourcePos + BufferPos
          
          'Ggf. Buffer vergrößern:
          If BufferPosNext > BufferLen Then
            Buffer = Buffer & Space$(BufferPosNext)
            BufferLen = Len(Buffer)
          End If
          
          Mid$(Buffer, BufferPos) = Mid$(Text, SourcePos)
          Replace05 = Left$(Buffer, BufferPosNext)
          Exit Function
        Else
          Replace05 = Left$(Buffer, BufferPos - 1)
          Exit Function
        End If
      
      Else
        'Gleiche Länge, also einfach überschreiben:
        
        Replace05 = Text
        For Count = 1 To Count
          Mid$(Replace05, Start) = sNew
          Start = InStr(Start + OldLen, Replace05, sOld, Compare)
          If Start = 0 Then Exit Function
        Next Count
        Exit Function
      
      End If
    
    Else 'Kein Treffer:
      Replace05 = Text
      Exit Function
    End If
  
  Else 'Suchstring ist leer:
    Replace05 = Text
    Exit Function
  End If

End Function

Public Function Replace06( _
    Expression As String, _
    sOld As String, _
    sNew As String, _
    Optional ByVal Start As Long = 1, _
    Optional ByVal Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As String
' by Donald, donald@xbeat.net, 20001201 (rev 002)
' partly based on Replace05 by Jost Schwider

  Dim cntReplace As Long
  Dim lenOld As Long
  Dim lenNew As Long
  Dim lenCopy As Long
  Dim posSource As Long
  Dim posTarget As Long
  
  lenOld = Len(sOld)
  If lenOld Then
    
    ' get first match
    Start = InStr(Start, Expression, sOld, Compare)
    If Start Then
    
      ' set Count to "+inf" to get them all
      If Count < 0 Then Count = &H7FFFFFFF
      
      lenNew = Len(sNew)
      If lenOld = lenNew Then
        ' easy: simply overwrite Old with New
        Replace06 = Expression
        For Count = 1 To Count
          ' replace
          Mid$(Replace06, Start) = sNew
          ' find next
          Start = InStr(Start + lenOld, Expression, sOld, Compare)
          If Start = 0 Then Exit Function
        Next
      
      Else
        ' not so easy: gotta rebuild target from scratch
        '
        ' determine the number of actual replacements
        ' and calculate exact space needed for returned string
        posSource = Start
        For Count = 1 To Count
          cntReplace = cntReplace + 1
          ' find next
          posSource = InStr(posSource + lenOld, Expression, sOld, Compare)
          If posSource = 0 Then Exit For
        Next
        ' allocate space
        Replace06 = Space$(Len(Expression) + cntReplace * (lenNew - lenOld))
        '
        ' do the rebuild
        posSource = 1
        posTarget = 1
        For cntReplace = 1 To cntReplace
          lenCopy = Start - posSource
          ' insert source
          If lenCopy Then
            Mid$(Replace06, posTarget) = Mid$(Expression, posSource, lenCopy)
          End If
          ' insert new
          If lenNew Then
            Mid$(Replace06, posTarget + lenCopy) = sNew
          End If
          ' next pos in target
          posTarget = posTarget + lenCopy + lenNew
          ' find next
          posSource = Start + lenOld
          Start = InStr(posSource, Expression, sOld, Compare)
        Next
        ' insert source remainder
        If posTarget <= Len(Replace06) Then
          Mid$(Replace06, posTarget) = Mid$(Expression, posSource)
        End If
      End If
    
    Else
      ' no match
      Replace06 = Expression
    End If
  
  Else
    ' find string is zero-length
    Replace06 = Expression
  End If
  
End Function

Private Declare Function VarPtrArray& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)
Private Declare Sub RtlZeroMemory Lib "kernel32" (dst As Any, ByVal nBytes&)

Public Function Replace07( _
                        Text$, _
                        OldString$, _
                        NewString$, _
                        Optional ByVal Start& = 1, _
                        Optional ByVal Count& = -1, _
                        Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
                        ) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20001207

    Dim iLenOld&, iLenNew&, iLenDst&
    Dim pSrc&, pDst&, ccSrc&, ccDst&, c&
    Dim iAsc1%, iAsc2%, SA As BStrAPI.SAFEARRAY1D, aiResult%()
    
    If Start <= 0 Then Start = 1
    Start = InStr(Start, Text, OldString, Compare)
    If Start Then
        If Count < 0 Then Count = &H7FFFFFFF
        iLenNew = Len(NewString)
        iLenOld = Len(OldString)
        
        Select Case iLenOld
        Case 0
            Replace07 = Text
        Case iLenNew
            Replace07 = Text
            If iLenNew <= 2 Then
                SA.cDims = 1:           SA.pvData = StrPtr(Replace07)
                SA.lLbound1D = 1:       SA.cElements1D = &H7FFFFFFF ' Len(Text)
                SA.cbElements = 2
                pSrc = VarPtrArray(aiResult)
                RtlMoveMemory ByVal pSrc, VarPtr(SA), 4
                If iLenNew = 1 Then
                    iAsc1 = AscW(NewString)
                    Do
                        aiResult(Start) = iAsc1
                        Start = InStr(Start + 1, Text, OldString, Compare)
                        Count = Count - 1
                    Loop Until (Start = 0) Or (Count = 0)
                Else
                    RtlMoveMemory iAsc1, ByVal StrPtr(NewString), 2
                    RtlMoveMemory iAsc2, ByVal StrPtr(NewString) + 2, 2
                    Do
                        aiResult(Start) = iAsc1
                        aiResult(Start + 1) = iAsc2
                        Start = InStr(Start + 2, Text, OldString, Compare)
                        Count = Count - 1
                    Loop Until (Start = 0) Or (Count = 0)
                    
                End If
                RtlZeroMemory ByVal pSrc, 4
            Else
                Do
                    Mid$(Replace07, Start, iLenNew) = NewString
                    Start = InStr(Start + iLenOld, Text, OldString, Compare)
                    Count = Count - 1
                Loop Until (Start = 0) Or (Count = 0)
            End If
        Case Else 'ilenNew <> iLenOld
            
            ccSrc = Start
            Do
                ccSrc = InStr(ccSrc + iLenOld, Text, OldString, Compare)
                c = c + 1
            Loop Until (ccSrc = 0) Or (Count = c)
          
            iLenDst = Len(Text) + (iLenNew - iLenOld) * c
            Replace07 = BStrAPI.SysAllocStringLen(vbNullString, iLenDst)
            
            pSrc = StrPtr(Text) - 2
            pDst = StrPtr(Replace07) - 2
            
            ccSrc = 1
            
            If iLenNew Then
                ccDst = 1
                Do
                    Count = Start - ccSrc
                    If Count Then
                        RtlMoveMemory ByVal pDst + ccDst + ccDst, _
                                      ByVal pSrc + ccSrc + ccSrc, Count + Count
                        ccDst = ccDst + Count
                    End If
                    
                    Mid$(Replace07, ccDst, iLenNew) = NewString
                    ccDst = ccDst + iLenNew
                    
                    ccSrc = Start + iLenOld
                    Start = InStr(ccSrc, Text, OldString, Compare)
                    c = c - 1
                Loop Until c = 0
                Count = iLenDst - (ccDst - 1)
                If Count > 0 Then
                    RtlMoveMemory ByVal pDst + ccDst + ccDst, _
                                  ByVal pSrc + ccSrc + ccSrc, Count + Count
                End If
            Else
                ccDst = 2
                Do
                    Count = (Start - ccSrc) * 2
                    If Count Then
                        RtlMoveMemory ByVal pDst + ccDst, _
                                      ByVal pSrc + ccSrc + ccSrc, Count
                        ccDst = ccDst + Count
                    End If
                    ccSrc = Start + iLenOld
                    Start = InStr(ccSrc, Text, OldString, Compare)
                    c = c - 1
                Loop Until c = 0
                Count = iLenDst * 2 - (ccDst - 2)
                If Count > 0 Then
                    RtlMoveMemory ByVal pDst + ccDst, _
                                  ByVal pSrc + ccSrc + ccSrc, Count
                End If
            End If
        End Select
    Else
        Replace07 = Text
    End If
End Function