Abundant Technologies - IT Consulting Experts

 Source Code Library

 Code Details

 
Public Function boolMaskCompareAt(strMask As String, strCandidate As String, ByVal lngC As Long) As Boolean ' Procedure : boolMaskCompareAt ' Description: Return TRUE if the candidate matches the mask ' Copyright: Chris Greaves Inc. ' Inputs: A mask, string, a candidate string, a position within the candidate string. ' Returns: boolean. ' Assumes: Nothing ' Side Effects: None. ' Tested: By the calls shown below. ' Given a mask (optionally with * and ? strings) and a candidate as a string, and a starting position, ' return TRUE if the candidate matches the mask ' The mask can start with an *, a ? or another character ' The mask may contain any mask characters. ' In the event that no mask characters are present, a straight embedded comparison is offered. boolMaskCompareAt = False ' default result is failure ' Declare counters to step along the strings Dim lngM As Long ' Counter for the mask string lngM = 1 ' Loop until either string is exhausted While lngM <= Len(strMask) And lngC <= Len(strCandidate) If Mid(strMask, lngM, 1) = "?" Then ' Mask character is ?; advance both pointers to skip this match lngM = lngM + 1 lngC = lngC + 1 If lngM > Len(strMask) Then boolMaskCompareAt = True: Exit Function ' SUCCESS Else If Mid(strMask, lngM, 1) = "*" Then ' Mask character is *; advance the Mask pointer to skip this character lngM = lngM + 1 If lngM > Len(strMask) Then boolMaskCompareAt = True: Exit Function ' SUCCESS ' What if the user had two consecutive * in the mask? While (Mid(strMask, lngM, 1) <> Mid(strCandidate, lngC, 1)) And lngC <= Len(strCandidate) lngC = lngC + 1 Wend If lngC > Len(strCandidate) Then Exit Function ' FAILURE and we have exhausted our search territory. Else ' mask character is neither ? nor * If Mid(strMask, lngM, 1) = Mid(strCandidate, lngC, 1) Then ' two non-mask characters match; advance both pointers. lngM = lngM + 1 lngC = lngC + 1 If lngM > Len(strMask) Then boolMaskCompareAt = True: Exit Function ' SUCCESS Else ' we found a mismatch, so backup the mask lngM = lngM - 1 If lngM < 1 Then Exit Function ' FAILURE and we have exhausted our mask options. End If End If End If Wend 'Sub TESTboolMaskCompareAt() 'MsgBox boolMaskCompareAt("abc", "abc", 1) ' TRUE: regular comparison two equal strings. 'MsgBox boolMaskCompareAt("ab", "abc", 1) ' TRUE: first string is shorter 'MsgBox boolMaskCompareAt("abc", "ab", 1) ' FALSE: second string is shorter 'MsgBox boolMaskCompareAt("abc", "abd", 1) ' FALSE: mismatch in last character 'MsgBox boolMaskCompareAt("abc", "dbc", 1) ' FALSE: mismatch in first character 'MsgBox boolMaskCompareAt("abcd", "abc", 1) ' FALSE: first string is longer 'MsgBox boolMaskCompareAt("abc", "abcd", 1) ' TRUE: second string is longer 'MsgBox boolMaskCompareAt("xabcz", "abc", 1) ' FALSE: first string is buried 'MsgBox boolMaskCompareAt("abc", "xabcz", 1) ' FALSE: second string is buried 'MsgBox boolMaskCompareAt("a?c", "abc", 1) ' TRUE: match in a single wildcard character 'MsgBox boolMaskCompareAt("a*c", "abc", 1) ' TRUE: match in a single wildcard character 'MsgBox boolMaskCompareAt("a*c", "ac", 1) ' TRUE: none, one or many of the * 'MsgBox boolMaskCompareAt("a**c", "a*c", 1) ' TRUE: use * as an escape character 'MsgBox boolMaskCompareAt("a*c", "a**c", 1) ' TRUE: use * as an escape character 'MsgBox boolMaskCompareAt("ever", "there was never a man!", 1) ' FALSE: regular comparison two unequal strings. 'MsgBox boolMaskCompareAt("*ever*ever*", "if ever there was never a man!", 1) ' TRUE: double wildcard sequence 'End Sub End Function

Mail To: info@3pc.com