' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' Copyright 2011 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File: M017_String
' Originator: Allen Baker (2011.03.07 23:06)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit
' ========================================================================================================================
' Description
' This module provides procedures that supplement the String type.
'
' Here is a good reference on the String type: http://www.aivosto.com/vbtips/stringopt.html
' It describes performance optimizations as well as the various built-in String constants
' ========================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Constants ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Module Variables ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[ Public Routines ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function counts the number of instances of a substring within a string
'
' return
' this function returns the number of instances of the substring within the string
'
' param
' pStr is the string to search
' param
' pSubstr is the substring to search for and count
' -----------------------------------------------------------------------------------------------------------
Public Function substrCount(ByVal pStr As String, ByVal pSubstr As String) As Long
Dim x As Integer
For x = 1 To Len(pStr)
If Mid(pStr, x, Len(pSubstr)) = pSubstr Then
substrCount = substrCount + 1
End If
Next x
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function prepends and appends blanks in equal quantities to pStr until the resulting String is
' pFieldSize characters long. In other words, it centers pStr in a field that is pFieldSize characters long
' with blankss filling out the left and right of the field.
'
' return
' A new String that is equivalent to pStr but with the leading and trailing characters added.
'
' param
' pStr is the String that will be centered.
' param
' pFieldSize is the size of resulting String including its prepended and appended characters.
' -----------------------------------------------------------------------------------------------------------
Public Function centerString(ByVal pStr As String, ByVal pFieldSize As Long) As String
Dim padSize As Long
If (Len(pStr) >= pFieldSize) Then
centerString = pStr
Else
padSize = Int((pFieldSize - Len(pStr)) / 2)
centerString = Space(padSize) & pStr & Space(pFieldSize - Len(pStr) - padSize)
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a substring is contained within a string.
'
' return
' this function returns TRUE if pStringSearched contains the substring pStringSought. Otherwise, it
' returns FALSE.
'
' param
' pStringSearched is the string being searched.
' param
' pStringSought is the substring being searched for.
' -----------------------------------------------------------------------------------------------------------
Public Function containsSubstring(ByVal pStringSearched As String, ByVal pStringSought As String) As Boolean
containsSubstring = (InStr(pStringSearched, pStringSought) > 0)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a substring is contained within a string while ignoring case.
'
' return
' this function returns TRUE if pStringSearched contains the substring pStringSought. Otherwise, it
' returns FALSE.
'
' param
' pStringSearched is the string being searched.
' param
' pStringSought is the substring being searched for.
' -----------------------------------------------------------------------------------------------------------
Public Function containsSubstringNoCase(ByVal pStringSearched As String, ByVal pStringSought As String) As Boolean
containsSubstringNoCase = (InStr(UCase(pStringSearched), UCase(pStringSought)) > 0)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a string starts with a substring.
'
' return
' this function returns TRUE if pStringToSearchIn starts with the substring pStringToSearchFor.
' Otherwise, it returns FALSE.
'
' param
' pStringToSearchIn is the string being searched.
' param
' pStringToSearchFor is the substring being searched for.
' param (optional)
' pCompareMethod specifies whether or not the search is case-sensitive. For a case-sensitive search, use
' vbBinaryCompare as the argument. For a case-insensitive search use vbTextCompare as the argument. If
' you do not pass an argument in through this parameter, it will default to vbBinaryCompare and your
' result will be from a case-sensitive search.
' -----------------------------------------------------------------------------------------------------------
Public Function startsWith _
( _
ByVal pStringToSearchIn As String, _
ByRef pStringToSearchFor As String, _
Optional ByVal pCompareMethod As VbCompareMethod = vbBinaryCompare _
) _
As Boolean
Dim substring As String
Dim length As Long
startsWith = False
length = Len(pStringToSearchFor)
If length > Len(pStringToSearchIn) Then Exit Function
substring = Left(pStringToSearchIn, length)
startsWith = StrComp(substring, pStringToSearchFor, pCompareMethod) = 0
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a string starts with a substring wile ignoring case.
'
' return
' this function returns TRUE if pStringToSearchIn starts with the substring pStringToSearchFor.
' Otherwise, it returns FALSE.
'
' param
' pStringToSearchIn is the string being searched.
' param
' pStringToSearchFor is the substring being searched for.
' -----------------------------------------------------------------------------------------------------------
Public Function startsWithNoCase(ByVal pStringToSearchIn As String, ByRef pStringToSearchFor As String) As Boolean
startsWithNoCase = startsWith(pStringToSearchIn, pStringToSearchFor, vbTextCompare)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a string ends with a substring.
'
' return
' this function returns TRUE if pStringToSearchIn ends with the substring pStringToSearchFor.
' Otherwise, it returns FALSE.
'
' param
' pStringToSearchIn is the string being searched.
' param
' pStringToSearchFor is the substring being searched for.
' param (optional)
' pCompareMethod specifies whether or not the search is case-sensitive. For a case-sensitive search, use
' vbBinaryCompare as the argument. For a case-insensitive search use vbTextCompare as the argument. If
' you do not pass an argument in through this parameter, it will default to vbBinaryCompare and your
' result will be from a case-sensitive search.
' -----------------------------------------------------------------------------------------------------------
Public Function endsWith _
( _
ByVal pStringToSearchIn As String, _
ByRef pStringToSearchFor As String, _
Optional ByVal pCompareMethod As VbCompareMethod = vbBinaryCompare _
) _
As Boolean
Dim substring As String
Dim length As Long
endsWith = False
length = Len(pStringToSearchFor)
If length > Len(pStringToSearchIn) Then Exit Function
substring = Right(pStringToSearchIn, length)
endsWith = StrComp(substring, pStringToSearchFor, pCompareMethod) = 0
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a string ends with a substring wile ignoring case.
'
' return
' this function returns TRUE if pStringToSearchIn ends with the substring pStringToSearchFor.
' Otherwise, it returns FALSE.
'
' param
' pStringToSearchIn is the string being searched.
' param
' pStringToSearchFor is the substring being searched for.
' -----------------------------------------------------------------------------------------------------------
Public Function endsWithNoCase(ByVal pStringToSearchIn As String, ByRef pStringToSearchFor As String) As Boolean
endsWithNoCase = endsWith(pStringToSearchIn, pStringToSearchFor, vbTextCompare)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function strips away the portion of a string that comes before the beginning of the first occurrence
' of a specified substring. For example:
' stripLeftOfSubstring("1234", "2") returns "234"
' stripLeftOfSubstring("c:\pathName\tuna", ":") returns ":\pathName\tuna"
' stripLeftOfSubstring("c:\pathName\tuna", "\") returns "\pathName\tuna"
' stripLeftOfSubstring("c:\pathName\tuna", "\path") returns "hName\tuna"
'
' return
' this function returns TRUE if pStringToSearchIn contains the substring pStringToSearchFor. Otherwise, it
' returns FALSE.
'
' param
' pStringToSearchIn is the string being searched.
' param
' pStringToSearchFor is the substring being searched for.
' -----------------------------------------------------------------------------------------------------------
Public Function stripLeftOfSubstring(ByVal pStringToSearchIn As String, ByVal pStringToSearchFor As String) As String
Dim idx As Long
stripLeftOfSubstring = pStringToSearchIn
If (pStringToSearchFor = "") Then
Exit Function
End If
If (startsWith(pStringToSearchIn, pStringToSearchFor)) Then
Dim length As Long
length = Len(pStringToSearchIn)
stripLeftOfSubstring = Right(pStringToSearchIn, length - idx + 1)
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function tokenizes a string by separating it into parts delimited by pDelimiters and returning the
' parts in an array. It is an alias for Split().
'
' return
' This function returns a zero-based, one-dimensional array containing a specified number of substrings
'
' param
' pString is the String that will be tokenized.
' param
' pDelimiters is an Optional String character used to identify substring limits. If omitted, the space
' character (" ") is assumed to be the delimiter. If delimiter is a zero-length string, a single-element
' array containing the entire expression string is returned.
' -----------------------------------------------------------------------------------------------------------
Public Function tokenizedString _
( _
ByVal pString As String, _
Optional ByVal pDelimiters As String = " ", _
Optional ByVal pAllowConsecutiveDelimiters As Boolean = False, _
Optional ByVal pLimit As Integer = -1, _
Optional ByVal pCompare As Integer = vbBinaryCompare _
) _
As String()
Dim ConsecutiveDelimiters As String
'
' ==============================================================================================
' if pDelimiters is 0 or 1, then the normal split function is used as is.
' ----------------------------------------------------------------------------------------------
If (Len(pDelimiters) <= 1) Then
If (Len(pDelimiters) = 1) Then
'
' ==============================================================================================
' If the caller doesn't want consecutive delimiters to result in empty strings being included
' in the returned array, replace all consecutive sequences of the delimiter character with one
' instance of the delimiter character.
' ----------------------------------------------------------------------------------------------
If (Not pAllowConsecutiveDelimiters) Then
pString = dedupCharacters(pString, pDelimiters)
End If
End If
' ==============================================================================================
' parse the string and we're done
' ----------------------------------------------------------------------------------------------
tokenizedString = Split(pString, pDelimiters)
'
' ==============================================================================================
' otherwise, multiple delimiter characters are included in pDelimiters. In that case, pick the
' first delimiter character and convert all the other delimiter characters in pString to the
' first delimiter character.
' ----------------------------------------------------------------------------------------------
Else
Dim intIndex As Integer
Dim firstDelimiter As String
Dim nextDelimiter As String
firstDelimiter = Mid(pDelimiters, 1, 1)
' ==============================================================================================
' Filter all specified characters from the string.
' ----------------------------------------------------------------------------------------------
For intIndex = 2 To Len(pDelimiters)
nextDelimiter = Mid(pDelimiters, intIndex, 1)
If (nextDelimiter <> firstDelimiter) Then
pString = Replace(pString, nextDelimiter, firstDelimiter)
End If
Next intIndex
' ==============================================================================================
' now there is only one kind of delimiter character in pString. If the caller doesn't want
' consecutive delimiters to result in empty strings being included in the returned array,
' replace all consecutive sequences of the delimiter character with one instance of the
' delimiter character.
' ----------------------------------------------------------------------------------------------
If (Not pAllowConsecutiveDelimiters) Then
pString = dedupCharacters(pString, pDelimiters)
End If
' ==============================================================================================
' parse the string and we're done
' ----------------------------------------------------------------------------------------------
tokenizedString = Split(pString, pDelimiters)
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function removes consecutive repititions of specific characters from a String. Illustrating by
' example: if the String "abb cdeeeebgg" is passed in as pString and the user wants to remove repititions of
' the character "b" the user would pass the string "b" as the pCharactersToRemove parameter and the function
' would return the String "ab cdeeeebgg". If the user could remove all the repeating "b"s, "e"'s and "g"'s
' by passing "beg" as the pCharactersToRemove parameter. The function would return the String "ab cdebg".
'
' return
' This function returns a copy of pString with all the repeating characters specified by
' PCharactersToRemove removed.
'
' param
' pString is the String that will have repeating characters removed.
' param
' pCharactersToRemove is an Optional String containing all the characters that the user wants repeating
' instances of removed from pString. If omitted, the space character (" ") is assumed to be the character
' to remove all repeating instances of. If pCharactersToRemove is a zero-length string, pString is simply
' returned.
' -----------------------------------------------------------------------------------------------------------
Public Function dedupCharacters(ByVal pString As String, Optional ByVal pCharactersToRemove As String = " ") As String
Dim ConsecutiveChars As String
If (Len(pCharactersToRemove) > 0) Then
Dim char As String
Dim charIdx As Long
For charIdx = 1 To Len(pCharactersToRemove)
char = Mid(pCharactersToRemove, charIdx, 1)
ConsecutiveChars = char & char
Do While InStr(pString, ConsecutiveChars)
pString = Replace(pString, ConsecutiveChars, char)
Loop
Next charIdx
End If
dedupCharacters = pString
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function trims all instances of the substring pTrim from the beginning of pString.
'
' return
' This function returns a copy of pString with all instances of the substring pTrim removed from the
' beginning.
'
' param
' pString is the String that will be trimmed
' param
' pTrim is an Optional String containing the character sequence that this function will remove all
' instances of from the beginning of pString. If omitted, the space character (" ") is assumed to be the
' string to remove all instances of from the beginning of pString. If pTrim is a zero-length string,
' pString is simply returned.
' -----------------------------------------------------------------------------------------------------------
Public Function trimLeftSubstring(ByVal pString As String, Optional ByVal pTrim As String = " ") As String
If (Len(pTrim) > 0) Then
Do While startsWith(pString, pTrim)
pString = Mid(pString, Len(pTrim) + 1, Len(pString) - Len(pTrim))
Loop
End If
trimLeftSubstring = pString
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function trims all instances of the substring pTrim from the ending of pString.
'
' return
' This function returns a copy of pString with all instances of the substring pTrim removed from the
' ending.
'
' param
' pString is the String that will be trimmed
' param
' pTrim is an Optional String containing the character sequence that this function will remove all
' instances of from the ending of pString. If omitted, the space character (" ") is assumed to be the
' string to remove all instances of from the ending of pString. If pTrim is a zero-length string, pString
' is simply returned.
' -----------------------------------------------------------------------------------------------------------
Public Function trimRightSubstring(ByVal pString As String, Optional ByVal pTrim As String = " ") As String
If (Len(pTrim) > 0) Then
Do While endsWith(pString, pTrim)
pString = Mid(pString, 1, Len(pString) - Len(pTrim))
Loop
End If
trimRightSubstring = pString
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function trims all instances of the substring pTrim from the beginning and ending of pString.
'
' return
' This function returns a copy of pString with all instances of the substring pTrim removed from the
' beginning and ending.
'
' param
' pString is the String that will be trimmed
' param
' pTrim is an Optional String containing the character sequence that this function will remove all
' instances of from the beginning and ending of pString. If omitted, the space character (" ") is assumed
' to be the string to remove all instances of from the beginning and ending of pString. If pTrim is a
' zero-length string, pString is simply returned.
' -----------------------------------------------------------------------------------------------------------
Public Function trimSubstring(ByVal pString As String, Optional ByVal pTrim As String = " ") As String
pString = trimLeftSubstring(pString, pTrim)
pString = trimRightSubstring(pString, pTrim)
trimSubstring = pString
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function compares two Strings, ignoring the case of their characters.
'
' return
' This function returns True if the two Strings are equal, otherwise it returns False.
'
' param
' pString1 is the String to compare to pString2
' param
' pString2 is the String to compare to pString1
' -----------------------------------------------------------------------------------------------------------
Public Function equalsNoCase(ByVal pString1 As String, ByVal pString2 As String) As Boolean
equalsNoCase = (UCase(pString1) = UCase(pString2))
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a zero-based array containing all the words in pString. pDelimiters is used to
' determine how pString is broken up into sepatrate words.
'
' return
' This function returns a zero-based array containing all the words in pString
'
' param
' pString is the String to parse out the words from
' param
' pDelimiters is and optional String containing the set of characters that delimit words in pString. If
' omitted, this set of characters " .!?,;:""'()[]{}" is used to delimit the words in pString.
' -----------------------------------------------------------------------------------------------------------
Public Function getWords(ByVal pString As String, Optional ByVal pDelimiters As String = " .!?,;:""'()[]{}") As String()
getWords = tokenizedString(pString, pDelimiters)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function capitalizes the first letter and sets all other letters a lower case for each word in
' pString and returns the result.
'
' return
' This function returns a copy of pString with the first letter of every word capitalized and all other
' letters lower cased.
'
' param
' pString is the String to capitalize
' param
' pDelimiters is and optional String containing the set of characters that delimit words in pString. If
' omitted, the blank character " " is used to delimit the words in pString.
' -----------------------------------------------------------------------------------------------------------
Public Function startCase(ByVal pString As String, Optional ByVal pDelimiters As String = " ") As String
Dim words() As String
Dim i As Long
startCase = ""
words = getWords(LCase(pString), pDelimiters)
For i = 0 To UBound(words)
If (Len(words(i)) > 0) Then
If (Len(words(i)) = 1) Then
words(i) = UCase(words(i))
Else
words(i) = UCase(Mid(words(i), 1, 1)) & Mid(words(i), 2, Len(words(i)) - 1)
End If
End If
Next i
For i = 0 To UBound(words)
startCase = startCase & words(i)
If (i < UBound(words)) Then startCase = startCase & " "
Next i
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a String containing a single character, specifically, the character located at
' position pPosition within pString.
' For example: if pString is "ab5c3d1e4f2ghi" and pPosition is 3, then this function will return "5".
' index: 12345678901234
'
' return
' this function returns a String containing the single character at position pPosition within pString.
' If pPosition is greater than Len(PString) then this function returns the empty string ""
'
' param
' pString is the string to return a single specified character from.
' param
' pPosition is the index of the character within pString that is returned.
' -----------------------------------------------------------------------------------------------------------
Public Function characterAt(pString As String, pPosition As Long) As String
characterAt = Mid(pString, pPosition, 1)
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a String containing a copy of pString with the single character at position
' pPosition removed.
' For example: if pString is "ab5c3d1e4f2ghi" and pPosition is 3, then this function will return
' "abc3d1e4f2ghi".
' index: 12345678901234
'
' return
' this function returns a String containing a copy of pString with the single character at position
' pPosition removed.
'
' param
' pString is the string to remove a character from.
' param
' pPosition is the index of the character within pString to remove.
' -----------------------------------------------------------------------------------------------------------
Public Function deleteCharacterAt(pString As String, pPosition As Long) As String
If ((pPosition < 1) Or (pPosition > Len(pString))) Then
deleteCharacterAt = pString
Else
deleteCharacterAt = Mid(pString, 1, pPosition - 1) & Mid(pString, pPosition + 1, Len(pString) - pPosition)
End If
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a String containing a sorted copy of pString
' For example: if pString is "ab5c3d1e4f2ghi", then this function will return "12345abcdefghi".
'
' return
' this function returns a String containing a sorted copy of pString.
'
' param
' pString is the string to sort.
' -----------------------------------------------------------------------------------------------------------
Public Function sortedString(pString As String) As String
Dim idx As Long
Dim min As Long
Dim stringToSort As String
stringToSort = pString
sortedString = ""
While Len(stringToSort) > 0
min = 1
For idx = 2 To Len(stringToSort)
If Mid(stringToSort, idx, 1) < Mid(stringToSort, min, 1) Then
min = idx
End If
Next idx
sortedString = sortedString & Mid(stringToSort, min, 1)
stringToSort = deleteCharacterAt(stringToSort, min)
Wend
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function searches pString for each character in pCharacterSetString and replaces each one it finds in
' pString with pReplacement
' For example: if pString is "ab5c3d1e4f2ghi" and pCharacterSetString is "12345" and pReplacement is
' ":-", then this function will return "ab:-c:-d:-e:-f:-ghi".
'
' return
' this function returns pString with all the characters specified by PCharacterSetString replaced by the
' String pReplacement.
'
' param
' pString is the String containing the characters to replace
' param
' pCharacterSetString is a String that is interpreted as a set of characters. Each character is replaced
' if it is found in pString with the String specified by pReplacement.
' param
' pReplacement is the String that replaces all instances of all characters in pCharacterSetString that
' are found in pString.
' -----------------------------------------------------------------------------------------------------------
Public Function replaceAllCharactersInSet(pString As String, pCharacterSetString As String, pReplacement As String) As String
Dim char As String
Dim idx As Long
replaceAllCharactersInSet = pString
For idx = 1 To Len(pCharacterSetString)
char = characterAt(pCharacterSetString, idx)
replaceAllCharactersInSet = Replace(replaceAllCharactersInSet, char, pReplacement)
Next idx
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the index of the last character in pString that is also in pCharacterSetString
' For example: if pString is "ab5c3d1e4f2ghi" and pCharacterSetString is "12345", then this function will
' return 11.
' index: 12345678901234
'
' return
' this function returns the index of the last character in pString that is also in pCharacterSetString or
' 0 if none of the characters in pCharacterSetString are in pString.
'
' param
' pString is the String to search
' param
' pCharacterSetString is a String that is interpreted as a set of characters to search for.
' -----------------------------------------------------------------------------------------------------------
Public Function lastCharInSet(pString As String, pCharacterSetString As String) As Long
Dim char As String
Dim maxIndex As Long
Dim idx As Long
lastCharInSet = 0
For idx = 1 To Len(pCharacterSetString)
char = characterAt(pCharacterSetString, idx)
lastCharInSet = max(lastCharInSet, InStrRev(pString, char))
Next idx
End Function
' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function is an alias for InStr(). It returns the index of the beginning of the first instance of
' pSubstring within pStringToSearch. If no instance of pSubstring is found in pStringToSearch, then this
' function returns 0.
'
' return
' this function returns the index of the beginning of the first instance of pSubstring within
' pStringToSearch. If no instance of pSubstring is found in pStringToSearch, then this function returns
' 0.
'
' param
' pStringToSearch is the String to search
' param
' pSubstring is the String to search for within pStringToSearch
' -----------------------------------------------------------------------------------------------------------
Public Function substringIndex(pStringToSearch As String, pSubstring As String) As Long
substringIndex = InStr(pStringToSearch, pSubstring)
End Function
Facebook