<!--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 = " "
If QNumber < 10 Then
QFormat = QFormat & " "
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 = " *"
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 = " *"
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 = " *"
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 & _
" 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 & _
" <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>