Este codigo lo hice hace un rato espero que les ayude en algo, de todos modos vienen varias funciones que talvez les sirvan para entenderlas y aplicarlas en otros programas, si tienen un:
ComentarioQuejaDuda o Si se puede hacer mejor posteen
´Código:Public Function Genera_Pass(Longitud As Byte, Optional MiCadena As String = "", Optional Codigo_ansii As Boolean = False, _ Optional Numeros As Boolean = False, Optional Minusculas As Boolean = False, Optional Mayusculas As _ Boolean = False, Optional Especiales As Boolean = False, Optional bRepetir As Boolean = True) 'Longitud = Parametro para SAber de cuantos caracteres se hara el pass 'MiCadena = PArametro para trabajar con los caracteres seleccionados por el usuario 'Codigo_ansi = Parametro para trabajar con todos los caracteres 'Numeros,Minusculas,Mayusculas,Especiales = PArametros para armar la cadena con lo que seleccione el usuario On Error GoTo eti 'Constantes de cadenas Const sNum = "1234567890" Const sMin = "abcdefghijklmnopqrstuvwxyz" Const sMay = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Const sEsp = "[]{}!¡¿?#$%&/()" Dim sIn As String 'Variable para armar la contraseña Dim sFi As String 'Variable para armar la cadena sobre la que se va a sacar la contraseña Dim i As Integer 'Variable para los bucles Dim iRan As Integer 'Variable para saber la posicion de donde vamos a sacar el caracter Dim iCadFin As Integer 'Variable para saber la longitud de la cadena armada sFi = "" 'Iniciamos la variable por si las dudas If MiCadena = "" Then 'Si esta es diferente entonces ya no arma nada If Codigo_ansii = True Then 'Si se escoge el codigo ansi como verdadero entonces ya no checa nada mas For i = 33 To 126 'Bucle para armar la cadena con los caracteres ascii del 33 al 126 sFi = sFi & Chr(i) Next Else 'Las siguientes condiciones son para armar la cadena segun las opciones seleccionadas If Numeros = True Then sFi = sFi & sNum If Minusculas = True Then sFi = sFi & sMin If Mayusculas = True Then sFi = sFi & sMay If Especiales = True Then sFi = sFi & sEsp End If Else sFi = MiCadena End If iCadFin = Len(sFi) 'Aqui se sabe la logitud de la cadena final If bRepetir = False Then If Longitud > iCadFin Then Longitud = iCadFin End If If iCadFin = 0 Or Longitud < 1 Then 'Si la cadena final es "" lo longitud es menor de 1 entonces Pone mi Alias JeJe ;-) Genera_Pass = "ZiTrO": Exit Function End If For i = 1 To Longitud 'Bucle para hacer el pass con la longitud seleccionada Randomize 'Empieza la funcion de numeros aleatorios Do iRan = Round(Rnd(iCadFin) * iCadFin, 0) 'Aqui generamos la posicion aleatoria de un numero valido dentro de la cadena de caracteres 'Round = Redondeamos el valor obtenido del Rnd 'Rnd = Aqui hacemos el azar y como nos da un valor entre 0 y 1 entonces lo multiplicamos y lo redondeamos Loop While iRan = 0 'Si el azar nos da 0 lo volvemos a hacer, por que en el mid nos daria error el 0 sIn = sIn & Mid(sFi, iRan, 1) 'Aqui ya obtenemos el caracter y lo concatenamos con el anterior If bRepetir = False Then sFi = Replace(sFi, Mid(sFi, iRan, 1), "") iCadFin = iCadFin - 1 End If Next Genera_Pass = sIn 'Aqui ya Asignamos el valor de la cadena a la funcion Exit Function eti: MsgBox Err.Number & " " & Err.Description, vbExclamation, "Error a Tratar" End Function
Se le llama asi:
Código:Private Sub Form_Load() me.Caption = Genera_Pass(3, , True)'El 3 puede ser un valor entre 1 y 255 para aumentar solo cambien la longitud as byte por longitud as integer o long End Sub
Tiene el error de que no quita los caracteres especiales que a veces windows u otras paginas nos piden que no pongamos, a ver si en otra revisada le agrego esa parte del code, de todos modos por alguna duda posteen
Edit: Le <agregue lo de no repetir caracteresEdited by: Zitro