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

📄 frmkaoshi.frm

📁 自己用vb开发的局域网考试系统
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
            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 imgSubmit 
      Height          =   960
      Left            =   9240
      MouseIcon       =   "FrmKaoShi.frx":DE32
      MousePointer    =   99  'Custom
      Picture         =   "FrmKaoShi.frx":E274
      Top             =   7680
      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 '表示现在操作那个题型
'由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
     
     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

     
     '生成单选题
     '========判断是否有单选题
     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






Private Sub Command5_Click()
End Sub

Private Sub Command6_Click()

End Sub

Private Sub Form_Load()
'判断是否发试卷
'判断是否已经生成本地数据库
Dim adoRS As Recordset
Set adoRS = New Recordset
adoRS.CursorLocation = adUseClient

adoRS.Open "试卷信息", LocalConn, adOpenStatic, adLockOptimistic
If adoRS.EOF Then
   CreateTest '生成试卷
  Else
   LabTitle.Caption = adoRS.Fields("试卷标题").Value
   LabScore.Caption = "总分:" & adoRS.Fields("试卷总分").Value & "分"
End If
 '创建选择题的树
 CreateTree
 
'显示填空题显示
adoRS.Close
adoRS.Open "select ID from 试卷填空题", LocalConn, adOpenStatic, adLockOptimistic
LstTK.Clear
If Not adoRS.EOF Then
  adoRS.MoveLast
  adoRS.MoveFirst
  '重定义
  ReDim TKIDArr(adoRS.RecordCount + 1) As Long
  Do While Not adoRS.EOF
     LstTK.AddItem "第" & adoRS.AbsolutePosition & "题"
     TKIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
     adoRS.MoveNext
  Loop
End If

'显示判断题显示
adoRS.Close
adoRS.Open "select ID from 试卷判断题", LocalConn, adOpenStatic, adLockOptimistic
LstPD.Clear
If Not adoRS.EOF Then
  adoRS.MoveLast
  adoRS.MoveFirst
  '重定义
  ReDim PDIDArr(adoRS.RecordCount + 1) As Long
  Do While Not adoRS.EOF
     LstPD.AddItem "第" & adoRS.AbsolutePosition & "题"
     PDIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
     adoRS.MoveNext
  Loop
End If

'显示问答题显示
adoRS.Close
adoRS.Open "select ID from 试卷问答题", LocalConn, adOpenStatic, adLockOptimistic
LstWD.Clear
If Not adoRS.EOF Then
  adoRS.MoveLast
  adoRS.MoveFirst
  '重定义
  ReDim WDIDArr(adoRS.RecordCount + 1) As Long
  Do While Not adoRS.EOF
     LstWD.AddItem "第" & adoRS.AbsolutePosition & "题"
     WDIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
     adoRS.MoveNext
  Loop
End If

'显示作文题显示
adoRS.Close
adoRS.Open "select ID from 试卷作文题", LocalConn, adOpenStatic, adLockOptimistic
LstZW.Clear
If Not adoRS.EOF Then
  adoRS.MoveLast
  adoRS.MoveFirst
  '重定义
  ReDim ZWIDArr(adoRS.RecordCount + 1) As Long
  Do While Not adoRS.EOF
     LstZW.AddItem "第" & adoRS.AbsolutePosition & "题"
     ZWIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
     adoRS.MoveNext
  Loop
End If
'显示背景图片
PicXZ.Picture = Me.Picture
PicTK.Picture = Me.Picture
PicPD.Picture = Me.Picture
PicWD.Picture = Me.Picture
PicZW.Picture = Me.Picture
'产生填空框
CreateDA
'初始化
12345

⌨️ 快捷键说明

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