qestionpaper.vb

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

		If DataEnv.rsQstPaper.RecordCount > 0 Then
			AddQuestion = False '若该题目编号与类型的记录已经存在于试卷中，则添加失败
		Else
			DataEnv.rsQstPaper.Filter = ""
			DataEnv.rsQstPaper.AddNew() '向试卷中添加试题
			DataEnv.rsQstPaper.Fields("PaperSerial").Value = iCount
			DataEnv.rsQstPaper.Fields("QuestionID").Value = QID
			DataEnv.rsQstPaper.Fields("QuestionType").Value = QType
			DataEnv.rsQstPaper.Fields("Score").Value = 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
		'UPGRADE_WARNING: 未能解析对象 DataEnv.DelQuestion 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		DataEnv.DelQuestion() '执行数据环境命令DelQuestion
		Dim iCount As Integer
		Dim QID As Integer
		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 Integer) As Integer '获取试卷编号QSerail的题目编号
		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").Value
		End If
		DataEnv.rsQstPaper.Filter = ""
		DataEnv.rsQstPaper.Close()
	End Function
	
	Public Function GetQuestion(ByVal QSerial As Integer) As String '获取试卷编号QSerail的题目问题
		On Error Resume Next
		Dim dbrs As ADODB.Recordset
		Dim QType As MainModule.QuestionType
		Dim QID As Integer
		QID = GetQuestionID(QSerial)
		QType = GetType_Renamed(QSerial)
		dbrs = GetDBRS(QType)
		dbrs.Open()
		dbrs.Filter = "QuestionID = " & CStr(QID)
		GetQuestion = CStr(QSerial) & ". " & dbrs.Fields("Question").Value
		dbrs.Filter = ""
		dbrs.Close()
	End Function
	Public Function GetChoice(ByVal QSerial As Integer) As String '获取试卷编号QSerail的题目选项
		On Error Resume Next
		Dim dbrs As ADODB.Recordset
		Dim QType As MainModule.QuestionType
		Dim QID As Integer
		Dim S As String
		Dim i As Byte
		QType = GetType_Renamed(QSerial)
		If QType <> MainModule.QuestionType.singlesel And QType <> MainModule.QuestionType.MultiSel Then '如果试题类型不是单选题或多选题
			GetChoice = "" '返回值为空字符串
			Exit Function
		End If
		QID = GetQuestionID(QSerial) '获取题目编号
		dbrs = GetDBRS(QType) '获取试题库数据集
		dbrs.Open()
		dbrs.Filter = "QuestionID = " & CStr(QID)
		S = ""
		For i = 1 To 3 '将各个选项拼接为以逗号分隔的字符串
			S = S & dbrs.Fields("Choice" & CStr(i)).Value & ","
		Next 
		S = S & dbrs.Fields("Choice4").Value
		dbrs.Filter = ""
		dbrs.Close()
		GetChoice = S
	End Function
	
	Public Function DelQuestion(ByVal PSerial As Integer) As Boolean '删除一个问题
		On Error Resume Next
		DataEnv.rsQstPaper.Open()
		DataEnv.rsQstPaper.Filter = "PaperSerial = " & PSerial
		DataEnv.rsQstPaper.Delete(ADODB.AffectEnum.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 Integer
		'UPGRADE_WARNING: Dir 有新行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1041"”
		If Dir(FileName, FileAttribute.Normal) <> "" Then '如果文件已经存在，则删除原文件
			Kill(FileName)
		End If
		FileOpen(1, FileName, OpenMode.Output) '打开文件用于写入数据
		PrintLine(1, "    试卷样稿    ")
		PrintLine(1, "------------------")
		Dim S() As String
		Dim i As Byte '输出数组元素
		For iCount = 1 To LastQSerial '输出每道题目
			txtFile = GetQuestion(iCount) '获取每道题的题目问题
			If txtFile <> "" Then
				PrintLine(1, txtFile)
			End If
			txtFile = GetChoice(iCount) '获取并输出题目选项
			If txtFile <> "" Then
				S = Split(txtFile, ",") '利用逗号分隔符将获取的字符串分割为字符串数组
				For i = 0 To UBound(S)
					txtFile = Space(3) & Chr(Asc("A") + i) & "." & S(i)
					PrintLine(1, txtFile)
				Next 
			End If
		Next 
		FileClose(1)
	End Sub
	
	'UPGRADE_NOTE: GetType 已升级到 GetType_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"”
	Public Function GetType_Renamed(ByVal QSerial As Integer) As MainModule.QuestionType '获取试卷编号为QSerial的题目类型
		On Error Resume Next
		DataEnv.rsQstPaper.Open()
		DataEnv.rsQstPaper.Filter = "PaperSerial = " & CStr(QSerial) '查找相应的记录
		Dim iType As Byte
		If DataEnv.rsQstPaper.RecordCount < 1 Then
			GetType_Renamed = MainModule.QuestionType.OnErr
		Else
			iType = DataEnv.rsQstPaper.Fields("QuestionType").Value '获取"QuestionType"字段
			GetType_Renamed = iType
		End If
		DataEnv.rsQstPaper.Filter = ""
		DataEnv.rsQstPaper.Close()
		
	End Function
	Public Function GetQSerial(ByVal nCount As Integer) As Integer '参数nCount表数据集中的第几条记录
		On Error Resume Next
		DataEnv.rsQstPaper.Open() '打开数据集
		If DataEnv.rsQstPaper.RecordCount < nCount Then '如果数据集为空，则返回值为0
			GetQSerial = 0
		Else
			DataEnv.rsQstPaper.Move(nCount - 1, 0) '将游标移到第nCount条记录
			GetQSerial = DataEnv.rsQstPaper.Fields("PaperSerial").Value '获取PaperSerial字段值
		End If
		DataEnv.rsQstPaper.Close() '关闭数据集
	End Function
	
	Public Function GetQAnswer(ByVal QSerial As Integer) As String '获取试卷编号为QSerial题目的参考答案
		Dim dbrs As ADODB.Recordset
		Dim QType As MainModule.QuestionType
		Dim QID As Integer
		QType = GetType_Renamed(QSerial) '确定试题的类型
		QID = GetQuestionID(QSerial) '获取问题的编号
		dbrs = GetDBRS(QType) '获取试题库的数据集
		dbrs.Open()
		dbrs.Filter = "QuestionID = " & CStr(QID) '在试题库中查询其所对应的试题
		GetQAnswer = dbrs.Fields("Answer").Value '获取试题的参考答案
		dbrs.Filter = ""
		dbrs.Close()
	End Function
	
	Public Function GetUserAnswer(ByVal QSerial As Integer) As String '获取试卷编号为QSerial的用户答案
		Dim UserAnswer As Object
		DataEnv.rsQstPaper.Open()
		DataEnv.rsQstPaper.Filter = "PaperSerial =" & CStr(QSerial)
		If DataEnv.rsQstPaper.RecordCount < 1 Then
			GetUserAnswer = ""
		Else
			'UPGRADE_WARNING: 未能解析对象 UserAnswer 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			UserAnswer = DataEnv.rsQstPaper.Fields("UserAnswer").Value
			'UPGRADE_WARNING: 检测到使用了 Null/IsNull()。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1049"”
			If IsDbNull(UserAnswer) Then
				GetUserAnswer = ""
			Else
				GetUserAnswer = DataEnv.rsQstPaper.Fields("UserAnswer").Value
			End If
		End If
		DataEnv.rsQstPaper.Close()
	End Function
	
	Public Sub Check(ByVal QSerial As Integer) '评阅试卷编号为QSerial的试题
		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").Value = DataEnv.rsQstPaper.Fields("Score").Value
		Else
			DataEnv.rsQstPaper.Fields("Commence").Value = 0
		End If
		DataEnv.rsQstPaper.Close()
	End Sub
	
	Public Sub SetAnswer(ByVal iCount As Integer, ByVal Answer As String) '设置用户答案
		On Error Resume Next
		DataEnv.rsQstPaper.Open()
		DataEnv.rsQstPaper.Move(iCount - 1, 0)
		DataEnv.rsQstPaper.Fields("UserAnswer").Value = Answer
		DataEnv.rsQstPaper.Update() '更新数据集
		DataEnv.rsQstPaper.Close()
	End Sub
End Class