/* * $Id$ */ /* * Harbour Project source code: * ODBC Access Class * * Copyright 1999 Felipe G. Coury * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version, with one exception: * * The exception is that if you link the Harbour Runtime Library (HRL) * and/or the Harbour Virtual Machine (HVM) with other files to produce * an executable, this does not by itself cause the resulting executable * to be covered by the GNU General Public License. Your use of that * executable is in no way restricted on account of linking the HRL * and/or HVM code into it. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit * their web site at http://www.gnu.org/). * */ #include "hbclass.ch" #include "common.ch" #include "sql.ch" *+-------------------------------------------------------------------- *+ *+ Class TODBCField *+ Fields information collection *+ *+-------------------------------------------------------------------- *+ CLASS TODBCField FROM TClass DATA FieldID DATA FieldName DATA DataType DATA DataSize DATA DataDecs DATA AllowNull DATA Value METHOD New() ENDCLASS // New fields instance METHOD New() CLASS TODBCField ::FieldId := - 1 ::FieldName := "" ::DataType := - 1 ::DataSize := - 1 ::DataDecs := - 1 ::AllowNull := .f. ::Value := NIL RETURN ( Self ) /*-----------------------------------------------------------------------*/ *+-------------------------------------------------------------------- *+ *+ Class TODBC *+ Manages ODBC access *+ *+-------------------------------------------------------------------- *+ CLASS TODBC FROM TClass DATA hEnv DATA hDbc DATA hStmt DATA cODBCStr DATA cODBCRes DATA cSQL DATA Active DATA Fields DATA nEof DATA nRetCode METHOD New( cODBCStr ) METHOD Destroy() METHOD SetSQL( cSQL ) METHOD Open() METHOD ExecSQL() METHOD CLOSE() METHOD LoadData() METHOD FieldByName( cField ) METHOD Fetch( nFetchType, nOffSet ) METHOD Next() METHOD Prior() METHOD First() METHOD last() METHOD MoveBy( nSteps ) METHOD GoTo( nRecNo ) METHOD Skip() METHOD Eof() METHOD SQLErrorMessage() ENDCLASS METHOD SQLErrorMessage() CLASS TODBC LOCAL cErrorClass, nType, cErrorMsg SQLError( ::hEnv, ::hDbc, ::hStmt, @cErrorClass, @nType, @cErrorMsg ) RETURN( "Error " + cErrorClass + " - " + cErrorMsg ) // New instance of TODBC METHOD New( cODBCStr ) CLASS TODBC LOCAL xBuf // WHILE .t. ::cODBCStr := cODBCStr ::Active := .f. ::Fields := {} ::nEof := 0 // Allocates SQL Environment IF ( (nRet := SQLAllocEn( @xBuf )) == SQL_SUCCESS ) ::hEnv := xBuf ELSE ::nRetCode := nRet alert( "SQLAllocEnvironment Error" ) alert( ::SQLErrorMessage() ) // EXIT ENDIF SQLAllocCo( ::hEnv, @xBuf ) // Allocates SQL Connection ::hDbc := xBuf SQLDriverC( ::hDbc, ::cODBCStr, @xBuf ) // Connects to Driver ::cODBCRes := xBuf // ENDDO RETURN ( Self ) // Destructor for TODBC class METHOD Destroy() CLASS TODBC SQLDisconn( ::hDbc ) // Disconnects from Driver SQLFreeCon( ::hDbc ) // Frees the connection SQLFreeEnv( ::hEnv ) // Frees the environment RETURN ( NIL ) // Sets SQL Statement METHOD SetSQL( cSQL ) CLASS TODBC // If the DataSet is active, close it // before assigning new statement IF ::Active ::Close() ENDIF ::cSQL := cSQL RETURN ( NIL ) // Opens a DataSet given the SQL Statement METHOD Open() CLASS TODBC LOCAL nRet LOCAL nCols LOCAL i LOCAL cColName LOCAL nNameLen LOCAL nDataType LOCAL nColSize LOCAL nDecimals LOCAL nNul LOCAL xBuf WHILE .T. // Dataset must be closed IF ::Active // TODO: Some error here // Cannot do this operation on an opened dataset nRet := - 1 EXIT ENDIF // SQL statement is mandatory IF empty( ::cSQL ) // TODO: Some error here // SQL Statement not defined nRet := - 1 EXIT ENDIF // Allocates and executes the statement xBuf := ::hStmt SQLAllocSt( ::hDbc, @xBuf ) ::hStmt := xBuf nRet := SQLExecDir( ::hStmt, ::cSQL ) // Get result information about fields and stores it // on Fields collection SQLNumRes( ::hStmt, @nCols ) ::Fields := {} FOR i := 1 TO nCols SQLDescrib( ::hStmt, i, @cColName, 255, @nNameLen, @nDataType, ; @ nColSize, @nDecimals, @nNul ) aadd( ::Fields, TODBCField():New() ) ::Fields[ len( ::Fields ) ] :FieldID := i ::Fields[ len( ::Fields ) ] :FieldName := cColName ::Fields[ len( ::Fields ) ] :DataSize := nNameLen ::Fields[ len( ::Fields ) ] :DataType := nDataType ::Fields[ len( ::Fields ) ] :DataDecs := nDecimals ::Fields[ len( ::Fields ) ] :AllowNull := ( nNul != 0 ) NEXT // Sets the Dataset state to active and put cursor on first record ::Active := .t. ::Skip() EXIT ENDDO RETURN ( ( nRet == 0 ) ) // Only executes the SQL Statement METHOD ExecSQL() CLASS TODBC WHILE .T. // SQL statement is mandatory IF empty( ::cSQL ) lRet := .F. EXIT ENDIF // Allocates and executes the statement xBuf := ::hStmt SQLAllocSt( ::hDbc, @xBuf ) ::hStmt := xBuf nRet := SQLExecDir( ::hStmt, ::cSQL ) ::Close() ENDDO RETURN ( nRet ) // Closes the dataset METHOD CLOSE() CLASS TODBC // Frees the statement SQLFreeStm( ::hStmt, SQL_DROP ) ::Active := .F. RETURN ( NIL ) // Returns the Field object for a named field METHOD FieldByName( cField ) CLASS TODBC LOCAL nRet := ascan( ::Fields, { | x | upper( x:FieldName ) == upper( cField ) } ) LOCAL xRet IF nRet == 0 // TODO: Some error here // Invalid field name xRet := NIL ELSE xRet := ::Fields[ nRet ] ENDIF RETURN ( xRet ) // General fetch wrapper - used by next methods METHOD Fetch( nFetchType, nOffset ) CLASS TODBC LOCAL nRows LOCAL nRowStatus ::nEof := SQLFetchSc( ::hStmt, nFetchType, nOffSet ) ::LoadData() RETURN ( ::nEof ) // Moves to next record on DataSet METHOD NEXT () CLASS TODBC RETURN ( ::Fetch( SQL_FETCH_NEXT, 1 ) ) // Moves to prior record on DataSet METHOD Prior() CLASS TODBC RETURN ( ::Fetch( SQL_FETCH_PRIOR, 1 ) ) // Moves to first record on DataSet METHOD First() CLASS TODBC RETURN ( ::Fetch( SQL_FETCH_FIRST, 1 ) ) // Moves to the last record on DataSet METHOD last() CLASS TODBC RETURN ( ::Fetch( SQL_FETCH_LAST, 1 ) ) // Moves the DataSet nSteps from the current record METHOD MoveBy( nSteps ) CLASS TODBC RETURN ( ::Fetch( SQL_FETCH_RELATIVE, nSteps ) ) // Moves the DataSet to absolute record number METHOD GOTO( nRecNo ) CLASS TODBC RETURN ( ::Fetch( SQL_FETCH_ABSOLUTE, nRecNo ) ) // Skips dataset to the next record - wrapper to Next() METHOD SKIP() CLASS TODBC RETURN ( ::Next() ) // Checks for End of File (End of DataSet, actually) METHOD eof() CLASS TODBC RETURN ( ( ::nEof != 0 ) ) // Loads current record data into the Fields collection METHOD LoadData() CLASS TODBC LOCAL xRet LOCAL i FOR i := 1 TO len( ::Fields ) xRet := space( 128 ) SQLGetData( ::hStmt, ::Fields[ i ] :FieldID, SQL_CHAR, len( xRet ), @xRet ) ::Fields[ i ] :Value := xRet NEXT RETURN ( NIL ) *+ EOF: TODBC.PRG