Powerbasic Museum 2020-B

Webmaster: José Roca (PBWIN 10+/PBCC 6+) (SDK Forum) => COM Programming => Topic started by: José Roca on August 20, 2011, 10:47:41 PM

Title: ADO/ADOX Examples
Post by: José Roca on August 20, 2011, 10:47:41 PM
 
ADO

Microsoft ActiveX Data Objects (ADO) enable your client applications to access and manipulate data from a variety of sources through an OLE DB provider. Its primary benefits are ease of use, high speed, low memory overhead, and a small disk footprint. ADO supports key features for building client/server and Web-based applications.

ADOX

Microsoft ActiveX Data Objects Extensions for Data Definition Language and Security (ADOX) is an extension to the ADO objects and programming model. ADOX includes objects for schema creation and modification, as well as security. Because it is an object-based approach to schema manipulation, you can write code that will work against various data sources regardless of differences in their native syntaxes.

ADOX is a companion library to the core ADO objects. It exposes additional objects for creating, modifying, and deleting schema objects, such as tables and procedures. It also includes security objects to maintain users and groups and to grant and revoke permissions on objects.
Title: ADO Example: AbsolutePage Property
Post by: José Roca on August 20, 2011, 10:55:28 PM


The following example illustrates the use of the AbsolutePage property.
The cursor location must be set to adUseClient.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_AbsolutePage.bas
' Contents: ADO example
' Demonstrates the use of the AbsolutePage, PageCount and PageSize properties.
' The cursor location 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 the 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 nPageCount AS LONG
   LOCAL nPageSize AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   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
      ' // Use client cursor to enable AbsolutePosition property
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Display five records at a time
      pRecordset.PageSize = 5
      ' // Retrieve the number of pages
      nPageCount = pRecordset.PageCount
      ' // Parse the recordset
      FOR i = 1 TO nPageCount
         ' // Set the cursor at the beginning of the page
         pRecordset.AbsolutePage = i
         ' // Retrieve the number of records of the page
         nPageSize = pRecordset.PageSize
         FOR x = 1 TO nPageSize
            ' // Get the content of the "Name" column
            vRes = pRecordset.Collect("Name")
            ? VARIANT$$(vRes)
            ' // Fetch the next row
            pRecordset.MoveNext
            IF pRecordset.EOF THEN EXIT FOR
         NEXT
         WAITKEY$
      NEXT
   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
' ========================================================================================

Title: ADO Example: AbsolutePosition Property
Post by: José Roca on August 20, 2011, 10:57:01 PM


The following example illustrates the use of the AbsolutePosition property.
The cursor location must be set to adUseClient.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_AbsolutePosition.bas
' Contents: ADO example
' This example demonstrates how the AbsolutePosition property can track the progress of a
' loop that enumerates all the records of a Recordset. It uses the CursorLocation property
' to enable the AbsolutePosition property by setting the cursor to a client cursor.
' 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 the 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 = "Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdTable
      DO
        ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the absolute position
         PRINT "Position:" & STR$(pRecordset.AbsolutePosition) " ";
         ' // Get the Publisher's name
         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
' ========================================================================================

Title: ADO Example: ActiveCommand Property
Post by: José Roca on August 20, 2011, 10:58:15 PM


This example illustrates the ActiveCommand property.

A subroutine is given a Recordset object whose ActiveCommand property is used to display the command text and parameter that created the recordset.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_ActiveCommand.bas
' Contents: ADO example
' This example demonstrates the use of the ActiveCommand property.
' A subroutine is given a Recordset object whose ActiveCommand property is used to display
' the command text and parameter that created the Recordset.
' 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"

' ========================================================================================
' The ShowActiveCommand routine is given only a Recordset object, yet it must print the
' command text and parameter that created the Recordset. This can be done because the
' Recordset object's ActiveCommand property yields the associated Command object.
' The Command object's CommandText property yields the parameterized command that was
' substituted for the command's parameter placeholder ("?").
' ========================================================================================
SUB ShowActiveCommand (BYVAL pConnection AS ADOConnection, BYVAL pRecordset AS ADORecordset)

   LOCAL bstrPrmName AS WSTRING
   LOCAL pCommand AS ADOCommand
   LOCAL bstrCommandText AS WSTRING
   LOCAL pParameters AS ADOParameters
   LOCAL pParameter AS ADOParameter
   LOCAL vValue AS VARIANT
   LOCAL bstrAuID AS WSTRING
   LOCAL bstrAuName AS WSTRING

   TRY
      pCommand = pRecordset.ActiveCommand
      bstrCommandText = pCommand.CommandText
      pParameters = pCommand.Parameters
      pParameter = pParameters.Item("Name")
      vValue = pParameter.Value
      bstrPrmName = VARIANT$$(vValue)
      PRINT "Command text: " & bstrCommandText
      PRINT "Parameter: " & bstrPrmName
      IF pRecordset.BOF THEN
         PRINT "Name = '" & bstrPrmName & "', not found"
      ELSE
         vValue = pRecordset.Collect("Author")
         bstrAuName = VARIANT$$(vValue)
         vValue = pRecordset.Collect("Au_ID")
         bstrAuID = STR$(VARIANT#(vValue))
         PRINT "Name = " & bstrAuName & ", ID = " & bstrAuID
      END IF
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   END TRY

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

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

   LOCAL pConnection AS ADOConnection
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL pCommand AS ADOCommand
   LOCAL pRecordset AS ADORecordset
   LOCAL pParameters AS ADOParameters
   LOCAL pParameter AS ADOParameter

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

   ' // Create an ADO command object
   pCommand = NEWCOM "ADODB.Command"
   IF ISFALSE ISOBJECT(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 ADOCommand active connection
      pCommand.putref_ActiveConnection = pConnection
      ' // Set the command text
      pCommand.CommandText = "SELECT * FROM Authors WHERE Author = ?"
      ' // Create the parameter
      pParameter = pCommand.CreateParameter("Name", %adChar, %adParamInput, 255, "Bard, Dick")
      ' // Add the parameter to the collection
      pParameters = pCommand.Parameters
      pParameters.Append pParameter
      ' // Create the recordset by executing the command string
      pRecordset = pCommand.Execute
      ' // Display the results
      ShowActiveCommand pConnection, pRecordset
   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
' ========================================================================================

Title: ADO Example: ActualSize Property
Post by: José Roca on August 20, 2011, 10:59:08 PM


The following example illustrates the use of the ActualSize property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_ActualSize.bas
' Contents: ADO example
' This example uses the ActualSize and DefinedSize properties to display the defined size
' and actual size of a 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"

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

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   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 Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Get a reference to the Fields collection
      pFields = pRecordset.Fields
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the Publisher's name
         pField = pFields.Item("Name")
         vRes = pField.Value
         PRINT "Name: " & VARIANT$$(vRes) " - ";
         PRINT "Actual size:" & STR$(pField.ActualSize) " - ";
         PRINT "Defined size:" & STR$(pField.DefinedSize)
         pField = NOTHING
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
      ' // Release the collection
      pFields = NOTHING
   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
' ========================================================================================

Title: ADO Example: AddNew Method
Post by: José Roca on August 20, 2011, 10:59:55 PM


The following example demonstrates the use of the AddNew method.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_AddNewRecod.bas
' Contents: ADO example
' This example uses the AddNew method to create a new record.
' 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 bConStr AS WSTRING
   LOCAL bSqlStr AS WSTRING
   LOCAL v1 AS VARIANT
   LOCAL v2 AS VARIANT
   DIM   vFieldList(4) AS VARIANT
   DIM   vValues(4) 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
      bConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open bConStr
      ' // Open the recordset
      bSqlStr = "Publishers"
      pRecordset.Open bSqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdTableDirect
      ' // Fill the array of fields
      vFieldList(0) = "PubID"
      vFieldList(1) = "Name"
      vFieldList(2) = "Company Name"
      vFieldList(3) = "Address"
      vFieldList(4) = "City"
      ' // Fill the array of values
      vValues(0) = 10000 AS LONG
      vValues(1) = "Wile E. Coyote"
      vValues(2) = "Warner Brothers Studios"
      vValues(3) = "4000 Warner Boulevard"
      vValues(4) = "Burbank, CA. 91522"
      ' // Store the arrays in variants
      v1 = vFieldList()
      v2 = vValues()
      ' // Add the record
      pRecordset.AddNew v1, v2
      STDOUT "Record added"
   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
' ========================================================================================

Title: ADO Example: Attributes Property
Post by: José Roca on August 20, 2011, 11:00:46 PM


The following example illustrates the use of the Attributes property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Attributes.bas
' Contents: ADO example
' Demonstrates the use of the Attributes and Name properties.
' 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 pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nCount AS LONG
   LOCAL lAttr AS LONG
   LOCAL i AS LONG

   ' // 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
      ' // Parse the Properties collection
      pProperties = pRecordset.Properties
      nCount = pProperties.Count
      FOR i = 0 TO nCount - 1
         pProperty = pProperties.Item(i)
         PRINT "Property name: " & pProperty.Name " - ";
         PRINT "Attributes: " & STR$(pProperty.Attributes)
         pProperty = NOTHING
      NEXT
      pProperties = NOTHING
      ' // Parse the Fields collection
      pFields = pRecordset.Fields
      nCount = pFields.Count
      IF nCount THEN
         PRINT
         PRINT "Nullable fields:"
         PRINT "================"
         PRINT
      END IF
      FOR i = 0 TO nCount - 1
         pField = pFields.Item(i)
         ' // Get the attributes of the field
         lAttr = pField.Attributes
         ' // Display fields that are nullable
         IF (lAttr AND %adFldIsNullable) = %adFldIsNullable THEN
            PRINT "Field name: " & pField.Name
         END IF
         pField = NOTHING
      NEXT
      pFields = NOTHING
   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
' ========================================================================================

Title: ADO Example: ConnectionString Property
Post by: José Roca on August 20, 2011, 11:01:43 PM


The following example opens a connection with the biblio.mdb database, creates a recordset and parses the result. Instead of using  AdoRecordset.Open, this example sets the properties individually. It also uses the Source property to show an alternate way to set the source for the recordset.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_ConnectionString.bas
' Contents: ADO example
' Demonstrates the use of the ConnectionString, ActiveConnection and Source properties.
' Opens a connection with the biblio.mdb database, creates a recordset and parses the result.
' Instead of using  ADORecordset.Open, this example sets the properties individually.
' It also uses the Source property to show an alternate way to set the source for the recordset.
' 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 vOpt AS VARIANT

   vOpt = ERROR %DISP_E_PARAMNOTFOUND

   ' // 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"
      ' // Set the connection string
      pConnection.ConnectionString = Constr
      ' // Open the database
      pConnection.Open
      ' // Set the recordset's active connection
      pRecordset.putref_ActiveConnection = pConnection
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' *** The cursor type and lock type can't be set individually
      ' *** when using direct interface calls because the call to the
      ' *** Open method will reset them to 0.
      ' // Set the cursor type
'      pRecordset.CursorType = %adOpenKeyset
      ' // Set the lock type
'      pRecordset.LockType = %adLockOptimistic
      ' // Set the source for the recordset
      SqlStr = "SELECT * FROM Authors ORDER BY Author"
      pRecordset.Source = SqlStr
      ' // Open the recordset
      pRecordset.Open vOpt, vOpt, %adOpenKeyset, %adLockOptimistic
      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("Author")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

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

Title: ADO Example: DefinedSize Property
Post by: José Roca on August 20, 2011, 11:02:36 PM


The following example illustrates the use of the DefinedSize property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_DefinedSize.bas
' Contents: ADO example
' This example uses the ActualSize and DefinedSize properties to display the defined size
' and actual size of a 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"

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

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   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 Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Get a reference to the Fields collection
      pFields = pRecordset.Fields
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the Publisher's name
         pField = pFields.Item("Name")
         vRes = pField.Value
         PRINT "Name: " & VARIANT$$(vRes) " - ";
         PRINT "Actual size:" & STR$(pField.ActualSize) " - ";
         PRINT "Defined size:" & STR$(pField.DefinedSize)
         pField = NOTHING
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
      ' // Release the collection
      pFields = NOTHING
   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
' ========================================================================================

Title: ADO Example: Delete Method
Post by: José Roca on August 20, 2011, 11:03:37 PM


The following example demonstrates the use of the Delete method.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_DeleteRecord.bas
' Contents: ADO example
' This example uses the Delete method to remove a specified record from a Recordset.
' 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 bConStr AS WSTRING
   LOCAL bSqlStr 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
      bConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open bConStr
      ' // Retrieve the record to update
      bSqlStr = "SELECT * FROM Publishers WHERE PubID=10000"
      pRecordset.Open bSqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      vRes = pRecordset.Collect("PubID")
      IF VARIANT#(vRes) = 10000 THEN
         pRecordset.Delete %adAffectCurrent
         STDOUT "Record deleted"
      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
' ========================================================================================

Title: ADO Example: Disconnected Recordset
Post by: José Roca on August 20, 2011, 11:04:42 PM
We can create a disconnected recordset by setting its ActiveConnection property to NOTHING.

One of the primary requisites for a recordset to become a disconnected recordset is that it should use client side cursors. That is, the CursorLocation should be initialized to adUseClient.

The following example demonstrates how to do it using PowerBASIC:


' ########################################################################################
' Microsoft Windows
' File: ADOEX_DisconnectedRecordset.bas
' Contents: ADO example
' Disconnected recordset 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 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 Authors"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Disconnect the recordset by setting is active connection to Nothing
      pRecordset.putref_ActiveConnection = NOTHING
      ' // Close and release the connection
      pConnection.Close
      pConnection = NOTHING
      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("Author")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF ISOBJECT(pConnection) THEN
         IF pConnection.State = %adStateOpen THEN pConnection.Close
      END IF
   END TRY

   WAITKEY$

END FUNCTION

Title: ADO Example: ADO Events
Post by: José Roca on August 20, 2011, 11:05:28 PM
 
This example demonstrates how to subscribe and unsubscribe to the Connection and Recordset events. If you want ADO to ignore an event, set adStatus = %adStatusUnwantedEvent.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Events.bas
' Contents: ADO example
' Opens a connection, creates a recordset and parses the result.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

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

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

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL pADOConnectionEvents AS ADOConnectionEventsImpl
   LOCAL pADORecordsetEvents AS ADORecordsetEventsImpl

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

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

   ' // Connect events
   pADOConnectionEvents = CLASS "CADOConnectionEvents"
   EVENTS FROM pConnection CALL pADOConnectionEvents
   pADORecordsetEvents = CLASS "CADORecordsetEvents"
   EVENTS FROM pRecordset CALL pADORecordsetEvents

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT TOP 20 * FROM Authors ORDER BY Author"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      DO
         ' // While not at the end of the recordset...
         IF ISTRUE pRecordset.EOF() THEN EXIT DO
         ' // Get the content of the "Author" column
         vRes = pRecordset.Collect("Author")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   ' // Disconnect events
   IF ISOBJECT(pADOConnectionEvents) THEN EVENTS END pADOConnectionEvents
   IF ISOBJECT(pADORecordsetEvents) THEN EVENTS END pADORecordsetEvents

   WAITKEY$

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

' ########################################################################################
' Class CConnectionEvents
' Interface name = ConnectionEvents
' IID = {00000400-0000-0010-8000-00AA006D2EA4}
' Attributes = 4096 [&H1000] [Dispatchable]
' Code generated by the TypeLib Browser 4.0.8.0 (c) 2008 by José Roca
' Date: 07 ago 2008   Time: 06:14:03
' ########################################################################################

CLASS CADOConnectionEvents GUID$("{BD67A17B-4C2B-4E02-A185-252353E7981E}") AS EVENT

INTERFACE ADOConnectionEventsImpl GUID$("{00000400-0000-0010-8000-00AA006D2EA4}") AS EVENT

  INHERIT IDispatch

   ' =====================================================================================
   METHOD InfoMessage <0> ( _
     BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD BeginTransComplete <1> ( _
     BYVAL TransactionLevel AS LONG _                   ' __in long TransactionLevel
   , BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CommitTransComplete <3> ( _
     BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD RollbackTransComplete <2> ( _
     BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD WillExecute <4> ( _
     BYREF Source AS WSTRING _                          ' __inout BSTR *Source
   , BYREF CursorType AS LONG _                         ' __inout CursorTypeEnum *CursorType
   , BYREF LockType AS LONG _                           ' __inout LockTypeEnum *LockType
   , BYREF Options AS LONG _                            ' __inout long *Options
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pCommand AS ADOCommand _                     ' __in _Command *pCommand
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD ExecuteComplete <5> ( _
     BYVAL RecordsAffected AS LONG _                    ' __in long RecordsAffected
   , BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pCommand AS ADOCommand _                     ' __in _Command *pCommand
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD WillConnect <6> ( _
     BYREF ConnectionString AS WSTRING _                ' __inout BSTR *ConnectionString
   , BYREF UserID AS WSTRING _                          ' __inout BSTR *UserID
   , BYREF Password AS WSTRING _                        ' __inout BSTR *Password
   , BYREF Options AS LONG _                            ' __inout long *Options
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     ? ConnectionString
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD ConnectComplete <7> ( _
     BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Disconnect <8> ( _
     BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pConnection AS ADOConnection _               ' __in _Connection *pConnection
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS
' ========================================================================================

' ########################################################################################
' Class CRecordsetEvents
' Interface name = RecordsetEvents
' IID = {00000266-0000-0010-8000-00AA006D2EA4}
' Attributes = 4096 [&H1000] [Dispatchable]
' Code generated by the TypeLib Browser 4.0.8.0 (c) 2008 by José Roca
' Date: 07 ago 2008   Time: 06:19:17
' ########################################################################################

CLASS CADORecordsetEvents GUID$("{7D3FC1E4-D47D-49FC-9042-970A342FAFFE}") AS EVENT

INTERFACE ADORecordsetEventsImpl GUID$("{00000266-0000-0010-8000-00AA006D2EA4}") AS EVENT

  INHERIT IDispatch

   ' =====================================================================================
   METHOD WillChangeField <9> ( _
     BYVAL cFields AS LONG _                            ' __in long cFields
   , BYVAL Fields AS VARIANT _                          ' __in VARIANT Fields
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD FieldChangeComplete <10> ( _
     BYVAL cFields AS LONG _                            ' __in long cFields
   , BYVAL Fields AS VARIANT _                          ' __in VARIANT Fields
   , BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD WillChangeRecord <11> ( _
     BYVAL adReason AS LONG _                           ' __in EventReasonEnum adReason
   , BYVAL cRecords AS LONG _                           ' __in long cRecords
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD RecordChangeComplete <12> ( _
     BYVAL adReason AS LONG _                           ' __in EventReasonEnum adReason
   , BYVAL cRecords AS LONG _                           ' __in long cRecords
   , BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD WillChangeRecordset <13> ( _
     BYVAL adReason AS LONG _                           ' __in EventReasonEnum adReason
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD RecordsetChangeComplete <14> ( _
     BYVAL adReason AS LONG _                           ' __in EventReasonEnum adReason
   , BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD WillMove <15> ( _
     BYVAL adReason AS LONG _                           ' __in EventReasonEnum adReason
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MoveComplete <16> ( _
     BYVAL adReason AS LONG _                           ' __in EventReasonEnum adReason
   , BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD EndOfRecordset <17> ( _
     BYREF fMoreData AS INTEGER _                       ' __inou VARIANT_BOOL *fMoreData
   , BYREF adStatus AS LONG _                           ' __inou EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD FetchProgress <18> ( _
     BYVAL Progress AS LONG _                           ' __in long Progress
   , BYVAL MaxProgress AS LONG _                        ' __in long MaxProgress
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD FetchComplete <19> ( _
     BYVAL pError AS ADOError _                         ' __in Error *pError
   , BYREF adStatus AS LONG _                           ' __inout EventStatusEnum *adStatus
   , BYVAL pRecordset AS ADORecordset _                 ' __in _Recordset *pRecordset
   )                                                    ' void

     ' *** Insert your code here ***
     PRINT FUNCNAME$

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS
' ========================================================================================

Title: ADO Example: Execute Method
Post by: José Roca on August 20, 2011, 11:06:09 PM


The following example demonstrates how to create a recordset using the Execute method of the Command object.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Execute.bas
' Contents: ADO example
' Demonstrates the Execute method when run from a Command object.
' 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 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 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 active connection
      pCommand.putref_ActiveConnection = pConnection
      ' // Set the CommandText property
      SqlStr = "SELECT TOP 20 * FROM Authors ORDER BY Author"
      pCommand.CommandText = SqlStr
      ' // Create the recordset
      pRecordset = pCommand.Execute
      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("Author")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close and release the recordset
      IF ISOBJECT(pRecordset) THEN
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
         pRecordset = NOTHING
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

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

Title: ADO Example: Field Object
Post by: José Roca on August 20, 2011, 11:07:32 PM


The following example demonstrates the use of the Field object.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Field.bas
' Contents: ADO example
' Demonstrates the use of the Fields collection and the Field object
' 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 pFields AS ADOFields
   LOCAL pField AS ADOField
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL nCount AS LONG
   LOCAL i AS LONG

   ' // 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 ORDER BY Author"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Get a reference to the Fields collection
      pFields = pRecordset.Fields
      nCount = pFields.Count
      ' // Parse the collection (Ado collections are zero based)
      FOR i = 0 TO nCount - 1
         ' // Get a reference to the Field object
         pField = pFields.Item(i)
         PRINT " ===================================================================="
         PRINT "Name: " & pField.Name
         PRINT "Type: " & STR$(pField.Type)
         PRINT "Status: " & STR$(pField.Status)
         PRINT "Actual size: " & STR$(pField.ActualSize)
         PRINT "Attibutes: " & STR$(pField.Attributes)
         PRINT "Defined size: " & STR$(pField.DefinedSize)
         vRes = pField.Value
         PRINT "Value: " & IIF$(VARIANTVT(vRes) = %VT_BSTR, VARIANT$$(vRes), STR$(VARIANT#(vRes)))
         PRINT "Precision: " & STR$(pField.Precision)
         PRINT "Numeric scale: " & STR$(pField.NumericScale)
         vRes = pField.OriginalValue
         PRINT "Original value: " & IIF$(VARIANTVT(vRes) = %VT_BSTR, VARIANT$$(vRes), STR$(VARIANT#(vRes)))
'         vRes = pField.UnderlyingValue
'         PRINT "Underlying value: " & IIF$(VARIANTVT(vRes) = %VT_BSTR, VARIANT$$(vRes), STR$(VARIANT#(vRes)))
         ' // Release the Field object
         pField = NOTHING
         PRINT " ===================================================================="
         WAITKEY$
      NEXT
      ' // Release the Fields collection
      pFields = NOTHING
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
      WAITKEY$
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

Title: ADO Example: Fields Collection
Post by: José Roca on August 20, 2011, 11:08:26 PM



' ########################################################################################
' Microsoft Windows
' File: ADOEX_Fields.bas
' Contents: ADO example
' Opens a connection, creates a recordset and parses the result.
' This example uses the Fields collection and the Field object instead of the Collect
' method to retrieve the 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 pFields AS ADOFields
   LOCAL pField AS ADOField
   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 Publishers ORDER BY PubID"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Get a reference to the Fields collection
      pFields = pRecordset.Fields
      ' // Parse the recordset
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         pField = pFields.Item("PubID")
         vRes = pField.Value
         PRINT VARIANT$$(vRes)" ";
         pField = NOTHING
         pField = pFields.Item("Name")
         vRes = pField.Value
         PRINT VARIANT$$(vRes)" ";
         pField = NOTHING
         pField = pFields.Item("Company Name")
         vRes = pField.Value
         PRINT VARIANT$$(vRes)
         pField = NOTHING
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
      ' // Release the collection
      pFields = NOTHING
   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
' ========================================================================================

Title: ADO Example: Filter Property
Post by: José Roca on August 20, 2011, 11:09:15 PM


This example uses the Filter property to limit the number of visible records to a particular city.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Filter.bas
' Contents: ADO example
' This example uses the Filter property to limit the number of visible records to a
' particular city.
' 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 Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Set the Filter property
      STDOUT STR$(pRecordset.RecordCount)
      pRecordset.Filter = "City = 'New York'"
      STDOUT STR$(pRecordset.RecordCount)
      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
' ========================================================================================

Title: ADO Example: Find Method
Post by: José Roca on August 20, 2011, 11:09:59 PM


The following example demonstrates the use of the Find method.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Find.bas
' Contents: ADO example
' Demonstrates the use of the Find 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
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers ORDER By PubID"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      pRecordset.Find "PubID = #70#", 0, %adSearchForward
      vRes = pRecordset.Collect("PubID")
      PRINT VARIANT#(vRes) " ";
      vRes = pRecordset.Collect("Name")
      PRINT VARIANT$$(vRes)
   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
' ========================================================================================

Title: ADO Example: How to extract a bitmap stored in an Access database
Post by: José Roca on August 20, 2011, 11:10:50 PM
This example shows how to extract the bitmap photos in the Microsoft Access 97 Nwind.mdb database and save them to a file. In order to accomplish this task, the Access and OLE headers must be stripped from the field.

Because the definition of OLE object storage is not documented, the code below searches the object's OLE header for characters consistent with the start of the graphic. This method may not work in all circumstances.

Note  Adaptation of the code posted in the following Microsoft Knowledge Base article: http://support.microsoft.com/kb/q175261/


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetBitmap.bas
' Contents: ADO example
' How to Retrieve Bitmap from Access
' 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.
' ########################################################################################

' ########################################################################################
' How to Retrieve Bitmap from Access
' This example shows how to extract the bitmap photos in the Microsoft Access 97 Nwind.mdb
' database and save them to a file. In order to accomplish this task, an the Access and
' OLE headers must be stripped from the field.
' Because the definition of OLE object storage is not documented, the code below searches
' the object's OLE header for characters consistent with the start of the graphic. This
' method may not work in all circumstances.
' Note: Adaptation of the code posted in the following Microsoft Knowledge Base article:
' http://support.microsoft.com/kb/q175261/
' ########################################################################################

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

TYPE OBJECTHEADER
  Signature    AS INTEGER
  HeaderSize   AS INTEGER
  ObjectType   AS LONG
  NameLen      AS INTEGER
  ClassLen     AS INTEGER
  NameOffset   AS INTEGER
  ClassOffset  AS INTEGER
  ObjectWidth  AS INTEGER
  ObjectHeight AS INTEGER
  OleInfo      AS ASCIIZ * 256
END TYPE

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

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nSize AS LONG
   LOCAL vRes AS VARIANT
   LOCAL ObjectOffset AS LONG
   LOCAL BitmapHeaderOffset AS INTEGER
   LOCAL BitmapOffset AS LONG
   LOCAL Buffer AS STRING
   LOCAL i AS LONG
   DIM   Arr(0) AS BYTE
   DIM   ArrBmp(0) AS BYTE
   DIM   ObjHeader AS OBJECTHEADER

   ' // 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=nwind.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT * FROM Employees ORDER BY EmployeeID"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Find the record
      pRecordset.Find "LastName = 'Davolio'", 0, 1
      ' // Get a reference to the Fields collection
      pFields = pRecordset.Fields
      ' // Get a reference to the Field object
      pField = pFields.Item("Photo")
      ' // Retrieve the actual size of the field
      nSize = pField.ActualSize
      ' // Get the content of the field
      vRes = pField.GetChunk(nSize)
      ' // Release the Field object
      pField = NOTHING
      ' // Release the Fields collection
      pFields = NOTHING
      ' // Store the content in a byte array
      Arr() = vRes
      ' // Empty the variant
      vRes = EMPTY
      ' // Copy information into a variable of the OBJECTHEADER user defined type
'      CopyMemory VARPTR(ObjHeader), VARPTR(Arr(0)), SIZEOF(OBJECTHEADER)
      MEMORY COPY VARPTR(Arr(0)), VARPTR(ObjHeader), SIZEOF(OBJECTHEADER)
      ' // Determine where the Access Header ends
      ObjectOffset = ObjHeader.HeaderSize + 1
      ' // Grab enough bytes after the OLE header to get the bitmap header
      FOR i = ObjectOffset TO ObjectOffset + 512
         IF UBOUND(Arr) => i THEN
            Buffer = Buffer & CHR$(Arr(i))
         END IF
      NEXT i
      ' // Make sure the class of the object is a Paint Brush object
      IF MID$(Buffer, 12, 6) = "PBrush" THEN
         BitmapHeaderOffset = INSTR(Buffer, "BM")
         IF BitmapHeaderOffset THEN
            ' // Calculate the beginning of the bitmap
            BitmapOffset = ObjectOffset + BitmapHeaderOffset - 1
            ' // Move the bitmap into its own array
            REDIM ArrBmp(UBOUND(Arr) - BitmapOffset)
            CopyMemory VARPTR(ArrBmp(0)), VARPTR(Arr(BitmapOffset)), UBOUND(Arr) - BitmapOffset + 1
            ' // Save the bitmap to a file. Change path as needed.
            OPEN "Photo.bmp" FOR BINARY AS #1
            PUT #1, 1, ArrBmp()
            CLOSE #1
            STDOUT "File saved"
         END IF
      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
' ========================================================================================

Title: ADO Example: GetErrorInfo wrapper function
Post by: José Roca on August 20, 2011, 11:11:49 PM

' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetErrorInfo.bas
' Contents: ADO example
' The following example tests the GetErrorInfo wrapper function to display rich error
' information. It contains an intentional error in the select clause of the query:
' SELEC instead of SELECT.
' 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
      ' // Trigger an error by writing incorrectly the name of SELECT
      SqlStr = "SELEC TOP 20 * FROM Authors ORDER BY Author"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      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("Author")
         PRINT VARIANT$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

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

Title: ADO Example: Retrieving the ordinal column numbers of a table
Post by: José Roca on August 20, 2011, 11:12:45 PM

' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetOrdinalColumnNumbers.bas
' Contents: ADO example
' Retrieves the ordinal column numbers of a table.
' 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"

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

   LOCAL hr AS LONG                         ' // HRESULT code
   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 pRC AS ADORecordsetConstruction    ' // RecordsetConstruction object
   LOCAL pRowset AS IRowset                 ' // IRowset interface
   LOCAL pCI AS IColumnsInfo                ' // IColumnsInfo interface
   LOCAL prgInfo AS DBCOLUMNINFO PTR        ' // Pointer variable to access the DBCOLUMNINFO array of structures
   LOCAL pStringsBuffer AS WSTRINGZ PTR     ' // Address of the strings
   LOCAL ulNumColumns AS DWORD              ' // Number of columns
   LOCAL i AS LONG                          ' // Loop counter
   LOCAL iOrdinal AS DWORD                  ' // Ordinal

   ' // 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
      ' // Get a reference to the ADORecordsetConstruction object
      pRC = pRecordset
      IF ISNOTHING(pRC) THEN EXIT TRY
      ' // Get a reference to the Rowset interface
      pRowset = pRc.Rowset
      ' // Release the ADORecordsetConstruction object (no longer needed)
      pRC = NOTHING
      ' // Terminate if pRowset is false
      IF ISNOTHING(pRowset) THEN EXIT TRY
      ' // Get a reference to the IColumnsInfo interface
      pCI = pRowset
      IF ISNOTHING(pCI) THEN EXIT TRY
      ' // Retrieve the information about the columns
      hr = pCI.GetColumnInfo(ulNumColumns, prgInfo, pStringsBuffer)
      IF hr = %S_OK THEN
         ' // Show the number of columns (including the one reserved for bookmarks, if any)
         ? "Columns = " & STR$(ulNumColumns)
         ' // If the recordset supports bookmarks, column 0 is reserved for them,
         ' // so change the start index from 0 to 1
         FOR i = 0 TO ulNumColumns - 1
            IF @prgInfo[i].pwszName THEN
               ' // Retrieve the ordinal number
               iOrdinal = @prgInfo[i].iOrdinal
               ' // Show the ordinal number and the name of the column
               ? "Ordinal =" & STR$(iOrdinal) & " | Name = " & @prgInfo[i].@pwszName
               ' // Free the memory allocated by the server for the name
               CoTaskMemFree @prgInfo[i].pwszName
            END IF
         NEXT
         ' // Free the memory allocated by the server for the array of DBCOLUMNINFO structures
         CoTaskMemFree prgInfo
         ' // Free the memory allocated by the server for the strings block
         CoTaskMemFree pStringsBuffer
      END IF

      ' // Release the IColumnsInfo interface
      pCI = NOTHING
      ' // Release the IRowset interface
      pRowset = NOTHING

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

Title: ADO Example: GetRows Method
Post by: José Roca on August 20, 2011, 11:13:31 PM


The following example demonstrates the use of the GetRows method.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetRows.bas
' Contents: ADO example
' Demonstrates the use of the GetRows 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"
#INCLUDE ONCE "AfxVarToStr.INC"

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

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr 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 TOP 20 * FROM Publishers ORDER BY Name"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Get all the rows of the recordset in a two-dimensional safe array
      LOCAL vRows AS VARIANT
      vRows = pRecordset.GetRows(-1)
      ' // Copy the contents in a Variant array
      DIM vRowsArray(0 TO 0) AS VARIANT
      vRowsArray() = vRows
      ' // Calculate the lower and upper bounds of the array
      LOCAL il AS LONG, iu AS LONG
      LOCAL  jl AS LONG, ju AS LONG
      il = LBOUND(vRowsArray, 1)
      iu = UBOUND(vRowsArray, 1)
      jl = LBOUND(vRowsArray, 2)
      ju = UBOUND(vRowsArray, 2)
      ' // Print the contents of the array
      LOCAL i AS LONG, j AS LONG
      FOR j = jl TO ju
         FOR i = il TO iu
            STDOUT AfxVarToStr(vRowsArray(i, j))
         NEXT
         PRINT
      NEXT
   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
' ========================================================================================

Title: ADO Example: GetString Method
Post by: José Roca on August 20, 2011, 11:14:21 PM


Assume you are debugging a data access problem and want a quick, simple way of printing the current contents of a small recordset. The GetString method returns the recordset as a string that you can print or save to a text file.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetString.bas
' Contents: ADO example
' Assume you are debugging a data access problem and want a quick, simple way of printing
' the current contents of a small recordset. The GetString method returns the recordset as
' a string that you can print or save to a text file.
' 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 bstrText 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
      ' // Get the recordset as an string
      bstrText = pRecordset.GetString(%adClipString, %adReadAll)
      STDOUT bstrText
   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
' ========================================================================================

Title: ADO Example: How to get the AutoNumber (or Identity) for a newly inserted reco
Post by: José Roca on August 20, 2011, 11:15:33 PM
How do I get the AutoNumber (or Identity) for a newly inserted record?

The AutoNumber field should always be available when a server-side cursor is used.

However, if a client-side cursor location is used, then the AutoNumber field is only returned immediately when an Access 2000 database is used with OLE DB Provider for Jet 4.0 driver (or with the Jet 4.0 ODBC driver).

http://support.microsoft.com/kb/q244136/


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Identity.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.
' ########################################################################################

' ########################################################################################
' How do I get the AutoNumber (or Identity) for a newly inserted record?
' The AutoNumber field should always be available when a server-side cursor is used.
' However, if a client-side cursor location is used, then the AutoNumber field is only
' returned immediately when an Access 2000 database is used with OLE DB Provider for
' Jet 4.0 driver (or with the Jet 4.0 ODBC driver).
' http://support.microsoft.com/kb/q244136/
' ########################################################################################

' 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 pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes 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 Command 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
      ' // Get a reference to the Properties collection
      pProperties = pRecordset.Properties
      pProperty = pProperties.Item("Update Resync")
      pProperty.Value = %adResyncAutoIncrement
      ' // Open the recordset
      SqlStr = "SELECT * FROM Contacts2"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockBatchOptimistic, %adCmdText
      ' // Add a record
      vFieldList(0) = "FirstName"
      vFieldList(1) = "LastName"
      vFieldList(2) = "Phone"
      vValues(0) = "John"
      vValues(1) = "Smith"
      vValues(2) = "(111)111-1111"
      LOCAL v1 AS VARIANT, v2 AS VARIANT
      v1 = vFieldList()
      v2 = vValues()
      pRecordset.AddNew v1, v2
      pRecordset.Update   ' // Update local Recordset (since %adLockBatchOptimistic)
      ' // Add another record
      vValues(0) = "Jack"
      vValues(1) = "Sparrow"
      vValues(2) = "(222)222-2222"
      v2 = vValues()
      pRecordset.AddNew v1, v2
      pRecordset.Update   ' // Update local Recordset (since %adLockBatchOptimistic)
      ' // Update the Access database (4.0 format)
      pRecordset.MarshalOptions = %adMarshalModifiedOnly
      pRecordset.UpdateBatch %adAffectAll
      ' // New autonumber for the 2nd AddNew
      vRes = pRecordset.Collect("ContactId")
      PRINT VARIANT#(vRes)
      ' // New autonumber for the 1st AddNew
      pRecordset.MovePrevious
      vRes = pRecordset.Collect("ContactId")
      PRINT VARIANT#(vRes)
   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

Title: ADO Example: Index Property
Post by: José Roca on August 20, 2011, 11:16:58 PM


The following example demonstrates the use of the Index property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Index.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
' ========================================================================================

Title: ADO Example: Name Property
Post by: José Roca on August 20, 2011, 11:17:40 PM


The following example illustrates the use of the Name property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Name.bas
' Contents: ADO example
' Demonstrates the use of the Attributes and Name properties.
' 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 pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nCount AS LONG
   LOCAL lAttr AS LONG
   LOCAL i AS LONG

   ' // 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
      ' // Parse the Properties collection
      pProperties = pRecordset.Properties
      nCount = pProperties.Count
      FOR i = 0 TO nCount - 1
         pProperty = pProperties.Item(i)
         PRINT "Property name: " & pProperty.Name " - ";
         PRINT "Attributes: " & STR$(pProperty.Attributes)
         pProperty = NOTHING
      NEXT
      pProperties = NOTHING
      ' // Parse the Fields collection
      pFields = pRecordset.Fields
      nCount = pFields.Count
      IF nCount THEN
         PRINT
         PRINT "Nullable fields:"
         PRINT "================"
         PRINT
      END IF
      FOR i = 0 TO nCount - 1
         pField = pFields.Item(i)
         ' // Get the attributes of the field
         lAttr = pField.Attributes
         ' // Display fields that are nullable
         IF (lAttr AND %adFldIsNullable) = %adFldIsNullable THEN
            PRINT "Field name: " & pField.Name
         END IF
         pField = NOTHING
      NEXT
      pFields = NOTHING
   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
' ========================================================================================

Title: ADO Example: Open Method
Post by: José Roca on August 20, 2011, 11:18:25 PM


The following example opens a connection with the biblio.mdb database, creates a recordset and parses the result.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Open.bas
' Contents: ADO example
' Opens a connection, creates a recordset and parses the result.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

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

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

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

   ' // 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 TOP 20 * FROM Authors ORDER BY Author"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      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("Author")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

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

Title: ADO Example: PageCount Property
Post by: José Roca on August 20, 2011, 11:19:08 PM


The following example illustrates the use of the AbsolutePage property. The cursor location must be set to adUseClient.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_PageCount.bas
' Contents: ADO example
' Demonstrates the use of the AbsolutePage, PageCount and PageSize properties.
' The cursor location 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 nPageCount AS LONG
   LOCAL nPageSize AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   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
      ' // Use client cursor to enable AbsolutePosition property
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Display five records at a time
      pRecordset.PageSize = 5
      ' // Retrieve the number of pages
      nPageCount = pRecordset.PageCount
      ' // Parses the recordset
      FOR i = 1 TO nPageCount
         ' // Set the cursor at the beginning of the page
         pRecordset.AbsolutePage = i
         ' // Retrieve the number of records of the page
         nPageSize = pRecordset.PageSize
         FOR x = 1 TO nPageSize
            ' // Get the content of the "Name" column
            vRes = pRecordset.Collect("Name")
            STDOUT VARIANT$$(vRes)
            ' // Fetch the next row
            pRecordset.MoveNext
            IF pRecordset.EOF THEN EXIT FOR
         NEXT
         WAITKEY$
      NEXT
   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
' ========================================================================================

Title: ADO Example: PageSize Property
Post by: José Roca on August 20, 2011, 11:19:54 PM


The following example illustrates the use of the PageSize property. The cursor location must be set to adUseClient.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_PageSize.bas
' Contents: ADO example
' Demonstrates the use of the AbsolutePage, PageCount and PageSize properties
' The cursor location 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 nPageCount AS LONG
   LOCAL nPageSize AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   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
      ' // Use client cursor to enable AbsolutePosition property
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Display five records at a time
      pRecordset.PageSize = 5
      ' // Retrieve the number of pages
      nPageCount = pRecordset.PageCount
      ' // Pars the recordset
      FOR i = 1 TO nPageCount
         ' // Set the cursor at the beginning of the page
         pRecordset.AbsolutePage = i
         ' // Retrieve the number of records of the page
         nPageSize = pRecordset.PageSize
         FOR x = 1 TO nPageSize
            ' // Get the content of the "Name" column
            vRes = pRecordset.Collect("Name")
            STDOUT VARIANT$$(vRes)
            ' // Fetch the next row
            pRecordset.MoveNext
            IF pRecordset.EOF THEN EXIT FOR
         NEXT
         WAITKEY$
      NEXT
   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
' ========================================================================================

Title: ADO Example: How to read an Excel sheet
Post by: José Roca on August 20, 2011, 11:20:51 PM
The following example demonstrates how to read an Excel sheet using ADO.

There are two problems: 1) The name of the sheets is localized, so instead of SqlStr = "SELECT * FROM [Hoja1$]" you will have to use the appropriate name for your version, e.g. SqlStr = "SELECT * FROM [Sheet1$]" for the English version. 2) The Excel sheet maybe has not column names.

To solve these problems, the second example uses the OpenSchema method to retrieve the names of the sheets as if they were tables and uses ordinals instead of column names.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_ReadExcelSheet.bas
' Contents: ADO example
' Demonstrates how to read an Excel sheet using ADO.
' 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

   ' // Creates 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=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ=test.xls;ReadOnly=False"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      ' // Instead of [Hoja1$] you will need to use the appropiate
      ' // name if you aren't using an Spanish version of Excel,
      ' // e.g. [Sheet1$] for the English version.
      SqlStr = "SELECT * FROM [Hoja1$]"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("Column 1")
         PRINT VARIANT$$(vRes)
         vRes = pRecordset.Collect("Column 2")
         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
' ========================================================================================

Title: ADO Example: How to read an Excel sheet (2)
Post by: José Roca on August 20, 2011, 11:22:27 PM

' ########################################################################################
' Microsoft Windows
' File: ADOEX_ReadExcelSheet2.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.
' ########################################################################################

' ########################################################################################
' Demonstrates how to open an excel sheet and parse it as if it where a recordset.
' To solve the problem that the name of the sheet is localized ("Sheet", in English,
' "Hoja", in Spanish, etc.), first we use the OpenSchema method to retrieve the names of
' the excel sheets; then we open a recordset for each sheet, retrieve the number of columns
' and read them.
' Assumes that the first row contains the names of the columns and that all the rows have
' the same number of columns.
' ########################################################################################

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

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

   LOCAL hr AS DWORD
   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pFields AS ADOFields
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL c AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   DIM   TablesArray() AS STRING

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

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ=test3.xls;ReadOnly=False"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaTables)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_NAME")
         PRINT "Table Name = " VARIANT$$(vRes)
         REDIM PRESERVE TablesArray(UBOUND(TablesArray) + 1)
         TablesArray(UBOUND(TablesArray)) = VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
      ' // Close the recordset
      pRecordset.Close
      PRINT "-----------------------------------"
      ' // Open a recordset for each sheet
      IF UBOUND(TablesArray) > -1 THEN
         FOR i = LBOUND(TablesArray) TO UBOUND(TablesArray)
            SqlStr = "SELECT * FROM [" & TablesArray(i) & "]"
            pRecordset.Open SqlStr, pConnection, %adOpenStatic, -1, -1
            ' // Get a reference to the Fields collection
            pFields = pRecordset.Fields
            ' // Number of fields (columns)
            c = pFields.Count
            ' // Release the Fields collection
            pFields = NOTHING
            DO
               ' // While not at the end of the recordset...
               IF pRecordset.EOF THEN EXIT DO
               ' // Get the content of the columns
               FOR x = 0 TO c - 1
                  vRes = EMPTY
                  vRes = pRecordset.Collect(x)
                  IF VARIANTVT(vRes) = %VT_BSTR THEN
                     PRINT VARIANT$$(vRes)
                  ELSE
                     PRINT STR$(VARIANT#(vRes))
                  END IF
               NEXT
               ' // Fetch the next row
               pRecordset.MoveNext
            LOOP
            ' // Close the recordset
            pRecordset.Close
            PRINT "-----------------------------------"
         NEXT
      END IF
   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
' ========================================================================================

Title: ADO Example: Checks if the recordset supports bookmarks
Post by: José Roca on August 20, 2011, 11:23:18 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: How to save a recordset in XML format
Post by: José Roca on August 20, 2011, 11:24:12 PM


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


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaColumns)
Post by: José Roca on August 20, 2011, 11:25:30 PM





' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaColumns) (2)
Post by: José Roca on August 20, 2011, 11:26:34 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaForeignKeys)
Post by: José Roca on August 20, 2011, 11:27:37 PM

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

Title: ADO Example: OpenSchema (adSchemaIndexes)
Post by: José Roca on August 20, 2011, 11:28:24 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaPrimaryKeys)
Post by: José Roca on August 20, 2011, 11:29:10 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaProviderTypes)
Post by: José Roca on August 20, 2011, 11:29:59 PM

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

Title: ADO Example: OpenSchema (adSchemaProviderTypes) (2)
Post by: José Roca on August 20, 2011, 11:30:35 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaProviderTypes) (2b)
Post by: José Roca on August 20, 2011, 11:31:39 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaTables)
Post by: José Roca on August 20, 2011, 11:32:29 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaTables) (2)
Post by: José Roca on August 20, 2011, 11:33:08 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaTables) (2b)
Post by: José Roca on August 20, 2011, 11:33:56 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: OpenSchema (adSchemaViews)
Post by: José Roca on August 20, 2011, 11:34:44 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Seek Method
Post by: José Roca on August 20, 2011, 11:35:28 PM


The following example demonstrates the use of the Seek method.


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: SELECT @@Identity query
Post by: José Roca on August 20, 2011, 11:36:21 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Sort Property
Post by: José Roca on August 20, 2011, 11:37:15 PM


The following example illustrates the use of the Sort property.


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Supports Method
Post by: José Roca on August 20, 2011, 11:38:05 PM


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


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Checks if a table exists
Post by: José Roca on August 20, 2011, 11:39:06 PM
The following examples demonstrate the use of OpenSchema with the adSchemaTables query to check for the existence of a table.


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Checks if a table exists (2)
Post by: José Roca on August 20, 2011, 11:39:57 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Transactions
Post by: José Roca on August 20, 2011, 11:40:47 PM






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


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Type Property
Post by: José Roca on August 20, 2011, 11:41:37 PM


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.


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Update Method
Post by: José Roca on August 20, 2011, 11:42:24 PM


The following example demonstrates the use of the Update method.


' ########################################################################################
' 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
' ========================================================================================

Title: ADO Example: Version Property
Post by: José Roca on August 20, 2011, 11:43:05 PM


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.


' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: ActiveConnection Property
Post by: José Roca on August 20, 2011, 11:43:51 PM


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.


' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: Appends a view to the Views collection
Post by: José Roca on August 20, 2011, 11:44:59 PM


Appends a view to the Views collection.


' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: How to append a procedure
Post by: José Roca on August 20, 2011, 11:46:41 PM


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.


' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: Enumerates the Columns collection
Post by: José Roca on August 20, 2011, 11:47:44 PM


The following example enumerates the Columns collection.


' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: How to creaste a new table
Post by: José Roca on August 20, 2011, 11:48:52 PM


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


' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: How to create a new table containing an autoincrement field
Post by: José Roca on August 20, 2011, 11:49:45 PM

' ########################################################################################
' 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
' ========================================================================================

Title: ADOX Example: How to create a new table containing an autogenerate guid field
Post by: José Roca on August 20, 2011, 11:50:42 PM

' ########################################################################################
' Microsoft Windows
' File: ADOXEX_CreateTable3.bas
' Contents: ADOX example
' Demonstrates how to create a new table containing an autogenerate guid 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 CVariant 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 "Contacts3"
      pTable.Name = "Contacts4"
      ' // Sets the parent catalog
      pTable.ParentCatalog = pCatalog
      ' // Create fields and append 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 "GUID_ID", %adGUID
      ' // Make an autogenerate field seting is Autogenerate property to True
      pColumn = pColumns.Item("GUID_ID")
      pProperties = pColumn.Properties
      pProperty = pProperties.Item("Jet OLEDB:AutoGenerate")
      ' // 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
      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
      pProperty = NOTHING
      pProperties = NOTHING
      pColumn = NOTHING
      pColumns = NOTHING
      pTables = NOTHING
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: How to delete a column from a table
Post by: José Roca on August 20, 2011, 11:51:51 PM


The following example demonstrates how to delete a column from a table.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_DeleteColumn.bas
' Contents: ADOX example
' Demonstrates how to delete a column (Field in ADO lingo) from a table.
' 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

   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
      ' // Get a pointer to the table "Contacts4"
      pTable = pTables.Item("Contacts4")
      ' // Get a pointer to the Columns collection
      pColumns = pTable.Columns
      ' // Delete the "Notes" column from the collection
      ' --> change it as needed <--
      pColumns.Delete "Notes"
      STDOUT "Column deleted"
   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
' ========================================================================================

Title: ADOX Example: How to delete a procedure
Post by: José Roca on August 20, 2011, 11:52:38 PM


The following example shows how to delete a procedure.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_DeleteProcedure.bas
' Contents: ADOX example
' Demonstrates how to delete a procedure.
' 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 pProcedures AS ADOXPRocedures
   LOCAL ConStr AS WSTRING

   ' // 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 Procedures collection
      pProcedures = pCatalog.Procedures
      ' // Delete the "AuthorById Procedure"
      pProcedures.Delete "AuthorById"
      STDOUT "Procedure deleted"
   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
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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

Title: ADOX Example: DeleteRule Property
Post by: José Roca on August 20, 2011, 11:53:45 PM


This example demonstrates the use of the DeleteRule property.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_DeleteRule.bas
' Contents: ADOX example
' This example demonstrates the DeleteRule property of a Key object. The code appends a
' new Table and then defines a new primary key, setting DeleteRule to adRICascade.
' 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 pKeyColumns AS ADOXColumns
   LOCAL pKeyColumn AS ADOXColumn
   LOCAL pPrimaryKey AS ADOXKey
   LOCAL pKeys AS ADOXKeys
   LOCAL pConnection AS ADOConnection
   LOCAL vConnection AS VARIANT
   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

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

   TRY
      ' // Set the ActiveConnection property of the Catalog
      pCatalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Set the name of the new table
      pTable.Name = "NewTable"
      ' // Append a numeric and a text field to the new table
      pColumns = pTable.Columns
      pColumns.Append "NumField", %adInteger
      ' // Note: If you are using Jet 3.51 instead of 4.0 use %adVarChar
      pColumns.Append "TextField", %adVarWChar, 20
      ' // Append the new table
      pTables = pCatalog.Tables
      pTables.Append pTable
      ' // Define the primary key
      pPrimaryKey.Name = "NumField"
      pPrimaryKey.Type = %adKeyPrimary
      pPrimaryKey.RelatedTable = "Title Author"
      pKeyColumns = pPrimaryKey.Columns
      pKeyColumns.Append "NumField", %adVarWChar
      pKeyColumn = pKeyColumns.Item("NumField")
      pKeyColumn.RelatedColumn = "Au_ID"
      pPrimaryKey.DeleteRule = %adRICascade
      ' // Append the primary key
      pKeys = pTable.Keys
      pKeys.Append pPrimaryKey
   CATCH
      HRESULT = OBJRESULT
      ' // Display error information
      vConnection = pCatalog.ActiveConnection
      pConnection = vConnection
      STDOUT AdoGetErrorInfo(pConnection, HRESULT)
      vConnection = EMPTY
      pConnection = NOTHING
   FINALLY
      ' // Delete the table as this is a demo
      IF ISTRUE ISOBJECT(pTables) THEN
         pTables.Delete "NewTable"
         STDOUT "NewTable deleted"
      END IF
      ' // Release objects and collections
      pKeys = NOTHING
      pKeyColumn = NOTHING
      pKeyColumns = NOTHING
      pColumns = NOTHING
      pTable = NOTHING
      pTables = NOTHING
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Deletes a View from the collection
Post by: José Roca on August 20, 2011, 11:55:04 PM


The following example shows how to delete a View.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_DeleteView.bas
' Contents: ADOX example
' Demonstrates how to delete a View.
' 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 pViews AS ADOXViews
   LOCAL ConStr AS WSTRING

   ' // 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
      ' // Create the command representing the View
      ' // Get a reference to the Views collection
      pViews = pCatalog.Views
      ' // Delete the "AllAuthors view"
      pViews.Delete "AllAuthors"
      STDOUT "View deleted"
   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
' ========================================================================================

Title: ADOX Example: Views Collection
Post by: José Roca on August 20, 2011, 11:55:52 PM


The following example enumerates the Views collection.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Fields.bas
' Contents: ADOX example
' Retrieves the fields of the "All Titles" view.
' 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 pViews AS ADOXViews
   LOCAL pView AS ADOXView
   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 Views collection
      pViews = pCatalog.Views
      ' // Get the number of objects in the collection
      nCount = pViews.Count
      IF nCount = 0 THEN EXIT TRY
      ' // Enumerate the objects
      FOR i = 0 TO nCount - 1
         pView = pViews.Item(i)
         PRINT "Name: " pView.Name
         pView = NOTHING
      NEXT
      pView = pViews.Item("All Titles")
      PRINT "Date created: " AfxVarToStr(pView.DateCreated)
      PRINT "Date modified: " AfxVarToStr(pView.DateModified)
      pView = NOTHING
   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
' ========================================================================================

Title: ADOX Example: Demonstrates how to create a new index
Post by: José Roca on August 20, 2011, 11:56:52 PM


The following code demonstrates how to create a new index.
The index is on two columns in the table.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Index.bas
' Contents: ADOX example
' The following code demonstrates how to create a new index.
' The index is on two columns in the table.
' 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 pTable AS ADOXTable
   LOCAL pTables AS ADOXTables
   LOCAL pIndex AS ADOXIndex
   LOCAL pIndexes AS ADOXIndexes
   LOCAL pColumns AS ADOXColumns
   LOCAL pIdxColumns AS ADOXColumns
   LOCAL pConnection AS ADOConnection
   LOCAL vConnection AS VARIANT
   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

   ' // Create an Index object
   pIndex = NEWCOM "ADOX.Index"
   IF ISNOTHING(pIndex) THEN EXIT FUNCTION

   TRY
      ' // Set the ActiveConnection property of the Catalog
      pCatalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Set the name of the table
      pTable.Name = "myTable"
      ' // Append fields to the new table
      pColumns = pTable.Columns
      pColumns.Append "Column1", %adInteger
      pColumns.Append "Column2", %adInteger
      ' // Note: If you are using Jet 3.51 instead of 4.0 use %adVarChar
      pColumns.Append "Column3", %adVarWChar, 50
      ' // Append the new table
      pTables = pCatalog.Tables
      pTables.Append pTable
      ' // Define a multicolumn index
      pIndex.Name = "multicolidx"
      pIdxColumns = pIndex.Columns
      pIdxColumns.Append "Column1", %adVarWChar
      pIdxColumns.Append "Column2", %adVarWChar
      ' // Append the index to the table
      pIndexes = pTable.Indexes
      pIndexes.Append pIndex
   CATCH
      HRESULT = OBJRESULT
      ' // Display error information
      vConnection = pCatalog.ActiveConnection
      pConnection = vConnection
      STDOUT AdoGetErrorInfo(pConnection, HRESULT)
      vConnection = EMPTY
      pConnection = NOTHING
   FINALLY
      ' // Delete the table as this is a demonstration
      IF ISTRUE ISOBJECT(pTables) THEN
         pTables.Delete "MyTable"
         STDOUT "MyTable deleted"
      END IF
      ' // Release objects and collections
      pIdxColumns = NOTHING
      pColumns = NOTHING
      pIndexes = NOTHING
      pTables = NOTHING
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Indexes Collection
Post by: José Roca on August 20, 2011, 11:57:40 PM


The following example parses the Indexes collection of a Table and shows the name of the Primary Key and the columns that make up the index.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Indexes.bas
' Contents: ADOX example
' Parses the Indexes collection of a Table and shows the name of the Primary Key and the
' columns that make up the index.
' 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 pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL pIndexes AS ADOXIndexes
   LOCAL pIndex AS ADOXIndex
   LOCAL pColumns AS ADOXColumns
   LOCAL pColumn AS ADOXColumn
   LOCAL ConStr AS STRING
   LOCAL vCommand AS VARIANT
   LOCAL IdxCount AS LONG
   LOCAL ColCount AS LONG
   LOCAL i AS LONG
   LOCAL x 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 Table object
      pTable = pTables.Item("Authors")
      ' // Get a reference to the Indexes collection
      pIndexes = pTable.Indexes
      pTable = NOTHING
      ' // Retrieve the number of objects in the collection
      IdxCount = pIndexes.Count
      IF IdxCount = 0 THEN EXIT TRY
      FOR i = 0 TO IdxCount - 1
         pIndex = pIndexes.Item(i)
         IF ISTRUE pIndex.PrimaryKey THEN
            STDOUT "Index name: " & pIndex.Name
            pColumns = pIndex.Columns
            ColCount = pColumns.Count
            FOR x = 0 TO ColCount - 1
               pColumn = pColumns.Item(i)
               STDOUT "Column name: " & pColumn.Name
               pColumn = NOTHING
            NEXT
            pColumns = NOTHING
         END IF
         pIndex = NOTHING
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collections
      pIndexes = NOTHING
      pTables = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Key Object
Post by: José Roca on August 20, 2011, 11:58:18 PM


The following code demonstrates how to create a new key.
The key is on two columns in the table.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Key.bas
' Contents: ADOX example
' The following code demonstrates how to create a new key.
' The key is on two columns in the table.
' 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 pForeignKey AS ADOXKey
   LOCAL pColumns AS ADOXColumns
   LOCAL pColumn AS ADOXColumn
   LOCAL pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL pKeys AS ADOXKeys
   LOCAL pConnection AS ADOConnection
   LOCAL vConnection AS VARIANT
   LOCAL HRESULT AS LONG

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

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

   TRY
      ' // Set the ActiveConnection property of the Catalog
      pCatalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=nwind.mdb"
      ' // Define the foreign key
      pForeignKey.Name = "CustOrder"
      pForeignKey.Type = %adKeyForeign
      pForeignKey.RelatedTable = "Customers"
      pColumns = pForeignKey.Columns
      pColumns.Append "CustomerId", %adVarWChar
      pColumn = pColumns.Item("CustomerId")
      pColumn.RelatedColumn = "CustomerId"
      pForeignKey.UpdateRule = %adRICascade
      ' // Append the foreign key
      pTables = pCatalog.Tables
      pTable = pTables.Item("Orders")
      pKeys = pTable.Keys
      pKeys.Append pForeignKey
   CATCH
      HRESULT = OBJRESULT
      ' // Display error information
      vConnection = pCatalog.ActiveConnection
      pConnection = vConnection
      STDOUT AdoGetErrorInfo(pConnection, HRESULT)
      vConnection = EMPTY
      pConnection = NOTHING
   FINALLY
      ' // Delete the key as this is a demonstration
      IF ISTRUE ISOBJECT(pTables) THEN
         pKeys.Delete "CustOrder"
         STDOUT "CustOrder deleted"
      END IF
      ' // Release objects and collections
      pKeys = NOTHING
      pTable = NOTHING
      pTables = NOTHING
      pColumn = NOTHING
      pColumns = NOTHING
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Keys Collection
Post by: José Roca on August 20, 2011, 11:58:58 PM


The following example enumerates the Keys collection of the Titles table.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Keys.bas
' Contents: ADOX example
' Enumerates the Keys collection of the Titles table.
' 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 pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL pKeys AS ADOXKeys
   LOCAL pKey AS ADOXKey
   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
      IF nCount = 0 THEN EXIT TRY
      ' // Get a pointer to the table "Titles"
      pTable = pTables.Item("Titles")
      ' // Get a pointer to the Keys collection
      pKeys = pTable.Keys
      ' // Get the number of objects in the collection
      nCount = pKeys.Count
      ' // Enumerate the objects
      FOR i = 0 TO nCount - 1
         pKey = pKeys.Item(i)
         PRINT "Name: " pKey.Name " - ";
         PRINT "Type: " pKey.Type
         pKey = NOTHING
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collections
      pKeys = NOTHING
      pTables = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: How to retrieve parameter information for the Procedure
Post by: José Roca on August 21, 2011, 12:00:08 AM


The following example retrieves parameters information of a procedure.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_ParameterInfo.bas
' Contents: ADOX example
' The following code demonstrates how to use the Command property with the Command object
' to retrieve parameter information for the Procedure.
' 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 pProcedure AS ADOXProcedure
   LOCAL pParameters AS ADOParameters
   LOCAL pParameter AS ADOParameter
   LOCAL ConStr AS WSTRING
   LOCAL vCommand AS VARIANT
   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 Procedures collection
      pProcedures = pCatalog.Procedures
      ' // Get the Procedure object
      pProcedure = pProcedures.Item("AuthorById")
      ' // Get the Command
      vCommand = pProcedure.Command
      pProcedure = NOTHING
      pCommand = vCommand
      vCommand = EMPTY
      ' // Get a reference to the Parameters collection
      pParameters = pCommand.Parameters
      pCommand = NOTHING
      ' // Retrieve the number of objects in the collection
      nCount = pParameters.Count
      IF nCount = 0 THEN EXIT TRY
      FOR i = 0 TO nCount - 1
         pParameter = pParameters.Item(i)
         STDOUT "Parameter name: " & pParameter.Name & $CRLF & _
                "Parameter type: " & STR$(pParameter.Type)
         pParameter = NOTHING
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collections
      pParameters = NOTHING
      pProcedures = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Procedures Collection
Post by: José Roca on August 21, 2011, 12:00:47 AM


The following example enumerates the Procedures collection.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Procedures.bas
' Contents: ADOX example
' Enumerates the Procedures 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"
#INCLUDE ONCE "AfxVarToStr.inc"

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

   LOCAL pConnection AS ADOConnection
   LOCAL pCatalog AS ADOXCatalog
   LOCAL pProcedures AS ADOXPRocedures
   LOCAL pProcedure AS ADOXProcedure
   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 Procedures collection
      pProcedures = pCatalog.Procedures
      ' // Retrieve the number of objects in the collection
      nCount = pProcedures.Count
      IF nCount = 0 THEN EXIT TRY
      FOR i = 0 TO nCount - 1
         pProcedure = pProcedures.Item(i)
         STDOUT "Procedure name: " & pProcedure.Name & $CRLF & _
                "Date created: " & AfxVarToStr(pProcedure.DateCreated)
         pProcedure = NOTHING
      NEXT
   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
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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

Title: ADOX Example: Properties Collection
Post by: José Roca on August 21, 2011, 12:01:32 AM

' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Properties.bas
' Contents: ADOX example
' Enumerates the properties of the Name column of the BIBLIO.MDB 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 "AfxVarToStr.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 pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL ConStr AS WSTRING
   LOCAL nCount AS LONG
   LOCAL i AS LONG
   LOCAL vValue AS VARIANT

   ' // 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
      IF nCount = 0 THEN EXIT TRY
      ' // Get a pointer to the table "Publishers"
      pTable = pTables.Item("Publishers")
      ' // Get a pointer to the Columns collection of the table
      pColumns = pTable.Columns
      pTable = NOTHING
      ' // Get the number of objects in the Columns collection for that table
      nCount = pColumns.Count
      IF nCount = 0 THEN EXIT TRY
      ' // Enumerate all the objects
      FOR i = 0 TO nCount - 1
         pColumn = pColumns.Item(i)
         PRINT "Column name: " pColumn.Name
         PRINT "Defined size: " pColumn.DefinedSize
         PRINT "Type: " pColumn.Type
         PRINT "Attributes: " pColumn.Attributes
         pColumn = NOTHING
      NEXT
      ' // Get a pointer to the "Name" column
      pColumn = pColumns.Item("Name")
      ' // Get a pointer to his properties collection
      pProperties = pColumn.Properties
      nCount = pProperties.Count
      pColumn = NOTHING
      ' // Enumerate the properties
      PRINT "-----------------------------------------------------"
      PRINT "Properties of the Name column: "
      PRINT "-----------------------------------------------------"
      FOR i = 0 TO nCount - 1
         pProperty = pProperties.Item(i)
         PRINT "Property name: " pProperty.Name
         vValue = pProperty.Value
         PRINT "Value: " AfxVarToStr(vValue)
         PRINT "Type: " pProperty.Type
         PRINT "Attributes: " pProperty.Attributes
         pProperty = NOTHING
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collections
      pProperties = NOTHING
      pColumns = NOTHING
      pTables = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: How to refresh the Procedures collection of a Catalog
Post by: José Roca on August 21, 2011, 12:02:40 AM


The following example shows how to refresh the Procedures collection of a Catalog. This is required before View objects from the Catalog can be accessed.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_RefreshProcedures.bas
' Contents: ADOX example
' The following example shows how to refresh the Procedures collection of a Catalog. This
' is required before View objects from the Catalog can be accessed.
' 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 pProcedures AS ADOXPRocedures
   LOCAL ConStr AS WSTRING

   ' // 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 Procedures collection
      pProcedures = pCatalog.Procedures
      ' // Refresh the collection
      pProcedures.Refresh
      STDOUT "Procedures collection refreshed"

   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
   pCatalog = NOTHING
   pConnection = NOTHING

   WAITKEY$

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

Title: ADOX Example: How to refresh the Views collection of a Catalog
Post by: José Roca on August 21, 2011, 12:03:23 AM


The following example demonstrates how to refresh the Views collection of a Catalog. This is required before View objects from the Catalog can be accessed.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_RefreshViews.bas
' Contents: ADOX example
' The following example demonstrates how to refresh the Views collection of a Catalog.
' This is required before View objects from the Catalog can be accessed.
' 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 pViews AS ADOXViews
   LOCAL ConStr AS WSTRING

   ' // 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 Views collection
      pViews = pCatalog.Views
      ' // Refresh the collection
      pViews.Refresh
      STDOUT "Views collection refreshed"
   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
' ========================================================================================

Title: ADOX Example: How to rename a table
Post by: José Roca on August 21, 2011, 12:04:12 AM


The following example demonstrates how to rename a table using ADOX.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_RenameTable.bas
' Contents: ADOX example
' Demonstrates how to rename a table using ADOX.
' 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 pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL ConStr AS WSTRING

   ' // 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 Contacts3 table
      pTable = pTables.Item("Authors")
      pTable.Name = "Authors2"
      STDOUT "Table renamed"
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the Table object and the Tables collection
      pTable = NOTHING
      pTables = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Checks if a table exists in the database
Post by: José Roca on August 21, 2011, 12:05:03 AM


The following example checks If a table exists in the database.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_TableExists.bas
' Contents: ADOX example
' Checks if a table exists in the 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"

' ========================================================================================
' Checks if a table exists in the database
' ========================================================================================
FUNCTION ADOX_TableExists (BYVAL pConnection AS ADOConnection, BYVAL bstrTableName AS WSTRING) AS LONG

   LOCAL pCatalog AS ADOXCatalog
   LOCAL pTables AS ADOXTables
   LOCAL pTable AS ADOXTable
   LOCAL nCount AS LONG
   LOCAL i AS LONG

   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

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

   ' // 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
   IF nCount = 0 THEN EXIT FUNCTION
   pTable = pTables.Item(bstrTableName)
   IF ISTRUE ISOBJECT(pTable) THEN FUNCTION = %TRUE
   pTable = NOTHING
   ' // Release the collection
   pTables = NOTHING

   ' // Release the Catalog object
   pCatalog = NOTHING

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

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

   LOCAL pConnection AS ADOConnection
   LOCAL ConStr AS WSTRING

   ' // 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
      IF ADOX_TableExists(pConnection, "Publishers") THEN
         STDOUT "Table exists"
      ELSE
         STDOUT "Table doesn't exist"
      END IF
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   END TRY

   ' // Release the connection
   pConnection = NOTHING

   WAITKEY$

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

Title: ADOX Example: How to update a view
Post by: José Roca on August 21, 2011, 12:05:49 AM


The following example demostrates how to use the Command property to update the text of a view.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_UpdatView.bas
' Contents: ADOX example
' The following example demostrates how to use the Command property to update the text of a view.
' 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 vCommand AS VARIANT
   LOCAL pViews AS ADOXViews
   LOCAL pView AS ADOXView
   LOCAL ConStr AS WSTRING

   ' // 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 Views collection
      pViews = pCatalog.Views
      ' // Get a reference to the "AllAuthors" view
      pView = pViews.Item("AllAuthors")
      ' // Get the Command of the View
      vCommand = pView.Command
      pCommand = vCommand
      ' // Update the CommandText property of the Command
      pCommand.CommandText = "SELECT Author FROM Authors"
      pCommand = NOTHING
      ' // Modify the Command of the View
      pView.Command = vCommand
      vCommand = EMPTY
      STDOUT "View updated"
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Release the collection
      pView = NOTHING
      pViews = NOTHING
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

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

   WAITKEY$

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

Title: ADOX Example: Views Collection
Post by: José Roca on August 21, 2011, 12:06:28 AM


The following example enumerates the Views collection.


' ########################################################################################
' Microsoft Windows
' File: ADOXEX_Views.bas
' Contents: ADOX example
' The following example retrieves the fields of the "All Titles" view.
' 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 pViews AS ADOXViews
   LOCAL pView AS ADOXView
   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 Views collection
      pViews = pCatalog.Views
      ' // Get the number of objects in the collection
      nCount = pViews.Count
      IF nCount = 0 THEN EXIT TRY
      ' // Enumerate the objects
      FOR i = 0 TO nCount - 1
         pView = pViews.Item(i)
         PRINT "Name: " pView.Name
         pView = NOTHING
      NEXT
   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
' ========================================================================================