功能是：在数据库中建立一个数据表用保存系统用户登录信息，在设计登录对话框时通过该数据表完成验证．不知什么原因输入正确的用户名和口令也不能登录，望高手指下，在下不胜感激
代码如下:
Const MaxLogTimes As Integer = 3
Private Sub Command1_Click()
Dim intResult As Integer
intResult = MsgBox("你选择了退出系统!" & vbCrlf_ & "是否真的退出", vbYesNo, "登录系统")
If intResult = vbYes Then End
End Sub
Private Function check_PassWord(ByVal UserName As String, ByVal Password As String) As Byte
On Error GoTo gpError
Dim objCn As New Connection, objRs As New Recordset, strCn As String
Dim strSQl As String
'建立数据库连接
objCn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "D:\vb\01.mdb"
objCn.Open
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
gpError:
check_PassWord = 225
Set objRs = Nothing
Set objCn = Nothing
End Function
Private Sub Command2_Click()
Static intLogTimes As Integer
Dim intChecked As Integer, strName As String, strPassword As String
intLogTimes = intLogTimes + 1
If intLogTimes > MaxLogTimes Then
MsgBox ("你已超过允许验证次数!")
End
Else
strName = Trim(txtUserName.Text)
strPassword = Trim(textPassword.Text)
Select Case check_PassWord(strName, strPassword)
Case 0
MsgBox "&strName& 不是系统用户，请检查用户名是否正确!", vbCritical, "登录验证"
txtUserName.SetFocus
txtUserName.SelStart = 0
txtUserName.SelLength = Len(txtUserName)
Case 1
MsgBox "口令错误，请重新输入", vbCritical, "登录验证"
textPassword = ""
txtPassword.SetFocus
Case 2
Unload Me
MsgBox "登录成功, 将启动系统程序!", vbInformation, "登录验证"
Case Else
MsgBox "登录验证末正常完成，请与管理员联系", vbCritical, "登录验证"
End Select
End If
End Sub
