frmmanagers.frm

所在类别： 随书资源/T 工业技术/TP 自动化技术、计算机技术/TP31 计算机软件 其他题名： 作者： 夏邦贵, 刘凡馨等编著 出版者： 机械工业出版社 出版年： 2006 I

VERSION 5.00
Begin VB.Form frmManagers 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统用户管理"
   ClientHeight    =   2100
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4965
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2100
   ScaleWidth      =   4965
   Begin VB.CommandButton cmdSeek 
      Caption         =   "查找"
      Height          =   300
      Left            =   2115
      TabIndex        =   14
      Top             =   1425
      Width           =   735
   End
   Begin VB.TextBox txtName 
      Height          =   270
      Left            =   2107
      MaxLength       =   6
      TabIndex        =   0
      Top             =   353
      Width           =   1425
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存"
      Height          =   300
      Left            =   2865
      TabIndex        =   4
      Top             =   1425
      Width           =   735
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "退出"
      Height          =   300
      Left            =   3615
      TabIndex        =   5
      Top             =   1425
      Width           =   735
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Height          =   300
      Left            =   1365
      TabIndex        =   3
      Top             =   1425
      Width           =   735
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加"
      Height          =   300
      Left            =   615
      TabIndex        =   2
      Top             =   1425
      Width           =   735
   End
   Begin VB.TextBox txtPwd 
      Height          =   270
      Left            =   2107
      MaxLength       =   6
      TabIndex        =   1
      Top             =   720
      Width           =   1425
   End
   Begin VB.PictureBox picNavigation 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   345
      Left            =   1102
      ScaleHeight     =   345
      ScaleWidth      =   2760
      TabIndex        =   10
      Top             =   1095
      Width           =   2760
      Begin VB.CommandButton cmdMove 
         Caption         =   "<"
         Height          =   300
         Index           =   1
         Left            =   375
         TabIndex        =   7
         Top             =   15
         Width           =   360
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   "|<"
         Height          =   300
         Index           =   0
         Left            =   15
         TabIndex        =   6
         Top             =   15
         Width           =   360
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   ">|"
         Height          =   300
         Index           =   3
         Left            =   2370
         TabIndex        =   9
         Top             =   15
         Width           =   360
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   ">"
         Height          =   300
         Index           =   2
         Left            =   2010
         TabIndex        =   8
         Top             =   15
         Width           =   360
      End
      Begin VB.TextBox txtNews 
         Height          =   300
         Left            =   750
         Locked          =   -1  'True
         TabIndex        =   11
         TabStop         =   0   'False
         Top             =   15
         Width           =   1275
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户名"
      Height          =   180
      Left            =   1432
      TabIndex        =   13
      Top             =   398
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "口  令"
      Height          =   180
      Left            =   1432
      TabIndex        =   12
      Top             =   750
      Width           =   540
   End
End
Attribute VB_Name = "frmManagers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isAdding As Boolean             '定义操作状态标志
Dim objAdmin As Recordset           '用于保存管理员数据表记录
Dim objCn As Connection             '用于建立数据库联接

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

Private Sub cmdSeek_Click()
    Dim strKey$
    strKey = InputBox("请输入要查询的用户名！", "查询管理员")
    If strKey = "" Then
        MsgBox "输入无效！", vbInformation, "系统用户管理"
    Else
        With objAdmin
            If .RecordCount > 0 Then
                .MoveFirst
                .Find "用户名 like '*" & strKey & "*'"
                If .EOF Then
                    MsgBox "无用户名为 " & strKey & " 的管理员记录！", vbInformation, "系统用户管理"
                Else
                    '显示当前记录数据
                    txtName = .Fields("用户名")
                    txtPwd = .Fields("口令")
                    '显示当前记录编号和记录总数
                    txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
                End If
            Else
                MsgBox "无管理员记录！", vbInformation, "系统用户管理"
            End If
        End With
    End If
End Sub

Private Sub Form_Load()
    '建立数据库联接
    Set objCn = New Connection                 '实例化联接对象
    With objCn                                 '建立数据库联接
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=123;Data Source=(local);" & _
                            "Initial Catalog=学分制选课"
        .Open
    End With
    '获取管理员记录
    Set objAdmin = New Recordset                 '实例化objAdmin对象
    With objAdmin
        Set .ActiveConnection = objCn
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .LockType = adLockOptimistic
        .Open "SELECT * FROM 系统管理员"        '获取管理员登录信息
    End With
    '触发按钮单击事件，显示第一个记录
    cmdMove(0).Value = True
End Sub

Private Sub cmdMove_Click(Index As Integer)
    With objAdmin
        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 .RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            txtName = ""
            txtPwd = ""
        Else
            '显示当前记录数据
            txtName = .Fields("用户名")
            txtPwd = .Fields("口令")
            '显示当前记录编号和记录总数
            txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
        End If
    End With
    If isAdding Then isAdding = False   '改变当前记录则退出当前添加记录状态
End Sub

Private Sub cmdAdd_Click()
    txtNews = "添加新记录"
    txtName = ""
    txtPwd = ""
    isAdding = True
End Sub

Private Sub cmdDelete_Click()
    '根据是否处于添加记录状态执行不同的操作
    If isAdding Then
        '退出添加记录状态，显示当前记录
        isAdding = False
        If objAdmin.BOF And objAdmin.EOF Then
            txtNews = "记录：无"    '显示无记录提示
        Else
            '显示当前记录数据
            txtName = objAdmin.Fields("用户名")
            txtPwd = objAdmin.Fields("口令")
            '显示当前记录编号和记录总数
            txtNews = "记录：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
        End If
    Else
        If objAdmin.RecordCount > 0 Then
            If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, "系统用户管理") = vbYes Then
                objAdmin.Delete '执行删除当前记录操作
                cmdMove(2).Value = True '显示下一记录数据
            Else
                '显示当前记录数据
                txtName = objAdmin.Fields("用户名")
                txtPwd = objAdmin.Fields("口令")
                '显示当前记录编号和记录总数
                txtNews = "记录：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
            End If
        End If
    End If
End Sub
Private Sub cmdSave_Click()
    Dim objCopy As New Recordset
    If Trim(txtName) = "" Then
        MsgBox "用户名不能为空！", vbCritical, "系统用户管理"
        txtName.SetFocus
        txtName = ""
    ElseIf Len(Trim(txtPwd)) <> 6 Then
        MsgBox "用户口令必须为6位字符串！", vbCritical, "系统用户管理"
        txtPwd.SetFocus
        txtPwd.SelStart = 0
        txtPwd.SelLength = Len(txtPwd)
    Else
        Set objCopy = objAdmin.Clone
        With objCopy
            If .RecordCount > 0 Then
                '检查用户名是否被使用
                .MoveFirst
                .Find "用户名='" & Trim(txtName) & "'"
                If (isAdding And Not .EOF) Or (Not isAdding And Not .EOF And _
                     .AbsolutePosition <> objAdmin.AbsolutePosition) Then
                    MsgBox "用户名：" & Trim(txtName) & "已被使用，请使用其他用户名！", _
                    vbCritical, "系统用户管理"
                    txtName.SetFocus
                    txtName.SelStart = 0
                    txtName.SelLength = Len(txtName)
                    Exit Sub
                End If
            End If
        End With
        '保存或添加记录
        If isAdding Then objAdmin.AddNew
        objAdmin.Fields("用户名") = Trim(txtName)
        objAdmin.Fields("口令") = Trim(txtPwd)
        objAdmin.Update
        MsgBox "数据保存成功！", vbInformation, "系统用户管理"
        isAdding = False
        '显示当前记录编号和记录总数
        txtNews = "记录：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    objCn.Close                 '关闭数据联接
    Set objCn = Nothing         '释放数据库联接
    Set objAdmin = Nothing      '释放记录集对象
End Sub

'限制用户名输入
Private Sub txtName_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
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
End Sub