frmshezhi.frm

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

               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   660
            TabIndex        =   11
            Top             =   1455
            Width           =   1470
         End
         Begin VB.Label Label5 
            AutoSize        =   -1  'True
            Caption         =   "小时"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   2685
            TabIndex        =   10
            Top             =   1800
            Width           =   690
         End
         Begin VB.Label Label6 
            AutoSize        =   -1  'True
            Caption         =   "分钟"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   4200
            TabIndex        =   9
            Top             =   1800
            Width           =   420
         End
      End
      Begin VB.Frame Frame2 
         Height          =   7560
         Left            =   180
         TabIndex        =   1
         Top             =   225
         Width           =   3510
         Begin VB.ListBox LstTest 
            Appearance      =   0  'Flat
            BackColor       =   &H00E8F4F8&
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   6510
            Left            =   285
            TabIndex        =   2
            Top             =   780
            Width           =   3015
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "所有生成的试卷："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Left            =   150
            TabIndex        =   3
            Top             =   315
            Width           =   1920
         End
      End
   End
End
Attribute VB_Name = "FrmShezhi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义一个数组来保存对应试卷的id
Dim TestIdArr() As Long
Dim CountSec As Long '考试的总秒数

Private Sub CmdEnd_Click()
'  If CountSec > 0 Then
     If MsgBox("收回后将没有被激活的考试，你确认吗？", vbYesNo, "提问") = vbYes Then
        adoCn.Execute "delete from kaoshixinxi"
        CmdSet.Enabled = True
        CmdStart.Enabled = True
        CmdEnd.Enabled = False
        Label7.Visible = False
'        Timer1.Enabled = False
'        LabTime.Caption = "00:00:00"
'        CountSec = 0
     End If
'  End If
End Sub

Private Sub CmdSet_Click()
Dim TimeStr As String
 '提交
If LstTest.ListIndex < 0 Then
MsgBox "请选择考试的试卷名称", vbExclamation, "提示"
Exit Sub
End If
'判断是否设置考试时间
If TxTHour.Text = 0 And TXTFen.Text = 0 Then
   MsgBox "请先设置考试总时间！"
   Exit Sub
End If
'询问是否真的设置这个时间
TimeStr = Format(TxTHour.Text, "00") + ":" + Format(TXTFen.Text, "00") + ":" + "00"
If MsgBox("你设置的考试总时间为：" + TimeStr + ",你真的继续吗？", vbYesNo, "提示！") = vbNo Then
   Exit Sub
End If

'提问是不是真的发卷
If MsgBox("你真的要选择该卷吗？", vbYesNo, "问题！") = vbNo Then
   Exit Sub
End If
Dim sql As String
Dim TempRs As Recordset
Set TempRs = New Recordset
sql = "select * from test where title='" & LstTest.List(LstTest.ListIndex) & "' and id=" + str(TestIdArr(LstTest.ListIndex))

TempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic

Dim sql1 As String
sql1 = "delete from kaoshixinxi"
'adocn.Execute sql1
Dim kaoshiRs As New Recordset
kaoshiRs.Open sql1, adoCn, adOpenStatic, adLockOptimistic


Dim xinxiRS As Recordset
Set xinxiRS = New Recordset
xinxiRS.Open "kaoshixinxi", adoCn, adOpenStatic, adLockOptimistic
xinxiRS.AddNew
xinxiRS.Fields("id") = TempRs.Fields("ID").Value
xinxiRS.Fields("kemuid") = TempRs.Fields("kemuid").Value
xinxiRS.Fields("nianjiid") = TempRs.Fields("nianjiid").Value
xinxiRS.Fields("title") = TempRs.Fields("title").Value
xinxiRS.Fields("danxuan") = TempRs.Fields("danxuan").Value
xinxiRS.Fields("duoxuan") = TempRs.Fields("duoxuan").Value
xinxiRS.Fields("danxuans") = TempRs.Fields("danxuans").Value
xinxiRS.Fields("duoxuans") = TempRs.Fields("duoxuans").Value

xinxiRS.Fields("tiankong") = TempRs.Fields("tiankong").Value
xinxiRS.Fields("panduan") = TempRs.Fields("panduan").Value
xinxiRS.Fields("tiankongs") = TempRs.Fields("tiankongs").Value
xinxiRS.Fields("panduans") = TempRs.Fields("panduans").Value

xinxiRS.Fields("wenda") = TempRs.Fields("wenda").Value
xinxiRS.Fields("zuowen") = TempRs.Fields("zuowen").Value
xinxiRS.Fields("wendas") = TempRs.Fields("wendas").Value
xinxiRS.Fields("zuowens") = TempRs.Fields("zuowens").Value

xinxiRS.Fields("zscore").Value = TempRs.Fields("zscore").Value
xinxiRS.Fields("start").Value = "F"
xinxiRS.Fields("ctime").Value = Time2Sec(TimeStr)
xinxiRS.Update

xinxiRS.Close
CountSec = Time2Sec(TimeStr)
Set xinxiRS = Nothing
TempRs.Close
Set TempRs = Nothing
MsgBox "试卷成功设置完成！你可以按<激活考试>设置考试端可以开始考试了！"
CmdSet.Enabled = False
CmdStart.Enabled = True
End Sub


Private Sub CmdStart_Click()
 '开始到记时
' If MsgBox("一旦开始考试以后只有等到考试结束以后才能退出该模块，你是否真的确定？", vbYesNo + 48, "问题") = vbYes Then
'   Timer1.Enabled = True
Dim sql As String
Dim adoRs As Recordset
Set adoRs = New Recordset
    sql = "update kaoshixinxi set start='T'"
'   adocn.Execute "update kaoshixinxi set start='T'"
    adoRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
   CmdStart.Enabled = False
   CmdEnd.Enabled = True
   Label7.Visible = True
   MsgBox "考试被激活，客户端可以考试了", vbExclamation, "提示"
' End If
End Sub

Private Sub CmdView_Click()
If LstTest.ListIndex < 0 Then
  MsgBox "请选择考试的试卷名称", vbExclamation, "提示"
  Exit Sub
End If
Dim sql As String
Dim adoRs As Recordset
Dim strid As String '题目 ID
Dim adoTMRs As Recordset
Dim adoTMRsd As Recordset
'Dim adoTMTK As Recordset
'Dim adoTMPD As Recordset
'Dim adoTMWD As Recordset
'Dim adoTMZW As Recordset

Dim sqld As String
'查询试卷
Set adoRs = New Recordset
sql = "select * from test where title='" & LstTest.List(LstTest.ListIndex) & "' and id=" + str(TestIdArr(LstTest.ListIndex))
adoRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'预览试卷
'单选
strid = adoRs.Fields("danxuan").Value
If strid = "" Then strid = "0"
Set adoTMRs = New Recordset
sql = "select * from question where id in (" + strid + ")" '
adoTMRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'多选
strid = adoRs.Fields("duoxuan").Value
If strid = "" Then strid = "0"
Set adoTMRsd = New Recordset
sqld = "select * from question where id in (" + strid + ") "
adoTMRsd.Open sqld, adoCn, adOpenStatic, adLockOptimistic
''填空
'strid = adoRs.Fields("tiankong").Value
'If strid = "" Then strid = "0"
'Set adoTMTK = New Recordset
'sqld = "select * from questionTK where id in (" + strid + ") "
'adoTMTK.Open sqld, adoCn, adOpenStatic, adLockOptimistic
''判断
'strid = adoRs.Fields("panduan").Value
'If strid = "" Then strid = "0"
'Set adoTMPD = New Recordset
'sqld = "select * from questionPD where id in (" + strid + ") "
'adoTMPD.Open sqld, adoCn, adOpenStatic, adLockOptimistic
''问答
'strid = adoRs.Fields("wenda").Value
'If strid = "" Then strid = "0"
'Set adoTMWD = New Recordset
'sqld = "select * from questionWD where id in (" + strid + ") "
'adoTMWD.Open sqld, adoCn, adOpenStatic, adLockOptimistic
''作文
'strid = adoRs.Fields("zuowen").Value
'If strid = "" Then strid = "0"
'Set adoTMZW = New Recordset
'sqld = "select * from questionZW where id in (" + strid + ") "
'adoTMZW.Open sqld, adoCn, adOpenStatic, adLockOptimistic

'生成HTML文件
Dim DaView As Boolean
DaView = False
If CheView = 1 Then
   DaView = True
End If
CreateHTML App.Path + "\temp.html", LstTest.List(LstTest.ListIndex), DaView, adoTMRs, adoTMRsd
', adoTMTK, adoTMPD, adoTMWD, adoTMZW
   'FrmView.Web.LocationURL = App.Path + "\temp.html"
   Set adoTMRs = Nothing
   Set adoTMRsd = Nothing
   Set adoTMTK = Nothing
   Set adoTMPD = Nothing
   Set adoTMWD = Nothing
   Set adoTMZW = Nothing
FrmView.Web.Navigate App.Path + "\temp.html"
FrmView.Show 1
End Sub



Private Sub Command2_Click()
 
 Unload Me
End Sub

Private Sub Form_Load()
Dim IdCount As Integer

'取得全部试卷
Dim Qurs As ADODB.Recordset
Set Qurs = New Recordset
Qurs.Open "select id,title from test where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
IdCount = 0
If Not Qurs.EOF Then
  Qurs.MoveLast
  Qurs.MoveFirst
  IdCount = Qurs.RecordCount
  ReDim TestIdArr(IdCount) As Long
  IdCount = -1
  Do While Not Qurs.EOF
    IdCount = IdCount + 1
    LstTest.AddItem Qurs.Fields("title").Value
    TestIdArr(IdCount) = Qurs.Fields("id").Value
    Qurs.MoveNext
  Loop
  LstTest.ListIndex = 0
Else
  MsgBox "还没有生成试卷,请先生成试卷!"
End If
  Qurs.Close
  Set Qurs = Nothing
End Sub

Private Sub Form_Resize()
  
    FrmMain.WindowState = Me.WindowState
End Sub

Private Sub Form_Unload(Cancel As Integer)
  '表示正在考试
 If CmdStart.Enabled = False And CmdSet.Enabled = False Then
    MsgBox "现在正在考试，不能退出考试控制界面！"
    Cancel = 1
 End If
 If CmdSet.Enabled = False Then
    If MsgBox("客户端正在考试，你真的要退出吗？", vbYesNo, "提问！") = vbYes Then
      '删除数据库
      adoCn.Execute "delete from kaoshixinxi"
     Else
      Cancel = 1
     End If
 End If
End Sub


Private Sub LstTest_Click()
 LabTitle.Caption = LstTest.List(LstTest.ListIndex)
End Sub

'Private Sub Timer1_Timer()
' CountSec = CountSec - 1
' LabTime.Caption = Sec2Time(CountSec)
' If CountSec <= 0 Then
'    Timer1.Enabled = False
'    MsgBox "交卷时间到！！"
'
' End If
'End Sub

Private Sub TXTFen_Change()
   LabTime.Caption = Format(TxTHour.Text, "00") + ":" + Format(TXTFen.Text, "00") + ":60"
End Sub

Private Sub TXTFen_KeyPress(KeyAscii As Integer)
 If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46) Then
  KeyAscii = 0
 End If

End Sub

Private Sub TxTHour_Change()
   LabTime.Caption = Format(TxTHour.Text, "00") + ":" + Format(TXTFen.Text, "00") + ":00"
End Sub

Private Sub TxTHour_KeyPress(KeyAscii As Integer)
  If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46) Then
  KeyAscii = 0
 End If

End Sub