' Forcer la déclaration des variables.
Option Explicit
' Nous utilisons de l'aléa donc nous faisons appel à Randomize au
' début du script pour avoir un meilleur aléa.
Randomize
' Déclaration de la variable contenant tous les
'caractères potentienles du mot de passe.
Dim strElmts
' Nombre d'éléments (de caractères différents
'composants possible pour le mot de passe).
Dim intNbElmts
' C'est ici qu'il faut ajouter/enlever des
' caractères selon ses attentes.
strElmts = "abcdefghijklmnopqrstuvwxyz" & _
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"0123456789" & _
"#?./§,;:!%*$&'<>()[]{}@-_+=|"
intNbElmts = Len(strElmts)
' Génère un mot de passe de intLen caractères.
Function PasswordGeneration(intLen)
Dim i
PasswordGeneration = ""
For i = 1 to intLen
PasswordGeneration = PasswordGeneration & mid(strElmts, Int(rnd * intNbElmts) + 1, 1)
Next
End Function
' Vérifie la "politique de sécurité" du mot de passe.
' Ici, la politique de sécurité adoptée est la suivante:
' - au moins 8 caractères,
' - au moins 1 caractère en majuscule,
' - au moins 1 caractère en minuscule,
' - au moins 1 caractère numérique,
' - au moins 2 caractères 'spéciaux'.
' Retourne "True" si la politique de sécurité est bonne.
Function CheckSecurityPolitic(strPassword)
' Indices de boucle.
Dim i, j
' Compteurs.
Dim intCptMinuscules, intCptMajuscules, intCptNum, intCptSpec
' Index de début de séquence de caractère spéciaux
' dans la variable strElmts.
Dim intIndexSpec
' Taille du mot de passe.
Dim intLenPassword
intLenPassword = Len(strPassword)
' vérification de "au moins 8 caractères":
If (intLenPassword < 8) Then
CheckSecurityPolitic = False
Exit Function
End If
' ATTENTION: Il faut que la séquences de caractères "spéciaux"
' commence par # (comme c'est le cas ici).
intIndexSpec = InStr(strElmts, "#")
' Comptage des caractères.
intCptMinuscules = 0
intCptMajuscules = 0
intCptNum = 0
intCptSpec = 0
For i = 1 To intLenPassword
If ((asc(Mid(strPassword, i, 1)) >= asc("a")) And _
(asc(Mid(strPassword, i, 1)) <= asc("z"))) Then
intCptMinuscules = intCptMinuscules + 1
End If
If ((asc(Mid(strPassword, i, 1)) >= asc("A")) And _
(asc(Mid(strPassword, i, 1)) <= asc("Z"))) Then
intCptMajuscules = intCptMajuscules + 1
End If
If ((asc(Mid(strPassword, i, 1)) >= asc("0")) And _
(asc(Mid(strPassword, i, 1)) <= asc("9"))) Then
intCptNum = intCptNum + 1
End If
For j = intIndexSpec To intNbElmts
If (Mid(strElmts, j, 1) = Mid(strPassword, i, 1)) Then
intCptSpec = intCptSpec + 1
End If
Next
Next
CheckSecurityPolitic = (intCptMinuscules >= 1) And _
(intCptMajuscules >= 1) And _
(intCptNum >= 1) And _
(intCptSpec >= 2)
End Function
' Génère un mot de passe "sécurisé" de 8 à 14 caractères.
Function SecurityPasswordGeneration()
SecurityPasswordGeneration = ""
While (Not (CheckSecurityPolitic(SecurityPasswordGeneration)))
SecurityPasswordGeneration = PasswordGeneration(Int(rnd * 9) + 6)
WEnd
End Function
'#####################################
' Tests/démonstrations des fonctions.
'#####################################
Dim strAccumul
' Fonction PasswordGeneration
strAccumul = "Mot de passe condition particulière:" & VbCrlf
strAccumul = strAccumul & " De 8 caractères:" & PasswordGeneration(8) & VbCrlf
strAccumul = strAccumul & " Entre 6 et 12 caractères: " & PasswordGeneration(Int(rnd * 6) + 7) & VbCrlf
strAccumul = strAccumul & VbCrlf
' Fonction CheckSecurityPolitic
Dim arrTestPassword
Dim strTestPassword
arrTestPassword = Array("salut", "Salut1664", "<Salut1664>", "*!Rocky4%*", _
PasswordGeneration(Int(rnd * 5) + 7), PasswordGeneration(Int(rnd * 5) + 7), _
PasswordGeneration(Int(rnd * 5) + 7), PasswordGeneration(Int(rnd * 5) + 7))
For Each strTestPassword In arrTestPassword
If CheckSecurityPolitic(strTestPassword) Then
strAccumul = strAccumul & "Le mot de passe: " & strTestPassword & _
" est conforme à la politique de sécurité :-)" & VbCrlf
Else
strAccumul = strAccumul & "Le mot de passe: " & strTestPassword & _
" n'est pas conforme à la politique de sécurité :-(" & VbCrlf
End If
Next
strAccumul = strAccumul & VbCrlf
' Fonction SecurityPasswordGeneration
strAccumul = strAccumul & "Mot de passe ""sécurisé"": " & SecurityPasswordGeneration() & VbCrlf
strAccumul = strAccumul & "Mot de passe ""sécurisé"": " & SecurityPasswordGeneration()
Msgbox strAccumul & VbCrlf & "