机房收费系统——组合查询

机房收费系统中,多次用到组合查询,经过上网查资料、请教同学、类比学生信息管理系统,我终于能够实现这个功能了,尽管还存在很多漏洞。下面分享一下代码,希望大家多多指教。

界面展示:

代码展示:

Option Explicit
Dim Index As Integer
'自定义查空事件
Private Sub checktext(Index As Integer)
      If Not Testtxt(cboField(Index).Text) Then
          MsgBox "请选择字段名", vbOKOnly + vbInformation, "温馨提示"
          cboField(Index).SetFocus
          Exit Sub
      End If
      If Not Testtxt(cboSign(Index).Text) Then
          MsgBox "请选择操作符", vbOKOnly + vbInformation, "温馨提示"
          cboSign(Index).SetFocus
          Exit Sub
      End If
      If Not Testtxt(txtInput(Index).Text) Then
          MsgBox "请输入要查询的内容", vbOKOnly + vbInformation, "温馨提示"
          txtInput(Index).SetFocus
          Exit Sub
      End If
End Sub
Private Sub cmdCheck_Click()
Dim fields(0 To 4) As String
Dim relation(0 To 1) As String
Dim mrc As ADODB.Recordset
Dim txtsql As String
Dim msgtext As String
Dim dd(3) As Boolean
'定义变量,将不同的选择转化为表中的字段名送到变量中
fields(0) = "cardno"
fields(1) = "studentname"
fields(2) = "ondate"
fields(3) = "ontime"
fields(4) = "computer"

relation(0) = " and "
relation(1) = " or "

On Error Resume Next

'若配套的字段名+操作符+输入内容(+关系)均不为空,则用dd=true标记
If Trim(cboField(0).Text) <> "" And Trim(cboSign(0).Text) <> "" And Trim(txtInput(0).Text) <> "" Then
     dd(1) = True
Else
     dd(1) = False
End If
If Trim(cboField(1).Text) <> "" And Trim(cboSign(1).Text) <> "" And Trim(txtInput(1).Text) <> "" And cboRelation(0).Text <> "" Then
     dd(2) = True
Else
     dd(2) = False
End If
If Trim(cboField(2).Text) <> "" And Trim(cboSign(2).Text) <> "" And Trim(txtInput(2).Text) <> "" And cboRelation(1).Text <> "" Then
     dd(3) = True
Else
     dd(3) = False
End If

txtsql = "select * from online_info where "

'处理情况
If dd(1) = True Then
     If dd(2) = True Then
          If dd(3) = True Then  '第一种情况,三个条件都输入
              txtsql = txtsql & Trim(fields(cboField(0).ListIndex)) & Trim(cboSign(0).Text) & "'" & Trim(txtInput(0).Text) & "'" _
                           & (relation(cboRelation(0).ListIndex)) & Trim(fields(cboField(1).ListIndex)) & Trim(cboSign(1).Text) & "'" & Trim(txtInput(1).Text) & "'" _
                           & relation(cboRelation(1).ListIndex) & Trim(fields(cboField(2).ListIndex)) & Trim(cboSign(2).Text) & "'" & Trim(txtInput(2).Text) & "'"

          Else  '第一行和第二行输入
             txtsql = txtsql & Trim(fields(cboField(0).ListIndex)) & Trim(cboSign(0).Text) & "'" & Trim(txtInput(0).Text) & "'" _
                           & relation(cboRelation(0).ListIndex) & Trim(fields(cboField(1).ListIndex)) & Trim(cboSign(1).Text) & "'" & Trim(txtInput(1).Text) & "'"
          End If
     Else  '只有第一行的条件输入
          txtsql = txtsql & Trim(fields(cboField(0).ListIndex)) & Trim(cboSign(0).Text) & "'" & Trim(txtInput(0).Text) & "'"
     End If
Else   '没有输入完整的条件,查空
     Call checktext(0)
     Exit Sub
End If

Set mrc = ExecuteSQL(txtsql, msgtext)
     
'查询结果处理
      If mrc.EOF Then
               MsgBox "没有找到符合要求的结果!", vbOKOnly + vbInformation, "温馨提示"
                With MSHFlexGrid1
                    .Rows = 1
                    .CellAlignment = 4
                    .TextMatrix(0, 0) = "卡号"
                    .TextMatrix(0, 1) = "姓名"
                    .TextMatrix(0, 2) = "上机日期"
                    .TextMatrix(0, 3) = "上机时间"
                    .TextMatrix(0, 4) = "机房号"
               End With
               Exit Sub
     Else
           With MSHFlexGrid1
                    .Rows = 1
                    .CellAlignment = 4
                    .TextMatrix(0, 0) = "卡号"
                    .TextMatrix(0, 1) = "姓名"
                    .TextMatrix(0, 2) = "上机日期"
                    .TextMatrix(0, 3) = "上机时间"
                    .TextMatrix(0, 4) = "机房号"
                Do While Not mrc.EOF
                    .Rows = .Rows + 1
                    .TextMatrix(.Rows - 1, 0) = mrc.fields("cardno")
                    .TextMatrix(.Rows - 1, 1) = mrc.fields("studentname")
                    .TextMatrix(.Rows - 1, 2) = mrc.fields("ondate")
                    .TextMatrix(.Rows - 1, 3) = mrc.fields("ontime")
                    .TextMatrix(.Rows - 1, 4) = mrc.fields("computer")
                    mrc.MoveNext
                Loop
          End With
          mrc.Close
      End If
End Sub
Private Sub cmdExit_Click()
     Unload Me
End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值