frmuser.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

      _ExtentX        =   11007
      _ExtentY        =   4392
      View            =   3
      Arrange         =   2
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      AllowReorder    =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "用户ID"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "用户姓名"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         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 = "frmUser"
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
  Else
    MsgBox "原密码错误，修改密码失败！"
  End If

  '更新
  ChgUser.Update
  '关闭数据集
  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