代码大神抽时间帮看一下,小女子在此感谢
Option ExplicitConst n As Integer = 3
Private Sub cmd取消_Click()
If MsgBox("你选择了退出系统登录,退出将不能启动管理系统!" & vbCrLf & "是否真的退出?", vbYesNo, "登录验证") = vbYes Then
Unload Me
End If
End Sub
Private Sub cmd确定_Click()
Dim i As Integer
Dim name As String, password As String
Static k As Integer
k = k + 1
If k > n Then
MsgBox "你已经超过允许的登录验证次数!" & vbCr & "应用程序将结束!", vbCritical, "登录验证"
End
Else
name = Trim(txt登录(0).Text)
password = Trim(txt登录(1).Text)
Select Case check_password(name, password)
Case 0
MsgBox "用户不是系统用户,请检查用户名输入是否正确!", vbCritical, "登录验证"
txt登录(0).SetFocus
txt登录(0).SelStart = 0
txt登录(0).SelLength = Len(txt登录(0))
Case 1
MsgBox "密码错误,请重新输入!", vbCritical, "登录验证"
txt登录(1) = ""
txt登录(1).SetFocus
Case 2
Unload Me
MsgBox "登录成功,欢迎进入该企业人事管理系统!", vbInformation, "登录验证"
FrmMain.Show
Case Else
MsgBox "登录验证未完成!请重新运行登录程序", vbCritical, "提示"
End Select
End If
End Sub
Private Function check_password(ByVal name As String, ByVal password As String) As Byte
On Error GoTo Error
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim str As String, qstr As String
str = connectstr()
cn.Open str
qstr = "select user_ID from user_info where username='" & name & "'"
If txt登录(0) <> "" And txt登录(1) <> "" Then
rs.Open qstr, cn
ElseIf txt登录(0) <> "" Then
check_password = 3
End If
If check_password <> 3 Then
If rs.EOF = True Then
check_password = 0
Else
If password <> Trim(rs.Fields("user_ID").Value) Then
check_password = 1
Else
check_password = 2
End If
End If
End If
cn.Close
Set rs = Nothing
Set cn = Nothing
Exit Function
Error:
check_password = 255
End Function
Private Sub Form_Load()
End Sub
'Public Function ConnectString() As String
'ConnectString = " Driver={SQL Server};Server=WWW-FF7EBDD3239;UserID=sa;Password=123;Database=personnel"
'End Function
Private Sub txt登录_Change(Index As Integer)
End Sub
就是一个简单的登陆界面,就是不能执行。SQL里面有personnel库,user-info表,表里分别有username和user-ID.代码行家帮个大忙吧。代码的错误提示是子程序和函数未定义:str = connectstr()
--------------------编程问答-------------------- 注意检查正确,返回true,否则返回False
Private Function check_password(ByVal name As String, ByVal password As String) As boolean
' On Error GoTo Error 蛋疼的语句,可以很好的帮助你隐藏错误
on error goto ErrorX
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim qstr As String 'str As String, str是vb内置函数最好不要这样用
cn.CursorLocation = adUseClient
cn.connectionstring" Driver={SQL Server};Server=WWW-FF7EBDD3239;UserID=sa;Password=123;Database=personnel"
cn.Open
qstr = "select user_ID from user_info where username='" & name & "'"
' If txt登录(0) <> "" And txt登录(1) <> "" Then 既然是以了函数,在函数里最好不要使用窗口的元素
set rs=cn.execut(qstr)
'ElseIf txt登录(0) <> "" Then
' check_password = 3
' End If
' If check_password <> 3 Then
' If rs.EOF = True Then
' check_password = 0
' Else
' If password <> Trim(rs.Fields("user_ID").Value) Then
' check_password = 1
' Else
' check_password = 2
' End If
' End If
' End If '什么逻辑?
if rs.recorcount>0 then
check_password=cboolean(password=rs("User_ID"))
end if
cn.Close
Set rs = Nothing
Set cn = Nothing
Exit Function
ErrorX:
check_password = 255
msgbox err.description
End Function
--------------------编程问答-------------------- 女孩子一个不要写程序,一个不要开车。
就是喝醉了酒也不至于写出这么乱的程序。 --------------------编程问答-------------------- sql判断执行成功可以用这个
if not rs.eof then
end if
代码问题好多 不要用中文的控件名 会发生未知错误的 --------------------编程问答-------------------- 按照那样改了也不行,子程度或函数未定义,check_password=cboolean(password=rs("User_ID")) 这句中的rs.好头痛呀,谢谢你
补充:VB , 数据库(包含打印,安装,报表)