⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmkaoshi.frm

📁 自己用vb开发的局域网考试系统
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
         EndProperty
      End
      Begin VB.Line Line1 
         BorderWidth     =   2
         X1              =   6750
         X2              =   6750
         Y1              =   4995
         Y2              =   5265
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "答案:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000C0&
         Height          =   210
         Left            =   5415
         TabIndex        =   25
         Top             =   5010
         Width           =   525
      End
      Begin VB.Line Line2 
         BorderWidth     =   2
         X1              =   7305
         X2              =   7305
         Y1              =   4995
         Y2              =   5265
      End
      Begin VB.Shape Shape2 
         BackColor       =   &H00E8F4F8&
         FillColor       =   &H00FFFFFF&
         FillStyle       =   0  'Solid
         Height          =   315
         Left            =   5940
         Top             =   4965
         Width           =   1950
      End
   End
   Begin VB.Image ImgXZ 
      Height          =   960
      Left            =   4080
      MouseIcon       =   "FrmKaoShi.frx":F07A
      MousePointer    =   99  'Custom
      Picture         =   "FrmKaoShi.frx":F4BC
      Top             =   7680
      Visible         =   0   'False
      Width           =   1305
   End
   Begin VB.Image imgSubmit 
      Height          =   960
      Left            =   9960
      MouseIcon       =   "FrmKaoShi.frx":11A0F
      MousePointer    =   99  'Custom
      Picture         =   "FrmKaoShi.frx":11E51
      Top             =   7560
      Visible         =   0   'False
      Width           =   1305
   End
End
Attribute VB_Name = "FrmKaoShi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'保存时从1开始算,0号为空
'Dim TKIDArr() As Long '填空题id数组
'Dim PDIDArr() As Long '判断题id数组
'Dim WDIDArr() As Long '问答题id数组
'Dim ZWIDArr() As Long '作文题id数组
Dim OldDAan As String '保存旧一次的答案
Dim NewWho As Integer '表示现在操作那个题型
Dim CountSec As Long '考试的总秒数
'由ID值求他的对应题目的分数
Function GetScoreByID(ScoreArr() As String, ByVal ID As Long) As String
    Dim i As Long
    Dim strArr() As String
    For i = 0 To UBound(ScoreArr)
      strArr = Split(ScoreArr(i), ",")
      If strArr(0) = Int2Str(ID) Then
        GetScoreByID = strArr(1)
        Exit Function
      End If
    Next i
    GetScoreByID = ""
End Function
 '生成本机数据
Function CreateTest() As Boolean
  Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  adoRS.Open "kaoshixinxi", ConnString, adOpenStatic, adLockOptimistic
   '读题目
  '判断是否发卷
'  If adoRS.EOF Then
'     CreateTest = False
'     Exit Function
'   Else
    '创建本地试卷信息
    
     Dim LocaladoRs As Recordset
     Set LocaladoRs = New Recordset
     LocaladoRs.CursorLocation = adUseClient

     LocaladoRs.Open "试卷信息", LocalConn, adOpenStatic, adLockOptimistic
     If Not LocaladoRs.EOF Then LocaladoRs.Delete
     LocaladoRs.AddNew
     LocaladoRs.Fields("试卷标题").Value = adoRS.Fields("title").Value
     LabTitle.Caption = adoRS.Fields("title").Value
     LocaladoRs.Fields("考试日期").Value = Date '当天
     LocaladoRs.Fields("试卷编号").Value = adoRS.Fields("id").Value
     LocaladoRs.Fields("试卷总分").Value = adoRS.Fields("zscore").Value
     LabScore.Caption = "总分:" & adoRS.Fields("zscore").Value & "分"
     'LocaladoRs.Fields("科目ID").Value = adoRS.Fields("kemuid").Value
     'LocaladoRs.Fields("年级ID").Value = adoRS.Fields("nianjiid").Value
     LocaladoRs.Update
     Set LocaladoRs = Nothing
     '保存题目id数组
     Dim TempIDArr() As String
     '保存题目分数数组
     Dim TempScoreArr() As String
     Dim Pcount As Integer '题目的个数
     'Dim TLong As Long
     Dim i As Integer
     Dim ScoreArr() As String  '保存分数和题目对应的数组
     Dim sql As String
     '定义保存试卷题目的记录集
     Dim adoSJRs As Recordset
     Set adoSJRs = New Recordset
     adoSJRs.CursorLocation = adUseClient
     
     '清空本地数据库
     LocalConn.Execute "delete 试卷选择题"

     
     '生成单选题
     '========判断是否有单选题
     If adoRS.Fields("danxuan").Value <> "" Then
     
       TempIDArr = Split(adoRS.Fields("danxuan").Value, ",")
       TempScoreArr = Split(adoRS.Fields("danxuans").Value, ",")
       Pcount = UBound(TempIDArr)
       ReDim ScoreArr(Pcount + 1)
       For i = 0 To Pcount
          ScoreArr(i) = TempIDArr(i) + "," + TempScoreArr(i)
       Next i
       sql = "select id,wenti,xuanze1,xuanze2,xuanze3,xuanze4,daan from question where id in (" + adoRS.Fields("danxuan").Value + ")"
       adoSJRs.Open sql, ConnString, adOpenStatic, adLockOptimistic

       '插入本地数据库
       Do While Not adoSJRs.EOF
        '创建本地试卷
        sql = "insert into 试卷选择题(ID,问题,A,B,C,D,答案,分数,考生答案,类别) values(" + Str(adoSJRs.Fields("id").Value) + ",'"
        sql = sql + adoSJRs.Fields("wenti").Value + "','" + adoSJRs.Fields("xuanze1").Value + "','" + adoSJRs.Fields("xuanze2").Value + "','"
        sql = sql + adoSJRs.Fields("xuanze3").Value + "','" + adoSJRs.Fields("xuanze4").Value + "','" + adoSJRs.Fields("daan").Value + "'," + GetScoreByID(ScoreArr, adoSJRs.Fields("id").Value) + ",'','"
        sql = sql + "单')"
        LocalConn.Execute sql
        adoSJRs.MoveNext
       Loop
    
    
       '关闭adosjrs对象
       adoSJRs.Close
     
'     End If
     
     
    '生成多选题
     If adoRS.Fields("duoxuan").Value <> "" Then
     
     TempIDArr = Split(adoRS.Fields("duoxuan").Value, ",")
       TempScoreArr = Split(adoRS.Fields("duoxuans").Value, ",")
       Pcount = UBound(TempIDArr)
       ReDim ScoreArr(Pcount + 1)
       For i = 0 To Pcount
          ScoreArr(i) = TempIDArr(i) + "," + TempScoreArr(i)
       Next i
       sql = "select id,wenti,xuanze1,xuanze2,xuanze3,xuanze4,daan from question where id in (" + adoRS.Fields("duoxuan").Value + ")"
       adoSJRs.Open sql, ConnString, adOpenStatic, adLockOptimistic
       '插入本地数据库
       Do While Not adoSJRs.EOF
        '创建本地试卷
        sql = "insert into 试卷选择题(ID,问题,A,B,C,D,答案,分数,考生答案,类别) values(" + Str(adoSJRs.Fields("id").Value) + ",'"
        sql = sql + adoSJRs.Fields("wenti").Value + "','" + adoSJRs.Fields("xuanze1").Value + "','" + adoSJRs.Fields("xuanze2").Value + "','"
        sql = sql + adoSJRs.Fields("xuanze3").Value + "','" + adoSJRs.Fields("xuanze4").Value + "','" + adoSJRs.Fields("daan").Value + "'," + GetScoreByID(ScoreArr, adoSJRs.Fields("id").Value) + ",'','"
        sql = sql + "多')"
        LocalConn.Execute sql
        adoSJRs.MoveNext
       Loop
       '关闭adosjrs对象
       adoSJRs.Close
    End If
    
    '生成填空题
'     If adoRS.Fields("tiankong").Value <> "" Then
'
'       TempIDArr = Split(adoRS.Fields("tiankong").Value, ",")
'       TempScoreArr = Split(adoRS.Fields("tiankongs").Value, ",")
'       Pcount = UBound(TempIDArr)
'       ReDim ScoreArr(Pcount + 1)
'       For i = 0 To Pcount
'          ScoreArr(i) = TempIDArr(i) + "," + TempScoreArr(i)
'       Next i
'       sql = "select id,wenti,Kcount from questionTK where id in (" + adoRS.Fields("tiankong").Value + ")"
'       adoSJRs.Open sql, ConnString, adOpenStatic, adLockOptimistic
'       '插入本地数据库
'       Do While Not adoSJRs.EOF
'        '创建本地试卷
'        sql = "insert into 试卷填空题(ID,问题,空数,分数,考生答案) values(" + Str(adoSJRs.Fields("id").Value) + ",'"
'        sql = sql + adoSJRs.Fields("wenti").Value + "'," & adoSJRs.Fields("Kcount").Value & ","
'        sql = sql + GetScoreByID(ScoreArr, adoSJRs.Fields("id").Value) + ",'')"
'        LocalConn.Execute sql
'        adoSJRs.MoveNext
'       Loop
'       '关闭adosjrs对象
'       adoSJRs.Close
'    End If
'
'    '生成判断题
'     If adoRS.Fields("panduan").Value <> "" Then
'
'       TempIDArr = Split(adoRS.Fields("panduan").Value, ",")
'       TempScoreArr = Split(adoRS.Fields("panduans").Value, ",")
'       Pcount = UBound(TempIDArr)
'       ReDim ScoreArr(Pcount + 1)
'       For i = 0 To Pcount
'          ScoreArr(i) = TempIDArr(i) + "," + TempScoreArr(i)
'       Next i
'       sql = "select id,wenti,daan from questionPD where id in (" + adoRS.Fields("panduan").Value + ")"
'       adoSJRs.Open sql, ConnString, adOpenStatic, adLockOptimistic
'       '插入本地数据库
'       Do While Not adoSJRs.EOF
'        '创建本地试卷
'        sql = "insert into 试卷判断题(ID,问题,答案,分数,考生答案) values(" + Str(adoSJRs.Fields("id").Value) + ",'"
'        sql = sql + adoSJRs.Fields("wenti").Value + "','" & adoSJRs.Fields("daan").Value & "',"
'        sql = sql + GetScoreByID(ScoreArr, adoSJRs.Fields("id").Value) + ",'')"
'        LocalConn.Execute sql
'        adoSJRs.MoveNext
'       Loop
'       '关闭adosjrs对象
'       adoSJRs.Close
'    End If
'
'    '生成问答题
'     If adoRS.Fields("wenda").Value <> "" Then
'
'       TempIDArr = Split(adoRS.Fields("wenda").Value, ",")
'       TempScoreArr = Split(adoRS.Fields("wendas").Value, ",")
'       Pcount = UBound(TempIDArr)
'       ReDim ScoreArr(Pcount + 1)
'       For i = 0 To Pcount
'          ScoreArr(i) = TempIDArr(i) + "," + TempScoreArr(i)
'       Next i
'       sql = "select id,wenti from questionWD where id in (" + adoRS.Fields("wenda").Value + ")"
'       adoSJRs.Open sql, ConnString, adOpenStatic, adLockOptimistic
'       '插入本地数据库
'       Do While Not adoSJRs.EOF
'        '创建本地试卷
'        sql = "insert into 试卷问答题(ID,问题,分数,考生答案) values(" + Str(adoSJRs.Fields("id").Value) + ",'"
'        sql = sql + adoSJRs.Fields("wenti").Value + "',"
'        sql = sql + GetScoreByID(ScoreArr, adoSJRs.Fields("id").Value) + ",'')"
'        LocalConn.Execute sql
'        adoSJRs.MoveNext
'       Loop
'       '关闭adosjrs对象
'       adoSJRs.Close
'    End If
'
'     '生成作文题
'     If adoRS.Fields("zuowen").Value <> "" Then
'
'       TempIDArr = Split(adoRS.Fields("zuowen").Value, ",")
'       TempScoreArr = Split(adoRS.Fields("zuowens").Value, ",")
'       Pcount = UBound(TempIDArr)
'       ReDim ScoreArr(Pcount + 1)
'       For i = 0 To Pcount
'          ScoreArr(i) = TempIDArr(i) + "," + TempScoreArr(i)
'       Next i
'       sql = "select id,wenti from questionZW where id in (" + adoRS.Fields("zuowen").Value + ")"
'       adoSJRs.Open sql, ConnString, adOpenStatic, adLockOptimistic
'       '插入本地数据库
'       Do While Not adoSJRs.EOF
'        '创建本地试卷
'        sql = "insert into 试卷作文题(ID,问题,分数,考生答案) values(" + Str(adoSJRs.Fields("id").Value) + ",'"
'        sql = sql + adoSJRs.Fields("wenti").Value + "',"
'        sql = sql + GetScoreByID(ScoreArr, adoSJRs.Fields("id").Value) + ",'')"
'        LocalConn.Execute sql
'        adoSJRs.MoveNext
'       Loop
'       '关闭adosjrs对象
'       adoSJRs.Close
'    End If
'
'    '悉放对象
'    Set adoRS = Nothing
'    Set adoSJRs = Nothing
'
'
  End If
     
End Function
'Sub RefScore()
'     Dim adoRS As Recordset
'     Set adoRS = New Recordset
'     adoRS.CursorLocation = adUseClient
'
'     adoRS.Open "scores", ConnString, adOpenStatic, adLockOptimistic
'
'    '创建本地试卷信息
'
'     Dim LocaladoRs As Recordset
'     Set LocaladoRs = New Recordset
'     LocaladoRs.CursorLocation = adUseClient
'
'     LocaladoRs.Open "试卷选择题", LocalConn, adOpenStatic, adLockOptimistic
'
'     adoRS.AddNew
'     adoRS.Fields ("")
'End Sub
Private Sub CmdRefer_Click()
'交卷
 Dim answer As String
 SaveDaAN

 answer = MsgBox("你确定真的要交卷吗?请认真检查！", vbExclamation + vbYesNo, "确定")
 If answer = vbYes Then
   If JiaoJuan = True Then '处理交卷
      '记录此次考试的成绩和内容

      
      DelDB
      MsgBox "你已经成功的交了卷！请到首页查看成绩"
      Unload Me
    Else
      MsgBox "交卷失败，请重试或者报告管理员！"
   End If
 End If
End Sub

Private Sub cmdStart_Click()
Timer1.Enabled = True
TrVTM.Enabled = True
Dim i As Integer
For i = 0 To 3
   Check1(i).Enabled = True
Next i
CmdRefer.Enabled = True
cmdStart.Enabled = False


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 Form_Load()
'Me.Height = 9000
'Me.Width = 12000
'判断是否发试卷
'判断是否已经生成本地数据库
Dim adoRS As Recordset
Set adoRS = New Recordset
adoRS.CursorLocation = adUseClient

CreateTest '生成试卷
adoRS.Open "试卷信息", LocalConn, adOpenStatic, adLockOptimistic
'If adoRS.EOF Then
 
'  Else
   LabTitle.Caption = adoRS.Fields("试卷标题").Value
   LabScore.Caption = "总分:" & adoRS.Fields("试卷总分").Value & "分"
'End If

adoRS.Close
adoRS.Open "select ctime from kaoshixinxi", LocalConn, adOpenStatic, adLockOptimistic
CountSec = adoRS.Fields("ctime").Value
labTime.Caption = Sec2Time(CountSec)
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -