可还是不好用啊
Option Explicit
Public exePath As String
Private Sub Command1_Click()
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
If Trim(txtUser.Text) = "" Or Trim(txtPwd.Text) = "" Then
MsgBox "用户名和密码不允许为空" & Space(5), vbExclamation + vbOKOnly, "登陆失败"
txtUser.SetFocus
Exit Sub
ElseIf InStr(1, txtUser.Text, "'") > 0 Then
MsgBox "不允许输入特殊字符" & Space(5), vbExclamation + vbOKOnly, "系统提示"
txtUser.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Else
Dim lLogin As Long
lLogin = CheckLogin(Trim(txtUser.Text), MD5(Trim(txtPwd.Text), 1))
Select Case lLogin
Case 0:
sCurUser = Trim(txtUser.Text)
Me.Hide
frmMain.Show
Unload Me
Case 1:
MsgBox "该用户不存在" & Space(5), vbInformation + vbOKOnly, "系统提示"
txtUser.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Case 2:
MsgBox "密码错误,请重新输入" & Space(5), vbExclamation + vbOKOnly, "登陆失败"
txtPwd.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Case 3:
MsgBox "登陆失败,请重新启动程序" & Space(5), vbExclamation + vbOKOnly, "登陆失败"
Unload Me
End Select
End If
End Sub
Private Function CheckLogin(Name As String, Pwd As String) As Long
On Error GoTo LoginErr
Dim Rs As Recordset
Dim Password As String
Set Rs = New Recordset
Rs.Open "Select Name,Paseword from Users where Name='" & Name & "'", cnDB, adOpenForwardOnly, adLockReadOnly
If Rs.RecordCount = 0 Then
Rs.Close
Set Rs = Nothing
CheckLogin = 1 '无次用户
Exit Function
End If
If Rs!Password <> Password Then
CheckLogin = 2
Else
CheckLogin = 0
End If
Rs.Close
Set Rs = Nothing
Exit Function
LoginErr:
'Rs.Close
Set Rs = Nothing
CheckLogin = 3
End Function
Private Sub Text1_Change()
End Sub
Private Sub Text2_Change()
End Sub
Private Sub Form_Load()
Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Me.Hide
SystemInit
Dim bool As Boolean
End Sub
Private Sub SystemInit()
Dim Rs As Recordset
Dim conStr As String
Set cnDB = New Connection
conStr = "Provider=SQLOLEDB.1;User ID=sa;Password=;" & _
"DataSource=(local);Database=baizi;Persist Security Info=False"
cnDB.ConnectionString = conStr
cnDB.Open
If cnDB.State = adStateOpen Then
Set Rs = New Recordset
Rs.CursorLocation = adUseClient
If Rs.State <> adStateClosed Then Rs.Close
Rs.Open "Select Name,Password from Users", cnDB, adOpenForwardOnly, adLockReadOnly
If Rs.RecordCount = 0 Then
bNoUser = True
MsgBox "请先建立一个系统管理用户" & Space(5), vbInformation + vbOKOnly, "系统提示"
frmAddUser.Show
Else
bNoUser = False
Me.Show
Exit Sub
End If
Rs.Close
Set Rs = Nothing
Unload Me
Else
MsgBox "数据库连接失败,请重新启动程序" & Space(5), vbExclamation + vbOKOnly, "启动失败" '数据库连接失败则退出程序
Unload Me
End If
End Sub
thBmtViL.zip