From c0b89965bf65b807401a7d7ecc64be4a8f1f5fba Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 19 Mar 2009 08:14:22 +0000 Subject: [PATCH] 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(). --- harbour/ChangeLog | 25 ++ harbour/bin/postinst.bat | 2 - harbour/contrib/hbodbc/browodbc.prg | 186 ++++----- harbour/contrib/hbodbc/sql.ch | 51 ++- harbour/contrib/hbodbc/tests/harbour.mdb | Bin 1536 -> 0 bytes harbour/contrib/hbodbc/tests/odbccall.prg | 26 +- harbour/contrib/hbodbc/tests/odbcdemo.prg | 38 +- harbour/contrib/hbodbc/tests/test.mdb | Bin 0 -> 86016 bytes harbour/contrib/hbodbc/tests/testodbc.prg | 31 +- harbour/contrib/hbodbc/todbc.prg | 449 +++++++++++----------- 10 files changed, 424 insertions(+), 384 deletions(-) delete mode 100644 harbour/contrib/hbodbc/tests/harbour.mdb create mode 100644 harbour/contrib/hbodbc/tests/test.mdb 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 d1e9cd0eac3c4c8f088109d456ead5a76a6b4c39..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1536 zcmZQzWMBv`Nz6-0EJ{)EN-a@vabf_0t$EBz37m&QU#?6qa 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 0000000000000000000000000000000000000000..75ee1eac7a05ed882f30e554319579fb34a3cb59 GIT binary patch literal 86016 zcmeHQ4RBo5b-r)4l6Ixlu51h;U_irA;u381Ysu7Yo-A3|LY8Go$QUTGq?N2izg$GYy$ZGj2mNDJ4vYAsNyk4aulYQfLYjhSHgYsU;<3n$ke0)1eufq*lN0 zo_%lsWT4Mx0QbDrzJ2@dyZ4>*opaAU=iK{N#xbUEZg46&m`>Joj?C4x?=m=LzCKkl zbU6CAH@*CoBWd?T=H%U9`1IN*K415}g};8a_Q{oJ{&e_9KmE=ZI)3%3C%bPt{7Uov zD<^+>;rF)u%hJ|Q9sYyFN48)6^2%4gJbgji=Eko!{Op$tx3+G(>zXTHxa&_MSA6b& zp561glcxRSqaXh4>(71is!tsGyDL7>{`|lHVC2=c@~1k!c>JQ+t1oXIdZE9}n8t0j zphP!CKoL*`6ahs*5l{pa0YyL&Py`f#bAdpUgK$q@|8Eg+oMeLWKDUthX5wf`eihv@Z2q*&YCInX3&Snca%a!EjlCUv{Fy|i4u;%3iJWl&I zm`bw&DFUVmu;Ee%Z*E?d+~b(ERl;Jlypd&gvjq{`Mt(trHNtl70Shj$S67&bu?3|C z1shQiW{q;cDXDP@+NfYb1rG9We%i4$gpTYzc-KnSs6u1;HH;Kgqp@`h5|;OTK5SEQ zkXKm4Qf0BrgXFXm<;}}{2J3}DlOb0GktH|mksG57@|waoHdSd#3kps_SqHV&y;@FgKppA?H>pF3P`FmW?7}PxhwWFE`CGQk zo)Y{nF5=n4H)_JDU25+a!oCFWDigszig&e%W1ryL#IUczJ8mkluf!WVg?%~RLXJ;^ z9w-8efFhs>C<2OrBA^H;0*b(SfI!IkN}O!$N8G`v!;92y7?Q(ZA478q&snq)mtKH3 zH!uFT(KW&*p7JAjhO5qc!6yTsGsfdKjujHvl!V0P2#L!~E5guy2;@3!a5sj4Ep1W= z;25wnV5~-9IArd?5yM#qgJq@9KoL*`6ahs*5l{pa0Y%{5g+R#pc@-(D!pwB;tYcC9kNI{? zVDdEI7a~%=C=>s)I=2w(XM=W`V`j?0&iR*O`dJbKnG^%!dOIs!hK6%92Bnyl&P?s+ z7nI{dJBgm1$Idi$`m|#U!v11_Y{47n7>efO(bPs8|8qh*g-pUcasiy~<|Oruon)TH zC<2OrBA^H; z0*b)-i9pEthZs5Ais<}J;{Q^_|BT`Jz69~&rFg%U?TqUJYyp3HAvgTza(r8mjq<(K z>Y4DL34**#0@ej&!hf%+O!)5=FmteOjk3a|gjYlO%3axi+KFRD!7$?f3FHJOv7EdD z3(C{T5ODQD9Q)j|YUBv+v`g!~tL04Y+Jvj@HNA-CM{V@auxvsm7qLe}EVm#1%rEbVh3VEkj2dDcPl#%3Ov8Yup|40WvT#cu6Chuqaqz!7|F)W@*+bvxIV2Q1*Yp`mLh~CUjE-6ahs*5l{pa0YyL& zPy`eKMc}=Qfa4tU9%VLH*x&!FOS}^Qi}+CdviJ|HK2z0Q6|MSi>_qJP*nd?%RykgI zb>)vMPF5VO*jVvw^xkM&^mODKk-5lqk$)@ybHAPUE*eU?BA^H;0*Zhl@UBCk=3G!z zeJ&dDe#qopwDm4%gOdZgy$uN1y#3j>yLh$@u>Lt|#7}oP;zMe;Gt0|2uT61y*+cO;Th+|;qjy6o%=H9O0(yZUAG?CHz}3F z+0$dw2U3SJSC?f^7vHd43MUVYPg=?%{2sEm+uvo+aIuMQihv@Z2q*%IfFhs>C<2Or zBA^H;0%wmv*!jU3jn2wk70I8gK84vKE0^;R7 zK#C`Bqi;mraU1nR=#nX5t9KoL*`6ahuxJ%>Qp zxx4C2F`e zihv@Z2q*%IfFhs>yzK~totn4?^=~`OdILp35l{pa0YyL&Py`eKML-cy1QY>9;2lMP z@js?~byEZs0YyL&Py`eKML-cy1QY>9KoL*`6oK;?0geC9W8o@mihv@Z2q*%IfFhs> zC<2OrBA^H;0*XKe0geAv6%+wQKoL*`6ahs*5l{pa0YyL&Py`f#^B)1nS&Ml;?;kZ^ zPb3qSiKX~>d~^J%s?n+|s?L7|ltV>85l{pa0YyL&Py`eKML-cy1S|p@`0LmB59s*0 zY!jaQr^v*eFS(_ePhK!*M$9bs;mT`F@oS5zF_mV`m<{|{?MyR2|KLB`X1q@nEbcRX zW&sWLqPYn(hz3(;+Dzfh7>;J}SsHCO#jjo28}LWmgifzv?=$xX2h2Qfkw&AWyENKj zieKBajp8S}-$J9Urp@fO&DERYS8cXA2AXe9<9;(_?f`wmfZ;9Bh&HSF3+Ex@G39*0lns_nsRO0c(7Zdj+k7Vi3Q!mc1$wwmFB~ia5no#3sCR+G2{P;1rW81*dSP znlW%rMLAWLON0dcd8bI1V~S3Z`qH>Clp(d?D#rQ+SIIB-#dGgSQcY3wg{R1N-c=#z zavRaVh`SsrGsxe_hOgMhC$A~r^nt!ZsqyYgQ;uAgzimJ!2k#2jku3@er1|pS+ad)H zkatYB;9zH_AcQMJIR)2Wv{P!7;9t{~f&=@*Qlk{9wbGn|@y<;q zLaNH_i#KN$i(AAvEGS1oxvk+9Ah*YY2nr%O1rgqp1yK}4a|&W8u$)(*pd#nyea?OO z-eLA4lhjwMQ|#??s+$w>{s6Yx>P0T+QoR@!pNLZo%0e==mPo!fs^zq$F`eihv@Z2q*%I zfFj@_;5bPxB(Ph^d^2&>|K^?5PenixPy`eKML-cy1QY>9KoL*`6ahs*5jZOZ_-x5p zZ=27m1;<&m>nhmDCbKhfcl?Q}*JIblCMqAT_(gPEbS(0v^3}3!Wdo&u99}Aklyrvf zasKM8?szULXBHxSXT?2$<{r4$!HhW{YZ79|x*2qj-KNjWcPqFl>*L_*RdWo;1IYCweAOpATVd#8QM4<-$+R!m8T| ze!>qrxMv!4kb)#?AIu!3aXf=onoS)Z+-XAnezc#)D+S8B@C?xuRtJoLD?UAx<@iRd z4roBVM!Z{a<#x+WFdpiFz+>h(=sJu$Zp-knmf^viTDCG-`WpiTiRCcpnF2BgK@*W0 z2QPJ?rWWlqpmrn5#_-vPPogz~&rV!3Y$ZiL4uX2pT?@J!Kz%LhY{x5z1c=)sxXGG?k3!?5uDb8?gr4j18oGOyV-mh+Hf;!cbKcqW~(_K>Z>=dx;sGkuP+Qib0&cE z9#Ao1wL1+;iDI3_uMX7Im~Nb*U>5*mk7I3s!9|8@el6aF=_TnVyAytFGv>tEi z3mqtDzfR-)gyk-)QLU&y2B|DSVtu%t`o#TKy!oV6b3myy`F&xas4pxgR@~dc!|_fB zRFC1_g5)eTk5*v}cIOCarA)*^?FAO(jj|X-Pbcc|&}Df@LJQk0t+XgRKye)?rcDS&afA6Y;LwX!JIoeyd0zim`r3+% zE^U4tF|aMuK%SPKdQNmH32F_o+YWuG1KpGat!fey;z-eMzj3tKhwCXn%IF~YYq52j zf%jG%%SaK7gL?BQ&>Dhm>V;(z4m`{k?_YMefrHn!I#}Z+Rx}OzX?-|KEr4p;7WM|| z#q#VZ$FjMM1ad9xE}UbJqHOj8vwCZ(*pFym`5Dws)tRrEJ0Xc7^y)1IcFO!}#XSTr zo?PIFP3<4E+Ax!$gf@YFkxx4IS-tB5hkbaI+41=9z-vLBOfUb(i>VZ+D&1M9)Nya zlhGotFPJ?m?)AjKIfPY^)PV(9Li$FO1W^~yLOeQh#nCMVZJWnu4P-Wr&tyhs;;ALk zmj_U<5wthsMf=IIB^dS1@G<7#AKiwYbyX4St9E32Y`+0A)9@O)u;(~11&t+gd}5k3 zQU>ekeb)QnctCyQXwin&hCC>x0}DrSfV}V%7T&EZCQ112KqOD-vGfB z=;!n4)ERnh9E<3~5j&1X^p^JFJMo^jei7v~4LRl7)NWjn1g|2iS?Eza>b6)}aAXjk zg2|%EJYhZt>h6Fxc^DhAZ*kh$YdqzL75A?IwP@hDX*hVl}H2SjW@$ISC6PA9m;(ieHztHA@eo}TL z?mrBhC>+o~V)VnO^0U!^L=E)zdMxG~llxF>8ocn4d-fKNDfGLkMXXJaf*iD<#UL8h z0DF2D&`IK+TQVBuOW{MyE~D7SmmG^Jy_*~G9>R;5CqY9K?k)X-{wbxvn9GakvVD3V z>QMqIXk9C6(F>v%pMe&zKT{v_dj@-hcsCL; zNc>3&aC{>-eb7Am8yv4k@yVW_L_g?4O-hh{1uZJS)d!M59XwSTm$Mdit=w^T=EVQM zlSs!Os#=Xz$GR);srYvEKO?n~vGRw?UMQ_Db;Ea-EQMZkwmE5V8+?;k*FCx7)}oOg z;^~7{aGeDAv=a1VIlhPwPt@3p80pf3mMe(Z94u?T&FBXDwAYN(X*0x=3x*YS?O{md zHjJ8ke5>L2x=UBB7xUWR)Boi-nX=Zwi%{x70eec}$S<)XWt{I(l9OYW=W+OUd#s+a zpV1fFfp*wlus*lL_hJToFUIS2?r$!;4UoVSk2~lqM4Y||y{TefhKN!IeR%WNDi~#X z)>@*Fqd2z)H8(}mAjdzNFVcrrv^G7cP z_?m>(oCjY=>?lh7J%3DeDOjY-k=*m^yZ!uw*CQUhXVpCnE|$LJU<4YmRMNBOI8S7! zKm+q;q=3}39}iiXj6mZGGjZgOIV{$jwf>EGL3?2vY9S9V!eus#V_Pt(H05OC3geWT zvQ_s6@Duxy11{!m52w{3Wnz8k?=V`WmnfdF_yL|bnd{xOq84ozxoHCr#F8F0Jp=ZP zpgwW~tc;h5V>U5AVl=m`x|e~62Yy@nH^+8TaSU8=44r^Z&X;Rq?#im^T^qMXP>d~(dFNs+#`e_n-QYP%{!Qx-qI4_FtDU!*9 z6RU0qWb(}O4*D!Pn84?R^>Y@iZcT!2i5#g_lm=}T^`BQK5uMHXaq&F9(}H>a8Z%q$ z8`LlA7WdS&V3Mdq)|W(Qu_S(L)vW^u|2! z2Ugr3@N(5LX1B!q7X2(~g<-nU}C-?1qN_Lmv4N$5St3`#^s7FrDUR(d6jaM>fgv3t^&3&&Fa z4y0JK0bI!ukY2Ml^UR!TFlp5J{k_M}s51Vqjd;rtDvX<$iJz?cNo-4OwDR*6FGe>- zdog38nya#!57X#5JDu{tzKjrQP2Qte%0xCGS z$!raISOE2mLm7+Jz=M_93+6Ytwo2lmY_4NJsOOBQH($lII`m4J-K_-|j34N62l4Fa zA9^uEub-LqGBu`r#T}*`<|L*j?p%pCjl0t)B?Y95elv6blIvhZJ@*EYTN~ynn3-XA zoW3>Z*qHSTMt=)tIAykc7w(@gg{A8y(`24Dz>KjD^W&23rY4PAADg)*%7T%Cr#)PW zm(9j@*}9z5lvszEe#r~;!BdxbhnWG&f^rR(b7B_JixapWtRM=VS#hs|EOs`9pe4+b zPuTcPA~({&IYM%<8j3cE#%x*|iH^ zhUUQz$(pThad21WW*D)M51Cz&^%Ig?T0gfTy~B&%xbldUO3qfY;nb^Oder34v+P0a zEb9sVe(=gEw+Yz)#~9bTaQ1<}u+N{v=bQ_pW@Z5-@6G%R`!xGJ=TVrO;W@6>n87!$ zVC}}78MCX@Icg1$*g`PM8-2<<{T}RN-n;7V1m%qS_d;uDara43C-dX%&&=TyHTGyy znq6ze7?f)kWM0|p8M4M!dIYlra?J>E=>iwDrqmzyYTA~dy}H3HnR|iS4A!%GD|kF< zEIo6|TBVlX+ljECsUx n%*b$*lXd5uMP&|s4A<_3EEw^V3-)XFlc4>&&bP9;z2koY^XjyT literal 0 HcmV?d00001 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