e用户管理.frm

入库新书管理模块：用于登记新购图书和受赠图书两部分信息

         Begin VB.Label Label5 
            Caption         =   "用户类别："
            Height          =   255
            Index           =   1
            Left            =   120
            TabIndex        =   20
            Top             =   960
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "(10位)"
            ForeColor       =   &H000000FF&
            Height          =   375
            Index           =   0
            Left            =   3000
            TabIndex        =   19
            Top             =   480
            Width           =   495
         End
         Begin VB.Label Label3 
            Caption         =   "名称："
            Height          =   375
            Left            =   3480
            TabIndex        =   18
            Top             =   480
            Width           =   735
         End
         Begin VB.Label Label4 
            Caption         =   "电话："
            Height          =   375
            Left            =   240
            TabIndex        =   17
            Top             =   1440
            Width           =   615
         End
         Begin VB.Label Label7 
            Caption         =   "邮箱："
            Height          =   375
            Left            =   3480
            TabIndex        =   16
            Top             =   1320
            Width           =   855
         End
         Begin VB.Label Label2 
            Caption         =   "(小于10位)"
            ForeColor       =   &H000000FF&
            Height          =   375
            Index           =   1
            Left            =   6240
            TabIndex        =   15
            Top             =   840
            Width           =   855
         End
      End
   End
End
Attribute VB_Name = "E用户管理"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
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 Form_Load()
    '初始化用户类型下拉框
    CboSelect.AddItem "读者"
    CboSelect.AddItem "工作人员"
    CboSelect.AddItem "管理人员"
    CboSelect.ListIndex = 0     '默认为读者

    cbokind.AddItem "读者"
    cbokind.AddItem "工作人员"
    cbokind.AddItem "管理人员"
    cbokind.ListIndex = 0     '默认为读者
    Call LoadData '装载用户数据
End Sub
Private Sub LoadData()
    Dim strItem As String
    Dim strWhere As String
    '得到用户信息
    strWhere = " where 用户类别='" & Trim(cbokind.Text)
    strWhere = strWhere & "' and  用户ID like '" & txtUserIdQuery.Text & "%'"
    SQL = " select * from 用户信息表 " & strWhere & " 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
        '控件可用性
        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 FixData()
    Dim UserID As String
    Dim rights As String
    '显示具体信息
    If ListUser.ListCount > 0 Then
        UserID = Left(Trim(ListUser.Text), 10)
    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("邮箱"))
    txtAddress.Text = Trim(rs.Fields("住址"))
    txtCardId.Text = Trim(rs.Fields("身份证号"))
    rights = Trim(rs.Fields("权限"))
    '设置权限的CheckBox
    For Index = 0 To 4
        ChkRights(Index).Value = 0   '所有的权限CheckBox为“未选中”状态
    Next Index
    If InStr(rights, "资料管理") Then ChkRights(0).Value = 1
    If InStr(rights, "借书管理") Then ChkRights(1).Value = 1
    If InStr(rights, "还书管理") Then ChkRights(2).Value = 1
    If InStr(rights, "检索统计") Then ChkRights(3).Value = 1
    If InStr(rights, "系统管理") Then ChkRights(4).Value = 1
    '控件可用性
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub

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 = ""
        txtCardId.Text = ""
        txtAddress.Text = ""
        For Index = 0 To 4
            ChkRights(Index).Value = 0
        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
    ListUser.Enabled = Not flag
    txtCardId.Enabled = flag
    txtAddress.Enabled = flag
    For Index = 0 To 4
        ChkRights(Index).Enabled = flag
    Next Index
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 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 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)) <> 10 Then
        MsgBox ("用户ID不是10位！")
        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 setData()
    Dim rights As String
    rights = ""
    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)
    rs.Fields("住址") = Trim(txtAddress.Text)
    rs.Fields("身份证号") = Trim(txtCardId.Text)
    For Index = 0 To 4
        If ChkRights(Index).Value = 1 Then
        rights = rights & Trim(ChkRights(Index).Caption) & " : "
        End If
    Next Index
    rs.Fields("权限") = Trim(rights)
End Sub

Private Sub ListUser_Click()
    Call FixData
End Sub
Private Sub CmdQuery_Click()
    Call LoadData  '重新装载数据
End Sub
Private Sub CmdExit_Click()
'退出操作
    图书管理系统.Enabled = True
    rs.Close
    Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
    图书管理系统.Enabled = True
    Unload Me
End Sub