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

ゝ一世哀愁。 2023-10-17 18:01 41阅读 0赞

### 构思 ###

#### 用户体验 ####

*  窗体色调 – 原版有点不符合我审美；
 *  窗体外观 – 模仿 QQ 登录窗体「大小不可变」；
 *  窗体呈现位置 – 屏幕中央；
 *  用户习惯的最大保留 – Tab 键以及回车键的使用。

#### 系统安全 ####

*  提示「密码与用户名不正确」的条件；
 *  防止 SQL 注入；
 *  密码的非明文显示。

#### 登录流程 ####

*  方案一
    
    先对用户名进行判断「是否为空，是否存在」；然后判断密码「是否为空，是否正确」。
 *  方案二
    
    先对空进行判断「用户名与密码」；然后判断是否与存在是否正确「用户名与密码」。
    
    ![附上两种方案流程图][format_png]

### 代码 ###

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

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

[format_png]: https://imgconvert.csdnimg.cn/aHR0cDovL2ltZy5ibG9nLmNzZG4ubmV0LzIwMTgwMTI4MTE1MzA3MjIz?x-oss-process=image/format,png