ADO/ADOX Examples

[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_SelectIdentity.bas
' Contents: ADO example
' The Jet OLE DB version 4.0 provider supports the SELECT @@Identity query that allows you
' to retrieve the value of the auto-increment field generated on your connection.
' Note: Uses the table created with the ADOX_CreateTable2.BAS example.
' 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 pCommand AS ADOCommand
   LOCAL pParameters AS ADOParameters
   LOCAL pParameter AS ADOParameter
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL vOpt AS VARIANT

   vOpt = ERROR %DISP_E_PARAMNOTFOUND

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

   ' // Create a Command object
   pCommand = NEWCOM "ADODB.Command"
   IF ISNOTHING(pCommand) 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 command properties
      pCommand.putref_ActiveConnection = pConnection
      pCommand.CommandType = %adCmdText
      pCommand.CommandText = "INSERT INTO Contacts2 (FirstName, LastName, Phone) VALUES (?, ?, ?)"
      ' // Create command parameters
      LOCAL bstrFirstName AS WSTRING
      LOCAL bstrLastName AS WSTRING
      LOCAL bstrPhone AS WSTRING
      LOCAL bstrNotes AS WSTRING
      bstrFirstName = "Joe"
      bstrLastName = "Doe"
      bStrPhone = "(xxx)-xxxx-xxxx"
      bstrNotes = "Actor"
      pParameters = pCommand.Parameters
      pParameter = pCommand.CreateParameter("FirstName", %adVarWChar, %adParamInput, 255, bstrFirstName)
      pParameters.Append pParameter
      pParameter = NOTHING
      pParameter = pCommand.CreateParameter("LastName", %adVarWChar, %adParamInput, 255, bstrLastName)
      pParameters.Append pParameter
      pParameter = NOTHING
      pParameter = pCommand.CreateParameter("Phone", %adVarWChar, %adParamInput, 255, bstrPhone)
      pParameters.Append pParameter
      pParameter = NOTHING
      pParameter = NOTHING
      pParameters = NOTHING
      ' // Run the command (perform the Insert)
      pCommand.Execute vOpt, vOpt, %adExecuteNoRecords
      ' // Get the new AutoNumber value
      pRecordset = pConnection.Execute("SELECT @@Identity", vOpt, %adCmdText)
      vRes = pRecordset.Collect(0)
      STDOUT STR$(VARIANT#(vRes))
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF ISOBJECT(pRecordset) THEN
         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 illustrates the use of the Sort property.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Sort.bas
' Contents: ADO example
' This example uses the Sort property to reorder the rows of a Recordset.
' The CursorLocation must be set to %adUseClient.
' 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 = %adUseClient
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Set the Sort property
      pRecordset.Sort = "City ASC, Name ASC"
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the contents of the "City" and "Name" columns
         vRes = pRecordset.Collect("City")
         PRINT VARIANT$$(vRes) " ";
         vRes = pRecordset.Collect("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
' ========================================================================================


[José Roca]

This example uses the Supports method to display the options supported by a recordset opened with different cursor types.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Supports.bas
' Contents: ADO example
' This example uses the Supports method to display the options supported by a recordset
' opened with different cursor types.
' 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"

' ========================================================================================
' Display the options
' ========================================================================================
SUB ShowOptions (BYVAL pRecordset AS ADORecordset)

   STDOUT "Cursor type: " & STR$(pRecordset.CursorType)

   IF ISTRUE pRecordset.Supports(%adAddNew) THEN STDOUT "AddNew"
   IF ISTRUE pRecordset.Supports(%adApproxPosition) THEN STDOUT "AbsolutePosition and AbsolutePage"
   IF ISTRUE pRecordset.Supports(%adBookmark) THEN STDOUT "Bookmark"
   IF ISTRUE pRecordset.Supports(%adDelete) THEN STDOUT "Delete"
   IF ISTRUE pRecordset.Supports(%adFind) THEN STDOUT "Find"
   IF ISTRUE pRecordset.Supports(%adHoldRecords) THEN STDOUT "Holding Records"
   IF ISTRUE pRecordset.Supports(%adMovePrevious) THEN STDOUT "MovePrevious and Move"
   IF ISTRUE pRecordset.Supports(%adNotify) THEN STDOUT "Notifications"
   IF ISTRUE pRecordset.Supports(%adResync) THEN STDOUT "Resyncing data"
   IF ISTRUE pRecordset.Supports(%adUpdate) THEN STDOUT "Update"
   IF ISTRUE pRecordset.Supports(%adUpdateBatch) THEN STDOUT "Batch Updating"
   STDOUT "------------------------------------------------------"

   WAITKEY$

END SUB
' ========================================================================================

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

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

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

   ' // Create an ADO 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 a keyset recordset
      SqlStr = "SELECT * FROM Authors"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, -1, -1
      ' // Display the options
      ShowOptions pRecordset
      ' // Close the recordset
      pRecordset.Close
      ' // Open a forward only recordset
      pRecordset.Open SqlStr, pConnection, %adOpenForwardOnly, -1, -1
      ' // Display the options
      ShowOptions pRecordset
      ' // Close the recordset
      pRecordset.Close
      ' // Open an static recordset
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, -1, -1
      ' // Display the options
      ShowOptions pRecordset
      ' // Close the recordset
      pRecordset.Close
   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]

The following examples demonstrate the use of OpenSchema with the adSchemaTables query to check for the existence of a table.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_TableExists.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_TableExists2.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]

The following example illustrates the use of the BeginTrans, CommitTrans and RollbackTrans methods.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Transactions.bas
' Contents: ADO example
' Demonstrates the use of BeginTrans, CommitTrans and RollbackTrans.
' 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
      ' // Open the recordset
      SqlStr = "SELECT * FROM Authors"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Begin a transaction
      pConnection.BeginTrans
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("Year Born")
         PRINT VARIANT#(vRes)
         IF VARIANT#(vRes) = 1947 THEN
            pRecordset.Collect("Year Born") = 1900
         END IF
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
      ' // Commit the transaction
'      pConnection.CommitTrans
      ' // Rollback the transaction because this is a demo
      pConnection.RollbackTrans
   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]

This example demonstrates the Type property. It is a model of a utility for listing the names and types of a collection, like Properties, Fields, etc. We do not need to open the recordset to access the Properties collection, they come into existence when the Recordset object is instantiated. However, setting the  CursorLocation property to adUseClient adds several dynamic properties to the Recordset object's Properties collection, making the example a little more interesting.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Type.bas
' Contents: ADO example
' 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.
' ########################################################################################

' ########################################################################################
' This example demonstrates the Type property. It is a model of a utility for listing the
' names and types of a collection, like Properties, Fields, etc.
' We do not need to open the recordset to access the Properties collection, they come into
' existence when the Recordset object is instantiated. However, setting the CursorLocation
' property to %adUseClient adds several dynamic properties to the Recordset object's
' Properties collection, making the example a little more interesting.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

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

   LOCAL pRecordset AS ADORecordset
   LOCAL pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL vConnection AS VARIANT
   LOCAL pConnection AS ADOConnection
   LOCAL nCount AS LONG
   LOCAL nType AS LONG
   LOCAL i AS LONG
   LOCAL strName AS WSTRING
   LOCAL strType AS WSTRING
   LOCAL HRESULT AS LONG

   ' // Create a client-side recordset
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' // Get a reference to the Properties collection
      pProperties = pRecordset.Properties
      ' // Retrieve the number of objects in the collection
      nCount = pProperties.Count
      ' // ADO collections are zero based
      FOR i = 0 TO nCount - 1
         ' // Get a reference to the Property object
         pProperty = pProperties.Item(i)
         nType = pProperty.Type
         SELECT CASE AS LONG nType
           CASE %adBigInt           : strType = "adBigInt"
           CASE %adBinary           : strType = "adBinary"
           CASE %adBoolean          : strType = "adBoolean"
           CASE %adBSTR             : strType = "adBSTR"
           CASE %adChapter          : strType = "adChapter"
           CASE %adChar             : strType = "adChar"
           CASE %adCurrency         : strType = "adCurrency"
           CASE %adDate             : strType = "adDate"
           CASE %adDBDate           : strType = "adDBDate"
           CASE %adDBTime           : strType = "adDBTime"
           CASE %adDBTimeStamp      : strType = "adDBTimeStamp"
           CASE %adDecimal          : strType = "adDecimal"
           CASE %adDouble           : strType = "adDouble"
           CASE %adEmpty            : strType = "adEmpty"
           CASE %adError            : strType = "adError"
           CASE %adFileTime         : strType = "adFileTime"
           CASE %adGUID             : strType = "adGUID"
           CASE %adIDispatch        : strType = "adIDispatch"
           CASE %adInteger          : strType = "adInteger"
           CASE %adIUnknown         : strType = "adIUnknown"
           CASE %adLongVarBinary    : strType = "adLongVarBinary"
           CASE %adLongVarChar      : strType = "adLongVarChar"
           CASE %adLongVarWChar     : strType = "adLongVarWChar"
           CASE %adNumeric          : strType = "adNumeric"
           CASE %adPropVariant      : strType = "adPropVariant"
           CASE %adSingle           : strType = "adSingle"
           CASE %adSmallInt         : strType = "adSmallInt"
           CASE %adTinyInt          : strType = "adTinyInt"
           CASE %adUnsignedBigInt   : strType = "adUnsignedBigInt"
           CASE %adUnsignedInt      : strType = "adUnsignedInt"
           CASE %adUnsignedSmallInt : strType = "adUnsignedSmallInt"
           CASE %adUnsignedTinyInt  : strType = "adUnsignedTinyInt"
           CASE %adUserDefined      : strType = "adUserDefined"
           CASE %adVarBinary        : strType = "adVarBinary"
           CASE %adVarChar          : strType = "adVarChar"
           CASE %adVariant          : strType = "adVariant"
           CASE %adVarNumeric       : strType = "adVarNumeric"
           CASE %adVarWChar         : strType = "adVarWChar"
           CASE %adWChar            : strType = "adWChar"
           CASE ELSE                : strType = "*UNKNOWN*"
         END SELECT
         ' // Get the name of the property
         strName = pProperty.Name
         ' // Display the results
         STDOUT "Property" & STR$(i) & ": " & strName & ", Type = " & strType
         ' // Release the property object
         pProperty = NOTHING
      NEXT
   CATCH
      ' // Display error information
      HRESULT = OBJRESULT
      vConnection = pRecordset.ActiveConnection
      pConnection = vConnection
      vConnection = EMPTY
      STDOUT AdoGetErrorInfo(pConnection, HRESULT)
      pConnection = NOTHING
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
   END TRY

   ' // Release the Recordset object
   pRecordset = NOTHING

   WAITKEY$

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


[José Roca]

The following example demonstrates the use of the Update method.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_UpdatRecord.bas
' Contents: ADO example
' Demonstrates the use of the Update method.
' Note: Changed Update to Updat in the program name because the UAC triggers if certain
' words are used.
' 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 v1 AS VARIANT
   LOCAL v2 AS VARIANT
   DIM   vFieldList(2) AS VARIANT
   DIM   vValues(2) 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
      ' // Retrieve the record to update
      SqlStr = "SELECT * FROM Publishers WHERE PubID=10000"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      vRes = pRecordset.Collect("PubID")
      IF VARIANT#(vRes) = 10000 THEN
         ' // Fills the array of fields
         vFieldList(0) = "Company Name"
         vFieldList(1) = "Address"
         vFieldList(2) = "City"
         ' // Fill the array of values
         vValues(0) = "MGM Studios"
         vValues(1) = "10250 Constellation Boulevard"
         vValues(2) = "Los Angeles, CA. 90067"
         ' // Store the arrays in variants
         v1 = vFieldList()
         v2 = vValues()
         pRecordset.Update v1, v2
         STDOUT "Record updated"
      ELSE
         STDOUT "Record not found"
      END IF
   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]

This example uses the Version property of a Connection object to display the current ADO version. It also uses several dynamic properties to show other useful information.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Version.bas
' Contents: ADO example
' This example uses the Version property of a Connection object to display the current ADO
' version. It also uses several dynamic properties to show other useful 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 pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL ConStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' Create an ADO 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
      ' Show the version
      STDOUT "ADO Version: " & ACODE$(pConnection.Version)
      ' Get a reference to the Properties collection
      pProperties = pConnection.Properties
      ' Retrieve and display several properties
      pProperty = pProperties.Item("DBMS Name")
      vRes = pProperty.Value
      STDOUT "DBMS Name: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("DBMS Version")
      vRes = pProperty.Value
      STDOUT "DBMS Version: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("Provider Friendly Name")
      vRes = pProperty.Value
      STDOUT "Provider Friendly Name: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("Provider Name")
      vRes = pProperty.Value
      STDOUT "Provider Name: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("Provider Version")
      vRes = pProperty.Value
      STDOUT "Provider Version: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("User ID")
      vRes = pProperty.Value
      STDOUT "User ID: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("User Name")
      vRes = pProperty.Value
      STDOUT "User Name: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("Active Sessions")
      vRes = pProperty.Value
      STDOUT "Active Sessions: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("Data Source")
      vRes = pProperty.Value
      STDOUT "Data Source: " & VARIANT$$(vRes)
      pProperty = pProperties.Item("Data Source Name")
      vRes = pProperty.Value
      STDOUT "Data Source Name: " & VARIANT$$(vRes)
   CATCH
      ' Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' Release the Property object
      pProperty = NOTHING
      ' Release the Properties collection
      pProperties = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' Release the Connection object
   pConnection = NOTHING

   WAITKEY$

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


[José Roca]

Demonstrates the use of PutRefActiveConnection, GetTables, GetCount, GetItem and GetName.

Creates a new Adox.Catalog object, sets his active connection to an already open connection, gets a pointer to the Tables collection, gets how many objects are contained in the collection, and enumerated the names of the Tables getting a pointer to each object of the collection and using the Name property to get his names.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_ActiveConnection.bas
' Contents: ADOX example
' Setting the ActiveConnection property to a valid, open connection "opens" the catalog.
' From an open catalog, you can access the schema objects contained within that catalog.
' 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 "AfxVarToStr.inc"

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

   LOCAL pConnection AS ADOConnection
   LOCAL pCatalog AS ADOXCatalog
   LOCAL pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL ConStr AS WSTRING
   LOCAL nCount AS LONG
   LOCAL i AS LONG

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

   ' // Create a Catalog object
   pCatalog = NEWCOM "ADOX.Catalog"
   IF ISNOTHING(pCatalog) 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 ActiveConnection property of the Catalog
      pCatalog.putref_ActiveConnection = pConnection
      ' // Get a reference to the Tables collection
      pTables = pCatalog.Tables
      ' // Get the number of objects of the collection
      nCount = pTables.Count
      ' // Enumerate the tables
      FOR i = 0 TO nCount - 1
         pTable = pTables.Item(i)
         PRINT "Table name: " & pTable.Name
         PRINT "Type: " & pTable.Type
         PRINT "Date created: " & AfxVarToStr(pTable.DateCreated)
         PRINT "Date modified: " & AfxVarToStr(pTable.DateModified)
         PRINT "----------------------------------------------------"
         pTable = NOTHING
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the Tables collection
      pTables = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Release the objects
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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


[José Roca]

Appends a view to the Views collection.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_AddView.bas
' Contents: ADOX example
' Appends a view to the Views collection
' 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 pCatalog AS ADOXCatalog
   LOCAL pCommand AS ADOCommand
   LOCAL pViews AS ADOXViews
   LOCAL ConStr AS WSTRING

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

   ' // Create a Catalog object
   pCatalog = NEWCOM "ADOX.Catalog"
   IF ISNOTHING(pCatalog) THEN EXIT FUNCTION

   ' // Create a Command object
   pCommand = NEWCOM "ADODB.Command"
   IF ISNOTHING(pCommand) 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 ActiveConnection property of the Catalog
      pCatalog.putref_ActiveConnection = pConnection
      ' // Create the command representing the View
      pCommand.CommandText = "SELECT * FROM Authors"
      ' // Get a reference to the Views collection
      pViews = pCatalog.Views
      ' // Append the View to the collection
      pViews.Append "AllAuthors", pCommand
      ' // Release the collection
      pViews = NOTHING
      STDOUT "View created"
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collection
      pViews = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Release the objects
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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


[José Roca]

The following example demonstrates how to use a Command object and the Procedures collection Append method to create a new procedure in the underlying data source.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_AppendProcedure.bas
' Contents: ADOX example
' The following example demonstrates how to use a Command object and the Procedures
' collection Append method to create a new procedure in the underlying data source.
' 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 pCommand AS ADOCommand
   LOCAL pCatalog AS ADOXCatalog
   LOCAL pProcedures AS ADOXProcedures
   LOCAL ConStr AS WSTRING
   LOCAL bstrCommandText AS WSTRING

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

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

   ' // Create a Catalog object
   pCatalog = NEWCOM "ADOX.Catalog"
   IF ISNOTHING(pCatalog) 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 the parameterized command (Microsoft Jet specific)
      pCommand.putref_ActiveConnection = pConnection
      bstrCommandText = "PARAMETERS [AuthorId] Text; " & _
                       "SELECT * FROM Authors WHERE Aud_ID = [AuthorId]"
      pCommand.CommandText = bstrCommandText
      ' // Set the ActiveConnection property of the Catalog
      pCatalog.putref_ActiveConnection = pConnection
      ' // Get a reference to the Procedures collection
      pProcedures = pCatalog.Procedures
      ' // Append the procedure
      pProcedures.Append "AuthorById", pCommand
      STDOUT "Procedure added"
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collection
      pProcedures = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Release the objects
   pCommand = NOTHING
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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


[José Roca]

The following example enumerates the Columns collection.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Columns.bas
' Contents: ADOX example
' Demonstrates how to retrieve the names of the columns of a table.
' Uses the BIBLIO.MDB database that comes with Visual Studio.
' Note  For some reason, ADOX retuns the columns collection ordered by Column name.
' 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
#DEBUG ERROR ON
#INCLUDE ONCE "ADO.INC"

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

   LOCAL pConnection AS ADOConnection
   LOCAL pCatalog AS ADOXCatalog
   LOCAL pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL pColumns AS ADOXColumns
   LOCAL pColumn AS ADOXColumn
   LOCAL ConStr AS WSTRING
   LOCAL nCount AS LONG
   LOCAL i AS LONG

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

   ' // Create a Catalog object
   pCatalog = NEWCOM "ADOX.Catalog"
   IF ISNOTHING(pCatalog) 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 ActiveConnection property of the Catalog
      pCatalog.putref_ActiveConnection = pConnection
      ' // Get a reference to the Tables collection
      pTables = pCatalog.Tables
      ' // Get a reference to the Publishers table
      pTable = pTables.Item("Publishers")
      ' // Get a reference to the Columns collection of the table
      pColumns = pTable.Columns
      ' // Get the number of objects in the collection
      nCount = pColumns.Count
      IF nCount = 0 THEN EXIT TRY
      ' // Parse the collection
      FOR i = 0 TO nCount - 1
         pColumn = pColumns.Item(i)
         STDOUT pColumn.Name
         pColumn = NOTHING
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the Columns collection
      pColumns = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Release the objects
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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


[José Roca]

The following example demonstrates how to create a new table and append it to the Database collection.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_CreateTable.bas
' Contents: ADOX example
' Demonstrates how to create a new table and append it to the Database collection.
' 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 pCatalog AS ADOXCatalog
   LOCAL pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL pColumns AS ADOXColumns
   LOCAL pConnection AS ADOConnection
   LOCAL vConnection AS VARIANT
   LOCAL ConStr AS WSTRING
   LOCAL HRESULT AS LONG

   ' // Create a Catalog object
   pCatalog = NEWCOM "ADOX.Catalog"
   IF ISNOTHING(pCatalog) THEN EXIT FUNCTION

   ' // Create a Table object
   pTable = NEWCOM "ADOX.Table"
   IF ISNOTHING(pTable) THEN EXIT FUNCTION

   TRY
      ' // Set the ActiveConnection property of the Catalog
      pCatalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Get a pointer to the Tables collection
      pTables = pCatalog.Tables
      ' // Create a new table called "Contacts"
      pTable.Name = "Contacts"
      ' // Create fields and appends them to the Columns collection of the new Table object
      ' // Note that in ADOX the ADO Fields are called Columns
      pColumns = pTable.Columns
      pColumns.Append "FirstName", %adVarWChar
      pColumns.Append "LastName", %adVarWChar
      pColumns.Append "Phone", %adVarWChar
      pColumns.Append "Notes", %adLongVarWChar
      ' // Add the new Table to the Tables collection of the database
      pTables.Append pTable
      STDOUT "Table created"
   CATCH
      HRESULT = OBJRESULT
      ' // Display error information
      vConnection = pCatalog.ActiveConnection
      pConnection = vConnection
      STDOUT AdoGetErrorInfo(pConnection, HRESULT)
      vConnection = EMPTY
      pConnection = NOTHING
   FINALLY
      ' // Release objects and collections
      pColumns = NOTHING
      pTable = NOTHING
      pTables = NOTHING
   END TRY

   ' // Release the Catalog object
   pCatalog = NOTHING

   WAITKEY$

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_CreateTable2.bas
' Contents: ADOX example
' Demonstrates how to create a new table containing an autoincrement field.
' 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 "CVariant.inc"

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

   LOCAL pCatalog AS ADOXCatalog
   LOCAL pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL pColumns AS ADOXColumns
   LOCAL pColumn AS ADOXColumn
   LOCAL pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL pConnection AS ADOConnection
   LOCAL vConnection AS VARIANT
   LOCAL ConStr AS WSTRING
   LOCAL HRESULT AS LONG
   LOCAL vBool AS VARIANT
   LOCAL pVariant AS IVariant

   ' // Crete an instance of the CVarUtils class
   pVariant = CLASS "CVariant"
   IF ISNOTHING(pVariant) THEN EXIT FUNCTION

   ' // Create a Catalog object
   pCatalog = NEWCOM "ADOX.Catalog"
   IF ISNOTHING(pCatalog) THEN EXIT FUNCTION

   ' // Create a Table object
   pTable = NEWCOM "ADOX.Table"
   IF ISNOTHING(pTable) THEN EXIT FUNCTION

   TRY
      ' // Set the ActiveConnection property of the Catalog
      pCatalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Get a pointer to the Tables collection
      pTables = pCatalog.Tables
      ' // Create a new table called "Contacts2"
      pTable.Name = "Contacts2"
      ' // Set the parent catalog
      pTable.ParentCatalog = pCatalog
      ' // Create fields and appends them to the Columns collection of the new Table object
      ' // Note that in ADOX the ADO Fields are called Columns
      pColumns = pTable.Columns
      pColumns.Append "ContactId", %adInteger
      ' // Make an autoincrement field seting is Autoincrement property to True
      pColumn = pColumns.Item("ContactID")
      pProperties = pColumn.Properties
      pProperty = pProperties.Item("Autoincrement")
      ' // We need to pass a %VT_BOOL variant
      vBool = pVariant.FromBoolean(-1)
      pProperty.Value = vBool
      ' // Append the other fields
      pColumns.Append "FirstName", %adVarWChar
      pColumns.Append "LastName", %adVarWChar
      pColumns.Append "Phone", %adVarWChar
      ' // Add the new Table to the Tables collection of the database
      pTables.Append pTable
      STDOUT "Table created"
   CATCH
      HRESULT = OBJRESULT
      ' // Display error information
      vConnection = pCatalog.ActiveConnection
      pConnection = vConnection
      STDOUT AdoGetErrorInfo(pConnection, HRESULT)
      vConnection = EMPTY
      pConnection = NOTHING
   FINALLY
      ' // Release objects and collections
      pProperty = NOTHING
      pProperties = NOTHING
      pColumn = NOTHING
      pColumns = NOTHING
      pTables = NOTHING
   END TRY

   ' // Release the main objects
   pTable = NOTHING
   pCatalog = NOTHING

   WAITKEY$

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