/* * Xailer source code: * * OdbcDataSource.prg * Clase TOdbcDataSource() * * Copyright 2003, 2007 Ignacio Ortiz de Zúñiga * Copyright 2003, 2007 Xailer.com * All rights reserved * */ #include "Xailer.ch" #include "Odbc.ch" //-------------------------------------------------------------------------- CLASS XOdbcDataSource FROM TDataSource PUBLISHED: PROPERTY cDSN INIT "" PROPERTY cUser INIT "" PROPERTY cPassword INIT "" PROPERTY lAutoCommit INIT .T. WRITE METHOD SetAutoCommit PROPERTY lDateAsString INIT .T. PROPERTY lConnected INIT .F. WRITE INLINE IIf( Value, ::Connect(), ::DisConnect() ) PROTECTED: DATA hEnv, hDbc METHOD SetAutoCommit( lValue ) PUBLIC: PROPERTY cDriver INIT RddSetDefault() DATA nAffectedRows INIT 0 READONLY METHOD NewDataSet( cCommand, cProcess ) // --> oDataSet METHOD Query( cCommand, cProcess ) INLINE ::NewDataSet( cCommand, cProcess ) // --> oDataSet METHOD QueryArray( cCommand, aHeaders ) // --> aBuffer METHOD QueryRow( cCommand, aHeaders ) // --> aBuffer METHOD QueryValue( cCommand ) // --> Nil | Value METHOD Execute( cCommand, cOperation, hStmt ) // --> lSuccess METHOD Connect() // --> lSuccess METHOD DisConnect() // --> lSuccess METHOD BeginTrans() INLINE ::Execute( "BEGIN TRANSACTION", "Begin transaction" ) // --> lSuccess METHOD CommitTrans() INLINE ::Execute( "COMMIT TRANSACTION", "Commit transaction" ) // --> lSuccess METHOD RollBackTrans() INLINE ::Execute( "ROLLBACK TRANSACTION", "Rollback transaction" ) // --> lSuccess METHOD RollBackAll() // --> lSucces METHOD CommitAll() // --> lSuccess METHOD File( cName ) // --> lResult METHOD GetTables( cMask, lViews ) // --> aFiles METHOD DelTable( cTable ) // --> lSuccess RESERVED: METHOD AllocStatement() METHOD DropStatement( hStmt ) METHOD Fetch( hStmt ) INLINE SQL_OK( SqlFetch( hStmt ) ) METHOD NewError( cError, nError, oDataSet, hStmt ) ENDCLASS //-------------------------------------------------------------------------- METHOD Connect() CLASS XOdbcDataSource LOCAL oForm LOCAL hBuf, hWnd LOCAL nRet oForm := GetActiveForm() DEFAULT oForm TO Application:oMainForm IF oForm != Nil hWnd := oForm:Handle ENDIF ::DisConnect() IF ! Empty( ::cDSN ) ::cConnect := "DSN=" + Alltrim( ::cDSN ) IF ! Empty( ::cUser ) ::cConnect += ";UID=" + Alltrim( ::cUser ) ENDIF IF ! Empty( ::cPassword ) ::cConnect += ";PWD=" + Alltrim( ::cPassword ) ENDIF ENDIF ::OnConnect() hBuf := 0 nRet := SQLAllocHandle( SQL_HANDLE_ENV, @hBuf ) IF SQL_OK( nRet ) ::hEnv = hBuf nRet := SQLSetOdbcVersion( ::hEnv, 2 ) nRet := SQLAllocHandle( SQL_HANDLE_DBC, @hBuf ) ::hDbc := hBuf hBuf := ::cConnect nRet := SQLDriverConnect( ::hDbc, @hBuf, hWnd ) IF SQL_OK( nRet ) ::cConnect := hBuf ::FlConnected := .T. ::SetAutoCommit( ::FlAutoCommit ) ELSE ::NewError( "SQLDriverConnect error", nRet ) ENDIF ELSE ::NewError( "SQLAllocEnvironment error", nRet ) ENDIF ::OnConnected() RETURN ::FlConnected //-------------------------------------------------------------------------- METHOD DisConnect() CLASS XOdbcDataSource LOCAL nRet := 0 AEval( ::aDataSet, {|o| o:lOpen := .F. } ) ::OnDisconnect() IF ! Empty( ::hDbc ) nRet := SQLFreeHandle( SQL_HANDLE_DBC, ::hDbc ) ::hDbc := Nil ENDIF IF SQL_OK( nRet ) .AND. ! Empty( ::hEnv ) nRet := SQLFreeHandle( SQL_HANDLE_ENV, ::hEnv ) ::hEnv := Nil ENDIF ::FlConnected := .F. ::OnDisconnected() RETURN SQL_OK( nRet ) //-------------------------------------------------------------------------- METHOD Execute( cCommand, cOperation, hStmt ) CLASS XOdbcDataSource LOCAL nRet IF Empty( cCommand ) .OR. Empty( ::hDbc ) RETURN .F. ENDIF DEFAULT hStmt TO ::AllocStatement() IF hStmt != 0 nRet := SQLExecDirect( hStmt, cCommand ) IF ! SQL_OK( nRet ) ::NewError( cOperation , nRet,, hStmt ) ELSE ::nAffectedRows := SQLRowCount( hStmt ) ENDIF IF Pcount() < 3 ::DropStatement( hStmt ) ENDIF ENDIF RETURN SQL_OK( nRet ) //-------------------------------------------------------------------------- METHOD CommitAll() CLASS XOdbcDataSource LOCAL nRet nRet := SQLCommit( ::hEnv, ::hDbc ) IF ! SQL_OK( nRet ) ::NewError( "SqlCommit error", nRet ) ENDIF RETURN SQL_OK( nRet ) //-------------------------------------------------------------------------- METHOD RollBackAll() CLASS XOdbcDataSource LOCAL nRet nRet := SQLRollBack( ::hEnv, ::hDbc ) IF ! SQL_OK( nRet ) ::NewError( "SqlRollBack error", nRet ) ENDIF RETURN SQL_OK( nRet ) //-------------------------------------------------------------------------- METHOD NewDataSet( cCommand, cProcess ) CLASS XOdbcDataSource LOCAL oDataSet IF Empty( cCommand ) RETURN Nil ENDIF DEFAULT cProcess TO "GENERAL" WITH OBJECT oDataSet := TOdbcDataSet():Create( ::oParent, Self, "", Upper( ::cProcess ) ) :cSelect := cCommand :lDateAsString := ::lDateAsString END WITH RETURN oDataSet //-------------------------------------------------------------------------- METHOD QueryArray( cCommand, aHeaders ) CLASS XOdbcDataSource LOCAL aBuffer, aFields LOCAL hStmt, nFor, nFields, nRow IF Empty( ::hDbc ) RETURN {} ENDIF hStmt := ::AllocStatement() IF ! ::Execute( cCommand, "TOdbcDataSource:QueryArray()", hStmt ) ::DropStatement( hStmt ) RETURN {} ENDIF aFields := SQLFieldsInfo( hStmt, ::lDateAsString ) IF Len( aFields ) == 0 ::DropStatement( hStmt ) RETURN {} ENDIF nFields := Len( aFields ) aBuffer := {} nRow := 0 IF Pcount() > 1 aHeaders := Array( nFields ) FOR nFor := 1 TO nFields aHeaders[ nFor ]:= aFields[ nFor, SQL_INFO_NAME ] NEXT ENDIF DO WHILE ::Fetch( hStmt ) nRow ++ AAdd( aBuffer, Array( nFields ) ) FOR nFor := 1 TO nFields aBuffer[ nRow, nFor ] := SqlGetValue( hStmt, nFor, ; aFields[ nFor, SQL_INFO_SQLTYPE ], ; aFields[ nFor, SQL_INFO_SQLLEN ], ; aFields[ nFor, SQL_INFO_SQLDEC ], ; ::lDateAsString ) NEXT ENDDO ::DropStatement( hStmt ) RETURN aBuffer //-------------------------------------------------------------------------- METHOD QueryRow( cCommand, aHeaders ) CLASS XOdbcDataSource LOCAL aBuffer, aFields LOCAL hStmt, nFor, nFields IF Empty( ::hDbc ) RETURN {} ENDIF hStmt := ::AllocStatement() IF ! ::Execute( cCommand, "TOdbcDataSource:QueryRow()", hStmt ) ::DropStatement( hStmt ) RETURN {} ENDIF IF ! ::Fetch( hStmt ) ::DropStatement( hStmt ) RETURN {} ENDIF aFields := SQLFieldsInfo( hStmt, ::lDateAsString ) IF Len( aFields ) == 0 ::DropStatement( hStmt ) RETURN {} ENDIF nFields := Len( aFields ) aBuffer := Array( nFields ) IF Pcount() > 1 aHeaders := Array( nFields ) FOR nFor := 1 TO nFields aHeaders[ nFor ]:= aFields[ nFor, SQL_INFO_NAME ] NEXT ENDIF FOR nFor := 1 TO nFields aBuffer[ nFor ] := SqlGetValue( hStmt, nFor, ; aFields[ nFor, SQL_INFO_SQLTYPE ], ; aFields[ nFor, SQL_INFO_SQLLEN ], ; aFields[ nFor, SQL_INFO_SQLDEC ], ; ::lDateAsString ) NEXT ::DropStatement( hStmt ) RETURN aBuffer //-------------------------------------------------------------------------- METHOD QueryValue( cCommand ) CLASS XOdbcDataSource LOCAL Value LOCAL aFields LOCAL hStmt IF Empty( ::hDbc ) RETURN Nil ENDIF hStmt := ::AllocStatement() IF ! ::Execute( cCommand, "TOdbcDataSource:QueryRow()", hStmt ) ::DropStatement( hStmt ) RETURN Nil ENDIF IF ! ::Fetch( hStmt ) ::DropStatement( hStmt ) RETURN Nil ENDIF aFields := SQLFieldsInfo( hStmt, ::lDateAsString ) IF Len( aFields ) == 0 ::DropStatement( hStmt ) RETURN Nil ENDIF Value := SqlGetValue( hStmt, 1, ; aFields[ 1, SQL_INFO_SQLTYPE ], ; aFields[ 1, SQL_INFO_SQLLEN ], ; aFields[ 1, SQL_INFO_SQLDEC ], ; ::lDateAsString ) ::DropStatement( hStmt ) RETURN Value //-------------------------------------------------------------------------- METHOD AllocStatement() CLASS XOdbcDataSource LOCAL hStmt, nRet IF Empty( ::hDbc ) RETURN 0 ENDIF nRet := SQLAllocStmt( ::hDbc, @hStmt ) IF ! SQL_OK( nRet ) ::NewError( "TOdbcDataSource:AllocStatement()", nRet ) RETURN 0 ENDIF RETURN hStmt //-------------------------------------------------------------------------- METHOD DropStatement( hStmt ) CLASS XOdbcDataSource IF ! Empty( ::hDbc ) SQLFreeStmt( hStmt, SQL_DROP ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD SetAutoCommit( lValue ) CLASS XOdbcDataSource LOCAL nRet IF Empty( ::hDbc ) RETURN Nil ENDIF nRet := SqlSetConnectOption( ::hDbc, SQL_AUTOCOMMIT, IIf( lValue, SQL_AUTOCOMMIT_ON, SQL_AUTOCOMMIT_OFF ) ) IF SQL_OK( nRet ) ::FlAutoCommit := lValue ELSE ::NewError( "SqlSetConnectOption: AutoCommit error", nRet ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD File( cName ) CLASS XOdbcDataSource LOCAL hStmt := 0 LOCAL lTable := .F. LOCAL nRet IF cName == Nil .OR. Empty( ::hDbc ) RETURN .F. ENDIF hStmt := ::AllocStatement() IF hStmt == 0 RETURN .F. ENDIF nRet := SQLIsFile( hStmt, cName ) IF SQL_OK( nRet ) ::NewError("TOdbc:File()", nRet, , hStmt ) ELSE lTable := ::Fetch( hStmt ) ENDIF ::DropStatement( hStmt ) RETURN lTable //-------------------------------------------------------------------------- METHOD GetTables( cMask, lViews ) CLASS XOdbcDataSource LOCAL aFiles LOCAL hStmt LOCAL cTable, cType LOCAL nError DEFAULT lViews TO .T. IF Empty( ::hDbc ) RETURN {} ENDIF aFiles := {} IF cMask != Nil cMask := StrTran( cMask, "*", "%" ) ENDIF hStmt := ::AllocStatement() IF Empty( hStmt ) RETURN {} ENDIF nError := SQLIsFile( hStmt, cMask ) IF ! SQL_OK( nError ) ::NewError( "TOdbc:SQLFile()", nError,, hStmt ) RETURN {} ENDIF CursorWait() DO WHILE ::Fetch( hStmt ) IF ! SQL_OK( SqlGetData( hStmt, 3, 255, @cTable ) ) EXIT ENDIF IF ! SQL_OK( SqlGetData( hStmt, 4, 255, @cType ) ) EXIT ENDIF IF cType = "TABLE" .OR. ( lViews .AND. cType = "VIEW" ) AAdd( aFiles, cTable ) ENDIF ENDDO ::DropStatement( hStmt ) CursorArrow() RETURN aFiles //-------------------------------------------------------------------------- METHOD DelTable( cTable ) CLASS XOdbcDataSource LOCAL cSql IF ! ::File( cTable ) RETURN .F. ENDIF cSql := "DROP TABLE " + cTable RETURN ::Execute( cSql, "TOdbcDataSource:DelTable( " + cTable + " )" ) //-------------------------------------------------------------------------- METHOD NewError( cError, nError, oDataSet, hStmt ) CLASS XOdbcDataSource LOCAL cErrorClass, cErrorMsg, cDiagError, cSqlError, cSelect LOCAL nType DEFAULT cError TO "" IF hStmt != Nil .AND. SqlError( ::hEnv, ::hDbc, hStmt, @cErrorClass, @nType, @cErrorMsg ) != SQL_ERROR cSqlError := "Class: " + Trim( cErrorClass ) IF ! Empty( cErrorMsg ) cSqlError += ", Error: [" + LTrim( Str( nType ) ) + "] " + Trim( ::cErrorMsg ) ENDIF nError := nType cDiagError := SqlGetDiagRec( hStmt ) IF ! Empty( cDiagError ) cSqlError += CRLF + cDiagError ENDIF cError += CRLF+ CRLF + cSqlError ENDIF IF oDataSet != Nil cSelect := oDataSet:cSelect ENDIF RETURN ::Super:NewError( cError, nError, oDataSet, cSelect ) //-------------------------------------------------------------------------- //-------------------------------------------------------------------------- FUNCTION SQLIsFile( hStmt, cTableName ) // --> lResult RETURN SQLTables( hStmt, "", "", cTableName, "" ) //-------------------------------------------------------------------------- FUNCTION SQLFieldsInfo( hStmt, lDateAsStr ) // --> aFields LOCAL aFields LOCAL bTrans LOCAL cType, cName LOCAL nRet, nFields, nFor, nSqlType, nLen, nSqlLen, nDec, nSqlDec LOCAL lCanBeNull DEFAULT lDateAsStr TO .T. aFields := {} nRet := SQLNumResultCols( hStmt, @nFields ) IF ! SQL_OK( nRet ) RETURN {} ENDIF FOR nFor := 1 TO nFields nRet := SQLDescribeCol( hStmt, nFor, @cName, @nSqlType, @nSqlLen, @nSqlDec, @lCanBeNull ) IF ! SQL_OK( nRet ) RETURN {} ENDIF nSqlLen := Min( nSqlLen, FIELD_MAXLENGTH ) cName := Alltrim( cName ) DO CASE CASE nSqlType == SQL_CHAR .OR. nSqlType == SQL_VARCHAR cType := "C" nLen := nSqlLen nDec := 0 IF nLen > 255 cType := "M" nLen := 10 ENDIF CASE nSqlType == SQL_BIT cType := "L" nLen := 1 nDec := 0 CASE nSqlType == SQL_DOUBLE .OR. nSqlType == SQL_FLOAT cType := "N" nLen := 54 nDec := Set( _SET_DECIMALS ) CASE nSqlType == SQL_REAL cType := "N" nLen := 25 nDec := Set( _SET_DECIMALS ) CASE nSqlType == SQL_NUMERIC .OR. nSqlType == SQL_DECIMAL cType := "N" nLen := nSqlLen + 2 nDec := nSqlDec CASE nSqlType == SQL_SMALLINT .OR. nSqlType == SQL_INTEGER .OR. nSqlType == SQL_TINYINT cType := "N" nLen := nSqlLen + 1 nDec := 0 CASE nSqlType == SQL_DATE cType := "D" nLen := 8 nDec := 0 CASE nSqlType == SQL_TIME cType := "C" nLen := 8 nDec := 0 CASE nSqlType == SQL_TIMESTAMP IF ! lDateAsStr cType := "D" nLen := 8 ELSE cType := "C" nLen := 20 ENDIF nDec := 0 CASE nSqlType == SQL_LONGVARCHAR .OR. nSqlType == SQL_LONGVARBINARY cType := "M" nLen := 10 nDec := 0 OTHERWISE cType := "C" //nLen := nSqlLen nLen := 64 nDec := 0 ENDCASE AAdd( aFields, { cName, cType, nLen, nDec, ; nSqlType, nSqlLen, nSqlDec, ; lCanBeNull } ) NEXT RETURN aFields //-------------------------------------------------------------------------- //-------------------------------------------------------------------------- #pragma BEGINDUMP #include #include #include #include #include #include //-------------------------------------------------------------------------- XA_FUNC( SQLFETCH ) // SQLFetch( ) --> nRetCode { hb_retnl( SQLFetch( ( HSTMT ) hb_parnl( 1 ) ) ); } //-------------------------------------------------------------------------- XA_FUNC( SQLFETCHSCROLL ) // SQLFetchScroll( , , ) --> nRetCode { hb_retnl( SQLFetchScroll( ( HSTMT ) hb_parnl( 1 ), (SQLSMALLINT) hb_parnl( 2 ), (SQLINTEGER) hb_parnl( 3 ) ) ); } //-------------------------------------------------------------------------- XA_FUNC( SQLPRIMARYKEYS ) // SQLPrimaryKeys( , ) --> nKeys { hb_retni( SQLPrimaryKeys( ( HSTMT ) hb_parnl ( 1 ), NULL, 0, NULL, 0, ( unsigned char * ) hb_parc ( 2 ), hb_parclen( 2 ) ) ); } //-------------------------------------------------------------------------- XA_FUNC( SQLGETDATA ) // SQLGetData( , , <@nLen>, <@cBuffer> ) --> nRetCode { SDWORD lLen; PTR bBuffer; WORD wResult; lLen = ( SDWORD )( hb_parnl( 3 ) ? hb_parnl( 3 ) : 64 ); bBuffer = hb_xgrab( lLen + 1 ); wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, ( PTR ) bBuffer, lLen, &lLen ); if ( lLen > 0 ) hb_storclen( ( char * ) bBuffer, lLen, 4 ) ; else hb_storc( "", 4 ) ; hb_stornl( lLen, 3 ); hb_xfree( ( PTR ) bBuffer ); hb_retni( wResult ); } //-------------------------------------------------------------------------- XA_FUNC( SQLGETVALUE ) // SQLGetValue( , , , <@nLen>, , ) --> Value { SDWORD lLen; WORD wResult, wDec; BOOLEAN lDateAsString; long lType; lType = ( HB_ISNUM( 3 ) ? hb_parni( 3 ) : SQL_BINARY ); lLen = ( SDWORD )( HB_ISNUM( 4 ) ? hb_parnl( 4 ) : 64 ); wDec = ( HB_ISNUM( 5 ) ? hb_parni( 5 ) : hb_setGetDecimals() ); lDateAsString = ( HB_ISLOG( 6 ) ? hb_parnl( 6 ) : TRUE ); switch( lType ) { case SQL_CHAR: case SQL_VARCHAR: // case SQL_BINARY: { PTR bBuffer; bBuffer = hb_xgrab( ++ lLen ); wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, ( PTR ) bBuffer, lLen, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retclen( ( char * ) bBuffer, lLen ) ; else hb_retc( "" ); hb_xfree( ( PTR ) bBuffer ); break; } case SQL_WCHAR: case SQL_WVARCHAR: case SQL_WLONGVARCHAR: { PTR bBuffer; bBuffer = hb_xgrab( ++ lLen ); wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, ( PTR ) bBuffer, lLen, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retclen( ( char * ) bBuffer, lLen ) ; else hb_retc( "" ); hb_xfree( ( PTR ) bBuffer ); break; } case SQL_BIT: { SQLCHAR bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_BIT, &bBuffer, sizeof( SQLCHAR ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retl( (BOOLEAN) bBuffer ) ; else hb_retl( FALSE ); break; } case SQL_TINYINT: { SQLCHAR bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_TINYINT, &bBuffer, sizeof( SQLCHAR ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retni( bBuffer ) ; else hb_retni( 0 ); break; } case SQL_SMALLINT: { SQLSMALLINT bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_SHORT, &bBuffer, sizeof( SQLSMALLINT ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retnl( (int) bBuffer ) ; else hb_retnl( 0 ); break; } case SQL_INTEGER: { SQLINTEGER bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_LONG, &bBuffer, sizeof( SQLINTEGER ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retnl( (LONG) bBuffer ) ; else hb_retnl( 0 ); break; } case SQL_DOUBLE: case SQL_FLOAT: { SQLDOUBLE bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_DOUBLE, &bBuffer, sizeof( SQLDOUBLE ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retnd( bBuffer ) ; else hb_retnd( 0 ); break; } case SQL_REAL: { SQLREAL bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_FLOAT, &bBuffer, sizeof( SQLREAL ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retnd( bBuffer ) ; else hb_retnd( 0 ); break; } case SQL_BIGINT: case SQL_NUMERIC: case SQL_DECIMAL: { char bBuffer[ 16 ]; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, &bBuffer, 16, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retndlen( hb_strVal( bBuffer, lLen ), lLen, wDec ) ; else hb_retnd( 0 ); break; } case SQL_DATE: { SQL_DATE_STRUCT bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_DATE, &bBuffer, sizeof( SQL_DATE_STRUCT ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retd( bBuffer.year, bBuffer.month, bBuffer.day ); else hb_retd( 0, 0, 0 ); break; } case SQL_TIME: { char bBuffer[ 9 ]; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, &bBuffer, 9, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retc( ( char * ) &bBuffer ); else hb_retc( "00:00:00" ); break; } case SQL_TIMESTAMP: if ( lDateAsString ) { char bBuffer[ 25 ]; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, &bBuffer, 25, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retclen( ( char * ) &bBuffer, lLen ); else hb_retc( "00/00/0000 00:00:00" ); break; } else { SQL_TIMESTAMP_STRUCT bBuffer; wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_TIMESTAMP, &bBuffer, sizeof( SQL_TIMESTAMP_STRUCT ), &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retd( bBuffer.year, bBuffer.month, bBuffer.day ); else hb_retd( 0, 0, 0 ); break; } case SQL_LONGVARBINARY: { PTR bBuffer; bBuffer = hb_xgrab( ++ lLen ); wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_BINARY, ( PTR ) bBuffer, lLen, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retclen( ( char * ) bBuffer, lLen ) ; else hb_retc( "" ); hb_xfree( ( PTR ) bBuffer ); break; } case SQL_LONGVARCHAR: { PTR bBuffer; if( lLen < 0 ) lLen = ( 1024 * 32 ); // en MySQL viene con un valor -1 bBuffer = hb_xgrab( ++ lLen ); wResult = SQLGetData( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_C_CHAR, ( PTR ) bBuffer, lLen, &lLen ); hb_stornl( lLen, 4 ); if( wResult == SQL_SUCCESS && lLen > 0 ) hb_retclen( ( char * ) bBuffer, lLen ) ; else hb_retc( "" ); hb_xfree( ( PTR ) bBuffer ); break; } default: { char szName[64]; sprintf( szName, "Xailer: SQL type (%ld) not supported", lType ); hb_retc( ( char * ) &szName ); break; } } } //-------------------------------------------------------------------------- /* NOTA: No usada HB_FUNC_STATIC( SQLALLOCENV ) // ( @hEnv ) --> nRetCode { HENV hEnv; RETCODE ret = SQLAllocEnv( &hEnv ); hb_stornl( ( LONG ) hEnv, 1 ); hb_retnl( ret ); } */ //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLALLOCHANDLE ) // ( nType, @Handle ) --> nRetCode { SQLHANDLE hOut; SQLRETURN ret = SQLAllocHandle( (SQLSMALLINT) hb_parni( 1 ), (SQLHANDLE) hb_parnl( 2 ), &hOut ); hb_stornl( ( LONG ) hOut, 2 ); hb_retnl( ret ); } //-------------------------------------------------------------------------- /* NOTA: No usada HB_FUNC_STATIC( SQLALLOCCONNECT ) // ( hEnv, @hDbc ) --> nRetCode { HDBC hDbc; RETCODE ret = SQLAllocConnect( ( HENV ) hb_parnl( 1 ), &hDbc ); hb_stornl( ( LONG ) hDbc, 2 ); hb_retnl( ret ); } */ //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLDRIVERCONNECT ) // ( hDbc, @cConnectString, hWnd ) --> nRetCode { BYTE bBuffer[ 1024 ]; SWORD wLen; HWND hWnd = HB_ISNUM( 3 ) ? (HWND) hb_parnl( 3 ) : GetDesktopWindow(); RETCODE ret = SQLDriverConnect( ( HDBC ) hb_parnl( 1 ), hWnd, (unsigned char *) hb_parcx( 2 ), strlen( hb_parcx( 2 ) ), bBuffer, 1024, &wLen, SQL_DRIVER_COMPLETE ); if ( ret == SQL_SUCCESS ) hb_storclen( (char *) bBuffer , wLen, 2 ); hb_retnl( ret ); } //-------------------------------------------------------------------------- /* NOTA: No usadas HB_FUNC_STATIC( SQLCONNECT ) // ( hDbc, cDSN, cUseName, cPassword ) --> nRetCode { RETCODE ret = SQLConnect( ( HDBC ) hb_parnl( 1 ), (unsigned char*) hb_parcx( 2 ), strlen( hb_parcx( 2 ) ), (unsigned char*) hb_parcx( 3 ), strlen( hb_parcx( 3 ) ), (unsigned char*) hb_parcx( 4 ), strlen( hb_parcx( 4 ) ) ); hb_retnl( ret ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLDISCONNECT ) // ( hDbc ) --> nRetCode { hb_retnl( SQLDisconnect( ( HDBC ) hb_parnl( 1 ) ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLFREECONNECT ) // ( hDbc ) --> nRetCode { hb_retnl( SQLFreeConnect( ( HDBC ) hb_parnl( 1 ) ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLFREEENV ) // ( hEnv ) --> nRetCode { hb_retnl( SQLFreeEnv( ( HENV ) hb_parnl( 1 ) ) ); } */ //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLFREEHANDLE ) // ( nType, handle ) --> nRetCode { hb_retnl( SQLFreeHandle( (SQLSMALLINT) hb_parni( 1 ), ( HENV ) hb_parnl( 2 ) ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLSETODBCVERSION ) // ( hEnv, 2 | 3) --> lSuccess { hb_retnl( SQLSetEnvAttr( (SQLHENV) hb_parnl( 1 ), SQL_ATTR_ODBC_VERSION, hb_parni( 2 ) == 3 ? (void*)SQL_OV_ODBC3 : (void*)SQL_OV_ODBC2, 0 ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLALLOCSTMT ) // (hDbc, @ hStmt ) --> nRetCode { HSTMT hStmt; hb_retnl( SQLAllocStmt( ( HDBC ) hb_parnl( 1 ), &hStmt ) ); hb_stornl( ( LONG ) hStmt, 2 ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLFREESTMT ) // ( hStmt, nType ) --> nRetCode { hb_retnl( SQLFreeStmt( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ) ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLEXECDIRECT ) // ( hStmt, cStatement ) --> nRetCode { hb_retnl( SQLExecDirect( ( HSTMT ) hb_parnl( 1 ), (unsigned char*) hb_parc( 2 ), hb_parclen( 2 ) ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLCOMMIT ) // hEnv, hDbc { hb_retnl( SQLTransact( ( HENV ) hb_parnl( 1 ), ( HDBC ) hb_parnl( 2 ), SQL_COMMIT ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLROLLBACK ) // hEnv, hDbc { hb_retnl( SQLTransact( ( HENV ) hb_parnl( 1 ), ( HDBC ) hb_parnl( 2 ), SQL_ROLLBACK ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLSETCONNECTOPTION ) // hDbc, nOption, uOption { hb_retnl( ( LONG ) SQLSetConnectOption( ( HDBC ) hb_parnl( 1 ), ( UWORD ) hb_parnl( 2 ), ( UDWORD ) HB_ISCHAR( 3 ) ? ( LONG ) hb_parcx( 3 ) : hb_parnl( 3 ) ) ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLERROR ) // hEnv, hDbc, hStmt, @ cErrorClass, @ nType, @ cErrorMsg { BYTE bBuffer1[ 256 ], szErrorMsg[ 256 ]; UDWORD lError; SWORD wLen; hb_retni( SQLError( ( HENV ) hb_parnl( 1 ), ( HDBC ) hb_parnl( 2 ), ( HSTMT ) hb_parnl( 3 ), bBuffer1, (LONG *) &lError, szErrorMsg, 256, &wLen ) ); hb_storc( (char *) bBuffer1, 4 ); hb_stornl( lError, 5 ); hb_storclen( (char *) szErrorMsg, 6, wLen ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLGETDIAGREC ) // hStmt { BYTE szMessage[ 256 ]; BYTE szState[ 6 ]; SQLINTEGER wNativeError; SQLSMALLINT wTextLength; SQLGetDiagRec( SQL_HANDLE_STMT, ( HSTMT ) hb_parnl ( 1 ), 1, szState, &wNativeError, szMessage, 256, &wTextLength ); hb_retclen( ( char * ) szMessage, wTextLength ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLTABLES ) // ( hStmt, cCatalogName, cSchemaName, cTableName, cTableType ) { hb_retnl( SQLTables( ( HSTMT ) hb_parnl ( 1 ), ( hb_parclen( 2 ) == 0 ) ? NULL : ( unsigned char * ) hb_parc( 2 ), SQL_NTS, ( hb_parclen( 3 ) == 0 ) ? NULL : ( unsigned char * ) hb_parc( 3 ), SQL_NTS, ( hb_parclen( 4 ) == 0 ) ? NULL : ( unsigned char * ) hb_parc( 4 ), SQL_NTS, ( hb_parclen( 5 ) == 0 ) ? NULL : ( unsigned char * ) hb_parc( 5 ), SQL_NTS ) ) ; } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLNUMRESULTCOLS ) // hStmt, @ nRows --> nRetCode { SWORD wRows; hb_retni( SQLNumResultCols( ( HSTMT ) hb_parnl( 1 ), &wRows ) ); hb_storni( wRows, 2 ); } //-------------------------------------------------------------------------- HB_FUNC_STATIC( SQLROWCOUNT ) // hStmt --> nRows { SQLINTEGER iRows; RETCODE ret = SQLRowCount( ( HSTMT ) hb_parnl( 1 ), (SQLINTEGER *) &iRows ); if ( ret == SQL_SUCCESS ) hb_retnl( iRows ); else hb_retnl( -1 ); } //-------------------------------------------------------------------------- // 1 2 3 4 5 6 7 HB_FUNC_STATIC( SQLDESCRIBECOL ) // hStmt, nField, @cColName, @nType, @nLen, @nDec, @lCanBeNull { BYTE szName[ 255 ]; SWORD wNameLen, wType, wDec, wNullable; UDWORD lLen; hb_retni( SQLDescribeCol( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), szName, 255, &wNameLen, &wType, &lLen, &wDec, &wNullable ) ); hb_storclen( ( char * ) szName, ( WORD ) wNameLen, 3 ); hb_storni( wType, 4 ); hb_stornl( lLen, 5 ); hb_storni( wDec, 6 ); hb_storl( ( wNullable == SQL_NULLABLE ), 7 ); } //-------------------------------------------------------------------------- /* NOTA: No usada // 1 2 3 HB_FUNC_STATIC( SQLCOLREALNAME ) // SQLColRealName( hStmt, nField, @cColName ) --> { BYTE szName[ 255 ]; SWORD wNameLen; hb_retni( SQLColAttribute( ( HSTMT ) hb_parnl( 1 ), hb_parni( 2 ), SQL_DESC_BASE_COLUMN_NAME, szName, 255, &wNameLen, NULL ) ); hb_storclen( ( char * ) szName, ( WORD ) wNameLen, 3 ); } */ #pragma ENDDUMP //--------------------------------------------------------------------------