Foro de elhacker.net

For Cantidad = txtDesde To txtHasta
 Select Case Cantidad
  Case 1:
   For I1 = 1 To Len(txtDic)
    If Chekeo(Mid(txtDic,I1,1)) Then Exit For
   Next
  Case 2:
   For I1 = 1 To Len(txtDic):For I2 = 1 To Len(txtDic)
    If Chekeo(Mid(txtDic,I1,1) & Mid(txtDic,I2,1)) Then Exit For
   Next:Next
  Case 3:
   For I1 = 1 To Len(txtDic):For I2 = 1 To Len(txtDic):For I3 = 1 To Len(txtDic)
    If Chekeo(Mid(txtDic,I1,1) & Mid(txtDic,I2,1) & Mid(txtDic,I3,1)) Then Exit For
   Next:Next:Next
  Case etc.........
 End Select
Next

'**************************************************
'
'Autor: Slasher
'
'Descripción: Este procedimiento genera claves alfabéticas
'que se pueden usar ya sea para crear un diccionario de claves
'o para crackear algo, da lo mismo. La idea es mostrar un
'algoritmo básico que genera cualquier clave alfabética de
'cualquier cantidad de dígitos.
'
'Con un par de lineas más de puede hacer que genere claves
'alfanuméricas, pero les dejo eso para que usen un poco de
'su imaginación ;)
'
'**************************************************

Option Explicit
Option Base 1

Sub KeyGen(NumChar As Integer, Optional StartData As String)
          Dim btChar() As Byte
          Dim iCnt%
          Dim sKey$
          Dim i%

  ReDim btChar(NumChar) As Byte

  For i = 1 To NumChar
    If Len(StartData) >= NumChar Then
      'Establece la clave inicial.
      '
      btChar(i) = Asc(Mid$(StartData, i, 1))
    Else
      'Comienza desde la A hasta la Z
      '
      btChar(i) = vbKeyA
    End If
  Next

  Do
    'Incrementa el último caracter.
    '
    btChar(NumChar) = btChar(NumChar) + 1

    'Copia la clave a un string.
    '
    For i = NumChar To 1 Step -1
      sKey = Chr$(btChar(i)) & sKey
    Next

    If btChar(NumChar) = vbKeyZ Then

      'Si el último caracter llega a la Z el programa
      'aumenta en uno el anterior. Y asi con todos
      'los caracteres de la clave.
      '
      For i = NumChar To 1 Step -1
        If btChar(i) = vbKeyZ Then
          If i > 1 Then
            btChar(i - 1) = btChar(i - 1) + 1
          End If
         
          iCnt = iCnt + 1
         
          btChar(i) = vbKeyA
        End If
      Next
     
    End If
   
    'Realizar tareas con la clave generada.
    '
    '
    '

   
    If iCnt = NumChar Then Exit Do
   
    sKey = vbNullString
    iCnt = 0
  Loop

End Sub