frmuser.frm

VB制作的简单的基于access的停车管理数据库

         Alignment       =   2  'Center
         Caption         =   "新密码确认："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   6
         Top             =   2520
         Width           =   1560
      End
      Begin VB.Label Label2 
         Alignment       =   2  'Center
         Caption         =   "新密码："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   480
         TabIndex        =   5
         Top             =   1560
         Width           =   1560
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         Caption         =   "原密码："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   480
         TabIndex        =   4
         Top             =   600
         Width           =   1575
      End
   End
   Begin VB.CommandButton cmdquery 
      Caption         =   "用户浏览"
      Height          =   495
      Left            =   6480
      TabIndex        =   2
      ToolTipText     =   "查看系统中当前所有用户的主要资料"
      Top             =   480
      Width           =   1695
   End
   Begin VB.CommandButton cmdaddnew 
      Caption         =   "添加用户"
      Height          =   495
      Left            =   3600
      TabIndex        =   1
      ToolTipText     =   "添加您所想添加的新用户"
      Top             =   480
      Width           =   1695
   End
   Begin VB.CommandButton cmdmodify 
      Caption         =   "修改密码"
      Height          =   495
      Left            =   600
      TabIndex        =   0
      ToolTipText     =   "更改您的当前密码"
      Top             =   480
      Width           =   1695
   End
   Begin VB.PictureBox Picture1 
      Height          =   6975
      Left            =   -240
      Picture         =   "frmuser.frx":0033
      ScaleHeight     =   6915
      ScaleWidth      =   9075
      TabIndex        =   25
      Top             =   -120
      Width           =   9135
   End
End
Attribute VB_Name = "frmuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

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
Dim usrtype As Integer
If Me.textaddid.Text = "" Then
   MsgBox "请输入需要创建的用户ID！", , "提示！"
   Exit Sub
ElseIf Len(Trim(Me.textaddid.Text)) > 16 Then
   MsgBox "输入的用ID过长，请从新输入！", , "提示！"
   Exit Sub
End If
usrid = Replace(Trim(Me.textaddid.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.comboaddtype.Text = "系统管理员" Then
   usrtype = 0
ElseIf Me.comboaddtype.Text = "高级用户" Then
   usrtype = 2
ElseIf Me.comboaddtype.Text = "普通管理员" Then
   usrtype = 1
End If
If Me.textaddpwd1.Text = "" Then
   MsgBox "请输入需要创建的用户的密码！", , "提示！"
   Exit Sub
ElseIf Len(Trim(Me.textaddpwd1)) > 16 Then
   MsgBox "新用户的密码过长，请从新输入！", , "提示！"
   Exit Sub
End If
If Me.textaddpwd2.Text = "" Then
   MsgBox "请输入确认密码确认！", , "提示！"
   Exit Sub
ElseIf Len(Trim(Me.textaddpwd2.Text)) > 16 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" & " values('" & usrid & "'" & " ,'" & usrname & "'" & ",'" & usrpwd & "'," & usrtype & ",'');"
dbcnn.Execute sqlstr
MsgBox "添加成功！"
Me.textaddid.Text = ""
Me.textaddname.Text = ""
Me.textaddpwd1.Text = ""
Me.textaddpwd2.Text = ""
addrec (4)
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)) > 16 Then
   MsgBox "密码过长，请从新输入密码！", , "提示！"
   Exit Sub
End If
If Me.textmodifynew1.Text = "" Then
   MsgBox "请输入新密码！", , "提示！"
   Exit Sub
ElseIf Len(Trim(Me.textmodifynew1.Text)) > 16 Then
   MsgBox "新密码过长！", , "提示！"
   Exit Sub
End If
If Me.textmodifynew2.Text = "" Then
   MsgBox "请输入新密码确认！", , "提示！"
   Exit Sub
ElseIf Len(Trim(Me.textmodifynew2.Text)) > 16 Then
   MsgBox "确认密码过长，请新输入！", , "提示！"
   Exit Sub
End If
If Me.textmodifynew1.Text <> Me.textmodifynew2 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 Command1_Click()
Unload Me
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