frmuser.frm

这是一个用VB编写出来的烟草管理系统

VERSION 5.00
Begin VB.Form frmuser 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户管理"
   ClientHeight    =   2625
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3780
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5163.729
   ScaleMode       =   0  'User
   ScaleWidth      =   4046.538
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame3 
      Caption         =   "操作："
      Height          =   763
      Left            =   0
      TabIndex        =   1
      Top             =   1800
      Width           =   3705
      Begin VB.CommandButton exit 
         Caption         =   "退出"
         Height          =   400
         Left            =   2880
         TabIndex        =   4
         Top             =   240
         Width           =   650
      End
      Begin VB.CommandButton Mod 
         Caption         =   "修改密码"
         Height          =   400
         Left            =   1440
         TabIndex        =   3
         Top             =   240
         Width           =   1005
      End
      Begin VB.CommandButton Add 
         Caption         =   "添加用户"
         Height          =   400
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   1005
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "用户信息"
      Height          =   1695
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3735
      Begin VB.ListBox List1 
         BackColor       =   &H80000018&
         Height          =   1320
         Left            =   360
         TabIndex        =   5
         Top             =   240
         Width           =   3135
      End
   End
End
Attribute VB_Name = "frmuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim un As String
Dim db As Database
Dim rs As Recordset
Private Sub Add_Click()
    MsgBox ("用户名和密码都不能超过20个字符！"), vbOKOnly, ("提醒")
    newuser = InputBox("请输入要添加的用户名称", "用户名称")
    If newuser = "" Then
        MsgBox ("用户名不能为空！"), vbOKOnly, ("警告")
    Else
        Set rs = db.OpenRecordset("select user.user from user where user=" + Chr$(34) + newuser + Chr$(34) + ";")
        If rs.EOF Then
            newpassword1 = InputBox("请输入密码", "密码")
            newpassword2 = InputBox("请再输入一次密码", "验证密码")
            If newpassword1 <> newpassword2 Then
                MsgBox ("两次输入密码不相符！"), vbOKOnly, "添加失败"
            Else
                If newpassword1 = "" Then
                    MsgBox ("你必须设置密码！"), vbOKOnly, ("添加失败")
                    
                Else
                    Set rs = db.OpenRecordset("user")
                    With rs
                        .AddNew
                        !user = LCase(newuser)
                        !password = LCase(newpassword1)
                        .Update
                    End With
                    MsgBox ("用户添加成功！"), vbOKOnly, ("提醒")
                    List1.AddItem newuser
                End If
            End If
        Else
            MsgBox ("这个用户已经存在！"), vbOKOnly, ("警告")
        End If
    End If
End Sub

Private Sub exit_Click()
    db.Close
    Unload Me
End Sub

Private Sub Form_Load()
    Set db = OpenDatabase(App.Path + "..\db\System.mdb")
    Set rs = db.OpenRecordset("select user.user from user")
    rs.MoveFirst
    Do Until rs.EOF
        UserName = rs.Fields("User")
        List1.AddItem UserName
        rs.MoveNext
    Loop
End Sub

Private Sub List1_Click()
    un = List1.ListIndex
End Sub

Private Sub Mod_Click()
    jmm = InputBox("请输入原来的密码", "验证身份")
    Set rs = db.OpenRecordset("select user.user from user where password=" + Chr$(34) + jmm + Chr$(34) + ";")
    If rs.EOF Then
        MsgBox ("你无权修改此用户！"), vbOKOnly, ("警告")
    Else
        xmm1 = InputBox("请输入新密码", "新密码")
        xmm2 = InputBox("请再输入一次新密码", "新密码")
        If xmm1 <> xmm2 Then
            MsgBox ("两次新密码输入不相符！"), vbOKOnly, ("失败")
        Else
            If xmm1 = "" Then
                MsgBox ("你必须设置密码！"), vbOKOnly, ("修改失败")
            Else
                Set rs = db.OpenRecordset("select user.password from user where password=" + Chr$(34) + jmm + Chr$(34) + ";")
                With rs
                    .Edit
                    !password = LCase(xmm1)
                    .Update
                End With
                MsgBox ("新密码已经被接受，下次进入请使用新密码！"), vbOKOnly, ("修改成功")
            End If
        End If
    End If
End Sub