第一次机房收费系统之管理员删除添加用户

操作流程：

根据用户级别的不同，显示不同的数据，可点击右方的添加，显示添加用户窗体进行添加，可以选中MSHFlexGrid控件中的内容，点击删除键进行删除，更新是为了添加删除用户后进行重新显示内容。

使用的数据库表：

user_info（存放用户信息）

具体代码如下：

显示信息的操作：

Private Sub comboUserLevel_Click()
    '对user_info表操作
    Dim mrcuser As ADODB.Recordset '用于存放记录集
    Dim userSQL As String '用于存放SQL语句
    Dim userMsgText As String '用于存放返回信息
    
    '对MSHFlexGrid进行操作
    With MSHFlexGrid
        .Rows = 1
        '用判断语句进行操作，按条件查询
        Select Case comboUserLevel
            Case "管理员"
                userSQL = "select * from user_info where level='管理员'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '判断记录是否为空
                If mrcuser.EOF = True Then
                    MsgBox "无管理员数据！", vbOKOnly + vbInformation, "提示"
                    Exit Sub
                Else
                    '在记录到达最后一行前做循环，将记录显示在MSHFlexGrid中
                    Do While mrcuser.EOF = False
                        .Rows = .Rows + 1
                        .CellAlignment = 4
                        .TextMatrix(.Rows - 1, 0) = Trim(mrcuser.Fields(0))
                        .TextMatrix(.Rows - 1, 1) = Trim(mrcuser.Fields(3))
                        .TextMatrix(.Rows - 1, 2) = Trim(mrcuser.Fields(4))
                        mrcuser.MoveNext
                    Loop
                    mrcuser.Close
                End If
            Case "操作员"
                userSQL = "select * from user_info where level='操作员'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '判断记录是否为空
                If mrcuser.EOF = True Then
                    MsgBox "无操作员数据！", vbOKOnly + vbInformation, "提示"
                    Exit Sub
                Else
                    '在记录到达最后一行前做循环，将记录显示在MSHFlexGrid中
                    Do While mrcuser.EOF = False
                        .Rows = .Rows + 1
                        .CellAlignment = 4
                        .TextMatrix(.Rows - 1, 0) = Trim(mrcuser.Fields(0))
                        .TextMatrix(.Rows - 1, 1) = Trim(mrcuser.Fields(3))
                        .TextMatrix(.Rows - 1, 2) = Trim(mrcuser.Fields(4))
                        mrcuser.MoveNext
                    Loop
                    mrcuser.Close
                End If
            Case "一般用户"
                userSQL = "select * from user_info where level='一般用户'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '判断记录是否为空
                If mrcuser.EOF = True Then
                    MsgBox "无一般用户数据！", vbOKOnly + vbInformation, "提示"
                    Exit Sub
                Else
                    '在记录到达最后一行前做循环，将记录显示在MSHFlexGrid中
                    Do While mrcuser.EOF = False
                        .Rows = .Rows + 1
                        .CellAlignment = 4
                        .TextMatrix(.Rows - 1, 0) = Trim(mrcuser.Fields(0))
                        .TextMatrix(.Rows - 1, 1) = Trim(mrcuser.Fields(3))
                        .TextMatrix(.Rows - 1, 2) = Trim(mrcuser.Fields(4))
                        mrcuser.MoveNext
                    Loop
                    mrcuser.Close
                End If
        End Select
    End With
End Sub

添加的操作：

Private Sub cmdAddUser_Click()
    frmADDUser.Show
    Me.Hide
End Sub


添加窗体的代码
Option Explicit
Dim H As Single '定义窗体高的变量
Dim W As Single '定义窗体高的变量

Private Sub cmdCancel_Click()
    Unload Me
    frmADUser.Show
End Sub

Private Sub cmdEmpty_Click()
    '清空控件内容
    txtUserID.Text = ""
    comboUserLevel.Text = ""
    txtUserName.Text = ""
    txtPassWord.Text = ""
    txtOKPassWord.Text = ""
End Sub

Private Sub cmdOK_Click()
    '对user_info表操作
    Dim mrcuser As ADODB.Recordset '用于存放记录集 '用于存放记录集
    Dim userSQL As String '用于存放SQL语句 '用于存放SQL语句
    Dim userMsgText As String '用于存放返回信息 '用于存放返回信息
    '对用户名、用户级别、姓名、密码等做限制，使其不为空
    If txtUserID.Text = "" Then
        MsgBox "请输入用户名！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        If comboUserLevel.Text = "" Then
            MsgBox "请输入用户级别！", vbOKOnly + vbExclamation, "警告"
            Exit Sub
        Else
            If txtUserName.Text = "" Then
                MsgBox "请输入姓名！", vbOKOnly + vbExclamation, "警告"
                Exit Sub
            Else
                If txtPassWord.Text = "" Then
                    MsgBox "请输入密码！", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                Else
                    If txtOKPassWord.Text = "" Then
                        MsgBox "请输入确认密码！", vbOKOnly + vbExclamation, "警告"
                        Exit Sub
                    Else
                        '判断两次是否输入密码一致
                        If Trim(txtPassWord.Text) <> Trim(txtOKPassWord.Text) Then
                            MsgBox "确认密码与密码应相同！", vbOKOnly + vbInformation, "警告"
                            txtOKPassWord.Text = ""
                            txtOKPassWord.SetFocus
                        Else
                            'userSQL中搜索记录
                            userSQL = "select * from user_info where userid='" & Trim(txtUserID.Text) & "'"
                            Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                            
                            '判断用户记录是否为空
                            If mrcuser.EOF = False Then
                                MsgBox "用户重复，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"
                                txtUserID.Text = ""
                                txtUserID.SetFocus '使此控件得到焦点
                                mrcuser.Close
                                Exit Sub
                            Else
                                '给user表添加新记录
                                mrcuser.AddNew
                                mrcuser.Fields(0) = Trim(txtUserID.Text)
                                mrcuser.Fields(1) = Trim(txtPassWord.Text)
                                mrcuser.Fields(2) = Trim(comboUserLevel.Text)
                                mrcuser.Fields(3) = Trim(txtUserName.Text)
                                mrcuser.Fields(4) = Trim(frmLogin.txtUserName.Text)
                                mrcuser.Update '更新数据表
                                mrcuser.Close
                                MsgBox "添加用户成功！", vbOKOnly + vbInformation, "提示"
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub

Private Sub comboUserLevel_KeyPress(KeyAscii As Integer)
    KeyAscii = 0 '不可输入值
End Sub

Private Sub Form_Load()
    H = Me.Height
    W = Me.Width
    '为combox控件添加选项
    comboUserLevel.AddItem "管理员"
    comboUserLevel.AddItem "操作员"
    comboUserLevel.AddItem "一般用户"
End Sub

Private Sub Form_Resize()
    Me.Height = H
    Me.Width = W
    Me.PaintPicture Me.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight  '背景图随窗体改变而改变
End Sub

Private Sub txtOKPassWord_KeyPress(KeyAscii As Integer)
    '限制不能输入汉字
    If (KeyAscii <= -3652 And KeyAscii >= -20319) = True Then
        KeyAscii = 0 '不可输入值
    End If
End Sub

Private Sub txtOKPassWord_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '控件禁止粘贴，在按下此控件后自动删除粘贴板的内容
    If Button = 2 Then
        Clipboard.Clear
    End If
End Sub

Private Sub txtPassWord_KeyPress(KeyAscii As Integer)
    '限制不能输入汉字
    If (KeyAscii <= -3652 And KeyAscii >= -20319) = True Then
        KeyAscii = 0 '不可输入值
    End If
End Sub

Private Sub txtPassWord_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '控件禁止粘贴，在按下此控件后自动删除粘贴板的内容
    If Button = 2 Then
        Clipboard.Clear
    End If
End Sub

Private Sub txtUserID_KeyPress(KeyAscii As Integer)
    '限制只能输入数字
    If (KeyAscii > Asc("0") Or KeyAscii < Asc("9")) = False And KeyAscii <> 8 Then
        KeyAscii = 0 '不可输入值
    End If
End Sub

Private Sub txtUserID_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '控件禁止粘贴，在按下此控件后自动删除粘贴板的内容
    If Button = 2 Then
        Clipboard.Clear
    End If
End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
    '限制只能输入汉字和字母
    If ((KeyAscii <= -3652 And KeyAscii >= -20319) Or (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Or KeyAscii = 32 Or KeyAscii = 8) = False Then
        KeyAscii = 0 '不可输入值
    End If
End Sub

Private Sub txtUserName_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '控件禁止粘贴，在按下此控件后自动删除粘贴板的内容
    If Button = 2 Then
        Clipboard.Clear
    End If
End Sub

删除的操作：

Private Sub MSHFlexGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim column As Integer '定义行数
    '判断控件是否选中，若选中改变颜色，加√号，如本身选中则变为非选中
    If MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 3) = "√" Then
        MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 3) = ""
        For column = 0 To MSHFlexGrid.Cols - 1
            MSHFlexGrid.Col = column
            MSHFlexGrid.CellBackColor = vbWhite
        Next column
    Else
        If MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 3) <> "是否选中" Then
            MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 3) = "√"
            For column = 0 To MSHFlexGrid.Cols - 1
                MSHFlexGrid.Col = column
                MSHFlexGrid.CellBackColor = &HFFFF00
            Next column
        End If
    End If
End Sub


Private Sub cmdDelete_Click()
    Dim line As Integer '定义行数
    Dim a As VbMsgBoxResult '定义消息框结果
    Dim i As Integer '定义一个整型变量，用户判断删除记录数
    '对user_info表操作
    Dim mrcuser As ADODB.Recordset '用于存放记录集 '用户存放记录集
    Dim userSQL As String '用于存放SQL语句 '用于存放SQL语句
    Dim userMsgText As String '用于存放返回信息 '用户存放返回信息
    i = 0 '初始值i等于0
    a = MsgBox("确定所选删除用户吗？", vbOKCancel + vbQuestion, "询问")
    '当a为OK时进行删除记录，否则退出记录
    If a = vbOK Then
        '以MSHFlexGrid控件的行数为基础做循环，进行删除记录
        For line = MSHFlexGrid.Rows To 1 Step -1
            '判断是否选中
            If MSHFlexGrid.TextMatrix(line - 1, 3) = "√" Then
            
                userSQL = "select * from user_info where userID='" & Trim(MSHFlexGrid.TextMatrix(line - 1, 0)) & "'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '当MSHFlexGrid里的第一列内容和本机登录的内容一样时不允许删除
                If Trim(MSHFlexGrid.TextMatrix(line - 1, 0)) = Trim(frmLogin.txtUserName.Text) Then
                    MsgBox "用户：" & Trim(MSHFlexGrid.TextMatrix(line - 1, 0)) & " 正在登录，无法删除！", vbOKOnly + vbExclamation, "警告"
                Else
                    '删除MSHFlexGrid和数据表中的数据
                    i = i + 1
                    MSHFlexGrid.RemoveItem line - 1
                    mrcuser.Delete
                    mrcuser.Close
                End If
            End If
        Next line
    If i <> 0 Then
            MsgBox "删除用户成功！", vbOKOnly + vbInformation, "提示"
    Else
        MsgBox "请选择所删除的用户！", vbOKOnly + vbInformation, "提示"
        Exit Sub '退出过程
    End If
                
End Sub

更新的操作：

Private Sub cmdOFF_Click()
    Unload Me
End Sub

Private Sub cmdUpdate_Click()
    '对user_info表操作
    Dim mrcuser As ADODB.Recordset '用于存放记录集 '用于存放记录集
    Dim userSQL As String '用于存放SQL语句 '用于存放SQL语句
    Dim userMsgText As String '用于存放返回信息 '用户存放返回信息
    
    '对MSHFlexGrid控件进行操作
    With MSHFlexGrid
        .Rows = 1
        '用一个判断语句按不同用户级别进行查找
        Select Case comboUserLevel
            Case "管理员"
                userSQL = "select * from user_info where level='管理员'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '判断记录是否为空
                If mrcuser.EOF = True Then
                    MsgBox "无管理员数据！", vbOKOnly + vbInformation, "提示"
                    Exit Sub
                Else
                    '在记录到达最后一行前做循环，将记录显示在MSHFlexGrid中
                    Do While mrcuser.EOF = False
                        .Rows = .Rows + 1
                        .CellAlignment = 4
                        .TextMatrix(.Rows - 1, 0) = Trim(mrcuser.Fields(0))
                        .TextMatrix(.Rows - 1, 1) = Trim(mrcuser.Fields(3))
                        .TextMatrix(.Rows - 1, 2) = Trim(mrcuser.Fields(4))
                        mrcuser.MoveNext
                    Loop
                    mrcuser.Close
                End If
            Case "操作员"
                userSQL = "select * from user_info where level='操作员'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '判断记录是否为空
                If mrcuser.EOF = True Then
                    MsgBox "无操作员数据！", vbOKOnly + vbInformation, "提示"
                    Exit Sub
                Else
                    '在记录到达最后一行前做循环，将记录显示在MSHFlexGrid中
                    Do While mrcuser.EOF = False
                        .Rows = .Rows + 1
                        .CellAlignment = 4
                        .TextMatrix(.Rows - 1, 0) = Trim(mrcuser.Fields(0))
                        .TextMatrix(.Rows - 1, 1) = Trim(mrcuser.Fields(3))
                        .TextMatrix(.Rows - 1, 2) = Trim(mrcuser.Fields(4))
                        mrcuser.MoveNext
                    Loop
                    mrcuser.Close
                End If
            Case "一般用户"
                userSQL = "select * from user_info where level='一般用户'"
                Set mrcuser = ExecuteSQL(userSQL, userMsgText)
                
                '判断记录是否为空
                If mrcuser.EOF = True Then
                    MsgBox "无一般用户数据！", vbOKOnly + vbInformation, "提示"
                    Exit Sub
                Else
                    '在记录到达最后一行前做循环，将记录显示在MSHFlexGrid中
                    Do While mrcuser.EOF = False
                        .Rows = .Rows + 1
                        .CellAlignment = 4
                        .TextMatrix(.Rows - 1, 0) = Trim(mrcuser.Fields(0))
                        .TextMatrix(.Rows - 1, 1) = Trim(mrcuser.Fields(3))
                        .TextMatrix(.Rows - 1, 2) = Trim(mrcuser.Fields(4))
                        mrcuser.MoveNext
                    Loop
                    mrcuser.Close
                End If
        End Select
    End With
End Sub

优化方面：

1.背景图随窗体改变而改变

Dim H As Single '定义窗体高的变量
Dim W As Single '定义窗体高的变量

Private Sub Form_Load()
    H = Me.Height
    W = Me.Width
    '为用户级别添加选项
    comboUserLevel.AddItem "管理员"
    comboUserLevel.AddItem "操作员"
    comboUserLevel.AddItem "一般用户"
    comboUserLevel.AddItem " "
    '显示MSHFlexGrid固定行
    With MSHFlexGrid
        .Rows = 1
        '居中显示
        .CellAlignment = 4
        .ColAlignment = 4
        .TextMatrix(0, 0) = "用户名"
        .TextMatrix(0, 1) = "姓名"
        .TextMatrix(0, 2) = "开户人"
        .TextMatrix(0, 3) = "是否选中"
    End With
End Sub

Private Sub Form_Resize()
    Me.Height = H
    Me.Width = W
    Me.PaintPicture Me.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight '背景图随窗体变化而变化
End Sub

2.不可输入

Private Sub comboUserLevel_KeyPress(KeyAscii As Integer)
    KeyAscii = 0 '不可输入值
End Sub