frmstudents.frm

上机考试系统

    Set objCn = New Connection                 '实例化联接对象
    With objCn                                 '建立数据库联接
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=123;Data Source=(local);" & _
                            "Initial Catalog=学籍管理"
        .Open
    End With
    '获取学生信息记录
    Set objStudent = New Recordset              '实例化objStudent对象
    With objStudent
        Set .ActiveConnection = objCn           '设置数据库联接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .LockType = adLockOptimistic
        .Open "SELECT * FROM 学生信息"          '获取学生信息记录
    End With
    '获取系部编号和名称，建立系部名称列表
    Set objDepart = New Recordset               '实例化objDepart对象
    With objDepart
        Set .ActiveConnection = objCn           '设置数据库联接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .LockType = adLockOptimistic
        .Open "SELECT * FROM 系部信息"          '获取系部信息记录
        cmbDepart.AddItem ""                    '添加一个空的列表项
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                cmbDepart.AddItem .Fields("系名称")
                .MoveNext
            Wend
        End If
    End With
    '获取班级编号和名称，建立班级名称列表
    Set objGrade = New Recordset               '实例化objGrade对象
    With objGrade
        Set .ActiveConnection = objCn           '设置数据库联接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .LockType = adLockOptimistic
        .Open "SELECT * FROM 班级信息"          '获取班级信息记录
        cmbGrade.AddItem ""                     '添加一个空的列表项
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                cmbGrade.AddItem .Fields("名称")
                .MoveNext
            Wend
        End If
    End With
    '触发按钮单击事件，显示第一个记录
    cmdMove(0).Value = True
End Sub

Private Sub cmdMove_Click(Index As Integer)
    With objStudent
        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 = "记录：无"    '显示无记录提示
            txtNum = "":    txtName = ""
            txtPhone = "":  txtEmail = ""
            txtHome = "":   txtExp = ""
            txtBirth = ""
            cmbDepart.ListIndex = 0
            cmbGrade.ListIndex = 0
        Else
            '显示当前记录数据
            ShowData
        End If
    End With
    If isAdding Then isAdding = False
End Sub

Private Sub cmdAdd_Click()
    txtNews = "添加新记录"
    '设置默认值
    txtNum = Trim(Str(Year(Date))) + "0001"
    txtName = ""
    txtPhone = ""
    txtEmail = ""
    txtHome = ""
    txtExp = ""
    txtBirth = "2000-01-01"
    cmbDepart.ListIndex = 1
    cmbGrade.ListIndex = 1
    cmbSex.ListIndex = 0
    isAdding = True
End Sub

Private Sub cmdDelete_Click()
    '根据是否处于添加记录状态执行不同的操作
    If isAdding Then
        '退出添加记录状态，显示当前记录
        isAdding = False
        If objStudent.RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            txtNum = "": txtName = ""
            txtPhone = "": txtEmail = ""
            txtHome = "": txtExp = ""
            txtBirth = ""
            cmbDepart.ListIndex = 0
            cmbGrade.ListIndex = 0
        Else
            '显示当前记录数据
            ShowData
        End If
    Else
        If objStudent.RecordCount > 0 Then
            '检查在选课记录表中是否使用了当前记录的编号
            '如果被使用，则不执行删除操作
            Dim objTemp As New Recordset
            With objTemp
                Set .ActiveConnection = objCn           '设置数据库联接
                .CursorLocation = adUseClient           '指定使用客户端游标
                .CursorType = adOpenStatic              '指定使用静态游标
                '获取使用了该编号的第一条记录
                .Open "SELECT TOP 1 * FROM 选课记录 WHERE 学生='" & Trim(txtNum) & "'"
                If .RecordCount > 0 Then
                    MsgBox "编号被《选课记录》表使用，不能删除当前记录！", vbInformation, "学生信息管理"
                    Exit Sub
                End If
                .Close
            End With
            Set objTemp = Nothing
            '可以删除，请求确认执行删除操作
            If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, "学生信息管理") = vbYes Then
                '执行删除当前记录操作
                objStudent.Delete
                '显示下一记录数据
                cmdMove(2).Value = True
            Else
                '显示当前记录数据
                ShowData
            End If
        End If
    End If
End Sub
Private Sub cmdSave_Click()
    '在当前表中无数据和不是添加记录时，不执行保存操作
    If Not isAdding And objStudent.RecordCount < 1 Then Exit Sub
    '获得添加或修改的记录数据
    Dim strNum$, strName$, strPhone$, strEmail$, strDepart$
    Dim strGrade$, strSex$, strBirth$, strExp$, strHome$
    strNum = Trim(txtNum)
    strName = Trim(txtName)
    strPhone = Trim(txtPhone)
    strEmail = Trim(txtEmail)
    strBirth = Trim(txtBirth)
    strHome = Trim(txtHome)
    strExp = Trim(txtExp)
    strSex = cmbSex
    '根据系名称获得系编号
    If cmbDepart <> "" Then
        objDepart.MoveFirst
        objDepart.Find "系名称='" & cmbDepart & "'"
        strDepart = objDepart.Fields("系编号")
    End If
    '根据班级名称获得系编号
    If cmbGrade <> "" Then
        objGrade.MoveFirst
        objGrade.Find "名称='" & cmbGrade & "'"
        strGrade = objGrade.Fields("编号")
    End If
    '检验是否输入学生姓名
    If Trim(txtName) = "" Then
        MsgBox "学生姓名不能为空！", vbCritical, "学生信息管理"
        txtName.SetFocus
        txtName = ""
        Exit Sub
    End If
    '检验是否输入学生编号
    If Len(strNum) <> 8 Then
        MsgBox "学生编号必须为8位数字！", vbCritical, "学生信息管理"
        txtNum.SetFocus
        txtNum.SelStart = 0
        txtNum.SelLength = Len(txtNum)
        Exit Sub
    End If
    '检验选择了所属系部
    If cmbDepart = "" Then
        MsgBox "必须指定学生所属系部！", vbCritical, "学生信息管理"
        cmbDepart.SetFocus
        Exit Sub
    End If
    '检验选择了所属班级
    If cmbGrade = "" Then
        MsgBox "必须指定学生所属班级！", vbCritical, "学生信息管理"
        cmbGrade.SetFocus
        Exit Sub
    End If
    '检验指定的出生日期是否有效
    If Not IsDate(strBirth) Then
        MsgBox "出生日期无效！", vbCritical, "学生信息管理"
        txtBirth.SetFocus
        txtBirth.SelStart = 0
        txtBirth.SelLength = Len(txtBirth)
        Exit Sub
    End If
    '在进一步保存添加的新记录或修改的当前记录之前，检查编号是否重复
    Dim objCopy As New Recordset
    Set objCopy = objStudent.Clone
    If objCopy.RecordCount > 0 Then
        objCopy.MoveFirst
        objCopy.Find "编号='" & strNum & "'"
        If (isAdding And Not objCopy.EOF) Or (Not isAdding And Not objCopy.EOF And _
            objCopy.AbsolutePosition <> objStudent.AbsolutePosition) Then
            MsgBox "学生编号：" & strNum & "已被使用，请使用其他编号！", _
            vbCritical, "学生信息管理"
            txtNum.SetFocus
            txtNum.SelStart = 0
            txtNum.SelLength = Len(txtNum)
            Exit Sub        '编号重复，直接退出
        End If
    End If
    '编号不重复，执行下一步保存操作
    With objStudent
        If isAdding Then
            '添加新记录
            .AddNew
        Else
            '保存被修改的当前记录
            If .Fields("编号") <> strNum Then
                If MsgBox("修改编号将影响《课程信息》表中的相关记录，是否继续？", _
                   vbYesNo + vbQuestion, "学生信息管理") = vbNo Then
                    '取消修改，还原当前记录
                    ShowData
                End If
            End If
        End If
        .Fields("编号") = strNum
        .Fields("姓名") = strName
        .Fields("系编号") = strDepart
        .Fields("班编号") = strGrade
        .Fields("性别") = strSex
        .Fields("生日") = strBirth
        .Fields("住址") = strHome
        .Fields("电话") = strPhone
        .Fields("Email") = strEmail
        .Fields("简历") = strExp
        '执行更新操作
        .Update
        MsgBox "数据保存成功！", vbInformation, "学生信息管理"
        isAdding = False
        '显示当前记录编号和记录总数
        txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    objCn.Close                 '关闭数据联接
    Set objCn = Nothing         '释放数据库联接
    Set objStudent = Nothing     '释放记录集对象
    Set objDepart = Nothing     '释放记录集对象
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
    '将小写字母转换为大写
    If Chr(KeyAscii) Like "[a-z]" Then
        KeyAscii = KeyAscii - 32  '输入不是数字、英文字母或退格键，取消输入
    End If
End Sub

'显示objStudent当前记录信息
Private Sub ShowData()
    With objStudent
        '显示当前记录数据
        txtName = .Fields("姓名")
        txtNum = .Fields("编号")
        txtBirth = .Fields("生日")
        If IsNull(.Fields("电话")) Then
            txtPhone = ""
        Else
            txtPhone = .Fields("电话")
        End If
        If IsNull(.Fields("Email")) Then
            txtEmail = ""
        Else
            txtEmail = .Fields("Email")
        End If
        If IsNull(.Fields("住址")) Then
            txtHome = ""
        Else
            txtHome = .Fields("住址")
        End If
        If IsNull(.Fields("简历")) Then
            txtExp = ""
        Else
            txtExp = .Fields("简历")
        End If
        cmbSex.ListIndex = Switch(.Fields("性别") = "男", 0, .Fields("性别") = "女", 1)
        '根据系编号显示系名称
        objDepart.MoveFirst
        objDepart.Find "系编号='" & .Fields("系编号") & "'"
        cmbDepart.ListIndex = objDepart.AbsolutePosition
        '根据班级编号显示班级名称
        objGrade.MoveFirst
        objGrade.Find "编号='" & .Fields("班编号") & "'"
        cmbGrade.ListIndex = objGrade.AbsolutePosition
        '显示当前记录编号和记录总数
        txtNews = "记录：" & objStudent.AbsolutePosition & "/" & objStudent.RecordCount
    End With
End Sub