Validation de la force d'un mot de passe

Description

Ce qui suis est un AddIns pour Excel, testé sur Excel 2003. Différentes fonctions pouvant être utilisé individuellement ou ensemble pour évaluer un mot de passe. Ce programme en VBA est inspiré d'une recherche exhaustive sur internet, ont y trouve différentes façon de valider un mot de passe, il n'y a pas vraiment de formule miracle, ce programme est donc une synthèse de ce que j'y ai trouvé.

Voici une liste et description des fonctions:

Fonction CapsCount
Calcule le nombre de lettres majuscules dans la cellule sélectionnée.
La valeur ASCII des lettres majuscules est comprise entre 65 et 90.

Fonction LowCapCount
Calcule le nombre de lettres minuscules dans la cellule sélectionnée.
La valeur ASCII des lettres minuscules est comprise entre 97 et 122.

Fonction NumberCount
Calcule le nombre de chiffres dans la cellule sélectionnée.
La valeur ASCII des chiffres est comprise entre 48 et 57.

Fonction SymbolCount
Calcule le nombre de symboles dans la cellule sélectionnée.
La valeur ASCII des symboles est comprise entre 33 et 47, 58 et 64, 91 et 96, 123 et 126.

Fonction TwoCaps
Vérifie s’il y a deux lettres majuscules consécutives dans la cellule sélectionnée.
Lorsqu'il y a une majuscule, la variable CountCap est incrémentée de 1, si le prochain caractère n'est pas une majuscule, CountCap est remis à zéro.
Lorsque la variable CountCap est égale ou supérieure à deux (deux majuscules consécutives), TwoCaps est incrémenté d’un.
2 majuscules consécutives, TwoCap est égale à 1. 3 majuscules consécutives, TwoCap est égale à 2. 4 majuscules consécutives, TwoCap est égale à 3.

Fonction TwoLowCaps
Vérifie s'il y a deux lettres majuscules consécutives dans la cellule sélectionnée.
Lorsqu'il y a une majuscule, la variable CountLowCaps est incrémentée de 1, si le prochain caractère n'est pas une minuscule, CountLowCaps est remis à zéro.
Lorsque la variable CountLowCaps est égale ou supérieure à deux (deux minuscules consécutives), TwoCaps est incrémenté d'un.
2 minuscules consécutives, TwoLowCaps est égale à 1. 3 minuscules consécutives, TwoLowCaps est égale à 2. 4 minuscules consécutives, TwoLowCaps est égale à 3.

Fonction TwoNum
Vérifie s'il y a deux chiffres consécutifs dans la cellule sélectionnée.
Lorsqu'il y a un chiffre, la variable CountNum est incrémentée de 1, si le prochain caractère n'est pas un chiffre, CountNum est remis à zéro.
Lorsque la variable CountNum est égale ou supérieure à deux (deux chiffres consécutifs), TwoCaps est incrémenté d'un.
2 chiffres consécutifs, TwoNum est égale à 1. 3 chiffres consécutifs, TwoNum est égale à 2. 4 chiffres consécutifs, TwoNum est égale à 3.

Fonction RepeatChar
Vérifie s'il y a deux caractères identiques consécutifs dans la cellule sélectionnée.
Mémorise le caractère lu.
Valide si le caractère lu est identique à celui mémorisé précédemment.
Incrémente pour chaque répétition de caractères.

Fonction IllegalChar
Vérifie s'il y a des caractères hors normes (33 à 126) dans la cellule sélectionnée.

Fonction ConsecChar
Vérifie s'il y a une chaîne croissante de lettres de plus de 3 caractères dans la cellule sélectionnée. (aBc...)
Les chiffres et caractères spéciaux sont omis de cette fonction.

Fonction revConsecChar
Vérifie s'il y a une chaîne décroissante de lettres de plus de 3 caractères dans la cellule sélectionnée. (ZyX...)
Les chiffres et caractères spéciaux sont omis de cette fonction.

Fonction ConsecNum
Vérifie s'il y a une chaîne croissante de plus de 3 chiffres dans la cellule sélectionnée. (123...)
Les lettres et caractères spéciaux sont omis de cette fonction.

Fonction revConsecNum
Vérifie s'il y a une chaîne décroissante de plus de 3 chiffres dans la cellule sélectionnée. (987...)
Les lettres et caractères spéciaux sont omis de cette fonction.

Fonction PassPercent
Convertie en pourcentage le pointage de la cellule sélectionnée sur une base d'un mot de passe de 16 caractères maximum.
Limite le résultat à 240 dans le cas d'un mot de passe ayant plus de 16 caractères
Limite le résultat à zéro dans le cas d'un pointage insuffisant en fonction du choix de caractères.
Le pointage maximum étant alors de 240, la conversion se résume donc à une règle de trois.

Fonction PassEvaluation
Affiche l'évaluation du mot de passe. Vous devez sélectionner le résultat en pointage.
Points : Pourcentage
0-46 0-19 "Très Faible" 'Very Weak
47-94 20-39 "Faible" 'Weak
95-142 40-59 "Bon" 'Good
143-190 60-79 "Fort" 'Strong
191-240 80-100 "Very Strong" 'Very Strong

Fonction MidNumSymb
Cette Fonction appelle les fonctions NumberCount et SymbolCount et vérifie s’il y a des chiffres et des caractères spéciaux au milieu du mot de passe hormis le premier et dernier caractère.

Fonction PassReq
Cette Fonction valide si les 5 paramètres minimum sont respectés.
Le mot de passe doit contenir au moins une majuscule, une minuscule, un chiffre, un caractère spécial,
et soit un chiffre ou caractère spécial au milieu du mot de passe.

Fonction PassLettersOnly
Vérifie si le mot de passe ne contient que des lettres.

Fonction PassNumOnly
Vérifie si le mot de passe ne contient que des chiffres.

Fonction PassWrdStrg
Combinaison des fonctions incluant les formules de pointages:
En Addition: CapsCount, LowCapCount, NumberCount, SymbolCount, MidNumSymb,PassReq,
En Soustraction: PassLettersOnly, PassNumOnly, RepeatChar, TwoCaps, TwoLowCaps, TwoNum, ConsecChar, revConsecChar, ConsecNum, revConsecNum.

Fonction PassWrdStrgSymb
Combinaison des fonctions incluant les formules de pointages:
En Addition: CapsCount, LowCapCount, NumberCount, SymbolCount, MidNumSymb,PassReq,
En Soustraction: PassLettersOnly, PassNumOnly, RepeatChar, TwoCaps, TwoLowCaps, TwoNum, ConsecChar, revConsecChar, ConsecNum, revConsecNum, ConsecSymb, RevConsecSymb

Fonction CombProb - ANALYSE COMBINATOIRE - ARRANGEMENTS AVEC RÉPÉTITION
Calcule la probabilité des combinaisons possibles avec tous les types de caractères utilisés dans le mot de passe.

Fonction CombProbUni - ANALYSE COMBINATOIRE - COMBINAISONS SIMPLES SANS RÉPÉTITION
Calcule la probabilité des combinaisons possibles avec le nombre de caractères utilisés dans le mot de passe
à la condition que chacun des caractères ne soit utilisé qu'une seule fois. Même principe de calcule que la lotterie.
Cette fonction est la même que COMBIN(number,number_chosen) retrouvé dans EXCEL.
Dans cette fonction, number correspond au type de caractères choisi (FNum) et number_choosen (LEN(avar)à la longueur du mot de passe.
Il est à noter que le mot de passe ne contient que des chiffres, le résultat sera de 1, ceci est du au fait que si vous entrez un mot de passe de plus de 10 caractères, la fonction génèrerait une erreur du fait que 0 à 9 = 10 caractères uniques...

Fonction ConsecSymb
Vérifie s'il y a une chaîne croissante de symboles dans la cellule sélectionnée en fonction de leurs valeurs ASCII. (!"#$%&'() etc.)
Les chiffres et lettres sont omis de cette fonction.

Fonction RevConsecSymb
Vérifie s'il y a une chaîne décroissante de symboles dans la cellule sélectionnée en fonction de leurs valeurs ASCII. (/.-,+*)('&% etc.)
Les chiffres et lettres sont omis de cette fonction.

Source / Exemple :


Function CapsCount(avar)
'**********************************************************************************************************************
'Fonction CapsCount
'Calcule le nombre de lettres majuscules dans la cellule sélectionnée.
'La valeur ASCII des lettres majuscules est comprise entre 65 et 90.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 65 And Asc(Mid(avar, N, 1)) <= 90 Then CapsCount = CapsCount + 1
Next
End Function
Function LowCapCount(avar)
'**********************************************************************************************************************
'Fonction LowCapCount
'Calcule le nombre de lettres minuscules dans la cellule sélectionnée.
'La valeur ASCII des lettres minuscules est comprise entre 97 et 122.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 97 And Asc(Mid(avar, N, 1)) <= 122 Then LowCapCount = LowCapCount + 1
Next
End Function
Function NumberCount(avar)
'**********************************************************************************************************************
'Fonction NumberCount
'Calcule le nombre de chiffres dans la cellule sélectionnée.
'La valeur ASCII des chiffres est comprise entre 48 et 57.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 48 And Asc(Mid(avar, N, 1)) <= 57 Then NumberCount = NumberCount + 1
Next
End Function
Function SymbolCount(avar)
'**********************************************************************************************************************
'Fonction SymbolCount
'Calcule le nombre de symboles dans la cellule sélectionnée.
'La valeur ASCII des symboles est comprise entre 33 et 47, 58 et 64, 91 et 96, 123 et 126.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 33 And Asc(Mid(avar, N, 1)) <= 47 Then SymbolCount = SymbolCount + 1
   If Asc(Mid(avar, N, 1)) >= 58 And Asc(Mid(avar, N, 1)) <= 64 Then SymbolCount = SymbolCount + 1
   If Asc(Mid(avar, N, 1)) >= 91 And Asc(Mid(avar, N, 1)) <= 96 Then SymbolCount = SymbolCount + 1
   If Asc(Mid(avar, N, 1)) >= 123 And Asc(Mid(avar, N, 1)) <= 126 Then SymbolCount = SymbolCount + 1
Next
End Function
Function TwoCaps(avar)
'**********************************************************************************************************************
'Fonction TwoCaps
'Vérifie s 'il y a deux lettres majuscules consécutives dans la cellule sélectionnée.
'Lorsqu'il y a une majuscule, la variable CountCap est incrémentée de 1, si le prochain caractère n'est pas une majuscule, CountCap est remis à zéro.
'Lorsque la variable CountCap est égale ou supérieure à deux (deux majuscules consécutives), TwoCaps est incrémenté d'un.
'2 majuscules consécutives, TwoCap est égale à 1. 3 majuscules consécutives, TwoCap est égale à 2. 4 majuscules consécutives, TwoCap est égale à 3.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 65 And Asc(Mid(avar, N, 1)) <= 90 Then CountCap = CountCap + 1 Else CountCap = 0
   If CountCap >= 2 Then TwoCaps = TwoCaps + 1
Next
End Function
Function TwoLowCaps(avar)
'**********************************************************************************************************************
'Fonction TwoLowCaps
'Vérifie s'il y a deux lettres majuscules consécutives dans la cellule sélectionnée.
'Lorsqu'il y a une majuscule, la variable CountLowCaps est incrémentée de 1, si le prochain caractère n'est pas une minuscule, CountLowCaps est remis à zéro.
'Lorsque la variable CountLowCaps est égale ou supérieure à deux (deux minuscules consécutives), TwoCaps est incrémenté d'un.
'2 minuscules consécutives, TwoLowCaps est égale à 1. 3 minuscules consécutives, TwoLowCaps est égale à 2. 4 minuscules consécutives, TwoLowCaps est égale à 3.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 97 And Asc(Mid(avar, N, 1)) <= 122 Then CountLowCaps = CountLowCaps + 1 Else CountLowCaps = 0
   If CountLowCaps >= 2 Then TwoLowCaps = TwoLowCaps + 1
Next
End Function
Function TwoNum(avar)
'**********************************************************************************************************************
'Fonction TwoNum
'Vérifie s'il y a deux chiffres consécutifs dans la cellule sélectionnée.
'Lorsqu'il y a un chiffre, la variable CountNum est incrémentée de 1, si le prochain caractère n'est pas un chiffre, CountNum est remis à zéro.
'Lorsque la variable CountNum est égale ou supérieure à deux (deux chiffres consécutifs), TwoCaps est incrémenté d'un.
'2 chiffres consécutifs, TwoNum est égale à 1. 3 chiffres consécutifs, TwoNum est égale à 2. 4 chiffres consécutifs, TwoNum est égale à 3.
'**********************************************************************************************************************
For N = 1 To Len(avar)
   If Asc(Mid(avar, N, 1)) >= 48 And Asc(Mid(avar, N, 1)) <= 57 Then CountNum = CountNum + 1 Else CountNum = 0
   If CountNum >= 2 Then TwoNum = TwoNum + 1
Next
End Function
Function RepeatChar(avar)
'**********************************************************************************************************************
'Fonction RepeatChar
'Vérifie s'il y a deux caractères identiques consécutifs dans la cellule sélectionnée.
'**********************************************************************************************************************
For p = 33 To 126 'Valide les caractères utiles de 33 à 126.
    For N = 1 To Len(avar)
       If Asc(Mid(avar, N, 1)) >= 65 And Asc(Mid(avar, N, 1)) <= 90 Then aConvertToLow = Asc(Mid(avar, N, 1)) + 32 'Lettre majuscule convertie en minuscule.
       If Asc(Mid(avar, N, 1)) >= 97 And Asc(Mid(avar, N, 1)) <= 122 Then aConvertToLow = Asc(Mid(avar, N, 1))
       If Asc(Mid(avar, N, 1)) >= 33 And Asc(Mid(avar, N, 1)) <= 47 Then aConvertToLow = Asc(Mid(avar, N, 1))
       If Asc(Mid(avar, N, 1)) >= 58 And Asc(Mid(avar, N, 1)) <= 64 Then aConvertToLow = Asc(Mid(avar, N, 1))
       If Asc(Mid(avar, N, 1)) >= 91 And Asc(Mid(avar, N, 1)) <= 96 Then aConvertToLow = Asc(Mid(avar, N, 1))
       If Asc(Mid(avar, N, 1)) >= 123 And Asc(Mid(avar, N, 1)) <= 126 Then aConvertToLow = Asc(Mid(avar, N, 1))
       If Asc(Mid(avar, N, 1)) >= 48 And Asc(Mid(avar, N, 1)) <= 57 Then aConvertToLow = Asc(Mid(avar, N, 1))
       aChar = aConvertToLow 'Mémorise le caractère lu.
       If aChar = p Then countp = countp + 1 'Valide si le caractère lu est identique à celui mémorisé précédemment.
    Next
       If countp > 1 Then RepeatChar = RepeatChar + countp 'Incrémente pour chaque répétition de caractères.
       countp = 0
Next
End Function
Function IllegalChar(avar) As String
'**********************************************************************************************************************
'Fonction IllegalChar
'Vérifie s'il y a des caractères hors normes (33 à 126) dans la cellule sélectionnée.
'**********************************************************************************************************************
For N = 1 To Len(avar)
    If Asc(Mid(avar, N, 1)) >= 33 And Asc(Mid(avar, N, 1)) <= 126 Then IllegalChar = "Caractères légaux" Else IllegalChar = "Caractères illégaux"
Next
End Function
Function ConsecChar(avar)
'**********************************************************************************************************************
'Fonction ConsecChar
'Vérifie s'il y a une chaîne croissante de lettres dans la cellule sélectionnée. (aBc...)
'Les chiffres et caractères spéciaux sont omis de cette fonction.
'**********************************************************************************************************************
For N = 1 To Len(avar)
        If Asc(Mid(avar, N, 1)) >= 65 And Asc(Mid(avar, N, 1)) <= 90 Then aConvertToLow = Asc(Mid(avar, N, 1)) + 32 'Lettre majuscule convertie en minuscule.
        If Asc(Mid(avar, N, 1)) >= 97 And Asc(Mid(avar, N, 1)) <= 122 Then aConvertToLow = Asc(Mid(avar, N, 1))
        aChar = aConvertToLow
        If Asc(Mid(avar, N, 1)) < 65 Then countp = 0
        If Asc(Mid(avar, N, 1)) > 122 Then countp = 0
        If Asc(Mid(avar, N, 1)) >= 91 And Asc(Mid(avar, N, 1)) <= 96 Then countp = 0
        If aChar = bChar + 1 Then countp = countp + 1 Else countp = 0
        bChar = aChar
        If countp >= 2 Then ConsecChar = ConsecChar + 1
Next
End Function
Function RevConsecChar(avar)
'**********************************************************************************************************************
'Fonction RevConsecChar
'Vérifie s'il y a une chaîne décroissante de lettres dans la cellule sélectionnée. (ZyX...)
'Les chiffres et caractères spéciaux sont omis de cette fonction.
'**********************************************************************************************************************
For N = 1 To Len(avar)
        If Asc(Mid(avar, N, 1)) >= 65 And Asc(Mid(avar, N, 1)) <= 90 Then aConvertToLow = Asc(Mid(avar, N, 1)) + 32 'Lettre majuscule convertie en minuscule.
        If Asc(Mid(avar, N, 1)) >= 97 And Asc(Mid(avar, N, 1)) <= 122 Then aConvertToLow = Asc(Mid(avar, N, 1))
        aChar = aConvertToLow
        If Asc(Mid(avar, N, 1)) < 65 Then countp = 0
        If Asc(Mid(avar, N, 1)) > 122 Then countp = 0
        If Asc(Mid(avar, N, 1)) >= 91 And Asc(Mid(avar, N, 1)) <= 96 Then countp = 0
        If aChar = bChar - 1 Then countp = countp + 1 Else countp = 0
        bChar = aChar
        If countp >= 2 Then RevConsecChar = RevConsecChar + 1
Next
End Function
Function ConsecNum(avar)
'**********************************************************************************************************************
'Fonction ConsecNum
'Vérifie s'il y a une chaîne croissante de chiffres dans la cellule sélectionnée. (123...)
'Les lettres et caractères spéciaux sont omis de cette fonction.
'**********************************************************************************************************************
For N = 1 To Len(avar)
        If Asc(Mid(avar, N, 1)) >= 48 And Asc(Mid(avar, N, 1)) <= 57 Then aConvertToLow = Asc(Mid(avar, N, 1))
        aNum = aConvertToLow
        If Asc(Mid(avar, N, 1)) < 48 Then countp = 0
        If Asc(Mid(avar, N, 1)) > 57 Then countp = 0
        If aNum = bNum + 1 Then countp = countp + 1 Else countp = 0
        bNum = aNum
        If countp >= 2 Then ConsecNum = ConsecNum + 1
Next
End Function
Function RevConsecNum(avar)
'**********************************************************************************************************************
'Fonction RevConsecNum
'Vérifie s'il y a une chaîne décroissante de chiffres dans la cellule sélectionnée. (987...)
'Les lettres et caractères spéciaux sont omis de cette fonction.
'**********************************************************************************************************************
For N = 1 To Len(avar)
        If Asc(Mid(avar, N, 1)) >= 48 And Asc(Mid(avar, N, 1)) <= 57 Then aConvertToLow = Asc(Mid(avar, N, 1))
        aNum = aConvertToLow
        If Asc(Mid(avar, N, 1)) < 48 Then countp = 0
        If Asc(Mid(avar, N, 1)) > 57 Then countp = 0
        If aNum = bNum - 1 Then countp = countp + 1 Else countp = 0
        bNum = aNum
        If countp >= 2 Then RevConsecNum = RevConsecNum + 1
Next
End Function
Function PassPercent(result As Integer)
'**********************************************************************************************************************
'Fonction PassPercent
'Convertie en pourcentage le pointage de la cellule sélectionnée sur une base d'un mot de passe de 16 caractères maximum.
'Limite le résultat à 240 dans le cas d'un mot de passe ayant plus de 16 caractères
'Limite le résultat à zéro dans le cas d'un pointage insuffisant en fonction du choix de caractères.
'Le pointage maximum étant alors de 240, la conversion se résume donc à une règle de trois.
'**********************************************************************************************************************
    If result > 240 Then result = 240
    If result < 0 Then result = 0
    PassPercent = result * 100 / 240
End Function
Function PassEvaluation(result As Integer) As String
'**********************************************************************************************************************
'Fonction PassEvaluation
'Affiche l'évaluation du mot de passe. Vous devez sélectionner le résultat en pointage.
'Points : Pourcentage
'0-46       0-19    "Très Faible" 'Very Weak
'47-94      20-39   "Faible" 'Weak
'95-142     40-59   "Bon" 'Good
'143-190    60-79   "Fort" 'Strong
'191-240    80-100  "Very Strong" 'Very Strong
'**********************************************************************************************************************
    PassEval = PassPercent(result)
    If PassEval >= 0 Then PassEvaluation = "Très Faible" 'Very Weak
    If PassEval >= 20 Then PassEvaluation = "Faible" 'Weak
    If PassEval >= 40 Then PassEvaluation = "Bon" 'Good
    If PassEval >= 60 Then PassEvaluation = "Fort" 'Strong
    If PassEval >= 80 Then PassEvaluation = "Très Fort" 'Very Strong
End Function
Function MidNumSymb(avar)
'**********************************************************************************************************************
'Fonction MidNumSymb
'Cette Fonction appelle les fonctions NumberCount et SymbolCount et vérifie s'il y a des chiffres et des caractères spéciaux
'au milieu du mot de passe hormis le premier et dernier caractère.
'**********************************************************************************************************************
    If Len(avar) > 2 Then MidNumSymb = NumberCount(Mid(avar, 2, Len(avar) - 2)) + SymbolCount(Mid(avar, 2, Len(avar) - 2))
End Function
Function PassReq(avar)
'**********************************************************************************************************************
'Fonction PassReq
'Cette Fonction valide si les 5 paramètres minimum sont respectés.
'Le mot de passe doit contenir au moins une majuscule, une minuscule, un chiffre, un caractère spécial,
'et soit un chiffre ou caractère spécial au milieu du mot de passe.
'**********************************************************************************************************************
    If CapsCount(avar) > 0 Then PassReqCount = PassReqCount + 1
    If LowCapCount(avar) > 0 Then PassReqCount = PassReqCount + 1
    If NumberCount(avar) > 0 Then PassReqCount = PassReqCount + 1
    If SymbolCount(avar) > 0 Then PassReqCount = PassReqCount + 1
    If MidNumSymb(avar) > 0 Then PassReqCount = PassReqCount + 1
    If PassReqCount = 5 Then PassReq = 5
End Function
Function PassLettersOnly(avar)
'**********************************************************************************************************************
'Fonction PassLettersOnly
'Vérifie si le mot de passe ne contient que des lettres.
'**********************************************************************************************************************
    If NumberCount(avar) = 0 Then PLO = PLO + 1
    If SymbolCount(avar) = 0 Then PLO = PLO + 1
    If PLO = 2 Then PassLettersOnly = Len(avar)
End Function
Function PassNumOnly(avar)
'**********************************************************************************************************************
'Fonction PassNumOnly
'Vérifie si le mot de passe ne contient que des chiffres.
'**********************************************************************************************************************
    If CapsCount(avar) = 0 Then PNO = PNO + 1
    If LowCapCount(avar) = 0 Then PNO = PNO + 1
    If SymbolCount(avar) = 0 Then PNO = PNO + 1
    If PNO = 3 Then PassNumOnly = Len(avar)
End Function
Function PassWrdStrg(avar)
'**********************************************************************************************************************
'Fonction PassWrdStrg
'Combinaison des fonctions incluant les formules de pointages:
'En Addition: CapsCount, LowCapCount, NumberCount, SymbolCount, MidNumSymb,PassReq,
'En Soustraction: PassLettersOnly, PassNumOnly, RepeatChar, TwoCaps, TwoLowCaps, TwoNum, ConsecChar, revConsecChar, ConsecNum, revConsecNum.
'**********************************************************************************************************************
    PassStrg = PassStrg + (Len(avar) * 4)
    If CapsCount(avar) > 0 Then PassStrg = PassStrg + ((Len(avar) - CapsCount(avar)) * 2)
    If LowCapCount(avar) > 0 Then PassStrg = PassStrg + ((Len(avar) - LowCapCount(avar)) * 2)
    PassStrg = PassStrg + (NumberCount(avar) * 4)
    PassStrg = PassStrg + (SymbolCount(avar) * 6)
    PassStrg = PassStrg + (MidNumSymb(avar) * 2)
    PassStrg = PassStrg + (PassReq(avar) * 2)
    PassStrg = PassStrg - PassLettersOnly(avar)
    PassStrg = PassStrg - PassNumOnly(avar)
    PassStrg = PassStrg - (RepeatChar(avar) * (RepeatChar(avar) - 1))
    PassStrg = PassStrg - (TwoCaps(avar) * 2)
    PassStrg = PassStrg - (TwoLowCaps(avar) * 2)
    PassStrg = PassStrg - (TwoNum(avar) * 2)
    PassStrg = PassStrg - ((ConsecChar(avar) + RevConsecChar(avar)) * 6)
    PassStrg = PassStrg - ((ConsecNum(avar) + RevConsecNum(avar)) * 6)
    If PassStrg < 0 Then PassStrg = 0
    PassWrdStrg = PassStrg
End Function
Function PassWrdStrgSymb(avar)
'**********************************************************************************************************************
'Fonction PassWrdStrg
'Combinaison des fonctions incluant les formules de pointages:
'En Addition: CapsCount, LowCapCount, NumberCount, SymbolCount, MidNumSymb,PassReq,
'En Soustraction: PassLettersOnly, PassNumOnly, RepeatChar, TwoCaps, TwoLowCaps, TwoNum, ConsecChar, revConsecChar, ConsecNum, revConsecNum, ConsecSymb, RevConsecSymb.
'**********************************************************************************************************************
    PassStrg = PassStrg + (Len(avar) * 4)
    If CapsCount(avar) > 0 Then PassStrg = PassStrg + ((Len(avar) - CapsCount(avar)) * 2)
    If LowCapCount(avar) > 0 Then PassStrg = PassStrg + ((Len(avar) - LowCapCount(avar)) * 2)
    PassStrg = PassStrg + (NumberCount(avar) * 4)
    PassStrg = PassStrg + (SymbolCount(avar) * 6)
    PassStrg = PassStrg + (MidNumSymb(avar) * 2)
    PassStrg = PassStrg + (PassReq(avar) * 2)
    PassStrg = PassStrg - PassLettersOnly(avar)
    PassStrg = PassStrg - PassNumOnly(avar)
    PassStrg = PassStrg - (RepeatChar(avar) * (RepeatChar(avar) - 1))
    PassStrg = PassStrg - (TwoCaps(avar) * 2)
    PassStrg = PassStrg - (TwoLowCaps(avar) * 2)
    PassStrg = PassStrg - (TwoNum(avar) * 2)
    PassStrg = PassStrg - ((ConsecSymb(avar) + RevConsecSymb(avar)) * 6)
    PassStrg = PassStrg - ((ConsecChar(avar) + RevConsecChar(avar)) * 6)
    PassStrg = PassStrg - ((ConsecNum(avar) + RevConsecNum(avar)) * 6)
    If PassStrg < 0 Then PassStrg = 0
    PassWrdStrgSymb = PassStrg
End Function

Function CombProb(avar)
'**********************************************************************************************************************
'Fonction CombProb - ANALYSE COMBINATOIRE - ARRANGEMENTS AVEC RÉPÉTITION
'Calcule la probabilité des combinaisons possibles avec tous les types de caractères utilisés dans le mot de passe.
'**********************************************************************************************************************
    If CapsCount(avar) > 0 Then Fnum = Fnum + 26
    If LowCapCount(avar) > 0 Then Fnum = Fnum + 26
    If NumberCount(avar) > 0 Then Fnum = Fnum + 10
    If SymbolCount(avar) > 0 Then Fnum = Fnum + 32
    If Fnum = 0 Then Fnum = 1
    CombProb = (Application.WorksheetFunction.Power(Fnum, Len(avar)))
End Function
Function CombProbUni(avar)
'**********************************************************************************************************************
'Fonction CombProbUni - ANALYSE COMBINATOIRE - COMBINAISONS SIMPLES SANS RÉPÉTITION
'Calcule la probabilité des combinaisons possibles avec le nombre de caractères utilisés dans le mot de passe
'à la condition que chacun des caractères ne soit utilisé qu'une seule fois. Même principe de calcule que la lotterie.
'Cette fonction est la même que COMBIN(number,number_chosen) retrouvé dans EXCEL.
'Dans cette fonction, number correspond au type de caractères choisi (FNum) et number_choosen (LEN(avar)à la longueur du mot de passe.
'Il est à noter que le mot de passe ne contient que des chiffres, le résultat sera de 1, ceci est du au fait que si vous entrez
'un mot de passe de plus de 10 caractères, la fonction génèrerait une erreur du fait que 0 à 9 = 10 caractères uniques...
'**********************************************************************************************************************
    If CapsCount(avar) > 0 Then Fnum = Fnum + 26
    If LowCapCount(avar) > 0 Then Fnum = Fnum + 26
    If NumberCount(avar) > 0 Then Fnum = Fnum + 10
    If SymbolCount(avar) > 0 Then Fnum = Fnum + 32
    If Fnum = 10 Then Fnum = Len(avar)
    CombProbUni = (Application.WorksheetFunction.Fact(Fnum) / (Application.WorksheetFunction.Fact(Fnum - Len(avar)) * Application.WorksheetFunction.Fact(Len(avar))))
End Function
Function ConsecSymb(avar)
'**********************************************************************************************************************
'Fonction ConsecSymb
'Vérifie s'il y a une chaîne croissante de symboles dans la cellule sélectionnée en fonction de leurs valeurs ASCII. (!"#$%&'() etc.)
'Les chiffres et lettres sont omis de cette fonction.
'**********************************************************************************************************************
For N = 1 To Len(avar)
    If Asc(Mid(avar, N, 1)) >= 33 And Asc(Mid(avar, N, 1)) <= 47 Then SymbolConsec = Asc(Mid(avar, N, 1))   'Caratères spéciaux   !"#$%&'()*+,-./
    If Asc(Mid(avar, N, 1)) >= 58 And Asc(Mid(avar, N, 1)) <= 64 Then SymbolConsec = Asc(Mid(avar, N, 1))   'Caratères spéciaux   :;<=>?@
    If Asc(Mid(avar, N, 1)) >= 91 And Asc(Mid(avar, N, 1)) <= 96 Then SymbolConsec = Asc(Mid(avar, N, 1))   'Caratères spéciaux   [\]^_`
    If Asc(Mid(avar, N, 1)) >= 123 And Asc(Mid(avar, N, 1)) <= 126 Then SymbolConsec = Asc(Mid(avar, N, 1)) 'Caratères spéciaux   
        aChar = SymbolConsec
    If Asc(Mid(avar, N, 1)) > 47 And Asc(Mid(avar, N, 1)) < 58 Then countp = 0  'Élimination des Chiffres
    If Asc(Mid(avar, N, 1)) > 64 And Asc(Mid(avar, N, 1)) < 91 Then countp = 0  'Élimination des Majuscules
    If Asc(Mid(avar, N, 1)) > 96 And Asc(Mid(avar, N, 1)) < 123 Then countp = 0 'Élimination des Minuscules
        If aChar = bChar + 1 Then countp = countp + 1 Else countp = 0
        bChar = aChar
    If countp >= 2 Then ConsecSymb = ConsecSymb + 1
Next
End Function
Function RevConsecSymb(avar)
'**********************************************************************************************************************
'Fonction RevConsecSymb
'Vérifie s'il y a une chaîne décroissante de symboles dans la cellule sélectionnée en fonction de leurs valeurs ASCII. (/.-,+*)('&% etc.)
'Les chiffres et lettres sont omis de cette fonction.
'**********************************************************************************************************************
For N = 1 To Len(avar)
    If Asc(Mid(avar, N, 1)) >= 33 And Asc(Mid(avar, N, 1)) <= 47 Then SymbolConsec = Asc(Mid(avar, N, 1))   'Caratères spéciaux   !"#$%&'()*+,-./
    If Asc(Mid(avar, N, 1)) >= 58 And Asc(Mid(avar, N, 1)) <= 64 Then SymbolConsec = Asc(Mid(avar, N, 1))   'Caratères spéciaux   :;<=>?@
    If Asc(Mid(avar, N, 1)) >= 91 And Asc(Mid(avar, N, 1)) <= 96 Then SymbolConsec = Asc(Mid(avar, N, 1))   'Caratères spéciaux   [\]^_`
    If Asc(Mid(avar, N, 1)) >= 123 And Asc(Mid(avar, N, 1)) <= 126 Then SymbolConsec = Asc(Mid(avar, N, 1)) 'Caratères spéciaux   {
~ aChar = SymbolConsec If Asc(Mid(avar, N, 1)) > 47 And Asc(Mid(avar, N, 1)) < 58 Then countp = 0 'Élimination des Chiffres If Asc(Mid(avar, N, 1)) > 64 And Asc(Mid(avar, N, 1)) < 91 Then countp = 0 'Élimination des Majuscules If Asc(Mid(avar, N, 1)) > 96 And Asc(Mid(avar, N, 1)) < 123 Then countp = 0 'Élimination des Minuscules If aChar = bChar - 1 Then countp = countp + 1 Else countp = 0 bChar = aChar If countp >= 2 Then RevConsecSymb = RevConsecSymb + 1 Next End Function

Conclusion :


Dans le fichier "Password Meter ver 2.0912 rev 1001.zip", vous retrouverez le Module ainsi qu'un fichier demo.

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.