DominoArea.org [Archive]

Forums Lotus Domino/Notes en Français

Accéder au contenu

Génération d'un Mot de Passe Aléatoire

Publier une réponse

Génération d'un Mot de Passe Aléatoire

Messagepar Michael DELIQUE » 18 Fév 2009 à 13:39

Code : Tout sélectionner
Function PasswordCreate(wFormatPSW As String) As String
   
   'génére un mot de passe complexe en fonction du format demandé
   ' (M) pour une lettre Majuscule
   ' (L) pour une lettre Minuscule
   ' (C) pour un chiffre
   ' (S) pour un caractère spéciale
   
   'séparer chaque parametre d'une virgule, ce qui ne correspondra pas au format sera insré comme telle dans le psw.
   
   'exempe  "(L)","(C)","(S)","M","azerty ","123"
   
   Dim vrFormatPSW As Variant
   Dim lstValue List As String
   Dim i As Integer
   Dim j As Integer
   Dim lstSpecialChar List As String
   Dim nbSpecialCar As Integer
   Dim valeur As String
   Dim char As String
   
   
   On Error Goto ErreurHandle
   
   PasswordCreate = ""
   
   Randomize
   
   'si pas de format, génére un format aléatoire
   If Trim(wFormatPSW) = "" Then
      'taille par défaut   entre 8 et 16 caracteres
      j = 0
      While j< 8 Or j > 16
         valeur = Strleft(Cstr(Rnd()*100),".")
         If Trim(valeur) = "" Then
            j = 0
         Else
            j = Cint(valeur)
         End If
         valeur = ""
      Wend
      
      For i = 1 To j
         Select Case Trim(Left(Right(Cstr(Rnd()*10000),2),1))
         Case "2","4"
            'lettre Majuscule
            lstValue(i) = "(M)"
         Case "6","8"
            'Lettre Minuscule
            lstValue(i) = "(L)"
         Case "1","3","5","7"
            'Chiffre
            lstValue(i) = "(C)"
         Case "0"
            'Caractere spécial
            lstValue(i) = "(S)"
         End Select
      Next      
      j =0
      vrFormatPSW = lstValue
      Erase lstValue
   Else
      vrFormatPSW = Split(wFormatPSW,",")
   End If
   
   'liste des caractères spéciaux utilisable
   lstSpecialChar(0) = "&"
   lstSpecialChar(1) = "#"
   lstSpecialChar(2) = "-"
   lstSpecialChar(3) = "_"
   lstSpecialChar(4) = "@"
   lstSpecialChar(5) = "$"
   lstSpecialChar(6) = "£"
   lstSpecialChar(7) = "%"
   lstSpecialChar(8) = "*"
   lstSpecialChar(9) = "!"
   lstSpecialChar(10) = "?"
   lstSpecialChar(11) = "{"
   lstSpecialChar(12) = "}"
   lstSpecialChar(13) = "["
   lstSpecialChar(14) = "]"
   lstSpecialChar(15) = "\"
   lstSpecialChar(16) = "/"
   lstSpecialChar(17) = "§"
   lstSpecialChar(18) = "."
   lstSpecialChar(19) = ";"
   lstSpecialChar(20) = ","
   lstSpecialChar(21) = "<"
   lstSpecialChar(22) = ">"
   lstSpecialChar(23) = "="
   lstSpecialChar(24) = ":"
   lstSpecialChar(25) = "|"
   lstSpecialChar(26) = " "
   
   nbSpecialCar = 26
   
   Forall value In  vrFormatPSW      
      
      Select Case Ucase(Trim(Cstr(value)))
      Case "(M)"
         'calcul lalettre majuscule
         J = 0
         While J<65 Or J > 90
            valeur = Strleft(Cstr(Rnd()*100),".")
            If Trim(valeur) = "" Then
               J = 0
            Else
               J = Cint(valeur)
            End If
            valeur = ""
         Wend
         J=0
         PasswordCreate = PasswordCreate + Ucase(Chr(J))
      Case "(L)"
         'calcul la lettre minuscule
         J = 0
         While J<97 Or J > 122      
            valeur = Strleft(Cstr(Rnd()*1000),".")
            If Trim(valeur) = "" Then
               J = 0
            Else
               J = Cint(valeur)
            End If
            valeur = ""
         Wend
         J=0
         PasswordCreate = PasswordCreate + Lcase(Chr(J))
      Case "(C)"
         'calcul le chiffre
         PasswordCreate = PasswordCreate + Trim(Left(Right(Cstr(Rnd()*10000),2),1))
      Case "(S)"
         'calcul le caractère spécial
         J = 100
         While J > nbSpecialCar
            valeur = Strleft(Cstr(Rnd()*100),".")
            If Trim(valeur) = "" Then
               J = 100
            Else
               J = Cint(valeur)
            End If
            valeur = ""
         Wend
         J=0
         PasswordCreate = PasswordCreate + lstSpecialChar(J)
      Case Else
         'si le valeur n'est pas reconnu comme un "format" inser le texte t'elle qu'elle
         PasswordCreate = PasswordCreate +value
         
      End Select
   End Forall
   
   Erase lstSpecialChar
   vrFormatPSW = Null
   
   Exit Function
ErreurHandle:
   Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   PasswordCreate = ""
   Erase lstSpecialChar
   vrFormatPSW = Null
   Exit Function
End Function
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy
Haut

Messagepar billbock » 01 Sep 2010 à 09:51

Mickael , je me suis permis de modifier ce code
en inversant les lignes
Code : Tout sélectionner
J=0 et PasswordCreate = PasswordCreate + Ucase(Chr(J))
pour le cas majuscule (M)

ainsi que les lignes
Code : Tout sélectionner
J=0  et PasswordCreate = PasswordCreate + Lcase(Chr(J)
pour le cas minuscule (L)

ainsi que les fonction RND pour qu'elles ailles plus vite :

Code : Tout sélectionner
Function PasswordCreate(wFormatPSW As String) As String
   
   'génére un mot de passe complexe en fonction du format demandé
   ' (M) pour une lettre Majuscule
   ' (L) pour une lettre Minuscule
   ' (C) pour un chiffre
   ' (S) pour un caractère spéciale
   
   'séparer chaque parametre d'une virgule, ce qui ne correspondra pas au format sera insré comme telle dans le psw.
   
   'exemple  "(L)","(C)","(S)","M","azerty ","123"
   
   Dim vrFormatPSW As Variant
   Dim lstValue List As String
   Dim i As Integer
   Dim j As Integer
   Dim lstSpecialChar List As String
   Dim nbSpecialCar As Integer
   Dim valeur As String
   Dim char As String
   
   
   On Error Goto ErreurHandle
   
   PasswordCreate = ""
   
   Randomize
   
   'si pas de format, génére un format aléatoire
   If Trim(wFormatPSW) = "" Then
      'taille par défaut   entre 8 et 16 caracteres
      j = 0
      While j< 8 Or j > 16
         valeur = Strleft((Cstr(Rnd()*16)+1),",")
         If Trim(valeur) = "" Then
            j = 0
         Else
            j = Cint(valeur)
         End If
         valeur = ""
      Wend
      
      For i = 1 To j
         Select Case Trim(Left(Right(Cstr(Rnd()*10000),2),1))
         Case "2","4"
            'lettre Majuscule
            lstValue(i) = "(M)"
         Case "6","8"
            'Lettre Minuscule
            lstValue(i) = "(L)"
         Case "1","3","5","7"
            'Chiffre
            lstValue(i) = "(C)"
         Case "0"
            'Caractere spécial
            lstValue(i) = "(S)"
         End Select
      Next     
      j =0
      vrFormatPSW = lstValue
      Erase lstValue
   Else
      vrFormatPSW = Split(wFormatPSW,",")
   End If
   
   'liste des caractères spéciaux utilisable
   lstSpecialChar(0) = "&"
   lstSpecialChar(1) = "#"
   lstSpecialChar(2) = "-"
   lstSpecialChar(3) = "_"
   lstSpecialChar(4) = "@"
   lstSpecialChar(5) = "$"
   lstSpecialChar(6) = "£"
   lstSpecialChar(7) = "%"
   lstSpecialChar(8) = "*"
   lstSpecialChar(9) = "!"
   lstSpecialChar(10) = "?"
   lstSpecialChar(11) = "{"
   lstSpecialChar(12) = "}"
   lstSpecialChar(13) = "["
   lstSpecialChar(14) = "]"
   lstSpecialChar(15) = "\"
   lstSpecialChar(16) = "/"
   lstSpecialChar(17) = "§"
   lstSpecialChar(18) = "."
   lstSpecialChar(19) = ";"
   lstSpecialChar(20) = ","
   lstSpecialChar(21) = "<"
   lstSpecialChar(22) = ">"
   lstSpecialChar(23) = "="
   lstSpecialChar(24) = ":"
   lstSpecialChar(25) = "|"
   lstSpecialChar(26) = " "
   
   nbSpecialCar = 26
   
   Forall value In  vrFormatPSW     
      
      Select Case Ucase(Trim(Cstr(value)))
      Case "(M)"
         'calcul lalettre majuscule
         J = 0
         While J<65 Or J > 90
            valeur = Strleft(Cstr((Rnd()*90)+1),",")
            If Trim(valeur) = "" Then
               J = 0
            Else
               J = Cint(valeur)
            End If
            valeur = ""
         Wend
         PasswordCreate = PasswordCreate + Ucase(Chr(J))
         J=0
      Case "(L)"
         'calcul la lettre minuscule
         J = 0
         While J<97 Or J > 122     
            valeur = Strleft(Cstr((Rnd()*122)+1),",")
            If Trim(valeur) = "" Then
               J = 0
            Else
               J = Cint(valeur)
            End If
            valeur = ""
         Wend
         PasswordCreate = PasswordCreate + Lcase(Chr(J))
         J=0
      Case "(C)"
         'calcul le chiffre
         PasswordCreate = PasswordCreate + Trim(Left(Right(Cstr(Rnd()*10000),2),1))
      Case "(S)"
         'calcul le caractère spécial
         J = 100
         While J > nbSpecialCar
            valeur = Strleft(Cstr((Rnd()*26)+1),",")
            If Trim(valeur) = "" Then
               J = 100
            Else
               J = Cint(valeur)
            End If
            valeur = ""
         Wend
         PasswordCreate = PasswordCreate + lstSpecialChar(J)
         J=0
         
      Case Else
         'si le valeur n'est pas reconnu comme un "format" inser le texte t'elle qu'elle
         PasswordCreate = PasswordCreate +value
         
      End Select
   End Forall
   
   Erase lstSpecialChar
   vrFormatPSW = Null
   
   Exit Function
ErreurHandle:
   Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   PasswordCreate = ""
   Erase lstSpecialChar
   vrFormatPSW = Null
   Exit Function
End Function
Code : Tout sélectionner
Avatar de l’utilisateur
billbock
Modérateur
Modérateur
 
Message(s) : 310
Inscrit(e) le : 15 Fév 2007 à 13:58
Localisation : paris
Haut

Messagepar Michael DELIQUE » 01 Sep 2010 à 22:22

bien vue, merci pour l'optimisation
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy
Haut
Publier une réponse

Retour vers Chaines de caractères

Powered by phpBB® Forum Software © phpBB Group
Traduit par Maël Soucaze et Elglobo © phpBB.fr