[Source] VB6 Bruteforce (mejorado)

[Psyke1]

Hola a todos hace poco pregunte como se hacia un Bruteforce en vb6, obtuve diferentes metodos, pero Karcrack me dijo q lo intentara por mi mismo, y asi he hecho!!  :)Les presento mi code para convinar las letras minusculas del abcdario. estuve dandole vueltas, no se si es la forma optima de hacerlo (aunque funciona a la perfeccion), por eso os pido vuestra yuda para mejorarlo y de paso aprender.

Código (vb) [Seleccionar] Expandir


Public Sub BruteForce()
   
   Dim D1, D2, D3, D4, D5, D6, D7, D8 As Integer
   
   D1 = 97: D2 = 97: D3 = 97: D4 = 97: D5 = 97: D6 = 97: D7 = 97: D8 = 97

   Open App.Path & "\midicionario.txt" For Output As #1

digito1:

   If D1 = 123 Then
       D1 = 97
       MsgBox "Combinaciones con un digito completadas", vbInformation
       GoTo digito2
   End If
   Print #1, Chr(D1)
   D1 = D1 + 1
   GoTo digito1

digito2:

   If D1 = 122 And D2 = 123 Then
       D1 = 97: D2 = 97
       MsgBox "Combinaciones con dos digitos completadas", vbInformation
       GoTo digito3
   ElseIf D2 = 123 Then
       D1 = D1 + 1
       D2 = 97
   End If
   Print #1, Chr(D1) & Chr(D2)
   D2 = D2 + 1
   GoTo digito2
   
digito3:
   
   If D1 = 122 And D2 = 122 And D3 = 123 Then
       D1 = 97: D2 = 97: D3 = 97
       MsgBox "Combinaciones con tres digitos completadas", vbInformation
       GoTo digito4
   ElseIf D2 = 122 And D3 = 123 Then
       D2 = 97: D3 = 97
       D1 = D1 + 1
   ElseIf D3 = 123 Then
       D2 = D2 + 1
       D3 = 97
   End If
   Print #1, Chr(D1) & Chr(D2) & Chr(D3)
   D3 = D3 + 1
   GoTo digito3

digito4:

   If D1 = 122 And D2 = 122 And D3 = 122 And D4 = 123 Then
       D1 = 97: D2 = 97: D3 = 97: D4 = 97
       MsgBox "Combinaciones con cuatro digitos completadas", vbInformation
       GoTo fin
   ElseIf D2 = 122 And D3 = 122 And D4 = 123 Then
       D2 = 97: D3 = 97: D4 = 97
       D1 = D1 + 1
   ElseIf D3 = 122 And D4 = 123 Then
       D3 = 97: D4 = 97
       D2 = D2 + 1
   ElseIf D4 = 123 Then
       D4 = 97
       D3 = D3 + 1
   End If
   Print #1, Chr(D1) & Chr(D2) & Chr(D3) & Chr(D4)
   D4 = D4 + 1
   GoTo digito4
   
fin:

   MsgBox "Fin", vbExclamation
   Close #1
   
End Sub


Si no entienden algo no uden en preguntar  

Garcias Karcrack

[Novlucker]

Yo que tu desaparezco esos GOTO del código antes de que te insulten , usa bucles y funciones

Te lo diré del siguiente modo, si que hay más métodos y más optimos con códigos más legibles, de hecho anda por el foro uno que había hecho en vbs usando recursividad.

Saludos

[Psyke1]

gracias por la crítika, me apliko el cuento Novlucker!!

[Psyke1]

Sinceramente, no sabria como hacerlo con bucles, seria algo asi, no:

Código (vb) [Seleccionar] Expandir


    For D1 = 97 to 123 Then
        Print #1, Chr(D1)
    Next
    MsgBox "Combinaciones con un dígito completadas", vbInformation

Pero eso es para el 1er digito, para los demas no se...

Gracias!

Salu2

[Novlucker]

Intenta entender esto y pruebalo (esta hecho en excel, así que puede que no funcione XD)

Código (vb) [Seleccionar] Expandir

Private Sub GenerarDiccionario()
Dim chars As String
Dim charlist() As String
Dim length As Integer

Open app.Path & "\diccionario.txt" For Output As #1

chars = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
charlist = Split(chars, ",")
length = 4

Call Complete("", length, charlist)
Close #1

MsgBox "Proceso Terminado", vbInformation
End Sub

Public Sub Complete(ByVal strin As String, ByVal length As Integer, ByRef charlist() As String)
Dim z As Integer

For z = 0 To UBound(charlist())
word = strin & charlist(z)

If Len(word) = length Then
    Print #1, word
Else
    Call Complete(word, length, charlist)
End If

Next

End Sub

En este se usa una lista de caracteres, y length es la cantidad de caracteres objetivo para la "palabra", en el ejemplo son todas las palabras formadas por esos caracteres y 4 caracteres de largo.

Para probar todas las palabras de 1, 2, 3, 4, etc caracteres puedes simplemente meterlo en un bucle, aunque más sencillo es comparar a medida que van apareciendo, de modo de evitar que resulte redundante ya que en el proceso de generar una palabra de 4 letras por ejemplo, el código pasa por A, AA, AAA, AAAA y ahí llega hasta la primera de 4 caracteres, pero como se ve antes ha pasado por las otras 3.

Saludos

[Lupin]

Si funciona...
...ayudaria un doevents ??

[Psyke1]

Gracias, esoy mastikando el code , mas adelante resumire el mio mas...

Salu2

[Psyke1]

Mirar, he simplificado un poco el code con bucles en vez de Goto y con un array

Código (vb) [Seleccionar] Expandir


Public Sub BruteForce()
   
'\\Declaro variables
   
    Dim D(3) As Integer, x As Integer
   
    For x = 0 To 3: D(x) = 97: Next

'\\Abro archivo de texto

    Open App.Path & "\dic.txt" For Output As #1

'\\Un digito

    While Not D(0) = 123
        Print #1, Chr(D(0))
        D(0) = D(0) + 1
    Wend
    D(0) = 97
    MsgBox "Combinaciones con un dígito completadas!", vbInformation

'\\Dos digitos

    While Not D(0) = 123
        If D(1) = 123 Then
            D(1) = 97
            D(0) = D(0) + 1
        End If
        If Not D(0) = 123 Then Print #1, Chr(D(0)) & Chr(D(1))
        D(1) = D(1) + 1
    Wend
    D(0) = 97: D(1) = 97
    MsgBox "Combinaciones con dos dígitos completadas!", vbInformation

'\\Tres digitos
   
    While Not D(0) = 123
        If D(1) = 122 And D(2) = 123 Then
            D(2) = 97: D(3) = 97
            D(0) = D(0) + 1
        ElseIf D(2) = 123 Then
            D(1) = D(1) + 1
            D(2) = 97
        End If
        If Not D(0) = 123 Then Print #1, Chr(D(0)) & Chr(D(1)) & Chr(D(2))
        D(2) = D(2) + 1
    Wend
    For x = 0 To 2: D(x) = 97: Next
    MsgBox "Combinaciones con tres dígitos completadas!", vbInformation

'\\Cuatro digitos

    While Not D(0) = 123
        If D(1) = 122 And D(2) = 122 And D(3) = 123 Then
            For x = 1 To 3: D(x) = 97: Next
            D(0) = D(0) + 1
        ElseIf D(2) = 122 And D(3) = 123 Then
            D(2) = 97: D(3) = 97
            D(1) = D(1) + 1
        ElseIf D(3) = 123 Then
            D(3) = 97
            D(2) = D(2) + 1
        End If
        If Not D(0) = 123 Then Print #1, Chr(D(0)) & Chr(D(1)) & Chr(D(2)) & Chr(D(3))
        D(3) = D(3) + 1
    Wend
    For x = 0 To 3: D(x) = 97: Next
    MsgBox "Combinaciones con cuatro dígitos completadas!", vbInformation

'\\Finalizamos

    MsgBox "Fin", vbOKOnly
    Close #1
    End
   
End Sub

Ya se que no es la forma profesionl de hacerlo, pero os pido vuestra opinion

[MCKSys Argentina]

Esta es una alternativa con 2 bucles:

Código [Seleccionar] Expandir


Sub BruteForce(MaxDigitos As Integer)
'a = 97
'z = 122
Dim Serial As String
Dim Terminado As Boolean
Dim Terminado2 As Boolean
Dim i As Integer
Dim c As Byte
Dim j As Integer
Dim pos As Integer

Serial = Space(MaxDigitos)

Open App.Path & "\midicionario.txt" For Output As #1

Mid(Serial, 1, 1) = "a"
Print #1, Trim(Serial)

Terminado = False

Do While Not Terminado
    pos = 1
    Terminado2 = False
    Do While Not Terminado2
        DoEvents
        c = Asc(Mid(Serial, pos, 1))
        'contempla char espacio
        If c < 97 Then
            c = 97
        Else
            c = c + 1
        End If
        If c < 123 Then
            Mid(Serial, pos, 1) = Chr(c)
            Terminado2 = True
        Else
            Mid(Serial, pos, 1) = "a"
            pos = pos + 1
        End If
    Loop
    Print #1, Trim(Serial)
    Terminado = True
    For j = 1 To MaxDigitos
        Terminado = Terminado And (Mid(Serial, j, 1) = "z")
    Next j
Loop
Close #1
MsgBox "listo"
End Sub


Saludos!

[Psyke1]

Muy interesante, agradezco el aporte MCKSys Argentina!!!