密码破解 文本文档.txt

能够破解ACCESS97/2000/2003/XP等任意版本 本程序显示了Microsoft Access中密码的脆弱性

 很多时候，与其去研究什么密码算法，还不如采取暴力破解。
' 不过，如果能知道密码的算法，就可以斯文一点了。

' 本程序可以称得上暴力和色情的完美结合， _
所谓色情，意味着只有脱掉Bill的裤子，才知道内裤的颜色。

' Access2000的密码，与文件的创建时间有关，即使目前很多宣称能破解密码的软件， _
也只是对软件作者自己计算机上的密码进行破解而已。在后面将会看到，不同时间创建 _
的密码只是略有不同（密码算子），本程序将采用尝试的方法来得到这个密码算子。
' 其实也不算暴力，最多255，对计算机来说，洒洒水啦：）

'注：当采用暴力方法破解时，计算机要装有DAO3.60（即Microsoft DAO 3.6 Object Library--dao360.dll）
' 用本思路，也可以使用ADO2.5以上来测试连接（Microsoft ActiveX Data Objects 2.5 Library --msado25.tlb）
' 关于密码的算子，将来也许有变化（本程序在Access2003环境下测试通过）。

'2003-08-08:新增对ADO连接测试的功能，但测试的结果感觉速度比较慢
'2003-10-10:新增加了对双字节（例如中文）密码的支持
'2003-10-18:跟踪了ACCESS2003的密码算法，并由此推及到其他版本的密码算法，将算法使用VB代码实现。
'2004-01-01:公布算法
'2004-04-01:去掉了暴力部分代码和一些不必要的引用，可在VB5下编译，方便初学者使用和编译 
 

--------------------------------------------------------------------------------
小小鱼 发表于： 04-06-04 03:49  
注册会员
快乐的鱼

回复 1037
注册于 04-03-30 Option Explicit
Dim mbMove As Boolean

'***************** 以下代码，含暴力内容，请各位家长注意 *****************单个窗体,可惜本论坛不能上传图片和文件,需要者请与我联系,到翔天培训找小鱼*****

Private Sub cmdOpenFile_Click()
Dim sFile As String
Dim sPasswd As String
Dim sVersion As String

cmdOpenFile.Enabled = False
sFile = INNER_GetFileName(True, "mdb (*.mdb)|*.mdb", "MDB", txtFileName.Text, "请选择数据库文件"
If Len(sFile) > 0 Then
Shape1.Width = 0
txtFileName = sFile
txtVersion = ""
txtPassword = ""
lblProcess.Visible = True
Shape1.Visible = True
If chkUseForce.Value = vbChecked Then chkMore.Enabled = False
cmdCopy.Enabled = False
sPasswd = INNER_GetAccessPwd(sFile, sVersion, (chkUseForce.Value = vbUnchecked))
If gbExit Then Exit Sub
cmdCopy.Enabled = True
If chkUseForce.Value = vbChecked Then chkMore.Enabled = True
Shape1.Visible = False
lblProcess.Visible = False
txtVersion = sVersion
txtPassword = sPasswd
End If
cmdOpenFile.Enabled = True
End Sub

Private Sub Form_Load()
Shape1.Width = 0
Shape1.Visible = False
glCounts = 255
lblMailto.Caption = " Author:Binny Email:[e-mail] "
lblMailto.ForeColor = vbBlue
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 cmdCopy_Click()
Dim sString As String
sString = CStr(txtPassword.Text)
Clipboard.Clear ' 清除剪贴板。
Clipboard.SetText sString, vbCFText
End Sub

Private Sub Form_Unload(Cancel As Integer)
gbExit = True
End Sub 
 

--------------------------------------------------------------------------------
小小鱼 发表于： 04-06-04 03:52  
注册会员
快乐的鱼

回复 1037
注册于 04-03-30 模块内代码

Option Explicit
'#Const USE_DAO = 1
'#If USE_DAO Then
' Public gDAO As DAO.Database
'#Else
' Public gADO As ADODB.Connection
'#End If
Public gbExit As Boolean
Public glCounts As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 
 

--------------------------------------------------------------------------------
小小鱼 发表于： 04-06-04 03:53  
注册会员
快乐的鱼

回复 1037
注册于 04-03-30 Public Function INNER_GetFileName(ByVal fbOpen As Boolean, _
Optional fsFilter As String = "All (*.*)| *.*", _
Optional ByVal fsDefaultExt As String, _
Optional ByVal fsDefFile As String, _
Optional ByVal fsDialogTitle As String, _
Optional ByVal flHwnd As Long = -1) As String

Dim CommonDialog1 As New clsCommonDialog
If fbOpen Then
If (CommonDialog1.VBGetOpenFileName(Filename:=fsDefFile, _
Filter:=fsFilter, _
FileTitle:=fsDialogTitle, _
DefaultExt:=fsDefaultExt, _
Owner:=flHwnd)) Then
INNER_GetFileName = fsDefFile
End If
Else
If (CommonDialog1.VBGetSaveFileName(Filename:=fsDefFile, _
Filter:=fsFilter, _
FileTitle:=fsDialogTitle, _
DefaultExt:=fsDefaultExt, _
Owner:=flHwnd)) Then
INNER_GetFileName = fsDefFile
End If
End If 
 

--------------------------------------------------------------------------------
小小鱼 发表于： 04-06-04 03:54  
注册会员
快乐的鱼

回复 1037
注册于 04-03-30 INNER_GetFileName = INNER_GetStrFromBuffer(INNER_GetFileName)
Set CommonDialog1 = Nothing
End Function

Public Function INNER_FileExists(fsFileName As String) As Boolean
On Error GoTo ErrLabel
If fsFileName = "" Then Exit Function
If Right(fsFileName, 1) = "\" Then Exit Function
If Len(Dir(fsFileName)) > 0 Then
If UCase(INNER_FileName(fsFileName)) = UCase(Dir(fsFileName)) Then
INNER_FileExists = True
End If
End If
ErrLabel:
End Function

Public Function INNER_FileName(sFileName As String) As String
Dim nIdx As Integer
For nIdx = Len(sFileName) To 1 Step -1
If Mid$(sFileName, nIdx, 1) = "\" Then
INNER_FileName = Mid$(sFileName, nIdx + 1)
Exit Function
End If
Next nIdx
INNER_FileName = sFileName
End Function

Public Function INNER_GetStrFromBuffer(sz As String) As String
If InStr(sz, vbNullChar) Then
INNER_GetStrFromBuffer = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
INNER_GetStrFromBuffer = sz
End If
End Function

'fsRetVer为返回的数据库版本，可用于创建连接
'fbDirect=True,直接给出密码，不使用暴力破解 
 

--------------------------------------------------------------------------------
小小鱼 发表于： 04-06-04 03:55  
注册会员
快乐的鱼

回复 1037
注册于 04-03-30 Public Function INNER_GetAccessPwd(fsDBsee As String, _
fsRetVer As String, _
Optional fbDirect As Boolean = True) As String
Dim bytVer(2) As Byte
Dim bytDB_ID As Byte
Dim bytFile(39) As Byte
Dim bytDateKey(127) As Byte
Dim l As Long
Dim n As Long
Dim iFreeFile As Integer
Dim sFileFlag As String * 15

Dim sKey2K As String
Dim sKey97 As String
Dim bytKey() As Byte
Dim bytRslt() As Byte
Dim lAscii As Long
Dim lTemp As Long
Dim sPassword As String

On Error GoTo ErrLabel

iFreeFile = FreeFile
Open fsDBsee For Binary As #iFreeFile

l = LOF(iFreeFile)

If l > &H140 Then
Get #iFreeFile, &H43, bytFile
Get #iFreeFile, &H9D, bytVer
Get #iFreeFile, &H15, bytDB_ID
Get #iFreeFile, &H19, bytDateKey
Get #iFreeFile, &H5, sFileFlag
End If
Close #iFreeFile

If sFileFlag <> "Standard Jet DB" Then
sPassword = "非ACCESS数据库文件"
'实际上，文件开始的0x0001标志也可以做为判断依据
GoTo Endlabel
End If
sKey2K = "3074EC37EBCB9CFA70D128E6A5398A60E21B7B3643FDDFB1C17B13437920B13382EE795B243A7C2A"
sKey97 = "86FBEC375D449CFAC65E28E613"

If bytVer(0) = 0 Then
fsRetVer = "3.51"
Else
'Microsoft 似乎想在今后的版本中用该数据表示建立ADO的连接
fsRetVer = Chr(bytVer(0)) & Chr(bytVer(1)) & Chr(bytVer(2))
End If

fsRetVer = IIf(bytDB_ID = 0, "ACCESS_97;", "ACCESS_2K;" & fsRetVer

If (bytDB_ID = 1) And fbDirect Then
sPassword = INNER_GetPwdDirect(bytDateKey)
If sPassword = "" Then sPassword = "无密码"
GoTo Endlabel
End If 
 

--------------------------------------------------------------------------------
小小鱼 发表于： 04-06-04 03:56  
注册会员
快乐的鱼

回复 1037
注册于 04-03-30 If bytDB_ID = 1 Then
' '以下为解密过程
'' If INNER_CanOpenDateBase(fsDBsee, "") Then '先假定数据库无密码
'' GoTo Endlabel
'' End If
'
' bytKey = INNER_Hex2ByteA(sKey2K)
' ReDim bytRslt(UBound(bytKey))
' For l = 0 To UBound(bytKey)
' bytRslt(l) = bytKey(l) Xor bytFile(l)
' Next l
'
' For n = 0 To glCounts
' If gbExit Then
' Exit Function
' End If
' sPassword = ""
'
' '这里，n值与本数据库创建的时间是相关的，n值一旦确定，密码便迎刃而解了。
' '由于此处演示暴力破解，因此n值的解法略
'
' frmMain.Shape1.Width = frmMain.lblProcess.Width * (n + 1) / glCounts
'' bytTemp = 0
' For l = 0 To UBound(bytKey) \ 2
' If l Mod 2 = 0 Then
' If glCounts = 255 Then
' lAscii = bytRslt(2 * l) Xor n
' Else
' lAscii = (CLng(bytRslt(2 * l + 1)) * 256 + bytRslt(2 * l)) Xor n
' End If
' lTemp = lTemp Xor lAscii