Public datname, bakname, tstream As Object, tempFileName As Object, strES As Object Public optio As Integer Public strOpt As Object, strFileEnd As Object Public i As Long Public j, k, l As Integer Public dig_number As Long Public row_number As Long Public strTempNumber, strRndNumber As Object, strElse$, ESPassword$ Public min, max As Integer Public rndNumber, rndElse, diffNumber, sumNumber As Integer Public Lines As Long Public ES As Boolean
Public Function GeneratePassword( _ ByVal intLength As Integer, _ Optional ByVal bolWithNumber As Boolean = False, Optional ByVal bolWithUpperCase As Boolean = False, Optional ByVal bolWithAll As Boolean = False, Optional ByVal bolOnlyUpperCase As Boolean = False, Optional ByVal bolOnlyLowerCase As Boolean = False) As String On Error GoTo fehler Dim intCharType As Integer Dim strTempLetter As String = "" Dim intTempNumber As Integer Dim strPassword As String = "" Dim J As Integer
For j = 1 To intLength
If bolWithNumber = True And bolWithAll = False And bolWithUpperCase = True Then intCharType = GetRandomNumber(1, 3) ElseIf bolWithNumber = True And bolWithAll = True Then intCharType = GetRandomNumber(1, 4) ElseIf bolWithNumber = False And bolWithUpperCase = True And bolWithAll = False Then intCharType = GetRandomNumber(1, 2) ElseIf bolWithNumber = False And bolWithUpperCase = False And bolWithAll = False Then intCharType = 2 ElseIf bolWithNumber = False And bolWithUpperCase = True And bolWithAll = False Then intCharType = 1 ElseIf bolWithNumber = True And bolWithUpperCase = False And bolWithAll = False Then intCharType = GetRandomNumber(2, 3) End If
Select Case intCharType
'Grossbuchstaben Case 1 min = 65 max = 90 intTempNumber = GetRandomNumber(min, max)
'Kleinbuchstaben Case 2 min = 97 max = 122 intTempNumber = GetRandomNumber(min, max)
'Zahlen Case 3 min = 48 max = 57 intTempNumber = GetRandomNumber(min, max)
'All Case 4 min = 33 max = 126 intTempNumber = GetRandomNumber(min, max)
End Select
strTempLetter = Chr(intTempNumber)
rndNumber = Int((max - min) * Rnd() + min) If rndNumber < min Then rndNumber = (min) If rndNumber > max Then rndNumber = (max)
diffNumber = (intTempNumber - strRndNumber) If diffNumber < min Then diffNumber = (min) If diffNumber > max Then diffNumber = (max)
sumNumber = (intTempNumber + strRndNumber) If sumNumber < min Then sumNumber = (min) If sumNumber > max Then sumNumber = (max)
If intTempNumber = min Then strTempNumber = Chr(Int(sumNumber)) ElseIf intTempNumber = max Then strTempNumber = Chr(Int(diffNumber)) Else strTempNumber = Chr(rndNumber) End If
strPassword = strPassword & strElse 'Debug.Print "case else - " & strPassword; "" 'Debug.Print k, l, dig_number End If
Next j
If bolOnlyUpperCase = True Then GeneratePassword = UCase(strPassword) ElseIf bolOnlyLowerCase = True Then GeneratePassword = LCase(strPassword) Else GeneratePassword = strPassword End If
Exit Function fehler: Err.Clear() MsgBox("Error : " & Err.Number & " " & Err.Description & " ! ", vbCritical + vbOKOnly, "Oooops ") End Function
Public Function GetRandomNumber(ByVal intLower As Integer, _ ByVal intUpper As Integer) As Integer
Randomize() GetRandomNumber = Int((intUpper - intLower + 1) * Rnd + intLower) End Function
Public Function GeneratePassword_ES( _ ByVal intLength As Integer, Optional ByVal bolWithNumber As Boolean = False, Optional ByVal bolWithUpperCase As Boolean = False, Optional ByVal bolWithAll As Boolean = False, Optional ByVal bolOnlyUpperCase As Boolean = False, Optional ByVal bolOnlyLowerCase As Boolean = False) As String On Error GoTo fehler Dim intCharType As Integer Dim strTempLetter As String Dim intTempNumber As Integer Dim strPassword As String = "" Dim j As Integer
GeneratePassword_ES = "" For j = 1 To intLength
If bolWithNumber = True And bolWithAll = False And bolWithUpperCase = True Then intCharType = GetRandomNumber(1, 3) ElseIf bolWithNumber = True And bolWithAll = True Then intCharType = GetRandomNumber(1, 4) ElseIf bolWithNumber = False And bolWithUpperCase = True And bolWithAll = False Then intCharType = GetRandomNumber(1, 2) ElseIf bolWithNumber = False And bolWithUpperCase = False And bolWithAll = False Then intCharType = 2 ElseIf bolWithNumber = False And bolWithUpperCase = True And bolWithAll = False Then intCharType = 1 ElseIf bolWithNumber = True And bolWithUpperCase = False And bolWithAll = False Then intCharType = GetRandomNumber(2, 3) End If
Select Case intCharType
'Grossbuchstaben Case 1 min = 65 max = 90 intTempNumber = GetRandomNumber(min, max)
'Kleinbuchstaben Case 2 min = 97 max = 122 intTempNumber = GetRandomNumber(min, max)
'Zahlen Case 3 min = 48 max = 57 intTempNumber = GetRandomNumber(min, max)
'All Case 4 min = 33 max = 126 intTempNumber = GetRandomNumber(min, max)
End Select
strTempLetter = Chr(intTempNumber)
rndNumber = Int((max - min) * Rnd() + min) If rndNumber < min Then rndNumber = (min) If rndNumber > max Then rndNumber = (max)
diffNumber = (intTempNumber - strRndNumber) If diffNumber < min Then diffNumber = (min) If diffNumber > max Then diffNumber = (max)
sumNumber = (intTempNumber + strRndNumber) If sumNumber < min Then sumNumber = (min) If sumNumber > max Then sumNumber = (max)
If intTempNumber = min Then strTempNumber = Chr(Int(sumNumber)) ElseIf intTempNumber = max Then strTempNumber = Chr(Int(diffNumber)) Else strTempNumber = Chr(rndNumber) End If
strPassword = strPassword & strElse 'Debug.Print "case else - " & strPassword; "" 'Debug.Print k, l, dig_number End If
If bolOnlyUpperCase = True Then GeneratePassword_ES = UCase(strPassword) ElseIf bolOnlyLowerCase = True Then GeneratePassword_ES = LCase(strPassword) Else GeneratePassword_ES = strPassword End If