9-3.asp

同样是一个在ASP.NET+SQL基础环境下开发的网上BBS系统

<%
'将得到的整数转换成字符字函数
Function GetLetterFromAnswerNumber(iInput)
Dim strTemp
	Select Case iInput
		Case 0
			strTemp = "A"
		Case 1
			strTemp = "B"
		Case 2
			strTemp = "C"
		Case 3
			strTemp = "D"
		Case 4
			strTemp = "E"
		Case 5
			strTemp = "F"
	End Select
GetLetterFromAnswerNumber = strTemp
End Function

'下面为取出答案的字函数
'为了简化，将得到的字符串划分为几个部分 
Function GetAnswerFromAnswerString(iQuestionNumber, strAnswers)
Dim strTemp
Dim iOffset
	'使用InStrRev函数来分割一个字符串
	iOffset = InStrRev(strAnswers, "|" & iQuestionNumber & "|", -1, 1)
	
	'取出答案
	strTemp = Mid(strAnswers, iOffset + Len("|" & iQuestionNumber & "|"), 1)

	'将答案转化为大写字符
GetAnswerFromAnswerString = UCase(CStr(strTemp))
End Function
%>

<%
'在本程序中，可以使用数据库或者直接写具体的题目等内容，在本例中如果使用为数据
'库，则数据库名为quiz.mdb 
'如果使用数据库则设定为true，否则为false

Const USE_DB_FOR_INFO = False

'下面的定义是为使用数据库而定义
'如果不使用数据库则没有关系
Dim DB_CONN_STRING
DB_CONN_STRING = "DBQ=" & Server.MapPath("quiz.mdb") & ";"
DB_CONN_STRING = DB_CONN_STRING & "Driver={Microsoft Access Driver (*.mdb)};"
DB_CONN_STRING = DB_CONN_STRING & "DriverId=25;FIL=MS Access;"
'为了能从一个数据库中进行多个测试，则定义QUIZ_ID来把它们分开
Const QUIZ_ID = 1

'定义其它变量
Dim cnnQuiz, rsQuiz     '定义数据库变量

Dim I                    '循环变量
Dim iNumberOfQuestions    '问题号
Dim iQuestionNumber       '当前的题号
Dim strQuestionText        '当前问题的内容
Dim aAnswers             '问题的各个选项
                      
Dim strAnswers           '存储问题号和答案
                        '利用“|”来分开
Dim iScore               '最后的得分
Dim bAbort            
Dim strResults          

bAbort = False            '如果在正常情况下退出，则设为false

'如果是第一次进入，则进行初始化设置 
'检查问题号是否为空.
If Request.QueryString("qid") = "" Then
	' 获取或者设置数据库信息
	If USE_DB_FOR_INFO Then
		'使用数据库
		'建立连接
		Set cnnQuiz = Server.CreateObject("ADODB.Connection")
		cnnQuiz.Open DB_CONN_STRING
		
		'建立recordset对象
		Set rsQuiz = Server.CreateObject("ADODB.Recordset")
		rsQuiz.Open "SELECT * FROM quizzes WHERE quiz_id=" & QUIZ_ID & ";", cnnQuiz
		
		'自定义session属性
		Session("QuizName") = CStr(rsQuiz.Fields("quiz_name").Value)
		Session("NumberOfQuestions") = CInt(rsQuiz.Fields("number_of_questions").Value)
		Session("PercentageToPass") = CInt(rsQuiz.Fields("percentage_to_pass").Value)
		
		'关闭并释放数据库对象
		rsQuiz.Close
		Set rsQuiz = Nothing
		cnnQuiz.Close
		Set cnnQuiz = Nothing
	Else
	
		'如果不是使用数据库
		Session("QuizName") = "ASP测试"
		Session("NumberOfQuestions") = 10
		Session("PercentageToPass") = 70
	End If
	'设置初始的问题号和返回的内容AnswerString
	iQuestionNumber = 1
	Session("AnswerString") = "|"
Else
	
'确认有一个session对象
	If Session("AnswerString") = "" Then
		Response.Write "对不起，你已经花了太长时间，可以单击"
		Response.Write "<A HREF=""" & Request.ServerVariables("URL") & """>重新开始</A>."
		
'本来可以通过response.end来结束，但是为了让后面的代码继续执行，则不能使
'用这个代码 ，只好定义一个标志变量
		bAbort = True
	End If
		'取得正在回答的问题号
	iQuestionNumber = CInt(Request.QueryString("qid"))
		
	Session("AnswerString") = Session("AnswerString") & iQuestionNumber & "|" & _
		GetLetterFromAnswerNumber(CInt(Request.QueryString("sa"))) & "|"
	
	'问题号加一
	iQuestionNumber = iQuestionNumber + 1
End If

If Not bAbort Then

	iNumberOfQuestions = Session("NumberOfQuestions")

	'检查是否到了最后一道题，如果是，则显示结果，如果不是，则显示下一道
	If iQuestionNumber > iNumberOfQuestions Then
		strAnswers = Session("AnswerString")
		
		'Response.Write strAnswers & "<BR>" & vbCrLf & "<BR>" & vbCrLf

		If USE_DB_FOR_INFO Then
			' 如果使用数据库
			' 创建数据库连接
			Set cnnQuiz = Server.CreateObject("ADODB.Connection")
			cnnQuiz.Open DB_CONN_STRING
				
			Set rsQuiz = Server.CreateObject("ADODB.Recordset")
			' 设定游标类型3, 1 (Static, Read Only)
			rsQuiz.Open "SELECT * FROM questions WHERE quiz_id=" & QUIZ_ID & _
				" ORDER BY question_number;", cnnQuiz, 3, 1
				
			iScore = 0
			I = 1
			Do While Not rsQuiz.EOF
				If UCase(CStr(rsQuiz.Fields("correct_answer").Value)) = _
					GetAnswerFromAnswerString(I, strAnswers) Then
					
					iScore = iScore + 1
				Else
					strResults = strResults & I & ", "
				End If
				I = I + 1
				rsQuiz.MoveNext
			Loop

			'关闭释放数据库资源
			rsQuiz.Close
			Set rsQuiz = Nothing
			cnnQuiz.Close
			Set cnnQuiz = Nothing
		Else
			'不是使用数据库
			aAnswers = Array("A", "A", "A", "E", "D", "A", "E", "E", "A", "A")
			 
			iScore = 0
			For I = 1 to iNumberOfQuestions
				If UCase(CStr(aAnswers(I - 1))) = _
					GetAnswerFromAnswerString(I, strAnswers) Then
					
					iScore = iScore + 1
				Else
					strResults = strResults & I & ", "
				End If
			Next
		End If

		'将得分转换为百分数
		iScore = Round((iScore / iNumberOfQuestions) * 100)
		%>
		<FONT SIZE="+2"><B><%= Session("QuizName") %></B>
</FONT><BR>
		<BR>

		<%
		If iScore >= Session("PercentageToPass") Then 
			Response.Write "恭喜! 你通过了考试，分数是： "
			Response.Write iScore & "%.<BR>" & vbCrLf
		Else
			Response.Write "对不起，你需要达到 "
			Response.Write Session("PercentageToPass") & "% 或者更高才能通过.  "
			Response.Write "对不起，你得分数只有 " & iScore & "%.  "
			Response.Write "你可以单击链接<A HREF="""
			Response.Write Request.ServerVariables("URL") & """>重新开始</A>.<BR>" & vbCrLf
		End If
		Response.Write "<BR>" & vbCrLf

		If Len(strResults) <> 0 Then
			Response.Write "你答错了如下题目： " & Left(strResults, Len(strResults) - 2)
			Response.Write "<BR>" & vbCrLf
		End If

		'你可以将结果输出到一个文件中或者自定义的格式
	Else
		'得到或设定文件信息
		If USE_DB_FOR_INFO Then
			Set cnnQuiz = Server.CreateObject("ADODB.Connection")
			cnnQuiz.Open DB_CONN_STRING
				
			Set rsQuiz = Server.CreateObject("ADODB.Recordset")
			rsQuiz.Open "SELECT * FROM questions WHERE quiz_id=" _
				& QUIZ_ID & " AND question_number=" & iQuestionNumber & ";", cnnQuiz
				
			strQuestionText = CStr(rsQuiz.Fields("question_text").Value)
			
			aAnswers = Array( _
			CStr(rsQuiz.Fields("answer_a").Value & ""), _
			CStr(rsQuiz.Fields("answer_b").Value & ""), _
			CStr(rsQuiz.Fields("answer_c").Value & ""), _
			CStr(rsQuiz.Fields("answer_d").Value & ""), _
			CStr(rsQuiz.Fields("answer_e").Value & ""), _
			CStr(rsQuiz.Fields("answer_f").Value & ""))
				
			For I = LBound(aAnswers) To UBound(aAnswers)
				If aAnswers(I) = "" Then
					ReDim Preserve aAnswers(I - 1)
					Exit For
				End If
			Next

			'关闭和释放数据库资源
			rsQuiz.Close
			Set rsQuiz = Nothing
			cnnQuiz.Close
			Set cnnQuiz = Nothing
		Else
			Select Case iQuestionNumber
				Case 1
					strQuestionText = "What does ASP stand for?"
					aAnswers = Array( _
						"Active Server Pages", _
						"Additional Sensory Perception", _
						"Accidental Script Problem", _
						"Altruistically Solving Problems", _
						"Additional Sleeping Preferred", _
						"Any Solution Possible")
				Case 2
					strQuestionText = "What command is &lt;%= %&gt; equivalent to?"
					aAnswers = Array( _
						"Response.Write", _
						"Request.Write", _
						"Referer.Write", _
						"Redirect.Write", _
						"Reasonably.Write", _
						"Damn It I'm Right!")
				Case 3
					strQuestionText = "What does &quot;Option Explicit&quot; do?"
					aAnswers = Array( _
						"Requires explicit variable declaration", _
						"Makes the computer give you additional errors", _
						"Converts a PG rated programming language into one rated NC-17")
				Case 4
					strQuestionText = "Which of the following is not a valid "
					strQuestionText = strQuestionText & "VBScript looping statement?"
					aAnswers = Array( _
						"Do...Loop", _
						"While...Wend", _
						"For...Next", _
						"For Each...Next", _
						"Just do this 10 times you stupid computer!")
				Case 5
					strQuestionText = "What language can you not use to write ASP?"
					aAnswers = Array( _
						"VBScript", _
						"JavaScript (JScript)", _
						"PerlScript", _
						"SuperScript")
				Case 6
					strQuestionText = "Where does ASP code execute?"
					aAnswers = Array( _
						"On the web server", _
						"In the client's browser", _
						"On any machine it wants to", _
						"Reportedly somewhere in Washington State")
				Case 7
					strQuestionText = "Which set of acronyms is not associated with ASP?"
					aAnswers = Array( _
						"CDO, CDONTS", _
						"ADO, RDS, DAO, ODBC", _
						"IIS, PWS, MMC", _
						"ADSI, XML", _
						"B&Ouml;C, OU812, GNR, BTO")
				Case 8
					strQuestionText = "Which of the following is not something you can get "
					strQuestionText = strQuestionText & "from the Request collection?"
					aAnswers = Array( _
						"Cookies", _
						"Form", _
						"QueryString", _
						"ServerVariables", _
						"Beer", _
						"ClientCertificate")
				Case 9
					strQuestionText = "What will this script output when run?<BR><BR>&lt;%<BR>"
					strQuestionText = strQuestionText & "Dim aTempArray<BR>Dim I<BR>"
					strQuestionText = strQuestionText & "aTempArray = Array(1, 2, 3)<BR>"
					strQuestionText = strQuestionText & "For I = LBound(aTempArray) To "
					strQuestionText = strQuestionText & "Ubound(aTempArray)<BR>"
					strQuestionText = strQuestionText & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
					strQuestionText = strQuestionText & "Response.Write I & &quot&nbsp;&quot;<BR>"
					strQuestionText = strQuestionText & "Next 'I<BR>%&gt;<BR>"
					aAnswers = Array( _
						"0 1 2", _
						"1 2 3", _
						"0<BR>1<BR>2<BR>", _
						"1<BR>2<BR>3<BR>")
				Case 10
					strQuestionText = "What is the URL of the best ASP web site?"
					aAnswers = Array("http://www.asp101.com (yeah... like we'd put any other choices here!)")
			End Select
		End If
		%>

		<FONT SIZE="+2"><B>
<%= Session("QuizName") %>
</B></FONT>
<BR>
		<BR>
		
		考试进程提示:
		<%
		Const BAR_LENGTH = 160
		If iQuestionNumber = 1 Then
			' Since a 0 width is ignored by the browsers we need to remove the image altogether!
			Response.Write "<IMG SRC=""./images/spacer_red.gif"" HEIGHT=""10"" WIDTH="""
			Response.Write BAR_LENGTH
			Response.Write """><BR>"
		Else
			Response.Write "<IMG SRC=""./images/spacer_blue.gif"" HEIGHT=""10"" WIDTH="""
			Response.Write (BAR_LENGTH / iNumberOfQuestions) * (iQuestionNumber - 1) 
			Response.Write """>"
			Response.Write "<IMG SRC=""./images/spacer_red.gif"" HEIGHT=""10"" WIDTH="""
			Response.Write (BAR_LENGTH / iNumberOfQuestions) * (iNumberOfQuestions - (iQuestionNumber - 1))
			Response.Write """><BR>"
		End If
		%>
		问题：<%= iQuestionNumber %> of <%= iNumberOfQuestions %><BR>
		
		<BR>
		<STRONG>
<%= iQuestionNumber %>.
</STRONG>&nbsp;&nbsp
<%= strQuestionText %>
<BR>

		<BR>

		<STRONG>
问题选项：
</STRONG>
		<OL TYPE="A">

		<%
		For I = LBound(aAnswers) to UBound(aAnswers)
			Response.Write "<LI><A HREF=""" & Request.ServerVariables("URL")
			Response.Write "?qid=" & iQuestionNumber & "&sa=" & I & """>"
			Response.Write aAnswers(I) & "</A></LI>" & vbCrLf
		Next
		%>
		</OL>
<%
End If
End If
%>