frmkaoshi.frm

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

     RtbWDTM.Text = "   " + adoRS.Fields("问题").Value + "(" & adoRS.Fields("分数").Value & ")" + vbCrLf
     '显示答案
     RtbWDDA.Text = adoRS.Fields("考生答案").Value
  End If
 Set adoRS = Nothing
End Sub
'预览填空题
Sub ViewTK(ByVal TMid As Long) '题目id
  Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  Dim DaanArr() As String
  adoRS.Open "select * from 试卷填空题 where ID=" & TMid, LocalConn, adOpenStatic, adLockOptimistic
  If Not adoRS.EOF Then
     '显示
     RtbTK.Text = "   " + adoRS.Fields("问题").Value + "(" & adoRS.Fields("分数").Value & ")" + vbCrLf
     '显示空和答案
     Dim i As Integer
     For i = 1 To 30
       LabDaan(i).Visible = False
       TxTDaan(i).Visible = False
       TxTDaan(i).Text = ""
     Next i
     'rtbTK.Tag里面保存空个数,以后可以用
     RtbTK.Tag = adoRS.Fields("空数").Value
     For i = 1 To adoRS.Fields("空数").Value
       LabDaan(i).Visible = True
       TxTDaan(i).Visible = True
     Next i
    '显示答案
     If Len(adoRS.Fields("考生答案").Value) > 0 Then
       DaanArr = Split(adoRS.Fields("考生答案").Value, "▲▲")
       For i = 0 To UBound(DaanArr)
        TxTDaan(i + 1).Text = DaanArr(i)
       Next i
     End If
  End If
 Set adoRS = Nothing
End Sub
'看选择题
Sub ViewTM(ByVal adoTMRs As Recordset)
  Dim DAArr() As String
  Dim i As Integer
  
  TXTView.Text = "  " + adoTMRs.Fields("问题").Value + "(" + str(adoTMRs.Fields("分数").Value) + "分" + ")" + vbCrLf
  
  TXTView.Text = TXTView.Text + "    A、" + adoTMRs.Fields("A").Value + vbCrLf + vbCrLf
  TXTView.Text = TXTView.Text + "    B、" + adoTMRs.Fields("B").Value + vbCrLf + vbCrLf
  TXTView.Text = TXTView.Text + "    C、" + adoTMRs.Fields("C").Value + vbCrLf + vbCrLf
  TXTView.Text = TXTView.Text + "    D、" + adoTMRs.Fields("D").Value + vbCrLf + vbCrLf
  '清空
  For i = 0 To 3
    Check1(i).Value = 0
  Next i
  '显示答案
  If Len(adoTMRs.Fields("考生答案").Value) > 0 Then
   DAArr = Split(adoTMRs.Fields("考生答案").Value, ",")
   For i = 0 To UBound(DAArr)
     Check1(Asc(DAArr(i)) - 65).Value = 1
   Next i
  End If
  
End Sub
'保存选择题
Sub SaveDaAN()
Dim i As Integer
Dim DAan As String
For i = 0 To 3
If Check1(i).Value Then
   DAan = DAan & Check1(i).Caption & ","
End If
Next i
If DAan = "" Then DAan = "," '若此题未做
DAan = Left(DAan, Len(DAan) - 1)
Dim sql As String
sql = "update 试卷选择题 set 考生答案='" & DAan & "' where id=" & Val(TXTView.Tag)
LocalConn.Execute sql
End Sub
''保存作文题
Sub SaveZW()
  If LstZW.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstZW.Tag

  '保存
  Dim DAan As String
  DAan = RtbZW.Text
  Dim sql As String
  sql = "update 试卷作文题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub
''保存问答题
Sub SaveWD()
  If LstWD.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstWD.Tag
  
  Dim DAan As String
  DAan = RtbWDDA.Text
  Dim sql As String
  sql = "update 试卷问答题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub
''保存判断题
Sub SavePD()
  If LstPD.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstPD.Tag
  
  Dim DAan As String
  If OptDui = True Then
    DAan = "T"
  End If
  If OptCuo = True Then
    DAan = "F"
  End If
  Dim sql As String
  sql = "update 试卷判断题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub
''保存填空题
Sub SaveTK()
  If LstTK.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstTK.Tag
  
  Dim i As Integer
  Dim DAan As String
  For i = 1 To Val(RtbTK.Tag)
    DAan = DAan & TxTDaan(i).Text & "▲▲"
  Next i
  DAan = Left(DAan, Len(DAan) - 2)
  Dim sql As String
  sql = "update 试卷填空题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub

'处理交卷
'"▼▼"用于分割各填空题、问答题、作文的答案
'"▲▲"用于分割填空题各个空的字符
'函数返回true和false表示交卷是否成功
Function JiaoJuan() As Boolean
  JiaoJuan = False
  Dim Scores As Long '成绩
  'Dim Zscore As Long '总分
  Dim Danxuan As String, Duoxuan As String  '答案字符串
  Dim Danxuans As String, Duoxuans As String  '对应的分数字符串
  Dim Danxuanid As String, Duoxuanid As String  '对应的试卷ID字符串
  Dim TianKong As String, TianKongs As String, TianKongID As String '填空题
  Dim PanDuan As String, PanDuans As String, PanDuanID As String '判断题
  Dim WenDa As String, WenDas As String, WenDaID As String '问答题
  Dim ZuoWen As String, ZuoWens As String, ZuoWenID As String '作文题
  Dim TestID As Long '试卷标号
  '试卷基本信息
  Dim tempRS As Recordset
  Set tempRS = New Recordset
  tempRS.CursorLocation = adUseClient

  tempRS.Open "试卷信息", LocalConn, adOpenStatic, adLockOptimistic
  TestID = tempRS.Fields("试卷编号").Value
  'Zscore = tempRS.Fields("试卷总分").Value  '总分
  tempRS.Close
  Set tempRS = Nothing
  
  Dim rs As Recordset
  Set rs = New Recordset
  rs.CursorLocation = adUseClient

  '选择题
  rs.Open "试卷选择题", LocalConn, adOpenStatic, adLockOptimistic
  Do While Not rs.EOF
     If rs.Fields("类别").Value = "单" Then
        If rs.Fields("考生答案").Value <> "" Then
           Danxuan = Danxuan + rs.Fields("考生答案") + "/"
        Else
           Danxuan = Danxuan + "o" + "/"
        End If
        '试卷分数,ID'不正确分数为0
        If rs.Fields("考生答案").Value = rs.Fields("答案").Value Then
            Scores = Scores + rs.Fields("分数").Value
            Danxuans = Danxuans + Trim(str(rs.Fields("分数").Value)) + ","
           Else
            Danxuans = Danxuans + "0,"
        End If
        Danxuanid = Danxuanid + Trim(str(rs.Fields("ID").Value)) + ","
     ElseIf rs.Fields("类别").Value = "多" Then
        If rs.Fields("考生答案").Value <> "" Then
            Duoxuan = Duoxuan + rs.Fields("考生答案").Value + "/"
        Else
            Duoxuan = Duoxuan + "o" + "/"
        End If
        '试卷分数,ID'不正确分数为0
        If rs.Fields("考生答案").Value = rs.Fields("答案").Value Then
            Scores = Scores + rs.Fields("分数").Value
            Duoxuans = Duoxuans + Trim(str(rs.Fields("分数").Value)) + ","
           Else
            Duoxuans = Duoxuans + "0,"
        End If
        Duoxuanid = Duoxuanid + Trim(str(rs.Fields("ID").Value)) + ","
     End If
   
     rs.MoveNext
  Loop
  '填空题
  rs.Close
  rs.Open "试卷填空题", LocalConn, adOpenStatic, adLockOptimistic
  Do While Not rs.EOF
    TianKong = TianKong + rs.Fields("考生答案").Value + "▼▼"
    TianKongID = TianKongID & rs.Fields("ID").Value & ","
    TianKongs = TianKongs + ","
    rs.MoveNext
  Loop
  
  '填判断
  rs.Close
  rs.Open "试卷判断题", LocalConn, adOpenStatic, adLockOptimistic
  Do While Not rs.EOF
    PanDuan = PanDuan + rs.Fields("考生答案").Value + ","
    PanDuanID = PanDuanID & rs.Fields("ID").Value & ","
    If rs.Fields("考生答案").Value = rs.Fields("答案").Value Then
      Scores = Scores + rs.Fields("分数").Value
      PanDuans = PanDuans & rs.Fields("分数").Value & ","
     Else
      PanDuans = PanDuans + "0,"
    End If
    rs.MoveNext
  Loop
  
  '问答题
  rs.Close
  rs.Open "试卷问答题", LocalConn, adOpenStatic, adLockOptimistic
  Do While Not rs.EOF
    WenDa = WenDa + rs.Fields("考生答案").Value + "▼▼"
    WenDaID = WenDaID & rs.Fields("ID").Value & ","
    WenDas = WenDas + ","
    rs.MoveNext
  Loop
  
 '作文题
  rs.Close
  rs.Open "试卷作文题", LocalConn, adOpenStatic, adLockOptimistic
  Do While Not rs.EOF
    ZuoWen = ZuoWen + rs.Fields("考生答案").Value + "▼▼"
    ZuoWenID = ZuoWenID & rs.Fields("ID").Value & ","
    ZuoWens = ZuoWens + ","
    rs.MoveNext
  Loop
  '判断是否有该题型,没有则处理
  If Danxuan = "" Then
    Danxuan = "/"
    Danxuans = ","
    Danxuanid = ","
  End If
  If Duoxuan = "" Then
    Duoxuan = "/"
    Duoxuans = ","
    Duoxuanid = ","
  End If
  If TianKong = "" Then
    TianKong = "▼▼"
    TianKongID = ","
    TianKongs = ","
  End If
  If PanDuan = "" Then
    PanDuan = ","
    PanDuanID = ","
    PanDuans = ","
  End If
  If WenDa = "" Then
    WenDa = "▼▼"
    WenDaID = ","
    WenDas = ","
  End If
  If ZuoWen = "" Then
    ZuoWen = "▼▼"
    ZuoWenID = ","
    ZuoWens = ","
  End If
  '选择
  Danxuan = Left(Danxuan, Len(Danxuan) - 1)
  Duoxuan = Left(Duoxuan, Len(Duoxuan) - 1)
  Danxuans = Left(Danxuans, Len(Danxuans) - 1)
  Duoxuans = Left(Duoxuans, Len(Duoxuans) - 1)
  Danxuanid = Left(Danxuanid, Len(Danxuanid) - 1)
  Duoxuanid = Left(Duoxuanid, Len(Duoxuanid) - 1)
  '填空
  TianKong = Left(TianKong, Len(TianKong) - 2)
  TianKongID = Left(TianKongID, Len(TianKongID) - 1)
  TianKongs = Left(TianKongs, Len(TianKongs) - 1)
  ' 判断
  PanDuan = Left(PanDuan, Len(PanDuan) - 1)
  PanDuanID = Left(PanDuanID, Len(PanDuanID) - 1)
  PanDuans = Left(PanDuans, Len(PanDuans) - 1)
  '问答
  WenDa = Left(WenDa, Len(WenDa) - 2)
  WenDaID = Left(WenDaID, Len(WenDaID) - 1)
  WenDas = Left(WenDas, Len(WenDas) - 1)
  '作文
  ZuoWen = Left(ZuoWen, Len(ZuoWen) - 2)
  ZuoWenID = Left(ZuoWenID, Len(ZuoWenID) - 1)
  ZuoWens = Left(ZuoWens, Len(ZuoWens) - 1)
  '提交分数
  Dim RemoteConn As Connection
  Set RemoteConn = New Connection
  Dim sql As String
  Dim ID As Long
  RemoteConn.Open ConnString '
  ID = GetAutoID("score")
  '判断题和基本信息
  sql = "insert into score(id,studentid,testid,testtime,score,danxuan,danxuanid,danxuans,duoxuan,duoxuanid,duoxuans,complete) values(" & ID & "," + StudentID + "," & TestID & ",'" + Format(Date, "yyyy-mm-dd") & "'," & Scores & ",'" + Danxuan + "','" + Danxuanid + "','" + Danxuans + "','" + Duoxuan + "','" + Duoxuanid + "','" + Duoxuans + "','F')"
  RemoteConn.Execute sql
  '填空题
  If TianKong <> "" Then
   sql = "insert into scoreTK(id,tiankong,tiankongid,tiankongs) values (" & ID & ",'" + TianKong + "','" + TianKongID + "','" + TianKongs + "')"
   RemoteConn.Execute sql
  End If
  
  '判断题
  If PanDuan <> "" Then
    sql = "insert into scorePD(id,panduan,panduanid,panduans) values (" & ID & ",'" + PanDuan + "','" + PanDuanID + "','" + PanDuans + "')"
    RemoteConn.Execute sql
  End If
  
  '问答题
  If WenDa <> "" Then
    sql = "insert into scoreWD(id,wenda,wendaid,wendas) values (" & ID & ",'" + WenDa + "','" + WenDaID + "','" + WenDas + "')"
    RemoteConn.Execute sql
  End If
  
  '作文题
  If ZuoWen <> "" Then
    sql = "insert into scoreZW(id,zuowen,zuowenid,zuowens) values (" & ID & ",'" + ZuoWen + "','" + ZuoWenID + "','" + ZuoWens + "')"
    RemoteConn.Execute sql
  End If
  
  '释放资源
  rs.Close
  Set rs = Nothing
  RemoteConn.Close
  Set RemoteConn = Nothing
  JiaoJuan = True
  MsgBox "你的选择题和判断题的总成绩为 " & Scores & " 分" + vbCrLf + "其他题型等老师判完卷以后才知道！"
  
End Function


Sub DelDB() '删除数据库
  Dim sql As String
  sql = "delete from 试卷选择题"
  LocalConn.Execute sql
  sql = "delete from 试卷信息"
  LocalConn.Execute sql
  sql = "delete from 试卷填空题"
  LocalConn.Execute sql
  sql = "delete from 试卷判断题"
  LocalConn.Execute sql
  sql = "delete from 试卷问答题"
  LocalConn.Execute sql
  sql = "delete from 试卷作文题"
  LocalConn.Execute sql
  If Dir(App.Path + "\temp.html") <> "" Then
     Kill App.Path + "\temp.html"
  End If
End Sub