qestionpaper.cls

Visual Basic管理信息系统开发 学生考试系统(源代码)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "QestionPaper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Private mvarFillingNum As Long
Private mvarRightWrongNum As Long
Private mvarSingleSelNum As Long
Private mvarMultiSelNum As Long
Private mvarEssayQNum As Long
Private mvarCreated As Boolean
Private mvarAnswered As Boolean
Private mvarChecked As Boolean

Public Property Get SubjectiveScore() As Single
    On Error Resume Next
    Dim SubScore As Single
    SubScore = 0
    DataEnv.rsQstPaper.Open      '打开rsQstPaper数据集
    DataEnv.rsQstPaper.Filter = "QuestionType = 1 or QuestionType = 5"    '设置数据集过滤器
    While Not DataEnv.rsQstPaper.EOF
        SubScore = SubScore + DataEnv.rsQstPaper.Fields("Commence")   '获取Commence字段值
        DataEnv.rsQstPaper.MoveNext
    Wend
    DataEnv.rsQstPaper.Filter = ""         '清空数据集过滤器
    DataEnv.rsQstPaper.Close               '关闭数据集
    SubjectiveScore = SubScore
End Property

Public Property Get ObjectiveScore() As Single
    On Error Resume Next
    Dim objScore As Single
    objScore = 0
    DataEnv.rsQstPaper.Open
    '数据集过滤条件试题类型为2或3或4
    DataEnv.rsQstPaper.Filter = "QuestionType = 2 or QuestionType = 3 Or QuestionType = 4"
    While Not DataEnv.rsQstPaper.EOF
        objScore = objScore + DataEnv.rsQstPaper.Fields("Commence")
        DataEnv.rsQstPaper.MoveNext
    Wend
    DataEnv.rsQstPaper.Filter = ""
    DataEnv.rsQstPaper.Close
    ObjectiveScore = objScore
End Property

Public Property Get SScore() As Single
    On Error Resume Next
    Dim SubScore As Single
    SubScore = 0
    DataEnv.rsQstPaper.Open
    '数据集过滤条件试题类型为1或5
    DataEnv.rsQstPaper.Filter = "QuestionType = 1 or QuestionType = 5"
    While Not DataEnv.rsQstPaper.EOF
        SubScore = SubScore + DataEnv.rsQstPaper.Fields("Score")  '获取Score的字段值
        DataEnv.rsQstPaper.MoveNext
    Wend
    DataEnv.rsQstPaper.Filter = ""
    DataEnv.rsQstPaper.Close
    SScore = SubScore

End Property

Public Property Get OScore() As Single
    On Error Resume Next
    Dim objScore As Single
    objScore = 0
    DataEnv.rsQstPaper.Open
    '数据集过滤条件试题类型为2或3或4
    DataEnv.rsQstPaper.Filter = "QuestionType = 2 or QuestionType = 3 Or QuestionType = 4"
    While Not DataEnv.rsQstPaper.EOF
        objScore = objScore + DataEnv.rsQstPaper.Fields("Score")   '获取Score的字段值
        DataEnv.rsQstPaper.MoveNext
    Wend
    DataEnv.rsQstPaper.Filter = ""
    DataEnv.rsQstPaper.Close
    OScore = objScore
End Property

Public Property Get QuestionNum() As Long
    DataEnv.rsQstPaper.Open
    QuestionNum = DataEnv.rsQstPaper.RecordCount    '获取rsQstPaper数据集的记录数目
    DataEnv.rsQstPaper.Close
End Property

Public Property Get LastQSerial() As Long
    LastQSerial = GetQSerial(QuestionNum)  '获取最后一条记录的试卷编号
End Property

Public Property Get FirstQSerial() As Long
    FirstQSerial = GetQSerial(1)          '获取开始记录的试卷编号
End Property
'定义属性表示填空题数
Public Property Let FillingNum(ByVal vData As Integer)
    mvarFillingNum = vData
End Property

Public Property Get FillingNum() As Integer
    FillingNum = mvarFillingNum
End Property
'定义属性表示判断题数
Public Property Let RightWrongNum(ByVal vData As Integer)
    mvarRightWrongNum = vData
End Property

Public Property Get RightWrongNum() As Integer
    RightWrongNum = mvarRightWrongNum
End Property
'定义属性表示单选题数
Public Property Let SingleSelNum(ByVal vData As Integer)
    mvarSingleSelNum = vData
End Property

Public Property Get SingleSelNum() As Integer
    SingleSelNum = mvarSingleSelNum
End Property
'定义属性表示多选题数
Public Property Let MultiSelNum(ByVal vData As Integer)
    mvarMultiSelNum = vData
End Property

Public Property Get MultiSelNum() As Integer
    MultiSelNum = mvarMultiSelNum
End Property
'定义属性表示问答题数
Public Property Let EssayQuesNum(ByVal vData As Integer)
    mvarEssayQNum = vData
End Property

Public Property Get EssayQuesNum() As Integer
    EssayQuesNum = mvarEssayQNum
End Property
'定义属性表示试卷是否需要进行回答
Public Property Let Answered(ByVal vData As Boolean)
    mvarAnswered = vData
End Property

Public Property Get Answered() As Boolean
    Answered = mvarAnswered
End Property
'定义属性表示试卷是否需要创建
Public Property Let Created(ByVal vData As Boolean)
    mvarCreated = vData
End Property

Public Property Get Created() As Boolean
    Created = mvarCreated
End Property
'定义属性表示试卷是否需要评阅
Public Property Let Checked(ByVal vData As Boolean)
    mvarChecked = vData
End Property

Public Property Get Checked() As Boolean
    Checked = mvarChecked
End Property

Private Function GetDBRS(ByVal QType As QuestionType) As ADODB.Recordset
    On Error Resume Next
    Select Case QType                '根据试题类型获取数据集
      Case Blacks
          Set GetDBRS = DataEnv.rsFillingQ
      Case RightOrWrong
          Set GetDBRS = DataEnv.rsRorWQ
      Case singlesel
          Set GetDBRS = DataEnv.rsSingleSelQ
      Case MultiSel
          Set GetDBRS = DataEnv.rsMultiSelQ
      Case EssayQuestion
          Set GetDBRS = DataEnv.rsEssayQ
      Case Else
          Set GetDBRS = Nothing
    End Select
End Function
Private Function GetQID(ByVal QType As QuestionType, ByRef Score As Single) As Long
    On Error Resume Next
    Dim dbrs As ADODB.Recordset
    Set dbrs = GetDBRS(QType)         '获取题型为qType的数据集
    Dim QstID As Long
    QstID = 0
    dbrs.Open                         '打开题库数据集
    DataEnv.rsQstPaper.Open           '打开试卷数据集
    While (QstID = 0)                 '获取问题号,如果试卷中已有该号,则重新获取。
        Randomize
        QstID = Int(Rnd * (dbrs.RecordCount - 1))
        dbrs.Move QstID, adBookmarkFirst    '游标移至第QstID条记录
        QstID = dbrs.Fields("QuestionID")   '获取试题编号
        Score = dbrs.Fields("Score")        '获取该试题的得分
        DataEnv.rsQstPaper.Filter = "QuestionID = " & QstID & " And QuestionType =" & QType
        If DataEnv.rsQstPaper.RecordCount > 0 Then
            QstID = 0                      '如果试卷中已经有该题，则将编号重置
        End If
    Wend
    DataEnv.rsQstPaper.Close               '关闭数据库
    dbrs.Close
    GetQID = QstID                         '函数返回题目编号
End Function

Public Function AddQuestion(ByVal iCount As Long, ByVal QID As Long, ByVal QType As QuestionType, ByVal Score As Single) As Boolean
    On Error Resume Next
    DataEnv.rsQstPaper.Open
    DataEnv.rsQstPaper.Filter = "QuestionID = " & CStr(QID) & " and QuestionType = " & CStr(QType)
    If DataEnv.rsQstPaper.RecordCount > 0 Then
        AddQuestion = False  '若该题目编号与类型的记录已经存在于试卷中，则添加失败
    Else
        DataEnv.rsQstPaper.Filter = ""
        DataEnv.rsQstPaper.AddNew   '向试卷中添加试题
        DataEnv.rsQstPaper.Fields("PaperSerial") = iCount
        DataEnv.rsQstPaper.Fields("QuestionID") = QID
        DataEnv.rsQstPaper.Fields("QuestionType") = QType