b考生考试.frm

在线考试系统。用vb编写

      End
      Begin VB.Label Label1 
         Caption         =   "未答客观题："
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   2
         Top             =   600
         Width           =   1215
      End
   End
   Begin VB.CommandButton CmdJiaoJuan 
      BackColor       =   &H00C0C0C0&
      Caption         =   "交卷"
      Height          =   360
      Left            =   7560
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   5160
      Width           =   800
   End
End
Attribute VB_Name = "B考生考试"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As ADODB.Recordset
Dim SQL As String
Dim Index As Integer
Dim msg As String
Dim time As Integer                             '保存时间变量
Dim KGTNo(1 To 10) As String                    '保存考生的10道客观题的考题号
Dim ZGTNo(1 To 5) As String                     '保存考生的5道主观题的考题号
Dim colValue As String                          '保存当前显示的考题号
Private Sub Form_Load()
    Call TextEnabled                            '控制控件的Enabled性
    Call GetKGT                                 '随机抽取客观题
    Call GetZGT                                 '随机抽取主观题
    Call setComboKGT                            '得到客观题ComboBox中的值
    Call setComboZGT                            '得到主观题ComboBox中的值
    time = 0                                    '初始化时间变量
End Sub
Private Sub TextEnabled()
'控制控件的Enable性
    txtkqt.Enabled = False                      '客观题题目不能被修改
    For Index = 0 To 3                          '客观题答案选项不能被修改
        txtAnswer(Index).Enabled = False
    Next Index                                  '主观题题目不能被修改
    txtzgt.Enabled = False
End Sub
Private Sub GetKGT()
'随机抽取客观题
    Dim rst As ADODB.Recordset
    Dim flag As Boolean
    Dim index1 As Integer
    Dim index2 As Integer
    Dim tempid As Integer
    Dim temp As Integer
    Dim sum As Integer                          '保存题库中的题目总数量
    Dim RandNo(1 To 10) As String               '保存考生的10道客观题的随机序列号
    '初始化数组
    For index1 = 1 To 10
        RandNo(index1) = "-1"
    Next index1
    
    '查询客观题题号信息
    SQL = " Select 考题号,答案 from 客观题信息表 order by 考题号 "
    Set rst = SelectSQL(SQL, msg)
    sum = rst.RecordCount                       '得到题库中题目总数量
    
    '取10道客观题的随机序列号
    For index1 = 1 To 10
        '保证所有的序号不能重复存在
        Do While True
            Randomize                           '随机数种子
            tempid = Int(Rnd() * (sum - 1)) + 1
            flag = True
            For index2 = 1 To index1
                If tempid = RandNo(index2) Then '如果取得序列号和前面的相同
                     flag = False
                     Exit For
                End If
            Next index2
            If flag = True Then Exit Do
        Loop
        RandNo(index1) = tempid
    Next index1
    
    '对随机得到的序号进行排序
    For index1 = 1 To 9
            tempid = index1
            For index2 = index1 + 1 To 10
                If CInt(Trim(RandNo(index2))) < CInt(Trim(RandNo(tempid))) Then
                     tempid = index2
                End If
            Next index2
            temp = RandNo(index1)
            RandNo(index1) = RandNo(tempid)
            RandNo(tempid) = temp
    Next index1
    
    '将得到的客观题号写入客观题临时表中
    index1 = 1
    index2 = 1
    rst.MoveFirst
    Do While Not rst.EOF
        If index1 = RandNo(index2) Then         '如果当前序列号与客观题信息表中的记录序列号相等
           '插入客观题信息
           SQL = "insert into 客观题临时表(考生号,考题号,标准答案,考生做答)"
           SQL = SQL & "values('" & Trim(UserID) & "','" & Trim(rst.Fields("考题号")) & "','" & Trim(rst.Fields("答案")) & "','')"
           Call ExecuteSQL(SQL, msg)
           KGTNo(index2) = rst.Fields("考题号") '将得到的考题号保存在数组中
           index2 = index2 + 1
        End If
        If index2 > 10 Then Exit Do             '插入过程完成
        rst.MoveNext
        index1 = index1 + 1
    Loop
    rst.Close
End Sub
Private Sub GetZGT()
'随机抽取主观题
    Dim rst As ADODB.Recordset
    Dim flag As Boolean
    Dim index1 As Integer
    Dim index2 As Integer
    Dim tempid As Integer
    Dim temp As Integer
    Dim sum As Integer                          '保存题库中的题目总数量
    Dim RandNo(1 To 5) As String                '保存考生的5道主观题的随机序列号
    '初始化数组
    For index1 = 1 To 5
        RandNo(index1) = "-1"
    Next index1
    
    '得到主观题题号信息
    SQL = " Select 考题号,答案 from 主观题信息表 order by 考题号 "
    Set rst = SelectSQL(SQL, msg)
    sum = rst.RecordCount                       '得到题库中题目总数量
    
    '取得5道主观题的随机序列号
    For index1 = 1 To 5
        '保证所有的序号不能重复存在
        Do While True
            Randomize                           '随机数种子
            tempid = Int(Rnd() * (sum - 1)) + 1
            flag = True
            For index2 = 1 To index1
                If tempid = RandNo(index2) Then '如果取得序列号和前面的相同
                     flag = False
                     Exit For
                End If
            Next index2
            If flag = True Then Exit Do
        Loop
        RandNo(index1) = tempid
    Next index1
    
    '对随机序号进行排序
    For index1 = 1 To 4
            tempid = index1
            For index2 = index1 + 1 To 5
                If CInt(Trim(RandNo(index2))) < CInt(Trim(RandNo(tempid))) Then
                     tempid = index2
                End If
            Next index2
            temp = RandNo(index1)
            RandNo(index1) = RandNo(tempid)
            RandNo(tempid) = temp
    Next index1
    
    '将得到的主观题号写入考生主观题作答表中
    index1 = 1
    index2 = 1
    rst.MoveFirst
    Do While Not rst.EOF
        If index1 = RandNo(index2) Then         '如果当前序列号与主观题信息表中的记录序列号相等
           '插入主观题
           SQL = "insert into 考生主观题作答表(考生号,考题号,答案)"
           SQL = SQL & "values('" & Trim(UserID) & "','" & Trim(rst.Fields("考题号")) & "','')"
           Call ExecuteSQL(SQL, msg)
           ZGTNo(index2) = rst.Fields("考题号") '将得到的考题号保存在数组中
           index2 = index2 + 1
        End If
        If index2 > 5 Then Exit Do              '插入过程完成
        rst.MoveNext
        index1 = index1 + 1
    Loop
    rst.Close
End Sub
Private Sub setComboKGT()
'设置客观题ComboBox中的值
    Dim index1 As Integer
    Dim rst As ADODB.Recordset
    Dim str As String
    '清空ComboBox
    CboGKT(0).Clear
    CboGKT(1).Clear
    
    '把考题号添加至ComboBox
    For index1 = 1 To 10
        str = "第 " & index1 & " 道题"
        SQL = " Select * from 客观题临时表 where 考生号='" & Trim(UserID)
        SQL = SQL & "' and 考题号='" & Trim(KGTNo(index1)) & "'"
        Set rst = SelectSQL(SQL, msg)
        If Trim(rst.Fields("考生做答")) = "" Then   '将没有作答的题号添加到未答客观题
            CboGKT(0).AddItem str
        Else                                        '将作答完的题号添加到已答客观题
            CboGKT(1).AddItem str
        End If
    Next index1
    If CboGKT(0).ListCount > 0 Then                 '如果ComboBox中存在数据
        CboGKT(0).listindex = 0
    End If
    If CboGKT(1).ListCount > 0 Then                 '如果ComboBox中存在数据
        CboGKT(1).listindex = 0
    End If
End Sub
Private Sub setComboZGT()
'设置主观题ComboBox中的值
    Dim index1 As Integer
    Dim rst As ADODB.Recordset
    Dim str As String
    '清空ComboBox
    CboZGT(0).Clear
    CboZGT(1).Clear
    
    '把考题号添加至ComboBox
    For index1 = 1 To 5
        str = "第 " & index1 & " 道题"
        SQL = " Select * from 考生主观题作答表 where 考生号='" & Trim(UserID)
        SQL = SQL & "' and 考题号='" & Trim(ZGTNo(index1)) & "'"
        Set rst = SelectSQL(SQL, msg)
        If Trim(rst.Fields("答案")) = "" Then       '将没有作答的题号添加到未答主观题
            CboZGT(0).AddItem str
        Else                                        '将作答完的题号添加到已答主观题
            CboZGT(1).AddItem str
        End If
    Next index1
    If CboZGT(0).ListCount > 0 Then                 '如果ComboBox中存在数据
        CboZGT(0).listindex = 0
    End If
    If CboZGT(1).ListCount > 0 Then                 '如果ComboBox中存在数据
        CboZGT(1).listindex = 0
    End If
End Sub
Private Sub CboGKT_Click(Index As Integer)
'在控件中显示数据
    Dim ms As ADODB.Recordset
    Dim index1 As Integer
    Dim listindex As Integer
    '清空Option1
    For index1 = 0 To 3
        Option1(index1).Value = False
    Next index1
    '得到考题号
    listindex = CInt(Trim(Mid(Trim(CboGKT(Index).Text), 3, 2)))
    colValue = Trim(KGTNo(listindex))
    '查询考题
    SQL = " Select 考题号,题目内容,A选项,B选项,C选项,D选项 from 客观题信息表 "
    SQL = SQL & " where 考题号='" & colValue & "'"
    Set ms = SelectSQL(SQL, msg)
    '显示题目
    txtkqt.Text = ms.Fields("题目内容")
    For index1 = 0 To 3
        txtAnswer(index1).Text = ms.Fields(index1 + 2)
    Next index1
    
    '如果是选择已作答客观题，需显示考生所作答案
    SQL = " Select * from 客观题临时表 where 考生号='" & Trim(UserID) & "'"
    Set rs = SelectSQL(SQL, msg)
    If Index = 1 And CboGKT(1).ListCount <> 0 Then
        '定位与当前选择的考题
        rs.Find ("考题号='" & colValue & "'")
        For index1 = 0 To 3
            If Trim(Option1(index1).Caption) = Trim(rs.Fields("考生做答")) Then
                Option1(index1).Value = True
            End If
        Next index1
    End If
End Sub
Private Sub CboZGT_Click(Index As Integer)
'在控件中显示数据
    Dim ms As ADODB.Recordset
    Dim index1 As Integer
    Dim listindex As Integer
    
    txtKaoAnswer.Text = ""                      '清空答案text
    '得到考题号
    listindex = CInt(Trim(Mid(Trim(CboZGT(Index).Text), 3, 2)))
    colValue = Trim(ZGTNo(listindex))
    '查询考题
    SQL = " Select 考题号,题目内容 from 主观题信息表 "
    SQL = SQL & " where 考题号='" & colValue & "'"
    Set ms = SelectSQL(SQL, msg)
    txtzgt.Text = ms.Fields("题目内容")         '显示题目
   
    '如果是选择已作答的主观题，需显示考生所作答案
    SQL = " Select * from 考生主观题作答表 where 考生号='" & Trim(UserID) & "'"
    Set rs = SelectSQL(SQL, msg)
    If Index = 1 And CboZGT(1).ListCount <> 0 Then
        '定位与当前选择的考题
        rs.Find ("考题号='" & colValue & "'")
        txtKaoAnswer.Text = rs.Fields("答案")
    End If
End Sub
Private Sub CmdOK_Click()
'作答客观题，每做完一道客观题，必须单击此按钮，以记录考生的答案
    For Index = 0 To 3
        If Option1(Index).Value = True Then
            '将考生作答的答案写入客观题临时表
            SQL = "Update 客观题临时表 set 考生做答='" & Trim(Option1(Index).Caption)
            SQL = SQL & "' where 考生号='" & Trim(UserID) & "'and 考题号='" & colValue & "'"
            Call ExecuteSQL(SQL, msg)
            Call setComboKGT                    '改变客观题ComboBox中的值
            Exit Sub
        End If
    Next Index
    If Index > 3 Then MsgBox ("请选择答案！")
End Sub
Private Sub CmdQuding_Click()
'作答主观题，每做完一道主观题，必须单击此按钮，以记录考生的答案
    '将考生作答的答案写入考生主观题作答表
    SQL = "Update 考生主观题作答表 set 答案='" & txtKaoAnswer.Text
    SQL = SQL & "' where 考生号='" & Trim(UserID) & "'and 考题号='" & colValue & "'"
    Call ExecuteSQL(SQL, msg)
    Call setComboZGT                            '改变主观题ComboBox中的值
End Sub
Private Sub Timer1_Timer()
'计算时间
    time = time + 1
    If time = 60 Then
        Label4.Caption = Val(Trim(Label4.Caption)) - 1
        time = 0
    End If
End Sub
Private Sub CmdJiaoJuan_Click()
'交卷操作
    Dim rst As ADODB.Recordset
    Dim records As Double
    '提示是否真的交卷
    If MsgBox("一旦交卷就不能再次进入，你确定要进行交卷吗？", vbYesNo + vbExclamation, "提示") Then
        '查询考生客观题的分
        SQL = " Select 标准答案,考生做答 from 客观题临时表 where 考生号='" & Trim(UserID) & "'"
        Set rst = SelectSQL(SQL, msg)
        If rst.RecordCount <> 0 Then            '记录考生客观题的分
            rst.MoveFirst
            Do Until rst.EOF
                '计算考生客观题得分
                If Trim(rst.Fields("标准答案")) = Trim(rst.Fields("考生做答")) Then
                    records = records + 5
                End If
                rst.MoveNext
            Loop
            '将考生客观题得分、交卷时间写入成绩信息表
            SQL = " update 成绩信息表 set 交卷时间='" & Now
            SQL = SQL & "',客观题得分='" & records & "' where 考生号='" & Trim(UserID) & "'"
            Call ExecuteSQL(SQL, msg)
            '删除客观题临时表中的记录
            SQL = " delete  from 客观题临时表 where 考生号='" & Trim(UserID) & "'"
            Call ExecuteSQL(SQL, msg)
        End If
        MsgBox "交卷成功，你可以离开！"
        Unload Me
        B考生考试管理.Enabled = True
    End If
End Sub