frmdotest.frm

自测考试系统

                cmbtype = "多项选择题"
                lblType = "三、多项选择题"
                txtTest = Trim(Str(.AbsolutePosition - ij - iso)) & "、"
                objselmany.MoveFirst
                objselmany.Find "编号=" & .Fields("编号") & ""
                txtTest = txtTest & objselmany.Fields("题干")
                txtTest = txtTest & vbCrLf & " （A）" & objselmany.Fields("选项a")
                txtTest = txtTest & vbCrLf & " （B）" & objselmany.Fields("选项b")
                txtTest = txtTest & vbCrLf & " （C）" & objselmany.Fields("选项c")
                txtTest = txtTest & vbCrLf & " （D）" & objselmany.Fields("选项d")
                frmAnswer(0).Visible = False
                frmAnswer(1).Visible = False
                frmAnswer(2).Visible = True
                frmAnswer(3).Visible = False
                frmAnswer(4).Visible = False
                For i = 0 To 3
                    If Not InStr(strTest(.AbsolutePosition, 2), i + 1) = 0 Then
                    chksm(i).Value = 1
                     End If
                Next
            Case ij + iso + ism + 1 To ij + iso + ism + ifl
                cmbtype = "填空题"
                '显示填空题内容以及所作答案
                p = (.AbsolutePosition - ij - iso - ism - 1) * 3
                lblType = "四、填空题"
                n = .AbsolutePosition
                txtTest = Trim(Str(n - ij - iso - ism)) & "、" & vbCrLf
                objfill.MoveFirst
                objfill.Find "编号=" & .Fields("编号") & ""
                txtTest = txtTest & objfill.Fields("题干")
                txtBlank(0) = strTest(n + p, 2)
                txtBlank(1) = strTest(n + p + 1, 2)
                txtBlank(2) = strTest(n + p + 2, 2)
                txtBlank(3) = strTest(n + p + 3, 2)
                If objfill.Fields("空1") = "" Then
                    txtBlank(0).Visible = False
                    lblBlank(0).Visible = False
                Else
                    txtBlank(0).Visible = True
                    lblBlank(0).Visible = True
                End If
                If objfill.Fields("空2") = "" Then
                    txtBlank(1).Visible = False
                    lblBlank(1).Visible = False
                Else
                    txtBlank(1).Visible = True
                    lblBlank(1).Visible = True
                End If
                If objfill.Fields("空3") = "" Then
                    txtBlank(2).Visible = False
                    lblBlank(2).Visible = False
                Else
                    txtBlank(2).Visible = True
                    lblBlank(2).Visible = True
                End If
                If objfill.Fields("空4") = "" Then
                    txtBlank(3).Visible = False
                    lblBlank(3).Visible = False
                Else
                    txtBlank(3).Visible = True
                    lblBlank(3).Visible = True
                End If
                frmAnswer(0).Visible = False
                frmAnswer(1).Visible = False
                frmAnswer(2).Visible = False
                frmAnswer(3).Visible = True
                frmAnswer(4).Visible = False
                 Case ij + iso + ism + 1 To ij + iso + ism + ifl + ians
               
                '显示问答题内容以及所作答案
                p = ifl * 3
                 cmbtype = "问答题"
                lblType = "五、问答题"
                n = .AbsolutePosition
                txtTest = Trim(Str(n - ij - iso - ism - ifl)) & "、" & vbCrLf
                objanswer.MoveFirst
                objanswer.Find "编号=" & .Fields("编号") & ""
                txtTest = txtTest & objanswer.Fields("题干")
                txtanswer = strTest(.AbsolutePosition + p, 2)
                frmAnswer(0).Visible = False
                frmAnswer(1).Visible = False
                frmAnswer(2).Visible = False
                frmAnswer(3).Visible = False
                frmAnswer(4).Visible = True
               End Select
    End With
End Sub

Private Sub cmdSubmit_Click()
    On Error Resume Next
    Dim strA$, strB$, strC$, strD$, strE$, i%, strSQL$
    Dim objStuLogInfo As New Recordset
        If MsgBox("请认真检查后交卷，交卷后则不能再继续考试！", _
              vbYesNo + vbInformation, "Basic自测考试") = vbYes Then
        '改变试题当前记录，保存对试题最后的修改
        cmdMove(1).Value = True
        '获得学生答题数据
        For i = 1 To ij
            strA = strA & Chr(13) & Chr(10) & strTest(i, 1) & "=" & strTest(i, 2)
        Next
        For i = ij + 1 To ij + iso
            strB = strB & Chr(13) & Chr(10) & strTest(i, 1) & "=" & strTest(i, 2)
        Next
        For i = ij + iso + 1 To ij + iso + ism
            strC = strC & Chr(13) & Chr(10) & strTest(i, 1) & "=" & strTest(i, 2)
        Next
        For i = ij + iso + ism + 1 To ij + iso + ism + 4 * ifl
            strD = strD & Chr(13) & Chr(10) & strTest(i, 1) & "=" & strTest(i, 2)
        Next
        For i = ij + iso + ism + 4 * ifl + 1 To iTotal
            strE = strE & Chr(13) & Chr(10) & strTest(i, 1) & "=" & strTest(i, 2)
        Next
        strA = Mid(strA, 3)
        strB = Mid(strB, 3)
        strC = Mid(strC, 3)
        strD = Mid(strD, 3)
        strE = Mid(strE, 3)
        '将学生答题数据存入数据库
        '访问数据库获得学生信息数据
      ' With objStuLogInfo
       ' .CursorLocation = adUseClient           '指定使用客户端游标
       ' .Open "SELECT * FROM 学生信息", objCn   '获取问答题数据
       ' studentcode = .Fields("考号")
      ' End With
       
        
        strSQL = "Insert into 考试记录 (考号,判断题,单选题,多选题,填空题,问答题) " & _
                 "VALUES ('" & studentcode & "','" & strA & "','" & strB & "','" _
                 & strC & "','" & strD & "','" & strE & "')"
        objCn.Open
        objCn.Execute strSQL
        objCn.Close
        MsgBox "成功提交试题，考试结束！", vbInformation, "自测考试"
        Unload Me
        End  '结束程序运行
    End If
End Sub

Private Sub Form_Load()
    Dim n%, i%, m%, p%, s%, s1%, s2%
    Set objCn = New Connection
    With objCn                                 '建立数据库联接
        .Provider = "SQLOLEDB"
        .ConnectionString = "user id=sa;data source=(local);" & _
           "initial catalog=自测考试"
        .Open
    End With
    '访问数据库获得判断题数据
    Set objjudge = New Recordset                '实例化对象
    With objjudge
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT * FROM 判断题"            '获取判断题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With

    '访问数据库获得单项选择题数据
    Set objselone = New Recordset                '实例化对象
    With objselone
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT * FROM 单项选择题"        '获取选择题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得多项选择题数据
    Set objselmany = New Recordset                '实例化对象
    With objselmany
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT * FROM 多项选择题"        '获取程序阅读题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得填空题数据
     Set objfill = New Recordset                '实例化对象
    With objfill
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT * FROM 填空题"            '获取填空题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得问答题数据
    Set objanswer = New Recordset                '实例化对象
    With objanswer
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT * FROM 问答题"            '获取问答题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
    End With
    '访问数据库获得本次试题数据
    Set objTest = New Recordset                '实例化对象
    With objTest
        Set .ActiveConnection = objCn           '建立数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT * FROM ThisTest"          '获取本次试题数据
        Set .ActiveConnection = Nothing         '断开数据库连接
        '统计总题数
        
        .Filter = "题型='判断题'"
        n = n + .RecordCount
        ij = .RecordCount
        s = n * .Fields("分数")
        lblNews = "一、判断题(" & Trim(Str(n)) & "小题,每题" & Trim(Str(.Fields("分数"))) _
                & "分,共" & Trim(Str(s)) & "分)"
        
        .Filter = "题型='单选题'"
        m = .RecordCount
        iso = m
        n = n + m
        s1 = m * .Fields("分数")
        s = s + s1
        lblNews = lblNews & vbCrLf & "二、单项选择题(" & Trim(Str(m)) & "小题,每题" & Trim(Str(.Fields("分数"))) _
                & "分,共" & Trim(Str(s1)) & "分)"
         
         .Filter = "题型='多选题'"
        p = .RecordCount
        ism = p
        n = n + p
        s2 = p * .Fields("分数")
        s = s + s2
        lblNews = lblNews & vbCrLf & "三、多项选择题(" & Trim(Str(p)) & "小题,每题" & Trim(Str(.Fields("分数"))) _
                & "分,共" & Trim(Str(s2)) & "分)"
        
        .Filter = "题型='填空题'"
        ifl = .RecordCount
        n = n + .RecordCount * 4
        s1 = .Fields("分数")
        '计算实际小题数
        m = 0
        While Not .EOF
            objfill.MoveFirst
            objfill.Find "编号=" & .Fields("编号") & ""
            For i = 1 To 4
                If objfill.Fields("空" & Trim(Str(i))) <> "" Then m = m + 1
            Next
            .MoveNext
        Wend
        s = s + s1 * m
        lblNews = lblNews & vbCrLf & "四、填空题(" & Trim(Str(m)) & "小题,每题" & Trim(Str(s1)) _
                & "分,共" & Trim(Str(s1 * m)) & "分)"
        .Filter = "题型='问答题'"
        ians = .RecordCount
           n = n + ians
        s1 = ians * .Fields("分数")
        s = s + s1
        lblNews = lblNews & vbCrLf & "五、问答题(" & Trim(Str(ians)) & "小题,每题" & Trim(Str(.Fields("分数"))) _
                & "分,共" & Trim(Str(s1)) & "分)"
        lblNews = "本试卷共5大题,总分" & Trim(Str(s)) & "分" & vbCrLf & lblNews
        '重定义保存本次试题数据的数组
        ReDim strTest(n, 2)
        iTotal = n
        '获取判断题数据
        .Filter = "题型='判断题'"
        n = 1
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            .MoveNext
        Wend
        '获取单项选择题数据
        .Filter = "题型='单选题'"
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            .MoveNext
        Wend
        '获取多项选择题数据
        .Filter = "题型='多选题'"
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            .MoveNext
        Wend
        '获取填空题数据
        .Filter = "题型='填空题'"
        i = 1
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            i = i + 1
            If i > 4 Then
                i = 1
                .MoveNext
            End If
        Wend
         '获取问答题数据
        .Filter = "题型='问答题'"
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            .MoveNext
        Wend
        .Filter = ""
    End With
    cmdMove(0).Value = True                 '显示第一道试题
    objCn.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objCn = Nothing
    Set objjudge = Nothing
    Set objTest = Nothing
    Set objselone = Nothing
    Set objselmany = Nothing
    Set objfill = Nothing
    Set objanswer = Nothing
End Sub