modquestion.bas

自己用vb开发的局域网考试系统

  Dim DScoreStr As String '保存成绩的分数字符串
  Dim KSDaAnStr As String '保存成绩表的考生答案字符串
  Dim OneDaAn As String '保存考生做的一道题的答案
  Dim TempArr() As String '用于产生临时数组
  sql = "select test.title,score.danxuan,score.danxuanid,score.danxuans"
  sql = sql + ",score.duoxuan,score.duoxuanid,score.duoxuans"
  sql = sql + ",test.danxuan,test.danxuans,test.duoxuan,test.duoxuans"
  sql = sql + ",test.tiankong,test.tiankongs,test.panduan,test.panduans,test.wenda,test.wendas"
  sql = sql + ",test.zuowen,test.zuowens from score,test where score.testid=test.id and score.id=" & ID
  adoRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
  Title = adoRs.Fields(0).Value
  TempStr = "<p align=center><b><font face='楷体_GB2312' size=5>" + Title + "</font></b></p><hr>" + vbCrLf
  TempStr = TempStr + "<div align=center><table border=0 width=94% cellpadding=2><TR><TD>" + vbCrLf
  '单选题
  If adoRs.Fields(2).Value <> "" Then
     '查询
     sql = "select id,wenti,xuanze1,xuanze2,xuanze3,xuanze4,daan from question where id in (" + adoRs.Fields(2).Value + ")"
     adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
     '开始产生字符串
     XuanZeStr = XuanZeStr + "<br><FONT size=2 COLOR=#FF0000>一、单选题</FONT><br>" + vbCrLf
     Number = 0
     '付给字符串
     ScoreIDstr = adoRs.Fields(2).Value
     TestIDStr = adoRs.Fields(7).Value
     TMScoreStr = adoRs.Fields(8).Value
     DScoreStr = adoRs.Fields(3).Value
     KSDaAnStr = adoRs.Fields(1).Value
     Do While Not adoSJRs.EOF
       Number = Number + 1
       XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT>" + vbCrLf
       XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF><ul TYPE=A>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze1").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze2").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze3").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze4").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "</ul></font>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "/", adoSJRs.Fields("id").Value)
       If adoSJRs.Fields("daan").Value = OneDaAn Then
         XuanZeStr = XuanZeStr + "<font color=#ff0000>正确！</font>" + "标准答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
       Else
         XuanZeStr = XuanZeStr + "<font color=#ff0000>错误！</font>" + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font>" + " 标准答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
       End If
       XuanZeStr = XuanZeStr + "你的得分：<font color=#ff0000>" + GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分</font><br>" + vbCrLf
       adoSJRs.MoveNext
     Loop
  End If
  
  '多选题
  adoSJRs.Close
  If adoRs.Fields(5).Value <> "" Then
     '查询
     sql = "select id,wenti,xuanze1,xuanze2,xuanze3,xuanze4,daan from question where id in (" + adoRs.Fields(5).Value + ")"
     adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
     '开始产生字符串
     XuanZeStr = XuanZeStr + "<br><FONT size=2 COLOR=#FF0000>二、多选题</FONT><br>" + vbCrLf
     Number = 0
     '付给字符串
     ScoreIDstr = adoRs.Fields(5).Value
     TestIDStr = adoRs.Fields(9).Value
     TMScoreStr = adoRs.Fields(10).Value
     DScoreStr = adoRs.Fields(6).Value
     KSDaAnStr = adoRs.Fields(4).Value
     Do While Not adoSJRs.EOF
       Number = Number + 1
       XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT>" + vbCrLf
       XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF><ul TYPE=A>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze1").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze2").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze3").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze4").Value + "</li>" + vbCrLf
       XuanZeStr = XuanZeStr + "</ul></font>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "/", adoSJRs.Fields("id").Value)
       If adoSJRs.Fields("daan").Value = OneDaAn Then
         XuanZeStr = XuanZeStr + "<font color=#ff0000>正确！</font>" + "标准答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
       Else
         XuanZeStr = XuanZeStr + "<font color=#ff0000>错误！</font>" + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font>" + " 标准答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
       End If
       XuanZeStr = XuanZeStr + "你的得分：<font color=#ff0000>" + GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分</font><br>" + vbCrLf
       adoSJRs.MoveNext
     Loop
  End If
  
  '填空题
  adoSJRs.Close
  sql = "select * from scoreTK where id=" & ID
  '打开成绩表里的填空题
  adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
  If adoTempRs.Fields("tiankongid").Value <> "" Then
     '查询
     sql = "select id,wenti,daan from questionTK where id in (" + adoTempRs.Fields("tiankongid").Value + ")"
     adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
     '开始产生字符串
     TianKongStr = TianKongStr + "<br><FONT size=2 COLOR=#FF0000>三、填空题</FONT><br>" + vbCrLf
     Number = 0
     '付给字符串
     ScoreIDstr = adoTempRs.Fields("TianKongID").Value
     TestIDStr = adoRs.Fields(11).Value
     TMScoreStr = adoRs.Fields(12).Value
     DScoreStr = adoTempRs.Fields("tiankongs").Value
     KSDaAnStr = adoTempRs.Fields("tiankong").Value
     Do While Not adoSJRs.EOF
       Number = Number + 1
       TianKongStr = TianKongStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
       TempArr = Split(adoSJRs.Fields("daan").Value, "▲▲")
       OneDaAn = ""
       For i = 0 To UBound(TempArr)
         OneDaAn = OneDaAn + "<U>" + TempArr(i) + "</U>" + "、"
       Next i
       OneDaAn = Left(OneDaAn, Len(OneDaAn) - 1)
       TianKongStr = TianKongStr + "参考答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "▼▼", adoSJRs.Fields("id").Value)
       TempArr = Split(OneDaAn, "▲▲")
       OneDaAn = ""
       For i = 0 To UBound(TempArr)
         OneDaAn = OneDaAn + "<U>" + TempArr(i) + "</U>" + "、"
       Next i
       TianKongStr = TianKongStr + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
       If OneDaAn = "" Then
          TianKongStr = TianKongStr + "<font color=#bb88cc><这道题还没判！></font><br>" + vbCrLf
        Else
          TianKongStr = TianKongStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
       End If
       adoSJRs.MoveNext
     Loop
  End If
  
  '判断题
  adoSJRs.Close
  adoTempRs.Close
  sql = "select * from scorePD where id=" & ID
  '打开成绩表里的判断题
  adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
  If adoTempRs.Fields("panduanid").Value <> "" Then
     '查询
     sql = "select id,wenti,daan from questionPD where id in (" + adoTempRs.Fields("panduanid").Value + ")"
     adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
     '开始产生字符串
     PanDuanStr = PanDuanStr + "<br><FONT size=2 COLOR=#FF0000>四、判断题</FONT><br>" + vbCrLf
     Number = 0
     '付给字符串
     ScoreIDstr = adoTempRs.Fields("panduanID").Value
     TestIDStr = adoRs.Fields(13).Value
     TMScoreStr = adoRs.Fields(14).Value
     DScoreStr = adoTempRs.Fields("panduans").Value
     KSDaAnStr = adoTempRs.Fields("panduan").Value
     Do While Not adoSJRs.EOF
       Number = Number + 1
       PanDuanStr = PanDuanStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
       If adoSJRs.Fields("daan").Value = "T" Then
          OneDaAn = "对"
        Else
          OneDaAn = "错"
       End If
       PanDuanStr = PanDuanStr + "参考答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       '取得考生答案
       OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", ",", adoSJRs.Fields("id").Value)
       If OneDaAn = "" Then
          OneDaAn = "这道题你没答"
        ElseIf OneDaAn = "T" Then
          OneDaAn = "对"
        Else
          OneDaAn = "错"
       End If
       PanDuanStr = PanDuanStr + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
       PanDuanStr = PanDuanStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
       adoSJRs.MoveNext
     Loop
  End If
  
   '问答题
  adoSJRs.Close
  adoTempRs.Close
  sql = "select * from scoreWD where id=" & ID
  '打开成绩表里的填空题
  adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
  If adoTempRs.Fields("wendaid").Value <> "" Then
     '查询
     sql = "select id,wenti,daan from questionWD where id in (" + adoTempRs.Fields("wendaid").Value + ")"
     adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
     '开始产生字符串
     WenDaStr = WenDaStr + "<br><FONT size=2 COLOR=#FF0000>五、问答题</FONT><br>" + vbCrLf
     Number = 0
     '付给字符串
     ScoreIDstr = adoTempRs.Fields("wendaID").Value
     TestIDStr = adoRs.Fields(15).Value
     TMScoreStr = adoRs.Fields(16).Value
     DScoreStr = adoTempRs.Fields("wendas").Value
     KSDaAnStr = adoTempRs.Fields("wenda").Value
     Do While Not adoSJRs.EOF
       Number = Number + 1
       WenDaStr = WenDaStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
       OneDaAn = adoSJRs.Fields("daan").Value
       WenDaStr = WenDaStr + "参考答案：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "▼▼", adoSJRs.Fields("id").Value)
       WenDaStr = WenDaStr + "您的答案：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
       If OneDaAn = "" Then
          WenDaStr = WenDaStr + "<font color=#bb88cc><这道题还没判！></font><br>" + vbCrLf
        Else
          WenDaStr = WenDaStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
       End If
       adoSJRs.MoveNext
     Loop
  End If
  
  '作文题
  adoSJRs.Close
  adoTempRs.Close
  sql = "select * from scoreZW where id=" & ID
  '打开成绩表里的填空题
  adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
  If adoTempRs.Fields("zuowenid").Value <> "" Then
     '查询
     sql = "select id,wenti,daan from questionZW where id in (" + adoTempRs.Fields("zuowenid").Value + ")"
     adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
     '开始产生字符串
     ZuoWenStr = ZuoWenStr + "<br><FONT size=2 COLOR=#FF0000>六、作文题</FONT><br>" + vbCrLf
     Number = 0
     '付给字符串
     ScoreIDstr = adoTempRs.Fields("zuowenID").Value
     TestIDStr = adoRs.Fields(17).Value
     TMScoreStr = adoRs.Fields(18).Value
     DScoreStr = adoTempRs.Fields("zuowens").Value
     KSDaAnStr = adoTempRs.Fields("zuowen").Value
     Do While Not adoSJRs.EOF
       Number = Number + 1
       ZuoWenStr = ZuoWenStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
       OneDaAn = adoSJRs.Fields("daan").Value
       ZuoWenStr = ZuoWenStr + "评分标准：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "▼▼", adoSJRs.Fields("id").Value)
       ZuoWenStr = ZuoWenStr + "您的作文：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
       OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
       If OneDaAn = "" Then
          ZuoWenStr = ZuoWenStr + "<font color=#bb88cc><这道题还没判！></font><br>" + vbCrLf
        Else
          ZuoWenStr = ZuoWenStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
       End If
       adoSJRs.MoveNext
     Loop
  End If
  
  ZuoWenStr = ZuoWenStr + "</TD></TR></table></div>" + vbCrLf
  '释放
  Set adoRs = Nothing
  Set adoSJRs = Nothing
  Set adoTempRs = Nothing
  '生成文件
  Open FileName For Output As #1
    Print #1, TempStr + XuanZeStr + TianKongStr + PanDuanStr + WenDaStr + ZuoWenStr
  Close #1
End Sub
'把时间换成秒的函数
Function Time2Sec(ByVal TimeStr As String) As Long
  Dim CountS As Long
  Dim strArr() As String
  strArr = Split(TimeStr, ":")
  CountS = Val(strArr(0)) * 3600 + Val(strArr(1)) * 60
  Time2Sec = CountS
End Function
'把秒转化成时间的函数
Function Sec2Time(ByVal Sec As Long) As String
  Dim TempStr As String
  Dim TimeStr As String
  TempStr = Trim(str(Sec \ 3600))
  TimeStr = TempStr + ":"
  TempStr = Trim(str((Sec Mod 3600) \ 60))
  TimeStr = TimeStr + TempStr + ":"
  TempStr = Trim(str((Sec Mod 3600) Mod 60))
  Sec2Time = TimeStr + TempStr
End Function