不看会后悔的Windows XP之经验谈	简单快捷DIY实用家庭影院

请教高手关于判断数据库密码的问题！急，在线等～

楼主jehon（没车步行中。。。）2005-04-02 10:49:09 在 VB / 基础类提问

VB连ACCESS数据库，在登录界面要输入数据库密码。现在的情况是，我不输数据库密码或输入错误的密码，VB自动调用错误信息，说密码无效。
能不能由我来判断我输入的数据库密码跟实际数据库的密码是否匹配？以便由我来指定当错误发生时显示何种提示信息～或进行何种操作？！问题点数：20、回复次数：12Top

1 楼jehon（没车步行中。。。）回复于 2005-04-02 11:29:38 得分 0

大家帮帮我！:(Top

2 楼chendjin（蹭分来了）回复于 2005-04-02 11:37:08 得分 5

'定义允许用户验证登录信息的最大次数
Const MaxLogTimes As Integer = 3

Private Sub cmdCancel_Click()
'请求用户确认是否真的退出系统登录
If MsgBox("你选择了退出系统登录，退出将不能启动管理系统！" & vbCrLf _
& "是否真的退出？", vbYesNo, "登录验证") = vbYes Then
Unload Me '卸载登录窗体
End If
End Sub

Private Sub cmdOk_Click()
Dim intChecked As Integer
Dim strName As String, MdbPath As String, strPassword As String

'静态常量intLogTimes用于保存用户请求验证的次数
Static intLogTimes As Integer
intLogTimes = intLogTimes + 1 '保存登录次数
If intLogTimes > MaxLogTimes Then
'超过允许的登录次数，显示提示信息
MsgBox "你已经超过允许的登录验证次数！" & vbCr _
& "应用程序将结束！", vbCritical, "登录验证"
End '结束应用程序
Else
'进一步验证登录信息的合法性
strName = Trim(txtLog(0).Text) '获得用户名
strPassword = Trim(txtLog(1).Text) '获得口令

'检验用户名和口令的合法性，并根据检验返回值执行相应的操作
MdbPath = App.Path & "\物管数据库.mdb"
Select Case Check_PassWord(MdbPath, strName, strPassword)
Case 0
'用户不是系统用户
MsgBox "用户不是系统用户,请检查用户名输入是否正确！", _
vbCritical, "登录验证"
txtLog(0).SetFocus
txtLog(0).SelStart = 0
txtLog(0).SelLength = Len(txtLog(0))
Case 1
'口令错误
MsgBox "口令错误,请重新输入！", vbCritical, "登录验证"
txtLog(1) = ""
txtLog(1).SetFocus
Case 2
Unload Me '口令正确,卸载登录窗体
MsgBox "登录成功，将启动系统程序！", vbInformation, "登录验证"

'通常在此放置显示系统主窗体的语句，例如
'frmMain.Show
Case Else
'登录验证未正常完成
MsgBox "登录验证未正常完成！请重新运行登录程序，" & vbCrLf _
& "如果仍不能登录，请报告系统管理员！", _
vbCritical, "登录验证"
End Select
End If
End Sub

Private Function Check_PassWord(ByVal MdbPath As String, ByVal UserName As String, _
ByVal Password As String) As Byte
On Error GoTo gpError
'查询数据库，获得UserName的登录口令
Dim objCn As ADODB.Connection
Dim objRs As ADODB.Recordset
Dim strCn As String, strSQL As String

Set objCn = New Connection
Set objRs = New Recordset
'建立数据库连接
With objCn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & MdbPath & ";" & _
"Mode=Share Deny Read|Share Deny Write;Persist Security Info=False;" & _
"Jet OLEDB:Database Password=" & Password & ";"
.Open
End With

'执行查询命令,获得用户登录口令
strSQL = "SELECT 口令 FROM 系统用户 WHERE 用户名='" _
& UserName & "'"
Set objRs.ActiveConnection = objCn
objRs.Open (strSQL)

'判断有无查询结果
If objRs.EOF Then
Check_PassWord = 0 '没有查询结果，表示该用户为非法用户
Else
'检查口令是否正确
If Password <> Trim(objRs.Fields("口令").Value) Then
Check_PassWord = 1 '口令不正确
Else
Check_PassWord = 2 '口令正确
End If
End If

'关闭数据库连接，释放对象
objCn.Close
Set objRs = Nothing
Set objCn = Nothing
Exit Function
gpError:
Check_PassWord = 255
End FunctionTop

3 楼jehon（没车步行中。。。）回复于 2005-04-02 11:42:14 得分 0

我要判断的是数据库的密码，不是系统用户的密码～Top

4 楼zhoujiamurong（有分俺就不要，俺要知识）回复于 2005-04-02 11:47:40 得分 0

用一个用户输入的变量（如text1.text）来生成连接字符串，然后，用这个试着连数据库，如果不行，就说明错误Top

5 楼jehon（没车步行中。。。）回复于 2005-04-02 11:53:25 得分 0

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\misdata.mdb;Persist Security Info=False; Jet OLEDB:Database Password='" & datapw & "';" 我就想要判断Database Password 与 '" & datapw & "'是不是相等～Top

6 楼yin138（大海）回复于 2005-04-02 12:03:16 得分 0

用这个PW试一个，并设置一个错误句柄，如果不行的话，检查一下ErrNumber,如果是正确的话，程序就可以打开数据库，但是如果错误且是密码错误的话，那就是不相等咯。Top

7 楼jehon（没车步行中。。。）回复于 2005-04-02 12:14:57 得分 0

在我不输数据库密码或输入错误密码的情况下
cn.open strConn 就会弹出一个‘密码无效’的对话框（）

请问如果密码是正确的，cn.open strConn 返回的是个什么值？如果发生异常，是不是也应该有值返回呢？那我能不能知道它返回的值是什么？Top

8 楼chendjin（蹭分来了）回复于 2005-04-02 12:22:22 得分 10

给你一段获取.mdb密码代码，知道后自己看着办。
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'fbDirect=True,直接给出密码GetAccessPwd
Public Function 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 = GetPwdDirect(bytDateKey)
If sPassword = "" Then sPassword = "无密码"
GoTo Endlabel
End If

If bytDB_ID = 1 Then
ElseIf bytDB_ID = 0 Then
bytKey = 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 = "无密码"

Endlabel:
GetAccessPwd = sPassword
Exit Function
ErrLabel:
GetAccessPwd = Err.Description
End Function
'实用函数，将16进制的字符串转换成字节型的数组
Public Function 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
Hex2ByteA = btyTemp
End Function
Public Function 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
GetPwdDirect = sPassword
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
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

Private Sub Command1_Click()
Dim sFile As String
Dim sVersion As String

sFile = App.Path & "\DATA.mdb"
Text1.Text = GetAccessPwd(sFile, sVersion, True)
Text2.Text = sVersion
End Sub
Top

9 楼dqhuaying（不再留恋）回复于 2005-05-24 09:51:30 得分 0

好深Top

10 楼xuxutj（紫雨）回复于 2005-05-27 14:25:28 得分 0

好强的代码啊Top

11 楼hr88rong（阿榕（http://www.caixiong.com/?69583361.htm））回复于 2005-05-27 17:09:32 得分 0

帮你顶,学习中......Top

12 楼yangfengcl（傷透腦袋）回复于 2005-05-28 11:30:20 得分 5

rs.Open "select 用戶名,密碼 from usepass where 用戶名='" & usename.Text & "'", db, adOpenStatic, adLockBatchOptimistic
If rs.EOF = False Then
If (IsNull(rs.Fields("密碼")) And Text2.Text = "") Or rs.Fields("密碼") = Text2.Text Then
rs.Close
db.Close
password.Hide
main.Show
main.Command5.Enabled = True
Else
MsgBox "密碼不正確，請注意大小寫，重新輸入！", , "登入"
End If
Else
MsgBox "用戶名不正確，請重新輸入！", , "登入"
End IfTop