密码破解 文本文档.txt

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

' Else
' lAscii = CLng(bytRslt(2 * l + 1)) * 256 + bytRslt(2 * l)
' End If
' If lAscii <> 0 Then
' '在2000的数据库中，一个双字节的密码只占用一个位置。
' '这就是当前市面上大部分解密软件无法解密中文密码的关键。
' '因此，一个2000数据库，可以最长使用20个中文字来组成密码。
' 'VB中恰好有ChrW来代替API WideCharToMultiByte 对Unicode字节进行转换
' sPassword = sPassword & ChrW(lAscii)
' End If
' Next l
' If sPassword <> "" Then
' If INNER_CanOpenDateBase(fsDBsee, sPassword) Then
' GoTo Endlabel
' End If
' End If
' Next n
' If glCounts = 255 Then
' sPassword = "未找到密码，请尝试更多的密码！"
' End If
ElseIf bytDB_ID = 0 Then
bytKey = INNER_Hex2ByteA(sKey97)
For l = 0 To UBound(bytKey)
lAscii = bytKey(l) Xor bytFile(l)
If lAscii <> 0 Then
sPassword = sPassword & Chr(lAscii)
End If
Next l
Else
sPassword = "非ACCESS数据库文件"
End If
If sPassword = "" Then sPassword = "无密码" 
 

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

回复 1037
注册于 04-03-30 Endlabel:
INNER_GetAccessPwd = sPassword
Exit Function
ErrLabel:
INNER_GetAccessPwd = Err.Description
End Function

Public Function INNER_GetPwdDirect(fbytFile() As Byte) As String
Dim l As Long
Dim bytEncriptKey(3) As Byte '初始密码
Dim bytEncriptRet(257) As Byte
Dim dbl As Double
Dim lKey As Long
Dim lRslt(19) As Long
Dim sPassword As String

bytEncriptKey(0) = &HC7
bytEncriptKey(1) = &HDA
bytEncriptKey(2) = &H39
bytEncriptKey(3) = &H6B

'先直接使用上面的初始密码通过查表的方法形成新的密钥
'本函数有点DES算法的味道
Call LoGetEncryptStr(bytEncriptKey, bytEncriptRet, 4)
'利用上面形成的密钥对文件中的加密字串fbytFile进行解密，得到结果bytEncriptRet
Call LoGetKey(bytEncriptRet, fbytFile, &H80)
'比尔的原版ACCESS算法中，使用了数学协处理器的浮点指令FISTP、FSTCW等，
'但我发现，采用CopyMemory方法有种殊途同归的感觉
CopyMemory ByVal VarPtr(dbl), ByVal VarPtr(fbytFile(0)) + 90, 8
'lKey是整个过程的关键，如果不是跟踪到核心算法，我是永远猜不透这个数值的来历的。
'这就是我先前使用暴力的原因。
lKey = Int(dbl)
For l = 0 To 19
lRslt(l) = fbytFile(l * 2 + 42) + 256 * CLng(fbytFile(l * 2 + 43))
If l Mod 2 = 0 Then
lRslt(l) = lRslt(l) Xor lKey
End If
If lRslt(l) <> 0 Then
'用ChrW来代替WideCharToMultiByte对Unicode字节进行转换
sPassword = sPassword & ChrW(lRslt(l))
End If
Next l
INNER_GetPwdDirect = sPassword
End Function
'
'Public Function INNER_CanOpenDateBase(fsFilename As String, fsPasswd As String) As Boolean
' On Error GoTo ErrLabel
' Dim sConn As String
' '通过暴力来测试连接是否正确的方式很多，这里，可以根据情况确定使用ADO或DAO来测试
' '实际上，也可以使用对Microsoft Access 10.0 Object Library的引用来进行测试。
' '这里，大家也可以学习到如何建立ADO或DAO的连接字串 
 

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

回复 1037
注册于 04-03-30 ' #If USE_DAO Then
' Set gDAO = DAO.OpenDatabase(fsFilename, False, 0, ";pwd=" & fsPasswd)
' INNER_CanOpenDateBase = True
' Set gDAO = Nothing
' #Else
' Set gADO = New ADODB.Connection
' sConn = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fsFilename & _
' ";Jet OLEDB:Database Password =" & fsPasswd & ";"
' gADO.Open sConn
' INNER_CanOpenDateBase = True
' Set gADO = Nothing
' #End If
'ErrLabel:
' DoEvents
'End Function

'实用函数，将16进制的字符串转换成字节型的数组
Public Function INNER_Hex2ByteA(fsData As String) As Byte()
Dim i As Integer
Dim btyTemp() As Byte

If fsData = "" Then fsData = 0
If Len(fsData) < 2 Then
ReDim btyTemp(0)
btyTemp(0) = CByte("&H" & fsData)
Else
ReDim btyTemp(0 To Len(fsData) \ 2 - 1)
For i = 0 To Len(fsData) \ 2 - 1
btyTemp(i) = CByte("&H" & Mid(fsData, (i + 1) * 2 - 1, 2))
Next i
End If
INNER_Hex2ByteA = btyTemp
End Function

'本函数将得到解密用的KEY
Private Function LoGetEncryptStr(fbytEncriptKey() As Byte, fbytEncriptRet() As Byte, flModeValue As Long)
Dim l As Long
Dim lTemp1 As Long
Dim lTemp2 As Long
Dim lTemp3 As Long
Dim lTemp4 As Long
Dim lTemp5 As Long

For l = 0 To 255
fbytEncriptRet(l) = l
Next l
lTemp1 = 0
For l = 0 To 255
lTemp1 = lTemp2
lTemp1 = fbytEncriptKey(lTemp1)
lTemp4 = fbytEncriptRet(l)
lTemp1 = lTemp1 + lTemp4
lTemp4 = lTemp3
lTemp1 = lTemp1 + lTemp4
lTemp1 = lTemp1 And &H800000FF
lTemp3 = lTemp1
lTemp1 = fbytEncriptRet(l)
lTemp5 = lTemp1
lTemp1 = lTemp3
lTemp1 = fbytEncriptRet(lTemp1)
fbytEncriptRet(l) = lTemp1
lTemp4 = lTemp3
fbytEncriptRet(lTemp4) = lTemp5
lTemp1 = lTemp2
lTemp1 = lTemp1 + 1
lTemp4 = lTemp1 Mod flModeValue
lTemp2 = lTemp4
Next l
End Function 
 

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

回复 1037
注册于 04-03-30 Private Function LoGetKey(fbytEncriptKey() As Byte, fbytKeyRet() As Byte, flMaxValue As Long)
Dim l As Long
Dim lTemp1 As Long
Dim lTemp2 As Long
Dim lTemp3 As Long
Dim lTemp4 As Long
Dim lTemp5 As Long
Dim lTemp6 As Long
Dim lTemp7 As Long
Dim lTemp8 As Long

lTemp4 = fbytEncriptKey(&H100)
lTemp1 = fbytEncriptKey(&H101)

For l = 1 To flMaxValue
lTemp4 = lTemp4 + 1
lTemp4 = lTemp4 And &H800000FF
lTemp3 = lTemp4 And &HFF
lTemp5 = fbytEncriptKey(lTemp3)
lTemp1 = lTemp1 And &HFF
lTemp5 = lTemp5 + lTemp1
lTemp1 = lTemp5 And &H800000FF
lTemp6 = fbytEncriptKey(lTemp4)
lTemp5 = fbytEncriptKey(lTemp1)
fbytEncriptKey(lTemp3) = lTemp5
lTemp2 = lTemp1
fbytEncriptKey(lTemp2) = lTemp6
lTemp5 = fbytEncriptKey(lTemp3)
lTemp3 = fbytEncriptKey(lTemp1 And &HFF)
lTemp5 = lTemp5 + lTemp3
lTemp5 = lTemp5 And &H800000FF
lTemp7 = lTemp5
lTemp3 = lTemp8
lTemp5 = fbytEncriptKey(lTemp5)
fbytKeyRet(lTemp3) = fbytKeyRet(lTemp3) Xor lTemp5
lTemp8 = lTemp8 + 1
Next l
fbytEncriptKey(&H100) = lTemp4
fbytEncriptKey(&H101) = lTemp1
End Function 
 

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

回复 1037
注册于 04-03-30 类模块

Option Explicit


Public Enum EErrorCommonDialog
eeBaseCommonDialog = 13450 ' CommonDialog
End Enum

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalReAlloc Lib "kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryStr Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, ByVal lpvSource As String, ByVal cbCopy As Long) 
 

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

回复 1037
注册于 04-03-30 Private Const MAX_PATH = 260
Private Const MAX_FILE = 260

Private Type OPENFILENAME
lStructSize As Long ' Filled with UDT size
hWndOwner As Long ' Tied to Owner
hInstance As Long ' Ignored (used only by templates)
lpstrFilter As String ' Tied to Filter
lpstrCustomFilter As String ' Ignored (exercise for reader)
nMaxCustFilter As Long ' Ignored (exercise for reader)
nFilterIndex As Long ' Tied to FilterIndex
lpstrFile As String ' Tied to FileName
nMaxFile As Long ' Handled internally
lpstrFileTitle As String ' Tied to FileTitle
nMaxFileTitle As Long ' Handled internally
lpstrInitialDir As String ' Tied to InitDir
lpstrTitle As String ' Tied to DlgTitle
flags As Long ' Tied to Flags
nFileOffset As Integer ' Ignored (exercise for reader)
nFileExtension As Integer ' Ignored (exercise for reader)
lpstrDefExt As String ' Tied to DefaultExt
lCustData As Long ' Ignored (needed for hooks)
lpfnHook As Long ' Ignored (good luck with hooks)
lpTemplateName As Long ' Ignored (good luck with templates)
End Type

Private Declare Function GetOpenFileName Lib "COMDLG32" _
Alias "GetOpenFileNameA" (file As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "COMDLG32" _
Alias "GetSaveFileNameA" (file As OPENFILENAME) As Long
Private Declare Function GetFileTitle Lib "COMDLG32" _
Alias "GetFileTitleA" (ByVal szFile As String, _
ByVal szTitle As String, ByVal cbBuf As Long) As Long 
 

--------------------------------------------------------------------------------