<!--GradeTest.asp-->
<!--Copyright (c) 1998 by Charles W. McNichols.  All rights reserved.-->
<!--Grade test from test bank stored as Access database-->
<HTML>
<HEAD>
<TITLE>Test Grader</TITLE>
</HEAD>
<BODY BGCOLOR="#ffffff">

<% Call Main %>

<SCRIPT RUNAT="SERVER" LANGUAGE="VBSCRIPT">

Sub Main

    Dim i
    Dim tempStr
    Dim tempChar
    Dim QCount      'count of questions submitted for grading
    Dim QNumber     'current question number
    Dim QFormat     'leading blanks for question number
    Dim QList       'for IN list in SQL statement
    Dim formEl      'form elements
    Dim choiceFlag  'flags student response choice
    Dim Answers()   'returned response name values
    Dim SQLCommand  'build SQL command for test retrieval here
    Dim openItalic  'italic tag or null
    Dim closeItalic
    Dim nCorrect    'number of correct answers
    Dim ExplanationText 'temp storage of correct answer explanation
    Dim answerSet   'string of responses for multiple-multiple choice
    Dim gradeFlag   'used to grade multiple-multiple choice
    Dim moveFlag    'force row advance in defective test bank
    Dim correctFlag   'flag set if question was answered correctly
    Dim controlExplanation  'condition for showing question explanation
    Dim errorFont   'font tag for color-coding erroneous reponses

    '[1] Get the flag that controls including explanations
    controlExplanation = UCase(Request.Form("Explanation"))

    'Test bank ODBC DSN passed as form variable from BuildTest.asp
    TestBank = Request.form("TestBankDSN")

    'Setup an alternate color to call attention to wrong answers
    errorFont = "<FONT COLOR=Red>"  'use color name or string e.g. #ff0000

    nCorrect = 0
    QCount = 0

    '[2] EXTRACT FORM ELEMENTS TO BUILD ITEM LIST FOR SQL "IN(,,)"
    For Each formEl in Request.Form
        tempStr = UCase(formEl)
        If tempStr <> "EXPLANATION" And tempStr <> "TestBankDSN" Then
            ReDim Preserve Answers(QCount)
            Answers(QCount) = formEl
            QCount = QCount + 1
        End If
    Next

    QList = ""
    For i = QCount - 1 to 0 Step -1
        If Len(QList) > 0 Then
            QList = QList & ","
        End If
        QList = QList & "'" & Answers(i) & "'"
    Next

    Response.Write("<P><B>Your responses are " & _ 
        "marked with asterisks (*).  Correct responses are " & _
        "displayed in <I>italics</I>.</B></P>" & vbNewLine)

    'OPEN TEST BANK DB AND EXTRACT QUESTIONS AND CORRECT RESPONSE
    'First, build the SQL retrieval statement
    SQLCommand = "SELECT Question.Index,MatchIndex,QType,QuestionText," & _
        "CorrectResponse,Explanation,Response,ResponseText " & _
        "FROM question LEFT OUTER JOIN answer ON " & _
        "question.index=answer.index WHERE question.Index " & _
        "IN  (" & QList & ") ORDER BY Question.Index,Response"

    Set objConn = Server.CreateObject("ADODB.Connection")
    objConn.Open TestBank   'ODBC DSN for test bank

    Set objRS = objConn.Execute(SQLCommand) 'execute SQL to get question data

    '[3] DISPLAY THE QUIZ WITH ANSWERS AND GRADE IT
    QNumber = 1
    Do While Not objRS.EOF  'loop through test bank recordset
        moveFlag = False    'forces row advance in defective test bank
        QFormat = ""
        If QNumber < 100 Then
            QFormat = "&nbsp;&nbsp;"
            If QNumber < 10 Then
                QFormat = QFormat & "&nbsp;&nbsp;"
            End If
        End If
        'Each question is displayed as a table
        Select Case objRS("QType")
            Case 1  'True/False
                correctFlag = False   'flag correct response for explanation
                Response.Write("<TABLE CELLPADDING=""0"" CELLSPACING=""0"">")
                'Output the question stem
                Response.Write("<TR><TD VALIGN=""TOP"">" & QFormat & _
                    QNumber & ". <TD>" & objRS("QuestionText"))
                QNumber = QNumber + 1   'next question number
                'Then the response set
                tempIndex = objRS("Index")
                If Request.Form(objRS("Index")) = _
                    UCase(objRS("CorrectResponse")) Then
                    nCorrect = nCorrect + 1 'grading
                    correctFlag = True
                End If
                For i = 1 To 2  'True and False responses (A and B)
                    'Flag selected answer with an *
                    tempChar = Chr(64+i)
                    If tempChar = Request.Form(objRS("Index")) Then
                        choiceFlag = "&nbsp;&nbsp;&nbsp;&nbsp;*"
                    Else
                        choiceFlag = " "
                    End If
                    If tempChar = UCase(objRS("CorrectResponse")) Then
                        openItalic = "<I>"  'flag correct answer
                        closeItalic = "</I>"
                    Else
                        openItalic = ""
                        closeItalic = ""
                    End If
                    'Color code incorrect answer
                    If openItalic = "" and choiceFlag <> " " Then
                        choiceFlag = errorFont & choiceFlag & "</FONT>"
                    End If
                    Response.Write("<TR><TD VALIGN=""TOP"">" & choiceFlag & _
                        "<TD><TABLE CELLPADDING=""0"" CELLSPACING=""0"">" & _
                        "<TR><TD VALIGN=""TOP"">" & tempChar & _
                        ". <TD>" & "<TD VALIGN=""TOP"">" & openItalic & _
                        Mid("True False",(i-1)*5+1,5) & closeItalic & _
                        "</TABLE>")
                Next
                'Output question explanation
                Call WriteExpl(controlExplanation, correctFlag, _
                    objRS("Explanation"))
                Response.Write("</TABLE>")
                Response.Write("<BR>" & vbNewLine)
                objRs.MoveNext  'there are no responses stored for T/F
                moveFlag = True
            Case 2  'Multiple choice
                correctFlag = False   'flag correct response for explanation
                ExplanationText = objRS("Explanation")  'need after responses
                Response.Write("<TABLE CELLPADDING=""0"" CELLSPACING=""0"">")
                'Output the question stem
                Response.Write("<TR><TD VALIGN=""TOP"">" & QFormat & _
                    QNumber & ". <TD COLSPAN=""2"">" & objRS("QuestionText"))
                QNumber = QNumber + 1   'next question number
                'Then the response set
                tempIndex = objRS("Index")
                If Request.Form(objRS("Index")) = _
                    UCase(objRS("CorrectResponse")) Then
                    nCorrect = nCorrect + 1 'grading
                    correctFlag = True
                End If
                i = 1
                Do While Not objRS.EOF
                    tempChar = Chr(64+i)
                    If objRS("Index") <> tempIndex Then
                        Exit Do
                    End If
                    'Flag selected answer with an *
                    If tempChar = UCase(Request.Form(objRS("Index"))) Then
                        choiceFlag = "&nbsp;&nbsp;&nbsp;&nbsp;*"
                    Else
                        choiceFlag = " "
                    End If
                    If tempChar = UCase(objRS("CorrectResponse")) Then
                        openItalic = "<I>"      'italicize correct answer
                        closeItalic = "</I>"
                    Else
                        openItalic = ""
                        closeItalic = ""
                    End If
                    'Color code incorrect answer
                    If openItalic = "" and choiceFlag <> " " Then
                        choiceFlag = errorFont & choiceFlag & "</FONT>"
                    End If
                    Response.Write("<TR><TD VALIGN=""TOP"">" & choiceFlag & _
                        "<TD><TABLE CELLPADDING=""0"" CELLSPACING=""0"">" & _
                        "<TR><TD VALIGN=""TOP"">" & _
                        objRS("Response") & ". </TD><TD ALIGN=""TOP"">" & _
                        openItalic & objRS("ResponseText") & _
                        closeItalic & "</TABLE>")
                    i = i + 1
                    objRs.MoveNext
                    moveFlag = True
                Loop    'multiple choice response loop
                'Output question explanation
                Call WriteExpl(controlExplanation, correctFlag, _
                    ExplanationText)
                Response.Write("</TABLE>")
                Response.Write("<BR>" & vbNewLine)
            Case 3  'Multiple-multiple choice
                correctFlag = False   'flag correct response for explanation
                gradeFlag = True    'true till first mistake found
                ExplanationText = objRS("Explanation")  'need after responses
                'Get all of the responses provided for this question
                answerSet = ""
                For i = 1 To Request.Form(objRS("Index")).Count
                    answerSet = answerSet & _
                    UCase(Request.Form(objRS("Index")(i)))
                Next
                Response.Write("<TABLE CELLPADDING=""0"" CELLSPACING=""0"">")
                'Output the question stem
                Response.Write("<TR><TD VALIGN=""TOP"">" & QFormat & _
                    QNumber & ". <TD COLSPAN=""2"">" & _
                    objRS("QuestionText"))
                QNumber = QNumber + 1   'next question number
                'Then the response set
                tempIndex = objRS("Index")
                i = 1
                Do While Not objRS.EOF
                    tempChar = Chr(64+i)
                    If objRS("Index") <> tempIndex Then
                        Exit Do
                    End If
                    'Flag all selected responses with an *
                    If InStr(answerSet, tempChar) > 0 Then
                        choiceFlag = "&nbsp;&nbsp;&nbsp;&nbsp;*"
                    Else
                        choiceFlag = " "
                    End If
                    'If answer is wrong, set gradeFlag to False
                    tempStr = UCase(objRS("CorrectResponse"))
                    If Instr(tempStr, tempChar) > 0 And _
                        Instr(answerSet, tempChar) = 0 Or _
                        Instr(tempStr, tempChar) = 0 And _
                        Instr(answerSet, tempChar) > 0 Then
                        gradeFlag = False
                    End If
                    'Italicize if this response should have been checked
                    If InStr(tempStr, tempChar) > 0 Then
                        openItalic = "<I>"
                        closeItalic = "</I>"
                    Else
                        openItalic = ""
                        closeItalic = ""
                    End If
                    'Color code incorrect answers
                    If openItalic = "" and choiceFlag <> " " Then
                        choiceFlag = errorFont & choiceFlag & "</FONT>"
                    ElseIf openItalic <> "" and choiceFlag = " " Then
                        choiceFlag = errorFont & _
                            "&nbsp;&nbsp;&nbsp;&nbsp;x" & "</FONT>"
                    End If
                    Response.Write("<TR><TD VALIGN=""TOP"">" & choiceFlag & _
                        "<TD><TABLE CELLPADDING=""0"" CELLSPACING=""0"">" & _
                        "<TR><TD VALIGN=""TOP"">" & objRS("Response") & _
                        ". <TD ALIGN=""TOP"">" & openItalic & _
                        objRS("ResponseText") & closeItalic & "</TABLE>")
                    i = i + 1
                    objRs.MoveNext
                    moveFlag = True
                Loop    'multiple-multiple choice response loop
                'If all correct answers were selected, count as correct
                If gradeFlag Then
                    nCorrect = nCorrect + 1 'grading
                    correctFlag = True
                End If
                'Output question explanation
                Call WriteExpl(controlExplanation, correctFlag, _
                    ExplanationText)
                Response.Write("</TABLE>")
                Response.Write("<BR>" & vbNewLine)
            Case 4  'Matching
                'Output the matching question stem of 1st question (no number)
                Response.Write(objRS("QuestionText"))
                'Then the response set. Only the 1st question has these
                Response.Write("<TABLE CELLSPACING=""0"" CELLPADDING=""0"">")
                tempIndex = objRS("Index")
                Do While Not objRS.EOF
                    'Possible responses may have blank or Index value in
                    'MatchIndex -- either condition yields True below
                    If objRS("MatchIndex") <> objRS("Index") Then
                        Exit Do
                    End If
                    Response.Write("<TR><TD>" & QFormat & _
                        "&nbsp;&nbsp;&nbsp;<TD VALIGN=""TOP"">" & _
                        objRS("Response") & ". <TD>" & objRS("ResponseText"))
                    objRS.MoveNext
                    moveFlag = True
                Loop    'response loop - values to match
                Response.Write("</TABLE><TABLE>")
                'Now output the questions for the match
                Do While Not objRS.EOF
                    correctFlag = False   'flag correct response
                    'Test below required because MatchIndex could be null
                    If objRS("MatchIndex") <> tempIndex Or _
                        objRS("QType") <> 4  Then    'out of matching
                        Exit Do
                    End If
                    If UCase(Request.Form(objRS("Index"))) = _
                        UCase(objRS("CorrectResponse")) Then
                        nCorrect = nCorrect + 1 'grading
                        correctFlag = True
                        tempStr = "<FONT>"  'dummy
                    Else
                        tempStr = errorFont 'color code error
                    End If
                    Response.Write("<TR><TD VALIGN=""TOP"">" & QFormat _
                        & QNumber & ". <TD VALIGN=""TOP"">" & "[" & _
                        tempStr & "*</FONT>" & _
                        UCase(Request.Form(objRS("Index"))) & "" & _
                        "|<I>" & objRS("CorrectResponse") & _
                        "</I>]<TD>" & objRS("QuestionText"))
                    'Output question explanation
                    Call WriteExpl(controlExplanation, correctFlag, _
                        objRS("Explanation"))
                    QNumber = QNumber + 1   'next question number
                    objRS.MoveNext
                    moveFlag = True
                Loop
                Response.Write("</TABLE>")
                Response.Write("<BR>" & vbNewLine)
            Case Else
                objRS.MoveNext  'can't process question type - error
                moveFlag = True
        End Select
        If Not MoveFlag Then    'force row advance in defective test bank
            objRS.MoveNext
        End If
    Loop    'end of loop through recordset

    '[4] CLOSE DB AND OUTPUT GRADE
	objRS.Close
	objConn.Close

    Response.Write("<CENTER><H3>You scored " & nCorrect & _
        " correct out of " &  QNumber - 1 & " questions answered or " & _
        ROUND(100*nCorrect/(QNumber-1), 1) & "%</CENTER>")

End Sub 'Main

'WRITE EXPLANATION AFTER EACH QUESTION
Function WriteExpl(controlExpl, correctFl, Expltext)
    If (controlExpl = "ALWAYS" Or controlExpl = "WRONG" And _
        correctFl = False) And Len(ExplText) > 0 Then
        Response.Write("<TR><TD><TD COLSPAN=2>" & ExplText)
    End If
End Function    'WriteExpl()

</SCRIPT>

</BODY>
</HTML>