comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[SOURCE] Brute Force Dictionary Creator 7913

  • 1 Respuestas
  • 1839 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado 79137913

  • *
  • Moderator
  • Mensajes: 631
  • Actividad:
    6.67%
  • Reputación 11
  • 4 Esquinas
    • Ver Perfil
    • Doors.Party
    • Email
  • Skype: fg_mdq@hotmail.com
« en: Mayo 28, 2013, 03:17:55 pm »
HOLA!!!

Bueno... es un creador de diccionarios ni mas ni menos, pero al trabajar con strings anda rapido. Igual funciona bastante bienn :P.

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: Visual Basic
  1.     Const Sym As String = "/\!·$%&/()='""¡¿?<>., :;-_*+" 'Simbolos
  2.    Const Num As String = "0123456789"                   'Numeros
  3.    Const Min As String = "abcdefghijklmnopqrstuvwxyz"   'Letras Minusculas
  4.    Const May As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"   'Letras Mayusculas
  5.    Const SpL As String = "áéíóúàèìòùâêîôûäëïöüçñ"       'Letras Especiales Minusculas
  6.    Const SpU As String = "ÁÉÍÓÚÀÈÌÒÙÊÎÔÛÄËÏÖÜÇÑ"       'Letras Especiales Mayusculas
  7.    Dim Cad As String                                    'Cadena entera de caracteres
  8.    Dim X As Long                                        'Para los Bucles
  9.    
  10.     Private Sub Inicio()
  11.     Dim Letras() As String
  12.     Dim Posiciones() As Long
  13.     Dim Palabras() As String
  14.     Dim a As Long
  15.     Dim CT As Long
  16.     Dim CantPos As Long
  17.     Dim CantLet As Long
  18.        Letras = CharSplit7913(Cad)
  19.        CantLet = UBound(Letras)
  20.        Open "C:\Dic7913.txt" For Output As #1
  21.        Close #1
  22.        ReDim Palabras(1000)
  23.        For a = 0 To Val(MinMaxL(1).Text) - Val(MinMaxL(0).Text)
  24.            CantPos = MinMaxL(0) + a - 1
  25.            ReDim Posiciones(CantPos)
  26.            Do
  27.            For X = 0 To CantPos
  28.                Palabras(CT) = Palabras(CT) & Letras(Posiciones(X))
  29.            Next
  30.            CT = CT + 1
  31.            Posiciones(0) = Posiciones(0) + 1
  32.            For X = 0 To CantPos - 1
  33.                If Posiciones(X) > CantLet Then Posiciones(X) = 0: Posiciones(X + 1) = Posiciones(X + 1) + 1
  34.            Next
  35.            If CT = 1001 Then
  36.                Open "C:\Dic7913.txt" For Append As #1
  37.                    For X = 0 To 1000
  38.                        Print #1, Palabras(X)
  39.                    Next
  40.                Close #1
  41.                ReDim Palabras(1000)
  42.                CT = 0
  43.            End If
  44.            If Posiciones(CantPos) = CantLet + 1 Then GoTo Terminado
  45.            Loop
  46.     Terminado:
  47.        Next
  48.        If CT <> 0 Then
  49.            Open "C:\Dic7913.txt" For Append As #1
  50.                For X = 0 To CT
  51.                    Print #1, Palabras(X)
  52.                Next
  53.            Close #1
  54.            CT = 0
  55.        End If
  56.        MsgBox "Terminado", vbInformation, "Atencion"
  57.     End Sub
  58.      
  59.     Private Sub Caracteres_Click(Index As Integer)
  60.        'Limita el checkbox de los caracteres extra si el cuadro de texto esta vacio
  61.       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"
  62.     End Sub
  63.      
  64.     Private Sub Go_Click()
  65.     Dim FlagCheck As Boolean
  66.        'Comprobacion de los minimos y maximos de longitud
  67.       If Val(MinMaxL(0).Text) = 0 Then MsgBox "El minimo de longitud no puede ser cero", vbCritical, "Error": Exit Sub
  68.        If Val(MinMaxL(1).Text) = 0 Then MsgBox "El maximo de longitud no puede ser cero", vbCritical, "Error": Exit Sub
  69.        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
  70.        'Comprobacion de los checkboxes, minimo uno debe estar tildado
  71.       For X = 0 To 6
  72.            If Caracteres(X).Value = 1 Then FlagCheck = True
  73.        Next
  74.        If FlagCheck = False Then MsgBox "Seleccione primero con que caracteres quiere hacer el diccionario", vbCritical, "Error": Exit Sub
  75.        Cad = vbNullString 'Vacio el string Cad por si estaba lleno
  76.       'Lleno cad con la seleccion del usuario
  77.       If Caracteres(0).Value = 1 Then Cad = Num
  78.        If Caracteres(1).Value = 1 Then Cad = Cad & Sym
  79.        If Caracteres(2).Value = 1 Then Cad = Cad & Min
  80.        If Caracteres(3).Value = 1 Then Cad = Cad & Max
  81.        If Caracteres(4).Value = 1 Then Cad = Cad & SpL
  82.        If Caracteres(5).Value = 1 Then Cad = Cad & SpU
  83.        If Caracteres(6).Value = 1 Then Cad = Cad & ExtraCHR.Text
  84.        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"
  85.        Call Inicio ' llamo al inicio de proceso
  86.    End Sub
  87.      
  88.     Private Sub MinMaxL_KeyPress(Index As Integer, KeyAscii As Integer)
  89.        If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0 'Verifica que solo se ingresen numeros en el desde hasta.
  90.    End Sub
  91.      
  92.     Private Function CharSplit7913(expression As String) As String()
  93.        Dim lExp     As Long
  94.        Dim ExpB()   As Byte
  95.        Dim AuxArr() As String
  96.        ExpB = expression
  97.        lExp = UBound(ExpB)
  98.        ReDim AuxArr(lExp)
  99.        For X = 0 To lExp Step 2
  100.            AuxArr(X / 2) = ChrW(ExpB(X))
  101.        Next
  102.        ReDim Preserve AuxArr(Int(lExp / 2))
  103.        CharSplit7913 = AuxArr
  104.     End Function
     


Descargar Source y Binario:
No tienes permisos para ver links. Registrate o Entra con tu cuenta

GRACIAS POR LEER!!!
« Última modificación: Mayo 28, 2013, 03:21:51 pm por 79137913 »
"Algunos creen que soy un bot, puede que tengan razon"
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

*Shadow Scout Team*                                                   No tienes permisos para ver links. Registrate o Entra con tu cuenta

Desconectado kid_goth

  • *
  • Underc0der
  • Mensajes: 201
  • Actividad:
    0%
  • Reputación 3
  • Tu conocimiento se limita cuando dices NO PUEDO...
    • Ver Perfil
    • DC Projects
    • Email
« Respuesta #1 en: Mayo 28, 2013, 04:44:48 pm »
una pregunta genera todas las posibilidades? por ejemplo si le digo 1 de logitud letras mayusculas me muestra las 25? ufff igual esta muy bueno gracias eso si le aplico un cambio tal vez poco significativo, el agregar la ñ y la Ñ a las letras minusculas y mayusculas no especiales ..

Saludos
No tienes permisos para ver links. Registrate o Entra con tu cuenta

Acepta con humildad y aprecio que en la vida la muerte es inevitable y amarás ésta, adorando la muerte

 

¿Te gustó el post? COMPARTILO!



[JUEGO & Source] VIDA : Mantene viva tu Civilizacion de bichitos.

Iniciado por 79137913

Respuestas: 3
Vistas: 2319
Último mensaje Marzo 25, 2013, 01:58:13 pm
por alexander1712
[Recopilacion] Source Ofuscadores

Iniciado por Expermicid

Respuestas: 9
Vistas: 3973
Último mensaje Noviembre 13, 2012, 08:23:26 pm
por mcr_bkn