diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 84e873d4a7..fe558f0b2c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,31 @@ 2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2009-03-19 09:10 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * bin/postinst.bat + - Removed generation of odbc32.lib for BCC. + You should configure BCC to include /Lib/PSDK in + the lib paths in bcc32.cfg and ilink32.cfg. It's not + Harbour's job to generate it. + + - contrib/hbodbc/tests/harbour.mdb + + contrib/hbodbc/tests/test.mdb + * contrib/hbodbc/tests/odbcdemo.prg + * contrib/hbodbc/tests/odbccall.prg + * contrib/hbodbc/tests/testodbc.prg + * Created working test table from test.dbf. + (previous .mdb was broken) + + * contrib/hbodbc/tests/odbcdemo.prg + * contrib/hbodbc/tests/odbccall.prg + * contrib/hbodbc/tests/testodbc.prg + * contrib/hbodbc/todbc.prg + * contrib/hbodbc/browodbc.prg + * contrib/hbodbc/sql.ch + * Formatting. + * Optimizations and cleanups. (could still use a lot more) + ! Fixed to not use Alert(). + 2009-03-19 01:14 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * contrib/hbmysql/mysql.c * contrib/hbmysql/tmysql.prg diff --git a/harbour/bin/postinst.bat b/harbour/bin/postinst.bat index 7d06aa78c9..dec500bca5 100644 --- a/harbour/bin/postinst.bat +++ b/harbour/bin/postinst.bat @@ -66,8 +66,6 @@ if "%HB_BUILD_IMPLIB%" == "yes" ( if exist "%HB_DIR_OPENSSL%\ssleay32.dll" implib -a "%HB_LIB_INSTALL%\ssleay32.lib" "%HB_DIR_OPENSSL%\ssleay32.dll" if exist "%HB_DIR_PGSQL%\lib\libpq.dll" implib -a "%HB_LIB_INSTALL%\libpq.lib" "%HB_DIR_PGSQL%\lib\libpq.dll" - if exist "%SystemRoot%\system32\odbc32.dll" implib "%HB_LIB_INSTALL%\odbc32.lib" "%SystemRoot%\system32\odbc32.dll" - goto END ) diff --git a/harbour/contrib/hbodbc/browodbc.prg b/harbour/contrib/hbodbc/browodbc.prg index 33f1ed776c..ef232e67ad 100644 --- a/harbour/contrib/hbodbc/browodbc.prg +++ b/harbour/contrib/hbodbc/browodbc.prg @@ -9,7 +9,7 @@ * Copyright 1999 Antonio Linares for code derived from browse.prg * Copyright 1999-2001 Viktor Szakats for original FieldBlock function * Copyright 1999 Paul Tucker for original Skipped function - * Copyright 2002 Tomaz Zupan modifications for ODBC + * Copyright 2002 Tomaz Zupan modifications for ODBC * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -52,37 +52,37 @@ * If you do not wish that, delete this exception notice. * */ - + /* CREDITS: * This code is mostly derived work from harbours RTL browse.prg, browdb.prg. - * and fieldbl.prg. Only minor changes were needed to adapt them to ODBC. + * and fieldbl.prg. Only minor changes were needed to adapt them to ODBC. */ -#include "inkey.ch" #include "common.ch" +#include "inkey.ch" -function BrowseODBC( nTop, nLeft, nBottom, nRight, oDataSource ) +FUNCTION BrowseODBC( nTop, nLeft, nBottom, nRight, oDataSource ) - local oBrw - local cOldScreen - local n, nOldCursor - local nKey := 0 - local lExit := .f. - local bAction - local oColumn + LOCAL oBrw + LOCAL cOldScreen + LOCAL n, nOldCursor + LOCAL nKey := 0 + LOCAL lExit := .F. + LOCAL bAction + LOCAL oColumn //LOCAL cFName - - //TODO: Check if datasource is open - //if ! Used() - // return .f. - //end - if PCount() < 4 + //TODO: Check if datasource is open + //IF ! Used() + // RETURN .F. + //ENDIF + + IF PCount() < 4 nTop := 1 nLeft := 0 nBottom := MaxRow() nRight := MaxCol() - endif + ENDIF nOldCursor := SetCursor( 0 ) cOldScreen := SaveScreen( nTop, nLeft, nBottom, nRight ) @@ -90,158 +90,158 @@ function BrowseODBC( nTop, nLeft, nBottom, nRight, oDataSource ) @ nTop, nLeft TO nBottom, nRight @ nTop + 1, nLeft + 1 SAY Space( nRight - nLeft - 1 ) - oBrw:= TBrowseNew(nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 ) + oBrw := TBrowseNew( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 ) oBrw:SkipBlock := { | nRecs | Skipped( nRecs,oDataSource ) } oBrw:GoTopBlock := { || oDataSource:first() } oBrw:GoBottomBlock := { || oDataSource:last() } oBrw:HeadSep := "-" - - - // TODO: Find out number of columns in ODBC result set, up to then you have to add columns by hand - for n := 1 to len(oDataSource:Fields) - oColumn:= TBColumn():New( oDataSource:Fields[n]:FieldName, ODBCFget(oDataSource:Fields[n]:FieldName,oDataSource)) - oBrw:AddColumn(oColumn) - next - - oBrw:Configure() + // TODO: Find out number of columns in ODBC result set, up to then you have to add columns by hand + FOR n := 1 to Len( oDataSource:Fields ) + oColumn:= TBColumn():New( oDataSource:Fields[ n ]:FieldName, ODBCFget( oDataSource:Fields[ n ]:FieldName, oDataSource ) ) + oBrw:AddColumn( oColumn ) + NEXT + + oBrw:Configure() oBrw:ForceStable() - while ! lExit + DO WHILE ! lExit - if nKey == 0 - while !oBrw:stabilize() .and. NextKey() == 0 - enddo - endif + IF nKey == 0 + DO WHILE !oBrw:stabilize() .AND. NextKey() == 0 + ENDDO + ENDIF - if NextKey() == 0 + IF NextKey() == 0 oBrw:forceStable() Statline( oBrw, oDataSource) nKey := Inkey( 0 ) - if ( bAction := SetKey( nKey ) ) != nil + IF ( bAction := SetKey( nKey ) ) != NIL Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" ) - loop - endif - else + LOOP + ENDIF + ELSE nKey := Inkey() - endif + ENDIF - do case - case nKey == K_ESC - lExit := .t. + DO CASE + CASE nKey == K_ESC + lExit := .T. - case nKey == K_UP - oBrw:Up() + CASE nKey == K_UP + oBrw:Up() - case nKey == K_DOWN - oBrw:Down() + CASE nKey == K_DOWN + oBrw:Down() - case nKey == K_END - oBrw:End() + CASE nKey == K_END + oBrw:End() - case nKey == K_HOME - oBrw:Home() + CASE nKey == K_HOME + oBrw:Home() - case nKey == K_LEFT - oBrw:Left() + CASE nKey == K_LEFT + oBrw:Left() - case nKey == K_RIGHT - oBrw:Right() + CASE nKey == K_RIGHT + oBrw:Right() - case nKey == K_PGUP - oBrw:PageUp() + CASE nKey == K_PGUP + oBrw:PageUp() - case nKey == K_PGDN - oBrw:PageDown() + CASE nKey == K_PGDN + oBrw:PageDown() - case nKey == K_CTRL_PGUP - oBrw:GoTop() + CASE nKey == K_CTRL_PGUP + oBrw:GoTop() - case nKey == K_CTRL_PGDN - oBrw:GoBottom() + CASE nKey == K_CTRL_PGDN + oBrw:GoBottom() - case nKey == K_CTRL_LEFT - oBrw:panLeft() + CASE nKey == K_CTRL_LEFT + oBrw:panLeft() - case nKey == K_CTRL_RIGHT - oBrw:panRight() + CASE nKey == K_CTRL_RIGHT + oBrw:panRight() - case nKey == K_CTRL_HOME - oBrw:panHome() + CASE nKey == K_CTRL_HOME + oBrw:panHome() - case nKey == K_CTRL_END - oBrw:panEnd() + CASE nKey == K_CTRL_END + oBrw:panEnd() - endcase - end + ENDCASE + ENDDO RestScreen( nTop, nLeft, nBottom, nRight, cOldScreen ) SetCursor( nOldCursor ) -return .t. + RETURN .T. -static procedure Statline( oBrw, oDataSource ) +STATIC PROCEDURE Statline( oBrw, oDataSource ) - local nTop := oBrw:nTop - 1 - local nRight := oBrw:nRight + LOCAL nTop := oBrw:nTop - 1 + LOCAL nRight := oBrw:nRight @ nTop, nRight - 27 SAY "Record " - if oDataSource:LastRec() == 0 + IF oDataSource:LastRec() == 0 @ nTop, nRight - 20 SAY " " - elseif oDataSource:RecNo() == oDataSource:LastRec() + 1 + ELSEIF oDataSource:RecNo() == oDataSource:LastRec() + 1 @ nTop, nRight - 40 SAY " " @ nTop, nRight - 20 SAY " " - else + ELSE @ nTop, nRight - 20 SAY PadR( LTrim( Str( oDataSource:RecNo() ) ) + "/" +; Ltrim( Str( oDataSource:LastRec() ) ), 16 ) +; iif( oBrw:hitTop, "", " " )+; iif( oBrw:hitBottom, "", " " ) - endif + ENDIF -return + RETURN STATIC FUNCTION Skipped( nRecs, oDataSource ) LOCAL nSkipped := 0 - IF .not. oDataSource:Eof() + + IF ! oDataSource:Eof() IF nRecs == 0 - // ODBC doesn't have skip(0) - ELSEIF nRecs > 0 + // ODBC doesn't have Skip( 0 ) + ELSEIF nRecs > 0 DO WHILE nSkipped < nRecs - IF .NOT. oDataSource:Eof() + IF ! oDataSource:Eof() oDataSource:next( ) IF oDataSource:Eof() oDataSource:prior( ) EXIT ENDIF nSkipped++ - ENDIF + ENDIF ENDDO ELSEIF nRecs < 0 DO WHILE nSkipped > nRecs - IF .NOT. oDataSource:Bof() + IF ! oDataSource:Bof() oDataSource:prior( ) IF oDataSource:Bof() EXIT ENDIF nSkipped-- - ENDIF + ENDIF ENDDO ENDIF ENDIF -RETURN nSkipped -STATIC FUNCTION ODBCFGet(cFieldName,oDataSource) + RETURN nSkipped + +STATIC FUNCTION ODBCFGet( cFieldName, oDataSource ) IF ISCHARACTER( cFieldName ) // For changing value rather write a decent SQL statement - RETURN {| x | iif( x == NIL, oDataSource:FieldByName(cFieldName):value,NIL ) } + RETURN {| x | iif( x == NIL, oDataSource:FieldByName( cFieldName ):value, NIL ) } ENDIF -RETURN NIL + RETURN NIL diff --git a/harbour/contrib/hbodbc/sql.ch b/harbour/contrib/hbodbc/sql.ch index 7e3012ba73..88da6d969d 100644 --- a/harbour/contrib/hbodbc/sql.ch +++ b/harbour/contrib/hbodbc/sql.ch @@ -3,11 +3,52 @@ */ /* -* -* sql.ch -* (Not Ready) Headers for ODBC -* -**/ + * Harbour Project source code: + * Headers for ODBC + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * 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, or (at your option) + * any later version. + * + * 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 software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ /* RETCODEs */ #define SQL_INVALID_HANDLE -2 diff --git a/harbour/contrib/hbodbc/tests/harbour.mdb b/harbour/contrib/hbodbc/tests/harbour.mdb deleted file mode 100644 index d1e9cd0eac..0000000000 Binary files a/harbour/contrib/hbodbc/tests/harbour.mdb and /dev/null differ diff --git a/harbour/contrib/hbodbc/tests/odbccall.prg b/harbour/contrib/hbodbc/tests/odbccall.prg index 391349db0e..9a307658b1 100644 --- a/harbour/contrib/hbodbc/tests/odbccall.prg +++ b/harbour/contrib/hbodbc/tests/odbccall.prg @@ -5,39 +5,37 @@ #xcommand WITH DO => Self := #xcommand ENDWITH => Self := NIL -FUNCTION Main() +PROCEDURE Main() LOCAL cConStr - LOCAL cDir + LOCAL cDir := hb_DirBase() LOCAL dsFunctions - hb_FNameSplit( hb_ArgV( 0 ), @cDir ) + LOCAL Self - cConStr := "DBQ=" + hb_FNameMerge( cDir, "harbour.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" + cConStr := "DBQ=" + hb_FNameMerge( cDir, "test.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" dsFunctions := TODBC():New( cConStr ) WITH dsFunctions DO - ::SetSQL( "SELECT * FROM Functions" ) + ::SetSQL( "SELECT * FROM test" ) ::Open() - ? ::FieldByName( "Code" ):Value + ? ::FieldByName( "First" ):Value ? ::Skip() - ? ::FieldByName( "Code" ):Value + ? ::FieldByName( "First" ):Value ? ::GoTo( 1 ) - ? ::FieldByName( "Code" ):Value + ? ::FieldByName( "First" ):Value ? ::Prior() - ? ::FieldByName( "Code" ):Value + ? ::FieldByName( "First" ):Value ? ::First() - ? ::FieldByName( "Code" ):Value + ? ::FieldByName( "First" ):Value ? ::Last() - ? ::FieldByName( "Code" ):Value + ? ::FieldByName( "First" ):Value ? ::Close() ENDWITH dsFunctions:Destroy() - RETURN( NIL ) - - + RETURN diff --git a/harbour/contrib/hbodbc/tests/odbcdemo.prg b/harbour/contrib/hbodbc/tests/odbcdemo.prg index efe02fad12..d1c331b39b 100644 --- a/harbour/contrib/hbodbc/tests/odbcdemo.prg +++ b/harbour/contrib/hbodbc/tests/odbcdemo.prg @@ -2,34 +2,28 @@ * $Id$ */ -*+-------------------------------------------------------------------- -*+ -*+ Function Main() -*+ -*+-------------------------------------------------------------------- -*+ -FUNCTION Main() +PROCEDURE Main() LOCAL aOrders LOCAL nOp LOCAL dsFunctions LOCAL cConStr - LOCAL cDir + LOCAL cDir := hb_DirBase() - hb_FNameSplit( hb_ArgV( 0 ), @cDir ) + LOCAL i - cConStr := "DBQ=" + hb_FNameMerge( cDir, "harbour.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" + cConStr := "DBQ=" + hb_FNameMerge( cDir, "test.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" dsFunctions := TODBC():New( cConStr ) SET COLOR TO "W+/B" CLS - WHILE .T. + DO WHILE .T. @ 00, 00 SAY padc( "- TODBC Demonstration -", 80 ) COLOR "B/W" - dsFunctions:SetSQL( "SELECT * FROM Functions" ) + dsFunctions:SetSQL( "SELECT * FROM test" ) dsFunctions:Open() @ 03, 24 TO len( dsFunctions:Fields ) + 4, 55 @@ -50,7 +44,7 @@ FUNCTION Main() dsFunctions:Close() - dsFunctions:SetSQL( "SELECT * FROM Functions ORDER BY " + aOrders[ nOp ] ) + dsFunctions:SetSQL( "SELECT * FROM test ORDER BY " + aOrders[ nOp ] ) dsFunctions:Open() FOR i := 11 TO 24 @@ -65,17 +59,17 @@ FUNCTION Main() @ 11, 02 SAY "Statement:" COLOR "GR+/B" @ 11, col() + 1 SAY dsFunctions:cSQL - @ 14, 05 SAY " " + padr( dsFunctions:FieldByName( "Code" ) :FieldName, 3 ) + " " + ; - padr( dsFunctions:FieldByName( "Function" ) :FieldName, 15 ) + " " + ; - padr( dsFunctions:FieldByName( "State" ) :FieldName, 2 ) + " " + ; - padr( dsFunctions:FieldByName( "Comments" ) :FieldName, 40 ) ; + @ 14, 05 SAY " " + PadR( dsFunctions:FieldByName( "First" ) :FieldName, 3 ) + " " + ; + PadR( dsFunctions:FieldByName( "Last" ) :FieldName, 15 ) + " " + ; + PadR( dsFunctions:FieldByName( "Street" ) :FieldName, 2 ) + " " + ; + PadR( dsFunctions:FieldByName( "City" ) :FieldName, 40 ) ; COLOR "B/W" WHILE !dsFunctions:Eof() - ? " " + padr( dsFunctions:FieldByName( "Code" ) :Value, 3 ), "³", ; - padr( dsFunctions:FieldByName( "Function" ) :Value, 15 ), "³", ; - padr( dsFunctions:FieldByName( "State" ) :Value, 2 ), "³", ; - padr( dsFunctions:FieldByName( "Comments" ) :Value, 40 ) + ? " " + PadR( dsFunctions:FieldByName( "First" ) :Value, 3 ), "³", ; + PadR( dsFunctions:FieldByName( "Last" ) :Value, 15 ), "³", ; + PadR( dsFunctions:FieldByName( "Street" ) :Value, 2 ), "³", ; + PadR( dsFunctions:FieldByName( "City" ) :Value, 40 ) dsFunctions:Skip() ENDDO @@ -84,4 +78,4 @@ FUNCTION Main() ENDDO dsFunctions:Destroy() -RETURN ( NIL ) + RETURN diff --git a/harbour/contrib/hbodbc/tests/test.mdb b/harbour/contrib/hbodbc/tests/test.mdb new file mode 100644 index 0000000000..75ee1eac7a Binary files /dev/null and b/harbour/contrib/hbodbc/tests/test.mdb differ diff --git a/harbour/contrib/hbodbc/tests/testodbc.prg b/harbour/contrib/hbodbc/tests/testodbc.prg index 7f326a7fc4..cb0b10931d 100644 --- a/harbour/contrib/hbodbc/tests/testodbc.prg +++ b/harbour/contrib/hbodbc/tests/testodbc.prg @@ -8,7 +8,7 @@ := space( 128 ) ;; SQLGetData( hStmt, , SQL_CHAR, len( ), @ ) -FUNCTION Main() +PROCEDURE Main() LOCAL hEnv := 0 LOCAL hDbc := 0 @@ -17,12 +17,11 @@ FUNCTION Main() LOCAL cConstrout := SPACE(1024) LOCAL nRows := 0 LOCAL cCode, cFunc, cState, cComm - LOCAL cDir - - hb_FNameSplit( hb_ArgV( 0 ), @cDir ) - - cConstrin := "DBQ=" + hb_FNameMerge( cDir, "harbour.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" - + + LOCAL cDir := hb_DirBase() + + cConstrin := "DBQ=" + hb_FNameMerge( cDir, "test.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" + ? padc( "*** ODBC ACCESS TEST ***", 80 ) ? ? "Allocating environment... " @@ -33,13 +32,13 @@ FUNCTION Main() SQLDriverC( hDbc, cConstrin, @cConstrout ) ? "Allocating statement... " SQLAllocSt( hDbc, @hStmt ) - + ? - ? "SQL: SELECT * FROM FUNCTIONS" - SQLExecDir( hStmt, "select * from functions" ) - + ? "SQL: SELECT * FROM TEST" + SQLExecDir( hStmt, "select * from test" ) + ? - + WHILE SQLFetch( hStmt ) == 0 nRows++ GET ROW 1 INTO cCode @@ -48,13 +47,13 @@ FUNCTION Main() GET ROW 4 INTO cComm ? cCode, padr( cFunc, 20 ), cState, cComm ENDDO - + ? "------------------------------------------------------------------------------" ? str( nRows, 4 ), " row(s) affected." - + SQLFreeStm( hStmt, SQL_DROP ) SQLDisconn( hDbc ) SQLFreeCon( hDbc ) SQLFreeEnv( hEnv ) - - RETURN NIL + + RETURN diff --git a/harbour/contrib/hbodbc/todbc.prg b/harbour/contrib/hbodbc/todbc.prg index 2301c19b2b..9c34028ba6 100644 --- a/harbour/contrib/hbodbc/todbc.prg +++ b/harbour/contrib/hbodbc/todbc.prg @@ -106,7 +106,7 @@ METHOD New() CLASS TODBCField ::AllowNull := .F. ::Value := NIL -RETURN Self + RETURN Self *+-------------------------------------------------------------------- *+ @@ -115,7 +115,7 @@ RETURN Self *+ *+-------------------------------------------------------------------- -CLASS TODBC FROM HBClass +CREATE CLASS TODBC FROM HBClass DATA hEnv DATA hDbc @@ -123,15 +123,15 @@ CLASS TODBC FROM HBClass DATA cODBCStr DATA cODBCRes DATA cSQL - DATA Active - DATA Fields - DATA nEof - DATA lBof + DATA Active INIT .F. + DATA Fields INIT {} + DATA nEof INIT 0 + DATA lBof INIT .F. DATA nRetCode - DATA nRecCount // number of rows in current recordset - DATA nRecNo // Current row number in current recordset + DATA nRecCount INIT 0 // number of rows in current recordset + DATA nRecNo INIT 0 // Current row number in current recordset DATA lCacheRS // Do we want to cache recordset in memory - DATA aRecordSet // Array to store cached recordset + DATA aRecordSet INIT {} // Array to store cached recordset DATA lAutoCommit AS LOGICAL INIT .T. // Autocommit is usually on at startup @@ -144,7 +144,7 @@ CLASS TODBC FROM HBClass METHOD CLOSE() METHOD LoadData() - METHOD ClearData() INLINE ( AEVAL(::Fields, {|oField| oField:Value := nil}) ) + METHOD ClearData() INLINE AEval( ::Fields, {| oField | oField:Value := NIL } ) METHOD FieldByName( cField ) METHOD Fetch( nFetchType, nOffSet ) @@ -182,7 +182,7 @@ METHOD SQLErrorMessage() CLASS TODBC SQLError( ::hEnv, ::hDbc, ::hStmt, @cErrorClass, @nType, @cErrorMsg ) -RETURN "Error " + cErrorClass + " - " + cErrorMsg + RETURN "Error " + cErrorClass + " - " + cErrorMsg /*-----------------------------------------------------------------------*/ @@ -192,59 +192,50 @@ METHOD New( cODBCStr, cUserName, cPassword, lCache ) CLASS TODBC LOCAL nRet IF cUserName != NIL - DEFAULT cPassword TO "" + DEFAULT cPassword TO "" ENDIF DEFAULT lCache TO .T. ::cODBCStr := cODBCStr - ::Active := .F. - ::Fields := {} - ::nEof := 0 - ::lBof := .F. - ::nRecCount := 0 - ::nRecNo := 0 ::lCacheRS := lCache - ::aRecordSet:= {} // Allocates SQL Environment - IF ( (nRet := SQLAllocEn( @xBuf )) == SQL_SUCCESS ) + IF ( nRet := SQLAllocEn( @xBuf ) ) == SQL_SUCCESS ::hEnv := xBuf - ELSE ::nRetCode := nRet - alert( "SQLAllocEnvironment Error" ) - alert( ::SQLErrorMessage() ) + RETURN NIL ENDIF SQLAllocCo( ::hEnv, @xBuf ) // Allocates SQL Connection ::hDbc := xBuf IF cUserName == NIL - SQLDriverC( ::hDbc, ::cODBCStr, @xBuf ) // Connects to Driver - ::cODBCRes := xBuf + SQLDriverC( ::hDbc, ::cODBCStr, @xBuf ) // Connects to Driver + ::cODBCRes := xBuf ELSE - IF .not. ( (nRet := SQLConnect( ::hDbc, cODBCStr, cUserName, cPassword)) == SQL_SUCCESS .or. nRet == SQL_SUCCESS_WITH_INFO ) - //TODO: Some error here + IF ! ( ( nRet := SQLConnect( ::hDbc, cODBCStr, cUserName, cPassword ) ) == SQL_SUCCESS .OR. nRet == SQL_SUCCESS_WITH_INFO ) + // TODO: Some error here ENDIF ENDIF -RETURN Self + RETURN Self /*-----------------------------------------------------------------------*/ METHOD SetAutocommit( lEnable ) CLASS TODBC - local lOld := ::lAutoCommit + LOCAL lOld := ::lAutoCommit DEFAULT lEnable TO .T. - If lEnable != lOld + IF lEnable != lOld ::SetCnnOptions( SQL_AUTOCOMMIT, iif( lEnable, SQL_AUTOCOMMIT_ON, SQL_AUTOCOMMIT_OFF ) ) ::lAutoCommit := lEnable - EndIf + ENDIF -Return lOld + RETURN lOld /*-----------------------------------------------------------------------*/ @@ -254,50 +245,51 @@ METHOD Destroy() CLASS TODBC SQLFreeCon( ::hDbc ) // Frees the connection SQLFreeEnv( ::hEnv ) // Frees the environment -RETURN NIL + RETURN NIL /*-----------------------------------------------------------------------*/ METHOD GetCnnOptions( nType ) CLASS TODBC - local cBuffer:=space(256) - ::nRetCode := SQLGETCONNECTOPTION( ::hDbc, nType, @cBuffer ) + LOCAL cBuffer := Space( 256 ) -return cBuffer + ::nRetCode := SQLGetConnectOption( ::hDbc, nType, @cBuffer ) + + RETURN cBuffer /*-----------------------------------------------------------------------*/ METHOD SetCnnOptions( nType, uBuffer ) CLASS TODBC -return ::nRetCode := SQLSetConnectOption( ::hDbc, nType, uBuffer ) + RETURN ::nRetCode := SQLSetConnectOption( ::hDbc, nType, uBuffer ) /*-----------------------------------------------------------------------*/ METHOD Commit() CLASS TODBC -return ::nRetCode := SQLCommit( ::hEnv, ::hDbc ) + RETURN ::nRetCode := SQLCommit( ::hEnv, ::hDbc ) /*-----------------------------------------------------------------------*/ METHOD RollBack() CLASS TODBC -return ::nRetCode := SQLRollBack( ::hEnv, ::hDbc ) + RETURN ::nRetCode := SQLRollBack( ::hEnv, ::hDbc ) /*-----------------------------------------------------------------------*/ METHOD GetStmtOptions( nType ) CLASS TODBC - local cBuffer := Space( 256 ) + LOCAL cBuffer := Space( 256 ) ::nRetCode := SQLGetStmtOption( ::hStmt, nType, @cBuffer ) -return cBuffer + RETURN cBuffer /*-----------------------------------------------------------------------*/ METHOD SetStmtOptions( nType, uBuffer ) CLASS TODBC -return ::nRetCode := SQLSetStmtOption( ::hStmt, nType, uBuffer ) + RETURN ::nRetCode := SQLSetStmtOption( ::hStmt, nType, uBuffer ) /*-----------------------------------------------------------------------*/ @@ -312,7 +304,7 @@ METHOD SetSQL( cSQL ) CLASS TODBC ::cSQL := cSQL -RETURN NIL + RETURN NIL /*-----------------------------------------------------------------------*/ @@ -332,7 +324,7 @@ METHOD Open() CLASS TODBC LOCAL nResult LOCAL aCurRow - WHILE .T. + DO WHILE .T. // Dataset must be closed IF ::Active @@ -346,7 +338,7 @@ METHOD Open() CLASS TODBC ENDIF // SQL statement is mandatory - IF empty( ::cSQL ) + IF Empty( ::cSQL ) // TODO: Some error here // SQL Statement not defined @@ -360,72 +352,64 @@ METHOD Open() CLASS TODBC xBuf := ::hStmt SQLAllocSt( ::hDbc, @xBuf ) ::hStmt := xBuf - nRet := SQLExecDir( ::hStmt, ::cSQL ) + nRet := SQLExecDir( ::hStmt, ::cSQL ) // Get result information about fields and stores it // on Fields collection SQLNumRes( ::hStmt, @nCols ) // Get number of rows in result set - nResult := SQLRowCoun(::hStmt, @nRows ) - if nResult == SQL_SUCCESS + nResult := SQLRowCoun( ::hStmt, @nRows ) + IF nResult == SQL_SUCCESS ::nRecCount := nRows - endif + ENDIF ::Fields := {} FOR i := 1 TO nCols SQLDescrib( ::hStmt, i, @cColName, 255, @nNameLen, @nDataType, ; - @ nColSize, @nDecimals, @nNul ) + @nColSize, @nDecimals, @nNul ) - aadd( ::Fields, TODBCField():New() ) - ::Fields[ len( ::Fields ) ] :FieldID := i - ::Fields[ len( ::Fields ) ] :FieldName := cColName - ::Fields[ len( ::Fields ) ] :DataSize := nColsize - ::Fields[ len( ::Fields ) ] :DataType := nDataType - ::Fields[ len( ::Fields ) ] :DataDecs := nDecimals - ::Fields[ len( ::Fields ) ] :AllowNull := ( nNul != 0 ) + AAdd( ::Fields, TODBCField():New() ) + ::Fields[ Len( ::Fields ) ]:FieldID := i + ::Fields[ Len( ::Fields ) ]:FieldName := cColName + ::Fields[ Len( ::Fields ) ]:DataSize := nColsize + ::Fields[ Len( ::Fields ) ]:DataType := nDataType + ::Fields[ Len( ::Fields ) ]:DataDecs := nDecimals + ::Fields[ Len( ::Fields ) ]:AllowNull := ( nNul != 0 ) NEXT - // Do we cache recordset? IF ::lCacheRS - ::aRecordSet:={} - WHILE ::Fetch( SQL_FETCH_NEXT, 1 ) == SQL_SUCCESS + ::aRecordSet := {} + DO WHILE ::Fetch( SQL_FETCH_NEXT, 1 ) == SQL_SUCCESS - aCurRow :={} - FOR i := 1 TO nCols - - aadd(aCurRow,::Fields[i]:value) - NEXT - aadd(::aRecordSet,aCurRow) - END + aCurRow := {} + FOR i := 1 TO nCols + AAdd( aCurRow, ::Fields[ i ]:value ) + NEXT + AAdd( ::aRecordSet, aCurRow ) + ENDDO - ::nRecCount := len(::aRecordSet) - + ::nRecCount := Len( ::aRecordSet ) ELSE - - if ::First() == SQL_SUCCESS + IF ::First() == SQL_SUCCESS ::nRecCount := 1 - else + ELSE ::nRecCount := 0 - endif - + ENDIF ENDIF - // Newly opened recordset - we are on first row - ::nRecNo := 1 - - // Sets the Dataset state to active - ::Active := .T. + ::nRecNo := 1 // Newly opened recordset - we are on first row + ::Active := .T. // Sets the Dataset state to active EXIT ENDDO -RETURN nRet == SQL_SUCCESS + RETURN nRet == SQL_SUCCESS /*-----------------------------------------------------------------------*/ // Only executes the SQL Statement @@ -434,28 +418,20 @@ METHOD ExecSQL() CLASS TODBC LOCAL xBuf LOCAL nRet - WHILE .T. - - // SQL statement is mandatory - IF empty( ::cSQL ) - - nRet := SQL_ERROR - EXIT - - ENDIF - + // SQL statement is mandatory + IF Empty( ::cSQL ) + nRet := SQL_ERROR + ELSE // Allocates and executes the statement xBuf := ::hStmt SQLAllocSt( ::hDbc, @xBuf ) ::hStmt := xBuf - nRet := SQLExecDir( ::hStmt, ::cSQL ) + nRet := SQLExecDir( ::hStmt, ::cSQL ) ::Close() - EXIT + ENDIF - ENDDO - -RETURN nRet + RETURN nRet /*-----------------------------------------------------------------------*/ // Closes the dataset @@ -474,27 +450,28 @@ METHOD CLOSE() CLASS TODBC ::nRecNo := 0 ::lBof := .T. -RETURN NIL + 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 + LOCAL nRet + LOCAL xRet := NIL - IF nRet == 0 - // TODO: Some error here - // Invalid field name - xRet := NIL - - ELSE - xRet := ::Fields[ nRet ] + IF ISCHARACTER( cField ) + nRet := AScan( ::Fields, { | x | Upper( x:FieldName ) == Upper( cField ) } ) + IF nRet != 0 + xRet := ::Fields[ nRet ] + ELSE + // TODO: Some error here + // Invalid field name + ENDIF ENDIF -RETURN xRet + RETURN xRet /*-----------------------------------------------------------------------*/ // General fetch wrapper - used by next methods @@ -503,189 +480,190 @@ METHOD Fetch( nFetchType, nOffset ) CLASS TODBC LOCAL nRows LOCAL nResult - LOCAL nPos:=NIL + LOCAL nPos := NIL // First clear fields ::ClearData() // Do we have cached recordset? IF ::lCacheRS .AND. ::Active // looks like we do ... - // Change Recno according to nFetchType and nOffset - DO CASE - CASE nFetchType == SQL_FETCH_NEXT - IF ( ::nRecNo == ::nRecCount ) + // Change Recno according to nFetchType and nOffset + SWITCH nFetchType + CASE SQL_FETCH_NEXT + + IF ::nRecNo == ::nRecCount nResult := SQL_NO_DATA_FOUND - ELSE + ELSE nResult := SQL_SUCCESS nPos := ::nRecNo + 1 - ENDIF + ENDIF + EXIT - CASE nFetchType == SQL_FETCH_PRIOR - IF ( ::nRecNo == 1 ) + CASE SQL_FETCH_PRIOR + IF ::nRecNo == 1 nResult := SQL_NO_DATA_FOUND - ELSE + ELSE nResult := SQL_SUCCESS nPos := ::nRecNo - 1 - ENDIF - - CASE nFetchType == SQL_FETCH_FIRST - nResult := SQL_SUCCESS - nPos := 1 + ENDIF + EXIT - CASE nFetchType == SQL_FETCH_LAST - nResult := SQL_SUCCESS - nPos := ::nRecCount + CASE SQL_FETCH_FIRST + nResult := SQL_SUCCESS + nPos := 1 + EXIT - CASE nFetchType == SQL_FETCH_RELATIVE - IF ( ::nRecNo + nOffset ) > ::nRecCount .OR. ( ::nRecNo + nOffset ) < 1 // TODO: Should we go to the first/last row if out of bounds? + CASE SQL_FETCH_LAST + nResult := SQL_SUCCESS + nPos := ::nRecCount + EXIT + + CASE SQL_FETCH_RELATIVE + IF ( ::nRecNo + nOffset ) > ::nRecCount .OR. ( ::nRecNo + nOffset ) < 1 // TODO: Should we go to the first/last row if out of bounds? nResult := SQL_ERROR - ELSE + ELSE nResult := SQL_SUCCESS nPos := ::nRecNo + nOffset - ENDIF + ENDIF + EXIT - CASE nFetchType == SQL_FETCH_ABSOLUTE - IF nOffset > ::nRecCount .OR. nOffset < 1 // TODO: Should we go to the first/last row if out of bounds? + CASE SQL_FETCH_ABSOLUTE + IF nOffset > ::nRecCount .OR. nOffset < 1 // TODO: Should we go to the first/last row if out of bounds? nResult := SQL_ERROR - ELSE + ELSE nResult := SQL_SUCCESS nPos := nOffset - ENDIF + ENDIF + EXIT - OTHERWISE - nResult := SQL_ERROR - ENDCASE + OTHERWISE + nResult := SQL_ERROR + ENDSWITCH ELSE // apearently we don't have -// nResult := SQLFetch( ::hStmt /*, nFetchType, nOffSet */) - nResult := SQLExtende( ::hStmt, nFetchType, nOffSet, @nRows, 0 ) - +// nResult := SQLFetch( ::hStmt /*, nFetchType, nOffSet */) + nResult := SQLExtende( ::hStmt, nFetchType, nOffSet, @nRows, 0 ) + ENDIF - IF nResult == SQL_SUCCESS .or. nResult == SQL_SUCCESS_WITH_INFO + IF nResult == SQL_SUCCESS .OR. nResult == SQL_SUCCESS_WITH_INFO nResult := SQL_SUCCESS - ::LoadData(nPos) + ::LoadData( nPos ) ::lBof := .F. ELSE // TODO: Report error here ENDIF -RETURN nResult + RETURN nResult /*-----------------------------------------------------------------------*/ // Moves to next record on DataSet -METHOD NEXT () CLASS TODBC +METHOD Next() CLASS TODBC - LOCAL nResult + LOCAL nResult := ::Fetch( SQL_FETCH_NEXT, 1 ) - nResult := ::Fetch( SQL_FETCH_NEXT, 1 ) - if nResult == SQL_SUCCESS + IF nResult == SQL_SUCCESS ::nRecno := ::nRecno + 1 - if ::nRecNo > ::nRecCount + IF ::nRecNo > ::nRecCount ::nRecCount := ::nRecNo - endif - elseif ( nResult == SQL_NO_DATA_FOUND ) .AND. ( ::nRecNo==::nRecCount ) // permit skip on last row, so that EOF() can work properly + ENDIF + ELSEIF nResult == SQL_NO_DATA_FOUND .AND. ::nRecNo == ::nRecCount // permit skip on last row, so that EOF() can work properly ::nRecno := ::nRecno + 1 - else + ELSE //TODO: Error handling - endif + ENDIF -RETURN nResult + RETURN nResult /*-----------------------------------------------------------------------*/ // Moves to prior record on DataSet METHOD Prior() CLASS TODBC - LOCAL nResult + LOCAL nResult := ::Fetch( SQL_FETCH_PRIOR, 1 ) - nResult := ::Fetch( SQL_FETCH_PRIOR, 1 ) - if nResult == SQL_SUCCESS + IF nResult == SQL_SUCCESS ::nRecno := ::nRecno - 1 - elseif ( nResult == SQL_NO_DATA_FOUND ) .AND. ( ::nRecNo==1 ) // permit skip-1 on first row, so that BOF() can work properly + ELSEIF nResult == SQL_NO_DATA_FOUND .AND. ::nRecNo == 1 // permit skip-1 on first row, so that BOF() can work properly ::nRecno := ::nRecno - 1 ::next() ::lBof := .T. - else + ELSE //TODO: Error handling - endif + ENDIF -RETURN nResult + RETURN nResult /*-----------------------------------------------------------------------*/ // Moves to first record on DataSet METHOD First() CLASS TODBC - LOCAL nResult + LOCAL nResult := ::Fetch( SQL_FETCH_FIRST, 1 ) - nResult := ::Fetch( SQL_FETCH_FIRST, 1 ) - if nResult == SQL_SUCCESS + IF nResult == SQL_SUCCESS ::nRecno := 1 - else + ELSE //TODO: Error handling - endif + ENDIF -RETURN nResult + RETURN nResult /*-----------------------------------------------------------------------*/ // Moves to the last record on DataSet METHOD last() CLASS TODBC - LOCAL nResult + LOCAL nResult := ::Fetch( SQL_FETCH_LAST, 1 ) - nResult := ::Fetch( SQL_FETCH_LAST, 1 ) - if nResult == SQL_SUCCESS + IF nResult == SQL_SUCCESS ::nRecno := ::nRecCount - else + ELSE //TODO: Error handling - endif + ENDIF -RETURN nResult + RETURN nResult /*-----------------------------------------------------------------------*/ // Moves the DataSet nSteps from the current record METHOD MoveBy( nSteps ) CLASS TODBC - LOCAL nResult - //TODO: Check if nSteps goes beyond eof - nResult := ::Fetch( SQL_FETCH_RELATIVE, nSteps ) - if nResult == SQL_SUCCESS - ::nRecno := ::nRecNo + nSteps - else - //TODO: Error handling - endif + LOCAL nResult := ::Fetch( SQL_FETCH_RELATIVE, nSteps ) -RETURN nResult + IF nResult == SQL_SUCCESS + ::nRecno := ::nRecNo + nSteps + ELSE + //TODO: Error handling + ENDIF + + RETURN nResult /*-----------------------------------------------------------------------*/ // Moves the DataSet to absolute record number METHOD GOTO( nRecNo ) CLASS TODBC - LOCAL nResult + LOCAL nResult := ::Fetch( SQL_FETCH_ABSOLUTE, nRecNo ) - nResult := ::Fetch( SQL_FETCH_ABSOLUTE, nRecNo ) - if nResult == SQL_SUCCESS + IF nResult == SQL_SUCCESS ::nRecno := nRecNo - else + ELSE //TODO: Error handling - endif + ENDIF -RETURN nResult + RETURN nResult /*-----------------------------------------------------------------------*/ // Skips dataset to the next record - wrapper to Next() METHOD SKIP() CLASS TODBC -RETURN ::Next() + RETURN ::Next() /*-----------------------------------------------------------------------*/ // Checks for End of File (End of DataSet, actually) @@ -696,99 +674,106 @@ METHOD eof() CLASS TODBC LOCAL lResult // Do we have any data in recordset? - - if ::nRecCount > 0 + + IF ::nRecCount > 0 lResult := ( ::nRecNo > ::nRecCount ) - else + ELSE lResult := .T. - endif - -RETURN lResult + ENDIF + + RETURN lResult /*-----------------------------------------------------------------------*/ // Checks for Begining of File METHOD bof() CLASS TODBC -RETURN ::lBof + RETURN ::lBof /*-----------------------------------------------------------------------*/ // Returns the current row in dataset METHOD RecNo() CLASS TODBC -RETURN ::nRecNo + RETURN ::nRecNo /*-----------------------------------------------------------------------*/ // Returns number of rows ( if that function is supported by ODBC driver ) METHOD Lastrec() CLASS TODBC -RETURN ::nRecCount + RETURN ::nRecCount /*-----------------------------------------------------------------------*/ // Returns number of rows ( if that function is supported by ODBC driver ) METHOD RecCount() CLASS TODBC -RETURN ::nRecCount + RETURN ::nRecCount /*-----------------------------------------------------------------------*/ // Loads current record data into the Fields collection -METHOD LoadData(nPos) CLASS TODBC +METHOD LoadData( nPos ) CLASS TODBC LOCAL uData LOCAL i - local nType + LOCAL nType - FOR i := 1 TO len( ::Fields ) + FOR i := 1 TO Len( ::Fields ) - uData := space( 64 ) + uData := Space( 64 ) IF ::lCacheRS .AND. ::Active - IF nPos > 0 .and. nPos <= ::nRecCount - uData := ::aRecordSet[ nPos,i ] + IF nPos > 0 .AND. nPos <= ::nRecCount + uData := ::aRecordSet[ nPos, i ] ENDIF ELSE - - SQLGetData( ::hStmt, ::Fields[ i ]:FieldID, SQL_CHAR, len( uData ), @uData) + + SQLGetData( ::hStmt, ::Fields[ i ]:FieldID, SQL_CHAR, Len( uData ), @uData) nType := ::Fields[ i ]:DataType - - do case - case nType == SQL_LONGVARCHAR + SWITCH nType + CASE SQL_LONGVARCHAR uData := AllTrim( uData ) + EXIT - case nType == SQL_CHAR .or. nType == SQL_VARCHAR .or. nType == SQL_NVARCHAR + CASE SQL_CHAR + CASE SQL_VARCHAR + CASE SQL_NVARCHAR uData := PadR( uData, ::Fields[ i ]:DataSize ) + EXIT - case nType == SQL_TIMESTAMP .or. nType == SQL_DATE - uData := stod( substr(uData,1,4) + substr(uData,6,2) + substr(uData,9,2) ) + CASE SQL_TIMESTAMP + CASE SQL_DATE + uData := SToD( SubStr( uData, 1, 4 ) + SubStr( uData, 6, 2 ) + SubStr( uData, 9, 2 ) ) + EXIT - case nType == SQL_BIT + CASE SQL_BIT uData := Val( uData ) == 1 + EXIT - case nType == SQL_NUMERIC; - .or. nType == SQL_DECIMAL; - .or. nType == SQL_DOUBLE; - .or. nType == SQL_TINYINT; - .or. nType == SQL_SMALLINT; - .or. nType == SQL_INTEGER; - .or. nType == SQL_FLOAT; - .or. nType == SQL_REAL - IF ISCHARACTER(uData) - uData := strtran(uData,",",".") - uData := Round( Val(uData), ::Fields[ i ]:DataSize ) - ENDIF - uData := SetNumLen( uData, ::Fields[ i ]:DataSize ,::Fields[ i ]:DataDecs ) - - endcase + CASE SQL_NUMERIC + CASE SQL_DECIMAL + CASE SQL_DOUBLE + CASE SQL_TINYINT + CASE SQL_SMALLINT + CASE SQL_INTEGER + CASE SQL_FLOAT + CASE SQL_REAL + + IF ISCHARACTER( uData ) + uData := StrTran( uData, ",", "." ) + uData := Round( Val( uData ), ::Fields[ i ]:DataSize ) + ENDIF + uData := SetNumLen( uData, ::Fields[ i ]:DataSize ,::Fields[ i ]:DataDecs ) + EXIT + + ENDSWITCH ENDIF - - ::Fields[ i ]:Value := uData - - next - -RETURN NIL + ::Fields[ i ]:Value := uData + + NEXT + + RETURN NIL