frmsysusermanage.frm

图书管理系统

VERSION 5.00
Begin VB.Form SysUserManage 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统用户管理"
   ClientHeight    =   2355
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2355
   ScaleWidth      =   4680
   Begin VB.TextBox txtNews 
      Height          =   270
      Left            =   1200
      Locked          =   -1  'True
      TabIndex        =   15
      TabStop         =   0   'False
      Top             =   1680
      Width           =   1545
   End
   Begin VB.CommandButton cmdMove 
      Height          =   270
      Index           =   3
      Left            =   3120
      Picture         =   "frmSysUserManage.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   1680
      Width           =   300
   End
   Begin VB.CommandButton cmdMove 
      Height          =   270
      Index           =   2
      Left            =   2760
      Picture         =   "frmSysUserManage.frx":004C
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   1680
      Width           =   345
   End
   Begin VB.CommandButton cmdMove 
      Height          =   270
      Index           =   1
      Left            =   960
      Picture         =   "frmSysUserManage.frx":0090
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   1680
      Width           =   300
   End
   Begin VB.CommandButton cmdMove 
      Height          =   270
      Index           =   0
      Left            =   600
      Picture         =   "frmSysUserManage.frx":00D4
      Style           =   1  'Graphical
      TabIndex        =   11
      Top             =   1680
      Width           =   345
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "关闭"
      Height          =   255
      Left            =   3600
      TabIndex        =   10
      Top             =   1800
      Width           =   735
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存"
      Height          =   255
      Left            =   3600
      TabIndex        =   9
      Top             =   1440
      Width           =   735
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "刷新"
      Height          =   255
      Left            =   3600
      TabIndex        =   8
      Top             =   1080
      Width           =   735
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Height          =   255
      Left            =   3600
      TabIndex        =   7
      Top             =   720
      Width           =   735
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加"
      Height          =   255
      Left            =   3600
      TabIndex        =   6
      Top             =   360
      Width           =   735
   End
   Begin VB.TextBox txtAuth 
      DataField       =   "权限"
      DataMember      =   "SysUsers"
      DataSource      =   "Library_Manage"
      Height          =   270
      Left            =   1080
      TabIndex        =   5
      Top             =   1200
      Width           =   2295
   End
   Begin VB.TextBox txtPWD 
      DataField       =   "口令"
      DataMember      =   "SysUsers"
      DataSource      =   "Library_Manage"
      Height          =   270
      Left            =   1080
      TabIndex        =   4
      Top             =   840
      Width           =   2295
   End
   Begin VB.TextBox txtNum 
      DataField       =   "编号"
      DataMember      =   "SysUsers"
      DataSource      =   "Library_Manage"
      Height          =   270
      Left            =   1080
      TabIndex        =   3
      Top             =   480
      Width           =   2295
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "权限"
      Height          =   180
      Left            =   480
      TabIndex        =   2
      Top             =   1200
      Width           =   360
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "口令"
      Height          =   180
      Left            =   480
      TabIndex        =   1
      Top             =   840
      Width           =   360
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "编号"
      Height          =   180
      Left            =   480
      TabIndex        =   0
      Top             =   480
      Width           =   360
   End
End
Attribute VB_Name = "SysUserManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isAdding As Boolean     '定义窗体状态标志

Private Sub cmdExit_Click()
    Unload Me               '关闭系统用户管理窗体
End Sub

Private Sub cmdRefresh_Click()
    With Library_Manage.rsSysUsers
        If .RecordCount > 0 Then
            .CancelUpdate       '取消前一步执行的操作
            .Requery            '重新读取记录集数据
            '重新执行数据绑定
            Set txtNum.DataSource = Library_Manage
            txtNum.DataMember = "SysUsers"
            txtNum.DataField = "编号"
            Set txtPWD.DataSource = Library_Manage
            txtPWD.DataMember = "SysUsers"
            txtPWD.DataField = "口令"
            Set txtAuth.DataSource = Library_Manage
            txtAuth.DataMember = "SysUsers"
            txtAuth.DataField = "权限"
        End If
    End With
    cmdAdd.Enabled = True
    cmdDelete.Enabled = True
    isAdding = False
    cmdMove(0).Enabled = True
    cmdMove(1).Enabled = True
    cmdMove(2).Enabled = True
    cmdMove(3).Enabled = True
    txtNews.Enabled = True
    cmdMove(0).Value = True
End Sub

Private Sub Form_Load()
    cmdMove(0).Value = True     '触发按钮单击事件
End Sub

'验证编号输入
Private Sub txtnum_KeyPress(KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0-9]" Or Chr(KeyAscii) Like "[a-z]" _
           Or Chr(KeyAscii) Like "[A-Z]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '输入不是数字、英文字母或退格键，取消输入
    End If
    cmdMove(0).Enabled = False
    cmdMove(1).Enabled = False
    cmdMove(2).Enabled = False
    cmdMove(3).Enabled = False
    txtNews.Enabled = False
End Sub
'验证口令输入
Private Sub txtPWD_KeyPress(KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0-9]" Or Chr(KeyAscii) Like "[a-z]" _
           Or Chr(KeyAscii) Like "[A-Z]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '输入不是数字、英文字母或退格键，取消输入
    End If
    cmdMove(0).Enabled = False
    cmdMove(1).Enabled = False
    cmdMove(2).Enabled = False
    cmdMove(3).Enabled = False
    txtNews.Enabled = False
End Sub
'验证权限代码输入
Private Sub txtauth_KeyPress(KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0,1]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '输入不是0、1或退格键，取消输入
    End If
     cmdMove(0).Enabled = False
    cmdMove(1).Enabled = False
    cmdMove(2).Enabled = False
    cmdMove(3).Enabled = False
    txtNews.Enabled = False
End Sub

Private Sub cmdAdd_Click()
    With Library_Manage.rsSysUsers
        .AddNew                     '添加新记录
        txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
    End With
    txtAuth = 1                     '设置默认权限代码
    isAdding = True
    cmdAdd.Enabled = False          '在保存新记录之前禁用控件
    cmdDelete.Enabled = False
    cmdMove(0).Enabled = False
    cmdMove(1).Enabled = False
    cmdMove(2).Enabled = False
    cmdMove(3).Enabled = False
      txtNews.Enabled = False
End Sub

Private Sub cmdDelete_Click()
    With Library_Manage.rsSysUsers
        If Not .EOF Then
            If MsgBox("将删除<" & Trim(txtNum) & ">的用户数据，是否继续？", _
                       vbCritical + vbYesNo, "系统用户管理") = vbYes Then
                .Delete
                .MoveNext
                If .EOF And .RecordCount > 0 Then .MoveLast
            End If
        End If
    End With
End Sub

Private Sub cmdSave_Click()
    Dim objCopy As New Recordset
    If Trim(txtNum) = "" Then
        MsgBox "编号不能为空！", vbCritical, "系统用户管理"
        txtNum.SetFocus
        txtNum.SelStart = 0
        txtNum.SelLength = Len(txtNum)
    ElseIf Len(Trim(txtPWD)) <> 6 Then
        MsgBox "用户口令必须为6位字符串！", vbCritical, "系统用户管理"
        txtPWD.SetFocus
        txtPWD.SelStart = 0
        txtPWD.SelLength = Len(txtPWD)
    ElseIf Not txtAuth Like "[0,1]" Then
        MsgBox "用户权限代码必须为0或1！", vbCritical, "系统用户管理"
        txtAuth = ""
        txtAuth.SetFocus
    Else
        Set objCopy = Library_Manage.rsSysUsers.Clone
        With objCopy
            If .RecordCount > 0 Then
                .MoveFirst
                .Find "编号='" & Trim(txtNum) & "'"
                '检查编号是否被使用
                If Not .EOF And .AbsolutePosition <> _
                        Library_Manage.rsSysUsers.AbsolutePosition Then
                    MsgBox "编号：" & Trim(txtNum) _
                    & "已被使用，请使用其他编号！", _
                    vbCritical, "系统用户管理"
                    txtNum.SetFocus
                    txtNum.SelStart = 0
                    txtNum.SelLength = Len(txtNum)
                    Exit Sub
                Else
                    '保存记录
                    Library_Manage.rsSysUsers.Update
                    MsgBox "数据保存成功！", vbInformation, "系统用户管理"
                    cmdAdd.Enabled = True
                    cmdDelete.Enabled = True
                    isAdding = False
                    cmdMove(0).Enabled = True
    cmdMove(1).Enabled = True
    cmdMove(2).Enabled = True
    cmdMove(3).Enabled = True
      txtNews.Enabled = True
                End If
            End If
        End With
    End If
End Sub

Private Sub cmdMove_Click(Index As Integer)
    With Library_Manage.rsSysUsers
        Select Case Index       '切换当前记录
            Case 0              '使第一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then .MoveFirst
            Case 1              '使上一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then
                    .MovePrevious
                    If .BOF Then .MoveFirst
                End If
            Case 2              '使下一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then
                    .MoveNext
                    If .EOF Then .MoveLast
                End If
            Case 3              '使最后一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then .MoveLast
        End Select
        If .BOF And .EOF Then   '显示当前记录编号和记录总数
            txtNews = "记录：无"
        Else
            txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
        End If
    End With
End Sub