📄 frmqqpwd.frm
字号:
VERSION 5.00
Begin VB.Form frmQQPwd
Caption = "QQ 密码破解终结 1.2"
ClientHeight = 4230
ClientLeft = 60
ClientTop = 345
ClientWidth = 9270
Icon = "frmQQPwd.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4230
ScaleWidth = 9270
StartUpPosition = 2 '屏幕中心
Begin VB.CheckBox Check1
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "产生EWH.DB文件"
ForeColor = &H80000008&
Height = 225
Left = 5490
TabIndex = 20
Top = 1478
Value = 1 'Checked
Width = 1740
End
Begin VB.CommandButton cmdCalTest
Caption = "算法测试"
Height = 825
Left = 7320
TabIndex = 19
Top = 3225
Width = 1515
End
Begin VB.TextBox txtHelp
Appearance = 0 'Flat
Height = 1020
Left = 105
MultiLine = -1 'True
TabIndex = 18
Text = "frmQQPwd.frx":030A
Top = 3120
Width = 8880
End
Begin VB.CommandButton cmdLoadDictionary
Caption = "加载字典文件.."
Enabled = 0 'False
Height = 315
Left = 7350
TabIndex = 16
Top = 2310
Width = 1650
End
Begin VB.TextBox txtCalHash
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Height = 300
Left = 4470
Locked = -1 'True
TabIndex = 12
Top = 1845
Width = 4530
End
Begin VB.TextBox txtFileHash
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Height = 300
Left = 4470
Locked = -1 'True
TabIndex = 10
Top = 510
Width = 4530
End
Begin VB.TextBox txtUIN
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Height = 300
Left = 1155
Locked = -1 'True
TabIndex = 8
Text = "110340156"
Top = 525
Width = 1785
End
Begin VB.TextBox txtFileName
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Height = 300
Left = 1155
Locked = -1 'True
TabIndex = 6
Text = "EWH.db"
Top = 105
Width = 6075
End
Begin VB.CommandButton cmdOpenFile
Caption = "打开QQ EWH文件.."
Height = 315
Left = 7350
TabIndex = 5
Top = 98
Width = 1650
End
Begin VB.TextBox txtEWH
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 300
Left = 1155
TabIndex = 4
Text = "12345"
Top = 1440
Width = 4155
End
Begin VB.TextBox txtAST
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 285
Left = 1155
TabIndex = 3
Text = "10000"
Top = 1853
Width = 1710
End
Begin VB.CommandButton cmdCalculate
Caption = "单步计算QQ Hash"
Height = 315
Left = 7350
TabIndex = 0
Top = 1433
Width = 1650
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H000000FF&
Caption = "正在搜索……"
Height = 180
Left = 120
TabIndex = 17
Top = 2850
Visible = 0 'False
Width = 1080
End
Begin VB.Label lblMailto
Alignment = 1 'Right Justify
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Caption = " Author:China54 Email:Binny@vip.163.com "
ForeColor = &H00FF0000&
Height = 225
Left = 4470
MouseIcon = "frmQQPwd.frx":0310
MousePointer = 99 'Custom
TabIndex = 15
Top = 1065
Width = 4530
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "本程序代码无版权限制，但因为使用不当等原因对您或社会造成伤害，作者概不负责。"
ForeColor = &H00E0E0E0&
Height = 180
Left = 90
TabIndex = 14
Top = 2475
Width = 6840
End
Begin VB.Line Line1
X1 = 180
X2 = 9105
Y1 = 1185
Y2 = 1185
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "QQ 计算Hash："
Height = 180
Index = 5
Left = 3150
TabIndex = 13
Top = 1905
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "QQ 文件Hash："
Height = 180
Index = 4
Left = 3150
TabIndex = 11
Top = 570
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "QQ 号码："
Height = 180
Index = 3
Left = 150
TabIndex = 9
Top = 570
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "QQ 文件："
Height = 180
Index = 2
Left = 150
TabIndex = 7
Top = 165
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "循环次数："
Height = 180
Index = 1
Left = 150
TabIndex = 2
Top = 1905
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "登录口令："
Height = 180
Index = 0
Left = 150
TabIndex = 1
Top = 1500
Width = 900
End
End
Attribute VB_Name = "frmQQPwd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'能够破解QQ2004~QQ2005等任意版本
'===========================================================================
' Code Name: 演示采用暴力方法破解QQ登陆密码
' First Built: 2005-1-5
' Last Modify: 2005-3-5
' Author: 赵斌（Binny）
' Copyright: 本程序代码无版权限制，但因为使用不当等原因 _
对你或社会造成伤害，作者概不负责。
'===========================================================================
' 很多时候，与其去研究什么密码算法，还不如采取暴力破解。
' 不过，如果能知道密码的算法，就可以斯文一点了。
' 本动态库 QQMD5.DLL 由于为了兼顾 Tencent 的利益，因此暂时保密，等 Tencent 修改了密码算法后将公开
' 动态库QQMD5.DLL为纯汇编编写，因此，不保证其安全使用。作者保留版权但允许在此基础上进行扩展，例如多线程之类的应用。
'2005年3月5日 增加了MD5代码速度测试
Dim mbMove As Boolean
Private Type QDFile
DataFlag As String '数据段的标志
sData As String '原始数据
bytDataType As Byte '数据段类型
End Type
Private mTQDFile() As QDFile
Private Sub cmdCalculate_Click()
Dim byt() As Byte
Dim sFileString As String
Dim iFreeFile As Integer
On Error Resume Next
If (IsNumeric(txtAST.Text)) Then
If LoIsCrack(txtEWH.Text) Then MsgBox "恭喜你，找到亲爱的密码！^_^", vbInformation
End If
If Check1.Value = vbChecked Then
sFileString = "51 44 01 01 03 00 04 03 00 BD AF A8 04 00 00 00" & _
"00 00 00 00 07 03 00 B9 AB B4 10 00 00 00 " & _
txtCalHash.Text & " 04 03" & _
"00 A9 B5 B2 04 00 00 00 51 51 49 44"
sFileString = Replace(sFileString, " ", "")
byt = INNER_Hex2ByteA(sFileString)
iFreeFile = FreeFile
Open "EWH.db" For Binary As #iFreeFile
Put #iFreeFile, , byt
Close #iFreeFile
End If
End Sub
Private Sub cmdCalTest_Click()
frmMD5Test.Show
End Sub
Private Sub cmdLoadDictionary_Click()
Dim sFile As String
Dim iFreeFile As Integer
If (IsNumeric(txtAST.Text)) And (txtFileHash.Text <> "") Then
sFile = INNER_GetFileName(True, "dic (*.dic)|*.dic|txt (*.txt)|*.txt", "dic", , "请选择字典文件")
If sFile <> "" Then
iFreeFile = FreeFile
Dim sTextLine
Open sFile For Input As #iFreeFile ' 打开文件。
Do While Not EOF(iFreeFile)
Line Input #iFreeFile, sTextLine ' 读入一行数据并将其赋予某变量。
txtEWH.Text = sTextLine
If LoIsCrack(txtEWH.Text) Then
MsgBox "恭喜你，找到亲爱的密码！^_^" & vbCrLf & sTextLine, vbInformation, sTextLine
Exit Do
End If
DoEvents '如果写专业代码，注意退出程序时，在这里要跳出，避免程序无法关闭
If gbExit Then
Close #iFreeFile
Exit Do
Unload Me
Exit Sub
End If
Label2.Visible = Not Label2.Visible
Loop
Close #iFreeFile
End If
End If
Label2.Visible = False
End Sub
Private Function LoIsCrack(fsPwd As String) As Boolean
Dim lAST As Long
lAST = Val(txtAST.Text)
txtCalHash.Text = UCase(INNER_GetQQHash(fsPwd, lAST))
LoIsCrack = txtFileHash.Text = txtCalHash.Text
End Function
Private Sub cmdOpenFile_Click()
Dim sFile As String
Dim iFreeFile As Integer
Dim bytFile() As Byte
Dim k As Long
Dim dbl As Double
On Error GoTo Errlabel
sFile = INNER_GetFileName(True, "db (*.db)|*.db", "db", txtFileName.Text, "请选择QQ数据库文件")
If Len(sFile) > 0 Then
txtFileName.Text = sFile
iFreeFile = FreeFile
Open sFile For Binary As #iFreeFile
k = LOF(iFreeFile)
If k > &H30 Then
ReDim bytFile(k - 1)
Get #iFreeFile, 1, bytFile
If bytFile(0) = &H51 And bytFile(1) = &H44 Then
'得到QQ号
'通过文件解调QQ数据
LoAnalysisQD bytFile
For k = 0 To UBound(mTQDFile)
With mTQDFile(k)
Select Case UCase(.DataFlag)
Case "AST"
txtAST.Text = INNER_Hex2Double(.sData)
Case "UIN"
txtUIN.Text = INNER_Hex2Double(.sData)
Case "EWH"
txtFileHash.Text = .sData
End Select
End With
Next k
Else '
txtFileHash.Text = "非QQ数据文件"
End If
End If
Close #iFreeFile
End If
Exit Sub
Errlabel:
If iFreeFile > 0 Then Close #iFreeFile
txtFileHash.Text = "错误：" & Err.Description
End Sub
'本算法等同于文章中的“五、数据结构分析中的汇编代码”
Private Sub LoAnalysisQD(fbyt() As Byte)
Dim k As Long
Dim m As Long
Dim lPoint As Long
Dim lLen As Long
Dim lDataSections As Long
Dim bytKey As Byte
lDataSections = fbyt(4) + CLng(fbyt(5)) * 256 '总数据段长度
lPoint = 6
If lDataSections > 0 Then ReDim mTQDFile(lDataSections - 1)
For k = 0 To lDataSections - 1
mTQDFile(k).bytDataType = fbyt(lPoint)
' If mTQDFile(k).bytDataType = 4 Then '非加密数据
'得到长度
lLen = fbyt(lPoint + 1) + CLng(fbyt(lPoint + 2)) * 256
bytKey = fbyt(lPoint + 1) Xor fbyt(lPoint + 2)
bytKey = 255 - bytKey '非逻辑操作
lPoint = lPoint + 3
For m = 0 To lLen - 1
mTQDFile(k).DataFlag = mTQDFile(k).DataFlag & Chr(fbyt(lPoint + m) Xor bytKey)
Next m
lPoint = lPoint + lLen
lLen = fbyt(lPoint) + CLng(fbyt(lPoint + 1)) * 256 + CLng(fbyt(lPoint + 2)) * 65536 '由于不会有太多数据，所以不做最高位的计算
lPoint = lPoint + 4
For m = 0 To lLen - 1
mTQDFile(k).sData = mTQDFile(k).sData & INNER_Byte2Hex(fbyt(lPoint + m))
Next m
lPoint = lPoint + lLen
' ElseIf mTQDFile(k).bytDataType = 7 Then '属于加密段
' End If
Next k
End Sub
Private Sub Form_Load()
txtHelp = vbCrLf & "第一步，找到并打开EWH.db文件" & vbCrLf & _
"第二步，按“加载字典文件”找到一个字典开始破解" & vbCrLf & _
"第三步，如果成功则会提示该密码"
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If mbMove Then
mbMove = False
lblMailto.ForeColor = vbBlue
End If
Label4.ForeColor = txtFileName.BackColor
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
gbExit = True
End Sub
Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label4.ForeColor = vbRed
End Sub
Private Sub lblMailto_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
Call ShellExecute(0&, vbNullString, "MailTo:Binny@vip.163.com", vbNullString, vbNullString, vbNormalFocus)
End If
End Sub
Private Sub lblMailto_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Not mbMove Then
lblMailto.ForeColor = vbRed
mbMove = True
End If
End Sub
Private Sub txtFileHash_Change()
cmdLoadDictionary.Enabled = Len(txtFileHash.Text) > 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -