This example demonstrates how to subscribe and unsubscribe to the Connection and Recordset events. If you want ADO to ignore an event, set adStatus = %adStatusUnwantedEvent.
' ########################################################################################
' Microsoft Windows
' File: ADOEX_Events.bas
' Contents: ADO example
' Opens a connection, creates a recordset and parses the result.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"
' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN
LOCAL pConnection AS ADOConnection
LOCAL pRecordset AS ADORecordset
LOCAL ConStr AS WSTRING
LOCAL SqlStr AS WSTRING
LOCAL vRes AS VARIANT
LOCAL pADOConnectionEvents AS ADOConnectionEventsImpl
LOCAL pADORecordsetEvents AS ADORecordsetEventsImpl
' // Create a Connection object
pConnection = NEWCOM "ADODB.Connection"
IF ISNOTHING(pConnection) THEN EXIT FUNCTION
' // Create a Recordset object
pRecordset = NEWCOM "ADODB.Recordset"
IF ISNOTHING(pRecordset) THEN EXIT FUNCTION
' // Connect events
pADOConnectionEvents = CLASS "CADOConnectionEvents"
EVENTS FROM pConnection CALL pADOConnectionEvents
pADORecordsetEvents = CLASS "CADORecordsetEvents"
EVENTS FROM pRecordset CALL pADORecordsetEvents
TRY
' // Connection String - Change it if needed
ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
' // Open the connection
pConnection.Open ConStr
' // Open the recordset
SqlStr = "SELECT TOP 20 * FROM Authors ORDER BY Author"
pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
DO
' // While not at the end of the recordset...
IF ISTRUE pRecordset.EOF() THEN EXIT DO
' // Get the content of the "Author" column
vRes = pRecordset.Collect("Author")
PRINT VARIANT$$(vRes)
' // Fetch the next row
pRecordset.MoveNext
LOOP
CATCH
' // Display error information
STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
FINALLY
' // Close the recordset
IF pRecordset.State = %adStateOpen THEN pRecordset.Close
' // Close the connection
IF pConnection.State = %adStateOpen THEN pConnection.Close
END TRY
' // Disconnect events
IF ISOBJECT(pADOConnectionEvents) THEN EVENTS END pADOConnectionEvents
IF ISOBJECT(pADORecordsetEvents) THEN EVENTS END pADORecordsetEvents
WAITKEY$
END FUNCTION
' ========================================================================================
' ########################################################################################
' Class CConnectionEvents
' Interface name = ConnectionEvents
' IID = {00000400-0000-0010-8000-00AA006D2EA4}
' Attributes = 4096 [&H1000] [Dispatchable]
' Code generated by the TypeLib Browser 4.0.8.0 (c) 2008 by José Roca
' Date: 07 ago 2008 Time: 06:14:03
' ########################################################################################
CLASS CADOConnectionEvents GUID$("{BD67A17B-4C2B-4E02-A185-252353E7981E}") AS EVENT
INTERFACE ADOConnectionEventsImpl GUID$("{00000400-0000-0010-8000-00AA006D2EA4}") AS EVENT
INHERIT IDispatch
' =====================================================================================
METHOD InfoMessage <0> ( _
BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD BeginTransComplete <1> ( _
BYVAL TransactionLevel AS LONG _ ' __in long TransactionLevel
, BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD CommitTransComplete <3> ( _
BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD RollbackTransComplete <2> ( _
BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD WillExecute <4> ( _
BYREF Source AS WSTRING _ ' __inout BSTR *Source
, BYREF CursorType AS LONG _ ' __inout CursorTypeEnum *CursorType
, BYREF LockType AS LONG _ ' __inout LockTypeEnum *LockType
, BYREF Options AS LONG _ ' __inout long *Options
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pCommand AS ADOCommand _ ' __in _Command *pCommand
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD ExecuteComplete <5> ( _
BYVAL RecordsAffected AS LONG _ ' __in long RecordsAffected
, BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pCommand AS ADOCommand _ ' __in _Command *pCommand
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD WillConnect <6> ( _
BYREF ConnectionString AS WSTRING _ ' __inout BSTR *ConnectionString
, BYREF UserID AS WSTRING _ ' __inout BSTR *UserID
, BYREF Password AS WSTRING _ ' __inout BSTR *Password
, BYREF Options AS LONG _ ' __inout long *Options
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
? ConnectionString
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD ConnectComplete <7> ( _
BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD Disconnect <8> ( _
BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pConnection AS ADOConnection _ ' __in _Connection *pConnection
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ========================================================================================
' ########################################################################################
' Class CRecordsetEvents
' Interface name = RecordsetEvents
' IID = {00000266-0000-0010-8000-00AA006D2EA4}
' Attributes = 4096 [&H1000] [Dispatchable]
' Code generated by the TypeLib Browser 4.0.8.0 (c) 2008 by José Roca
' Date: 07 ago 2008 Time: 06:19:17
' ########################################################################################
CLASS CADORecordsetEvents GUID$("{7D3FC1E4-D47D-49FC-9042-970A342FAFFE}") AS EVENT
INTERFACE ADORecordsetEventsImpl GUID$("{00000266-0000-0010-8000-00AA006D2EA4}") AS EVENT
INHERIT IDispatch
' =====================================================================================
METHOD WillChangeField <9> ( _
BYVAL cFields AS LONG _ ' __in long cFields
, BYVAL Fields AS VARIANT _ ' __in VARIANT Fields
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD FieldChangeComplete <10> ( _
BYVAL cFields AS LONG _ ' __in long cFields
, BYVAL Fields AS VARIANT _ ' __in VARIANT Fields
, BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD WillChangeRecord <11> ( _
BYVAL adReason AS LONG _ ' __in EventReasonEnum adReason
, BYVAL cRecords AS LONG _ ' __in long cRecords
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD RecordChangeComplete <12> ( _
BYVAL adReason AS LONG _ ' __in EventReasonEnum adReason
, BYVAL cRecords AS LONG _ ' __in long cRecords
, BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD WillChangeRecordset <13> ( _
BYVAL adReason AS LONG _ ' __in EventReasonEnum adReason
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD RecordsetChangeComplete <14> ( _
BYVAL adReason AS LONG _ ' __in EventReasonEnum adReason
, BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD WillMove <15> ( _
BYVAL adReason AS LONG _ ' __in EventReasonEnum adReason
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD MoveComplete <16> ( _
BYVAL adReason AS LONG _ ' __in EventReasonEnum adReason
, BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD EndOfRecordset <17> ( _
BYREF fMoreData AS INTEGER _ ' __inou VARIANT_BOOL *fMoreData
, BYREF adStatus AS LONG _ ' __inou EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD FetchProgress <18> ( _
BYVAL Progress AS LONG _ ' __in long Progress
, BYVAL MaxProgress AS LONG _ ' __in long MaxProgress
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
' =====================================================================================
METHOD FetchComplete <19> ( _
BYVAL pError AS ADOError _ ' __in Error *pError
, BYREF adStatus AS LONG _ ' __inout EventStatusEnum *adStatus
, BYVAL pRecordset AS ADORecordset _ ' __in _Recordset *pRecordset
) ' void
' *** Insert your code here ***
PRINT FUNCNAME$
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ========================================================================================