In collecting data we wanted associate each item of data with individuals who contributed it but without actually identifying them individually. To do this we used
MD5(Environ("UserName")) and stored this 'ID' on each of the individual contributors PCs. The unforeseen problem that thwarted our plan was that under some conditions windows changes the case of
Environ("UserName"), probably depending on how the user logs in. This incorrectly flagged that the user was unregistered and prevented them from contributing.
Having learned from our mistake we now use lowercase version of the UserName to anonymize respondents:
But we still need to re-validate each user who was flagged as un-registered and rewrite their MD5 IDs. Part of this strategy means checking the current MD5 is in-fact for this user, i.e. systematically change case until a match is found then rewrite the MD5 based on
lCase(UserName); this is the crux of the question.
I have a need to find all possible combinations of a string between
uCase(string) - without rearranging characters. For example, given the input string of:
abc I would expect the code to return:
abc, abC, aBc, aBC, Abc, AbC, ABc, & ABC.
The following code does that, but perhaps not as efficiently as it could. I'm working on the following assumptions:
- the input characters will be limited to:
- upper and lower case characters, A-z
- regular numbers, 0-9
- regular space character, " "
- the input strings are relatively short, 1 to 20 characters
- Users typically log into Windows using:
- FirstL, etc.
- (but other combinations and cases are also possible & likely)
The code basically works by converting an input string to lower case and then into a byte array. This provides each character in the input string with an easy-to-access index.
The next step is to create a binary number with 1 digit for each character in the input string. Then starting from
000 (i.e. for
abc) use a loop to keep adding 1 (to a decimal number and converting) to binary until there are no zeros left in the binary number. For each iteration of the loop the "1's" in the binary number represent possible uppercase characters for the original input string.
On my test PC it takes approximately 60 seconds to process a 16 character input string. I'm sure there is room for improvement.
In addition to speed I would like to better structure the code so that it is easier to test and so that when I look at it later I'm not left cursing myself.
The code is as follows:
Option Explicit Const BASE_2 As Long = 2 Const CHR_1 As String = "1" Const CHR_0 As String = "0" Public Sub CasePermutation(ByVal stringPassed As String) Dim stringIn As String stringIn = LCase$(stringPassed) Const SKIP_BLANKS As Long = 2 Dim stringInArray() As Byte stringInArray = stringIn 'Assign Unicode string to bytes.' Dim caseToggleArray() As Byte Dim exponent As Long exponent = Len(stringIn) Dim maxDecimal As Long maxDecimal = BASE_2 ^ exponent Dim decimalNumber As Long For decimalNumber = 0 To maxDecimal - 1 caseToggleArray = DecToBin(decimalNumber, exponent) Dim positionInString As Long For positionInString = LBound(stringInArray) To UBound(stringInArray) Step SKIP_BLANKS Dim tempString As String If Chr$(caseToggleArray(positionInString)) = CHR_1 Then tempString = tempString & UCase$(Chr$(stringInArray(positionInString))) Else tempString = tempString & Chr$(stringInArray(positionInString)) End If Next positionInString Debug.Print tempString ' Reset for next iteration tempString = vbNullString Next decimalNumber End Sub Public Function DecToBin(ByVal decimalPassed As Long, ByVal digitsToCount As Long) As String Dim curDec As Long curDec = decimalPassed Dim strTemp As String Dim positionInString As Long positionInString = digitsToCount Do While positionInString >= 0 If curDec >= (BASE_2 ^ positionInString) Then strTemp = strTemp & CHR_1 curDec = curDec - (BASE_2 ^ positionInString) Else If positionInString <> digitsToCount Then strTemp = strTemp & CHR_0 End If End If positionInString = positionInString - 1 Loop DecToBin = strTemp End Function Public Sub test() Dim myNow As Date myNow = now() CasePermutation "a 1" Debug.Print now & " " & myNow ' rough but ok for testing with 16 chr input strings End Sub