filter.bas

金算盘软件代码

    If InStr(strAfter, strTableName) > 0 Then
        strTemp = ""
'        strBiaTableName = "[" & Left(strReplace, Len(strReplace) - 1) & "]!"
        strBiaTableName = Left(strReplace, Len(strReplace) - 1) & "."
        lngTemp = InStr(strAfter, strTableName)
        Do While lngTemp > 0
            strFore = Left(strAfter, lngTemp - 1)
            strAfter = Right(strAfter, Len(strAfter) - lngTemp - Len(strTableName) + 1)
            strTemp = strTemp & strFore & strBiaTableName
            lngTemp = InStr(strAfter, strTableName)
        Loop
        strAfter = strTemp & strAfter
    End If
    ModifyTableName = strAfter
End Function


Public Function FindViewId(Optional ByVal LngFilterID As Long, Optional lngType As Long, Optional ViewName As String = "") As Long
Dim strKey As String
Dim rs As rdoResultset
Dim strSql As String, strTable As String
  On Error GoTo ErrHandle
    Select Case lngType
        Case 1
         strTable = "List"
         strKey = "LngListID"
        Case 2
         strTable = "Report"
         strKey = "LngReportID"
    End Select
       
    If ViewName = "" Then
       strSql = "Select lngViewId From " & strTable & " Where " & strKey & "=" & LngFilterID
    Else
       strSql = "Select lngViewId From View Where strViewName='" & ViewName & "'"
    End If
        
    Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rs
        If Not .EOF Then
             FindViewId = !lngViewId
        End If
    End With
    rs.Close
    Exit Function
ErrHandle:
    If Err.Number = 40045 Then
        Resume
    End If
End Function

'取筛选条件
Public Function GetInitWhere(ByVal LngFilterID As Long, lngType As Long, Optional ChineseCond As String = "", Optional IntTag As Integer = 0, Optional strCond As String = "", Optional strPeriodName As String = "", Optional strHaving As String = "") As String
    Dim lngViewId As Long
    Dim rs As rdoResultset
    Dim rsTempTable As rdoResultset
    Dim Index As Long
    Dim index2 As Long
    Dim strTableName As String
    Dim strkeyIdNumber As String
    Dim strCodeTemp As String
    Dim strTemp As String
    Dim D1 As Date
    Dim D2 As Date
    Dim strWhere As String
    Dim strSelect(1 To 10) As String '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5,6,7:操作符和操作值 8:strWhere子句 9:表别名 10:路径
    Dim strTagCond(1 To 10) As String
    Dim strSql As String
    Dim lngTemp As Long
    Dim blnAccount As Boolean
    Dim blnCustomer As Boolean
    Dim blnDepartment As Boolean
    Dim blnEmployee As Boolean
    Dim blnJob As Boolean
    Dim blnClass1 As Boolean
    Dim blnClass2 As Boolean
    Dim blnItem As Boolean
    Dim blnPosition As Boolean
    Dim blnPeriod As Boolean
    
    lngViewId = FindViewId(LngFilterID, lngType)
    strCond = ""
    strHaving = ""
    Select Case lngType
        Case 1
            strTableName = "ListCond"
            strkeyIdNumber = "lngListID"
'            gclsBase.BaseDB.QueryDefs("QListCond").sql = "Select * From ListCond Where " & Trim(strkeyIdNumber) & " = " & LngFilterID
            strSql = "select * from ViewField ,ListCond" & _
                     " where  (ViewField.lngViewFieldID =ListCond.lngviewfieldid) And ListCond.lngListID=" & LngFilterID & " and  ViewField.blnisfilter = 1 and ((viewfield.lngviewid=" & lngViewId & "  and listCond.blnHaveFatherNode=0)" & " or (listCond.blnHaveFatherNode=1 ))"
        Case 2
            strTableName = "ReportCond"
            strkeyIdNumber = "lngReportID"
''            gclsBase.BaseDB.QueryDefs("QReportCond").sql = "Select * From ReportCond Where " & Trim(strkeyIdNumber) & " = " & LngFilterID
            strSql = "select * from ViewField,ReportCond" & _
                     " where  (ViewField.lngViewFieldID =ReportCond.lngviewfieldid) And ReportCond.lngReportID=" & LngFilterID & " and  ViewField.blnisfilter = 1 and ((viewfield.lngviewid=" & lngViewId & "  and ReportCond.blnHaveFatherNode=0)" & " or ( ReportCond.blnHaveFatherNode=1 ))"
    End Select
 
    Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If rs.RowCount = 0 Then
        rs.Close
        Exit Function
    End If
      
    blnAccount = False
    blnCustomer = False
    blnDepartment = False
    blnEmployee = False
    blnJob = False
    blnClass1 = False
    blnPeriod = False
    blnPosition = False
    If IntTag <> 0 Then
        If IntTag And 1 Then blnAccount = True
        If IntTag And 2 Then blnCustomer = True
        If IntTag And 4 Then blnDepartment = True
        If IntTag And 8 Then blnEmployee = True
        If IntTag And 16 Then blnJob = True
        If IntTag And 32 Then blnClass1 = True
        If IntTag And 64 Then blnPeriod = True
        If IntTag And 128 Then blnItem = True
        If IntTag And 256 Then blnClass2 = True
        If IntTag And 512 Then blnPosition = True
    End If
    ChineseCond = ""

    rs.MoveFirst
      Do While Not rs.EOF
            strSelect(1) = rs!strViewFieldDesc
            strSelect(2) = IIf(UCase(rs!strFieldType) = "CODE", rs!strKeyField, rs!strFieldName)
            strSelect(3) = UCase(rs!strFieldType)
            strSelect(4) = rs!strTableName
            strSelect(9) = IIf(IsNull(rs!strOthTableName), "", rs!strOthTableName)
            strSelect(10) = Trim(rs!strPath)
            Select Case Trim(strSelect(3))
                 Case "STRING"
                    strSelect(5) = rs!strStringOP
                    strSelect(6) = rs!strString1
                        Select Case Trim(strSelect(5))
                         Case "1"
                            strSelect(5) = "等于 " & Trim(strSelect(6))
                            Select Case strSelect(1)            '处理编码级次的“等于”
                             Case "科目编码", "部门编码", "统计编码", "项目编码", "货位编码", "商品类型编码", "单位类型编码", "固资类别编码", "职员类别编码"
                                 strSelect(8) = "(" & strSelect(2) & " = " & "'" & Trim(strSelect(6)) & "' or " & strSelect(2) & " LIKE " & "'" & Trim(strSelect(6)) & "-%')"
                             Case "科目全称", "部门全称", "统计全称", "项目全称", "货位全称", "商品类型全称", "单位类型全称", "固资类别全称", "职员类别全称"
                                 strSelect(8) = "(" & strSelect(2) & " = " & "'" & Trim(strSelect(6)) & "' or " & strSelect(2) & " LIKE " & "'" & Trim(strSelect(6)) & "-%')"
                             Case Else
                                 strSelect(8) = strSelect(2) & " = " & "'" & Trim(strSelect(6)) & "'"
                            End Select
'                            strSelect(8) = strSelect(2) & " = " & "'" & Trim(strSelect(6)) & "'"
                         Case "2"
                            strSelect(5) = "大于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " > " & "'" & Trim(strSelect(6)) & "'"
                         Case "3"
                            strSelect(5) = "小于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " < " & "'" & Trim(strSelect(6)) & "'"
                         Case "4"
                            strSelect(5) = "大于等于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " >= " & "'" & Trim(strSelect(6)) & "'"
                         Case "5"
                            strSelect(5) = "小于等于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " <= " & "'" & Trim(strSelect(6)) & "'"
                         Case "6"
                            strSelect(5) = "打头字符为 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " like " & "'" & Trim(Trim(strSelect(6))) & "%' "
                         Case "7"
                            strSelect(5) = "包含字符 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " like " & "'" & "%" & Trim(Trim(strSelect(6))) & "%'"
                         Case "8"
                            strSelect(5) = "类似于 " & Trim(strSelect(6))
'                            strSelect(8) = strSelect(2) & " like " & "'" & Trim(strSelect(6)) & "'"
                            Select Case strSelect(1)            '处理编码级次的 “类似于”
                             Case "科目编码", "部门编码", "统计编码", "项目编码", "货位编码", "商品类型编码", "单位类型编码", "固资类别编码", "职员类别编码"
                                 strSelect(8) = "(" & strSelect(2) & " like " & "'" & Trim(strSelect(6)) & "' or " & strSelect(2) & " LIKE " & "'" & Trim(strSelect(6)) & "-%')"
                             Case "科目全称", "部门全称", "统计全称", "项目全称", "货位全称", "商品类型全称", "单位类型全称", "固资类别全称", "职员类别全称"
                                 strSelect(8) = "(" & strSelect(2) & " like " & "'" & Trim(strSelect(6)) & "' or " & strSelect(2) & " LIKE " & "'" & Trim(strSelect(6)) & "-%')"
                             Case Else
                                 strSelect(8) = strSelect(2) & " like " & "'" & Trim(strSelect(6)) & "'"
                            End Select
                         Case "9"
                            strSelect(5) = "不等于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " <> " & "'" & Trim(strSelect(6)) & "'"
                         Case "10"
                            strSelect(5) = "介于 (" & Trim(strSelect(6)) & "," & rs!strString2 & ")"
                            strSelect(8) = strSelect(2) & " >= " & "'" & Trim(strSelect(6)) & "' and " & strSelect(2) & " <= " & "'" & rs!strString2 & "'"
                         Case "11"
                            strSelect(5) = ": 空值"
                            strSelect(8) = "(" & strSelect(2) & " is NULL  or LTRIM(Rtrim(" & strSelect(2) & "))  = '')"
                         End Select
                 Case "ENUM"
                        strSelect(5) = ": " & rs!strString1
                        strSelect(8) = strSelect(2) & " in (" & Trim(rs!strString2) & ")"
                        If strSelect(1) = "报告期" Or strSelect(1) = "包含未记帐凭证" Then
                            strSelect(8) = ""
                        End If
                        If strSelect(1) = "辅助核算" Then
                            Dim strMulCond As String
                            If InStr(rs!strString2, "单位") > 0 Then
                                strMulCond = strSelect(4) & ".blnIsCustomer=1 "
                            Else
                                strMulCond = " 2>1 "
                            End If
                            If InStr(rs!strString2, "部门") > 0 Then
                                strMulCond = strMulCond & " And " & strSelect(4) & ".blnIsDepartment=1 "
                            End If
                            If InStr(rs!strString2, "职员") > 0 Then
                                strMulCond = strMulCond & " And " & strSelect(4) & ".blnIsEmployee=1 "
                            End If
                            If InStr(rs!strString2, "统计") > 0 Then
                                strMulCond = strMulCond & " And " & strSelect(4) & ".blnIsClass1=1 "
                            End If
                            If InStr(rs!strString2, "项目") > 0 Then
                                strMulCond = strMulCond & " And " & strSelect(4) & ".blnIsClass2=1 "
                            End If
                            strSelect(8) = strMulCond
                        End If
                 Case "LONG", "INTEGER", "DOUBLE"
                        strSelect(5) = Trim(rs!strDoubleOP)
                        strSelect(6) = Trim(CStr(rs!dbldouble1))
                        Select Case strSelect(5)
                        Case "1"
                            strSelect(5) = "等于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " = " & Trim(strSelect(6))
                        Case "2"
                            strSelect(5) = "大于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " > " & Trim(strSelect(6))
                        Case "3"
                            strSelect(5) = "小于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " < " & Trim(strSelect(6))
                        Case "4"
                            strSelect(5) = "大于等于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " >= " & Trim(strSelect(6))
                        Case "5"
                            strSelect(5) = "小于等于 " & Trim(strSelect(6))
                            strSelect(8) = strSelect(2) & " <= " & Trim(strSelect(6))
                        Case "6"
                            strSelect(7) = CStr(rs!dbldouble2)
                            strSelect(5) = "介于 （" & Trim(strSelect(6)) & "," & Trim(strSelect(7)) & ")"
                            strSelect(8) = strSelect(2) & " >= " & Trim(strSelect(6)) & " and " & strSelect(2) & " <= " & Trim(strSelect(7))