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