Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Mar 18, 2000

InstrWordEx - Find a whole word, with your choice of delimiters

'------------------------------------------------------------------------
' This enum is used by both InstrWordEx and ReplaceWordEx
'
' It uses a binary value to determine what separator characters are allowed
' bit 0 = allow spaces
' bit 1 = allow symbols
' bit 2 = allow control chars
' bit 3 = allow digits
' If all are excluded (ie a value of 0) then this means char must match a 
' special separator provided by caller

Enum sepType
    specialSep = 0                  'binary 0000 = words are ONLY separated by 
                                    ' a specified separator
    spacesOnly = 1                  'binary 0001 = words must be separated By 
                                    ' spaces
    spacesAndSymbols = 3            'binary 0011 = words must be separated By 
                                    ' spaces Or symbols
    spacesSymbolsAndCtrl = 7        'binary 0111 = words are separated by 
                                    ' spaces, symbols or ctrl chars
    spacesSymbolsCtrlAndDigits = 15 'binary 1111 = words are separated by 
                                    ' anything but letters
End Enum

' Return the next occurrence of a whole word
'
' Based on InstrWord function from VB2TheMax - www.vb2themax.com
'
' Changes from VB2TheMax function were made by Peter Stubbs to allow 
' specification of
' what constitutes a separator between words
'
'---------------------------------------------------------------------------
'Contact Peter at stubbsy@hunterlink.net.au
' http://users.hunterlink.net.au/~dgps
'---------------------------------------------------------------------------
'
' Choices for separator are as described above for the sepType enum
'
' Examples:
' pos = InstrWordEx(1,"This is a string","is",vbTextCompare)
'   returns 6 in pos since there is a word "is" preceded and followed by a Space
'
' pos = InstrWordEx(1,"This-is-a-string","is",vbTextCompare)
'  returns 6 in pos since there is a word "is" preceded and followed by a symbol
'
' pos = InstrWordEx(1,"This-is-a-string","is",vbTextCompare,spacesOnly)
'   returns 0 in pos since there are no occurences of "is" preceded and 
' followed by a space
'
' pos = InstrWordEx(1,"This is a list of 310 things","31",vbTextCompare)
'  returns 19 in pos since the digits 31 are preceded by a space and followed 
' by a digit
'  which is, by default, considered a valid separator
'
' pos = InstrWordEx(1,"This is a list of 310 
' things","31",vbTextCompare,spacesAndSymbols)
'  returns 0 in pos since this specifies spaces and symbols (but not digits) 
' are valid separators
'
' pos = InstrWordEx(1,"This/is/a/string","is",vbTextCompare,specialSep,"/")
'   returns 6 in pos since the word "is" is both preceded and followed by /
'
Function InstrWordEx(Start As Long, Source As String, Find As String, _
    compareMethod As VbCompareMethod, Optional separatorType As sepType = _
    spacesSymbolsCtrlAndDigits, Optional Separator As String = vbNullString) As _
    Long
    Dim index As Long
    Dim charcode As Integer
    Dim separatorInvalid As Boolean

    ' assume the search fails
    InstrWordEx = 0

    index = Start - 1

    Do
        ' search the next occurrence, exit if not found
        index = InStr(index + 1, Source, Find, compareMethod)
        If index = 0 Then Exit Function

        If index > 1 Then
            charcode = Asc(UCase$(Mid$(Source, index - 1, 1)))
        Else
            charcode = 32
        End If

        ' check that it is preceded by a valid separator
        If IsValidChar(charcode, separatorType, Separator) Then
            ' check that it is followed by a valid separator
            charcode = Asc(UCase$(Mid$(Source, index + Len(Find), 1)) & " ")
            If IsValidChar(charcode, separatorType, Separator) Then
                InstrWordEx = index
                Exit Function
            End If
        End If
    Loop

End Function

'This function determines if the character value in char is an acceptable 
' separator of the
'type specified by separatorType

'The function is used by both InstrWordEx and ReplaceWordEx

Private Function IsValidChar(char As Integer, separatorType As sepType, _
    Separator As String)
    Dim charType As Integer

    'Ctrl are chars in charType 0-31
    'Spaces and symbols are chars in charType 32-47, 58-64 and 91-255
    'Digits are chars in charType 48-57

    If separatorType = specialSep Then
        IsValidChar = (char = Asc(UCase$(Separator)))
        Exit Function
    End If

    'Determine charType that char falls in
    Select Case char
         Case Is < 32 '0-32 = ctrl
            charType = 4 '0100 binary

         Case 32 'space
            charType = 1 '0001 binary

         Case Is < 48, Is > 90 '32-48 or 91-255 = symbols (first range)
            charType = 2 '0010 binary

         Case Is < 58 '48-57 = digits
            charType = 8 '1000 binary

         Case Is < 65 '58-64 = symbols (second range)
            charType = 2 '0010 binary

        Case Else 'it's a letter
            charType = 0 '0000 binary
    End Select

    IsValidChar = Not ((charType And separatorType) = 0)
End Function
Peter Stubbs
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date