www.pudn.com > stu_rag.rar > QestionPaper.cls, change:2003-03-16,size:13103b


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 
    DataEnv.rsQstPaper.Filter = "QuestionType = 1 or QuestionType = 5" 
    While Not DataEnv.rsQstPaper.EOF 
        SubScore = SubScore + DataEnv.rsQstPaper.Fields("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 
    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 
    DataEnv.rsQstPaper.Filter = "QuestionType = 1 or QuestionType = 5" 
    While Not DataEnv.rsQstPaper.EOF 
        SubScore = SubScore + DataEnv.rsQstPaper.Fields("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 
    DataEnv.rsQstPaper.Filter = "QuestionType = 2 or QuestionType = 3 Or QuestionType = 4" 
    While Not DataEnv.rsQstPaper.EOF 
        objScore = objScore + DataEnv.rsQstPaper.Fields("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 
    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) 
    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 = 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 
        DataEnv.rsQstPaper.Fields("Score") = Score 
        DataEnv.rsQstPaper.Update 
        AddQuestion = True 
    End If 
    DataEnv.rsQstPaper.Filter = "" 
    DataEnv.rsQstPaper.Close 
End Function 
 
Public Function Create() As Boolean 
    On Error Resume Next 
    If Created Then 
        Create = False 
        Exit Function 
    End If 
    DataEnv.DelQuestion 
    Dim iCount As Long 
    Dim QID As Long 
    Dim Score As Single 
     
    For iCount = 1 To FillingNum 
       QID = GetQID(1, Score) 
       AddQuestion iCount, QID, 1, Score 
    Next 
     
    For iCount = 1 To RightWrongNum 
       QID = GetQID(2, Score) 
       AddQuestion iCount + FillingNum, QID, 2, Score 
    Next 
    For iCount = 1 To SingleSelNum 
       QID = GetQID(3, Score) 
       AddQuestion iCount + FillingNum + RightWrongNum, QID, 3, Score 
    Next 
    For iCount = 1 To MultiSelNum 
       QID = GetQID(4, Score) 
       AddQuestion iCount + FillingNum + RightWrongNum + SingleSelNum, QID, 4, Score 
    Next 
    For iCount = 1 To EssayQuesNum 
       QID = GetQID(5, Score) 
       AddQuestion iCount + FillingNum + RightWrongNum + SingleSelNum + MultiSelNum, QID, 5, Score 
    Next 
    Created = True 
    Create = True 
End Function 
Public Function GetQuestionID(ByVal QSerial As Long) As Long 
    On Error Resume Next 
    DataEnv.rsQstPaper.Open 
    DataEnv.rsQstPaper.Filter = "PaperSerial = " & CStr(QSerial) 
    If DataEnv.rsQstPaper.RecordCount < 1 Then 
        GetQuestionID = 0 
    Else 
        GetQuestionID = DataEnv.rsQstPaper.Fields("QuestionID") 
    End If 
    DataEnv.rsQstPaper.Filter = "" 
    DataEnv.rsQstPaper.Close 
End Function 
 
Public Function GetQuestion(ByVal QSerial As Long) As String 
    On Error Resume Next 
    Dim dbrs As ADODB.Recordset 
    Dim QType As QuestionType 
    Dim QID As Long 
    QID = GetQuestionID(QSerial) 
    QType = GetType(QSerial) 
    Set dbrs = GetDBRS(QType) 
    dbrs.Open 
    dbrs.Filter = "QuestionID = " & CStr(QID) 
    GetQuestion = CStr(QSerial) & ". " & dbrs.Fields("Question") 
    dbrs.Filter = "" 
    dbrs.Close 
End Function 
Public Function GetChoice(ByVal QSerial As Long) As String 
    On Error Resume Next 
    Dim dbrs As ADODB.Recordset 
    Dim QType As QuestionType 
    Dim QID As Long 
    Dim S As String 
    Dim i As Byte 
    QType = GetType(QSerial) 
    If QType <> singlesel And QType <> MultiSel Then 
        GetChoice = "" 
        Exit Function 
    End If 
    QID = GetQuestionID(QSerial) 
    Set dbrs = GetDBRS(QType) 
    dbrs.Open 
    dbrs.Filter = "QuestionID = " & CStr(QID) 
    S = "" 
    For i = 1 To 3 
        S = S & dbrs.Fields("Choice" & CStr(i)) & "," 
    Next 
    S = S & dbrs.Fields("Choice4") 
    dbrs.Filter = "" 
    dbrs.Close 
    GetChoice = S 
End Function 
 
Public Function DelQuestion(ByVal PSerial As Long) As Boolean 
    On Error Resume Next 
    DataEnv.rsQstPaper.Open 
    DataEnv.rsQstPaper.Filter = "PaperSerial = " & PSerial 
    DataEnv.rsQstPaper.Delete adAffectCurrent 
    DataEnv.rsQstPaper.Filter = "" 
    DataEnv.rsQstPaper.Close 
End Function 
 
Public Sub ReportToFile(ByVal FileName As String) 
    On Error Resume Next 
    Dim txtFile As String 
    Dim iCount As Long 
    If Dir(FileName, vbNormal) <> "" Then 
        Kill FileName 
    End If 
    Open FileName For Output As #1 
    Print #1, "    Ծ    " 
    Print #1, "------------------" 
    For iCount = 1 To LastQSerial 
        txtFile = GetQuestion(iCount) 
        If txtFile <> "" Then 
            Print #1, txtFile 
        End If 
        txtFile = GetChoice(iCount) 
        If txtFile <> "" Then 
            Dim S() As String 
            S = Split(txtFile, ",") 
            Dim i As Byte 
            For i = 0 To UBound(S) 
                txtFile = Space(3) & Chr(Asc("A") + i) & "." & S(i) 
                Print #1, txtFile 
            Next 
        End If 
    Next 
Close #1 
End Sub 
 
Public Function GetType(ByVal QSerial As Long) As QuestionType 
    On Error Resume Next 
    DataEnv.rsQstPaper.Open 
    DataEnv.rsQstPaper.Filter = "PaperSerial = " & CStr(QSerial) 
    If DataEnv.rsQstPaper.RecordCount < 1 Then 
        GetType = OnErr 
    Else 
        Dim iType As Byte 
        iType = DataEnv.rsQstPaper.Fields("QuestionType") 
        GetType = iType 
    End If 
    DataEnv.rsQstPaper.Filter = "" 
    DataEnv.rsQstPaper.Close 
     
End Function 
Public Function GetQSerial(ByVal nCount As Long) As Long 
    On Error Resume Next 
    DataEnv.rsQstPaper.Open 
    If DataEnv.rsQstPaper.RecordCount < nCount Then 
        GetQSerial = 0 
    Else 
        DataEnv.rsQstPaper.Move nCount - 1, 0 
        GetQSerial = DataEnv.rsQstPaper.Fields("PaperSerial") 
    End If 
    DataEnv.rsQstPaper.Close 
End Function 
 
Public Function GetQAnswer(ByVal QSerial As Long) As String 
    Dim dbrs As ADODB.Recordset 
    Dim QType As QuestionType 
    Dim QID As Long 
    QType = GetType(QSerial) 
    QID = GetQuestionID(QSerial) 
    Set dbrs = GetDBRS(QType) 
    dbrs.Open 
    dbrs.Filter = "QuestionID = " & CStr(QID) 
    GetQAnswer = dbrs.Fields("Answer") 
    dbrs.Filter = "" 
    dbrs.Close 
End Function 
 
Public Function GetUserAnswer(ByVal QSerial As Long) As String 
    Dim UserAnswer 
    DataEnv.rsQstPaper.Open 
    DataEnv.rsQstPaper.Filter = "PaperSerial =" & CStr(QSerial) 
    If DataEnv.rsQstPaper.RecordCount < 1 Then 
        GetUserAnswer = "" 
    Else 
        UserAnswer = DataEnv.rsQstPaper.Fields("UserAnswer") 
        If IsNull(UserAnswer) Then 
            GetUserAnswer = "" 
        Else 
            GetUserAnswer = DataEnv.rsQstPaper.Fields("UserAnswer") 
        End If 
    End If 
    DataEnv.rsQstPaper.Close 
End Function 
 
Public Sub Check(ByVal QSerial As Long) 
    On Error Resume Next 
    Dim uAnswer As String 
    Dim qAnswer As String 
    uAnswer = GetUserAnswer(QSerial) 
    qAnswer = GetQAnswer(QSerial) 
    DataEnv.rsQstPaper.Open 
    DataEnv.rsQstPaper.Filter = "PaperSerial = " & CStr(QSerial) 
    If uAnswer = qAnswer Then 
        DataEnv.rsQstPaper.Fields("Commence") = DataEnv.rsQstPaper.Fields("Score") 
    Else 
        DataEnv.rsQstPaper.Fields("Commence") = 0 
    End If 
    DataEnv.rsQstPaper.Close 
End Sub 
 
Public Sub SetAnswer(ByVal iCount As Long, ByVal Answer As String) 
    On Error Resume Next 
    DataEnv.rsQstPaper.Open 
    DataEnv.rsQstPaper.Move iCount - 1, 0 
    DataEnv.rsQstPaper.Fields("UserAnswer") = Answer 
    DataEnv.rsQstPaper.Update 
    DataEnv.rsQstPaper.Close 
End Sub