Announcement

Collapse
No announcement yet.

ADO PArt Deux: Catalog functions with Criteria Problems

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • ADO PArt Deux: Catalog functions with Criteria Problems

    Environment: Win/XP Pro SP 3 all updates
    ADO 2.8
    PB/CC 5.0

    Problem: Can't get criteria to work with the OpenSchema Method of ADO.

    In the new include file ADOTABLES.INC (below), there is this section of code
    Code:
         ' ---------------------------------------------------------------------
         '  SET THE 'WE WANT TABLE INFO' PARAMETERS FOR THE OPENSCHEMA METHOD
         ' ---------------------------------------------------------------------
    
         LET vQueryType =  %adSchemaTables AS LONG ' param 1
    
         ' OK, first run returned 6221 tables views ans synonyms
         ' it also returned everything for all shcemas ("user ids")
         ' I want to limit returns to TABLES, views and maybe synonyms
         ' for sure I want to limit the schema to that of the user ID
         ' param two is criteria, listed as an array
          REDIM sCriteria  (3)      ' four constraint columns for adSchema tables: 
                                    'catalog., schema, tablename, table_type
    
          sCriteria  (0)  = ""                ' catalog (= DB)
          sCriteria  (1)  = "prod"   '         PROD" & $NUL    ' schema  'UCODE$ did not help
          sCriteria  (2)  = ""                ' tablename
          sCriteria  (3)  = ""               ' tabletype
    
          LET   vCriteria =  sCriteria()  ' create variant array compliler is 
                                           'supposed to handle all unicode conversions required
        ' ----------------------------------------------------------------------------------
        '  EXECUTE THE OPENSCHEMA METHOD, Returning the recordset with the desired info
        ' ----------------------------------------------------------------------------------
        ' when I try to add vCriterial parameter, I get a x0009 with no IDISPINFO
        ' maybe I this code is out of whack, no it's OK. I must be doings soimething wrong here
        ' but it sure looks like I am doing this correctly, it's the same as the example
        ' I get EVERYTHING when I don't pass vCriteria, but I'd sure like to have ADO filter the data for me.
    
    [b]WITH_CRITERIA:[/b]
         OBJECT CALL  oConn.OpenSchema (VQueryType, vCriteria)  TO vW
    
    [b]WITHOUT_CRITERIA:[/b] 
          'OBJECT CALL  oConn.OpenSchema (VQueryType)  TO vW   <<< WORKS TERRIFIC (but gets EVERYTHING)
         iRet = OBJRESULT   ' most recent

    When I call the OpenSchema at WITHOUT_CRITERA I get success.. the report file starts out like this:


    Code:
    ADO Demo (tables) begins at 17:38:49 on 11-17-2008
    Connection string 'Provider=ORAOLEDB.Oracle;Data Source=XE;User ID=prod;Password=prod'
    
    AdoDbGetTableInfo returns 0 SUCCESS
    QUery returned 9 columns and 6221 rows
    
    COLUMN NAMES
    TABLE_CATALOG,TABLE_SCHEMA,TABLE_NAME,TABLE_TYPE,TABLE_GUID,DESCRIPTION,TABLE_PROPID,DATE_CREATED,DATE_MODIFIED
    
    ,HR,EMP_DETAILS_VIEW,VIEW,,,,2006-02-07 22:52:57,2006-02-07 22:52:57
    ,DBSNMP,MGMT_RESPONSE_BASELINE,VIEW,,,,2006-02-07 22:36:21,2006-02-07 22:36:21
    ,XDB,PATH_VIEW,VIEW,,,,2006-02-07 22:43:03,2006-02-07 22:53:16
    ,XDB,RESOURCE_VIEW,VIEW,,,,2006-02-07 22:42:18,2006-02-07 22:45:55
    ,FLOWS_020100,WWV_FLOW_ACTIVITY_LOG,VIEW,,,,2006-02-07 22:54:53,2006-02-07 22:54:53
    ,FLOWS_020100,WWV_FLOW_BUILD_OPTIONS,VIEW,,,,2006-02-07 22:54:54,2006-02-07 22:54:54
    ,FLOWS_020100,WWV_FLOW_CLICKTHRU_LOG,VIEW,,,,2006-02-07 22:55:02,2006-02-07 22:56:14
    ,FLOWS_020100,WWV_FLOW_CLICKTHRU_LOG_V,VIEW,,,,2006-02-07 22:55:02,2006-02-07 22:55:02
    ,FLOWS_020100,WWV_FLOW_COLLECTIONS,VIEW,,,,2006-02-07 22:55:01,2006-02-07 22:56:14
    ,FLOWS_020100,WWV_FLOW_FILES,VIEW,,,,2006-02-07 22:54:57,2006-02-07 22:56:16
    ,FLOWS_020100,WWV_FLOW_FORMAT_MASKS,VIEW,,,,2006-02-07 22:55:08,2006-02-07 22:55:08
    ,FLOWS_020100,WWV_FLOW_GROUP_USERS,VIEW,,,,2006-02-07 22:56:00,2006-02-07 22:56:14
    ,FLOWS_020100,WWV_FLOW_HOURS_12,VIEW,,,,2006-02-07 22:54:55,2006-02-07 22:54:55
    ,FLOWS_020100,WWV_FLOW_HOURS_24,VIEW,,,,2006-02-07 22:54:55,2006-02-07 22:54:55
    ...
    Unfortunately, this returns 6221 rows... all schemas, all tables, views, synonyms, etc.

    I want to restrict the function to returning ONLY schema = "prod" . I want probably only tables and views, but I can run this twice, once for tables, once for views for the target schema.

    But with I try WITH_CRITERIA, I get an exception error (DISP_E_EXECPTION) and I don't even get the IDISPPARAMS info!


    For the openSchema method, the doc is here...
    http://msdn.microsoft.com/en-us/library/ms945095.aspx

    ... and the "VB Example" provided is:
    Code:
    Set rstSchema = Cnxn2.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "VIEW"))

    So I tried this:
    Code:
          REDIM sCriteria  (3)     ' four constraint columns for adSchema tables: catalog., schema, tablename, table_type
          sCriteria  (0)  = ""                ' catalog (= DB)
          sCriteria  (1)  = ""   '     PROD" & $NUL    ' schema  'UCODE$ did not help
          sCriteria  (2)  = ""                ' tablename
          sCriteria  (3)  = "VIEW"               ' tabletype
    
          LET   vCriteria =  sCriteria()  ' create variant array compliler is supposed to handle all unicode conversions required
        ' ----------------------------------------------------------------------------------
        '  EXECUTE THE OPENSCHEMA METHOD, Returning the recordset with the desired info
        ' ----------------------------------------------------------------------------------
        ' when I try to add vCriterial parameter, I get a x0009 with no IDISPINFO
        ' maybe I this code is out of whack, no it's OK. I must be doings soimething wrong here
        ' but it sure looks like I am doing this correctly, it's the same as the example
        ' I get EVERYTHING when I don't pass vCriteria, but I'd sure like to have ADO filter the data for me.
    
    WITH_CRITERIA:
         OBJECT CALL  oConn.OpenSchema (VQueryType, vCriteria)  TO vW
    .. but that failed the same as trying to set only criteria 2, the schema: Exception with no IDISPPARAMS info.

    Does anyone have any pointers as to how I am supoosed to set up and call this method with criteria?

    All relevant code below. (Meaning, if you don't need criteria and can live with "everything" being returned, it's usable today)

    Thanks,
    MCM


    New include file ADOTABLES.INC for "get tables function"
    .. VERY similar to the one for "Execute a select"
    Code:
    ' ADOTABLES.INC
    '  Function to return table info about a data source
    ' plus required support functions
    ' === HISTORY ============
    ' 11.15.08         Original development starting with ADOEXECUTESELECT.INC
    ' CALLABLE FUNCTION AND PARAMETERS
    ' DECLARE FUNCTION ADODBgetTableInfo (szConnect AS ASCIIZ, sTableInfo() AS STRING, sErrMsg AS STRING) AS LONG
    ' returns.. 0 - success and STableINfo(col, row) is sized and filled thus:
    '    col 1-N          = columns ordinals 1-n; ie., (0,any) is never populated
    '    Row  0, cols 1-N = Column names
    '    row  1-N         = Data rows
    
    ' If function returns TRUE => some kind of error and a text message is deposited in sErrMsg.
    ' Using STRING for SerrMsg since it conceiveably could be a really long message
    ' and I do not wish to be constrained by SIZEOF(buffer) if buffer = ASCIIZ type.
    ' ---------------------------
    ' REQUIRED #INCLUDE files
    ' ---------------------------
    #IF NOT %DEF(%WINAPI)
      #INCLUDE "WIN32API.INC"
    #ENDIF
    
    #INCLUDE   "ADODB28DISP.INC"  ' generated with PB/CC 5.0 com browser "dispatch only" option,
    #IF NOT %DEF(%VT_DECIMAL)
      %VT_DECIMAL = 14
    #ENDIF
    ' ----------------------------------------------------------------------
    ' ROW INCREMENT: by how many rows the sRow() array grows when resized
    ' Note allocation is (nCol+1)*(nRow+1)* 4 bytes at a time since this is array of dynamic strings
    ' ' ----------------------------------------------------------------------
    %ADODB_ROW_INCR   =     1024&   '  when 16 return columns will allocate only 64K at a crack.
    ' ----------------------------------------------------------
    ' DATA CONVERSION FUNCTIONS USED IN THE FETCH FROM SELECT
    ' ----------------------------------------------------------
    'DECLARE FUNCTION VarBstrFromDec LIB "OLEAUT32.DLL" ALIAS "VarBstrFromDec" _
      ' (pdecIn AS ANY, BYVAL lcid AS DWORD, BYVAL dwFlags AS DWORD, pbstrOut AS STRING) AS LONG
    FUNCTION VtDecimalToString (vDec AS VARIANT) AS STRING
        LOCAL S AS STRING, hr AS LONG
        hr = VarBstrFromDec(vDec, %LOCALE_USER_DEFAULT, 0, S)
        FUNCTION =  ACODE$(S)
    END FUNCTION
    
    ' Cnvert a VT_DATE to a dynamic string
    ' Variant time is "ccyymmddpart.timepart" so if VARIANT# has a FRAC part it includes
    ' a time component as well as a date component.
    ' Tested format of time component 11/5/08
    ' official ODBC timestamp format is ccyy-mm-dd hh:mm:ss
    FUNCTION DbDatefromVariantDate (vDate AS VARIANT) AS STRING
    
        LOCAL ST AS SYSTEMTIME
        LOCAL szDF AS ASCIIZ * 48,  szDate AS ASCIIZ * 48
        LOCAL szTF AS ASCIIZ * 48,  szTime AS ASCIIZ * 48
        LOCAL vbTime AS DOUBLE
    
        vbTime = VARIANT#(vDate)
        VariantTimeToSystemTime vbTime, St
        ' always format the date
        szDf          =  "yyyy'-'MM'-'dd"
        GetDateFormat    BYVAL %NULL, BYVAL %NULL ,st, szDf, szDate, SIZEOF (szDate)
    
        ' only add the time string if present
        IF FRAC (vbTime) THEN
             szTF     = "HH':'mm':'ss"  ' HH= 24 hour, hh= 12 hour
             GetTimeFormat    BYVAL %NULL, BYVAL %NULL ,st, szTF, szTime, SIZEOF (szTime)
             FUNCTION = szDate & $SPC & szTime
         ELSE
            FUNCTION      = szDate
         END IF
    END FUNCTION
    
    ' -------------------------------------------
    ' ADODBGetTableINfo
    ' Generic FUNCTION.
    '  szConnect = Connection string. Not modified here
    ' function to connect, get info, disconnect and return
    FUNCTION ADODBGetTableInfo (szConnect AS ASCIIZ, _
                               sRow() AS STRING, sErrMsg AS STRING) AS LONG
      LOCAL oConn AS INT__Connection
      LOCAL vConn AS VARIANT       ' connection string so I can try multiple
      LOCAL vState AS VARIANT
      LOCAL iState AS LONG
      LOCAL vProvider AS VARIANT   ' get after connection
      ' to create a recordset on the connnection
      LOCAL sCOnnect AS STRING
      LOCAL oRs AS Int__RecordSet
      LOCAL oFields  AS  fields, vFields AS VARIANT
      LOCAL oField   AS Int_Field,   vField  AS VARIANT
      LOCAL vSql AS VARIANT, vnRow AS VARIANT
      LOCAL vW   AS VARIANT  ' working var
      LOCAL nCol AS LONG, iCol AS LONG
      LOCAL nRow      AS LONG, iRow AS LONG
    
      LOCAL sColName() AS STRING
      LOCAL vColIndex AS VARIANT, vColName AS VARIANT
      LOCAL vEOF AS VARIANT
      LOCAL vItem     AS VARIANT
    
      LOCAL vQueryType AS VARIANT
      ' criteria (param 2)  is optional, so I will not be setting this to start out
      ' SchemaID (param 3) "is a GUID for a provier-schma query not defined by the OLE DB specification.
      ' This parameter is required if QueryType is set to adSchemaProviderSpecific; otherwise it is not used."
      LOCAL sCriteria() AS STRING
      LOCAL vCriteria AS VARIANT
    
    
      LOCAL sIdispInfoText AS STRING
    
      LOCAL vValue    AS VARIANT
      LOCAL sValue    AS STRING
      LOCAL hOut      AS LONG, sBUff AS STRING
      LOCAL iRet      AS LONG
      LOCAL vErrIndex AS VARIANT
      LOCAL vErrDesc  AS VARIANT
      LOCAL vErrCount AS VARIANT
      LOCAL nErr      AS LONG
      LOCAL iErr      AS LONG
      LOCAL s         AS STRING
      LOCAL w         AS STRING
      LOCAL fv        AS LONG   ' function value. %S_OK =0
    
    
      ' ---------------------------
      ' Begin code portion here
      ' ---------------------------
    
      ' create a connection object
      SET oConn  = NEWCOM $PROGID_ADODB_Connection   ' CC 5 syntax
    
      IF ISOBJECT(oConn) THEN
         sConnect    = szCOnnect   'convert passed connection info to dynamic string
         vConn       = sConnect    ' and then to a variant
         s           = ""          ' initialize
         OBJECT CALL   oConn.Open (vConn)   ' establish connection
    
         iRet        = OBJRESULT
         IF iRet <> %S_OK THEN               ' some kind of error
    
             w = "Connection error:"
    
           ' Get the IDISPINFO information if applicable BEFORE we make
           ' any additional calls against the oCONN object
            IF iRet = %DISP_E_EXCEPTION  THEN   ' iDISPINFO applies.
                 CALL ADOGetIDispInfoErrorText () TO sIDispInfoText
            ELSE
                 siDispINfoText = ""
            END IF
            ' -----------------------------------------------------------------
            ' TRY TO GET THE ERRORS OBJECT, even if we have IDISPINFO message;
            ' you CAN get both! We want to use the errors info if available
            ' If not available, then we use the sIDispInfoText string
            ' we already have.
            ' -----------------------------------------------------------------
            OBJECT GET   oconn.Errors.Count  TO vErrCount
            nErr       = VARIANT#(vErrCount)
    
    
            'if error count is zero, must be ADO runtime error or Windows Error;
            'or, the exception error I got when the provider was not found.
            'in any event the only error info we have will be the IDISPINFO
            'material, so we can return now
            IF nErr = 0 THEN
               IF iRet = %DISP_E_EXCEPTION THEN
                   S         = sIDispInfoText
                   IF LEN(S) = 0 THEN
                        s = "0x0009 (Exception); IDISPINFO error information not available"
                   END IF
               ELSE              'not an 'exception' we can get text
                   CALL ADogetRuntimeERrorInfo (iRet)  TO s  ' "0xABCD text..."
               END IF
               ' set error message and goto cleanup (we have no Errors object to deal with)
                sErrMsg  = W & S    ' "connection error:" S strng
                fv       = iRet
                GOTO AdoDBGetTableInfo_Exit
    
            ELSE  ' we WERE able to get the Errors object so
                  ' we will use that to report.
    
                FOR iErr = 0 TO nErr-1
                   vErrIndex =  iErr
                   OBJECT GET oConn.Errors.Item(vErrIndex).Description TO vErrDesc
                   IF ierr = 0 THEN
                        S = VARIANT$(vErrDesc)
                   ELSE
                        S =  S & $CRLF & VARIANT$(vErrDesc)
                   END IF
                NEXT
            END IF ' if the error was DISP_E_EXCEPTION or not
            ' set error message and exit to cleanup
            sErrMsg =   W & S
            fv      =   iRet    ' non-zero
            GOTO        AdoDBGetTableInfo_Exit
    
         END IF  ' if the open (Connect) succeeded or not
    
         ' --------------------------------------------------------------------------------------
         ' When we get here, we are connected to database and ready to set up SQL for execution.
         ' ---------------------------------------------------------------------------------------
         ' create a working recordset object: the oCONN.OpenSchmema returns this
         SET oRS  =  NEWCOM  $PROGID_ADODB_Recordset
    
    
         ' ---------------------------------------------------------------------
         '  SET THE 'WE WANT TABLE INFO' PARAMETERS FOR THE OPENSCHEMA METHOD
         ' ---------------------------------------------------------------------
    
         LET vQueryType =  %adSchemaTables AS LONG ' param 1
    
         ' OK, first run returned 6221 tables views ans synonyms
         ' it also returned everything for all shcemas ("user ids")
         ' I want to limit returns to TABLES, views and maybe synonyms
         ' for sure I want to limit the schema to that of the user ID
         ' param two is criteria, listed as an array
          REDIM sCriteria  (3)     ' four constraint columns for adSchema tables: catalog., schema, tablename, table_type
    
          sCriteria  (0)  = ""                ' catalog (= DB)
          sCriteria  (1)  = ""   '     PROD" & $NUL    ' schema  'UCODE$ did not help
          sCriteria  (2)  = ""                ' tablename
          sCriteria  (3)  = ""               ' tabletype
    
          LET   vCriteria =  sCriteria()  ' create variant array compliler is supposed to handle all unicode conversions required
        ' ----------------------------------------------------------------------------------
        '  EXECUTE THE OPENSCHEMA METHOD, Returning the recordset with the desired info
        ' ----------------------------------------------------------------------------------
        ' when I try to add vCriterial parameter, I get a x0009 with no IDISPINFO
        ' maybe I this code is out of whack, no it's OK. I must be doings soimething wrong here
        ' but it sure looks like I am doing this correctly, it's the same as the example
        ' I get EVERYTHING when I don't pass vCriteria, but I'd sure like to have ADO filter the data for me.
    
         OBJECT CALL  oConn.OpenSchema (VQueryType, vCriteria)  TO vW
          'OBJECT CALL  oConn.OpenSchema (VQueryType)  TO vW   <<< WORKS TERRIFIC (but gets EVERYTHING)
         iRet = OBJRESULT   ' most recent
    
         IF iRet <> %S_OK THEN
    
             w = "OpenSchema error OBRESULT=0x'" & HEX$(iRet,4) & "'"
             STDOUT W
            ' -----------------------------------------------------------------
            ' TRY TO GET THE ERRORS OBJECT, even if we have IDISPINFO message;
            ' you CAN get both! We want to use the errors info if available
            ' If not available, then we use the sIDispInfoText string
            ' we already have.
            ' -----------------------------------------------------------------
            OBJECT GET   oconn.Errors.Count  TO vErrCount
            nErr       = VARIANT#(vErrCount)
            'if error count is zero, must be ADO runtime error or Windows Error;
            STDOUT "Number of errors is " & FORMAT$(nErr)
    
            IF nErr = 0 THEN
               IF iRet = %DISP_E_EXCEPTION THEN
                   CALL ADOGetIDispInfoErrorText () TO sIDispInfoText
                   S         = sIDispInfoText
                   IF LEN(S) = 0 THEN
                        s = "0x0009 (Exception); IDISPINFO error information not available"
                   END IF
                   STDOUT W & " ExcnErr = 0  IDISPINFO Text:" & S
                   WAITKEY$
               ELSE              'not an 'exception' we can get text
                   CALL ADogetRuntimeERrorInfo (iRet)  TO s  ' "0xABCD text..."
               END IF
               ' set error message and goto cleanup (we have no Errors object to deal with)
                sErrMsg  = W & S    ' "openschema error:" S strng
                fv       = iRet
                GOTO AdoDBGetTableInfo_Exit
    
            ELSE   ' we WERE above to get the errors object with a non-zero number of errors
                FOR iErr = 0 TO nErr-1
                   vErrIndex =  iErr
                   OBJECT GET oConn.Errors.Item(vErrIndex).Description TO vErrDesc
                   IF ierr = 0 THEN
                        S = VARIANT$(vErrDesc)
                   ELSE
                        S =  S & $CRLF & VARIANT$(vErrDesc)
                   END IF
                NEXT
            END IF '   if we were able to get the errors object
            ' set error message and exit to cleanup
            sErrMsg =   W & S
            fv      =   iRet    ' non-zero
            GOTO        AdoDBGetTableInfo_Exit
    
         END IF      ' if OBRESULT was not %S_OK
         ' ------------------------------------------------------------
         ' if here, OpenSchema succeeded and it returned a recordset.
         ' This fetch loop should be the same as the one used by the select execute
         ' -------------------------------------------------------------
         LET oRS  =  vW   ' does this work? It compiles, it works. I never had problems if I got
                          ' to this point, but here, too I sold probably check ISOBJECT
    
         ' test vnrow here; does not return anything useful on a SELECT although it should return
         ' 'rows affected' on an UPDATE or INSERT
         '?  "On this succesful SELECT, vnRow=" & FORMAT$ (VARIANT#(vnRow))
    
         'Get the fields object from the recordset (to get the column names)
         OBJECT GET    oRs.Fields TO vFields
         LET           oFields = vFields
         OBJECT GET oFields.Count TO vW
         nCol       = VARIANT#(vW)
          ' here is where we need to Size our return array as we will be returning
          ' the column names in row 0 and data in the rows after that.
         REDIM    sRow (nCol, %ADODB_ROW_INCR)    ' columns are 1 based
         iRow    = 0
         FOR icol  = 0 TO ncol-1   ' uses index
               LET vColIndex  = iCOL
               OBJECT GET       oFields.Item (vColIndex) TO vField
               LET   oField   = vField
               OBJECT GET       oField.Name  TO vColName
               sRow (iCol+1, iRow) = VARIANT$(vColName)
         NEXT
          ' -----------------------------------------------------
          ' now we get the actual returned datarows
          ' ------------------------------------------------------
          nRow     = 0                       ' Number of DATA rows (the sRow() row subscript) we read
          OBJECT CALL oRS.MoveFirst          ' position the cursor
          DO                                 ' perform FETCH loop
             OBJECT GET oRs.EOF  TO vEOF
             IF ISTRUE VARIANT#(vEof) THEN
               ' Exit the fetch loop
                 EXIT DO
             END IF
             ' When we get here we have a row of data to get
             INCR iRow
             ' make sure it will fit; if not make array big enough to hold another block of rows
             IF iRow >  UBOUND (sRow,2) THEN
                  REDIM PRESERVE sRow (nCol, iRow + %ADODB_ROW_INCR)
             END IF
             FOR iCol    = 0 TO nCol-1             ' we got nCol earlier; now get each column of data in this row
                 LET vCOlIndex   =  icol           ' which column
                 OBJECT GET Ors.Fields.Item(vColIndex).Value TO vValue
                  ' Format to a string based on the data type
                 SELECT CASE VARIANTVT (vValue)
                    CASE %VT_EMPTY
                        sValue = ""
                    CASE %VT_NULL
                        sValue = ""    ' we get %VT_NULL if column is null. PB Help does not suggested testing
                                       ' this but I do.
                    CASE %VT_BSTR
                        sValue =  VARIANT$(vValue)
                    CASE  %VT_DATE    ' type 7
                       CALL DbDateFromVariantDate (vValue) TO sValue
                    CASE %VT_DECIMAL    ' %VT_DECIMAL=14 = "16 byte fixed point"
                         ' 10-05-08 jet is giving me a type 3.. from ptmn.mdb
                         ' table = I4 handled below.
                         CALL VtDecimalToString (vValue)  TO sValue
                   ' KNOWN NUMERIC TYPES OTHER THAN DECIMAL
                        ' I2, I4, R4, R8, CY, I1, UI1, UI2, UI4, I8, UI8 INT UINT
                    ' 2   3   4    5  6   16  17   18   19   20   21  22  23
    
                    CASE %VT_BOOL    ' added this handler 11-5-08
                          sValue = IIF$(ISTRUE VARIANT#(vvalue), "1", "0")
    
                    ' KNOWN NUMERIC TYPES
                     CASE %VT_I2, %VT_I4, %VT_R4, %VT_R8, %VT_CY, %VT_I1, %VT_UI1,_
                          %VT_UI2, %VT_UI4, %VT_I8, %VT_UI8, %VT_INT, %VT_UINT
                              SValue = FORMAT$(VARIANT#(vValue))
                    ' if we get an unexpected type, we want to know about it so we can
                    ' add an explicit handler for it.
                     CASE ELSE
                        sValue = USING$ ("UNKNOWN TYPE #  FORMAT_$(VARIANT_#(VALUE)) IS '&'", VARIANTVT(vvalue), FORMAT$(VARIANT#(vValue)))
                  END SELECT
                 ' put sValue in its place remember we use 1 based cols in array
                 ' but zero-based for the fetch.
                  sRow (iCol + 1, iRow) = sValue
             NEXT iCol
             OBJECT CALL ors.MoveNext  ' next row
          LOOP
          ' -----------------------------------------------------
          ' end of fetch loop;
          ' iRow = number of data rows we have actually fetched
          ' -----------------------------------------------------
          ' resize array unless we were really really luck vis-a-vis the number of returned rows
          IF iRow <> UBOUND (sRow, 2) THEN
               REDIM PRESERVE sRow (nCol, iRow)
          END IF
         ' --------------------------
           fv =  0   ' SUCCESS!!!
    
         ' 11.08.08 test if recordset open and if so close it before disconnecting
          OBJECT GET ors.State TO vState
          iState    =  VARIANT# (vState)
          IF iState = %adStateOpen THEN
               '? "ORS RecordSet WAS OPEN at end of fetch, closing "
                 OBJECT CALL ors.Close
               ' NOTE it *WAS* open at conclusion of fetch loop.
               ' SLEEP 5000
          END IF
         ' disconnect from database (we don't get here if we don't connect).
           OBJECT CALL oConn.Close
    
      ELSE
          sErrMsg = "Could not create Connection object - ADO may be outdated or installed incorrectly"
          fv      =  %TRUE   ' error
      END IF
    
    
    AdoDBGetTableInfo_Exit:
      SET oconn    = NOTHING
      SET oRs      = NOTHING
      SET oFields  = NOTHING
      SET oField   = NOTHING
    
      FUNCTION = fv
    
    
    END FUNCTION  ' ADODBGetTableInfo
    
    
    ' ========================================================================================
    ' Returns the description of an ADO runtime error
    ' param in = OBJRESULT()
    ' This function is called by AdogetErrorinfo when the ERror object cannot be found/Created
    ' If function returns null string, it is not a recognized error and is probably a WIndows error
    ' Courtesy: Jose Roca
    ' ========================================================================================
    FUNCTION AdoGetRuntimeErrorInfo (BYVAL wError AS WORD) AS STRING
    
       LOCAL s AS STRING
    
       SELECT CASE AS LONG wError
          CASE 3000 ' &HBB8 - %adErrProviderFailed
             s = "Provider failed to perform the requested operation."
          CASE 3001 ' &HBB9 - %adErrInvalidArgument
             s = "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another."
          CASE 3002 ' &HBBA - %adErrOpeningFile
             s = "File could not be opened."
          CASE 3003 ' &HBBB - %adErrReadFile
             s = "File could not be read."
          CASE 3004 ' &HBBC - %adErrWriteFile
             s = "Write to file failed."
          CASE 3021 ' &HBCD - %adErrNoCurrentRecord
             s = "Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record."
          CASE 3219 ' &HC93 - %adErrIllegalOperation
             s = "Operation is not allowed in this context."
          CASE 3220 ' &HC94 - %adErrCantChangeProvider
             s = "Supplied provider is different from the one already in use."
          CASE 3246 ' &HCAE - %adErrInTransaction
             s = "Connection object cannot be explicitly closed while in a transaction."
          CASE 3251 ' &HCB3 - %adErrFeatureNotAvailable
             s = "Object or provider is not capable of performing requested operation."
          CASE 3265 ' &HCC1 - %adErrItemNotFound
             s = "Item cannot be found in the collection corresponding to the requested name or ordinal."
          CASE 3367 ' &HD27 - %adErrObjectInCollection
             s = "Object is already in collection. Cannot append."
          CASE 3420 ' &HD5C - %adErrObjectNotSet
             s = "Object is no longer valid."
          CASE 3421 ' &HD5D - %adErrDataConversion
             s = "Application uses a value of the wrong type for the current operation."
          CASE 3704 ' &HE78 - %adErrObjectClosed
             s = "Operation is not allowed when the object is closed. "
          CASE 3705 ' &HE79 - %adErrObjectOpen
             s = "Operation is not allowed when the object is open. "
          CASE 3706 ' &HE7A - %adErrProviderNotFound
             s = "Provider cannot be found. It may not be properly installed."
          CASE 3707 ' &HE7B - %adErrBoundToCommand
             s = "Cannot change the ActiveConnection property of a Recordset object which has a Command object as its source."
          CASE 3708 ' &HE7C - %adErrInvalidParamInfo
             s = "Parameter object is improperly defined. Inconsistent or incomplete information was provided."
          CASE 3709 ' &HE7D - %adErrInvalidConnection
             s = "The connection cannot be used to perform this operation. It is either closed or invalid in this context."
          CASE 3710 ' &HE7E - %adErrNotReentrant
             s = "Operation cannot be performed while processing event. "
          CASE 3711 ' &HE7F - %adErrStillExecuting
             s = "Operation cannot be performed while executing asynchronously."
          CASE 3712 ' &HE80 - %adErrOperationCancelled
             s = "Operation has been cancelled by the user."
          CASE 3713 ' &HE81 - %adErrStillConnecting
             s = "Operation cannot be performed while connecting aynchronously. "
          CASE 3714 ' &HE82 - %adErrInvalidTransaction
             s = "Coordinating transaction is invalid or has not started."
          CASE 3715 ' &HE83 - %adErrNotExecuting
             s = "Operation cannot be performed while not executing."
          CASE 3716 ' &HE84 - %adErrUnsafeOperation
             s = "Safety settings on this computer prohibit accessing a data source on another domain."
    '      CASE 3717 ' &HE85 - %adwrnSecurityDialog
    '         For internal use only. Don't use.
    '      CASE 3718 ' &HE86 - %adwrnSecurityDialogHeader
    '         For internal use only. Don't use.
          CASE 3719 ' &HE87 - %adErrIntegrityViolation
             s = "Data value conflicts with the integrity constraints of the field."
          CASE 3720 ' &HE88 - %adErrPermissionDenied
             s = "Insufficent permission prevents writing to the field."
          CASE 3721 ' &HE89 - %adErrDataOverflow
             s = "Data value is too large to be represented by the field data type."
          CASE 3722 ' &HE8A - %adErrSchemaViolation
             s = "Data value conflicts with the data type or constraints of the field."
          CASE 3723 ' &HE8B - %adErrSignMismatch
             s = "Conversion failed because the data value was signed and the field data type used by the provider was unsigned."
          CASE 3724 ' &HE8C - %adErrCantConvertvalue
             s = "Data value cannot be converted for reasons other than sign mismatch or data overflow. For example, conversion would have truncated data."
          CASE 3725 ' &HE8D - %adErrCantCreate
             s = "Data value cannot be set or retrieved because the field data type was unknown, or the provider had insufficient resources to perform the operation."
          CASE 3726 ' &HE8E - %adErrColumnNotOnThisRow
             s = "Record does not contain this field."
          CASE 3727 ' &HE8F - %adErrURLDoesNotExist
             s = "Either the source URL or the parent of the destination URL does not exist."
          CASE 3728 ' &HE90 - %adErrTreePermissionDenied
             s = "Permissions are insufficient to access tree or subtree. "
          CASE 3729 ' &HE91 - %adErrInvalidURL
             s = "URL contains invalid characters. Make sure the URL is typed correctly."
          CASE 3730 ' &HE92 - %adErrResourceLocked
             s = "Object represented by the specified URL is locked by one or more other processes. Wait until the process has finished and attempt the operation again."
          CASE 3731 ' &HE93 - %adErrResourceExists
             s = "Copy operation cannot be performed. Object named by destination URL already exists. Specify adCopyOverwrite to replace the object."
          CASE 3732 ' &HE94 - %adErrCannotComplete
             s = "Server cannot complete the operation."
          CASE 3733 ' &HE95 - %adErrVolumeNotFound
             s = "Provider cannot locate the storage device indicated by the URL. Make sure the URL is typed correctly."
          CASE 3734 ' &HE96 - %adErrOutOfSpace
             s = "Operation cannot be performed. Provider cannot obtain enough storage space."
          CASE 3735 ' &HE97 - %adErrResourceOutOfScope
             s = "Source or destination URL is outside the scope of the current record."
          CASE 3736 ' &HE98 - %adErrUnavailable
             s = "Operation failed to complete and the status is unavailable. The field may be unavailable or the operation was not attempted."
          CASE 3737 ' &HE99 - %adErrURLNamedRowDoesNotExist
             s = "Record named by this URL does not exist."
          CASE 3738 ' &HE9A - %adErrDelResOutOfScope
             s = "URL of the object to be deleted is outside the scope of the current record."
          CASE 3739 ' &HE9B - %adErrPropInvalidColumn
             s = "Cannot apply property to field"
          CASE 3740 ' &HE9C - %adErrPropInvalidOption
             s = "Attribute property invalid"
          CASE 3741 ' &HE9D - %adErrPropInvalidValue
             s = "Invalid property value"
          CASE 3742 ' &HE9E - %adErrPropConflicting
             s = "Property values conflict with each other"
          CASE 3743 ' &HE9F - %adErrPropNotAllSettable
             s = "Cannot set property or read-only"
          CASE 3744 ' &HEA0 - %adErrPropNotSet
             s = "Optional property value not set"
          CASE 3745 ' &HEA1 - %adErrPropNotSettable
             s = "Read-only property cannot be set"
          CASE 3746 ' &HEA2 - %adErrPropNotSupported
             s = "Property not supported by provider"
          CASE 3747 ' &HEA3 - %adErrCatalogNotSet
             s = "Operation requires a valid ParentCatalog."
          CASE 3748 ' &HEA4 - %adErrCantChangeConnection
             s = "Connection was denied. New connection you requested has different characteristics than the one already in use."
          CASE 3749 ' &HEA5 - %adErrFieldsUpdateFailed
             s = "Fields update failed. For further information, examine the Status property of individual field objects."
          CASE 3750 ' &HEA6 - %adErrDenyNotSupported
             s = "Provider does not support sharing restrictions."
          CASE 3751 ' &HEA7 - %adErrDenyTypeNotSupported
             s = "Provider does not support the requested kind of sharing restriction."
          CASE 3753 ' 3753 - %adErrProviderNotSpecified
             s = "Provider not specified"
          CASE 3754 ' &HEAA - %adErrConnectionStringTooLong
             s = "Connection string too long"
          CASE ELSE
             s =  "No description available."
    
       END SELECT
    
       FUNCTION =  USING$("_0X& &", HEX$(wError, 4), S)
    
    END FUNCTION
    
    ' --------------------------------------------
    ' This function I can conditionally test
    ' based on compiler version.
    ' --------------------------------------------
    FUNCTION ADOGetIDispInfoErrorText () AS  STRING
    ' called on DISP_E_EXCEPTION, but only used when we cannot get
    ' the "regular" Errors object.
    
      LOCAL S AS STRING
      LOCAL w AS STRING
    
      W = FORMAT$(IDISPINFO.CODE)
      S = USING$ ("DispInfo Code '&'", w)
      W = FORMAT$(IDISPINFO.CONTEXT)
      S = s & $CRLF & USING$ ("DispInfo Context '&'", w)
      W =  IDISPINFO.DESC$
      S = s & $CRLF & USING$ ("DispInfo Description '&'", W)
      W =  IDISPINFO.HELP$
      S = s & $CRLF & USING$ ("DispInfo Help(file) '&'", w)
      W = IDISPINFO.SOURCE$
      S = s & $CRLF & USING$ ("DispInfo Source'&'", W)
      S = s & $CRLF & "End of IDISPINFO error messages for DISP_E_EXCEPTION"
    
      FUNCTION = S
    
    END FUNCTION
    
    ' /// END OF FILE
    New Demo File

    Command file is ONLY looking for a connect string, or will use the $CONNECT_DEFAULT constant if not provided
    Code:
    ' ADOCATALOG.BAS
    ' Test/Demonstration of using the catalog functions available via ADO
    ' Date: 11-14-08
    ' 11-15-08      Start; copied ADODEMO2.BAS to this and modifiy
    ' Author: Michael Mattias Racine WI
    ' Use and Distrubution: PLaced in public domain by author 11/5/08.
    ' Thanks to: Fred Harris for starter ADO program. Jose Roca for tips re using new IDISPINFO object
    ' Compilers: PB/CC version 5 or PB/WIn 9. Compiles and runs on either 'as is'
    ' USAGE from command line:
    '    C:\> Start  adodemo.exe commandfilename
    ' Program edits commandfilename for the strings CONNECT= then executes the function "ADoDBGetTableInfo"
    '  which returns a filled dynamic string array.
    ' =========================================
    ' USEFUL/COMMON OLEDB Connection strings;
    ' Oracle: Provider=ORAOLEDB.Oracle;Data Source=<service name>;User ID=Xxxxxx;Password=xxxxx
    ' Jet/Access:Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Testdata\ptmn\db\jet\ptmn.mdb;User Id=admin;Password=;
    ' MS EXCEL LProvider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyExcel.xls;Extended Properties="Excel 8.0;HDR=Yes;IMEX=1";
    '
    ' Others: [url]http://www.connectionstrings.com[/url]
    ' See supplied test file "acommand.txt"
    ' ===============================================
    
    
    #COMPILE  EXE
    #COMPILER PBCC 5, PBWIN 9
    #DIM      ALL
    #TOOLS    OFF
    ' #DEBUG not on here, as I want a GPF immediately if I am corrupting memory.
    
    #INCLUDE "ADOTABLES.INC"
    '  this will incude #INCLUDE   "ADODB28DISP.INC"  ' regenerated with CC5 com browser "dispatch only"
    ' has to go this way due to the way some MACROs are generated by COM browser.
    
    #IF NOT %DEF(%VT_DECIMAL)
      %VT_DECIMAL = 14
    #ENDIF
    #IF NOT %DEF (%WINAPI)
       #INCLUDE   "Win32Api.inc"
    #ENDIF
    
    ' where progress info and data from select are deposited. FIle is opened with NOtePad at end.
    $RESULT_FILE     =  "ADOCATALOG.TXT"
    $CONNECT_DEFAULT = "Provider=ORAOLEDB.Oracle;Data Source=XE;User ID=prod;Password=prod"
    '$CONNECT_DEFAULT = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Testdata\ptmn\db\jet\ptmn.mdb;User Id=admin;Password=;"
    
    FUNCTION PBMAIN() AS LONG
    
        LOCAL sCmdFile AS STRING
        LOCAL sBuff AS STRING, sKEy AS STRING
        LOCAL sConnect AS STRING, sQuery AS STRING
        LOCAL hIn     AS LONG, iPos AS LONG
        LOCAL sRow() AS STRING, nRow AS LONG, nCol AS LONG, iRow AS LONG, iCol AS LONG
        LOCAL sErrMsg AS STRING
        LOCAL sResultFile AS STRING,hResult AS LONG
        LOCAL iRet AS LONG
        LOCAL bInBlock AS LONG, Z AS LONG
        LOCAL iUseError AS LONG
    
        sResultFile =  $RESULT_FILE
    
        sCMDFile = TRIM$(COMMAND$)
        bINblock = %FALSE
    
        IF DIR$(sCmdFile) > "" THEN
            hIN =   FREEFILE
            OPEN    sCmdFile  FOR INPUT AS hIn
            WHILE NOT EOF(hIN)
                LINE INPUT #hIn, sBUFF
                IF UCASE$(LEFT$(TRIM$(sBuff),8)) = "CONNECT=" THEN
                       sCOnnect = MID$(sBUff, 9)
                END IF
            WEND
            CLOSE hIn
        ELSE
           ? USING$("Command file '&' not found using default", sCmdFile)
           sConnect = $CONNECT_DEFAULT
        END IF
    
        IF LEN(sConnect) = 0 THEN
          ? "No 'CONNECT=' record found in command file"
          iUseError = %TRUE    ' error
          GOTO WinMainExit
        END IF
    
        ' ------------------------
        ' START RESULT FILE HERE
        ' ------------------------
        hResult = FREEFILE
        OPEN      sResultFile FOR OUTPUT AS hResult
        PRINT #hResult, USING$ ("ADO Demo (tables) begins at & on &", TIME$, DATE$)
        PRINT #hResult, USING$ ("Connection string '&'", sConnect)
    
        PRINT #hResult,
        ' -------------------------------------
        ' Create array to hold query results
        ' ------------------------------------
        REDIM  sRow(0,0)
        ' ---
        ' first run... returns 6221 rows. I want to limit TABLE_TYPE to TABLE and VIEW
        ' I want to limit SCHEMA  to the user ID
        ' I think I will want to pass an array of somethings
        ' to the function limiting same
        ' BUt first I have to figure out how to limit the return
        ' what is a variant structure? Build my own array to test?
    
    
        CALL AdoDbGetTableInfo (BYVAL STRPTR(sConnect),sRow(), sErrMsg) TO iRet
    
        PRINT #hResult, USING$ ( "AdoDbGetTableInfo returns # &", iRet, IIF$(iRet, "ERROR", "SUCCESS"))
    
    
        IF ISTRUE iRet THEN
             PRINT #hResult, "ERROR MESSAGE:" & sErrMsg
    
    
        ELSE
             ncol = UBOUND(sRow,1)
             nRow = UBOUND(sRow,2)
             PRINT #hResult, USING$ ("QUery returned # columns and # rows", nCol, nRow)
             PRINT #hResult,
             PRINT #hResult, "COLUMN NAMES"
             FOR iCol = 1 TO nCol
                  PRINT #hResult, sRow(iCol, 0);
                  IF icol <> nCol THEN
                       PRINT #hResult, ",";
                  END IF
             NEXT
             PRINT #hresult,
    
             ' ---------------------------------------
             ' now show data, comma separated
             ' ---------------------------------------
             FOR iRow = 1 TO nRow
                  PRINT #hResult,
                  FOR iCol = 1 TO nCol
                       PRINT #hResult, sRow (iCol, iRow);
                       IF iCol <> nCol THEN
                            PRINT #hResult, ",";
                       END IF
                  NEXT
             NEXT
             PRINT #hResult,
    
       END IF
    
       PRINT #hResult, "** END OF REPORT **"
       CLOSE hREsult
    
    
    
       Z= SHELL ("Notepad.exe " & sResultFile)
    
    
    WinMainExit:
    ' if PB/CC and error, hold screen
     #IF %DEF(%PB_CC32)
       IF ISTRUE iUseError THEN
          STDOUT  "Command line or command file error occurred; press any key to exit"
          WAITKEY$
       END IF
    #ENDIF
      FUNCTION = iRet
    
    END FUNCTION
    
    
    '' ///  *** END OF FILE *****
    Library file ADODB28DISP.INC COM interface
    Same as other one, get it here: http://www.powerbasic.com/support/pb...ad.php?t=39036
    Last edited by Michael Mattias; 17 Nov 2008, 06:00 PM.
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    See: http://www.jose.it-berater.org/smffo...p?topic=2591.0

    Tip: Instead of an array of strings (sCriteria), you must use an array of variants, because an empty (VT_EMPTY) variant is not the same that a variant holding an empty string.
    Last edited by José Roca; 17 Nov 2008, 07:01 PM.
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #3
      Perfect, Jose. Thank you very much.

      Weird thing: it wants UPPERCASE "PROD" (for schema) or "VIEW" (for table type).

      Runs without error but finds nothing if these words are not upper-cased.

      BUT..... if I run OpenSchema with %adSchemaSchemata first, I get a list of all the TABLES_SCHEMAs in the DB .... so I could compare case after doing that and then do the tables query using the correctly-cased TABLE_SCHEMA (Hello "ARRAY SCAN COLLATE UCASE"...)

      FWIW, W3Schools has got some terrific info and examples on-line

      For this method, here's the link: http://www.w3schools.com/ado/met_conn_openschema.asp


      MCM
      Michael Mattias
      Tal Systems (retired)
      Port Washington WI USA
      [email protected]
      http://www.talsystems.com

      Comment

      Working...
      X