frmtoscoring.frm

上机考试系统

         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   15
         Width           =   870
      End
      Begin VB.CommandButton cmdMove 
         Caption         =   "前一题"
         Height          =   300
         Index           =   1
         Left            =   920
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   15
         Width           =   870
      End
   End
   Begin VB.TextBox txtTest 
      Height          =   5070
      Left            =   410
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   578
      Width           =   4455
   End
   Begin VB.Label lblType 
      AutoSize        =   -1  'True
      Caption         =   "程序填空及参考答案"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   403
      TabIndex        =   1
      Top             =   293
      Width           =   2025
   End
End
Attribute VB_Name = "ToScoring"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim objTest As Recordset            '用于保存考试记录数据
Dim objJudge As Recordset           '用于保存判断题题库数据
Dim objSelOne As Recordset          '用于保存选择题题库数据
Dim objProRead As Recordset         '用于保存程序阅读题题库数据
Dim objProFill As Recordset         '用于保存程序填空题题库数据
Dim objCn As Connection             '用于建立数据库连接
Dim objTeacher As Recordset         '用于保存阅卷教师数据
Dim strTest                         '用于表存学生答题信息
Dim iTestNo%                        '用于保存当前题号
Dim iRight%()                       '用于保存程序填空题的评阅结果
Dim iPFS%                           '用于保存程序填空题的小题分数
Dim StuCode$                        '用于保存当前试卷学生的考号
Private Sub cmdSubmit_Click()
    Dim i%, j%, k%
    Dim strSQL$
    i = Val(txtScore(0)) + Val(txtScore(1)) + Val(txtScore(2)) + Val(txtScore(3))
    If MsgBox("本试卷总分：" & Str(i) & "，提交？", vbQuestion + vbYesNo, _
               "教师阅卷") = vbNo Then Exit Sub
    '保存当前学生试卷成绩
    strSQL = "update 学生信息 set 成绩=" & Str(i) _
            & " where 考号='" & StuCode & "'"
    objCn.Execute strSQL
    '保存阅卷记录
    strSQL = "Insert Into 阅卷记录 (教师,考号) Values (" _
             & Str(objTeacher.Fields("编号")) & ",'" & StuCode & "')"
    objCn.Execute strSQL
    MsgBox "成绩提交成功！", vbInformation, "教师阅卷"
    '更新教师阅卷信息
    lblTotal = "剩余份数：" & Str(Val(Mid(lblTotal, 6)) - 1)
    lblChecked = "已阅份数：" & Str(Val(Mid(lblChecked, 6)) + 1)
    txtNum = Str(Val(txtNum) + 1)
    '获得下一份试卷
    With objTest
         .Close
         Set .ActiveConnection = objCn                   '建立数据库连接
        .Open "SELECT TOP 1 考试记录.* FROM 考试记录,学生信息 " _
                & " WHERE 考试记录.考号=学生信息.考号 and 成绩 is null"
        Set .ActiveConnection = Nothing                  '断开数据库连接
        If .RecordCount = 0 Then
            MsgBox "试卷已经评阅完毕！"
            picNavigation.Enabled = False
            cmdSubmit.Enabled = False
            Exit Sub
        End If
        StuCode = .Fields("考号")
    End With
    Get_Test_Data
    iTestNo = 0
    ReDim iRight(UBound(strTest))
    '设置默认值
    For i = 0 To UBound(strTest)
        iRight(i) = -1
    Next
    cmdMove(0).Value = True
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim i%
    Set objCn = New Connection
    With objCn                                 '建立数据库联接
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=123;Data Source=(local);Initial Catalog=自测考试"
        .Open
    End With
    '访问数据库获得判断题数据
    Set objJudge = New Recordset                '实例化对象
    With objJudge
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .Open "SELECT * FROM 判断题"            '获取判断题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得单项选择题数据
    Set objSelOne = New Recordset                '实例化对象
    With objSelOne
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .Open "SELECT * FROM 选择题"            '获取选择题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得程序阅读题数据
    Set objProRead = New Recordset                '实例化对象
    With objProRead
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .Open "SELECT * FROM 程序阅读"          '获取程序阅读题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得程序填空题数据
     Set objProFill = New Recordset                '实例化对象
    With objProFill
         Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .Open "SELECT * FROM 程序填空"          '获取程序填空题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
        iPFS = .Fields("分数")
    End With
    '访问数据库获得第一份批改试卷数据
    Set objTest = New Recordset                '实例化对象
    With objTest
        Set .ActiveConnection = objCn                   '建立数据库连接
        .CursorLocation = adUseClient                   '指定使用客户端游标
        .Open "SELECT TOP 1 考试记录.* FROM 考试记录,学生信息 " _
                & " WHERE 考试记录.考号=学生信息.考号 and 成绩 is null"
        Set .ActiveConnection = Nothing                  '断开数据库连接
        If .RecordCount = 0 Then
            MsgBox "试卷已经评阅完毕！"
            Frame2.Enabled = False
            picNavigation.Enabled = False
            cmdSubmit.Enabled = False
            Exit Sub
        End If
        StuCode = .Fields("考号")
    End With
    '访问数据库获得阅卷教师信息
    Set objTeacher = New Recordset                '实例化对象
    With objTeacher
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .Open "SELECT * FROM 阅卷教师 where 姓名='" & CurrentUserName & "'"          '获得阅卷教师信息
        Set .ActiveConnection = Nothing         '断开数据库连接
        If .RecordCount = 0 Then
            MsgBox "请以阅卷教师身份登录系统，否则不能正常使用阅卷功能！", , Me.Caption
            Frame2.Enabled = False
            picNavigation.Enabled = False
            cmdSubmit.Enabled = False
            Exit Sub
        End If
        frmTeacher.Caption = CurrentUserName & "阅卷信息"
        lblTotal = "剩余份数：" & .Fields("数量")
        lblChecked = "已阅份数：0"
        txtNum = "1"
    End With
    '显示试卷程序填空题以及客观分数
    Get_Test_Data
    iTestNo = 0
    ReDim iRight(UBound(strTest))
    '设置默认值
    For i = 0 To UBound(strTest)
        iRight(i) = -1
    Next
    cmdMove(0).Value = True
End Sub
Private Sub cmdMove_Click(Index As Integer)
    Dim n, Code$(3), Answer$(3)
    '该变当前程序填空题
    Select Case Index
        Case 0                  '使第一题成为当前题
            If iTestNo <> 0 Then iTestNo = 0
        Case 1                  '使上一题成为当前题
            iTestNo = iTestNo - 4
            If iTestNo < 0 Then iTestNo = 0
        Case 2                  '使下一个记录成为当前题
            iTestNo = iTestNo + 4
            If iTestNo > UBound(strTest) Then iTestNo = UBound(strTest) - 3
        Case 3                  '使最后一题成为当前题
            iTestNo = UBound(strTest) - 3
    End Select
    n = InStr(strTest(iTestNo), "=")
    Code(0) = Left(strTest(iTestNo), n - 1)
    Answer(0) = Mid(strTest(iTestNo), n + 1)
    n = InStr(strTest(iTestNo + 1), "=")
    Code(1) = Left(strTest(iTestNo + 1), n - 1)
    Answer(1) = Mid(strTest(iTestNo + 1), n + 1)
    n = InStr(strTest(iTestNo + 2), "=")
    Code(2) = Left(strTest(iTestNo + 2), n - 1)
    Answer(2) = Mid(strTest(iTestNo + 2), n + 1)
    n = InStr(strTest(iTestNo + 3), "=")
    Code(3) = Left(strTest(iTestNo + 3), n - 1)
    Answer(3) = Mid(strTest(iTestNo + 3), n + 1)
    For n = 0 To 3
        txtStuAnswer(n) = Answer(n)
    Next
    '显示程序填空题及参考答案
    With objProFill
        .MoveFirst
        .Find "编号=" & Code(0)
        txtTest = "【" & Trim(Str(iTestNo / 4 + 1)) & "】" & vbCrLf _
                & .Fields("题干") & vbCrLf & "第1空参考答案：" & .Fields("空a") _
                & vbCrLf & "第2空参考答案：" & .Fields("空b")
        If .Fields("空c") <> "" Then
            txtTest = txtTest & vbCrLf & "第3空参考答案：" & .Fields("空c")
            frmBlank(2).Visible = True
        Else
            frmBlank(2).Visible = False
        End If
        If .Fields("空d") <> "" Then
            txtTest = txtTest & vbCrLf & "第4空参考答案：" & .Fields("空d")
            frmBlank(3).Visible = True
        Else
            frmBlank(3).Visible = False
        End If
    End With
    '显示试题评阅情况
    optYN1(0) = False
    optYN1(1) = False
    If iRight(iTestNo) = 1 Then
        optYN1(0) = True
    ElseIf iRight(iTestNo) = 0 Then
        optYN1(1) = True
    End If
    optYN2(0) = False
    optYN2(1) = False
    If iRight(iTestNo + 1) = 1 Then
        optYN2(0) = True
    ElseIf iRight(iTestNo + 1) = 0 Then
        optYN2(1) = True
    End If
    optYN3(0) = False
    optYN3(1) = False
    If iRight(iTestNo + 2) = 1 Then
        optYN3(0) = True
    ElseIf iRight(iTestNo + 2) = 0 Then
        optYN3(1) = True
    End If
    optYN4(0) = False
    optYN4(1) = False
    If iRight(iTestNo + 3) = 1 Then
        optYN4(0) = True
    ElseIf iRight(iTestNo + 3) = 0 Then
        optYN4(1) = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objCn = Nothing
    Set objJudge = Nothing
    Set objTest = Nothing
    Set objSelOne = Nothing
    Set objProRead = Nothing
    Set objProFill = Nothing
End Sub

Private Sub Get_Test_Data()
    Dim msg$, i%, Code$, Answer$, iScore%, iTotal%, n%, m%
    Dim Code1$, Answer1$, Code2$, Answer2$, Code3$, Answer3$
    '统计判断题应得分数
    strTest = Split(objTest.Fields("判断题"), Chr(13) & Chr(10))
    iScore = objJudge("分数")
    For i = 0 To UBound(strTest)
        n = InStr(1, strTest(i), "=")
        Code = Left(strTest(i), n - 1)
        Answer = Mid(strTest(i), n + 1)
        With objJudge
            .MoveFirst
            .Find "编号=" & Code
            If (Answer = "TRUE" And .Fields("答案") = True) Or _
                    (Answer = "FALSE" And .Fields("答案") = False) Then
                iTotal = iTotal + iScore
            End If
        End With
    Next i
    txtScore(0) = iTotal
    '统计选择题应得分数
    strTest = Split(objTest.Fields("选择题"), Chr(13) & Chr(10))
    iScore = objSelOne("分数")
    iTotal = 0
    For i = 0 To UBound(strTest)
        n = InStr(1, strTest(i), "=")
        Code = Left(strTest(i), n - 1)
        Answer = Mid(strTest(i), n + 1)
        With objSelOne
            .MoveFirst
            .Find "编号=" & Code
            If Answer = .Fields("答案") Then
                iTotal = iTotal + iScore
            End If
        End With
    Next i
    txtScore(1) = iTotal
    '统计程序阅读题应得分数
    strTest = Split(objTest.Fields("程序阅读"), Chr(13) & Chr(10))
    iScore = objProRead("分数")
    iTotal = 0
    For i = 0 To UBound(strTest) Step 3
        n = InStr(1, strTest(i), "=")
        Code = Left(strTest(i), n - 1)
        Answer = Mid(strTest(i), n + 1)
        n = InStr(1, strTest(i + 1), "=")
        Code1 = Left(strTest(i + 1), n - 1)
        Answer1 = Mid(strTest(i + 1), n + 1)
        n = InStr(1, strTest(i + 2), "=")
        Code2 = Left(strTest(i + 2), n - 1)
        Answer3 = Mid(strTest(i + 2), n + 1)
        With objProRead
            .MoveFirst
            .Find "编号=" & Code
            If Answer = .Fields("答案1") Then iTotal = iTotal + iScore
            If .Fields("答案2") <> "" And Answer1 = .Fields("答案2") Then iTotal = iTotal + iScore
            If .Fields("答案3") <> "" And Answer2 = .Fields("答案3") Then iTotal = iTotal + iScore
        End With
    Next i
    txtScore(2) = iTotal
    '获得程序填空题
    strTest = Split(objTest.Fields("程序填空"), Chr(13) & Chr(10))
End Sub

Private Sub optYN1_Click(Index As Integer)
    If Index = 0 And iRight(iTestNo) <> 1 Then
        iRight(iTestNo) = 1
    ElseIf Index = 1 Then
        iRight(iTestNo) = 0
    End If
    Sum_Score
End Sub

Private Sub optYN2_Click(Index As Integer)
    If Index = 0 And iRight(iTestNo + 1) <> 1 Then
        iRight(iTestNo + 1) = 1
    ElseIf Index = 1 Then
        iRight(iTestNo + 1) = 0
    End If
    Sum_Score
End Sub
Private Sub optYN3_Click(Index As Integer)
    If Index = 0 And iRight(iTestNo + 2) <> 1 Then
        iRight(iTestNo + 2) = 1
    ElseIf Index = 1 Then
        iRight(iTestNo + 2) = 0
    End If
    Sum_Score
End Sub
Private Sub optYN4_Click(Index As Integer)
    If Index = 0 And iRight(iTestNo + 3) <> 1 Then
        iRight(iTestNo + 3) = 1
    ElseIf Index = 1 Then
        iRight(iTestNo + 3) = 0
    End If
    Sum_Score
End Sub

Private Sub Sum_Score()
    Dim i%, s%
    For i = 0 To UBound(iRight)
        If iRight(i) = 1 Then s = s + iPFS
    Next
    txtScore(3) = s
End Sub