frm1pwd.frm

利用穷解法破解QQ时要用到的字典,可用同一QQ生成相应的不同密码.也可以利用一个弱密码生成不同的QQ段.

      Top             =   1560
      Width           =   1695
   End
   Begin VB.Label Label1 
      Caption         =   "起始密码："
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   600
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "终止密码："
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   1080
      Width           =   1575
   End
   Begin VB.Label Label3 
      Caption         =   "ＱＱ号码："
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   1575
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   3600
      Y1              =   3360
      Y2              =   3360
   End
End
Attribute VB_Name = "FrmCreatePWD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Load()
Dim IntI As Integer
For IntI = 8 To 30
CboTimes.AddItem IntI
Next
CboTimes.ListIndex = 12
Seed = 1
End Sub

Private Sub CmdCancel_Click()
Unload Me
End Sub

Private Sub CmdFile_Click()
CmnDialog.ShowOpen
End Sub

Private Sub CmdOK_Click()
On Error GoTo wrong
Mode = TxtMode.Text
FrmCreatePWD.Caption = "正在生成，请稍候…"
Open CmnDialog.FileName For Output As #1
For Itg1 = Lb1 To Le1
For Itg2 = Lb2 To Le2
For Itg3 = Lb3 To Le3
For Itg4 = Lb4 To Le4
For Itg5 = Lb5 To Le5
For Itg6 = Lb6 To Le6
For Itg7 = Lb7 To Le7
For Itg8 = Lb8 To Le8
For Itg9 = Lb9 To Le9
For Itg10 = Lb10 To Le10
For Itg11 = Lb11 To Le11
For Itg12 = Lb12 To Le12
For Itg13 = Lb13 To Le13
For Itg14 = Lb14 To Le14
For Itg15 = Lb15 To Le15
For Itg16 = Lb16 To Le16
If Seed = CboTimes.Text Then
    Print #1, TxtSeedNo.Text & Mode & TxtSeedPWD.Text & vbCrLf & _
    TxtQQ.Text & Mode & Chr(Itg1) & Chr(Itg2) & Chr(Itg3) _
         & Chr(Itg4) & Chr(Itg5) & Chr(Itg6) & Chr(Itg7) & Chr(Itg8) _
          & Chr(Itg9) & Chr(Itg10) & Chr(Itg11) & Chr(Itg12) & Chr(Itg13) _
           & Chr(Itg14) & Chr(Itg15) & Chr(Itg16)
    Seed = 1
    Else
        Print #1, TxtQQ.Text & Mode & Chr(Itg1) & Chr(Itg2) & Chr(Itg3) _
         & Chr(Itg4) & Chr(Itg5) & Chr(Itg6) & Chr(Itg7) & Chr(Itg8) _
          & Chr(Itg9) & Chr(Itg10) & Chr(Itg11) & Chr(Itg12) & Chr(Itg13) _
           & Chr(Itg14) & Chr(Itg15) & Chr(Itg16)
           Seed = Seed + 1
           End If
        Next Itg16
        Next Itg15
        Next Itg14
        Next Itg13
        Next Itg12
        Next Itg11
        Next Itg10
        Next Itg9
        Next Itg8
        Next Itg7
        Next Itg6
        Next Itg5
        Next Itg4
        Next Itg3
    Next Itg2
Next Itg1
Reset
FrmCreatePWD.Caption = "生成密码"
MsgBox "任务完成！", vbInformation, "恭喜！"
TxtBegain.Text = "不可逆输入"
TxtEnd.Text = "删除键也算"
Clear
Exit Sub
wrong:
If Err.Number = 75 Then
MsgBox "请先确定目标文件！", vbCritical, "错误"
CmdFile.SetFocus
End If
End Sub

Private Sub Command1_Click()
On Error GoTo wrong2
Dim ReadText As String
Open "Bhzp.hp" For Input As #2
While Not EOF(2)
Line Input #2, ReadText
FrmHelp.TxtHelp.Text = FrmHelp.TxtHelp.Text & ReadText & vbCrLf
Wend
Close #2
FrmHelp.Show
Exit Sub
wrong2:
If Err.Number = 53 Then
MsgBox "未找到帮助文件！" & vbCrLf & "可能已经被删除！", vbCritical, "错误"
End If
End Sub

Private Sub TxtBegain_GotFocus()
TxtBegain.Text = ""
End Sub

Private Sub TxtBegain_KeyPress(KeyAscii As Integer)
If Lb1 = 0 Then
Lb1 = KeyAscii
StrB1 = Chr(KeyAscii)
ElseIf Lb2 = 0 Then
Lb2 = KeyAscii
StrB2 = Chr(KeyAscii)
ElseIf Lb3 = 0 Then
Lb3 = KeyAscii
StrB3 = Chr(KeyAscii)
ElseIf Lb4 = 0 Then
Lb4 = KeyAscii
StrB4 = Chr(KeyAscii)
ElseIf Lb5 = 0 Then
Lb5 = KeyAscii
StrB5 = Chr(KeyAscii)
ElseIf Lb6 = 0 Then
Lb6 = KeyAscii
StrB6 = Chr(KeyAscii)
ElseIf Lb7 = 0 Then
Lb7 = KeyAscii
StrB7 = Chr(KeyAscii)
ElseIf Lb8 = 0 Then
Lb8 = KeyAscii
StrB8 = Chr(KeyAscii)
ElseIf Lb9 = 0 Then
Lb9 = KeyAscii
StrB9 = Chr(KeyAscii)
ElseIf Lb10 = 0 Then
Lb10 = KeyAscii
StrB10 = Chr(KeyAscii)
ElseIf Lb11 = 0 Then
Lb11 = KeyAscii
StrB11 = Chr(KeyAscii)
ElseIf Lb12 = 0 Then
Lb12 = KeyAscii
StrB12 = Chr(KeyAscii)
ElseIf Lb13 = 0 Then
Lb13 = KeyAscii
StrB13 = Chr(KeyAscii)
ElseIf Lb14 = 0 Then
Lb14 = KeyAscii
StrB14 = Chr(KeyAscii)
ElseIf Lb15 = 0 Then
Lb15 = KeyAscii
StrB5 = Chr(KeyAscii)
ElseIf Lb16 = 0 Then
Lb16 = KeyAscii
StrB16 = Chr(KeyAscii)
End If
End Sub

Private Sub TxtEnd_GotFocus()
TxtEnd.Text = ""
End Sub

Private Sub TxtEnd_KeyPress(KeyAscii As Integer)
If Le1 = 0 Then
Le1 = KeyAscii
str1 = Chr(KeyAscii)
ElseIf Le2 = 0 Then
Le2 = KeyAscii
str2 = Chr(KeyAscii)
ElseIf Le3 = 0 Then
Le3 = KeyAscii
str3 = Chr(KeyAscii)
ElseIf Le4 = 0 Then
Le4 = KeyAscii
str4 = Chr(KeyAscii)
ElseIf Le5 = 0 Then
Le5 = KeyAscii
str5 = Chr(KeyAscii)
ElseIf Le6 = 0 Then
Le6 = KeyAscii
str6 = Chr(KeyAscii)
ElseIf Le7 = 0 Then
Le7 = KeyAscii
str7 = Chr(KeyAscii)
ElseIf Le8 = 0 Then
Le8 = KeyAscii
str8 = Chr(KeyAscii)
ElseIf Le9 = 0 Then
Le9 = KeyAscii
str9 = Chr(KeyAscii)
ElseIf Le10 = 0 Then
Le10 = KeyAscii
str10 = Chr(KeyAscii)
ElseIf Le11 = 0 Then
Le11 = KeyAscii
str11 = Chr(KeyAscii)
ElseIf Le12 = 0 Then
Le12 = KeyAscii
str12 = Chr(KeyAscii)
ElseIf Le13 = 0 Then
Le13 = KeyAscii
str13 = Chr(KeyAscii)
ElseIf Le14 = 0 Then
Le14 = KeyAscii
str14 = Chr(KeyAscii)
ElseIf Le15 = 0 Then
Le15 = KeyAscii
str15 = Chr(KeyAscii)
ElseIf Le16 = 0 Then
Le16 = KeyAscii
str16 = Chr(KeyAscii)
End If
End Sub

Private Sub TxtQQ_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = vbBack Then Exit Sub
   If Not IsNumeric(Chr(KeyAscii)) Then
      KeyAscii = 0
      MsgBox "QQ号码只能为数字！", vbInformation + vbOKOnly, "提示"
   End If
End Sub

Private Sub TxtSeedNo_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = vbBack Then Exit Sub
   If Not IsNumeric(Chr(KeyAscii)) Then
      KeyAscii = 0
      MsgBox "QQ号码只能为数字！", vbInformation + vbOKOnly, "提示"
   End If
End Sub