frmsysusermanage.frm

工资管理系统

VERSION 5.00
Begin VB.Form SysUserManage 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统用户管理"
   ClientHeight    =   1965
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4635
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   1965
   ScaleWidth      =   4635
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "刷新"
      Height          =   300
      Left            =   3360
      TabIndex        =   16
      Top             =   829
      Width           =   735
   End
   Begin VB.PictureBox picNavigation 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   350
      Left            =   720
      ScaleHeight     =   345
      ScaleWidth      =   2415
      TabIndex        =   14
      Top             =   1440
      Width           =   2410
      Begin VB.TextBox txtNews 
         Height          =   270
         Left            =   570
         Locked          =   -1  'True
         TabIndex        =   15
         TabStop         =   0   'False
         Top             =   0
         Width           =   1185
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   ">"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   2
         Left            =   1725
         Picture         =   "frmSysUserManage.frx":0000
         TabIndex        =   5
         Top             =   0
         Width           =   300
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   ">|"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   3
         Left            =   2010
         Picture         =   "frmSysUserManage.frx":0044
         TabIndex        =   6
         Top             =   0
         Width           =   330
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   "|<"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   0
         Left            =   -15
         Picture         =   "frmSysUserManage.frx":0090
         TabIndex        =   3
         Top             =   0
         Width           =   330
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   "<"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   1
         Left            =   300
         Picture         =   "frmSysUserManage.frx":00DD
         TabIndex        =   4
         Top             =   0
         Width           =   300
      End
   End
   Begin VB.TextBox txtPWD 
      Height          =   270
      Left            =   1095
      MaxLength       =   6
      TabIndex        =   1
      Top             =   600
      Width           =   2175
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加"
      Height          =   300
      Left            =   3360
      TabIndex        =   7
      Top             =   195
      Width           =   735
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Height          =   300
      Left            =   3360
      TabIndex        =   8
      Top             =   512
      Width           =   735
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "关闭"
      Height          =   300
      Left            =   3360
      TabIndex        =   10
      Top             =   1465
      Width           =   735
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存"
      Height          =   300
      Left            =   3360
      TabIndex        =   9
      Top             =   1146
      Width           =   735
   End
   Begin VB.ComboBox cmbStatus 
      Height          =   300
      ItemData        =   "frmSysUserManage.frx":0121
      Left            =   1095
      List            =   "frmSysUserManage.frx":012B
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   1005
      Width           =   2175
   End
   Begin VB.TextBox txtUser 
      Height          =   270
      Left            =   1080
      MaxLength       =   5
      TabIndex        =   0
      Top             =   195
      Width           =   2175
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "口  令"
      Height          =   180
      Left            =   465
      TabIndex        =   13
      Top             =   645
      Width           =   540
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "身  份"
      Height          =   180
      Left            =   465
      TabIndex        =   12
      Top             =   1065
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户名"
      Height          =   180
      Left            =   465
      TabIndex        =   11
      Top             =   240
      Width           =   540
   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     '用于标识是否处于添加记录状态
Dim objCn As Connection, objRs As Recordset
Private Sub cmdExit_Click()
    Unload Me               '关闭系统用户管理窗体
End Sub

Private Sub cmdRefresh_Click()
    objRs.Requery       '刷新记录集数据
    ShowCurrentRecord
    cmdAdd.Enabled = True
    cmdDelete.Enabled = True
    isAdding = False
    picNavigation.Enabled = True
End Sub

Private Sub Form_Load()
    On Error GoTo DealError
    '建立数据库连接
    Set objCn = New Connection
    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & App.Path & "\数据库\工资管理.mdb"
     objCn.ConnectionString = strcn
     objCn.Open
        
    '创建RecordSet对象，获取系统用户数据
    Set objRs = New Recordset
    Set objRs.ActiveConnection = objCn
    objRs.CursorLocation = adUseClient
    objRs.CursorType = adOpenDynamic
    objRs.LockType = adLockOptimistic
    strsql = "SELECT * FROM 系统用户"
    objRs.Open strsql
    '显示第一条记录
    ShowCurrentRecord
    Exit Sub
DealError:
    msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objRs = Nothing
    objCn.Close
    Set objCn = Nothing
End Sub



Private Sub cmdAdd_Click()
    txtUser = ""
    txtPWD = ""
    txtNews = "添加新记录"
    cmbStatus.ListIndex = 1         '设置默认级别代码
    isAdding = True
    cmdAdd.Enabled = False          '在保存新记录之前禁用控件
    cmdDelete.Enabled = False
    picNavigation.Enabled = False
End Sub

Private Sub cmdDelete_Click()
    On Error GoTo DealError
    With objRs
        If Not .EOF Then
            If MsgBox("将删除<" & Trim(txtUser) & ">的用户数据，是否继续？", _
                       vbCritical + vbYesNo, "系统用户管理") = vbYes Then
                .Delete
                .MoveNext
                If .EOF And .RecordCount > 0 Then .MoveLast
                ShowCurrentRecord
            End If
        End If
    End With
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub cmdSave_Click()
    On Error GoTo DealError
    If Trim(txtUser) = "" Then
        MsgBox "用户名不能为空！", vbCritical, "系统用户管理"
        txtUser.SetFocus
    ElseIf Trim(txtPWD) = "" Then
        MsgBox "用户口令不能为空！", vbCritical, "系统用户管理"
        txtPWD.SetFocus
    Else
        If isRepeat Then
            MsgBox "用户名：" & Trim(txtUser) & "已被使用，请使用其他用户名！", _
            vbCritical, "系统用户管理"
            txtUser.SetFocus
            txtUser.SelStart = 0
            txtUser.SelLength = Len(txtUser)
        Else
            '保存记录
            If isAdding Then objRs.AddNew
            objRs!用户名 = txtUser
            objRs!口令 = txtPWD
            objRs!身份 = cmbStatus
            objRs.Update
            MsgBox "数据保存成功！", vbInformation, "系统用户管理"
            cmdAdd.Enabled = True
            cmdDelete.Enabled = True
            isAdding = False
            picNavigation.Enabled = True
            ShowCurrentRecord
        End If
    End If
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub cmdMove_Click(Index As Integer)
    On Error GoTo DealError
    With objRs
        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
        ShowCurrentRecord
    End With
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub ShowCurrentRecord()
    On Error GoTo DealError
    If objRs.BOF And objRs.EOF Then
       txtNews = "记录：无"
       Else
       txtUser = objRs!用户名
       txtPWD = objRs!口令
       If objRs!身份 = "管理员" Then
           cmbStatus.ListIndex = 0
       Else
           cmbStatus.ListIndex = 1
       End If
       '显示当前记录编号和记录总数
       txtNews = "记录：" & objRs.AbsolutePosition & "/" & objRs.RecordCount
    End If
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Function isRepeat() As Boolean
    '检查当前修改后的用户名是否重复
    Dim objCopy As New Recordset
    Set objCopy = objRs.Clone
    If objCopy.RecordCount > 0 Then
        objCopy.MoveFirst
        objCopy.Find "用户名='" & Trim(txtUser) & "'"
        If objCopy.EOF Then
            isRepeat = False
        ElseIf isAdding Then
            isRepeat = True
        ElseIf objCopy.AbsolutePosition <> objRs.AbsolutePosition Then
            isRepeat = True
        Else
            isRepeat = False
        End If
    Else
        isRepeat = False
    End If
    Set objCopy = Nothing
End Function