Tweet
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
When I call the OpenSchema at WITHOUT_CRITERA I get success.. the report file starts out like this:
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...
... and the "VB Example" provided is:
So I tried this:
.. 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"
New Demo File
Command file is ONLY looking for a connect string, or will use the $CONNECT_DEFAULT constant if not provided
Library file ADODB28DISP.INC COM interface
Same as other one, get it here: http://www.powerbasic.com/support/pb...ad.php?t=39036
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 ...
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...
... 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
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
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 *****
Same as other one, get it here: http://www.powerbasic.com/support/pb...ad.php?t=39036
Comment