Programación General > Visual Basic 6.0 e inferiores

 [SOURCE] Brute Force Dictionary Creator 7913

(1/1)

79137913:
HOLA!!!

Bueno... es un creador de diccionarios ni mas ni menos.

Siguiendo... les dejo una captura, el source y el binario.

Es mas para ejemplo que para usarlo, pero si no tenemos nada funciona :P.



Código


--- Código: Visual Basic ---Const Sym As String = "/\!·$%&/()='""¡¿?<>., :;-_*+" 'SimbolosConst Num As String = "0123456789"                   'NumerosConst Min As String = "abcdefghijklmnopqrstuvwxyz"   'Letras MinusculasConst May As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"   'Letras MayusculasConst SpL As String = "áéíóúàèìòùâêîôûäëïöüçñ"       'Letras Especiales MinusculasConst SpU As String = "ÁÉÍÓÚÀÈÌÒÙÊÎÔÛÄËÏÖÜÇÑ"       'Letras Especiales MayusculasDim Cad As String                                    'Cadena entera de caracteresDim X As Long                                        'Para los Bucles Private Sub Inicio()Dim Letras() As StringDim Posiciones() As LongDim Palabras() As StringDim a As LongDim CT As LongDim CantPos As LongDim 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        LoopTerminado:    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 procesoEnd 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 = AuxArrEnd Function


Descargar Source y Binario:
http://adf.ly/7Wsf8

GRACIAS POR LEER!!!

Navegación

[0] Índice de Mensajes