Website Design United States, Website Design California, Website Designing United States, Website Designing California

Replace VB's Replace - Visual Basic 6

This code blows VB's Replace$ away while staying 100%
call and behavior compatible. Even if you use VB6 you should still
use this in place of VB's Replace$ - it is 3 - 4 times faster!

Public Function Replace(sSrc As String, _
sTerm As String, _
sNewTerm As String, _
Optional lStart As Long = 1, _
Optional lHitCnt As Long, _
Optional ByVal lCompare As _
VbCompareMethod = vbBinaryCompare _
) As String ' ©Rd

Dim lSize As Long, lHit As Long, lHitPos As Long, lPos As Long
Dim lLenOrig As Long, lOffset As Long, lOffStart As Long
Dim lLenOld As Long, lLenNew As Long, lCnt As Long
Dim s1 As String, s2 As String, al() As Long

'On Error GoTo FreakOut

lLenOrig = Len(sSrc)
If (lLenOrig = 0) Then Exit Function ' No text

lLenOld = Len(sTerm): lLenNew = Len(sNewTerm)
Replace = sSrc
If (lLenOld = 0) Then Exit Function

If lCompare = vbBinaryCompare Then
s1 = sTerm: s2 = sSrc
Else
s1 = LCase$(sTerm): s2 = LCase$(sSrc)
End If

lOffset = lLenNew - lLenOld
lCnt = 0: lSize = 8000 ' lSize = Arr chunk size
ReDim al(0 To lSize) As Long

lHit = InStr(lStart, s2, s1)
Do While (lHit <> 0) And (lHit <= lLenOrig)
al(lCnt) = lHit: lCnt = lCnt + 1
If (lCnt = lHitCnt) Then Exit Do
If (lCnt = lSize) Then
lSize = lSize + 8000
ReDim Preserve al(0 To lSize) As Long
End If
lOffStart = lHit + lLenOld ' offset start pos
lHit = InStr(lOffStart, s2, s1)
Loop

If (lCnt = 0) Then GoTo FreakOut ' No hits
lHitCnt = lCnt
If lCompare = vbBinaryCompare Then
If StrComp(s1, sNewTerm) = 0 Then Exit Function
End If

lSize = (lLenOrig + lOffset * lCnt) ' lSize = result str size
Replace = Space$(lSize)

lCnt = lCnt - 1: lOffStart = 1: lPos = 1
For lHit = 0 To lCnt
lHitPos = al(lHit)
Mid$(Replace, lOffStart) = Mid$(sSrc, lPos, lHitPos - lPos)
lOffStart = lHitPos + (lOffset * lHit)
If (lLenNew <> 0) Then
Mid$(Replace, lOffStart) = sNewTerm
lOffStart = lOffStart + lLenNew
End If
lPos = lHitPos + lLenOld ' No offset orig str
Next

If lOffStart <= lSize Then
Mid$(Replace, lOffStart) = Mid$(sSrc, lPos)
End If
'lHitCnt = lHit
FreakOut:
End Function ' Rd - cryptic but crazy :)


WEB DESIGN INDIA
42 B Malviya Nagar , New Delhi-110017

Skype: manmeetsi
Email: support.webdesignindia@gmail.com
Tel: 91-011-40502005, 9810067295

 















 


© 2008-2009 dotnet4all.com