• Viernes 29 de Marzo de 2024, 09:43

Autor Tema:  [SOURCE] Brute Force Dictionary Creator 7913  (Leído 2234 veces)

79137913

  • Nuevo Miembro
  • *
  • Mensajes: 16
    • Ver Perfil
[SOURCE] Brute Force Dictionary Creator 7913
« en: Miércoles 18 de Abril de 2012, 13:51 »
0
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
  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:
http://adf.ly/7Wsf8

GRACIAS POR LEER!!!