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. ;D
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
Yo que tu desaparezco esos GOTO del código antes de que te insulten :xD , 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
gracias por la crítika, me apliko el cuento Novlucker!! :D
Sinceramente, no sabria como hacerlo con bucles, seria algo asi, no:
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
Intenta entender esto y pruebalo (esta hecho en excel, así que puede que no funcione XD)
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 :P
Si funciona...
...ayudaria un doevents ??
Gracias, esoy mastikando el code :laugh:, mas adelante resumire el mio mas... ;-)
Salu2 ;D
Mirar, he simplificado un poco el code con bucles en vez de Goto y con un array ;-)
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 ;D
Esta es una alternativa con 2 bucles:
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!
Muy interesante, agradezco el aporte MCKSys Argentina!!!
Miren, este es el code q me he currado para hacerlo sin tnr q ir digito por digito:
Private Sub Form_Load()
Dim ABC() As String
ABC = Split("abcdefghijklmnñopqrstuvwxyz", "")
Call BF(App.Path & "\Dic.txt", ABC, 3)
End Sub
Public Function BF(DirPath As String, Chrptr() As String, Longitud%)
Dim x%, FinChrptr As String, Finpalabra As String, Palabra As String
FinChrptr = UBound(Chrptr())
For x = 1 To Longitud: Finpalabra = Finpalabra + Chrptr(FinChrptr): Next
' MsgBox Finpalabra
Open DirPath For Output As #1
While Not Palabra = Finpalabra
Wend
Close #1
MsgBox "¡Combinaciones completadas!", vbInformation, "VB6 Brute Force by *PsYkE1*"
End Function
Bien, donde me quede es aqui:
While Not Palabra = Finpalabra
Wend
Es decir, mientras Palabra no sea igual a FinPalabra("zzz" en este caso) q haga el siguiente bucle, pero miren que le doy vueltas y no sabria seguir :-(, me podrian echar una mano??? :huh:
Gracias a to2!! ;D