[SOURCE] Brute Force Dictionary Creator by 79137913

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 .



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:
You are not allowed to view links. Register or Login

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!!!

@You are not allowed to view links. Register or Login :
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!!!

@You are not allowed to view links. Register or Login:
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!!!