Public Function MkPwd(Optional Lunghezza As Integer, Optional Template As String) As String
' ***************************************
' By Simone Pestelli s.pestelli@mclink.it
' Luglio 2004
' ***************************************
' 
' Lunghezza ->Lunghezza password
' 
' Sintassi Template
' X -> carattere Maiuscolo o Minuscolo
' U -> carattere Maiuscolo
' L -> carattere Minuscolo
' 9 -> numero
' . -> segno di interpunzione
' ^ -> segno o simbolo
' se viene passato solo la lunghezza della password viene generato una conbinazione casuale di caratterni numeri segni e simboli
' Se viene passato solo il template viene preso come esempio della stringa da realizzare
' se viene passato lunghezza e template viene ripetuto il template nella lunghezza richiesta
' se il template contiene caratteri diversi da quelli ammessi viene genarato casualmente u carattere
 
Dim Carattere As String
Dim Lettere As String
Dim Numeri As String
Dim Segni As String
Dim Simboli As String
Dim Tipologia As String
Dim Ciclo As Integer
Dim Ciclo1 As Integer
Dim Puntatore As Integer
Dim Campione As String
Dim Verifica As String
Dim Valido As Boolean

Randomize
 
Lettere = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Numeri = "0123456789"
Segni = "+-/*;,:."
Simboli = "!£$%&()=?^[]_<>+-/*;,:."
Tipologia = "X9.^UL"
 

If Lunghezza = 0 And Template = "" Then ' non è specificato niente!!!
    MkPwd = "Errore [Numero parametri]"
    Exit Function
End If
 
If Lunghezza <> 0 Then ' se è specificata la lunghezza
    If Template = "" Then ' se il template è vuoto lo creo
            For Ciclo = 1 To Lunghezza
                Campione = Campione & Mid(Tipologia, Int((Len(Tipologia) - 1 + 1) * Rnd + 1), 1)
            Next Ciclo
       Else
            Puntatore = 1 ' altrimenti replico il template nella lunghezza
            For Ciclo = 1 To Lunghezza
                Campione = Campione & Mid(Template, Puntatore, 1)
                Puntatore = Puntatore + 1
                If Puntatore > Len(Template) Then Puntatore = 1
            Next Ciclo
    End If
End If
 
If Lunghezza = 0 Then Campione = Template
 
' verifica sintassi campione
For Ciclo = 1 To Len(Campione) 'scorro la stringa camione
    Carattere = UCase(Mid(Campione, Ciclo, 1)) ' prendo un carattere del campione
    Valido = False
        For Ciclo1 = 1 To Len(Tipologia)
            If Carattere = Mid(Tipologia, Ciclo1, 1) Then Valido = True ' confronto il carattere con il campione se è valido ->true
        Next Ciclo1
    If Not Valido Then ' se il carattere non è valido lo metto a caso
        Carattere = Mid(Tipologia, Int((Len(Tipologia) - 1 + 1) * Rnd + 1), 1)
    End If
    Verifica = Verifica & Carattere
Next Ciclo

For Ciclo = 1 To Len(Verifica) ' infine genero la password
 
    Select Case Mid(Verifica, Ciclo, 1)
        Case "X"
            Carattere = Mid(Lettere, Int((Len(Lettere) - 1 + 1) * Rnd + 1), 1)
        Case "U"
            Carattere = UCase(Mid(Lettere, Int((Len(Lettere) - 1 + 1) * Rnd + 1), 1))
        Case "L"
            Carattere = LCase(Mid(Lettere, Int((Len(Lettere) - 1 + 1) * Rnd + 1), 1))
        Case "9"
            Carattere = Mid(Numeri, Int((Len(Numeri) - 1 + 1) * Rnd + 1), 1)
        Case "."
            Carattere = Mid(Segni, Int((Len(Segni) - 1 + 1) * Rnd + 1), 1)
        Case "^"
            Carattere = Mid(Simboli, Int((Len(Simboli) - 1 + 1) * Rnd + 1), 1)
    End Select
 
    MkPwd = MkPwd & Carattere
 
Next Ciclo

End Function

Download:
 
  Password.zip (28Kb) MSAccess97/2000 database