frmuser.frm

本系统主要完成访客资料的记录和查询

         SubItemIndex    =   2
         Text            =   "用户类型"
         Object.Width           =   2294
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "备注"
         Object.Width           =   2294
      EndProperty
   End
End
Attribute VB_Name = "Frm_User"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'添加新用户
Private Sub CmdAddnew_Click()
    '判断用户权限
    If UserNow.Type <> 0 Then
        MsgBox "对不起，您不是系统管理员，不能创建新用户！"
        Exit Sub
    End If
    AddnewView
End Sub

Private Sub CmdAddOk_Click()    '添加新用户确定
Dim AddUser As New ADODB.Recordset
Dim SqlStr As String
Dim DBstr As String
Dim UsrID As String
Dim UsrName As String
Dim UsrPwd As String

    '检验输入内容
    If Me.TxtAddID.Text = "" Then
        MsgBox "请输入需要创建的用户ID！"
        Exit Sub
    ElseIf Len(Trim(Me.TxtAddID.Text)) > 16 Then
        MsgBox "用户ID长度超出范围！"
        Exit Sub
    End If
    UsrID = Replace(Trim(Me.TxtAddID.Text), "'", "''")
    
    If Me.TextAddName.Text = "" Then
        MsgBox "请输入需要创建的用户名！"
        Exit Sub
    ElseIf Len(Trim(Me.TextAddName.Text)) > 4 Then
        MsgBox "用户姓名长度超出范围！"
        Exit Sub
    End If
    UsrName = Replace(Trim(Me.TextAddName.Text), "'", "''")
    
    If Me.ComboAddType.Text = "" Then
        MsgBox "请选择需要创建的用户类型！"
        Exit Sub
    End If
    If Me.TextAddPwd1.Text = "" Then
        MsgBox "请输入需要创建的用户密码！"
        Exit Sub
    ElseIf Len(Trim(Me.TextAddPwd1.Text)) > 8 Then
        MsgBox "密码长度超出范围！"
        Exit Sub
    End If
    If Me.TextAddPwd2.Text = "" Then
        MsgBox "请输入需要创建的用户密码确认！"
        Exit Sub
    ElseIf Len(Trim(Me.TextAddPwd2.Text)) > 8 Then
        MsgBox "密码长度超出范围！"
        Exit Sub
    End If
    If Me.TextAddPwd1.Text <> Me.TextAddPwd2.Text Then
        MsgBox "两次输入密码不一致！"
        Exit Sub
    End If
    UsrPwd = Replace(Trim(Me.TextAddPwd1.Text), "'", "''")
    
    DBstr = "select * from UserInfo where UserID= '" & UsrID & "'"
    '打开数据集
    AddUser.Open DBstr, DBCnn, adOpenForwardOnly, adLockOptimistic
        If Not AddUser.BOF Then
            MsgBox "该用户已存在！"
            AddUser.Close
            Exit Sub
        End If
    '关闭数据集
    AddUser.Close
    
    '操作数据库添加记录
    SqlStr = "INSERT INTO UserInfo" & _
    "(UserID,UserName,UserType,UserPwd) " & _
    "VALUES ('" & UsrID & "'" & _
             ",'" & UsrName & "'" & _
             "," & Val(Me.ComboAddType.Text) & _
             ",'" & UsrPwd & "');"
    DBCnn.Execute SqlStr
    '提示用户
    MsgBox "添加成功！"
    '清空界面
    Me.TxtAddID.Text = ""
    Me.TextAddName.Text = ""
    Me.TextAddPwd1.Text = ""
    Me.TextAddPwd2.Text = ""
    
    '记录该操作
    AddRec (4)
    
End Sub

'取消
Private Sub CmdCancel_Click()
    Unload Me
End Sub

'修改密码
Private Sub CmdModify_Click()
    ModifyView
End Sub

'修改密码
Private Sub CmdModifyOk_Click()
Dim ChgUser As New ADODB.Recordset
Dim DBstr As String

    '检验输入内容
    If Me.TextModifyOld.Text = "" Then
        MsgBox "请输入原密码！"
        Exit Sub
    ElseIf Len(Trim(Me.TextModifyOld.Text)) > 8 Then
        MsgBox "原密码过长！"
        Exit Sub
    End If
    If Me.TextModifyNew1.Text = "" Then
        MsgBox "请输入新密码！"
        Exit Sub
    ElseIf Len(Trim(Me.TextModifyNew1.Text)) > 8 Then
        MsgBox "新密码过长！"
        Exit Sub
    End If
    If Me.TextModifyNew2.Text = "" Then
        MsgBox "请输入新密码确认！"
        Exit Sub
    ElseIf Len(Trim(Me.TextModifyNew2.Text)) > 8 Then
        MsgBox "新密码确认过长！"
        Exit Sub
    End If
    If Me.TextModifyNew1.Text <> Me.TextModifyNew2.Text Then
        MsgBox "两次输入新密码不一致！"
        Exit Sub
    End If
    
    '写数据库
    DBstr = "select * from UserInfo where UserID='"
    DBstr = DBstr & Replace(UserNow.ID, "'", "''") & "'"
    '打开数据集
    ChgUser.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    '数据集指针指向第一个记录，这里查找到的记录唯一
    ChgUser.MoveFirst
        '检验旧密码
        If Trim(Me.TextModifyOld.Text) = ChgUser.Fields("UserPwd").Value Then
            ChgUser.Fields("UserPwd").Value = Me.TextModifyNew1.Text
            MsgBox "修改成功！"
        Else
            MsgBox "原密码错误，修改密码失败！"
        End If
    '更新
    ChgUser.Update
    'MsgBox "修改成功！"
    '关闭数据集
    ChgUser.Close
    
    '弹出提示框提示用户
    'MsgBox "修改成功！"
    
    '记录该操作
    AddRec (3)

End Sub

Private Sub CmdQuery_Click()    '查询用户
Dim UserQuery As New ADODB.Recordset
Dim i As Integer
Dim str As String
Dim LtItm As ListItem
Dim DBstr As String

    '检验用户权限
    If UserNow.Type <> 0 Then
        MsgBox "对不起，您不是系统管理员，不能查询用户！"
        Exit Sub
    End If
    
    QueryView
    
    '清空列表
    Me.LvQuery.ListItems.Clear
    
    '读用户资料
    DBstr = "select * from UserInfo "
    UserQuery.Open DBstr, DBCnn, adOpenStatic, adLockReadOnly
    UserQuery.MoveFirst
    
    '逐个读取用户记录
    For i = 1 To UserQuery.RecordCount
        Select Case UserQuery.Fields("UserType").Value
        Case 0
        str = "系统管理员"
        Case 1
        str = "普通用户"
        Case 2
        str = "高级用户"
        Case Else
        str = "类型错误！"
        End Select

        Set LtItm = Me.LvQuery.ListItems.Add()
            LtItm.Text = UserQuery.Fields("UserID").Value
            LtItm.SubItems(1) = UserQuery.Fields("UserName").Value
            LtItm.SubItems(2) = str
            If UserQuery.Fields("Remark").Value <> "" Then
                LtItm.SubItems(3) = UserQuery.Fields("Remark").Value
            End If
            
        UserQuery.MoveNext
    Next i
    
    UserQuery.Close
    
    '记录该操作
    AddRec (5)
        
End Sub

Private Sub Form_Load()
    ModifyView
    FrameModify.Caption = "当前用户：" & UserNow.ID
End Sub

'显示修改密码框架
Private Sub ModifyView()
    Me.FrameModify.Visible = True
Me.FrameAddnew.Visible = False
    Me.LvQuery.Visible = False
End Sub

'显示添加用户框架
Private Sub AddnewView()
    Me.FrameModify.Visible = False
    Me.FrameAddnew.Visible = True
    Me.LvQuery.Visible = False
End Sub

'显示查询结果框架
Private Sub QueryView()
    Me.FrameModify.Visible = False
    Me.FrameAddnew.Visible = False
    Me.LvQuery.Visible = True
End Sub