Attribute VB_Name = "modFilters"
Option Explicit

Private Type FILTER_TYPE
    blnUser As Boolean
    strText As String
End Type

Public Filters() As FILTER_TYPE

Public Sub LoadFilters()
On Error GoTo hErr:
1   ReDim Filters(0)
2   Dim FF As Integer, F As String, L As String, M() As String
3   FF = FreeFile
4   F = AppData & "Data\Preferences\Filters.ini"
5   Open F For Append As #FF
6   Close #FF
7   Open F For Input As #FF
8   Do Until EOF(FF)
9       Line Input #FF, L
10      M = Split(L, "//", 2)
11      If UBound(M) = 1 Then
12          If Not AddFilter(M(1), M(0) = "U", False) Then
13              'Debug.Print "Failed to add filter: " & L
14          End If
15      Else
16          'Debug.Print "Failed to add filter: " & L
17      End If
18  Loop
19  Close #FF
    SaveFilters
Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Filters", "LoadFilters"
End Sub

Public Function IsFiltered(strText As String, blnUser As Boolean) As Boolean
On Error GoTo hErr:
1   Dim I As Integer
2   For I = 0 To UBound(Filters)
3       If Filters(I).blnUser = blnUser Then
4           If Matches(strText, Filters(I).strText) Then
5               IsFiltered = True
6               Exit Function
7           End If
8       End If
9   Next I
Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Filters", "IsFiltered"
End Function

Public Function AddFilter(strText As String, blnUser As Boolean, Optional Save As Boolean = True) As Boolean
On Error GoTo hErr
1   Dim R As Boolean, x As Integer
2   R = RemoveFilter(strText, blnUser, Save)
3   If LenB(Filters(0).strText) = 0 Then x = 0 Else x = UBound(Filters) + 1: ReDim Preserve Filters(x)
4   With Filters(x)
5       .strText = strText
6       .blnUser = blnUser
7   End With
8   AddFilter = IIf(R, False, True)
9   If Save Then SaveFilters
Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Filters", "AddFilter"
End Function

Public Function RemoveFilter(strText As String, blnUser As Boolean, Optional Save As Boolean = True) As Boolean
On Error GoTo hErr
1   Dim x As Integer, R As Integer
2   For x = 0 To UBound(Filters)
    'Debug.Print Filters(X).strText & "//" & Filters(X).blnUser & "//" & blnUser
3       If Filters(x).blnUser = blnUser Then
5           If LCase$(strText) = LCase$(Filters(x).strText) Then
6               If UBound(Filters) > 0 Then
7                   For R = x To UBound(Filters) - 1
8                       Filters(R) = Filters(R + 1)
9                   Next R
10                  ReDim Preserve Filters(UBound(Filters) - 1)
11              Else
12                  ReDim Filters(0)
                End If
13              RemoveFilter = True
14              If Save Then SaveFilters
15              Exit Function
16          End If
        End If
    Next x
Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Filters", "RemoveFilter"
End Function

Public Sub SaveFilters()
On Error GoTo hErr
1   Dim FF As Integer, F As String, I As Integer
2   FF = FreeFile
3   F = AppData & "Data\Preferences\Filters.ini"
4   Open F For Append As #FF
5   Close #FF
6   Open F For Output As #FF
7       For I = 0 To UBound(Filters)
8           Print #FF, IIf(Filters(I).blnUser, "U", "M") & _
                 "//" & Filters(I).strText
9       Next I
10  Close #FF
Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Filters", "SaveFilters"
End Sub


