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


ReplaceWordEx - Replace whole words, with your choice of delimiters

Option Explicit

'------------------------------------------------------------------------
' 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

' Replace a whole word
'
' Based on ReplaceWord function from VB2TheMax - www.vb2themax.com
'
' Changes from VB2TheMax function were made 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
'

Function ReplaceWordEx(Source As String, Find As String, ReplaceStr As String, _
    Optional ByVal Start As Long = 1, Optional Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare, _
    Optional separatorType As sepType = spacesSymbolsCtrlAndDigits, _
    Optional Separator As String = vbNullString) As String
    Dim findLen As Long
    Dim replaceLen As Long
    Dim index As Long
    Dim counter As Long
    Dim charcode As Integer
    Dim replaceIt As Boolean

    findLen = Len(Find)
    replaceLen = Len(ReplaceStr)

    ' this prevents an endless loop
    If findLen = 0 Then Err.Raise 5

    If Start < 1 Then Start = 1
    index = Start

    ' let's start by assigning the source to the result
    ReplaceWordEx = Source

    Do
        index = InStr(index, ReplaceWordEx, Find, Compare)
        If index = 0 Then Exit Do

        replaceIt = False
        ' check that it is preceded by a punctuation symbol
        If index > 1 Then
            charcode = Asc(UCase$(Mid$(ReplaceWordEx, 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$(ReplaceWordEx, index + Len(Find), _
                1)) & " ")
            If IsValidChar(charcode, separatorType, Separator) Then
                ' do the replacement
                ReplaceWordEx = Left$(ReplaceWordEx, index - 1) & ReplaceStr & _
                    Mid$(ReplaceWordEx, index + findLen)
                ' skip over the string just added
                index = index + replaceLen
                ' increment the replacement counter
                counter = counter + 1
            End If
        Else
            ' skip over this false match
            index = index + findLen
        End If

        ' Note that the Loop Until test will always fail if Count = -1
    Loop Until counter = Count

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