VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MyOSPObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements OLEDBSimpleProvider
Dim MyOSPArray()
Dim RowCount As Integer
Dim ColCount As Integer
Dim colListeners As New Collection
Dim ospl As OLEDBSimpleProviderListener
Public FilePath As String

Public Sub LoadData()
    ' This procedure loads data from a semi-colon
    ' delimited file into an array
    Dim GetLine As Variant
    Dim Spot As Integer, Position As Integer
    Dim Row As Integer, Col As Integer
    
    On Error GoTo ErrorTrap
    Open FilePath For Input Lock Read Write As #1
    Position = 1
    Row = 0
    Line Input #1, GetLine
    Spot = InStr(1, GetLine, ";")
    RowCount = val(Left$(GetLine, Spot))
    ColCount = val(Right$(GetLine, Len(GetLine) - Spot))
    ReDim MyOSPArray(RowCount + 1, ColCount + 1)
    While Not EOF(1)
        Line Input #1, GetLine
        Col = 1
        Spot = InStr(1, GetLine, ";")
        While Spot <> 0
            MyOSPArray(Row, Col) = Left$(GetLine, Spot - 1)
            Col = Col + 1
            GetLine = Right$(GetLine, Len(GetLine) - Spot)
            Spot = InStr(1, GetLine, ";")
        Wend
        If Len(GetLine) <> 0 Then
               MyOSPArray(Row, Col) = GetLine
        End If
        Row = Row + 1
    Wend
    Close #1
    Exit Sub
ErrorTrap:
    Err.Raise (E_FAIL)
End Sub

Public Sub SaveData()
    ' This procedure writes data from an array
    ' to a semi-colon delimited file.
    Dim PutLine As Variant
    Dim iRow As Integer, iCol As Integer
    
    On Error GoTo ErrorTrap
    Open FilePath For Output Lock Read Write As #1
    Print #1, RowCount & ";" & ColCount
    
    For iRow = 0 To RowCount
        For iCol = 1 To ColCount
            PutLine = PutLine & MyOSPArray(iRow, iCol) & ";"
        Next iCol
        Print #1, PutLine
        PutLine = ""
    Next iRow
    Close #1
    Exit Sub
ErrorTrap:
    Err.Raise (E_FAIL)
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    ' Call the SaveData method
    SaveData
End Sub

Private Sub OLEDBSimpleProvider_addOLEDBSimpleProviderListener(ByVal pospIListener As MSDAOSP.OLEDBSimpleProviderListener)
    'Add a listener to the Listeners collection
    If Not (pospIListener Is Nothing) Then
        Set ospl = pospIListener
        colListeners.Add ospl
    End If
End Sub

Private Function OLEDBSimpleProvider_deleteRows(ByVal iRow As Long, ByVal cRows As Long) As Long
    Dim TempArray()
    Dim listener As OLEDBSimpleProviderListener
    Dim v As Variant
    Dim cNewRows As Integer, Row As Integer, Col As Integer
    
    ' Make sure iRow is in the correct range:
    If iRow < 1 Or iRow > RowCount Then
        Err.Raise (E_FAIL)
    End If
        
    ' Set cRows to the actual number which can be deleted
    If iRow + cRows > RowCount + 1 Then
        cRows = RowCount - iRow + 1
    End If
        
    ' Establish a Temporary Array
    cNewRows = RowCount - cRows
    ReDim TempArray(cNewRows + 1, ColCount + 1)
    
    ' Notify each listener:
    For Each v In colListeners
        Set listener = v
        listener.aboutToDeleteRows iRow, cRows
    Next
        
    ' Copy over the first rows which are not being deleted
    For Row = 0 To iRow - 1
        For Col = 0 To ColCount
            TempArray(Row, Col) = MyOSPArray(Row, Col)
        Next Col
    Next Row
        
    ' Copy the last rows which are not being deleted
    For Row = iRow + cRows To RowCount
        For Col = 0 To ColCount
            TempArray(Row - cRows, Col) = MyOSPArray(Row, Col)
        Next Col
    Next Row
       
    ' Re-allocate the array to copy into it
    ReDim MyOSPArray(cNewRows + 1, ColCount + 1)
        
    ' Set the real row count back in
    RowCount = cNewRows
        
    ' Copy over the rows
    For Row = 0 To cNewRows
        For Col = 0 To ColCount
            MyOSPArray(Row, Col) = TempArray(Row, Col)
        Next Col
    Next Row
        
    ' Clear the temporary array
    ReDim TempArray(0)
        
    ' Notify each listener
    For Each v In colListeners
        Set listener = v
        listener.deletedRows iRow, cRows
    Next
        
    ' Return number of deleted rows
    OLEDBSimpleProvider_deleteRows = cRows
End Function

Private Function OLEDBSimpleProvider_find(ByVal iRowStart As Long, ByVal iColumn As Long, ByVal val As Variant, ByVal findFlags As MSDAOSP.OSPFIND, ByVal compType As MSDAOSP.OSPCOMP) As Long
    Dim RowStart As Integer, RowStop As Integer
    Dim StepValue As Integer, CaseSens As Integer, StringComp As Integer
    Dim iAnswerRow As Integer, CompResult As Integer, iRow As Integer

    
    If (findFlags And (OSPFIND_UP Or OSPFIND_UPCASESENSITIVE)) <> 0 Then
        RowStart = RowCount + 1
        RowStop = 0
        StepValue = -1
    Else
        RowStart = 0
        RowStop = RowCount + 1
        StepValue = 1
    End If
    
    If (findFlags And (OSPFIND_CASESENSITIVE Or OSPFIND_UPCASESENSITIVE)) <> 0 Then
        CaseSens = 1   'Use a Text Compare not Case Sensitive
    Else
        CaseSens = 0   'Not Case Sensitive use Binary Compare
    End If
            
    If VarType(val) = vbString Then
        StringComp = True
    Else
        StringComp = False
    End If
    
    iAnswerRow = -1
    For iRow = RowStart To RowStop Step StepValue
        If StringComp Then
            CompResult = StrComp(MyOSPArray(iRow, iColumn), val, CaseSens)
            Select Case (compType)
                Case OSPCOMP_DEFAULT, OSPCOMP_EQ:
                    If CompResult = 0 Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_GE
                    If CompResult >= 0 Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_GT
                    If CompResult > 0 Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_LE
                    If CompResult <= 0 Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_LT
                    If CompResult < 0 Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_NE
                    If CompResult <> 0 Then
                        iAnswerRow = iRow
                        Exit For
                    End If
            End Select
        Else
            Select Case (compType)
                Case OSPCOMP_DEFAULT, OSPCOMP_EQ:
                    If MyOSPArray(iRow, iColumn) = val Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_GE
                    If MyOSPArray(iRow, iColumn) >= val Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_GT
                     If MyOSPArray(iRow, iColumn) > val Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_LE
                    If MyOSPArray(iRow, iColumn) <= val Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_LT
                    If MyOSPArray(iRow, iColumn) < val Then
                        iAnswerRow = iRow
                        Exit For
                    End If
                Case OSPCOMP_NE
                    If MyOSPArray(iRow, iColumn) <> val Then
                        iAnswerRow = iRow
                        Exit For
                    End If
            End Select
        End If
    Next iRow
    OLEDBSimpleProvider_find = iAnswerRow
End Function

Private Function OLEDBSimpleProvider_getColumnCount() As Long
    OLEDBSimpleProvider_getColumnCount = ColCount
End Function
Private Function OLEDBSimpleProvider_getEstimatedRows() As Long
    OLEDBSimpleProvider_getEstimatedRows = RowCount
End Function

Private Function OLEDBSimpleProvider_getLocale() As String
    OLEDBSimpleProvider_getLocale = ""
End Function
Private Function OLEDBSimpleProvider_getRowCount() As Long
    OLEDBSimpleProvider_getRowCount = RowCount
End Function

Private Function OLEDBSimpleProvider_getRWStatus(ByVal iRow As Long, ByVal iColumn As Long) As MSDAOSP.OSPRW
    If iColumn = 1 Then
        ' Make the first column read-only
        OLEDBSimpleProvider_getRWStatus = OSPRW_READONLY
    Else
        ' Make the column read-write
        OLEDBSimpleProvider_getRWStatus = OSPRW_READWRITE
    End If
End Function

Private Function OLEDBSimpleProvider_getVariant(ByVal iRow As Long, ByVal iColumn As Long, ByVal format As MSDAOSP.OSPFORMAT) As Variant
    OLEDBSimpleProvider_getVariant = MyOSPArray(iRow, iColumn)
End Function

Private Function OLEDBSimpleProvider_insertRows(ByVal iRow As Long, ByVal cRows As Long) As Long
    Dim TempArray()
    Dim listener As OLEDBSimpleProviderListener
    Dim v As Variant
    Dim cNewRows As Integer, Row As Integer, Col As Integer
    
    'Establish a Temporary Array
    cNewRows = RowCount + cRows
    ReDim TempArray(cNewRows + 1, ColCount + 1)
    
    'If inserting past the end of the array, insert at the end of the array
    If iRow > RowCount Then
        iRow = RowCount + 1
    End If
    
    'Notify listener
    For Each v In colListeners
        Set listener = v
        listener.aboutToInsertRows iRow, cRows
    Next
        
    'Copy over the existing rows
    For Row = 0 To iRow
        For Col = 0 To ColCount
            TempArray(Row, Col) = MyOSPArray(Row, Col)
        Next Col
    Next Row
    
    'Copy the last rows which follow the inserted rows
    For Row = iRow + 1 + cRows To cNewRows
        For Col = 0 To ColCount
            TempArray(Row, Col) = MyOSPArray(Row - cRows, Col)
        Next Col
    Next Row
        
    'Re-allocate the array to copy into it
    ReDim MyOSPArray(cNewRows + 1, ColCount + 1)
    
    'Copy over the rows
    For Row = 0 To cNewRows
        For Col = 0 To ColCount
            MyOSPArray(Row, Col) = TempArray(Row, Col)
        Next Col
    Next Row
        
    'Clear the temporary array
    ReDim TempArray(0)
    
    'Set the real row count back in
    RowCount = cNewRows
    
    'Notify listeners
    For Each v In colListeners
        Set listener = v
        listener.insertedRows iRow, cRows
    Next
    
    'Return number of inserted rows
    OLEDBSimpleProvider_insertRows = cRows
End Function

Private Function OLEDBSimpleProvider_isAsync() As Long
    OLEDBSimpleProvider_isAsync = False
End Function

Private Sub OLEDBSimpleProvider_removeOLEDBSimpleProviderListener(ByVal pospIListener As MSDAOSP.OLEDBSimpleProviderListener)
    Dim i As Integer
    
    'Remove the listener:
    For i = 1 To colListeners.Count
        If colListeners(i) Is pospIListener Then
            colListeners.Remove i
        End If
    Next
End Sub

Private Sub OLEDBSimpleProvider_setVariant(ByVal iRow As Long, ByVal iColumn As Long, ByVal format As MSDAOSP.OSPFORMAT, ByVal Var As Variant)
    Dim listener As OLEDBSimpleProviderListener
    Dim v As Variant
    
    For Each v In colListeners
        Set listener = v
        listener.aboutToChangeCell iRow, iColumn    'Pre-notification
    Next
    
    MyOSPArray(iRow, iColumn) = Var
    
    For Each v In colListeners
        Set listener = v
        listener.cellChanged iRow, iColumn          'Post-notification
    Next
End Sub
Private Sub OLEDBSimpleProvider_stopTransfer()
    'Do nothing because we are already populated
End Sub