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

构思

用户体验

• 窗体色调 – 原版有点不符合我审美；
• 窗体外观 – 模仿 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：用来存放 SQL 语句
    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