g用户管理.frm

人事管理系统:包括员工公资的管理,考勤的管理,还有各种考核等功能

Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Dim flag As String '判断是新增加的记录还是修改记录
Private Sub FixData()
    Dim UserID As String
    Dim rights As String
    '显示具体信息
    If ListUser.ListCount > 0 Then
        UserID = Left(Trim(ListUser.Text), 6)
    Else
        Exit Sub
    End If
    '查找数据
    rs.MoveFirst
    rs.Find ("用户ID='" & UserID & "'")
    '显示数据
    txtUserId.Text = Trim(rs.Fields("用户ID"))
    txtName.Text = Trim(rs.Fields("用户名称"))
    txtPassword.Text = Trim(rs.Fields("密码"))
    CboSelect.Text = Trim(rs.Fields("用户类别"))
    txtPhone.Text = Trim(rs.Fields("电话"))
    txtEmail.Text = Trim(rs.Fields("邮箱"))
    rights = Trim(rs.Fields("权限"))
    For Index = 0 To 5
        ListRights.Selected(Index) = False
    Next Index
    If InStr(rights, "机构设置") Then ListRights.Selected(0) = True
    If InStr(rights, "学籍管理") Then ListRights.Selected(1) = True
    If InStr(rights, "课程管理") Then ListRights.Selected(2) = True
    If InStr(rights, "成绩管理") Then ListRights.Selected(3) = True
    If InStr(rights, "奖惩管理") Then ListRights.Selected(4) = True
    If InStr(rights, "系统管理") Then ListRights.Selected(5) = True
    '控件可用性
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Function CheckData() As Boolean
    '检查数据的合法性
    Dim rst As ADODB.Recordset
    '检查非空性
    If (Trim(txtUserId.Text) = "") Then
        MsgBox ("用户ID不能为空！")
        CheckData = False
        Exit Function
    ElseIf Len(Trim(txtUserId.Text)) <> 6 Then
        MsgBox ("用户ID不是6位！")
        CheckData = False
        Exit Function
    End If
    '检查唯一性
    SQL = " select 用户ID from 用户信息表 where 用户ID='" & Trim(txtUserId.Text) & "'"
    Set rst = SelectSQL(SQL, msg)
    If flag = "Add" And rst.RecordCount > 0 Then
        MsgBox ("用户ID，重复添加!")
        rst.Close
        CheckData = False
        Exit Function
    End If
    CheckData = True '合法
End Function
Private Sub ControlActiveX(kind As String, flag As Boolean)
    '控制控件
    If kind = "Add" Or kind = "Delete" Or kind = "Save" Then
        txtUserId.Text = ""
        txtName.Text = ""
        txtPassword.Text = ""
        CboSelect.ListIndex = 0
        txtPhone.Text = ""
        txtEmail.Text = ""
        For Index = 0 To 5
            ListRights.Selected(Index) = False
        Next Index
    End If
    If kind = "Modify" Then
        txtUserId.Enabled = False
    Else
        txtUserId.Enabled = flag
    End If
    txtName.Enabled = flag
    txtPassword.Enabled = flag
    CboSelect.Enabled = flag
    txtPhone.Enabled = flag
    txtEmail.Enabled = flag
    ListRights.Enabled = flag
    ListUser.Enabled = Not flag
End Sub
Private Sub LoadData()
    Dim strItem As String
    '得到用户信息
    SQL = " select * from 用户信息表 order by 用户ID"
    Set rs = Nothing
    Set rs = SelectSQL(SQL, msg)
    ListUser.Clear
    If rs.RecordCount > 0 Then
        Do While (Not rs.EOF) And (Not rs.BOF)
            strItem = Trim(rs.Fields(0)) & ":" & Trim(rs.Fields(1))
            ListUser.AddItem (strItem)
            rs.MoveNext
        Loop
        rs.MoveFirst
        ListUser.ListIndex = 0
    Else
        MsgBox ("目前没有用户信息！")
        '控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = False: CmdSave.Enabled = False
        Exit Sub
    End If
    Call FixData '在文本框中显示详细信息
    '控件可用性
    CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
    CmdCancel.Enabled = False: CmdSave.Enabled = False
End Sub
Private Sub CboStu_Click()
    Call LoadData  '重新装载数据
End Sub
Private Sub CmdAdd_Click()
    '可用性，清空数据
    Call ControlActiveX("Add", True)
    '设置标志flag
    flag = "Add"
    '添加、修改、删除按钮不可用，取消、保存按钮可用
    CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    CmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()
    '修改操作
    If rs.RecordCount > 0 Then
        '可用性
        Call ControlActiveX("Modify", True)
        '设置标志flag
        flag = "Modify"
        '添加、修改、删除按钮不可用，取消、保存按钮可用
        CmdCancel.Enabled = True: CmdSave.Enabled = True
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    Else
        MsgBox ("没有可以修改的数据!")
    End If
End Sub
Private Sub CmdDelete_Click()
'删除操作
    On Error GoTo ErrMsg
    If txtUserId.Text = "" Then
        MsgBox ("选择需要删除的用户信息！")
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
         msg = MsgBox("删除该条记录吗?", vbYesNo)
         If msg = vbYes Then
            rs.Delete
            Call LoadData '重新装载数据
            '清空文本框,重新设置下拉框
            Call ControlActiveX("Delete", False)
            '按钮可用性处理
            CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = True
            CmdSave.Enabled = False: CmdCancel.Enabled = False
            MsgBox ("成功删除的数据!")
         End If
     Else
         MsgBox ("没有可删除的数据!")
    End If
    Exit Sub
ErrMsg:
         MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub cmdCancel_Click()
    '取消操作
    Call FixData '设置数据
    ListUser.Enabled = True
    '修改、删除、添加按钮可用,保存和取消按钮不可用
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub setData()
    Dim rights As String
    rs.Fields("用户ID") = Trim(txtUserId.Text)
    rs.Fields("用户名称") = Trim(txtName.Text)
    rs.Fields("密码") = Trim(txtPassword.Text)
    rs.Fields("用户类别") = Trim(CboSelect.Text)
    rs.Fields("电话") = Trim(txtPhone.Text)
    rs.Fields("邮箱") = Trim(txtEmail.Text)
    For Index = 0 To 5
        If ListRights.Selected(Index) Then
        rights = rights & ListRights.List(Index) & " : "
        End If
    Next Index
    rs.Fields("权限") = Trim(rights)
End Sub
Private Sub CmdSave_Click()
    On Error GoTo ErrMsg
    If Not CheckData Then Exit Sub '如果数据不合法退出
    If flag = "Modify" Then '如果是修改数据
        msg = MsgBox("您确实要修改这条数据吗?", vbYesNo)
        If msg = vbYes Then
            Call setData '赋值
        Else
            Exit Sub
        End If
    ElseIf flag = "Add" Then '如果是添加新数据
        rs.AddNew
        Call setData
    End If
    '更新数据
    rs.Update
    Call LoadData '重新装载数据
    '控件清空和可用性
    Call ControlActiveX("Save", False)
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
    If flag = "Add" Then
        MsgBox ("成功添加数据!")
    Else
        MsgBox ("成功更新数据!")
    End If
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbExclamation, "出错"
End Sub

Private Sub CmdExit_Click()
'退出操作
    学生档案管理.Enabled = True
    rs.Close
    Unload Me
End Sub
Private Sub Form_Load()
    Dim strItem As String
    '初始化下拉框
    CboSelect.AddItem "教师"
    CboSelect.AddItem "学生"
    CboSelect.AddItem "管理人员"
    CboSelect.ListIndex = 0
    ListRights.AddItem "机构设置"
    ListRights.AddItem "学籍管理"
    ListRights.AddItem "课程管理"
    ListRights.AddItem "成绩管理"
    ListRights.AddItem "奖惩管理"
    ListRights.AddItem "系统管理"
    ListRights.ListIndex = 0
    Call LoadData '装载用户数据
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
    学生档案管理.Enabled = True
    Unload Me
End Sub
Private Sub ListUser_Click()
    Call FixData
End Sub