modclient.bas

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

'     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, ConnString, 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, ConnString, 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, ConnString, 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, ConnString, 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, ConnString, 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, ConnString, 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
'====================2001-05-19 03:18修改


'数字到字符串的转化（str函数会产生空格）
Function Int2Str(ByVal IntLong As Variant) As String
  Int2Str = Trim(Str(IntLong))
End Function
'判断是否开考
Function StartYN() As Boolean
  Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  adoRS.Open "select Start from kaoshixinxi", ConnString, adOpenStatic, adLockOptimistic
  StartYN = True
  If adoRS.EOF Then
     StartYN = False
    Else
     If adoRS.Fields(0).Value <> "T" Then
        StartYN = False
     End If
  End If
  Set adoRS = Nothing
End Function
'应为自动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.CursorLocation = adUseClient

  adoRS.Open "select id from " + TableName + " ORDER BY id", ConnString, 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




'创建默认的ini文件 '写ini文件
Sub CreateInI(ByVal ServerName As String, ByVal LoginName As String, ByVal Pass As String, ByVal DbName As String)
  Dim Tstr As String
  Tstr = "[Server]" + vbCrLf
  Tstr = Tstr + "ServerName=" + ServerName + vbCrLf
  Tstr = Tstr + "LoginName=" + LoginName + vbCrLf
  Tstr = Tstr + "PassWord=" + Pass + vbCrLf
  Tstr = Tstr + "Database=" + DbName + vbCrLf
 Open InIpath For Output As #1
   Print #1, Tstr
 Close 1
End Sub
'把秒转化成时间的函数
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