query

组合查询 组合查询 组合查询

    uddDown = 1
End Enum

'查询条件
Private Enum QueryItem
    qiFields = 0        '查询字段
    qiOperation = 1     '关系符号
    qivalue = 2         '查询字段条件
    qiRelation = 3      '不同查询条件间的关系
End Enum

'查询字段的类型
Private Enum QueryFieldType
    qftSelect = 0
    qftNumber = 1
    qftString = 2
End Enum

'查询字段可选值的类型
Private Enum QuerySelectValueType
    qsvtInput = 0          '文本框输入
    qsvtSelect = 1         'ComboBox选择
    qsvtDateTime = 2       '时间类型
End Enum

Private mconQueryParam As ADODB.Connection
Private mrsQueryParam  As ADODB.Recordset
Private mrsValueToSelect  As ADODB.Recordset
Public mrsQueryResult  As ADODB.Recordset
Private mconQueryResult As ADODB.Connection

Private msQuerySql  As String            '当前输入查询条件sql语句
Private msQuerySource As String          '查询的表或视图
Private msFieldSource As String          '查询类型
Private msTotalTemp  As String           '当前输入的查询条件汇总
Private mRequestdb As RequestDB

Public mQueryPrintType As QueryPrintType '查询打印类型




Public Function Initialize(FormCaption As String, _
                           QuerySource As String, _
                           FieldSource As String) As Long
                           
    Dim sSql As String
    
    Dim strczyh As String
    Dim sSqlCzyh As String
    Dim lresult As Long
   
    
    strczyh = "01"
    
    Set mRequestdb = New RequestDB
    Set mrsQueryParam = New ADODB.Recordset
    Me.Caption = FormCaption
    msQuerySource = QuerySource
    msFieldSource = FieldSource
    Set mRequestdb.DBRecordset = mrsQueryParam
    
    sSqlCzyh = "select * from zhcx_dyzd where czyh='" & strczyh & "' and cxlx='" & msFieldSource & "'"
    lresult = mRequestdb.ExcuteQuery(sSqlCzyh)
    sSql = "select * from zhcx_cxcs where  cxlx='" & msFieldSource & "'"
    mRequestdb.ExcuteQuery (sSql)
    If lresult = 4 Then   '如果该操作员号不存在，读取全部字段，选中字段为空，查询字段为全部字段
        
        Call ReadValueToListControl(lstFields, mrsQueryParam, "zwmc")
        Call ReadValueToListControl(cmbQuery(qiFields), mrsQueryParam, "zwmc")
    Else                  '操作员号存在,判断是否存在选中字段
        sSql = "select * from cx_zhcx_cxcs where cxlx = '" _
               & msFieldSource & "' and czyh = '" & strczyh & "' and xz='" & 1 & "'"
        Set mrsValueToSelect = New ADODB.Recordset
        Set mRequestdb.DBRecordset = mrsValueToSelect
        lresult = mRequestdb.ExcuteQuery(sSql)
        If lresult <> 4 Then  '存在选中字段
            
            Call ReadValueToListControl(lstSelectedFields, mrsValueToSelect, "zwmc") '读取选中字段到选中字段列表框
            sSql = "select * from cx_zhcx_cxcs where cxlx = '" _
               & msFieldSource & "' and czyh = '" & strczyh & "' and xz='" & 0 & "'"
            Set mRequestdb.DBRecordset = mrsValueToSelect
            mRequestdb.ExcuteQuery (sSql)
            Call ReadValueToListControl(lstFields, mrsValueToSelect, "zwmc") ' 读取全部字段到全部字段列表框
            'Call RemoveSelected(lstSelectedFields, lstFields) '将选中字段从全部字段里移出
            Call ReadValueToListControl(cmbQuery(qiFields), mrsQueryParam, "zwmc") '读取全部字段到查询字段列表框

        Else       '不存在选中字段
             Call ReadValueToListControl(lstFields, mrsQueryParam, "zwmc")
             Call ReadValueToListControl(cmbQuery(qiFields), mrsQueryParam, "zwmc")
        End If
        
        Set mRequestdb.DBRecordset = mrsValueToSelect
        sSql = "select cxtj,sqlyj from zhcx_lscxtj where czyh='" & strczyh & "' and cxlx='" & msFieldSource & "'"
        lresult = mRequestdb.ExcuteQuery(sSql)
        If lresult <> 4 Then
            mrsValueToSelect.MoveFirst
            Do While Not mrsValueToSelect.EOF
                Combolscxtj.AddItem (mrsValueToSelect(0))
                Combolscxyj.AddItem (mrsValueToSelect(1))
                mrsValueToSelect.MoveNext
            Loop
        End If
    End If
    
    
    
    Call InitOperationComboBox(-1)
    Call InitRelationComboBox
    Call cmdMove_Click(-1)
    Call lstSelectedFields_Click

      

End Function
'根据选中字段将其从全部字段中移出
Private Function RemoveSelected(ObjlistSelected As ListBox, objlist As ListBox)
If ObjlistSelected.ListCount <> 0 Then
    Dim i As Integer
    Dim j As Integer
    For i = 0 To objlist.ListCount - 1
        For j = 0 To ObjlistSelected.ListCount - 1
            If objlist.List(i) = ObjlistSelected.List(j) Then
                objlist.RemoveItem (i)
            End If
        Next
    Next
End If
End Function





Public Function GetQuerySql() As String
    GetQuerySql = msQuerySql
End Function



'检验[增加查询条件]Button的可用性
Private Sub CheckAddQueryBtnEnabled()
    cmdAddQuery.Enabled = True
    
    If cmbQuery(qiFields).Text = "" Or cmbQuery(qiOperation).Text = "" Then
        GoTo EndSub
    End If
    
    If cmbQuery(qivalue).Text = "" And cmbQuery(qivalue).Visible = True Then
        GoTo EndSub
    End If
    
    If txtQueryValue.Text = "" And txtQueryValue.Visible = True _
       And CInt(cmbQuery(qiOperation).Tag) = CInt(qftNumber) Then
        GoTo EndSub
    End If
    
    
    If cmbQuery(qiRelation).Text = "" And cmbQuery(qiRelation).Enabled = True Then
        GoTo EndSub
    End If
    
    Exit Sub
EndSub:
    cmdAddQuery.Enabled = False
    
End Sub

Private Sub InitOperationComboBox(qft As QueryFieldType)
    
'根据不同数据类型确定不同关系操作符
    With cmbQuery(qiOperation)
        .Clear
        .Text = ""
        .Tag = qft
        Select Case qft
            Case qftSelect:
                .AddItem "等于"
                .AddItem "不等于"
            Case qftNumber:
                .AddItem "大于"
                .AddItem "大于等于"
                .AddItem "等于"
                .AddItem "小于"
                .AddItem "小于等于"
                .AddItem "不等于"
            Case qftString:
                .AddItem "等于"
                .AddItem "不等于"
                .AddItem "类似"
             '   .AddItem "包含"
             '   .AddItem "不包含"
            Case Else
                .AddItem "大于"
                .AddItem "大于等于"
                .AddItem "等于"
                .AddItem "小于"
                .AddItem "小于等于"
                .AddItem "不等于"
                .AddItem "类似"
               ' .AddItem "包含"
               ' .AddItem "不包含"
        End Select
    End With
End Sub


Private Function GetOperateCodeByName(Name As String) As String
'通过中文名称得到关系运算符
     Select Case Name
        Case "大于":
            GetOperateCodeByName = ">"
        Case "大于等于":
            GetOperateCodeByName = ">="
        Case "等于":
            GetOperateCodeByName = "="
        Case "小于":
            GetOperateCodeByName = "<"
        Case "小于等于":
            GetOperateCodeByName = "<="
        Case "不等于":
             GetOperateCodeByName = "<>"
            
        Case "类似":
             GetOperateCodeByName = "like"
        'Case "包含":
        '     GetOperateCodeByName = "in"
        'Case "不包含":
       '      GetOperateCodeByName = "not in"
        Case Else
             GetOperateCodeByName = ""
     End Select
     
End Function

Private Sub InitRelationComboBox()
    With cmbQuery(qiRelation)
        .AddItem "并且"
        .AddItem "或者"
        .Text = ""
        .Enabled = False
    End With

End Sub



Private Sub MoveItems(Source As ListBox, Target As ListBox, Optional All As Boolean = False)
    Dim i As Integer
    Dim iLastMovePos As Integer
    
    '全部移动
    If All Then
        For i = 0 To Source.ListCount - 1
            Target.AddItem (Source.List(i))
        Next i
        Source.Clear
        Exit Sub
    End If
    
    '仅移动选中的项
     For i = 0 To Source.ListCount - 1
       If i > Source.ListCount - 1 Then
            Exit For
       End If
       If Source.Selected(i) Then
            Target.AddItem (Source.List(i))
            Source.RemoveItem (i)
            iLastMovePos = i
            i = i - 1
       End If
     Next i
     
     If iLastMovePos < Source.ListCount Then
        Source.Selected(iLastMovePos) = True
     ElseIf iLastMovePos > 0 Then
        Source.Selected(iLastMovePos - 1) = True
     End If
     
End Sub



Private Sub cmbQuery_Change(Index As Integer)
    Call CheckAddQueryBtnEnabled
End Sub

Private Sub cmbQuery_Click(Index As Integer)
 '    On Error GoTo Errtrap
     
     Dim qft As QueryFieldType
     Dim iIndex As Integer
     Dim iSelect As Integer
     Dim sSql As String
     
     iIndex = cmbQuery(qiFields).ListIndex
     
     Select Case Index
        Case qiFields:
            If cmbQuery(qiFields).Text <> "" Then
                mrsQueryParam.MoveFirst
                mrsQueryParam.Move iIndex
                qft = mrsQueryParam.Fields("ysfh")
                
                '判断查询条件的输入类型（TextBox,or ComboBox,or DatePicker）
                iSelect = mrsQueryParam.Fields("zdlx")
                dtpQueryValue.Visible = False
                txtQueryValue.Visible = False
                cmbQuery(qivalue).Visible = False
                Select Case iSelect
                    Case qsvtInput:
                        txtQueryValue.Visible = True
                    Case qsvtSelect:
                        'On Error Resume Next
                        cmbQuery(qivalue).Visible = True
                        sSql = mrsQueryParam.Fields("cqyj")
                        Set mRequestdb.DBRecordset = mrsValueToSelect
                        mRequestdb.ExcuteQuery (sSql)
                        
                        'Set mrsValueToSelect = mconQueryParam.Execute(sSql)

                        Call ReadValueToListControl(cmbQuery(qivalue), mrsValueToSelect, "bm", "nr")
                        'Call ReadValueToListControl(cmbQuery(qiValue), mrsValueToSelect, "nr")
                        'mrsValueToSelect.Close
                        
                        
                    Case qsvtDateTime:
                        dtpQueryValue.Visible = True
                    Case Else
                        txtQueryValue.Visible = True
                End Select
                
                Call InitOperationComboBox(qft)
            End If
     End Select
     
     Call CheckAddQueryBtnEnabled
     
'Errtrap:
'     On Error GoTo 0
     
End Sub

Private Sub cmbQuery_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDelete Then
        cmbQuery(Index).Text = ""
    End If
End Sub

Private Sub cmbQuery_KeyPress(Index As Integer, KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub cmdAddQuery_Click()
    
     '查询条件转化成SQL语名 ,并在界面上显示增加的查询条件
    Dim stemp As String
    Dim iIndex As Integer
    Dim sFieldName As String
    Dim sOperateion As String
    
    'And or 操作符
    If cmbQuery(qiRelation).Enabled = True Then
        stemp = cmbQuery(qiRelation).Text
        If cmbQuery(qiRelation).ListIndex = 0 Then
            msQuerySql = msQuerySql & " And"
        Else
            msQuerySql = msQuerySql & " or"
        End If
    Else
        cmbQuery(qiRelation).Enabled = True
    End If
    
    '查询字段
    stemp = stemp & " [" & cmbQuery(qiFields).Text & "]"
    
    iIndex = cmbQuery(qiFields).ListIndex
    mrsQueryParam.MoveFirst
    mrsQueryParam.Move iIndex
    sFieldName = mrsQueryParam.Fields("zdmc")
    
    '要求选择的字段，字段名后两位截掉。
    If cmbQuery(qivalue).Visible Then
        sFieldName = Mid$(sFieldName, 1, Len(sFieldName) - 2)
    End If
     msQuerySql = msQuerySql & " " & sFieldName
    
    '关系运算符
    stemp = stemp & " " & cmbQuery(qiOperation).Text
    
    sOperateion = GetOperateCodeByName(cmbQuery(qiOperation).Text)
    msQuerySql = msQuerySql & " " & sOperateion
    
    '条件
    If cmbQuery(qivalue).Visible Then
        stemp = stemp & " " & cmbQuery(qivalue).Text
        msQuerySql = msQuerySql & " '" & GetStringLeftByFlag(cmbQuery(qivalue).Text, "-") & "'"
        'msQuerySql = msQuerySql & " '" & cmbQuery(qiValue).Text & "'"
    ElseIf txtQueryValue.Visible Then
        stemp = stemp & " " & txtQueryValue.Text
        '数字型
        If CInt(cmbQuery(qiOperation).Tag) = CInt(qftNumber) Then
            
            msQuerySql = msQuerySql & " " & txtQueryValue.Text
        Else '字符型
            If UCase(sOperateion) = "LIKE" Then
                msQuerySql = msQuerySql & " '%" & txtQueryValue.Text & "%'"
            Else
                msQuerySql = msQuerySql & " '" & txtQueryValue.Text & "'"
            End If
        End If
    Else
        stemp = stemp & " " & dtpQueryValue.Value
        msQuerySql = msQuerySql & " " & ("#" & CDate(Format(dtpQueryValue.Value, "yyyy - mm - dd")) & "#")
      
    End If
    
    Debug.Print msQuerySql
 
    msTotalTemp = msTotalTemp & stemp
    lstQuerySql.AddItem Trim(stemp)
    cmbQuery(qiFields).SetFocus
    
    
    Call CheckAddQueryBtnEnabled
    cmdClearQuery.Enabled = True
  
    
     '- 查询按钮
     If lstSelectedFields.ListCount <= 0 Then
        cmdBeginQuery.Enabled = False
     Else
        cmdBeginQuery.Enabled = True
     End If
    
End Sub

Private Sub cmdBeginQuery_Click()
    Dim sSql() As String
    Dim sZwmc() As String
    Dim sSqlSel As String
    Dim lresult As Long
    Dim i As Integer
    
    If Combolscxtj.Text <> "" Or msTotalTemp <> "" Then '判断是否选中历史条件或输入条件进行查询

        sSqlSel = "select * from zhcx_lscxtj where czyh='" & strczyh & "' and cxlx= '" & msFieldSource & "' and cxtj='" & msTotalTemp & "'"

        lresult = mRequestdb.ExcuteQuery(sSqlSel)
        If lresult = 4 Then   '判断是否有重复的历史查询条件，如果没有则添加到下拉框并存盘
            If Combolscxtj.ListCount < 10 Then  '如果下拉框最大数大于10，则删除最后一项
                Combolscxtj.AddItem (msTotalTemp)
                Combolscxyj.AddItem (msQuerySql)
            Else
                Combolscxtj.RemoveItem 9
                Combolscxyj.RemoveItem 9
                Combolscxtj.AddItem (msTotalTemp)  '添加历史查询条件到下拉框
                Combolscxyj.AddItem (msQuerySql)   '添加历史查询SQL语句到下拉框

            End If
        End If
    End If