Feedback

VB - Filterexpression einmal anders

Veröffentlicht von am 11.08.2015
(0 Bewertungen)
Benötige des Öfteren ein ungebundenes Xml-DataSet, dabei werden in den Tabellen die Funktion Select mit Filterkriterien benötigt.
Für diese Filterkriterien habe ich mir ein Klasse erstellt. Sie erlaubt Filterkriterien hintereinander zu kombinieren.
Etwa so:
Dim FILTER As New FilterServer.FILTER

Dim TExpess1 = FILTER.Value("datum").Filter(FilterServer.COM.enFilterOption.Equal, Now.Date).And. _
Value("Bez").Filter(FilterServer.COM.enFilterOption.IsLess, "M").And. _
Value("Note").Filter(FilterServer.COM.enFilterOption.IsNULL, "").Stop

FILTER.Clear() ' neue Abfrage

Dim TExpess2 = FILTER.Value("datum").Filter(FilterServer.COM.enFilterOption.Equal, Now.Date).And. _
Value("Wert").FilterBetween(20, 40).And.Value("Betrag").FilterIn(New Object() {20, 30, 40}).And. _
Value("Betrag").Filter(FilterServer.COM.enFilterOption.IsNotNULL, "").Stop

Ergebnisse:
TExpess1 ="datum = #8/11/2015 12:00 AM# AND Bez < 'M' AND Note Is Null"

TExpess2 ="datum = #8/11/2015 12:00 AM# AND (Wert BETWEEN 20 AND 40) AND Betrag IN (20,30,40) AND Betrag Is Not Null"

Der Filter ist so angelegt, dass aus der REPEAT-Klasse immer wieder auf die FILTER-Klasse verwiesen wird und somit eine Endlosschleife erfolgt bis in der REPEAT-Klasse STOP aufgerufen wird, der dann das ganze Ergebnis auswirft.
Ich hoffe das Beispiel macht Spaß und regt zu anderen Tools an.
Imports System.ComponentModel

Public Class FilterServer

    ''' <summary>
    ''' Hilfs-Objekte
    ''' </summary>
    ''' <remarks></remarks>
    Public Class COM

        ''' <summary>
        ''' Filter-Typ
        ''' </summary>
        ''' <remarks></remarks>
        Public Enum enFilterOption
            ''' <summary>
            ''' ist gleich
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist gleich")> Equal
            ''' <summary>
            ''' ist größer gleich
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist größer gleich")> GreatherThen
            ''' <summary>
            ''' ist kleiner gleich
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist kleiner gleich")> LessThen
            ''' <summary>
            ''' ist größer
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist größer")> IsGreather
            ''' <summary>
            ''' ist kleiner
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist kleiner")> IsLess
            ''' <summary>
            ''' ist ungleich
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist ungleich")> NotEqual
            ''' <summary>
            ''' ist ähnlich
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist ähnlich (nur String)")> [Like]
            ''' <summary>
            ''' Beginnt mit (nur String)
            ''' </summary>
            ''' <remarks></remarks>
            <Description("Beginnt mit (nur String)")> StartsWith
            ''' <summary>
            ''' Endet mit (nur String)
            ''' </summary>
            ''' <remarks></remarks>
            <Description("Endet mit (nur String)")> EndsWith
            ''' <summary>
            ''' ist Null
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist Null")> [IsNULL]
            ''' <summary>
            ''' ist nicht Null
            ''' </summary>
            ''' <remarks></remarks>
            <Description("ist nicht Null")> IsNotNULL
            ''' <summary>
            ''' kein Filter
            ''' </summary>
            ''' <remarks></remarks>
            <Description("kein Filter")> None
        End Enum

        Public Enum enDatatyp
            [String]
            [Date]
            Other
        End Enum

        Protected Friend Class Helper

            Private Const cst_Err As String = " error "

            ''' <summary>
            ''' Filteroperation mit dem Wert setzten
            ''' </summary>
            ''' <param name="value"></param>
            ''' <param name="filterOption"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function GetFilterValue(value As Object, filterOption As enFilterOption) As String
                Dim sFilterExpression As String = String.Empty

                If filterOption = enFilterOption.IsNULL Or filterOption = enFilterOption.IsNotNULL Then
                    Return " " + FilterCollection(filterOption).Patter
                End If

                If (value IsNot Nothing) AndAlso (value IsNot DBNull.Value) Then

                    Select Case True

                        Case TypeOf value Is String         ' STRING-WERTE

                            Dim sValue As String = JetSQLFixup(value.ToString)

                            If filterOption = enFilterOption.Like Then
                                sFilterExpression = GetStartsEndWith(sValue)

                            ElseIf filterOption = enFilterOption.EndsWith Or filterOption = enFilterOption.StartsWith Then
                                sFilterExpression = GetStartsEndWith(sValue, , False)

                            Else
                                sFilterExpression = String.Format("'{0}'", value)
                            End If

                        Case TypeOf value Is Date           ' DATUMS-WERTE

                            '   Ends-/StartsWith und Like zu Equal korrigieren
                            filterOption = CorrectionEndsStartsWith(filterOption)

                            Dim d As Date = CDate(value)
                            Dim dt As String = d.ToString("g", Globalization.CultureInfo.CreateSpecificCulture("en-us"))
                            sFilterExpression = String.Format("#{0}#", dt)

                        Case Else                           ' ALLE ANDEREN WERTE

                            '   Ends-/StartsWith und Like zu Equal korrigieren
                            filterOption = CorrectionEndsStartsWith(filterOption)

                            sFilterExpression = String.Format("{0}", value)

                    End Select

                End If


                Return FilterCollection(filterOption).Patter + " " + sFilterExpression + " "
            End Function

            ''' <summary>
            ''' Den Wert je nach Typ als String setzten
            ''' </summary>
            ''' <param name="value"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function GetValue(value As Object) As String
                If value Is Nothing Then Return cst_Err

                Select Case True
                    Case TypeOf value Is String         ' STRING-WERTE
                        Return String.Format("'{0}'", value)

                    Case TypeOf value Is Date           ' DATUMS-WERTE
                        Dim d As Date = CDate(value)
                        Dim dt As String = d.ToString("g", Globalization.CultureInfo.CreateSpecificCulture("en-us"))
                        Return String.Format("#{0}#", dt)

                End Select

                'ist Value = DBNull.Value --> Rückgabe String.Empty
                Return value.ToString()
            End Function

            ''' <summary>
            ''' IN Filter setzen
            ''' </summary>
            ''' <param name="InValues">alle Werte die vorkommen sollten</param>
            ''' <remarks></remarks>
            Shared Function Get_IN_Filter(InValues As IEnumerable(Of Object)) As String
                If InValues Is Nothing OrElse InValues.Count < 1 Then Return cst_Err

                Dim L As New List(Of String)
                For Each value In InValues
                    L.Add(GetValue(value))
                Next

                Return String.Format("IN ({0})", Join(L.ToArray, ","))
            End Function

            ''' <summary>
            ''' Between-Filter setzten
            ''' </summary>
            ''' <param name="fieldname"></param>
            ''' <param name="ValueStart"></param>
            ''' <param name="ValueEnd"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function Get_Beetween_Filter(fieldname As String, ValueStart As Object, ValueEnd As Object) As String
                Return String.Format("({0} >= {1} AND {0} <= {2})", fieldname, GetValue(ValueStart), GetValue(ValueEnd))
            End Function
            Shared Function Get_Beetween_Filter(ValueStart As Object, ValueEnd As Object) As String
                Return String.Format("BETWEEN {0} AND {1}", GetValue(ValueStart), GetValue(ValueEnd))
            End Function

            ''' <summary>
            ''' Starts-/EndsWith Werte ergänzen einschl. Like-Option
            ''' </summary>
            ''' <param name="value"></param>
            ''' <param name="Asterix"></param>
            ''' <param name="WithLikeOption"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function GetStartsEndWith(value As String, Optional Asterix As String = "*", Optional WithLikeOption As Boolean = True) As String
                value = value.Trim

                Select Case True
                    Case value.StartsWith(Asterix) And value.EndsWith(Asterix)
                        Return String.Format("'{0}'", value)

                    Case value.StartsWith(Asterix)
                        Return String.Format("'{0}{1}'", value, Asterix)

                    Case value.EndsWith(Asterix)
                        Return String.Format("'{1}{0}'", value, Asterix)

                    Case Else
                        If WithLikeOption Then
                            Return String.Format("'{1}{0}{1}'", value, Asterix)
                        Else
                            Return String.Format("'{0}'", value)
                        End If
                End Select

            End Function

            ''' <summary>
            ''' Korrekturen, da wo Starts-/EndsWith und Like-Option nicht gestattet sind
            ''' </summary>
            ''' <param name="filterOption"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function CorrectionEndsStartsWith(filterOption As enFilterOption) As COM.enFilterOption
                Select Case True
                    Case filterOption = enFilterOption.EndsWith, filterOption = enFilterOption.StartsWith, filterOption = enFilterOption.Like
                        Return enFilterOption.Equal
                End Select
                Return filterOption
            End Function

            ''' <summary>
            ''' Ersetzt Pipe-Zeichen (|) durch Chr(124) und ' durch '' (z.B. bei Mac'Donneld)
            ''' </summary>
            ''' <param name="TextIn"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function JetSQLFixup(TextIn As String) As String
                Dim Temp As String
                Temp = ReplaceString(TextIn, "'", "''", 0)
                Return ReplaceString(Temp, "|", "'" & Chr(124) & "'", 0)
            End Function

            ''' <summary>
            ''' Ersetzt ' durch '' z.B. O'Donnald --> O''Donald
            ''' SQLFixup sollte verwendet werden, wenn die SQL-Anweisung mit Jet SQL Pass-Through-Abfragen oder mit ODBCDirect, 
            ''' RDO und ADO an eine andere Jet-Back-End-Datenbank verwendet werden
            ''' </summary>
            ''' <param name="TextIn"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function SQLFixup(TextIn As String) As String
                Return ReplaceString(TextIn, "'", "''", 0)
            End Function

            ''' <summary>
            ''' Ersetzt "
            ''' </summary>
            ''' <param name="Value"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Public Shared Function Replace_Quotes(ByVal Value As String) As String
                If Not String.IsNullOrEmpty(Value) Then
                    Return SQLFixup(Value)
                End If
                Return Value
            End Function

            ''' <summary>
            ''' Ersetzt Elemente durch andere Elemente in einem Text
            ''' </summary>
            ''' <param name="TextIn"></param>
            ''' <param name="SearchStr">das zu ersetzende Element</param>
            ''' <param name="Replacement">das Element was eingefügt wird</param>
            ''' <param name="CompMode">Vergleichsmethode</param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function ReplaceString(TextIn As String, ByVal SearchStr As String, ByVal Replacement As String, ByVal CompMode As CompareMethod) As String
                Dim WorkText As String, Pointer As Integer
                If String.IsNullOrEmpty(TextIn) Then
                    ReplaceString = String.Empty
                Else
                    WorkText = TextIn
                    Pointer = InStr(1, WorkText, SearchStr, CompMode)
                    Do While Pointer > 0
                        WorkText = Left(WorkText, Pointer - 1) & Replacement & Mid(WorkText, Pointer + Len(SearchStr))
                        Pointer = InStr(Pointer + Len(Replacement), WorkText, SearchStr, CompMode)
                    Loop
                    ReplaceString = WorkText
                End If
            End Function

            Shared Function FilterCollection() As Dictionary(Of enFilterOption, FilterItem)
                Dim d As New Dictionary(Of enFilterOption, FilterItem)
                d.Add(enFilterOption.None, New FilterItem("kein Filter", "kein Filter - no filter", enFilterOption.None))
                d.Add(enFilterOption.Equal, New FilterItem("=", "gleich - equal to", enFilterOption.Equal))
                d.Add(enFilterOption.GreatherThen, New FilterItem(">=", "größer, gleich - greater than or equal to", enFilterOption.GreatherThen))
                d.Add(enFilterOption.IsGreather, New FilterItem(">", "größer als - greater than", enFilterOption.IsGreather))
                d.Add(enFilterOption.IsLess, New FilterItem("<", "kleiner als- less than", enFilterOption.IsLess))
                d.Add(enFilterOption.LessThen, New FilterItem("<=", "kleiner, gleich - less than or equal to", enFilterOption.LessThen))
                d.Add(enFilterOption.Like, New FilterItem("Like", "ähnlich wie - like", enFilterOption.Like))
                d.Add(enFilterOption.NotEqual, New FilterItem("<>", "ungleich - not equal to", enFilterOption.NotEqual))
                d.Add(enFilterOption.StartsWith, New FilterItem("Like", "Beginnt mit - starts with", enFilterOption.StartsWith))
                d.Add(enFilterOption.EndsWith, New FilterItem("Like", "Endet mit - ends with", enFilterOption.EndsWith))
                d.Add(enFilterOption.IsNULL, New FilterItem("Is Null", "Ist null - is null", enFilterOption.IsNULL))
                d.Add(enFilterOption.IsNotNULL, New FilterItem("Is Not Null", "Ist nicht null - is not null", enFilterOption.IsNotNULL))
                Return d
            End Function

            ''' <summary>
            ''' Sucht nach dem Filterzeichen
            ''' </summary>
            ''' <param name="FilterZeichen"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Shared Function FindFilterCollectionItem(FilterZeichen As String) As FilterItem
                If Not String.IsNullOrEmpty(FilterZeichen) Then
                    Dim q = From p In FilterCollection() Where p.Value.Patter.ToLower = FilterZeichen.ToLower Select p

                    If q.Count = 1 Then Return q.First.Value
                End If

                Return FilterCollection(enFilterOption.None)
            End Function


#Region " FilterItem Klasse "

            Public Class FilterItem
                ''' <summary>
                ''' Filterzeichen (Text)
                ''' </summary>
                ''' <value></value>
                ''' <returns></returns>
                ''' <remarks></remarks>
                Property Patter As String
                ''' <summary>
                ''' Eine Beschreibung (gleich - equal to)
                ''' </summary>
                ''' <value></value>
                ''' <returns></returns>
                ''' <remarks></remarks>
                Property Description As String
                ''' <summary>
                ''' Filter-Typ (Anweisung)
                ''' </summary>
                ''' <value></value>
                ''' <returns></returns>
                ''' <remarks></remarks>
                Property Typus As enFilterOption

                Sub New(sPatter As String, sDescription As String, enTypus As enFilterOption)

                    Me.Description = sDescription : Me.Patter = sPatter
                    Me.Typus = enTypus
                End Sub
            End Class

#End Region

        End Class


#Region " Interfaces "

        Public Interface IFiltering
            Function Value(FieldName As String) As IFilterOption
            ReadOnly Property Name As String
        End Interface

        Public Interface IRepeat
            Function [And]() As IFiltering
            Function [Or]() As IFiltering
            Function [Stop]() As String
        End Interface

        Public Interface IFilterOption
            Function Filter(filtertyp As enFilterOption, FilterValue As Object) As IRepeat
            Function FilterBetween(FilterValue1 As Object, FilterValue2 As Object) As IRepeat
            Function FilterIn(InValues As IEnumerable(Of Object)) As IRepeat
        End Interface

#End Region

        Public Class Filteroption
            Implements COM.IFilterOption

            Private sFilterExpression As String = String.Empty
            ''' <summary>
            ''' IFiltering
            ''' wird benötigt für Between-Filter
            ''' </summary>
            ''' <remarks></remarks>
            Private m_filter As IFiltering

            ''' <summary>
            ''' Übergabe des Filtertextes von IFiltering
            ''' </summary>
            ''' <param name="sFilterText">Filtertextes</param>
            ''' <param name="FilterObject">Übergabe von IFiltering</param>
            ''' <remarks></remarks>
            Public Sub New(sFilterText As String, FilterObject As IFiltering)
                Me.sFilterExpression = sFilterText
                m_filter = FilterObject
            End Sub

            Public Function Filter(filtertyp As COM.enFilterOption, FilterValue As Object) As COM.IRepeat Implements COM.IFilterOption.Filter
                Dim sValue As String = Helper.GetFilterValue(FilterValue, filtertyp)
                sFilterExpression += sValue + " "
                Return New COM.Repeat(sFilterExpression)
            End Function

            Public Function FilterBetween(FilterValue1 As Object, FilterValue2 As Object) As IRepeat Implements IFilterOption.FilterBetween
                Dim sValue As String = Helper.Get_Beetween_Filter(FilterValue1, FilterValue2)
                Dim Extact = _extractLastname(sFilterExpression)
                If Extact.Length = 2 Then
                    sFilterExpression = String.Format("{0} ({1} {2}) ", Extact.First, Extact.Last, sValue.Trim)
                Else
                    sFilterExpression += sValue + " "
                End If
                Return New COM.Repeat(sFilterExpression)
            End Function

            Public Function FilterIn(InValues As IEnumerable(Of Object)) As IRepeat Implements IFilterOption.FilterIn
                sFilterExpression += Helper.Get_IN_Filter(InValues) + " "
                Return New COM.Repeat(sFilterExpression)
            End Function

            ''' <summary>
            ''' Alternativ "größer= + kleiner="
            ''' </summary>
            ''' <param name="FilterValue1"></param>
            ''' <param name="FilterValue2"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Private Function _between2(FilterValue1 As Object, FilterValue2 As Object) As String
                Dim sValue As String = Helper.Get_Beetween_Filter(m_filter.Name, FilterValue1, FilterValue2)
                Dim i As Integer = sFilterExpression.Trim.LastIndexOf(" ")

                '   Doppelter Eintrag des Spaltennamens verhindern
                If i <> -1 Then
                    '   Am Ende des Strings
                    Dim sName As String = sFilterExpression.Substring(i + 1).Trim
                    If String.Compare(sName, m_filter.Name.Trim, True) = 0 Then
                        Me.sFilterExpression = sFilterExpression.Substring(0, i + 1)
                    End If
                Else
                    '   Gleich am Anfang des String
                    If String.Compare(sFilterExpression.Trim, m_filter.Name.Trim, True) = 0 Then
                        Me.sFilterExpression = ""
                    End If
                End If

                Return Me.sFilterExpression + sValue + " "
            End Function

            ''' <summary>
            ''' bei richtiger Ausführung kommen 2 Elemente:
            ''' First= Filterausdruck ohne den letzten Namen
            ''' Last=  letzter Name
            ''' </summary>
            ''' <param name="s"></param>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Private Function _extractLastname(s As String) As String()
                s = s.Trim

                If Not String.IsNullOrWhiteSpace(s) Then

                    Dim i As Integer = s.LastIndexOf(" ")

                    '   Doppelter Eintrag des Spaltennamens verhindern
                    If i <> -1 Then
                        '   Spaltennamens am Ende des Strings suchen
                        Dim sName As String = s.Substring(i + 1).Trim
                        If String.Compare(sName, m_filter.Name.Trim, True) = 0 Then
                            Return New String() {s.Substring(0, i + 1), sName}
                        End If
                    Else
                        '   Spaltennamens am Anfang des String (somit keine vorherigen Einträge)
                        If String.Compare(s, m_filter.Name.Trim, True) = 0 Then
                            Return New String() {String.Empty, m_filter.Name.Trim}
                        End If
                    End If
                End If

                Return New String() {}
            End Function

        End Class

        Public Class Repeat
            Implements IRepeat

            Private sFilterExpression As String = String.Empty

            Public Sub New(sFilterText As String)
                Me.sFilterExpression = sFilterText
            End Sub
            ''' <summary>
            ''' nächster Filter mit AND fortsetzten
            ''' </summary>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Public Function [And]() As IFiltering Implements IRepeat.And
                sFilterExpression += "AND "
                Return New FILTER(sFilterExpression)
            End Function

            ''' <summary>
            ''' nächster Filter mit OR fortsetzten
            ''' </summary>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Public Function [Or]() As IFiltering Implements IRepeat.Or
                sFilterExpression += "OR "
                Return New FILTER(sFilterExpression)
            End Function

            ''' <summary>
            ''' Filter beenden und gesamten Filterwert zurückgeben
            ''' </summary>
            ''' <returns></returns>
            ''' <remarks></remarks>
            Public Function [Stop]() As String Implements IRepeat.Stop
                Return sFilterExpression.Trim.Replace("  ", " ")
            End Function
        End Class


    End Class

    ''' <summary>
    ''' Der Filter zum auswerten
    ''' </summary>
    ''' <remarks></remarks>
    Public Class FILTER
        Implements COM.IFiltering


        Private sFilterExpression As String = String.Empty
        Private sFieldName As String = String.Empty

        Public Sub New()
        End Sub
        Public Sub New(sFilterText As String)
            Me.sFilterExpression = sFilterText
        End Sub

        ''' <summary>
        ''' Mit dem Filter beginnen
        ''' </summary>
        ''' <param name="FieldName"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Value(FieldName As String) As COM.IFilterOption Implements COM.IFiltering.Value
            Me.sFieldName = FieldName
            sFilterExpression += FieldName + " "
            Return New COM.Filteroption(sFilterExpression, Me)
        End Function

        ''' <summary>
        ''' Löscht den alten Eintrag
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Clear()
            Me.sFilterExpression = String.Empty
            Me.sFieldName = String.Empty
        End Sub

        ''' <summary>
        ''' Namen des Feldes
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property Name As String Implements COM.IFiltering.Name
            Get

                Return Me.sFieldName
            End Get
        End Property
    End Class


End Class
Abgelegt unter Filter, Filterexpression.

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!