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

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


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

WEBINAR:

On-Demand

Application Security Testing: An Integral Part of DevOps


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
×
We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.
Thanks for your registration, follow us on our social networks to keep up-to-date