frmseachtm.frm

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

         TabIndex        =   1
         Top             =   255
         Width           =   11190
         _ExtentX        =   19738
         _ExtentY        =   9631
         _Version        =   393216
         AllowUpdate     =   0   'False
         BackColor       =   15267064
         HeadLines       =   1
         RowHeight       =   18
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            MarqueeStyle    =   3
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "FrmSeachTM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim KeMuIdArr() As Long '科目id数组
Dim NianJiIdArr() As Long
'####################################非常重要
Function GetTJStr() As String
   '定义查询条件,保存各个查询条件
 Dim SqlID As String
 Dim SqlTitle As String
 Dim SqlKeMu As String
 Dim SqlNianJi As String
 Dim SqlScore As String

 '设置ID查询条件
 If TXTID.Text <> "" Then
   SqlID = " and test.id=" + TXTID.Text
  Else
   SqlID = ""
 End If
 '设置问题关键子
 If TXTTitle.Text <> "" Then
   SqlTitle = " and title like '%" + TXTTitle.Text + "%'"
  Else
   SqlTitle = ""
 End If
'设置年份
 If CmbNianJi.ListIndex = 0 Then
   SqlNianJi = ""
  Else
   SqlNianJi = " and nianjiid=" & NianJiIdArr(CmbNianJi.ListIndex - 1)
 End If
 '设置科目
 If CmbKeMu.ListIndex = 0 Then
   SqlKeMu = ""
  Else
   SqlKeMu = " and kemuid=" & KeMuIdArr(CmbKeMu.ListIndex - 1)
 End If
 '设置分数
 If TXTScore.Text <> "" Then
   SqlScore = " and zscore" + CmbCZS.Text + TXTScore.Text
  Else
   SqlScore = ""
 End If
 GetTJStr = SqlID + SqlTitle + SqlKeMu + SqlNianJi + SqlScore
End Function
Private Sub CmdSeach_Click()
  Dim adoTMRs As Recordset
   Dim sql As String
 Set adoTMRs = New Recordset

 '==========================================
 sql = "select test.id as 试卷ID,test.title as 试卷标题,kemu.name as 科目,nianji.name as 年份,test.zscore as 试卷总分 from test,kemu,nianji where test.kemuid=kemu.id and test.nianjiid=nianji.id"
 sql = sql + GetTJStr()
 adoTMRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
 Set DGSJ.DataSource = adoTMRs

End Sub







Private Sub Command1_Click()
If MsgBox("你真的要删掉这份试卷吗？", vbYesNo, "提问？") = vbYes Then
    Dim sql As String
    sql = "delete from test where id='" + DGSJ.Columns(0).Text + "'"
    adoCn.Execute sql
    '更新
    Dim adoRs As Recordset
    Set adoRs = New Recordset
    adoRs.Open "select test.id as 试卷ID,test.title as 试卷标题,kemu.name as 科目,nianji.name as 年份,test.zscore as 试卷总分 from test,kemu,nianji where test.kemuid=kemu.id and test.nianjiid=nianji.id", adoCn, adOpenStatic, adLockOptimistic
    Set DGSJ.DataSource = adoRs
    Set adoRs = Nothing
 End If
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Command3_Click()
If DGSJ.Row < 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 id=" + DGSJ.Columns(0).Text
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", DGSJ.Columns(1).Text, DaView, adoTMRs, adoTMRsd
   '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 Form_Load()
 Dim adoRs As Recordset
 Set adoRs = New Recordset
 Dim i As Integer
 '添加总类到下来框
  
'年份
adoRs.Open "select id,name from nianji", adoCn, adOpenStatic, adLockOptimistic
CmbNianJi.AddItem "所有年份"
If Not adoRs.EOF Then
  adoRs.MoveLast
  adoRs.MoveFirst
  ReDim NianJiIdArr(adoRs.RecordCount) As Long
  For i = 0 To adoRs.RecordCount - 1
     CmbNianJi.AddItem adoRs.Fields("name").Value
     NianJiIdArr(i) = adoRs.Fields("id").Value
     adoRs.MoveNext
  Next i
End If
adoRs.Close
'科目
adoRs.Open "kemu", adoCn, adOpenStatic, adLockOptimistic
CmbKeMu.AddItem "所有科目"
If Not adoRs.EOF Then
  adoRs.MoveLast
  adoRs.MoveFirst
  ReDim KeMuIdArr(adoRs.RecordCount) As Long
  For i = 0 To adoRs.RecordCount - 1
     CmbKeMu.AddItem adoRs.Fields("name").Value
     KeMuIdArr(i) = adoRs.Fields("id").Value
     adoRs.MoveNext
  Next i
End If
CmbKeMu.ListIndex = 0
CmbNianJi.ListIndex = 0
CmbCZS.ListIndex = 0
adoRs.Close
  '查询显示所有试卷
 adoRs.Open "select test.id as 试卷ID,test.title as 试卷标题,kemu.name as 科目,nianji.name as 年份,test.zscore as 试卷总分 from test,kemu,nianji where test.kemuid=kemu.id and test.nianjiid=nianji.id", adoCn, adOpenStatic, adLockOptimistic
 Set DGSJ.DataSource = adoRs

End Sub

Private Sub TXTID_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 TXTScore_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 TxTTitle_KeyPress(KeyAscii As Integer)
   If KeyAscii = 39 Then KeyAscii = -24145

End Sub