Sfida di Carnevale: validatore di password

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Questa sfida è abbastanza facile. Si può onorare anche tra una chiacchiera e l'altra (o tra un grostolo e l'altro, come volete)   

Si tratta di creare una Function in VBA che validi una password inserita dall'utente secondo i seguenti criteri:
* La lunghezza della password deve essere compresa tra 8 e 16 caratteri.
* Deve contenere almeno una lettera maiuscola.
* Deve contenere almeno una lettera minuscola.
* Deve contenere almeno un numero.
* Deve contenere almeno uno dei seguenti caratteri speciali: ! @ # $ % *

La Function restituisce un valore True/False che indica se la password inserita soddisfa tutti i criteri di validazione o meno.

Potete utilizzare l'approccio che desiderate (si tratta fondamentalmente di una manipolazione di stringhe, sotto condizioni complesse e se volete renderla più interessante potete utilizzare le "espressioni regolari" in VBA).

Buon lavoro    

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Non sono capace con le Function,  me la correggete in modo da capire?

`Sub password()
Dim Passw As String, X As Long, A
Passw = "123abcABC!@#$*"
Control = False
If Len(Passw) >= 8 And Len(Passw) <= 16 Then Control = True
    If Control <> True Then MsgBox "Non valida": Exit Sub
For X = 1 To Len(Passw)
    Control = False
    A = Mid(Passw, 1, X)
    Select Case Asc(A)
    Case 48 To 57
        Control = True
    Case 64 To 90 '@
        Control = True
    Case 97 To 122
        Control = True
    Case 33 To 37 Or 42
        Control = True
    End Select
    If Control <> True Then MsgBox "Non valida": Exit Sub
Next
MsgBox "Password OK"
End Sub`

[scossaPartecipante scossa Karma: 37 pts]

Due UDF del tutto simili ma con una differenza sostanziale.

CheckPass:

Public Function CheckPass(ByVal sPass As String) As Boolean
  'by scossa
  Dim nLen As Integer, bChars As Boolean, bSymb As Boolean, bLen As Boolean
  
  nLen = Len(sPass)
  bLen = (nLen > 7) And (nLen < 17)
  bSymb = (sPass Like "*!*" Or sPass Like "*[#]*" Or sPass Like "*$*" Or _
    sPass Like "*%*" Or sPass Like "*[*]*" Or sPass Like "*@*") And Not sPass Like "*[ ]*"
  bChars = sPass Like "*#*" And sPass Like "*[a-z]*" And sPass Like "*[A-Z]*"
  CheckPass = bChars And bSymb And bLen
End Function

CheckPswrd:

Public Function CheckPswrd(ByVal sPass As String) As Boolean
  'by scossa
  Dim nLen As Integer
  
  nLen = Len(sPass)
  If (nLen > 7) And (nLen < 17) And Not sPass Like "*[ ]*" Then
    If sPass Like "*#*" Then
      If sPass Like "*[a-z]*" Then
        If sPass Like "*[A-Z]*" Then
          If sPass Like "*!*" Or sPass Like "*[#]*" Or sPass Like "*$*" Or _
            sPass Like "*%*" Or sPass Like "*[*]*" Or sPass Like "*@*" Then
            CheckPswrd = True
          End If
        End If
      End If
    End If
  End If
End Function

da testare con questa sub:

Sub test()
  Dim sPass As String
  
  sPass = "12A3$BJ45"
  Debug.Print "CheckPass: " & CheckPass(sPass)
  Debug.Print "CheckPswrd: " & CheckPswrd(sPass)
End Sub

Ovviamente, essendo UDF, possono essere usate lato celle:

in A1 la password

in B1 =CheckPass(A1)

in C1 =CheckPswrd(A1)

Edit: modificato per non ammetere spazi nella password.

[scossaPartecipante scossa Karma: 37 pts]

Soluzione con RegEx, anche se i pattern si trovano quasi pronti con una ricerca in google:

Public Function CheckPwRe(ByVal sPass As String) As Boolean
  'Riferimenti: Microsoft VBScript Regular Expression 5.5
  'oppure As Object e Set oRE = CreateObject("vbscript.regexp")
  Dim oRE As Object
  
  Set oRE = CreateObject("vbscript.regexp")
  With oRE
    .Global = True
    .IgnoreCase = False
    .Pattern = ^(?=\S*[!@#*$%])(?=\S*\d)(?=\S*[a-z])(?=\S*[A-Z])\S{8,16}$ 
	     'era "^(?=.*[!@#$%])(?=.*\d)(?=.*[a-z])(?=.*[A-Z]).{8,16}$"
    If .test(sPass) Then
      CheckPwRe = True
    End If
  End With
  Set oRE = Nothing
End Function

N.B.: modificato pattern per non ammettere Spazi nella password

[GiuseppeMNPartecipante GiuseppeMN Karma: 19 pts]

Buona giornata a Tutti;
prelimarmente mi scuso se non propongo una Function ma un Codice VBA che, molto indegnamente, ho cercato di strutturare.

Option Explicit

Sub Verifica()
Dim Titolo As String, Messaggio As String, Default As String, PSW As String
Dim x As Byte
Dim y
Dim Ctr As Boolean

10:
Titolo = "Password"
Messaggio = "Inserire la password rispettando i seguenti vincoli:" & Chr(10) _
& "* lunghezza >=8 e <=16 caratteri" & Chr(10) _
& " Contenere" & Chr(10) _
& "* Almeno una lettera maiuscola." & Chr(10) _
& "* Almeno una lettera maiuscola." & Chr(10) _
& "* Almeno una lettera minuscola." & Chr(10) _
& "* Un numero e almeno uno dei caratteri: ! @ # $ % *"
Default = ""
PSW = Application.InputBox(Messaggio, Titolo, Default)
Cells(2, 1).Value = PSW
If Len(PSW) = 0 Then
MsgBox "La lunghezza della Passwrd non può essere nulla."
End
End If
If Len(PSW) < 6 Or Len(PSW) > 16 Then
MsgBox "La lunghezza della Passwrd non rispetta i criteri imposti."
GoTo 10
End If
' Verifiche
Ctr = False
For x = 1 To Len(PSW)

y = Mid(PSW, x, 1)
Select Case Asc(y)
Case 65 To 90 ' Carattere maiuscolo
Ctr = True
End Select
Next x
If Ctr = False Then MsgBox "Password non valida": End

Ctr = False
For x = 1 To Len(PSW)

y = Mid(PSW, x, 1)
Select Case Asc(y)
Case 97 To 122 ' Carattere minuscolo
Ctr = True
End Select
Next x
If Ctr = False Then MsgBox "Password non valida": End

Ctr = False
For x = 1 To Len(PSW)

y = Mid(PSW, x, 1)
Select Case Asc(y)
Case 48 To 57 ' Carattere numerico
Ctr = True
End Select
Next x
If Ctr = False Then MsgBox "Password non valida": End

For x = 1 To Len(PSW)
Ctr = False
y = Mid(PSW, x, 1)
Select Case Asc(y)
Case 33 ' !
Ctr = True
Case 35 ' #
Ctr = True
Case 36 ' $
Ctr = True
Case 37 ' %
Ctr = True
Case 42 ' *
Ctr = True
Case 64 ' @
Ctr = True
End Select
Next x
If Ctr = True Then
MsgBox "Password valida."
Else
MsgBox "Password non valida."
End If
End Sub

In reatà potrei impegnarmi a proporre una Function ma servirebbe ... una cassa di birra, preferibilmente ghiacciata, da bere in compagnia         

Buon fine settimana a Tutti.

Giuseppe

[scossaPartecipante scossa Karma: 37 pts]

Raffaele53 ha scritto:

me la correggete in modo da capire?

Primo errore: 

A = Mid(Passw, 1, X)
Select Case Asc(A)

prende in considerazione sempre e solo la prima lettera di Passw; modifica in:

A = Mid(Passw, X, 1)

Poi, corretto quanto sopra, per come hai strutturato il ciclo basta che nella password non ci siano caratteri non compresi nel pattern perché sia ritenuta valida (p.e. Passw = "aaaaaaaaaa").

Quindi devi rivedere la logica dei controlli.

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Mi domandavo perchè i codici di Scossa non funzionavano?
Dopo 30 minuti ho capito. Cosa manca in "12A3$BJ45" ??? il minuscolo

Ps. ho visto adesso la Tua risposta, ricontrollo il tutto

EDIT

Ok, grazie al post di scossa, ho notato i miei due gravi errori
Comunque chiedevo come far diventare una Sub in Function?

`Sub password()
Dim Passw As String, X As Long, A As String, B As String, C As String, D As String, E As String, Car  As String
Passw = "123abcABC!@#$*"
If Len(Passw) >= 8 And Len(Passw) <= 16 Then A = 1
For X = 1 To Len(Passw)
    Car = Mid(Passw, X, 1)
    Select Case Asc(Car)
    Case 48 To 57 '0123456789
        B = 2
    Case 65 To 90 'A-Z
        C = 3
    Case 97 To 122
        D = 4 ' a-z
    Case 33 To 37 Or 42 Or 64
        E = 5 '! @ # $ % *
    End Select
Next
If A & B & C & D & E = "12345" Then MsgBox "Password OK" Else MsgBox "Password Errata"
End Sub`

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao io ho usato semplicemente dei like.

Una prima Function versione corta fa solo la verifica,

La seconda prepara anche un messaggio pr spiegare la verifica.

Penso ma non sono sicuro che  Option Compare Binary sia il defoult perci' scriverlo è pleonastico...

Option Explicit
Option Compare Binary

Public Function VerificaPassword_Luca73_Short(Password As String) As Boolean
VerificaPassword_Luca73_Short = (((Len(Password) < 8) Or (Len(Password) > 16)) Or (Not (Password Like "*[A-Z]*")) Or (Not (Password Like "*[a-z]*")) Or (Not (Password Like "*[0-9]*")) Or Not (Password Like "*[(!) @ (#) $ % (*) ]*"))
End Function

 

Option Explicit
Option Compare Binary

Public Function VerificaPassword_Luca73(Password As String, Optional TestoEsteso As Boolean = False) As Boolean

Dim Risultato
Dim Risultato2
Risultato = True
Risultato2 = ""
If ((Len(Password) < 8) Or (Len(Password) > 16)) Then
    Risultato = False
    Risultato2 = "Lunghezza Non Conforme"
Else
    Risultato2 = "Lunghezza OK"
End If
If Not (Password Like "*[A-Z]*") Then
    Risultato = False
    Risultato2 = Risultato2 & vbCrLf & "No Maiuscola"
Else
    Risultato2 = Risultato2 & vbCrLf & "Maiuscola OK"
End If
If Not (Password Like "*[a-z]*") Then
    Risultato = False
    Risultato2 = Risultato2 & vbCrLf & "No minuscola"
Else
    Risultato2 = Risultato2 & vbCrLf & "Minuscola OK"

End If
If Not (Password Like "*[0-9]*") Then
    Risultato = False
    Risultato2 = Risultato2 & vbCrLf & "No Numero"
Else
    Risultato2 = Risultato2 & vbCrLf & "Numero OK"
End If
If Not (Password Like "*[(!) @ (#) $ % (*) ]*") Then
    Risultato = False
    Risultato2 = Risultato2 & vbCrLf & "No Carattere Speciale"
Else
    Risultato2 = Risultato2 & vbCrLf & "Carattere Speciale OK"
End If
VerificaPassword_Luca73 = Risultato

If TestoEsteso Then
    MsgBox Risultato2
End If

End Function

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Raffaele53 ha scritto:

Non sono capace con le Function

La Function è concettualmente simile a una Sub con la differenza che restituisce nu valore, che puoi riutilizzabile dopo la chiamata.

scossa ha scritto:

Due UDF del tutto simili ma con una differenza sostanziale

La prossima volta devo ricordarmi di mettere una partenza temporalmente sfalsata per scossa   

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

GiuseppeMN ha scritto:

ma servirebbe ... una cassa di birra

Ah bè, io ci sono sempre   

[scossaPartecipante scossa Karma: 37 pts]

Luca73 ha scritto:

Una prima Function versione corta fa solo la verifica,

Sicuro che sia corretta? a me accetta tutto, p.e. "as12fg" o anche "" 

La versione lunga va bene, ma accetta il carattere Spazio che non è incluso da V.F. nella lista dei caratteri speciali (in effetti ho dovuto anch'io adattare le mie per escluderlo).

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Luca73 ha scritto:

Penso ma non sono sicuro che  Option Compare Binary sia il default percio' scriverlo è pleonastico

E' esatto.

Raffaele53 ha scritto:

chiedevo come far diventare una Sub in Function?

La parola chiave è appunto "Function" invece di "Sub".

A parte il fatto che la Function restituisce un risultato assegnandolo al suo valore di ritorno, per il resto non ci sono differenze. In una Function ci possono stare tutte i parametri, le variabili, le istruzioni, le assegnazioni, i cicli, le decisioni eccetera  che metteresti un una Sub.

Certo, anche una Sub può restituire un risultato, ma solo come esito di un'assegnazione a una variabile globale. La Function non ha bisogno di questo perchè il risultato è assegnato al suo nome e tu utilizzi quello come valore di ritorno.

Function AreaDelTriangolo(base as single, altezza as single) as single
Dim calcolo as single
    
    calcolo = base * altezza / 2
    AreaDelTriangolo = calcolo
End Function

Sub test()
dim myarea as single
dim base as single
dim altezza as single

    base = 15.4
    altezza = 23.2
    myarea = AreaDelTriangolo(base, altezza)
    msgbox "Area del triangolo = " & myarea
End Sub
    

 

 

 

[scossaPartecipante scossa Karma: 37 pts]

Luca73 ha scritto:

If Not (Password Like "*[(!) @ (#) $ % (*) ]*") Then

ti copio spudoratamente  questo pattern per semplifcare le mie due:

Public Function CheckPswrd(ByVal sPass As String) As Boolean
  'by scossa
  Dim nLen As Integer
  
  nLen = Len(sPass)
  If (nLen > 7) And (nLen < 17) And Not sPass Like "*[ ]*" Then
    If sPass Like "*#*" Then
      If sPass Like "*[a-z]*" Then
        If sPass Like "*[A-Z]*" Then
          If sPass Like "*[(!)@(#)$%(*)]*" Then CheckPswrd = True
        End If
      End If
    End If
  End If
End Function

Public Function CheckPass(ByVal sPass As String) As Boolean
  'by scossa
  Dim nLen As Integer, bChars As Boolean, bSymb As Boolean, bLen As Boolean
  
  nLen = Len(sPass)
  bLen = (nLen > 7) And (nLen < 17)
  bSymb = sPass Like "*[(!)@(#)$%(*)]*" And Not sPass Like "*[ ]*"
  bChars = sPass Like "*#*" And sPass Like "*[a-z]*" And sPass Like "*[A-Z]*"
  CheckPass = bChars And bSymb And bLen
End Function

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

Edit: modificato per non ammettere spazi nella password.

Ammetto che quella di non consentire spazi è stato un po' un tiro basso   

[scossaPartecipante scossa Karma: 37 pts]

vecchio frac ha scritto:

anche una Sub può restituire un risultato, ma solo come esito di un'assegnazione a una variabile globale.

So che hai voluto semplificare, ma per maggior chiarezza, esiste anche un altro modo:

Sub prova()
  Dim nNum As Long
  nNum = 6
  Raddoppia nNum
  MsgBox nNum
End Sub


Sub Raddoppia(ByRef nX As Long)
  nX = nX * 2
End Sub

il punto chiave è il passaggio ByRef dell'argomento.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Sì, la rettifica è importante.

E' una costruzione che utilizzo piuttosto poco e in verità solo con pochi oggetti ben definiti (principalmente Dictionary). Trovo pericoloso e subdolo (perchè me ne dimenticherei) che la variabile passata per riferimento invece che per valore modifichi la variabile originale: se non ricordo male, alla routine è passato il puntatore alla memoria occupata dalla variabile, cioè il riferimento diretto allo spazio di memoria della variabile. In questo senso è come se la variabile fosse pubblica... non lo è naturalmente, perchè è dichiarata e usata solo nella routine cui appartiene, ma viene resa disponibile al pubblico ludibrio e ogni intervento ne influenza il valore originale.

[scossaPartecipante scossa Karma: 37 pts]

vecchio frac ha scritto:

Trovo pericoloso e subdolo (perchè me ne dimenticherei) che la variabile passata per riferimento invece che per valore modifichi la variabile originale

E pensa che è la modalità di default   

ByRef
Facoltativa. Indica che l'argomento viene passato per riferimento. Impostazione predefinita in Visual Basic.

quindi se te ne dimentichi ....,  per questo quando una sub può riceve un argomento (ma anche per le function) specifico sempre ByVal o ByRef a seconda della necessità.

[maxpitPartecipante maxpit Karma: 7 pts]

Buon pomeriggio a tutti,

provo anche io a partecipare ... ecco la mia versione: funzione VerificaPsw() così strutturata

`Option Explicit

Public Function VerificaPsw(ByVal sPsw As String) As Boolean

    Dim i As Long          ' contatore carattere per verifica psw
    Dim bMaiu As Boolean   ' presenza maiuscole
    Dim bMinu As Boolean   ' presenza minuscole
    Dim bNumr As Boolean   ' presenza numero
    Dim bSpec As Boolean   ' presenza carattere speciale
    Dim Rif As Byte        ' Codice carattere da verificare
    
    If Len(sPsw) Then
        For i = 1 To Len(sPsw)
            Rif = Asc(Mid$(sPsw, i, 1))
            ' 33, 35-37, 48-57, 64-90, 97-122 -> caratteri validi
            If (Rif < 33 Or Rif = 34 Or (Rif > 37 And Rif < 48) Or (Rif > 57 And Rif < 64) _
                Or (Rif > 90 And Rif < 97) Or Rif > 122) Then
                Exit Function
            End If
            If Not (bMaiu) Then
                If Rif > 64 And Rif < 91 Then bMaiu = True
            End If
            If Not (bMinu) Then
                If Rif > 96 And Rif < 123 Then bMinu = True
            End If
            If Not (bNumr) Then
                If Rif > 47 And Rif < 58 Then bNumr = True
            End If
            If Not (bSpec) Then
                If Rif = 33 Or Rif = 64 Or (Rif > 34 And Rif < 38) Then bSpec = True
            End If
        Next i
        VerificaPsw = Len(sPsw) > 7 And Len(sPsw) < 17 And bMaiu And bMinu And bNumr And bSpec
    End If
    
End Function`

Per utilizzarla in una cella del foglio Excel (es. A1) si scrive =VerificaPsw("ProvaPsw1*") oppure se la password è contenuta in altra cella("A2") si scrive =VerificaPsw(A2)

A presto.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

per questo quando una sub può riceve un argomento (ma anche per le function) specifico sempre ByVal o ByRef a seconda della necessità

Ah ecco! io lo faccio per abitudine ma senza pensarci. Bè, scossa forever   

[MirkoPartecipante Mirko Karma: 2 pts]

Trovata in rete e adattata per la sfida

Con riferimento a: Microsoft VBScript Regular Expressions 5.5

=TestPassword(A1)

`Option Explicit

'Requires a reference to Microsoft VBScript Regular Expressions x.x
Private Function TestPassword(inValue As String) As Boolean
    Dim criteria As Variant
    With New RegExp
        For Each criteria In Split(".{8},[A-Z],[a-z],[0-9],[!@#$%*]", ",")
            .Pattern = criteria
            If Not .Test(inValue) Then Exit Function
        Next
    End With
    If Len(inValue) < 17 Then TestPassword = True
End Function
`

[maxpitPartecipante maxpit Karma: 7 pts]

Buonasera Mirko,

prova a verificarla perché ho fatto un check e se uso gli spazi, mi segnala Vero, ma non mi sembra un carattere ammesso. 

A presto

 

[MirkoPartecipante Mirko Karma: 2 pts]

Modifichiamo con

 

Option Explicit

'Requires a reference to Microsoft VBScript Regular Expressions x.x
Private Function TestPassword(inValue As String) As Boolean
    Dim criteria As Variant
    With New RegExp
        For Each criteria In Split(".{8},[A-Z],[a-z],[0-9],[!@#$%*]", ",")
            .Pattern = criteria
            If Not .Test(inValue) Then Exit Function
        Next
    End With
    Debug.Print UBound(Split(inValue))
    If Len(inValue) < 17 And UBound(Split(inValue)) = 0 Then TestPassword = True
End Function

[albatros54Moderatore albatros54 Karma: 89 pts]

@ Francesco(vecchio_frac).Volevo fare un appunto, circa la velocita con cui gli utenti postano le loro soluzione,nel senso che bisognerebbe mettere delle regole come è quando postare le loro soluzioni.
Gli utenti terrestri , secondo me possono postare le loro soluzioni subito dopo la pubblicazione del quesito,per quanto riguarda l'altra categoria, tipo Alieni informatici piu veloci di Hermes ,si dovrebbero mette degli ostacoli tipo:
1°) possono pubblicare la loro soluzione dopo 48 ore della messa in rete del quesito.

2°) posssono avere a disposizione una tastiera dove digitare,non QWERTY, ma bensi GIAPPONESE

3°) durante la digitalizzazione, possono usare solamente la mano SX, bloccando il dito Indice e il Medio.

4°) oscurare la schermata del VBA ogni 30 Secondi con reset completo del PC.

Una saluto a Marco(scossa)    

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Luca73Partecipante Luca73 Karma: 58 pts]

Comunque scossa che mi dice 

ti copio spudoratamente   questo pattern per semplifcare le mie due:

 è da incorniciare e tenere per quei momenti in cui l'autostima vacilla

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

albatros54 ha scritto:

Gli utenti terrestri , secondo me

Sì ci stavo pensando   

Luca73 ha scritto:

 è da incorniciare e tenere per quei momenti in cui l'autostima vacilla

E' vero! Volevo dirlo io   

[Autore]

Articoli