HOLA!!!
Bueno... es un creador de diccionarios ni mas ni menos, funciona muy rapido.
Siguiendo... les dejo una captura, el source y el binario.
Es mas para ejemplo que para usarlo, pero si no tenemos nada funciona :P.
(http://i.imgur.com/3qyRxNZ.png)
Const Sym As String = "/\!·$%&/()='""¡¿?<>., :;-_*+" 'Simbolos
Const Num As String = "0123456789" 'Numeros
Const Min As String = "abcdefghijklmnopqrstuvwxyz" 'Letras Minusculas
Const May As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'Letras Mayusculas
Const SpL As String = "áéíóúàèìòùâêîôûäëïöüçñ" 'Letras Especiales Minusculas
Const SpU As String = "ÁÉÍÓÚÀÈÌÒÙÊÎÔÛÄËÏÖÜÇÑ" 'Letras Especiales Mayusculas
Dim Cad As String 'Cadena entera de caracteres
Dim X As Long 'Para los Bucles
Private Sub Inicio()
Dim Letras() As String
Dim Posiciones() As Long
Dim Palabras() As String
Dim a As Long
Dim CT As Long
Dim CantPos As Long
Dim CantLet As Long
Letras = CharSplit7913(Cad)
CantLet = UBound(Letras)
Open "C:\Dic7913.txt" For Output As #1
Close #1
ReDim Palabras(1000)
For a = 0 To Val(MinMaxL(1).Text) - Val(MinMaxL(0).Text)
CantPos = MinMaxL(0) + a - 1
ReDim Posiciones(CantPos)
Do
For X = 0 To CantPos
Palabras(CT) = Palabras(CT) & Letras(Posiciones(X))
Next
CT = CT + 1
Posiciones(0) = Posiciones(0) + 1
For X = 0 To CantPos - 1
If Posiciones(X) > CantLet Then Posiciones(X) = 0: Posiciones(X + 1) = Posiciones(X + 1) + 1
Next
If CT = 1001 Then
Open "C:\Dic7913.txt" For Append As #1
For X = 0 To 1000
Print #1, Palabras(X)
Next
Close #1
ReDim Palabras(1000)
CT = 0
End If
If Posiciones(CantPos) = CantLet + 1 Then GoTo Terminado
Loop
Terminado:
Next
If CT <> 0 Then
Open "C:\Dic7913.txt" For Append As #1
For X = 0 To CT
Print #1, Palabras(X)
Next
Close #1
CT = 0
End If
MsgBox "Terminado", vbInformation, "Atencion"
End Sub
Private Sub Caracteres_Click(Index As Integer)
'Limita el checkbox de los caracteres extra si el cuadro de texto esta vacio
If Index = 6 And Len(ExtraCHR.Text) = 0 Then Caracteres(6).Value = 0: MsgBox "El cuadro de texto de caracteres extra debe tener al menos un caracter", vbCritical, "Error"
End Sub
Private Sub Go_Click()
Dim FlagCheck As Boolean
'Comprobacion de los minimos y maximos de longitud
If Val(MinMaxL(0).Text) = 0 Then MsgBox "El minimo de longitud no puede ser cero", vbCritical, "Error": Exit Sub
If Val(MinMaxL(1).Text) = 0 Then MsgBox "El maximo de longitud no puede ser cero", vbCritical, "Error": Exit Sub
If Val(MinMaxL(0).Text) - Val(MinMaxL(1).Text) > 0 Then MsgBox "El maximo de longitud no puede ser menor que el minimo", vbCritical, "Error": Exit Sub
'Comprobacion de los checkboxes, minimo uno debe estar tildado
For X = 0 To 6
If Caracteres(X).Value = 1 Then FlagCheck = True
Next
If FlagCheck = False Then MsgBox "Seleccione primero con que caracteres quiere hacer el diccionario", vbCritical, "Error": Exit Sub
Cad = vbNullString 'Vacio el string Cad por si estaba lleno
'Lleno cad con la seleccion del usuario
If Caracteres(0).Value = 1 Then Cad = Num
If Caracteres(1).Value = 1 Then Cad = Cad & Sym
If Caracteres(2).Value = 1 Then Cad = Cad & Min
If Caracteres(3).Value = 1 Then Cad = Cad & Max
If Caracteres(4).Value = 1 Then Cad = Cad & SpL
If Caracteres(5).Value = 1 Then Cad = Cad & SpU
If Caracteres(6).Value = 1 Then Cad = Cad & ExtraCHR.Text
MsgBox "El Proceso esta por Comenzar, esto podria tardar mucho tiempo para frenarlo presione Ctrl+Shift+Esc y termine el proceso, el diccionario quedara incompleto (este se guarda en c:\Dic7913.txt)", vbInformation, "Atencion - Por Comenzar"
Call Inicio ' llamo al inicio de proceso
End Sub
Private Sub MinMaxL_KeyPress(Index As Integer, KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0 'Verifica que solo se ingresen numeros en el desde hasta.
End Sub
Private Function CharSplit7913(expression As String) As String()
Dim lExp As Long
Dim ExpB() As Byte
Dim AuxArr() As String
ExpB = expression
lExp = UBound(ExpB)
ReDim AuxArr(lExp)
For X = 0 To lExp Step 2
AuxArr(X / 2) = ChrW(ExpB(X))
Next
ReDim Preserve AuxArr(Int(lExp / 2))
CharSplit7913 = AuxArr
End Function
Descargar Source y Binario:
Mediafire (http://www.mediafire.com/?ma3l3278prf61wb)
GRACIAS POR LEER!!!
Gracias, para mí va a ser muy útil.
Cuanto tardaría en hacer un diccionario de longitud 8
saludos flamer y no se traba la ventana del programa
HOLA!!!
@Flamer (https://underc0de.org/foro/index.php?action=profile;u=20389) :
Eso dependerá de 3 factores:
- Cantidad de caracteres utilizados (si usamos mas tarda mas)
- Velocidad de escritura del disco (un HDD sera mucho mas lento que un SSD)
- Velocidad de tu procesador (este debería ser el que menos influye, pero si las condiciones anteriores son iguales en 2 sistemas el que tenga mejor procesador terminará primero)
Por ende no se puede calcular.
P.D: en cuanto a lo que decis de "no se traba la ventana" supongo que queres decir lo contrario es decir "se traba la ventana" es por que tu procesador esta trabajando al máximo, dejalo y cuando termine todo funcionará.
P.D2: aunque no lo parezca este programa en Visual Basic ha demostrado ser mas veloz que algoritmos similares en C, por ende recomiendo su uso.
GRACIAS POR LEER!!!
Creo que puedes usar un hilo para que la ventana no se trabe y siga funcionando bien, te digo esto por que hace poco estuve realizando un programa y tuve que realizar un hilo para que la ventana siguiera funcionando
saludos Flamer y solo le pasas todo el proceso al hilo
HOLA!!!
@Flamer (https://underc0de.org/foro/index.php?action=profile;u=20389):
Podria haber hecho que la ventana no se trabe de dos modos:
1- Usando hilos (lo cual es muy inestable[en vb6] y consideradamente mas lento).
2- Liberando el procesador de vez en cuando (reduciendo el rendimiento y velocidad de la aplicacion).
Haz comparativas, se freeza todo pero es mas veloz que la mayoria.
GRACIAS POR LEER!!!
Y, ¿no se podría poner tipo una barra de progreso en algun otro lado?
HOLA!!!
Si, totalmente, aunque bajaria la performance.
GRACIAS POR LEER!!!