article

MultiInStr (Update Nov 7, 2009)

Email
Submitted on: 2/19/2015 10:52:00 PM
By: Rde (from psc cd)  
Level: Intermediate
User Rating: By 3 Users
Compatibility: VB 4.0 (32-bit), VB 5.0, VB 6.0
Views: 872
 
     This is an improvement on the MultiInStr function that appears in other peoples code now and again ... I don't know who the original author was, so I hope who-ever you are you don't mind ... The original code would search through a string looking for occurences of single characters, while this pair of functions search for single-or-multi character terms within the given string ... Included are MultiInStr and MultiInStrR functions ... Hope someone finds them useful ... Update 25 May - improved versions added thanks to contributions from Kenneth Buckmaster ... Update 7 Nov - Reset string len bug fix in Ken's MultiInStr ... Happy coding


 
				

 
 '---------------------------------
 
 ' Simple MultiInStr:
 ' Always returns 'their' before 'heir'
 ' but returns either 'the' or 'their' depending on
 ' which term was found first in sTerms array order
 
Function MultiInStr(sSrc As String, sTerms() As String, _
                    Optional ByVal lStart As Long = 1, _
                    Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
                    Optional ByVal lRightLimit As Long = -1, _
                    Optional ByRef lHitItemIndex As Long) As Long
  Dim iPos As Long
  Dim iHit As Long
  Dim iIdx As Long
 
  If lRightLimit = -1 Then lRightLimit = Len(sSrc)
  iHit = Len(sSrc) + 1
 
  For iIdx = LBound(sTerms) To UBound(sTerms)
     iPos = InStr(lStart, sSrc, sTerms(iIdx), eCompare)
     If iPos Then
        If iPos < iHit Then iHit = iPos: lHitItemIndex = iIdx
     End If
  Next
 
  If iHit < Len(sSrc) + 1 Then MultiInStr = iHit
 
End Function
 
 '---------------------------------
 
 ' Comment From: Kenneth Buckmaster
 ' It occurred to me that you could avoid searching the
 ' whole string length after a term is found
 
 ' Also added something you might want in these functions -
 ' returns 'the' before 'their' when in the same location
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                   (pDest As Any, pSrc As Any, ByVal lLenB As Long)
 
Function MultiInStr(sSrc As String, sTerms() As String, _
                    Optional ByVal lStart As Long = 1, _
                    Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
                    Optional ByVal lRightLimit As Long = -1, _
                    Optional ByRef lHitItemIndex As Long)
As Long ' Kenneth Buckmaster
  Dim iPos As Long
  Dim iHit As Long
  Dim iIdx As Long
 
  Dim spointer As Long
  Dim slenb As Long
  Dim biggestlen As Long
  Dim newsearchlen As Long
 
  Dim bHit As Boolean
 
  slenb = LenB(sSrc)
  spointer = StrPtr(sSrc) - 4&
 
  For iIdx = LBound(sTerms) To UBound(sTerms)
     If LenB(sTerms(iIdx)) > biggestlen Then biggestlen = LenB(sTerms(iIdx))
  Next
 
  If lRightLimit = -1 Then lRightLimit = Len(sSrc)
  iHit = Len(sSrc) + 1
 
  For iIdx = LBound(sTerms) To UBound(sTerms)
     iPos = InStr(lStart, sSrc, sTerms(iIdx), eCompare)
 
     If iPos Then
        If iPos < iHit Then
            bHit = True
        ElseIf iPos = iHit Then
            bHit = LenB(sTerms(iIdx)) < LenB(sTerms(lHitItemIndex))
        End If
 
        If bHit Then
            iHit = iPos
            lHitItemIndex = iIdx
            newsearchlen = iHit + iHit + biggestlen
            If newsearchlen < slenb Then
                CopyMemory ByVal spointer, newsearchlen, 4&
            End If
            bHit = False
        End If
     End If
  Next
 
  CopyMemory ByVal spointer, slenb, 4&
 
  If iHit < Len(sSrc) + 1 Then MultiInStr = iHit
 
End Function
 
 '---------------------------------
 
 ' Simple MultiInStrR:
 ' Returns 'heir' before 'their' for reverse search
 ' but returns either 'the' or 'their' depending on
 ' which term was found first in sTerms array order
 
Function MultiInStrR(sSrc As String, sTerms() As String, _
                     Optional ByVal lRightStart As Long = -1, _
                     Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
                     Optional ByVal lLeftLimit As Long = 1, _
                     Optional ByRef lHitItemIndex As Long)
As Long
  Dim iLast As Long
  Dim iPos As Long
  Dim iHit As Long
  Dim iIdx As Long
 
  If lRightStart = -1 Then lRightStart = Len(sSrc)
 
  For iIdx = LBound(sTerms) To UBound(sTerms)
     iPos = InStr(lLeftLimit, sSrc, sTerms(iIdx), eCompare)
 
     Do Until iPos = 0 Or iPos > lRightStart
        iLast = iPos
        iPos = InStr(iLast + 1, sSrc, sTerms(iIdx), eCompare)
     Loop
 
     If iLast > iHit Then
        iHit = iLast
        lHitItemIndex = iIdx
        lLeftLimit = iLast
        iLast = 0
     End If
  Next
 
  If iHit Then MultiInStrR = iHit
 
End Function
 
 '---------------------------------
 
 ' Comment From: Kenneth Buckmaster
 ' Always returns 'heir' before 'their' for reverse search
 ' Always returns 'their' before 'the' for reverse search
 
Function MultiInStrR(sSrc As String, sTerms() As String, _
                     Optional ByVal lRightStart As Long = -1, _
                     Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
                     Optional ByVal lLeftLimit As Long = 1, _
                     Optional ByRef lHitItemIndex As Long)
As Long ' Kenneth Buckmaster
  Dim iLast As Long
  Dim iPos As Long
  Dim iHit As Long
  Dim iIdx As Long
 
  Dim bHit As Boolean
 
  If lRightStart = -1 Then lRightStart = Len(sSrc)
 
  For iIdx = LBound(sTerms) To UBound(sTerms)
     iPos = InStr(lLeftLimit, sSrc, sTerms(iIdx), eCompare)
 
     Do Until iPos = 0 Or iPos > lRightStart
        iLast = iPos
        iPos = InStr(iLast + 1, sSrc, sTerms(iIdx), eCompare)
     Loop
 
     If iLast > iHit Then
        bHit = True
     ElseIf iLast = iHit Then
        bHit = LenB(sTerms(iIdx)) > LenB(sTerms(lHitItemIndex))
     End If
 
     If bHit Then
        iHit = iLast
        lHitItemIndex = iIdx
        lLeftLimit = iLast
        iLast = 0
        bHit = False
     End If
  Next
 
  If iHit Then MultiInStrR = iHit
 
End Function
 
 


Other 30 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this article (in the Intermediate category)?
(The article with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular article, please click here instead.)
 

To post feedback, first please login.