Announcement

**Michael Mattias** · 6 Nov 2008, 09:35 AM

Updates 11/6/08

Demo program: cleaned up comments. Added Public Domain Statement

ADOEXECTUTESELECT: Fixed bug in retrieval of column names. Added explicit handing of type VT_BOOL in fetch loop to returns "0" or "1" (NOT TESTED); cleaned up comments; added public domain statement. Add time to returned date when VT_DATE but only if time included in what is returned.

MCM

**Michael Mattias** · 8 Nov 2008, 12:05 PM

CHANGES/UPDATES 11/8/08

11/10/08: Change comment re USING$ from "compiler bug" to "documented limitation missed by author."

ADOEXECUTESELECT.INC.
Test oRS recordset state at end of fetch loop and if open, close it.
(It WAS open at end of succesful fetch loop).

New Demo Program ADODEMO2

Recompiled with new ADOEXECUTESELECT.INC file (just to test, obviously does not apply to Source Code posting)
Does not hold console open or provide terminating MSGBOX at end except when parameter error when compiled with PB/CC
Don't use USING$ function to print query report file, as the string returned by USING$ is documented as limited to 1024 bytes. [Had previously commented that this was a bug in compiler]
New syntax for query in command file. Instead of 'QUERY=string' on one line, uses a BEGINQUERY/ENDQUERY block structure:
Code:
```
BEGINQUERY
         select X, 
                Y, 
                Z, 
                A, 
                B, 
                C, 
       from     t1, 
                t2
       where    whatever
       group by something
       order by  something
ENDQUERY
```
Have not yet found a DBMS which does not handle the resulting white space in the passed query string, Tested OK so far: Access/Jet, Oracle 10g/ORAOLEDB, Oracle 8i/MSDAORA, Microsoft SQL Server/sqloledb.

THE #INCLUDE file ADOExecuteSelect.INC is changed in post #1

The new demo program is here.

MCM
UPDATED DEMO PROGRAM

Code:

' ADODEMO2.BAS
' Demonstration of "generic" "SELECT " SQL statement use of function "ADOExecuteSelect"
' Date: 11-02-08
' 11-05-08      clean up comments; changes to ADOEXECUTESELECT.INC
'               Fix bug in adoexecuteselect in column names.
' 11/07/08      Change front end: instead of QUERY=  we use a block structiure
'               BEGINQUERY   on its own line
'                query lines here
'               ENDQUERY     on its own line.
'               QUery can can have whitespace and newline; the DBMS is responsible for sorting this out.
' 11/08/08      DOn't print query with USING$ function to workaround bug in PB/CC 5.0
'               Test for recordset open in #INCLUDE file and call close method if necessary.
'               NEEDS TO BE RENAMED and versioned.

' 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 QUERY= and CONNECT=, then executes the function "ADoExecuteSelect"
'  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: http://www.connectionstrings.com
' 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 "ADOEXECUTESELECT.INC" ' file created just for this demo
'  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  =  "ADODEMO_LOG.TXT"

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$(TRIM$(sBuff)) = "BEGINQUERY" THEN
                 bINbLock = %TRUE
                 sQUery   = ""  ' reset
            ELSEIF UCASE$(TRIM$(sBuff)) = "ENDQUERY" THEN
                 bINblock = %FALSE
            ELSEIF UCASE$(LEFT$(TRIM$(sBuff),8)) = "CONNECT=" THEN
                   sCOnnect = MID$(sBUff, 9)
            ELSE
                 IF ISTRUE bInBlock THEN
                      sQuery = sQuery & $CRLF & sBUff
                 END IF
            END IF
        WEND
        CLOSE hIn
    ELSE
       ? USING$("Command file '&' not found", sCmdFile)
       iUseError = %TRUE
       GOTO  WinMainExit
    END IF

    IF LEN(sConnect) = 0 THEN
      ? "No 'CONNECT=' record found in command file"
      iUseError = %TRUE    ' error
      GOTO WinMainExit
    END IF

    IF LEN(sQuery) = 0 THEN
      ? "No 'BEGINQUERY/ENDQUERY Text 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 begins at & on &", TIME$, DATE$)
    PRINT #hResult, USING$ ("Connection string '&'", sConnect)
    ' test 11/7/08 long queries are getting truncated
    ' COMPILER BUG!!!! FOUND 11/7/08, PRints all of the query  f we don't use USING$ function
    
    PRINT# hResult, "Query:"
    
    ' PRINT #hResult, "Query PRINTED 'AS STRING' starts next line"
    PRINT #hResult, sQuery
    'PRINT #hResult, "Query PRINTED with USING$ function starts next line"
    'PRINT #hResult, USING$ ("Query '&'", sQuery)
    ' something is cutting off the end of this query when printing here, but not when when sending to function?
    ' limited to some length? Need to test here too hard to test at cloyes.
    PRINT #hResult,


    ' -------------------------------------
    ' Create array to hold query results
    ' ------------------------------------
    REDIM  sRow(0,0)

    CALL AdoExecuteSelect (BYVAL STRPTR(sConnect), BYVAL STRPTR(sQuery), sRow(), sErrMsg) TO iRet

    PRINT #hResult, USING$ ( "AdoExecuteSelect 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 *****

**Michael Mattias** · 28 Nov 2008, 02:08 PM

UPDATES 11-28-08

Since you can't edit a post this old, best I can do here is give you the changes:

Add support for Microsoft Sql Server 'nVarChar' fields.
These are returned by ADO 2.7/2.8 as VARIANTVT value (%VT_ARRAY OR %VT_UI1) (8209 decimal or hex 0x2011)

1. Add these DECLARE statements (Anywhere, ADOEXECUTESELECT.INC suggested)

Code:

DECLARE FUNCTION SafeArrayGetDim     LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetDim"     (BYVAL psa AS DWORD) AS DWORD
DECLARE FUNCTION SafeArrayGetElement LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetElement" (BYVAL psa AS DWORD, rgIndices AS LONG, pData AS ANY) AS LONG
DECLARE FUNCTION SafeArrayGetLBound  LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetLBound"  (BYVAL psa AS DWORD, BYVAL nDim AS WORD, lbDim AS LONG) AS LONG
DECLARE FUNCTION SafeArrayGetUBound  LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetUBound"  (BYVAL psa AS DWORD, BYVAL nDim AS WORD, ubDim AS LONG) AS LONG

Or simply #INCLUDE PowerBasic-Provided "VBAPI32.INC"

2. Those declares support this function which can be #INCLUDEd or pasted into (anywhere, ADOEXECUTESELECT.INC suggested)

Code:

'-----------------------------------------------------------------------
' GET SQL Server 'nVarChar' field when returned 
' Returned by ADO as (VT_ARRAY|VT_UI1) (8209 decimal, 0x2011) 
' V assumed to have type VT_ARRAY|VT_UI1 or VT_ARRAY|VT_I1  (Byte array)
' -----------------------------------------------------------------------

FUNCTION GetVTByteArrayAsString (v AS VARIANT) AS STRING

 LOCAL nDim AS LONG

 LOCAL pV  AS VARIANTAPI PTR
 LOCAL lb AS LONG, ub AS LONG
 LOCAL pSA   AS DWORD
 LOCAL  iRet AS LONG
 LOCAL B AS STRING , i AS LONG
 LOCAL pb AS BYTE PTR


 pV     =    VARPTR (v)    ' pointer to VARIANTAPI structure

 ' get pointer to the safearray descriptor
   pSA  =  @pV.VD.psArray      ' the variant data are a pointer to the safearray descriptor
 ' get the lbound and ubound
 ' should return S_OK (0) on success.It  does 
   iRet = SafeArrayGetLbound(BYVAL pSA, 1, lb)
   iRet = SafeArrayGEtUbound (BYVAL pSA, 1, ub)
  ' could verify element size as 1 here... wuth SafeArrayGetElemSize.. except
  ' we already know its one because it's type "UI1"
  ' initialize a buffer full of nuls to hold the characters:
   B  =  STRING$ (ub-lb+1, 0)
'  set the initial destination for the array element data
   pB   =  STRPTR(B)
   FOR   i = LB TO UB    ' for each element of the array
      iRet= SafeArrayGetElement (BYVAL pSa, i, BYVAL pb)  ' deposit element at address 'pb'
      ' success = S_OK
      INCR  pb  ' set up so next element goes at next position.
   NEXT

   FUNCTION = B   ' return the filled string
END FUNCTION

3. In ADOEXECUTESELECT.INC, add the new highlighted code (labels optional) at the indicated point:

Code:

...
         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)
NEWCODE:
                CASE (%VT_ARRAY OR %VT_UI1), ( %VT_ARRAY OR %VT_I1)

                     sValue =GetVtBYteArrayAsString (vValue) 

ENDNEWCODE:
                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.
.....

MCM

**José Roca** · 28 Nov 2008, 06:29 PM

' initialize a buffer full of nuls to hold the characters:
B = STRING$ (ub-lb+1, 0)
' set the initial destination for the array element data
pB = STRPTR(B)
FOR i = LB TO UB ' for each element of the array
iRet= SafeArrayGetElement (BYVAL pSa, i, BYVAL pb) ' deposit element at address 'pb'
' success = S_OK
INCR pb ' set up so next element goes at next position.
NEXT

This should be faster:

Code:

LOCAL pData AS DWORD
' Lock the safearray for access
SafeArrayAccessData(pSa, pData)
IF pData THEN
   ' Read the data
   B = PEEK$(pData, ub-lb+1)  ' Or use CopyMemory
   ' Unlock the array
   SafeArrayUnaccessData(pSa)
END IF

**Michael Mattias** · 29 Nov 2008, 10:39 AM

"First you make it work. Only then do you make it work better. "

Whoever said that surely was wise.

**José Roca** · 29 Nov 2008, 08:23 PM

My apologies for trying to help you. Won't do it again.

**Anthony Giambalvo** · 1 Dec 2008, 11:37 AM

Ok, it's Monday morning and I am still a bit foggy, but where are SafeArrayAccessData() and SafeArrayUnaccessData() declared?

**Anthony Giambalvo** · 1 Dec 2008, 11:48 AM

Never mind. Again the fog has not yet cleared. Found the MSDN link here: http://msdn.microsoft.com/library/de...chap7_1rvp.asp

Also, Jose generously converted this for us already at: http://www.powerbasic.com/support/pb...d.php?p=146936

Thanks Michael and Jose.

**Michael Mattias** · 1 Dec 2008, 12:52 PM

Wrong forum I know but...

For the record, I do not create demos for 'maximum speed.'

My two guiding principles are
1. Maximum usabillity - so it's easy to compile and 'see what it does'
2. Maximum understandability - so it's easy to learn from, modify, and apply to a specific application.

That alternate code might be faster is a conscious decision I make when putting these things together, and it is a price I am willing to pay.

MCM

**Andy Flowers** · 5 Dec 2008, 06:42 PM

Looking for the latest version of Jose ADO.Inc

Jose if you are monitoring this forum. I am lookin for the latest version of your ADO.Inc file. Is it available?

I was on you site today trying to run some of your exampls but I do not have your latest ADO.inc file.

**Marcel Kollenaar** · 15 Aug 2009, 06:37 PM

Originally posted by Michael Mattias View Post

"First you make it work. Only then do you make it work better. "

Whoever said that surely was wise.

A "Thank you, yes indeed." would be more constructive [...]. It looks if members has to wear silk gloves when helping each other.

**Michael Mattias** · 15 Dec 2009, 03:53 PM

12/15/09 BUG FIX
For file ADOExecuteSelect.inc

Code:

' 11.25.09       When returning value of select in either select or in RecordSetToStringArray, do not 'movefirst'
'                if already at EOF (query succeeded but returned no rows).

Since I can't edit the code, Here is what you have to do in the fetch loop in ADOExecuteSelect.inc:

Instead of:

Code:

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

You need to:

Code:

      ' -----------------------------------------------------
      ' now we get the actual returned datarows
      ' ------------------------------------------------------
      nRow     = 0                       ' Number of DATA rows (the sRow() row subscript) we read
      OBJECT GET oRs.EOF  TO vEOF        ' must test for EOF BEFORE doing oRS.MoveFirst to avoid ERR 99
      IF ISFALSE VARIANT#(vEof) THEN
           OBJECT CALL oRS.MoveFirst          ' position the cursor
      END IF
      DO                                 ' perform FETCH loop
         OBJECT GET oRs.EOF  TO vEOF
         IF ISTRUE VARIANT#(vEof) THEN
           ' Exit the fetch loop
             EXIT DO
         END IF
         ....

You can restructure the loop to make one less "GET" of oRs.EOF if you want.

If you do the MoveFirst when at end (e.g. when query succeeds but returns zero rows) , you get an exception and "error 99 object error" is set.

MCM

Announcement

Forum Guidelines

Generic 'ADO' Connection and Query Tester

PBWin/PBCC Generic 'ADO' Connection and Query Tester

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment