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


Attribute VB_Name = "Module1" 
Option Explicit 
Global StudentID As String '存储登机考生ID号 
'Global StudentNAME As String '存储登记考生姓名 
'在托盘上加图标 
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long 
 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
Public Const NIM_ADD = &H0 
Public Const NIM_DELETE = &H2 
Public Const NIM_MODIFY = &H1 
Public Const NIF_ICON = &H2 
Public Const NIF_MESSAGE = &H1 
Public Const NIF_TIP = &H4 
Public Type NOTIFYICONDATA 
        cbSize As Long 'NOTIFYICONDATA类型的字节数 
        hwnd As Long '与状态区图标联系的窗口句柄 
        uID As Long '自定义的任务栏图标句柄 
        uFlags As Long '标识类型中其它成员是否有效 
        uCallbackMessage As Long '系统返回消息的标识,对于处理状态区的鼠标的事件很有用 
        hIcon As Long '使用的图标的句柄 
        szTip As String * 64 '提示字符串,最长为64个字符 
End Type 
Public Const WM_MOUSEMOVE = &H200 
Public Const WM_LBUTTONDOWN = &H201 
Public Const WM_RBUTTONDOWN = &H204 
Public tnid As NOTIFYICONDATA 
Public Const GWL_WNDPROC = -4 
Global lpPrevWndProc As Long 
Global gHW As Long 
 
'隐藏本任务 
 
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long 
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long 
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long 
Public Const RSP_SIMPLE_SERVICE = 1 
Public Const RSP_UNREGISTER_SERVICE = 0 
 
'注册表操作 
Private Const REG_SZ = 1 
Private Const HKEY_LOCAL_MACHINE = &H80000002 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 
 
'移动没标题的窗口 
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 
 
Global ConnString As String '连接试题库数据库的字符串 
Global LocalConn As Connection '连接本地数据库的连接 
 
'读写INI文件的API函数 
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long 
Global InIpath As String 'ini文件路径 
'Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long 
''''' 
'自动运行设定的程序 
Function AutoRun(AutoName As String, FileName As String) 
Dim hKey As Long 
RegOpenKey HKEY_LOCAL_MACHINE, "Software\Microsoft\windows\CurrentVersion\Run", hKey 
RegSetValueEx hKey, AutoName, 0, REG_SZ, ByVal FileName, Len(FileName) 
RegCloseKey hKey 
End Function 
'隐藏本任务 
'To remove your program from the Ctrl+Alt+Delete list, call the MakeMeService procedure: 
Public Sub RemoveProgramFromList() 
    Dim lngProcessID As Long 
    Dim lngReturn As Long 
     
    lngProcessID = GetCurrentProcessId() 
    lngReturn = RegisterServiceProcess(lngProcessID, RSP_SIMPLE_SERVICE) 
End Sub 
'显示本任务 
 
'To restore your application to the Ctrl+Alt+Delete list, call the UnMakeMeService procedure: 
Public Sub AddProgramToList() 
    Dim lngProcessID As Long 
    Dim lngReturn As Long 
     
    lngProcessID = GetCurrentProcessId() 
    lngReturn = RegisterServiceProcess(lngProcessID, RSP_UNREGISTER_SERVICE) 
End Sub 
 
'查找给定目录的上一级目录 
Function GetPrvPath(ByVal Path As String) As String 
  Dim i As Integer 
  Dim Tstr As String 
  For i = Len(Path) To 1 Step -1 
     Tstr = Mid(Path, i, 1) 
     If Tstr = "\" Then 
       GetPrvPath = Left(Path, i - 1) 
       Exit Function 
     End If 
  Next i 
   
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 CreateHTML(ByVal FileName As String, ByVal ID As Long) 
  Dim adoRS As Recordset 
  Set adoRS = New Recordset 
  adoRS.CursorLocation = adUseClient 
 
  Dim adoSJRs As Recordset 
  Set adoSJRs = New Recordset 
  adoSJRs.CursorLocation = adUseClient 
 
  Dim adoTempRs As Recordset '处理除选择题以外的题型 
  Set adoTempRs = New Recordset 
  adoTempRs.CursorLocation = adUseClient 
 
  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, ConnString, 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, ConnString, 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, ConnString, 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, ConnString, 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, ConnString, 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, 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