www.pudn.com > textmanager.rar > ModQuestion.bas, change:2005-04-12,size:24527b


Attribute VB_Name = "Module1" 
  
'移动没标题的窗口 
Public Declare Function ReleaseCapture Lib "user32" () As Long 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Public Const WM_SYSCOMMAND = &H112 
Public Const SC_MOVE = &HF010& 
Public Const HTCAPTION = 2 
'让窗口始终在所有窗口上面 
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long 
Public Const SWP_NOMOVE = &H2 
Public Const SWP_NOSIZE = &H1 
Public Const HWND_TOPMOST = -1 
Public Const HWND_NOTOPMOST = -2 
'让窗口始终在所有窗口上面 
Function SetFormTop(hwnd As Long, Top As Boolean) 
If Top Then 
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE 
Else 
SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE 
End If 
End Function 
'创建成绩表网页 
Sub CreateScoreTable(ByVal FileName As String, ByVal adoTempRs As Recordset) 
   Dim TempStr As String 
   TempStr = "<body bgcolor=#FFFFFF>" 
   TempStr = TempStr + "<div id=Layer1 style=position:absolute; width:486px; height:41px; z-index:1; left: 131px; top: 24px>" 
   TempStr = TempStr + "<table width=485 border=1 cellpadding=0 cellspacing=0>" 
   TempStr = TempStr + "<tr align=center>" 
   TempStr = TempStr + "<td colspan=3 height=20><b>学号</b></td>" 
   TempStr = TempStr + "<td width=17% height=20><b>姓名</b></td>" 
   TempStr = TempStr + "<td width=35% height=20><b>科目</b></td>" 
   TempStr = TempStr + "<td width=13% height=20><b>成绩</b></td>" 
   TempStr = TempStr + "<td width=12% height=20><b>名次</b></td>" 
   TempStr = TempStr + "</tr>" 
   Do While Not adoTempRs.EOF 
      TempStr = TempStr + "<tr align=center>" 
      TempStr = TempStr + "<td colspan=3>" + adoTempRs.Fields("学号").Value + "</td>" 
      TempStr = TempStr + "<td width=17%>" + adoTempRs.Fields("考生姓名").Value + "</td>" 
      TempStr = TempStr + "<td width=35%>" + adoTempRs.Fields("科目").Value + "</td>" 
      TempStr = TempStr + "<td width=13%>" & adoTempRs.Fields("考试成绩").Value & "</td>" 
      TempStr = TempStr + "<td width=12%>" & adoTempRs.AbsolutePosition & "</td>" 
      TempStr = TempStr + "</tr>" 
      adoTempRs.MoveNext 
   Loop 
   TempStr = TempStr + "</table></div></body>" 
  Open FileName For Output As #1 
    Print #1, TempStr 
  Close #1 
End Sub 
 
'预览试卷,加入答案,DAView表示是否显示答案 
Sub CreateHTML(ByVal FileName As String, ByVal Title As String, ByVal DaView As Boolean, ByVal rsdan As Recordset, ByVal rsduo As Recordset, ByVal rsTK As Recordset, ByVal rsPD As Recordset, ByVal rsWD As Recordset, ByVal rsZW As Recordset) 
  Dim RsStr As String 
  Dim Number As Integer 
  Dim i As Integer 
  Dim Count As Integer 
  Dim TempStr As String 
  TempStr = "<p align=center><b><font face='楷体_GB2312' size=4>" + Title + "</font></b></p><hr>" + vbCrLf 
  TempStr = TempStr + "<div align=center><table border=0 width=90%><TR><TD>" + vbCrLf 
  '单选题 
  RsStr = "" 
  Number = 0 
 If Not rsdan.EOF Then 
  RsStr = RsStr + "<FONT size=2 COLOR=#FF0000>一、单选题</FONT><br>" + vbCrLf 
 End If 
 Do While Not rsdan.EOF 
  Number = Number + 1 
  RsStr = RsStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + rsdan.Fields("wenti") + "</FONT>" + vbCrLf 
  RsStr = RsStr + "<ul TYPE=A>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsdan.Fields("xuanze1").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsdan.Fields("xuanze2").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsdan.Fields("xuanze3").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsdan.Fields("xuanze4").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "</ul>" + vbCrLf 
  If DaView = True Then RsStr = RsStr + "   答案:<font color=#ff0000>" + rsdan.Fields("daan").Value + "</font><br><br>" + vbCrLf 
rsdan.MoveNext 
 Loop 
 Number = 0 
  
 '多选题 
 If Not rsduo.EOF Then 
   RsStr = RsStr + "<FONT size=2 COLOR =#FF00>二、多选题</FONT><br>" + vbCrLf 
 End If 
 Do While Not rsduo.EOF 
  Number = Number + 1 
  RsStr = RsStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + rsduo.Fields("wenti") + "</FONT>" + vbCrLf 
  RsStr = RsStr + "<ul type=A>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsduo.Fields("xuanze1").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsduo.Fields("xuanze2").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsduo.Fields("xuanze3").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "<li>" + rsduo.Fields("xuanze4").Value + "</li>" + vbCrLf 
  RsStr = RsStr + "</ul>" + vbCrLf 
  If DaView = True Then RsStr = RsStr + "   答案:<font color=#ff0000>" + rsduo.Fields("daan").Value + "</font><br><br>" + vbCrLf 
rsduo.MoveNext 
 Loop 
 
'填空题 
Dim RsStrTK As String 
Dim DaanStr As String 
Dim DaanStrArr() As String 
Number = 0 
If Not rsTK.EOF Then 
  RsStrTK = RsStrTK + "<FONT size=2 COLOR =#FF00>三、填空题</FONT><br>" + vbCrLf 
End If 
Do While Not rsTK.EOF 
  Number = Number + 1 
  RsStrTK = RsStrTK + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + rsTK.Fields("wenti") + "</FONT><br>" + vbCrLf 
  DaanStrArr = Split(rsTK.Fields("daan").Value, "▲▲") 
  DaanStr = "" 
  For i = 0 To UBound(DaanStrArr) 
     DaanStr = DaanStr + "<U>" + DaanStrArr(i) + "</u>、" 
  Next i 
  DaanStr = Left(DaanStr, Len(DaanStr) - 1) 
  If DaView = True Then RsStrTK = RsStrTK + "   答案:<font color=#ff0000>" + DaanStr + "</font><br><br>" + vbCrLf 
 rsTK.MoveNext 
Loop 
     
'判断题 
Dim RsStrPD As String 
Number = 0 
If Not rsPD.EOF Then 
  RsStrPD = RsStrPD + "<FONT size=2 COLOR =#FF00>四、判断题</FONT><br>" + vbCrLf 
End If 
Do While Not rsPD.EOF 
  Number = Number + 1 
  RsStrPD = RsStrPD + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + rsPD.Fields("wenti") + "</FONT><br>" + vbCrLf 
  If rsPD.Fields("daan").Value = "T" Then 
    DaanStr = "对" 
   Else 
    DaanStr = "错" 
  End If 
  If DaView = True Then RsStrPD = RsStrPD + "   答案:<font color=#ff0000>" + DaanStr + "</font><br><br>" + vbCrLf 
 rsPD.MoveNext 
Loop 
     
'问答 
Dim RsStrWD As String 
Number = 0 
If Not rsWD.EOF Then 
  RsStrWD = RsStrWD + "<FONT size=2 COLOR =#FF00>五、问答题</FONT><br>" + vbCrLf 
End If 
Do While Not rsWD.EOF 
  Number = Number + 1 
  RsStrWD = RsStrWD + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + rsWD.Fields("wenti") + "</FONT><br>" + vbCrLf 
  DaanStr = rsWD.Fields("daan").Value 
  If DaView = True Then RsStrWD = RsStrWD + "   评分标准:<font color=#ff0000>" + DaanStr + "</font><br><br>" + vbCrLf 
 rsWD.MoveNext 
Loop 
     
'作文 
Dim RsStrZW As String 
Number = 0 
If Not rsZW.EOF Then 
  RsStrZW = RsStrZW + "<FONT size=2 COLOR =#FF00>六、作文</FONT><br>" + vbCrLf 
End If 
Do While Not rsZW.EOF 
  Number = Number + 1 
  RsStrZW = RsStrZW + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + rsZW.Fields("wenti") + "</FONT><br>" + vbCrLf 
  DaanStr = rsZW.Fields("daan").Value 
  If DaView = True Then RsStrZW = RsStrZW + "   评分标准:<font color=#ff0000>" + DaanStr + "</font><br><br>" + vbCrLf 
 rsZW.MoveNext 
Loop 
     
RsStrZW = RsStrZW + "</TD></TR></table></div>" + vbCrLf 
Open FileName For Output As #1 
    Print #1, TempStr + RsStr + RsStrTK + RsStrPD + RsStrWD + RsStrZW 
  Close #1 
End Sub 
 
'应为自动ID不能处理删除了的记录的ID问题,现在写一函数来模拟自动ID 
Function GetAutoID(ByVal TableName As String) As Long 
  Dim i As Long 
  Dim longID As Long 
  Dim adoRs As Recordset 
  Set adoRs = New Recordset 
  adoRs.Open "select id from " + TableName + " ORDER BY id", DB, adOpenStatic, adLockOptimistic 
  longID = 1 
  If Not adoRs.EOF Then 
        adoRs.MoveLast 
        adoRs.MoveFirst 
        For i = 1 To adoRs.RecordCount 
'-------------------------------------------------------+ 
' 获取空余最小 ID 号: 
'    从 1 开始搜索,若记录计数器 x 不等于 ID 字段值 , 
'  则取该序号作为 ID值,并跳出循环,若一直匹配,则取大于 
'       计数器当前值的最小值作为 ID值 
'-------------------------------------------------------- 
        If i <> adoRs.Fields(0) Then 
             longID = i 
             Exit For 
        End If 
        longID = i + 1 
        adoRs.MoveNext 
        Next i 
  End If 
  Set adoRs = Nothing 
 GetAutoID = longID 
End Function 
'数字到字符串的转化(str函数会产生空格) 
Function Int2Str(ByVal IntLong As Variant) As String 
  Int2Str = Trim(str(IntLong)) 
End Function 
'由年级序号转化成入学年 
Function Num2Year(ByVal Num As Integer) As Integer 
  Dim NewYear As Long, NewMon As Long 
  Dim YearNum As Integer 
  NewYear = Year(Date) 
  NewMon = Month(Date) 
  '9月份以后升一级 
  YearNum = NewYear - Num 
  If NewMon >= 8 Then 
    YearNum = NewYear - Num + 1 
  End If 
  Num2Year = YearNum 
End Function 
 
'由入学年转化成年级序号 
Function Year2Num(ByVal YearNum As Integer) As Integer 
  Dim NewYear As Long, NewMon As Long 
  Dim Num As Integer 
  NewYear = Year(Date) 
  NewMon = Month(Date) 
  Num = NewYear - YearNum 
  '9月份以后升一级 
  If NewMon >= 8 Then 
    Num = Num + 1 
  End If 
  Year2Num = Num 
End Function 
'由ID值求他的对应题目的分数或者答案等 
Function GetNeedByID(ByVal IdStr As String, ByVal NeedStr As String, ByVal IDSplitStr As String, ByVal NeedSplitStr As String, ByVal ID As Long) As String 
    If IdStr = "" Or NeedStr = "" Then 
       GetNeedByID = "" 
       Exit Function 
    End If 
    Dim i As Long 
    Dim IdArr() As String 
    Dim NeeDArr() As String 
    IdArr = Split(IdStr, IDSplitStr) 
    NeeDArr = Split(NeedStr, NeedSplitStr) 
    For i = 0 To UBound(IdArr) 
      If ID = Val(IdArr(i)) Then 
         GetNeedByID = NeeDArr(i) 
         Exit Function 
      End If 
    Next i 
    GetNeedByID = "" 
End Function 
'修改后加入所有题型的,直接传递成绩ID号 
Sub CreateScoreHTML(ByVal FileName As String, ByVal ID As Long) 
  Dim adoRs As Recordset 
  Set adoRs = New Recordset 
  Dim adoSJRs As Recordset 
  Set adoSJRs = New Recordset 
  Dim adoTempRs As Recordset '处理除选择题以外的题型 
  Set adoTempRs = New Recordset 
  Dim Title As String '试卷标题 
  Dim SQL As String 
  Dim Number As Integer 
  Dim i As Integer 
   '保存头字符串 
  Dim TempStr As String 
  Dim XuanZeStr As String '保存选择题的字符串 
  Dim TianKongStr As String '保存填空题的字符串 
  Dim PanDuanStr As String '保存判断题的字符串 
  Dim WenDaStr As String '保存问答题字符串 
  Dim ZuoWenStr As String '作文题的 
  Dim ScoreIDStr As String '保存成绩表里的题目ID 
  Dim TestIDStr As String '保存试卷表里的题目ID的字符串 
  Dim TMScoreStr As String '保存题目的分数的字符串 
  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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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, DB, 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