【VB】第一次机房收费系统 -- 登录篇

构思

用户体验

窗体色调 – 原版有点不符合我审美；

窗体外观 – 模仿 QQ 登录窗体「大小不可变」；

窗体呈现位置 – 屏幕中央；

用户习惯的最大保留 – Tab 键以及回车键的使用。

系统安全

提示「密码与用户名不正确」的条件；

防止 SQL 注入；

密码的非明文显示。

登录流程

方案一

先对用户名进行判断「是否为空，是否存在」；然后判断密码「是否为空，是否正确」。

方案二

先对空进行判断「用户名与密码」；然后判断是否与存在是否正确「用户名与密码」。

代码

此处用的「方案一」，但是「方案二」更为妥当。

Option Explicit
Private Declare Function getusername Lib "advapi32.dll" (ByVal Ipbuffer As String, nSize As Long) As Long
Public OK As Boolean                                                            '该类的公有成员
Dim miCount As Integer                                                          '记录登录次数
Rem：取消按键功能的实现
Private Sub cmdCancel_Click()
Unload Me
End Sub
Rem：确认按键功能的实现
Private Sub cmdOk_Click()
Rem：用来存放 S
4000
QL 语句
Dim txtSQL As String
Dim txtSQL2 As String
Rem：用来存放记录集对象
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset
Rem：用来存放返回信息
Dim MsgText As String
UserName = ""
Dim Userlevel As String
If Trim(txtUserName.Text = "") Then                                         '判断用户名是否为空
MsgBox "请先输入用户名再登录！", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
txtSQL = "select * from User_Info where userID ='" & txtUserName.Text & "'" '查询指定用户名记录
Set mrc = ExecuteSQL(txtSQL, MsgText)                                   '执行查询语句
If mrc.EOF Then
MsgBox "无此用户，请重新输入！", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
If Trim(txtPassword.Text = "") Then                                 '判断密码是否为空
MsgBox "请输入密码再登录！", vbOKOnly + vbExclamation, "警告"
txtPassword.SetFocus
Else
If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then            '判断密码是否正确
OK = True
UserName = Trim(txtUserName.Text)
txtSQL = "select * from OnWork_Info where userid='" & txtUserName.Text & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
mrc1.AddNew
mrc1.Fields(0) = Trim(txtUserName.Text)
mrc1.Fields(1) = Trim(mrc.Fields(2))
mrc1.Fields(2) = Date
mrc1.Fields(3) = Time
mrc1.Fields(4) = Environ("computername")
mrc1.Update
Rem：判断用户权限
txtSQL = "select * from User_Info where userID ='" & Trim(txtUserName.Text) & "'"
Set mrc3 = ExecuteSQL(txtSQL, MsgText)
If mrc3.EOF = False Then
Userlevel = Trim(mrc3.Fields(2))
End If

If Trim(Userlevel) = "操作员" Then
MDImain.toolMenuOperator.Enabled = True
MDImain.toolMenuGeneralUser.Enabled = True
MDImain.toolMenuAdministrators.Enabled = False
MDImain.toolMenuAdministrators.Visible = False
ElseIf Trim(Userlevel) = "一般用户" Then
MDImain.toolMenuOperator.Enabled = False
MDImain.toolMenuOperator.Visible = False
MDImain.toolMenuGeneralUser.Enabled = True
MDImain.toolMenuAdministrators.Enabled = False
MDImain.toolMenuAdministrators.Visible = False
ElseIf Trim(Userlevel) = "管理员" Then
MDImain.toolMenuOperator.Enabled = True
MDImain.toolMenuGeneralUser.Enabled = True
MDImain.toolMenuAdministrators.Enabled = True
MDImain.toolMenuAdministrators.Visible = True
End If
mrc1.Close
mrc.Close
Me.Hide
Else
MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
txtPassword.SetFocus
txtPassword.Text = ""
End If
End If
End If
End If
End Sub
Rem：
Private Sub Form_Load()
Dim sBuffer As String
Dim LSize As Long
sBuffer = Space$(255)
LSize = Len(sBuffer)
If LSize > 0 Then
txtUserName.Text = ""
Else
txtUserName.Text = vbNullString
End If
OK = False
miCount = 0
End Sub
Rem：防止 SQL 注入
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
Call Number_KeyPress(KeyAscii)
End Sub