Visual Basic Concepts
Creating the MyOSPObject Class
In the previous topic, we added an ActiveX DLL project to the AXData sample. In this step, we'll create a class that implements the OLE DB Simple Provider (OSP) interfaces to access data stored in a text file.
Note This topic is part of a series that walks you through creating sample data source components. It begins with the topic Creating Data Sources.
To create the MyOSPObject class
- In the Project Explorer, select Class1 from the MyDataComponent project. In the Properties window, set the properties for Class1 as follows:
Property | Setting |
(Name) | MyOSPObject |
Double-click MyOSPObject in the Project Explorer to open its code window.
In the Object box, select (General). In the Procedure box, select (Declarations) to position yourself at the top of the code module. Add the following code:
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
Note the use of the Implements keyword for OLEDBSimpleProvider. Remember, Implements is like a contract — it means that you'll need to implement all of the interfaces of the OLEDBSimpleProvider class.
Add the following procedures to read and write data from a file:
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
In the Object box, select Class. In the Procedure box, select the Terminate event. Add the following code to the Class_Terminate event procedure to save the data when the class is terminated:
Private Sub Class_Terminate() On Error Resume Next ' Call the SaveData method SaveData End Sub
To implement OLEDBSimpleProvider
Since the MyOSPObject class implements the OLEDBSimpleProvider class, we have to implement all of its interfaces, even if we aren't going to use them:
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the addOLEDBSimpleProviderListener function. Add the following code to the function procedure to add listeners that will notify the class when data changes:
Private Sub OLEDBSimpleProvider_addOLEDBSimpleProviderListener _ (ByVal pospIListener As OLEDBSimpleProviderListener) ' Add a listener to the Listeners collection. If Not (pospIListener Is Nothing) Then Set ospl = pospIListener colListeners.Add ospl End If End Sub
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the deleteRows function. Add the following code to the procedure to delete a row of data from a file:
Private Function OLEDBSimpleProvider_deleteRows _ (ByVal iRow As Long, ByVal cRows As Long) As Long Dim TempArray() Dim listener As OLEDBSimpleProviderListener Dim v As Variant ' 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
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the find function. Add the following code to the procedure to find data within a file:
Private Function OLEDBSimpleProvider_find(ByVal iRowStart As Long, _ ByVal iColumn As Long, ByVal val As Variant, _ ByVal findFlags As OSPFIND, ByVal compType As OSPCOMP) As Long Dim RowStart As Integer, RowStop 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
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the getColumnCount function. Add the following code to the procedure to return the number of fields within a file:
Private Function OLEDBSimpleProvider_getColumnCount() As Long OLEDBSimpleProvider_getColumnCount = ColCount End Function
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the getEstimatedRows function. Add the following code to the procedure to return the estimated number of rows of data within a file:
Private Function OLEDBSimpleProvider_getEstimatedRows() As Long OLEDBSimpleProvider_getEstimatedRows = RowCount End Function
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the getLocale function. Add the following code to the procedure:
Private Function OLEDBSimpleProvider_getLocale() As String OLEDBSimpleProvider_getLocale = "" End Function
Note that in this case the function simply returns a null value. Even though it doesn't do anything, the function has to be added — since this class implements OLEDBSimpleProvider, all of its interfaces have to be included.
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the getRowCount function. Add the following code to the procedure to return the number of rows of data within a file:
Private Function OLEDBSimpleProvider_getRowCount() As Long OLEDBSimpleProvider_getRowCount = RowCount End Function
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the getRWStatus function. Add the following code to the procedure to set the Read/Write status by column — in this case, the first column will be read-only while the remaining columns will be read-write:
Private Function OLEDBSimpleProvider_getRWStatus _ (ByVal iRow As Long, ByVal iColumn As Long) As 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
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the getVariant function. Add the following code to the procedure to return data stored in a specific row and column:
Private Function OLEDBSimpleProvider_getVariant _ (ByVal iRow As Long, ByVal iColumn As Long, _ ByVal format As OSPFORMAT) As Variant OLEDBSimpleProvider_getVariant = MyOSPArray(iRow, iColumn) End Function
The getVariant function also accepts a format argument which can be used to determine the formatting of the data returned.
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the insertRows function. Add the following code to the procedure to insert a new row of data into a file:
Private Function OLEDBSimpleProvider_insertRows _ (ByVal iRow As Long, ByVal cRows As Long) As Long Dim TempArray() Dim listener As OLEDBSimpleProviderListener Dim v As Variant ' 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
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the isAsynch function. Add the following code to the procedure to determine if the OSP can return data asynchronously:
Private Function OLEDBSimpleProvider_isAsync() As Long OLEDBSimpleProvider_isAsync = False End Function
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the removeOLEDBSimpleProviderListener function. Add the following code to the procedure to remove a listener:
Private Sub OLEDBSimpleProvider_removeOLEDBSimpleProviderListener _ (ByVal pospIListener As OLEDBSimpleProviderListener) ' Remove the listener For i = 1 To colListeners.Count If colListeners(i) Is pospIListener Then colListeners.Remove i End If Next End Sub
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the setVariant function. Add the following code to the procedure to retrieve data from a particular row and column and to designate a listener to provide notification that data has changed:
Private Sub OLEDBSimpleProvider_setVariant(ByVal iRow As Long, _ ByVal iColumn As Long, ByVal format As 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
In the Object box, select OLEDBSimpleProvider. In the Procedure box, select the stopTransfer function. Add the following code to the procedure:
Private Sub OLEDBSimpleProvider_stopTransfer() ' Do nothing because we are already populated End Sub
Note that there is no code in this procedure, but the procedure must be included because this class implements OLEDBSimpleProvider. You could add code here that would allow you to cancel loading during a long transfer.
Choose Save Project Group from the File menu to save your changes. When prompted for a file name for the Class module, choose the default (MyOSPObject.cls). When prompted for a file name for the Project, choose the default (MyDataComponent.vbp).
Whew! If that seemed like a lot of code, there's a good reason for it — the MyOSPObject class provides much of the functionality that you might find in a database. With OSP, you can use almost any file as you might have used a database in the past.
In the next step, we'll create another class that acts as the data source to the MyOSPObject class.
Step by Step
This topic is part of a series that walks you through creating sample ActiveX data sources.
To | See |
Go to the next step | Creating the MyDataSource Class |
Start from the beginning | Creating Data Sources |