ADO/ADOX Examples

[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_RowsetSupportsBookmarks.bas
' Contents: ADO example
' Checks if the recordset supports bookmarks.
' 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.
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"
#INCLUDE ONCE "OLEDB.INC"

' ========================================================================================
' Checks if the recordset supports bookmarks.
' Returns VARIANT_FALSE (0) or VARIANT_TRUE (-1)
' With ADO, you can use bBookmarks = pRecordset.Supports(%adBookmark) instead.
' ========================================================================================
FUNCTION OLEDB_RowsetSupportsBookmarks (BYVAL pRecordset AS ADORecordset) AS INTEGER

   LOCAL hr AS LONG                         ' // HRESULT code
   LOCAL pRC AS ADORecordsetConstruction    ' // RecordsetConstruction object
   LOCAL pRowset AS IRowset                 ' // IRowset interface
   LOCAL pRI AS IRowsetInfo                 ' // IRowsetInfo interface
   LOCAL PropIDSet AS DBPROPIDSET           ' // DBPROPIDSET structure
   DIM   rgPropertyIDs(0) AS DWORD          ' // Array of Property IDs
   LOCAL ulPropSet AS DWORD                 ' // Number of returned properties
   LOCAL pPropSet AS DBPROPSET PTR          ' // Pointer variable to access the DBPROPSET structure

   ' // Get a reference to the ADORecordsetConstruction interface
   pRC = pRecordset
   IF ISNOTHING(pRc) THEN EXIT FUNCTION
   ' // Get a reference to the Rowset interface
   pRowset = pRc.Rowset
   ' // Release the ADORecordsetConstruction obejct (no longer needed)
   pRC = NOTHING
   ' // Terminate if pRowset is false
   IF ISNOTHING(pRowset) THEN EXIT FUNCTION

   ' // Query for the IRowsetInfo interface
   pRI = pRowset
   IF ISNOTHING(pRI) THEN EXIT FUNCTION
   ' // Fill the DBPROPIDSET structure
   PropIDSet.cPropertyIDs = 1
   PropIDSet.guidPropertySet = $DBPROPSET_ROWSET
   rgPropertyIDs(0) = %DBPROP_BOOKMARKS
   PropIDSet.rgPropertyIDs = VARPTR(rgPropertyIDs(0))
   ' // Retrieve the property
   hr = pRI.GetProperties(1, PropIDSet, ulPropSet, pPropSet)
   IF hr = %S_OK AND ISTRUE pPropSet THEN
      ' // If it is a valid address...
      IF ISTRUE @pPropSet.rgProperties THEN
         ' // Get the value: VARIANT_FALSE(0) or VARIANT_TRUE (-1)
         IF ISTRUE ulPropSet THEN  ' Must be 1, since we have requested one property
            FUNCTION = @pPropSet.@rgProperties[0].vValue.boolVal
            ' // Note: We don't need to clear the variant because it doesn't contain
            ' // any reference value. If it did, such a BSTR, we will need to clear it using
            ' // VariantClear @pPropSetPtr.@rgProperties[0].vValue to avoid memory leaks.
         END IF
         ' // Free the memory allocated by the server for the properties array
         CoTaskMemFree @pPropSet.rgProperties
      END IF
      ' // Free the memory allocated by the server for the DBPROPSET structure
      CoTaskMemFree pPropSet
   END IF

   ' // Release the RowsetInfo interface
   pRI = NOTHING
   ' // Release the Rowset interface
   pRowset = NOTHING

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection       ' // Connection object
   LOCAL pRecordset AS ADORecordset         ' // Recordset object
   LOCAL ConStr AS WSTRING                  ' // Connection string
   LOCAL SqlStr AS WSTRING                  ' // Query string
   LOCAL bBookmarks AS INTEGER              ' // Flag

   ' // 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

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdTable
      ' // Check if the recordset supports boookmars
      bBookmarks = OLEDB_RowsetSupportsBookmarks(pRecordset)
      ? "Result = " & STR$(bBookmarks)
   CATCH
      ' // Display error information
      ? 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

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION
' ========================================================================================


[José Roca]

The following example demonstrates how to save a recordset in XML format.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SaveAsXml.bas
' Contents: ADO example
' Demonstrates how to save a recordset in XML format.
' 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 "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL bstrFileName AS WSTRING

   ' // 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

   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 * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Save the recordset as XML
      bstrFileName = "Publishers.xml"
      IF DIR$(bstrFileName) <> "" THEN KILL bstrFileName
      pRecordset.Save bstrFileName, %adPersistXML
      STDOUT "Recordset saved"
   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

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaColumns.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaColumns query.
' Also demonstrates how to constrain the query to an specified type.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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"
#INCLUDE ONCE "oaidl.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Create a SafeArray with four elements
      DIM rgsabound AS SAFEARRAYBOUND
      DIM psa AS DWORD
      rgsabound.lLBound = 1
      rgsabound.cElements = 4
      psa = SafeArrayCreate(%VT_VARIANT, 1, rgsabound)
      ' -------------------------------------------------------------------------
      ' Explanation:
      ' %adSchemaColumns has four possible constrains:
      ' TABLE_CATALOG
      ' TABLE_SCHEMA
      ' TABLE_NAME
      ' COLUMN_NAME
      ' We are going to constrain by the table name, that is the third element.
      ' The non-used elements of the array must be filled with and EMPTY variant.
      ' -------------------------------------------------------------------------
      DIM vPrm AS VARIANT
      DIM vEmpty AS VARIANT
      DIM ix AS LONG
      ix = 1 : SafeArrayPutElement(psa, ix, vEmpty)
      ix = 2 : SafeArrayPutElement(psa, ix, vEmpty)
      vPrm = "Titles" AS WSTRING
      ix = 3 : SafeArrayPutElement(psa, ix, vPrm)
      ix = 4 : SafeArrayPutElement(psa, ix, vEmpty)

      ' // Insert the SafeArray into a variant
      DIM vCriteria AS VARIANT
      DIM lpv AS VARIANTAPI PTR
      lpv = VARPTR(vCriteria)
      @lpv.vt = %VT_ARRAY OR %VT_VARIANT
      @lpv.vd.parray = psa
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaColumns, vCriteria)
      ' // Destroy the SafeArray
      vCriteria = EMPTY
      ' // Parse the recordset
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_CATALOG")
         PRINT "Table catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_SCHEMA")
         PRINT "Table schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_NAME")
         PRINT "Table name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_NAME")
         PRINT "Column name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_GUID")
         PRINT "Column guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("COLUMN_PROPID")
         PRINT "Column propid: " VARIANT#(vRes)
         vRes = pRecordset.Collect("ORDINAL_POSITION")
         PRINT "Ordinal position: " VARIANT#(vRes)
         vRes = pRecordset.Collect("COLUMN_HASDEFAULT")
         PRINT "Column has default: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("COLUMN_DEFAULT")
         PRINT "Column default: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_FLAGS")
         PRINT "Column flags: " VARIANT#(vRes)
         vRes = pRecordset.Collect("IS_NULLABLE")
         PRINT "Is nullable: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("DATA_TYPE")
         PRINT "Data Type: " VARIANT#(vRes)
         vRes = pRecordset.Collect("TYPE_GUID")
         PRINT "Type guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("CHARACTER_MAXIMUM_LENGTH")
         PRINT "Character maximum length: " VARIANT#(vRes)
         vRes = pRecordset.Collect("CHARACTER_OCTET_LENGTH")
         PRINT "Character octet length: " VARIANT#(vRes)
         vRes = pRecordset.Collect("NUMERIC_PRECISION")
         PRINT "Numeric precision: " VARIANT#(vRes)
         vRes = pRecordset.Collect("NUMERIC_SCALE")
         PRINT "Numeric scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("DATETIME_PRECISION")
         PRINT "Datetime precision: " VARIANT#(vRes)
         vRes = pRecordset.Collect("CHARACTER_SET_CATALOG")
         PRINT "Character set catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CHARACTER_SET_SCHEMA")
         PRINT "Character set schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CHARACTER_SET_NAME")
         PRINT "Character set name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLLATION_CATALOG")
         PRINT "Collation catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLLATION_SCHEMA")
         PRINT "Collation schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DOMAIN_NAME")
         PRINT "Domain name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DESCRIPTION")
         PRINT "Description: " VARIANT$$(vRes)
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaColumns_b.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaColumns query.
' Also demonstrates how to constrain the query to an specified type.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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 vRes AS VARIANT
   LOCAL vCriteria AS VARIANT
   DIM   vCriteriaArray(1 TO 4) AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Create a SafeArray with four elements
      vCriteriaArray(1) = EMPTY
      vCriteriaArray(2) = EMPTY
      vCriteriaArray(3) = "Titles"
      vCriteriaArray(4) = EMPTY
      vCriteria = vCriteriaArray()
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaColumns, vCriteria)
      ' // Parse the recordset
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_CATALOG")
         PRINT "Table catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_SCHEMA")
         PRINT "Table schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_NAME")
         PRINT "Table name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_NAME")
         PRINT "Column name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_GUID")
         PRINT "Column guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("COLUMN_PROPID")
         PRINT "Column propid: " VARIANT#(vRes)
         vRes = pRecordset.Collect("ORDINAL_POSITION")
         PRINT "Ordinal position: " VARIANT#(vRes)
         vRes = pRecordset.Collect("COLUMN_HASDEFAULT")
         PRINT "Column has default: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("COLUMN_DEFAULT")
         PRINT "Column default: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_FLAGS")
         PRINT "Column flags: " VARIANT#(vRes)
         vRes = pRecordset.Collect("IS_NULLABLE")
         PRINT "Is nullable: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("DATA_TYPE")
         PRINT "Data Type: " VARIANT#(vRes)
         vRes = pRecordset.Collect("TYPE_GUID")
         PRINT "Type guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("CHARACTER_MAXIMUM_LENGTH")
         PRINT "Character maximum length: " VARIANT#(vRes)
         vRes = pRecordset.Collect("CHARACTER_OCTET_LENGTH")
         PRINT "Character octet length: " VARIANT#(vRes)
         vRes = pRecordset.Collect("NUMERIC_PRECISION")
         PRINT "Numeric precision: " VARIANT#(vRes)
         vRes = pRecordset.Collect("NUMERIC_SCALE")
         PRINT "Numeric scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("DATETIME_PRECISION")
         PRINT "Datetime precision: " VARIANT#(vRes)
         vRes = pRecordset.Collect("CHARACTER_SET_CATALOG")
         PRINT "Character set catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CHARACTER_SET_SCHEMA")
         PRINT "Character set schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CHARACTER_SET_NAME")
         PRINT "Character set name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLLATION_CATALOG")
         PRINT "Collation catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLLATION_SCHEMA")
         PRINT "Collation schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DOMAIN_NAME")
         PRINT "Domain name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DESCRIPTION")
         PRINT "Description: " VARIANT$$(vRes)
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaForeignKeys.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaForeignKeys query.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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 vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   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 schema
      pRecordset = pConnection.OpenSchema(%adSchemaForeignKeys)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("FK_TABLE_CATALOG")
         STDOUT "Table catalog: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("FK_TABLE_SCHEMA")
         STDOUT "Table schema: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("FK_TABLE_NAME")
         STDOUT "Table name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("FK_COLUMN_NAME")
         STDOUT "Column name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("FK_COLUMN_GUID")
         STDOUT "Column guid: " & GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("FK_COLUMN_PROPID")
         STDOUT "Column propid: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("ORDINAL")
         STDOUT "Ordinal: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("UPDATE_RULE")
         STDOUT "Update rule: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("DELETE_RULE")
         STDOUT "Delete rule: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("FK_NAME")
         STDOUT "Foreign key name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("DEFERRABILITY")
         STDOUT "Deferrability: " & STR$(VARIANT#(vRes))
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaIndexes.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaIndexes query.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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 vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   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 schema
      pRecordset = pConnection.OpenSchema(%adSchemaIndexes)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_CATALOG")
         STDOUT "Table catalog: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_SCHEMA")
         STDOUT "Table schema: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_NAME")
         STDOUT "Table name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("INDEX_CATALOG")
         STDOUT "Index catalog: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("INDEX_SCHEMA")
         STDOUT "Index schema: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("INDEX_NAME")
         STDOUT "Index name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("PRIMARY_KEY")
         STDOUT "Primary key: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("UNIQUE")
         STDOUT "Unique: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("CLUSTERED")
         STDOUT "Clustered: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("TYPE")
         STDOUT "Type: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("FILL_FACTOR")
         STDOUT "Fill factor: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("INITIAL_SIZE")
         STDOUT "Initial size: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("NULLS")
         STDOUT "Nulls: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("SORT_BOOKMARKS")
         STDOUT "Sort bookmarks: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("AUTO_UPDATE")
         STDOUT "Auto update: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("NULL_COLLATION")
         STDOUT "Null collation: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("ORDINAL_POSITION")
         STDOUT "Ordinal position: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("COLUMN_NAME")
         STDOUT "Column name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_GUID")
         STDOUT "Column guid: " & GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("COLUMN_PROPID")
         STDOUT "Column propid: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("COLLATION")
         STDOUT "Collation: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("CARDINALITY")
         STDOUT "Cardinality: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("PAGES")
         STDOUT "Pages: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("FILTER_CONDITION")
         STDOUT "Filter condition: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("INTEGRATED")
         STDOUT "Integrated: " & STR$(CINT(VARIANT#(vRes)))
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaPrimaryKeys.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaPrimaryKeys query.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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 vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   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 schema
      pRecordset = pConnection.OpenSchema(%adSchemaPrimaryKeys)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_CATALOG")
         STDOUT "Table catalog: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_SCHEMA")
         STDOUT "Table schema: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_NAME")
         STDOUT "Table name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_NAME")
         STDOUT "Column name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("COLUMN_GUID")
         STDOUT "Column guid: " & GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("COLUMN_PROPID")
         STDOUT "Column propid: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("ORDINAL")
         STDOUT "Ordinal: " & STR$(VARIANT#(vRes))
         vRes = pRecordset.Collect("PK_NAME")
         STDOUT "Primary key name: " & VARIANT$$(vRes)
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaProvidesTypes.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaProviderTypes query.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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 vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   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 schema
      pRecordset = pConnection.OpenSchema(%adSchemaProviderTypes)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TYPE_NAME")
         PRINT "Type name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DATA_TYPE")
         PRINT "Data type: " VARIANT#(vRes)
         vRes = pRecordset.Collect("COLUMN_SIZE")
         PRINT "Column size: " VARIANT#(vRes)
         vRes = pRecordset.Collect("LITERAL_PREFIX")
         PRINT "Literal prefix: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("LITERAL_SUFFIX")
         PRINT "Literal suffix: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CREATE_PARAMS")
         PRINT "Create params: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("IS_NULLABLE")
         PRINT "Is nullable: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("CASE_SENSITIVE")
         PRINT "Case sensitive: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("SEARCHABLE")
         PRINT "Searchable: " VARIANT#(vRes)
         vRes = pRecordset.Collect("UNSIGNED_ATTRIBUTE")
         PRINT "Unsigned attribute: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("FIXED_PREC_SCALE")
         PRINT "Fixed precision scale: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("AUTO_UNIQUE_VALUE")
         PRINT "Auto unique value: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("LOCAL_TYPE_NAME")
         PRINT "Local type name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("MINIMUM_SCALE")
         PRINT "Minimum scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("MAXIMUM_SCALE")
         PRINT "Maximum scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("GUID")
         PRINT "Guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("TYPELIB")
         PRINT "Typelib: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("VERSION")
         PRINT "Version: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("IS_LONG")
         PRINT "Is long: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("BEST_MATCH")
         PRINT "Best match: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("IS_FIXEDLENGTH")
         PRINT "Is fixed length: " CINT(VARIANT#(vRes))
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaProvidesTypes2.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaProviderTypes query.
' Also demonstrates how to constrain the query to an specified type.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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"
#INCLUDE ONCE "oaidl.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Create a SafeArray with two elements
      DIM rgsabound AS SAFEARRAYBOUND
      DIM psa AS DWORD
      rgsabound.lLBound = 1
      rgsabound.cElements = 2
      psa = SafeArrayCreate(%VT_VARIANT, 1, rgsabound)
      ' -------------------------------------------------------------------------
      ' Explanation:
      ' In the SchemaEnum of the ADO documentation you will find that
      ' %adSchemaProviderTypes has two possible constrains:
      ' DATE_TYPE
      ' BEST_MATCH
      ' We are going to constrain by the date type, that is the first element.
      ' The non-used element of the array must be filled with and EMPTY variant.
      ' -------------------------------------------------------------------------
      ' // Puts in it the value 131 to constrain the query to the decimal type
      DIM vPrm AS VARIANT
      DIM vEmpty AS VARIANT
      DIM ix AS LONG
      vPrm = 131 AS WORD
      ix = 1 : SafeArrayPutElement(psa, ix, vPrm)
      ix = 2 : SafeArrayPutElement(psa, ix, vEmpty)
      ' // Insert the SafeArray into a variant
      DIM vCriteria AS VARIANT
      DIM lpv AS VARIANTAPI PTR
      lpv = VARPTR(vCriteria)
      @lpv.vt = %VT_ARRAY OR %VT_VARIANT
      @lpv.vd.parray = psa
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaProviderTypes, vCriteria)
      ' // Destroy the SafeArray
      vCriteria = EMPTY
      ' // Parse the recordset
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TYPE_NAME")
         PRINT "Type name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DATA_TYPE")
         PRINT "Data type: " VARIANT#(vRes)
         vRes = pRecordset.Collect("COLUMN_SIZE")
         PRINT "Column size: " VARIANT#(vRes)
         vRes = pRecordset.Collect("LITERAL_PREFIX")
         PRINT "Literal prefix: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("LITERAL_SUFFIX")
         PRINT "Literal suffix: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CREATE_PARAMS")
         PRINT "Create params: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("IS_NULLABLE")
         PRINT "Is nullable: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("CASE_SENSITIVE")
         PRINT "Case sensitive: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("SEARCHABLE")
         PRINT "Searchable: " VARIANT#(vRes)
         vRes = pRecordset.Collect("UNSIGNED_ATTRIBUTE")
         PRINT "Unsigned attribute: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("FIXED_PREC_SCALE")
         PRINT "Fixed precision scale: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("AUTO_UNIQUE_VALUE")
         PRINT "Auto unique value: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("LOCAL_TYPE_NAME")
         PRINT "Local type name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("MINIMUM_SCALE")
         PRINT "Minimum scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("MAXIMUM_SCALE")
         PRINT "Maximum scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("GUID")
         PRINT "Guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("TYPELIB")
         PRINT "Typelib: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("VERSION")
         PRINT "Version: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("IS_LONG")
         PRINT "Is long: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("BEST_MATCH")
         PRINT "Best match: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("IS_FIXEDLENGTH")
         PRINT "Is fixed length: " CINT(VARIANT#(vRes))
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaProviderTypes2b.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaProviderTypes query.
' Also demonstrates how to constrain the query to an specified type.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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 vRes AS VARIANT
   LOCAL vCriteria AS VARIANT
   DIM   vCriteriaArray(1 TO 2) AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Put in it the value 131 to constrain the query to the decimal type
      vCriteriaArray(1) = 131 AS WORD
      vCriteriaArray(2) = EMPTY
      vCriteria = vCriteriaArray()
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaProviderTypes, vCriteria)
      ' // Parse the recordset
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TYPE_NAME")
         PRINT "Type name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("DATA_TYPE")
         PRINT "Data type: " VARIANT#(vRes)
         vRes = pRecordset.Collect("COLUMN_SIZE")
         PRINT "Column size: " VARIANT#(vRes)
         vRes = pRecordset.Collect("LITERAL_PREFIX")
         PRINT "Literal prefix: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("LITERAL_SUFFIX")
         PRINT "Literal suffix: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("CREATE_PARAMS")
         PRINT "Create params: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("IS_NULLABLE")
         PRINT "Is nullable: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("CASE_SENSITIVE")
         PRINT "Case sensitive: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("SEARCHABLE")
         PRINT "Searchable: " VARIANT#(vRes)
         vRes = pRecordset.Collect("UNSIGNED_ATTRIBUTE")
         PRINT "Unsigned attribute: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("FIXED_PREC_SCALE")
         PRINT "Fixed precision scale: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("AUTO_UNIQUE_VALUE")
         PRINT "Auto unique value: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("LOCAL_TYPE_NAME")
         PRINT "Local type name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("MINIMUM_SCALE")
         PRINT "Minimum scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("MAXIMUM_SCALE")
         PRINT "Maximum scale: " VARIANT#(vRes)
         vRes = pRecordset.Collect("GUID")
         PRINT "Guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("TYPELIB")
         PRINT "Typelib: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("VERSION")
         PRINT "Version: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("IS_LONG")
         PRINT "Is long: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("BEST_MATCH")
         PRINT "Best match: " CINT(VARIANT#(vRes))
         vRes = pRecordset.Collect("IS_FIXEDLENGTH")
         PRINT "Is fixed length: " CINT(VARIANT#(vRes))
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaTables.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaTables query.
' 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"
#INCLUDE ONCE "oaidl.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL d  AS ASCIIZ * 64
   LOCAL st AS SYSTEMTIME
   LOCAL vbDate AS DOUBLE

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Create a SafeArray with two elements
      DIM rgsabound AS SAFEARRAYBOUND
      DIM psa AS DWORD
      rgsabound.lLBound = 1
      rgsabound.cElements = 2
      psa = SafeArrayCreate(%VT_VARIANT, 1, rgsabound)
      ' -------------------------------------------------------------------------
      ' Explanation:
      ' %adSchemaColumns has four possible constrains:
      ' TABLE_CATALOG
      ' TABLE_SCHEMA
      ' TABLE_NAME
      ' TABLE_TYPE
      ' We are going to constrain by the table type, that is the fourth element.
      ' The non-used elements of the array must be filled with and EMPTY variant.
      ' -------------------------------------------------------------------------
      DIM vPrm AS VARIANT
      DIM vEmpty AS VARIANT
      DIM ix AS LONG
      ix = 1 : SafeArrayPutElement(psa, ix, vEmpty)
      ix = 2 : SafeArrayPutElement(psa, ix, vEmpty)
      ix = 3 : SafeArrayPutElement(psa, ix, vEmpty)
      vPrm = "Table" AS WSTRING
      ix = 4 : SafeArrayPutElement(psa, ix, vPrm)
      ' // Insert the SafeArray into a variant
      DIM vCriteria AS VARIANT
      DIM lpv AS VARIANTAPI PTR
      lpv = VARPTR(vCriteria)
      @lpv.vt = %VT_ARRAY OR %VT_VARIANT
      @lpv.vd.parray = psa
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaTables, vCriteria)
      ' // Destroy the SafeArray
      vCriteria = EMPTY
      ' // Parse the recordset
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_CATALOG")
         PRINT "Table catalog: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_SCHEMA")
         PRINT "Table schema: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_NAME")
         PRINT "Table name: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_TYPE")
         PRINT "Table type: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_GUID")
         PRINT "Table guid: " GUIDTXT$(VARIANT$$(vRes))
         vRes = pRecordset.Collect("DESCRIPTION")
         PRINT "Table description: " VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_PROPID")
         PRINT "Table propid: " VARIANT#(vRes)
         vRes = pRecordset.Collect("DATE_CREATED")
         vbDate = VARIANT#(vRes)
         VariantTimeToSystemTime vbdate, st
         GetDateFormat 0, 1, st, BYVAL %NULL, d, 64
         PRINT "Date created: " d
         vRes = pRecordset.Collect("DATE_MODIFIED")
         vbDate = VARIANT#(vRes)
         VariantTimeToSystemTime vbdate, st
         GetDateFormat 0, 1, st, BYVAL %NULL, d, 64
         PRINT "Date modified: " d
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaTables2.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaTables query.
' Checks if a table exists in a database.
' 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"
#INCLUDE ONCE "oaidl.inc"

FUNCTION AdoTableExists (BYVAL pConnection AS ADOCOnnection, BYVAL strTableName AS STRING) AS LONG

   LOCAL pRecordset AS ADORecordset
   LOCAL vRes AS VARIANT

   ' // Create a SafeArray with four elements
   DIM rgsabound AS SAFEARRAYBOUND
   DIM psa AS DWORD
   rgsabound.lLBound = 1
   rgsabound.cElements = 4
   psa = SafeArrayCreate(%VT_VARIANT, 1, rgsabound)

   ' Explanation:
   ' In the SchemaEnum of the ADO documentation you will find that
   ' %adSchemaColumns has four possible constrains:
   ' TABLE_CATALOG
   ' TABLE_SCHEMA
   ' TABLE_NAME
   ' TABLE_TYPE
   ' We are going to constrain by the table name and table type.
   ' The non-used elements of the array must be filled with and EMPTY variant.

   DIM vPrm AS VARIANT
   DIM vEmpty AS VARIANT
   DIM ix AS LONG
   ix = 1 : SafeArrayPutElement(psa, ix, vEmpty)
   ix = 2 : SafeArrayPutElement(psa, ix, vEmpty)
   vPrm = strTableName AS WSTRING
   ix = 3 : SafeArrayPutElement(psa, ix, vPrm)
   vPrm = "Table" AS WSTRING
   ix = 4 : SafeArrayPutElement(psa, ix, vPrm)

   ' // Insert the SafeArray into a variant
   DIM vCriteria AS VARIANT
   DIM lpv AS VARIANTAPI PTR
   lpv = VARPTR(vCriteria)
   @lpv.vt = %VT_ARRAY OR %VT_VARIANT
   @lpv.vd.parray = psa

   ' // Open the schema
   pRecordset = pConnection.OpenSchema(%adSchemaTables, vCriteria)

   ' // Destroy the SafeArray
   vCriteria = EMPTY

   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   vRes = pRecordset.Collect("TABLE_NAME")
   IF UCASE$(VARIANT$$(vRes)) = UCASE$(strTableName) THEN FUNCTION = %TRUE

   ' // Close and release the recordset
   pRecordset.Close
   pRecordset = NOTHING

END FUNCTION

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Check if Publishers table exists
      IF ISTRUE AdoTableExists(pConnection, "Publishers") THEN
         STDOUT "Table exists"
      ELSE
         STDOUT "Table doesn't exist"
      END IF
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Release the Connection object
   pConnection = NOTHING

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaTables2b.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaTables query.
' Checks if a table exists in a database.
' 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"

FUNCTION AdoTableExists (BYVAL pConnection AS ADOCOnnection, BYVAL strTableName AS STRING) AS LONG

   LOCAL pRecordset AS ADORecordset
   LOCAL vRes AS VARIANT
   LOCAL vCriteria AS VARIANT
   DIM   vCriteriaArray(1 TO 4) AS VARIANT

   ' // Create a SafeArray with four elements
   vCriteriaArray(1) = EMPTY
   vCriteriaArray(2) = EMPTY
   vCriteriaArray(3) = strTableName
   vCriteriaArray(4) = "Table"
   vCriteria = vCriteriaArray()

   ' // Open the schema
   pRecordset = pConnection.OpenSchema(%adSchemaTables, vCriteria)
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   vRes = pRecordset.Collect("TABLE_NAME")
   IF UCASE$(VARIANT$$(vRes)) = UCASE$(strTableName) THEN FUNCTION = %TRUE

   ' // Close and releases the recordset
   pRecordset.Close
   pRecordset = NOTHING

END FUNCTION

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Check if Publishers table exists
      IF ISTRUE AdoTableExists(pConnection, "Publishers") THEN
         STDOUT "Table exists"
      ELSE
         STDOUT "Table doesn't exist"
      END IF
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Releases the Connection object
   pConnection = NOTHING

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SchemaViews.bas
' Contents: ADO example
' Demonstrates the use of OpenSchema with the %adSchemaViews query.
' Returns a Columns Rowset. See the OLE DB Programmer's Reference for further information.
' 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"
#INCLUDE ONCE "OleAuto.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL d  AS ASCIIZ * 64
   LOCAL st AS SYSTEMTIME
   LOCAL vbDate AS DOUBLE

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   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 schema
      pRecordset = pConnection.OpenSchema(%adSchemaViews)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_CATALOG")
         STDOUT "Table catalog: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_SCHEMA")
         STDOUT "Table schema: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("TABLE_NAME")
         STDOUT "Table name: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("VIEW_DEFINITION")
         STDOUT "View definition: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("CHECK_OPTION")
         STDOUT "Check option: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("IS_UPDATABLE")
         STDOUT "Is updatable: " & STR$(CINT(VARIANT#(vRes)))
         vRes = pRecordset.Collect("DESCRIPTION")
         STDOUT "Description: " & VARIANT$$(vRes)
         vRes = pRecordset.Collect("DATE_CREATED")
         vbDate = VARIANT#(vRes)
         VariantTimeToSystemTime vbdate, st
         GetDateFormat 0, 1, st, BYVAL %NULL, d, 64
         STDOUT "Datecreated: " & d
         vRes = pRecordset.Collect("DATE_MODIFIED")
         vbDate = VARIANT#(vRes)
         VariantTimeToSystemTime vbdate, st
         GetDateFormat 0, 1, st, BYVAL %NULL, d, 64
         STDOUT "Date modified: " & d
         WAITKEY$
         CLS
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


[José Roca]

The following example demonstrates the use of the Seek method.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Seek.bas
' Contents: ADO example
' Demonstrates the use of the Index property and the Seek method.
' 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

   ' // 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

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseServer
      ' // Open the recordset
      SqlStr = "Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdTableDirect
      ' // Set the index
      pRecordset.Index = "PrimaryKey"
      ' // See the record 70
      pRecordset.Seek 70, 1

      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the content of the "Author" column
         vRes = pRecordset.Collect("PubID")
         PRINT VARIANT$$(vRes)" ";
         vRes = pRecordset.Collect("Name")
         PRINT VARIANT$$(vRes)" ";
         vRes = pRecordset.Collect("Company Name")
         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

   WAITKEY$

END FUNCTION
' ========================================================================================