2002-07-02 19:07

     $APPTYPE CONSOLE

'ODBC - Open DataBase Connectivity
'Basic Steps
'Connecting to the SQL Server DataBase for retrieving information from tables

' ODBC Variables and Constants
     CONST MAX_DATA_BUFFER = 255
     CONST SQL_SUCCESS = 0
     CONST SQL_SUCCESS_WITH_INFO = 1
     CONST SQL_ERROR = -1
     CONST SQL_NO_DATA_FOUND = 100
     CONST SQL_CLOSE = 0
     CONST SQL_DROP = 1
     CONST SQL_CHAR = 1
     CONST SQL_NUMERIC = 2
     CONST SQL_DECIMAL = 3
     CONST SQL_INTEGER = 4
     CONST SQL_SMALLINT = 5
     CONST SQL_FLOAT = 6
     CONST SQL_REAL = 7
     CONST SQL_DOUBLE = 8
     CONST SQL_VARCHAR = 12
     CONST SQL_DATA_SOURCE_NAME = 6
     CONST SQL_USER_NAME = 8

'ODBC Declarations
     DECLARE FUNCTION SQLAllocEnv LIB "odbc32.dll" ALIAS "SQLAllocEnv"(env AS LONG) AS SHORT
     DECLARE FUNCTION SQLFreeEnv LIB "odbc32.dll" ALIAS "SQLFreeEnv"(BYVAL env AS LONG) AS SHORT
     DECLARE FUNCTION SQLAllocConnect LIB "odbc32.dll" ALIAS "SQLAllocConnect"(BYVAL env AS LONG, ldbc AS LONG) AS SHORT
     DECLARE FUNCTION SQLConnect LIB "odbc32.dll" ALIAS "SQLConnect"(BYVAL ldbc AS LONG, BYVAL Server AS STRING, BYVAL serverlen AS INTEGER, BYVAL uid AS STRING, BYVAL uidlen AS INTEGER, BYVAL pwd AS STRING, BYVAL pwdlen AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLDriverConnect LIB "odbc32.dll" ALIAS "SQLDriverConnect"(BYVAL ldbc AS LONG, BYVAL hWnd AS LONG, BYVAL szCSIn AS LONG, BYVAL cbCSIn AS INTEGER, BYVAL szCSOut AS LONG, BYVAL cbCSMax AS INTEGER, cbCSOut AS LONG, BYVAL f AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLFreeConnect LIB "odbc32.dll" ALIAS "SQLFreeConnect"(BYVAL ldbc AS LONG) AS SHORT
     DECLARE FUNCTION SQLDisconnect LIB "odbc32.dll" ALIAS "SQLDisconnect"(BYVAL ldbc AS LONG) AS SHORT
     DECLARE FUNCTION SQLAllocStmt LIB "odbc32.dll" ALIAS "SQLAllocStmt"(BYVAL ldbc AS LONG, lStmt AS LONG) AS SHORT
     DECLARE FUNCTION SQLFreeStmt LIB "odbc32.dll" ALIAS "SQLFreeStmt"(BYVAL lStmt AS LONG, BYVAL EndOption AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLTables LIB "odbc32.dll" ALIAS "SQLTables"(BYVAL lStmt AS LONG, BYVAL q AS LONG, BYVAL cbq AS INTEGER, BYVAL o AS LONG, BYVAL cbo AS INTEGER, BYVAL t AS LONG, BYVAL cbt AS INTEGER, BYVAL tt AS LONG, BYVAL cbtt AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLExecDirect LIB "odbc32.dll" ALIAS "SQLExecDirect"(BYVAL lStmt AS LONG, BYVAL sqlString AS LONG, BYVAL sqlstrlen AS LONG) AS SHORT
     DECLARE FUNCTION SQLNumResultCols LIB "odbc32.dll" ALIAS "SQLNumResultCols"(BYVAL lStmt AS LONG, NumCols AS LONG) AS SHORT
     DECLARE FUNCTION SQLDescribeCol LIB "odbc32.dll" ALIAS "SQLDescribeCol"(BYVAL lStmt AS LONG, BYVAL colnum AS INTEGER, BYVAL colname AS LONG, BYVAL Buflen AS INTEGER, colnamelen AS INTEGER, dtype AS INTEGER, dl AS LONG, ds AS INTEGER, n AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLFetch LIB "odbc32.dll" ALIAS "SQLFetch"(BYVAL lStmt AS LONG) AS SHORT
     DECLARE FUNCTION SQLGetData LIB "odbc32.dll" ALIAS "SQLGetData"(BYVAL lStmt AS LONG, BYVAL col AS INTEGER, BYVAL wConvType AS INTEGER, BYVAL lpbBuf AS LONG, BYVAL dwbuflen AS LONG, lpcbout AS LONG) AS SHORT
     DECLARE FUNCTION SQLGetInfo LIB "odbc32.dll" ALIAS "SQLGetInfo"(BYVAL ldbc AS LONG, BYVAL hWnd AS LONG, BYVAL szInfo AS STRING, BYVAL cbInfoMax AS INTEGER, cbInfoOut AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLError LIB "odbc32.dll" ALIAS "SQLError"(BYVAL env AS LONG, BYVAL ldbc AS LONG, BYVAL lStmt AS LONG, BYVAL SQLState AS LONG, NativeError AS LONG, BYVAL Buffer AS LONG, BYVAL Buflen AS INTEGER, Outlen AS INTEGER) AS SHORT
     DECLARE FUNCTION SQLCloseCursor LIB "odbc32.dll" ALIAS "SQLCloseCursor"(BYVAL lStmt AS LONG) AS SHORT
     DECLARE FUNCTION SQLDrivers LIB "odbc32.dll" ALIAS "SQLDrivers"(BYVAL env AS LONG, BYVAL dir AS INTEGER, BYVAL descrip AS LONG, BYVAL bflen AS INTEGER, descriplen AS INTEGER, BYVAL attrib AS LONG, BYVAL bfattrlen AS INTEGER, attriblen AS INTEGER) AS SHORT

     TYPE qODBC EXTENDS QOBJECT

      glEnv AS LONG
      glDbc AS LONG
      glStmt AS LONG
      sSQL AS STRING
      SQLRet AS SHORT
      sConnect AS STRING
      DriverCount AS INTEGER
      Driver(100) AS STRING
      TableCount AS INTEGER
      Table(100) AS STRING
      FieldCount AS INTEGER
      Field.Name(100) AS STRING
      Field.TypeNum(100) AS INTEGER
      Field.TypeStr(100) AS STRING
      Field.Size(100) AS INTEGER
      Field.DecDigits(100) AS INTEGER
      Field.Nullav(100) AS INTEGER
      Field.DATA(100) AS STRING


      SUB ODBCInit
       DIM iStatus AS SHORT

  '1. Allocate ODBC Environment Handle
       SQLRet = SQLAllocEnv(VARPTR(qODBC.glEnv))
       IF SQLRet <> SQL_SUCCESS THEN
        MESSAGEBOX("Unable to initialize ODBC API drivers!", "Error", 0)
       ELSE
   '2. Allocate ODBC Database Handle
        SQLRet=SQLAllocConnect(qODBC.glEnv, VARPTR(qODBC.glDbc))
        IF SQLRet<> SQL_SUCCESS THEN
         MESSAGEBOX("Could not allocate memory for connection Handle!", "Error", 0)
     ' Free the Environment
         iStatus = SQLFreeEnv(qODBC.glEnv)
         IF iStatus = SQL_ERROR THEN
          MESSAGEBOX("Error Freeing Environment From ODBC Drivers", "Error", 0)
         END IF
        ELSE
     '2.1 Get Drivers
         DIM dir AS INTEGER
         DIM descrip AS STRING * MAX_DATA_BUFFER
         DIM descriplen AS INTEGER
         DIM attrib AS STRING * MAX_DATA_BUFFER
         DIM attriblen AS INTEGER

         dir=2'First
         SQLRet=0
         qODBC.DriverCount=0
         WHILE SQLRet=SQL_SUCCESS
          IF SQLRet=SQL_SUCCESS THEN qODBC.DriverCount++
          SQLRet=SQLDrivers(qODBC.glEnv, dir, VARPTR(descrip),MAX_DATA_BUFFER, VARPTR(descriplen), VARPTR(attrib), MAX_DATA_BUFFER, VARPTR(attriblen))
          dir =1'Next
          qODBC.Driver(qODBC.DriverCount)=LEFT$(descrip,descriplen)
         WEND
        END IF
       END IF
      END SUB

      SUB Connect (sConn AS STRING)
       qODBC.sConnect=sConn
  'Connect using the sConnect string - SQLDriverConnect
       DIM sResult AS STRING * 256
       DIM iSize AS INTEGER

       SQLRet = SQLDriverConnect(qODBC.glDbc, 0&, VARPTR(qODBC.sConnect), LEN(qODBC.sConnect), VARPTR(sResult), 255, VARPTR(iSize), 1)
       IF SQLRet < 0 THEN
        MESSAGEBOX("Could not establish connection to ODBC driver!", "Error", 0)
       ELSE
    '4. Allocate ODBC Statement Handle
        SQLRet=SQLAllocStmt(qODBC.glDbc, VARPTR(qODBC.glStmt))
        IF SQLRet<> SQL_SUCCESS THEN
         MESSAGEBOX("Could not allocate memory for a statement handle!", "Error", 0)
        ELSE
     '4.1 Get tables
         DIM tPerform AS LONG
         DIM catalog AS STRING * 0
         DIM schema AS STRING * 0
         DIM tablename AS STRING * 0
         DIM tabletype AS STRING * 5
         DIM iTable AS INTEGER
         DIM tData AS STRING * MAX_DATA_BUFFER
         DIM tOutLen AS LONG

         qODBC.TableCount=0
         tabletype="TABLE"
         SQLRet=SQLTables(qODBC.glStmt, VARPTR(catalog), 0, VARPTR(schema),0, VARPTR(tablename),0, VARPTR(tabletype),5)
         IF SQLRet<> SQL_SUCCESS THEN
          MESSAGEBOX("Could not get Tables!", "Error", 0)
         ELSE
          tPerform = SQL_SUCCESS
          WHILE tPerform = SQL_SUCCESS
           tPerform = SQLFetch(qODBC.glStmt)		' Get the next row of data
           IF tPerform = 65535 OR tPerform = SQL_ERROR THEN
            EXIT WHILE
           ELSE
            IF tPerform = SQL_SUCCESS OR tPerform = SQL_SUCCESS_WITH_INFO THEN
             qODBC.TableCount++
             FOR iTable = 1 TO 3
              iStatus = SQLGetData(qODBC.glStmt, iTable, 1, VARPTR(tData), MAX_DATA_BUFFER, VARPTR(tOutLen))
             NEXT
             qODBC.Table(qODBC.TableCount) = LEFT$(tData, tOutlen) ' tOutlen = -1 if no data or Null data
            END IF
           END IF
          WEND
      'close cursor of tables query
          tPerform = SQLCloseCursor(qODBC.glStmt)
         END IF
        END IF
       END IF
      END SUB

      SUB Query(sSQL AS STRING)
  '5. Execute ODBC Statement - SQLExecDirect
       qODBC.sSQL=sSQL
       DIM lRet AS LONG, lErrNo AS LONG
       DIM iLen AS INTEGER
       DIM sSQLState AS STRING * MAX_DATA_BUFFER
       DIM sErrorMsg AS STRING * MAX_DATA_BUFFER
       DIM sMsg AS STRING


       qODBC.SQLRet=SQLExecDirect(qODBC.glStmt, VARPTR(qODBC.sSQL), LEN(qODBC.sSQL))
       IF qODBC.SQLRet <> SQL_SUCCESS AND qODBC.SQLRet <> SQL_SUCCESS_WITH_INFO THEN
        'Also Check for ODBC Error message - SQLError
        lRet = SQLError(glEnv, gldbc, glStmt, VARPTR(sSQLState), VARPTR(lErrNo), VARPTR(sErrorMsg), MAX_DATA_BUFFER, VARPTR(iLen))
        sMsg = "Error Executing SQL Statement" & CHR$(13) & CHR$(10)
        sMsg = sMsg & "ODBC State = " & Trim$(LEFT$(sSQLState, INSTR(sSQLState, CHR$(0)) - 1)) & CHR$(13) & CHR$(10)
        sMsg = sMsg & "ODBC Error Message = " & LEFT$(sErrorMsg, iLen)
        MESSAGEBOX(sMsg, "Error", 0)
       END IF

       DIM bPerform AS LONG
       DIM NumCols AS INTEGER

    'Get number of columns
       bPerform = SQLNumResultCols (qODBC.glStmt, VARPTR(NumCols))
       IF bPerform <> SQL_SUCCESS THEN
        MESSAGEBOX("Could not get columns quantity!", "Error", 0)
        END
       ELSE
        qODBC.FieldCount= NumCols
       END IF

    'Get column descriptor
       DIM icolnum AS INTEGER
       DIM colname AS STRING * MAX_DATA_BUFFER
       DIM colnamelen AS INTEGER
       DIM dtype AS INTEGER
       DIM colsize AS LONG
       DIM decdigits AS INTEGER
       DIM nullav AS INTEGER

       FOR icolnum = 1 TO qODBC.FieldCount
        bPerform = SQLDescribeCol(qODBC.glStmt, icolnum, VARPTR(colname), MAX_DATA_BUFFER, VARPTR(colnamelen), VARPTR(dtype), VARPTR(colsize), VARPTR(decdigits), VARPTR(nullav))
        IF bPerform <> SQL_SUCCESS THEN
         MESSAGEBOX("Could not get column descriptor!", "Error", 0)
        ELSE
         SELECT CASE dtype
         CASE 1
          tipo$= "CHAR"
         CASE 2
          tipo$=" NUMERIC"
         CASE 3
          tipo$="DECIMAL"
         CASE 4
          tipo$="INTEGER"
         CASE 5
          tipo$="SMALLINT"
         CASE 6
          tipo$="FLOAT"
         CASE 7
          tipo$="REAL"
         CASE 8
          tipo$="DOUBLE"
         CASE 9
          tipo$="DATE"
         CASE 10
          tipo$="TIME"
         CASE 11
          tipo$="TIMESTAMP"
         CASE 12
          tipo$="VARCHAR"
         CASE 65535
          tipo$="LONGVARCHAR"
         CASE 65534
          tipo$="BINARY"
         CASE 65533
          tipo$="VARBINARY"
         CASE 65532
          tipo$="LONGVARBINARY"
         CASE 65531
          tipo$="BIGINT"
         CASE 65530
          tipo$="TINYINT"
         CASE 65529
          tipo$="BIT"
         CASE 65456
          tipo$="TYPE_DRIVER_START"
         CASE ELSE
          tipo$="UNKNOWN TYPE"
         END SELECT
         qODBC.Field.Name(icolnum)=LEFT$(colname,colnamelen)
         qODBC.Field.TypeNum(icolnum)=dtype
         qODBC.Field.TypeStr(icolnum)=tipo$
         qODBC.Field.TypeNum(icolnum)=dtype
         qODBC.Field.Size(icolnum)=colsize
         qODBC.Field.DecDigits(icolnum)=decdigits
         qODBC.Field.Nullav(icolnum)=nullav
        END IF
       NEXT
      END SUB

      SUB CloseQuery
    'Close cursor of query
       bPerform = SQLCloseCursor(qODBC.glStmt)
      END SUB

      FUNCTION GetRecord AS INTEGER
   '6. Fetch one row of results from executed ODBC Statement - SQLFetch
    'Code in Step 7.

    '7. Get the Data in each field of the Fetched row - SQLGetData

       DIM bPerform AS LONG
       DIM iColumn AS INTEGER
       DIM sData AS STRING * MAX_DATA_BUFFER
       DIM lOutLen AS LONG
       DIM campo AS STRING
       DIM iStatus AS LONG

       bPerform = SQLFetch(qODBC.glStmt)		' Get the next row of data
       IF bPerform = 65535 OR bPerform = SQL_ERROR THEN
        Result= 0
       ELSE
        IF bPerform = SQL_SUCCESS OR bPerform = SQL_SUCCESS_WITH_INFO THEN
         Result = 1
         FOR iColumn = 1 TO qODBC.FieldCount
          iStatus = SQLGetData(qODBC.glStmt, iColumn, 1, VARPTR(sData), MAX_DATA_BUFFER, VARPTR(lOutLen))
            ' lOutlen = length of the valid data in sData
          campo = LEFT$(sData, lOutlen) ' lOutlen = -1 if no data or Null data
             ' Add the Field Data to Correponding Data Display Controls for this row
          qODBC.Field.DATA(iColumn)= campo
         NEXT
        ELSE
         Result= 0
        END IF
       END IF
      END FUNCTION

      SUB CloseDB
       DIM bPerform AS SHORT
       DIM iStatus AS SHORT

    'Release the ODBC Statement Handle
       bPerform = SQLFreeStmt(qODBC.glStmt, SQL_DROP)

    '8. Release the ODBC Statement Handle - SQLFreeSTmt
    'Code in Step 7.
    '***********************************************************************
    'The steps 9 - 11 are for Disconnecting from the SQL Server DataBase
    '***********************************************************************
    '9. Disconnect from ODBC Database - SQLDisconnect
       iStatus = SQLDisconnect(qODBC.glDbc)
      END SUB

      SUB CloseODBC
       DIM iStatus AS SHORT
    '10. Release the ODBC Database Handle - SQLFreeConnect
       iStatus = SQLFreeConnect(qODBC.glDbc)

    '11. Release the ODBC Environment Handle - SQLFreeEnv
       iStatus = SQLFreeEnv(qODBC.glEnv)
      END SUB
     END TYPE


     DIM myDB AS qODBC
     DIM sSQL AS STRING

     myDB.ODBCInit
     PRINT "There are = ";myDB.DriverCount;" Installed Drivers"
     FOR I = 1 TO myDB.DriverCount
      PRINT i;":";myDB.Driver(I)
     NEXT
' Change the Driver and Database information in your Connexion String
     sCon$ = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=adodemo.mdb;PWD=;UID=admin;"
     myDB.Connect(sCon$)
     PRINT "There are =";myDB.TableCount;" Tables"
     FOR I = 1 TO myDB.TableCount
      PRINT i;": ";myDB.Table(I)
      q$="select * from "+ myDB.Table(I)
      myDB.Query(q$)
      PRINT " There are ";myDB.FieldCount;" Columns"
      FOR y=1 TO myDB.FieldCount
       PRINT "  Field ";y;" :";myDB.Field.Name(y)
       PRINT "   TypeNum : ";myDB.Field.TypeNum(y)
       PRINT "   TypeStr : ";myDB.Field.TypeStr(y)
       PRINT "   TypeNum : ";myDB.Field.Size(y)
       PRINT "   DecDigits : ";myDB.Field.DecDigits(y)
       PRINT "   NullAvail : ";myDB.Field.Nullav(y)
      NEXT
      myDB.CloseQuery
     NEXT

' Change Query String to fit your needs, here are some examples
'  sSQL = "insert into nummesa (nummesa) values("+STR$(MESA&[IP])+")"
     sSQL = "select codigo,monto_contrato from obras where monto_contrato > 40 order by monto_contrato"
'  sSQL = "create table datos (LE CHAR(10) NULL, LM INTEGER, MONTO NUMERIC)"

     myDB.Query(sSQL)
     PRINT " There are ";myDB.FieldCount;" Columns"
     FOR y=1 TO myDB.FieldCount
      PRINT myDB.Field.Name(y);" ";
     NEXT
     PRINT
     I=1
     WHILE myDB.GetRecord = 1
      PRINT I;" : ";
      FOR y=1 TO myDB.FieldCount
       PRINT myDB.Field.DATA(y);" ";
      NEXT
      PRINT
      I++
     WEND
     myDB.CloseQuery
     myDB.CloseDB
     myDB.CloseODBC
     PRINT "FINISH"

     END

2002-07-02 19:07