diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9594af8690..c882895fec 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,28 @@ The license applies to all entries newer than 2009-04-28. */ +2012-07-19 14:57 UTC+0200 Viktor Szakats (harbour syenar.net) + + examples/hbapollo + + examples/hbapollo/*.c + + examples/hbapollo/*.prg + + examples/hbapollo/hbapollo.hbc + + examples/hbapollo/hbapollo.hbp + + examples/hbapollo/tests + + examples/hbapollo/tests/hbmk.hbm + + examples/hbapollo/tests/*.prg + + added "sixapi" lib borrowed from xhb. It's a binding + for Apollo libs. Available only for win/x86. A very + old and short implementation was BTW just recently + removed from Harbour. + ; Code received lots of generic polishing and minor + cleanups, hbmk2 build system, etc. Still has a lot + of Windows types, but that's what Apollo seems to + use, so it's not easy to drop them. + ; I'm not sure if this is worth including, Apollo + seems to be highly non-portable and a dead product, + but I had some spare time so I'm uploading it and + if nobody is interested I'll remove it. + 2012-07-19 11:28 UTC+0200 Viktor Szakats (harbour syenar.net) * tests/cursrtst.prg * tests/db_brows.prg diff --git a/harbour/examples/hbapollo/alias.c b/harbour/examples/hbapollo/alias.c new file mode 100644 index 0000000000..5c745bc4e2 --- /dev/null +++ b/harbour/examples/hbapollo/alias.c @@ -0,0 +1,81 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_AUTOALIAS ) +{ + hb_retc_buffer( _sx_AutoAlias( ( char * ) hb_parc( 1 ) ) ); +} + +HB_FUNC( SX_ALIAS ) +{ + WORD iWorkArea = 0; + + if( ! _sx_Used() ) + { + hb_retc_null(); + return; + } + + if( HB_ISNUM( 1 ) ) + { + iWorkArea = ( WORD ) hb_parnl( 1 ); + } + + hb_retc( ( char * ) sx_Alias( iWorkArea ) ); +} + +/* Making new alias name based on cpFileName + User must hb_xfree szAlias when calling this function + */ +char * _sx_AutoAlias( const char * cpFileName ) +{ + if( cpFileName ) + { + HB_ISIZ uiLenAlias; + char * szAlias; + PHB_FNAME pFileName = hb_fsFNameSplit( cpFileName ); + + uiLenAlias = strlen( ( char * ) pFileName->szName ) + 1; + szAlias = ( char * ) hb_xgrab( uiLenAlias ); + hb_snprintf( szAlias, uiLenAlias, "%s", pFileName->szName ); + hb_xfree( pFileName ); + return szAlias; + } + + return NULL; +} + +HB_FUNC( SX_WORKAREA ) +{ + PBYTE szAlias = 0; + + if( HB_ISCHAR( 1 ) ) + { + szAlias = ( PBYTE ) hb_parc( 1 ); + } + + hb_retni( sx_WorkArea( szAlias ) ); +} diff --git a/harbour/examples/hbapollo/append.c b/harbour/examples/hbapollo/append.c new file mode 100644 index 0000000000..07a3223f54 --- /dev/null +++ b/harbour/examples/hbapollo/append.c @@ -0,0 +1,250 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +static int _checkDelim( int _nDelim ); +static int _checkDelimChar( const char * _cDelim ); +static const char * aDelim[] = +{ + "SDENTX", "SDEFOX", "SDENSX", "SDENSX_DBT", "COMMA_DELIM", "SDF_FILE", + "TAB_DELIM", "OEMNTX", "OEMFOX", "OEMNSX" +}; +static int nDelim[] = { 1, 2, 3, 4, 21, 22, 23, 31, 32, 33 }; + +/* 2003.05.08 added parameter for work area to work on */ +HB_FUNC( SX_APPEND ) +{ + WORD iPreviousArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_APPEND" ); + + if( ! HB_ISNIL( 1 ) ) + iPreviousArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + if( HB_ISNUM( 2 ) ) /* How Many Append Blank */ + { + int nHowMany = hb_parni( 2 ); + int ui; + + if( nHowMany > 0 ) + { + for( ui = 0; ui < nHowMany; ui++ ) + sx_Append(); + } + } + else + sx_Append(); + + if( ! ( iPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( iPreviousArea ); +} + +HB_FUNC( SX_APPENDEX ) +{ + WORD iPreviousArea = SX_DUMMY_NUMBER; + int iRetVal = -1; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_APPENDEX" ); + + if( ! HB_ISNIL( 1 ) ) + iPreviousArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + if( HB_ISNUM( 2 ) ) /* How Many Append Blank */ + { + int nHowMany = hb_parni( 2 ); + int ui; + + if( nHowMany > 0 ) + { + for( ui = 0; ui < nHowMany; ui++ ) + iRetVal = sx_AppendEx(); + } + } + else + iRetVal = sx_AppendEx(); + + if( iRetVal == -1 ) + iRetVal = 0; + + hb_retni( iRetVal ); + + if( ! ( iPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( iPreviousArea ); +} + +HB_FUNC( SX_APPENDBLANK ) +{ + WORD iPreviousArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_APPENDBLANK" ); + + if( ! HB_ISNIL( 1 ) ) + iPreviousArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + if( HB_ISNUM( 2 ) ) /* How Many Append Blank */ + { + int nHowMany = hb_parni( 2 ); + int ui; + + if( nHowMany > 0 ) + { + for( ui = 0; ui < nHowMany; ui++ ) + sx_AppendBlank(); + } + } + else + sx_AppendBlank(); + + if( ! ( iPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( iPreviousArea ); +} + +HB_FUNC( SX_APPENDBLANKEX ) +{ + WORD iPreviousArea = SX_DUMMY_NUMBER; + int iRetVal = -1; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_APPENDBLANKEX" ); + + if( ! HB_ISNIL( 1 ) ) + iPreviousArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + if( HB_ISNUM( 2 ) ) /* How Many Append Blank */ + { + int nHowMany = hb_parni( 2 ); + int ui; + + if( nHowMany > 0 ) + { + for( ui = 0; ui < nHowMany; ui++ ) + iRetVal = sx_AppendBlankEx(); + } + } + else + iRetVal = sx_AppendBlankEx(); + + if( iRetVal == -1 ) + iRetVal = 0; + + hb_retni( iRetVal ); + + if( ! ( iPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( iPreviousArea ); +} + +HB_FUNC( SX_APPENDFROM ) +{ + PBYTE cSourceFile; + PBYTE cForScope; + int iRDEType; + WORD iPreviousArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_APPENDFROM" ); + + if( ! HB_ISNIL( 4 ) ) + iPreviousArea = _sx_select( hb_param( 4, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + { + cSourceFile = ( PBYTE ) hb_parc( 1 ); + if( strlen( ( char * ) cSourceFile ) == 0 ) + { + hb_retl( HB_FALSE ); + return; + } + + if( HB_ISNUM( 2 ) ) + { + iRDEType = _checkDelim( hb_parni( 2 ) ); + if( iRDEType == -1 ) + { + hb_retl( HB_FALSE ); + return; + } + } + else if( HB_ISCHAR( 2 ) ) + { + iRDEType = _checkDelimChar( hb_parc( 2 ) ); + if( iRDEType == -1 ) + { + hb_retl( HB_FALSE ); + return; + } + } + else + iRDEType = i_sxApi_RDD_Default; /* Default RDD Driver */ + + if( HB_ISCHAR( 3 ) ) + cForScope = ( PBYTE ) hb_parc( 3 ); + else + cForScope = ( PBYTE ) 0; + + hb_retl( sx_AppendFrom( cSourceFile, ( WORD ) iRDEType, cForScope ) ); + + if( ! ( iPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( iPreviousArea ); + } +} + +static int _checkDelim( int _nDelim ) +{ + HB_USHORT ui; + + for( ui = 0; ui < 10; ui++ ) + { + if( _nDelim == nDelim[ ui ] ) + return nDelim[ ui ]; + } + + return -1; +} + +static int _checkDelimChar( const char * _cDelim ) +{ + int ui; + int iResult = -1; + HB_ISIZ iLen = strlen( _cDelim ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", _cDelim ); + szTmp = _sx_upper( szTmp ); + + for( ui = 0; ui < 10; ui++ ) + { + if( strcmp( szTmp, aDelim[ ui ] ) == 0 ) + { + iResult = nDelim[ ui ]; + break; + } + } + + hb_xfree( szTmp ); + return iResult; +} diff --git a/harbour/examples/hbapollo/array.prg b/harbour/examples/hbapollo/array.prg new file mode 100644 index 0000000000..460278d3cb --- /dev/null +++ b/harbour/examples/hbapollo/array.prg @@ -0,0 +1,172 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +/* + Part of this program was taken from Nanfor Libs +*/ + +FUNCTION sx_ReplaceArray( cFieldName, aArray, xAlias ) + + LOCAL cFileName := "sxarray.dat" + LOCAL nErrorCode := 0 + + IF ValType( aArray ) == "A" + IF FT_SAVEARR( aArray, cFileName, @nErrorCode ) + sx_ReplaceBLOB( cFieldName, cFileName, xAlias ) + FErase( cFileName ) + RETURN .T. + ENDIF + ENDIF + + RETURN .F. + +FUNCTION sx_GetValueArray ( cFieldName, xAlias ) + + LOCAL aArray := {} + LOCAL cFileName := "sxarray.dat" + LOCAL nErrorCode := 0 + + IF sx_BlobToFile( cFieldName, cFileName, xAlias ) + aArray := FT_RESTARR( cFileName, @nErrorCode ) + FErase( cFileName ) + ENDIF + + RETURN aArray + +STATIC FUNCTION FT_SAVEARR( aArray, cFileName, nErrorCode ) + + LOCAL nHandle, lRet + + nHandle := FCreate( cFileName ) + nErrorCode := FError() + IF nErrorCode == 0 + lRet := _ftsavesub( aArray, nHandle, @nErrorCode ) + FClose( nHandle ) + IF lRet .AND. FError() != 0 + nErrorCode := FError() + lRet = .F. + ENDIF + ELSE + lRet = .F. + ENDIF + + RETURN lRet + +STATIC FUNCTION _ftsavesub( xMemVar, nHandle, nErrorCode ) + + LOCAL cValType, nLen, cString + LOCAL lRet := .T. + + cValType := ValType( xMemVar ) + FWrite( nHandle, cValType, 1 ) + IF FError() = 0 + DO CASE + CASE cValType = "A" + nLen := Len( xMemVar ) + FWrite( nHandle, L2Bin( nLen ), 4 ) + IF FError() = 0 + AEval( xMemVar, { |xMemVar1| lRet := _ftsavesub( xMemVar1, nHandle ) } ) + ELSE + lRet = .F. + ENDIF + CASE cValType = "B" + lRet := .F. + CASE cValType = "C" + nLen := Len( xMemVar ) + FWrite( nHandle, L2Bin( nLen ), 4 ) + FWrite( nHandle, xMemVar ) + CASE cValType = "D" + nLen := 8 + FWrite( nHandle, L2Bin( nLen ), 4 ) + FWrite( nHandle, DToC( xMemVar ) ) + CASE cValType = "L" + nLen := 1 + FWrite( nHandle, L2Bin( nLen ), 4 ) + FWrite( nHandle, IIF( xMemVar, "T", "F" ) ) + CASE cValType = "N" + cString := Str( xMemVar ) + nLen := Len( cString ) + FWrite( nHandle, L2Bin( nLen ), 4 ) + FWrite( nHandle, cString ) + ENDCASE + ELSE + lRet = .F. + ENDIF + nErrorCode = FError() + + RETURN lRet + +STATIC FUNCTION FT_RESTARR( cFileName, nErrorCode ) + + LOCAL nHandle, aArray + + nHandle := FOpen( cFileName ) + nErrorCode := FError() + IF nErrorCode = 0 + aArray := _ftrestsub( nHandle, @nErrorCode ) + FClose( nHandle ) + ELSE + aArray := {} + ENDIF + + RETURN aArray + +STATIC FUNCTION _ftrestsub( nHandle, nErrorCode ) + + LOCAL cValType, nLen, cLenStr, xMemVar, cMemVar, nk + + cValType := " " + FRead( nHandle, @cValType, 1 ) + cLenStr := Space( 4 ) + FRead( nHandle, @cLenStr, 4 ) + nLen = Bin2L( cLenStr ) + nErrorCode = FError() + IF nErrorCode == 0 + DO CASE + CASE cValType = "A" + xMemVar := {} + FOR nk := 1 TO nLen + AAdd( xMemVar, _ftrestsub( nHandle ) ) // Recursive call + NEXT + CASE cValType = "C" + xMemVar := Space( nLen ) + FRead( nHandle, @xMemVar, nLen ) + CASE cValType = "D" + cMemVar = Space( 8 ) + FRead( nHandle, @cMemVar, 8 ) + xMemVar := CToD( cMemVar ) + CASE cValType = "L" + cMemVar := " " + FRead( nHandle, @cMemVar, 1 ) + xMemVar := ( cMemVar = "T" ) + CASE cValType = "N" + cMemVar := Space( nLen ) + FRead( nHandle, @cMemVar, nLen ) + xMemVar = Val( cMemVar ) + ENDCASE + nErrorCode := FError() + ENDIF + + RETURN xMemVar diff --git a/harbour/examples/hbapollo/base.c b/harbour/examples/hbapollo/base.c new file mode 100644 index 0000000000..0bfef6b8da --- /dev/null +++ b/harbour/examples/hbapollo/base.c @@ -0,0 +1,74 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#include "sxapi.h" + +HB_FUNC( SX_VERSION ) +{ + char * szVersion = ( char * ) sx_Version(); + + hb_retc( szVersion ); +} + +/* Compatibility */ + +HB_FUNC_EXTERN( HB_VERSION ); + +HB_FUNC( SX_SXAPI_VERSION ) +{ + HB_FUNC_EXEC( HB_VERSION ); +} + +HB_FUNC( SX_BASEDATE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_BASEDATE" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_BaseDate() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_BASENAME ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_BASENAME" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_BaseName() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/bofeof.c b/harbour/examples/hbapollo/bofeof.c new file mode 100644 index 0000000000..d683e3a2cd --- /dev/null +++ b/harbour/examples/hbapollo/bofeof.c @@ -0,0 +1,63 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_BOF ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retl( HB_TRUE ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_Bof() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_EOF ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retl( HB_TRUE ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_Eof() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/browdb.prg b/harbour/examples/hbapollo/browdb.prg new file mode 100644 index 0000000000..34d54c7e54 --- /dev/null +++ b/harbour/examples/hbapollo/browdb.prg @@ -0,0 +1,61 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * TBROWSEDB() function + * + * Copyright 1999 Paul Tucker + * www - http://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. + * + */ + +FUNCTION sx_TBrowseDB( nTop, nLeft, nBottom, nRight ) + + LOCAL oBrowse := TBrowseNew( nTop, nLeft, nBottom, nRight ) + + oBrowse:SkipBlock := {| nRecs | sx_dbSkipper( nRecs ) } + oBrowse:GoTopBlock := {|| sx_dbGoTop() } + oBrowse:GoBottomBlock := {|| sx_dbGoBottom() } + + RETURN oBrowse diff --git a/harbour/examples/hbapollo/browse.prg b/harbour/examples/hbapollo/browse.prg new file mode 100644 index 0000000000..b121e3f6d0 --- /dev/null +++ b/harbour/examples/hbapollo/browse.prg @@ -0,0 +1,206 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Quick Clipper Browse() + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is hb_xfree 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. + * + */ + +#include "inkey.ch" + +FUNCTION sx_Browse( nTop, nLeft, nBottom, nRight ) + + LOCAL oBrw + LOCAL cOldScreen + LOCAL n, nOldCursor + LOCAL nKey := 0 + LOCAL lExit := .F. + +// LOCAL lGotKey := .f. + LOCAL bAction + + IF !sx_Used() + RETURN .F. + end + + sx_GoTop() + + IF PCount() < 4 + nTop := 1 + nLeft := 0 + nBottom := MaxRow() + nRight := MaxCol() + ENDIF + + nOldCursor := SetCursor( 0 ) + cOldScreen := SaveScreen( nTop, nLeft, nBottom, nRight ) + + @ nTop, nLeft TO nBottom, nRight + @ nTop + 3, nLeft SAY Chr( 198 ) + @ nTop + 3, nRight SAY Chr( 181 ) + @ nTop + 1, nLeft + 1 SAY Space( nRight - nLeft - 1 ) + + oBrw := sx_TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 ) + oBrw:HeadSep := " " + Chr( 205 ) + + for n := 1 TO sx_FieldCount() + oBrw:AddColumn( TBColumnNew( sx_FieldName( n ), sx_FieldBlock( sx_FieldName( n ) ) ) ) + next + + oBrw:ForceStable() + + WHILE ! lExit + + IF nKey == 0 + WHILE !oBrw:stabilize() .AND. NextKey() == 0 + ENDDO + ENDIF + + IF NextKey() == 0 + + oBrw:forceStable() + Statline( oBrw ) + + nKey := Inkey( 0 ) + + IF ( bAction := SetKey( nKey ) ) != nil + Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" ) + LOOP + ENDIF + ELSE + nKey := Inkey() + ENDIF + + SWITCH nKey + CASE K_ESC + lExit := .T. + EXIT + + CASE K_UP + oBrw:Up() + EXIT + + CASE K_DOWN + oBrw:Down() + EXIT + + CASE K_END + oBrw:End() + EXIT + + CASE K_HOME + oBrw:Home() + EXIT + + CASE K_LEFT + oBrw:Left() + EXIT + + CASE K_RIGHT + oBrw:Right() + EXIT + + CASE K_PGUP + oBrw:PageUp() + EXIT + + CASE K_PGDN + oBrw:PageDown() + EXIT + + CASE K_CTRL_PGUP + oBrw:GoTop() + EXIT + + CASE K_CTRL_PGDN + oBrw:GoBottom() + EXIT + + CASE K_CTRL_LEFT + oBrw:panLeft() + EXIT + + CASE K_CTRL_RIGHT + oBrw:panRight() + EXIT + + CASE K_CTRL_HOME + oBrw:panHome() + EXIT + + CASE K_CTRL_END + oBrw:panEnd() + EXIT + + ENDSWITCH + ENDDO + + RestScreen( nTop, nLeft, nBottom, nRight, cOldScreen ) + SetCursor( nOldCursor ) + + RETURN .T. + +STATIC PROCEDURE Statline( oBrw ) + + LOCAL nTop := oBrw:nTop - 1 + LOCAL nRight := oBrw:nRight + + @ nTop, nRight - 27 SAY "Record " + + IF sx_LastRec() == 0 + @ nTop, nRight - 20 SAY " " + ELSEIF sx_RecNo() == sx_LastRec() + 1 + @ nTop, nRight - 40 SAY " " + @ nTop, nRight - 20 SAY " " + ELSE + @ nTop, nRight - 40 SAY iif( sx_Deleted(), "", " " ) + @ nTop, nRight - 20 SAY PadR( LTrim( Str( sx_RecNo() ) ) + "/" + ; + LTrim( Str( sx_LastRec() ) ), 16 ) + ; + iif( oBrw:hitTop, "", " " ) + ENDIF + + RETURN diff --git a/harbour/examples/hbapollo/close.c b/harbour/examples/hbapollo/close.c new file mode 100644 index 0000000000..50937df1f6 --- /dev/null +++ b/harbour/examples/hbapollo/close.c @@ -0,0 +1,69 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +void _sx_DelOpenInfo( const char * szAlias ) +{ + if( Opened_DBF_Property ) + { + HB_USHORT uiSize; + for( uiSize = 0; uiSize < ( HB_USHORT ) hb_arrayLen( Opened_DBF_Property ); uiSize++ ) + { + PHB_ITEM pInfo = hb_arrayGetItemPtr( Opened_DBF_Property, uiSize + 1 ); + char * cAliasInfo = _sx_upper( ( char * ) hb_arrayGetCPtr( pInfo, 3 ) ); + + if( cAliasInfo ) + { + if( strcmp( cAliasInfo, szAlias ) == 0 ) + { + hb_arrayDel( Opened_DBF_Property, uiSize + 1 ); + hb_arraySize( Opened_DBF_Property, hb_arrayLen( Opened_DBF_Property ) - 1 ); + break; + } + } + } + } +} + +HB_FUNC( SX_CLOSE ) +{ + if( _sx_Used() ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + const char * szAlias; + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + szAlias = ( const char * ) sx_Alias( 0 ); + + sx_Close(); + + _sx_DelOpenInfo( szAlias ); + + if( ( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) && _sx_Used() ) + sx_Select( iWorkArea ); + } +} diff --git a/harbour/examples/hbapollo/commit.c b/harbour/examples/hbapollo/commit.c new file mode 100644 index 0000000000..24bcee86c5 --- /dev/null +++ b/harbour/examples/hbapollo/commit.c @@ -0,0 +1,51 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_COMMIT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_COMMIT" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Commit(); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_COMMITLEVEL ) +{ + hb_retni( sx_CommitLevel( hb_parni( 1 ) ) ); +} + +HB_FUNC( SX_FLUSHBUFFERS ) +{ + sx_FlushBuffers(); +} diff --git a/harbour/examples/hbapollo/copy.c b/harbour/examples/hbapollo/copy.c new file mode 100644 index 0000000000..bc8446398c --- /dev/null +++ b/harbour/examples/hbapollo/copy.c @@ -0,0 +1,87 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +/* + File name: + This program is part of sxApi Library + Copyright: Andi Jahja 2003 + Last update: 2003-07-03 + */ +#include "sxapi.h" + +#define COMMA_DELIMITED 21 +#define SDF_DELIMITED 22 + +HB_FUNC( SX_COPYFILE ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_COPYFILE" ); + else + { + if( HB_ISCHAR( 1 ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_CopyFile( ( PBYTE ) hb_parc( 1 ) ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); + } +} + +HB_FUNC( SX_COPYFILETEXT ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_COPYFILETEXT" ); + + if( HB_ISCHAR( 1 ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + int iDelimiter = COMMA_DELIMITED; /* Defaulted to Comma */ + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + if( HB_ISNUM( 2 ) ) + { + iDelimiter = hb_parni( 2 ); + if( iDelimiter < COMMA_DELIMITED && iDelimiter > SDF_DELIMITED ) + iDelimiter = COMMA_DELIMITED; + } + + hb_retl( sx_CopyFileText( ( PBYTE ) hb_parc( 1 ), ( WORD ) iDelimiter ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); +} diff --git a/harbour/examples/hbapollo/count.c b/harbour/examples/hbapollo/count.c new file mode 100644 index 0000000000..5c66723eab --- /dev/null +++ b/harbour/examples/hbapollo/count.c @@ -0,0 +1,38 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_COUNT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retnl( sx_Count() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/create.c b/harbour/examples/hbapollo/create.c new file mode 100644 index 0000000000..28386249af --- /dev/null +++ b/harbour/examples/hbapollo/create.c @@ -0,0 +1,281 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_CREATENEW ) +{ + hb_retni( sx_CreateNew( ( PBYTE ) hb_parc( 1 ), /* Field name */ + ( PBYTE ) hb_parc( 2 ), /* Alias */ + ( WORD ) hb_parni( 3 ), /* RDE Type */ + ( WORD ) hb_parni( 4 ) ) ); /* The maximum number of fields to + be added to the file structure */ +} + +HB_FUNC( SX_CREATEEXEC ) +{ + hb_retl( sx_CreateExec() ); +} + +HB_FUNC( SX_CREATEFIELD ) +{ + sx_CreateField( ( PBYTE ) hb_parc( 1 ), /* Field name */ + ( PBYTE ) hb_parc( 2 ), /* Field type */ + ( WORD ) hb_parni( 3 ), /* Field lenght */ + ( WORD ) hb_parni( 4 ) ); /* Field decimals */ +} + +HB_FUNC( SX_CREATEFROM ) +{ + PBYTE cpFileName, + cpAlias, + cpSourceFile; + int iRDEType; + HB_BOOL lIsAlloc = HB_FALSE; + + if( ! HB_ISCHAR( 1 ) || ! HB_ISCHAR( 3 ) ) + hb_retl( HB_FALSE ); + + /* New DBF File Name To Be Created */ + cpFileName = ( PBYTE ) hb_parc( 1 ); + if( strlen( ( char * ) cpFileName ) == 0 ) + hb_retl( HB_FALSE ); + + /* Alias */ + if( HB_ISCHAR( 2 ) ) + cpAlias = ( PBYTE ) hb_parc( 2 ); + else + cpAlias = ( PBYTE ) ""; + + if( strlen( ( char * ) cpAlias ) == 0 ) + { + cpAlias = ( PBYTE ) _sx_AutoAlias( ( char * ) hb_parc( 1 ) ); + lIsAlloc = HB_TRUE; + } + + /* Source File Name for Structure */ + cpSourceFile = ( PBYTE ) hb_parc( 3 ); + + /* RDD */ + if( HB_ISCHAR( 4 ) ) + iRDEType = _sx_CheckRDD( ( char * ) hb_parc( 4 ) ); + else if( HB_ISNUM( 4 ) ) + iRDEType = hb_parni( 4 ); + else + iRDEType = i_sxApi_RDD_Default; + + if( ( iRDEType <= 0 ) || ( iRDEType > 4 ) ) + iRDEType = i_sxApi_RDD_Default; + + hb_retl( sx_CreateFrom( cpFileName, cpAlias, cpSourceFile, ( WORD ) iRDEType ) ); + + _sx_SetDBFInfo( sx_WorkArea( cpAlias ), ( char * ) cpAlias, EXCLUSIVE, ( WORD ) iRDEType ); + + if( lIsAlloc ) + { + sx_Select( sx_WorkArea( cpAlias ) ); + sx_Close(); /* Close DBF if cAlias is not passed */ + _sx_DelOpenInfo( ( char * ) cpAlias ); + hb_xfree( cpAlias ); + } +} + +HB_FUNC( SX_CREATENEWEX ) +{ + UINT iCommitLevel = 1; + + if( HB_ISNUM( 5 ) ) + { + iCommitLevel = hb_parni( 5 ); + if( iCommitLevel > 2 ) + iCommitLevel = 1; + } + + hb_retni( sx_CreateNewEx( ( PBYTE ) hb_parc( 1 ), /* Field name */ + ( PBYTE ) hb_parc( 2 ), /* Alias */ + ( WORD ) hb_parni( 3 ), /* RDE Type */ + ( WORD ) hb_parni( 4 ), /* The maximum number of fields to be added to the file structure */ + iCommitLevel ) ); +} + +HB_FUNC( SX_DBCREATE ) +{ + HB_USHORT uiSize, + uiLen, + iDec, + iFieldLen, + nResult; + HB_BOOL bAutoOpen, + bSuccess = HB_FALSE; + PBYTE cFieldName, + cFieldType, + szFileName, + szAlias; + PHB_ITEM pStruct, + pFieldDesc; + WORD nDriver; + HB_BOOL bAlloc = HB_FALSE; + HB_USHORT iWorkArea; + + /* + File Name Passed + */ + + /* printf("sx_dbcreate...1\n"); */ + if( HB_ISCHAR( 1 ) ) + szFileName = ( PBYTE ) hb_parc( 1 ); + else + szFileName = ( PBYTE ) ""; + + /* + Array of Structure Passed + */ + + /* printf("sx_dbcreate...2\n"); */ + pStruct = hb_param( 2, HB_IT_ARRAY ); + if( pStruct ) + uiLen = ( HB_USHORT ) hb_arrayLen( pStruct ); + else + uiLen = 0; + + /* + Alias Passed + */ + + /* printf("sx_dbcreate...3\n"); */ + if( HB_ISCHAR( 4 ) ) + { + bAutoOpen = HB_TRUE; + szAlias = ( PBYTE ) hb_parc( 4 ); + } + else + { + bAutoOpen = HB_FALSE; + szAlias = ( PBYTE ) _sx_randomname( NULL ); + bAlloc = HB_TRUE; + } + + /* + Assign Alias Automatically if not passed using ROOT File Name + */ + + /* printf("sx_dbcreate...4\n"); */ + if( strlen( ( char * ) szAlias ) == 0 ) + { + szAlias = ( PBYTE ) _sx_AutoAlias( ( char * ) hb_parc( 1 ) ); + bAlloc = HB_TRUE; + } + + /* + Driver + Default is as set up by sx_RDDSetDefault(), SDENSX + */ + + /* printf("sx_dbcreate...5\n"); */ + if( HB_ISCHAR( 3 ) ) + { + nDriver = ( WORD ) _sx_CheckRDD( ( char * ) hb_parc( 3 ) ); + if( ( nDriver <= 0 ) || ( nDriver > 4 ) ) + nDriver = ( WORD ) i_sxApi_RDD_Default; + } + else + nDriver = ( WORD ) i_sxApi_RDD_Default; + + /* printf("sx_dbcreate...6\n"); */ + if( ( strlen( ( char * ) szFileName ) == 0 ) || ! pStruct || uiLen == 0 ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, "SX_DBCREATE" ); + return; + } + + /* printf("sx_dbcreate...7\n"); */ + for( uiSize = 0; uiSize < uiLen; uiSize++ ) + { + pFieldDesc = hb_arrayGetItemPtr( pStruct, uiSize + 1 ); + + if( hb_arrayLen( pFieldDesc ) < 4 ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, "SX_DBCREATE" ); + return; + } + + /* + Validate items types of fields + */ + if( ! ( hb_arrayGetType( pFieldDesc, 1 ) & HB_IT_STRING ) || + ! ( hb_arrayGetType( pFieldDesc, 2 ) & HB_IT_STRING ) || + ! ( hb_arrayGetType( pFieldDesc, 3 ) & HB_IT_NUMERIC ) || + ! ( hb_arrayGetType( pFieldDesc, 4 ) & HB_IT_NUMERIC ) ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, "SX_DBCREATE" ); + return; + } + } + + /* + Now Create DBF + */ + + /* printf("sx_dbcreate...8\n"); */ + if( HB_ISNUM( 5 ) ) /* nCommitLevel Passed */ + nResult = sx_CreateNewEx( szFileName, ( PBYTE ) szAlias, nDriver, uiLen, + hb_parni( 5 ) ); + else + nResult = sx_CreateNew( szFileName, ( PBYTE ) szAlias, nDriver, uiLen ); + + if( nResult ) + { + for( uiSize = 0; uiSize < uiLen; uiSize++ ) + { + pFieldDesc = hb_arrayGetItemPtr( pStruct, uiSize + 1 ); + cFieldName = ( PBYTE ) hb_arrayGetC( pFieldDesc, 1 ); + cFieldName = ( PBYTE ) _sx_alltrim( ( char * ) cFieldName ); + cFieldType = ( PBYTE ) hb_arrayGetC( pFieldDesc, 2 ); + iFieldLen = ( SHORT ) hb_arrayGetNI( pFieldDesc, 3 ); + iDec = ( SHORT ) hb_arrayGetNI( pFieldDesc, 4 ); + sx_CreateField( cFieldName, cFieldType, iFieldLen, iDec ); + hb_xfree( cFieldType ); + hb_xfree( cFieldName ); + } + + bSuccess = sx_CreateExec(); + + if( bSuccess ) + { + if( ! bAutoOpen ) + sx_Close(); + else + { + iWorkArea = sx_WorkArea( szAlias ); + if( iWorkArea > 0 ) + _sx_SetDBFInfo( iWorkArea, ( char * ) szAlias, READWRITE, nDriver ); + } + } + } + + hb_retl( bSuccess ); + + if( bAlloc ) + hb_xfree( szAlias ); +} diff --git a/harbour/examples/hbapollo/dbcopy.c b/harbour/examples/hbapollo/dbcopy.c new file mode 100644 index 0000000000..5d01175ece --- /dev/null +++ b/harbour/examples/hbapollo/dbcopy.c @@ -0,0 +1,491 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +static void __sx_Copy( PBYTE cTargetAlias, PBYTE cSourceAlias, PHB_ITEM pArray, + int iFieldCount ); + +HB_FUNC( __SX_DBCOPY ) /* (file,afields,bfor,bwhile,nnext,nrec,lrest,rdd) */ +{ + LONG nNextRecords, + nRecNo; + HB_BOOL lRest, + bGoTop; + LONG nCurrentRecNo, + ulCount, + ulRecNo; + PHB_ITEM pArray = hb_param( 2, HB_IT_ARRAY ); + PHB_ITEM pbFor = hb_param( 3, HB_IT_BLOCK ); + PHB_ITEM pbCondition = hb_param( 4, HB_IT_BLOCK ); + PHB_ITEM pTemp; + int iRDEType; /* RDD to use for new DBF file */ + PBYTE cNewDBFFile; /* New DBF File name */ + PBYTE cSourceAlias; /* New Alias for new DBF opened */ + PBYTE cNewAlias; /* New Alias for new DBF opened */ + int iFieldCount; + HB_ISIZ uilenpArray, + ui; + WORD iWorkArea = SX_DUMMY_NUMBER; + char * cFieldToCopy; + + /* Check WorkArea */ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_NOALIAS, NULL, "__SX_DBCOPY" ); + + if( ! HB_ISNIL( 9 ) ) + iWorkArea = _sx_select( hb_param( 9, HB_IT_ANY ) ); + + /* Alias of currently selected area */ + cSourceAlias = ( PBYTE ) sx_Alias( 0 ); + + /* Current Record Position */ + nCurrentRecNo = sx_RecNo(); + + /* New file name passed ? */ + if( ! HB_ISCHAR( 1 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBCOPY" ); + else + { + cNewDBFFile = ( PBYTE ) hb_parc( 1 ); + + /* Reject if empty string is passed */ + if( strlen( ( char * ) cNewDBFFile ) == 0 ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBCOPY" ); + + cNewAlias = ( PBYTE ) "__TEMP__"; + + /* cNewAlias = (PBYTE) _sx_AutoAlias( hb_parc( 1 ) ); */ + if( ! HB_ISNIL( 3 ) && ! HB_ISBLOCK( 3 ) ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBCOPY" ); + } + + if( ! HB_ISNIL( 4 ) && ! HB_ISBLOCK( 4 ) ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBCOPY" ); + } + + /* Next Records */ + if( HB_ISNUM( 5 ) ) + nNextRecords = hb_parnl( 5 ); + else + nNextRecords = -1; + + /* Record Number to process */ + if( HB_ISNUM( 6 ) ) + { + nRecNo = hb_parnl( 6 ); + + /* nRecNo should be <= LastRec() */ + if( nRecNo > sx_RecCount() || nRecNo < 1 ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBCOPY" ); + return; + } + + /* nRecNo vs Current Position vs Next Clause */ + if( nNextRecords > 0 && nRecNo <= nCurrentRecNo ) + { + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBCOPY" ); + return; + } + } + else + nRecNo = -1; + + /* Process all records ? */ + if( HB_ISLOG( 7 ) ) + lRest = hb_parl( 7 ); + else + lRest = HB_TRUE; + + if( nNextRecords == -1 && nRecNo == -1 ) + { + lRest = HB_TRUE; + bGoTop = HB_TRUE; + } + else + bGoTop = HB_FALSE; + + /* RDE Type Passed ? */ + if( HB_ISCHAR( 8 ) ) + { + char * cRDDChosen = ( char * ) hb_parc( 8 ); + iRDEType = _sx_CheckRDD( cRDDChosen ); + } + else + iRDEType = i_sxApi_RDD_Default; + + /* Now Processing Data ..... */ + /* All Records Until Eof() With For And Condition */ + sx_Select( sx_WorkArea( cSourceAlias ) ); + iFieldCount = sx_FieldCount(); + + /* Checking Array of Fields */ + uilenpArray = hb_arrayLen( pArray ); + if( uilenpArray == 0 ) /* Not Field Not Specified assumed ALL */ + { + PHB_ITEM pFieldName = hb_itemNew( NULL ); + hb_arraySize( pArray, iFieldCount ); + for( ui = 0; ui < iFieldCount; ui++ ) + { + cFieldToCopy = ( char * ) sx_FieldName( ( WORD ) ( ui + 1 ) ); + pTemp = hb_itemPutC( NULL, cFieldToCopy ); + hb_arraySet( pArray, ui + 1, pTemp ); + hb_itemRelease( pTemp ); + } + + if( pFieldName ) + hb_itemRelease( pFieldName ); + + /* Create DBF Based on Source Structure */ + } + + /* Create Custom DBF based on FIELDS clause */ + if( ! _sx_CopyStructure( cNewDBFFile, pArray ) ) + return; + if( ! sx_Use( cNewDBFFile, cNewAlias, EXCLUSIVE, ( WORD ) iRDEType ) ) + return; + + /* Back to Source Alias */ + sx_Select( sx_WorkArea( cSourceAlias ) ); + + if( bGoTop && lRest && HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + } + } + /* nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( ulCount <= nNextRecords && + _sx_Eval( pbCondition ) && + ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( ulCount <= nNextRecords && + _sx_Eval( pbCondition ) && + ! sx_Eof() ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount < nNextRecords && ! sx_Eof() ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nNextRecords Clause with nRecNo Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) && ( nRecNo > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( ulCount <= nNextRecords && + _sx_Eval( pbCondition ) && + ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( ulCount <= nNextRecords && + _sx_Eval( pbCondition ) && + ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nRecNo Clause with no nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nRecNo > 0 ) ) + { + if( HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_Copy( cNewAlias, cSourceAlias, pArray, iFieldCount ); + break; + } + + sx_Skip( 1 ); + } + } + } + + /* Free allocated memory */ + sx_Select( sx_WorkArea( cNewAlias ) ); /* Select New Area */ + sx_Commit(); + sx_Close(); /* Close It */ + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } +} + +static void __sx_Copy( PBYTE cTarget, PBYTE cSource, PHB_ITEM pArray, + int iFieldCount ) +{ + char cRecord[ 256 ]; + HB_ISIZ uiLen = hb_arrayLen( pArray ); + + if( uiLen == 0 ) /* Assumed all fields are copied */ + { + /* Currently in Source Area */ + sx_GetRecord( ( PBYTE ) cRecord ); /* Get Record from source */ + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_AppendBlank(); /* Append Blank Record */ + sx_PutRecord( ( PBYTE ) cRecord ); /* Put the new record */ + sx_Select( sx_WorkArea( cSource ) ); /* Select Source Area */ + } + else + { + int ui, + uiNew; + char * cFieldName, + * cFieldToCopy, + * cFieldType; + PBYTE cMemo; + PVOID vVariant; + HB_BOOL lTrue; + double vDouble; + + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_AppendBlank(); /* Append Blank Record */ + + for( ui = 1; ui <= iFieldCount; ui++ ) /* Field Names of Source */ + { + cFieldName = ( char * ) sx_FieldName( ( WORD ) ui ); + for( uiNew = 1; uiNew <= uiLen; uiNew++ ) /* Check The ARray Passed */ + { + cFieldToCopy = ( char * ) hb_arrayGetC( pArray, uiNew ); + if( cFieldToCopy ) + { + if( strcmp( cFieldToCopy, cFieldName ) == 0 ) + { + sx_Select( sx_WorkArea( cSource ) ); /* Select Source Area */ + cFieldType = ( char * ) sx_FieldType( ( PBYTE ) cFieldName ); + switch( *cFieldType ) + { + case 'N': + vDouble = sx_GetDouble( ( PBYTE ) cFieldName ); + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_Replace( ( PBYTE ) cFieldToCopy, R_DOUBLE, ( PVOID ) &vDouble ); + break; + + case 'C': + vVariant = ( PVOID ) sx_GetString( ( PBYTE ) cFieldName ); + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_Replace( ( PBYTE ) cFieldToCopy, R_CHAR, vVariant ); + break; + + case 'M': + cMemo = ( PBYTE ) sx_GetMemo( ( PBYTE ) cFieldName, 0 ); + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_Replace( ( PBYTE ) cFieldToCopy, R_MEMO, ( PVOID ) cMemo ); + if( lstrlen( ( char * ) cMemo ) ) /* TOFIX: lstrlen() usage */ + sx_MemDealloc( cMemo ); + break; + + case 'D': + vVariant = ( PVOID ) sx_GetDateString( ( PBYTE ) cFieldName ); + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_Replace( ( PBYTE ) cFieldToCopy, R_DATESTR, vVariant ); + break; + + case 'L': + lTrue = ( HB_BOOL ) sx_GetLogical( ( PBYTE ) cFieldName ); + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_Replace( ( PBYTE ) cFieldToCopy, R_LOGICAL, ( PVOID ) &lTrue ); + break; + } + + hb_xfree( cFieldToCopy ); + } + else + hb_xfree( cFieldToCopy ); + } + } /* end for( uiNew = 0; uiNew < uiLen ; uiNew ++ ) */ + + sx_Select( sx_WorkArea( cSource ) ); /* Select Source Area */ + } + } + + sx_Select( sx_WorkArea( cSource ) ); /* Select Source Area */ +} diff --git a/harbour/examples/hbapollo/dbdelim.c b/harbour/examples/hbapollo/dbdelim.c new file mode 100644 index 0000000000..9747376054 --- /dev/null +++ b/harbour/examples/hbapollo/dbdelim.c @@ -0,0 +1,434 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +static HB_BOOL bSDF = HB_FALSE; + +static void _sx_GetLine( PHB_ITEM pArray, FILE * hFileHandle, char * cDelimiter ) +{ + HB_ISIZ uiLen, + i; + char * cTemp, + * cFieldName, + * cFieldType; + + if( HB_IS_ARRAY( pArray ) ) + { + uiLen = hb_arrayLen( pArray ); + if( uiLen > 0 ) + { + for( i = 0; i < uiLen; i++ ) + { + cFieldName = ( char * ) hb_arrayGetC( pArray, i + 1 ); + cFieldType = ( char * ) sx_FieldType( ( PBYTE ) cFieldName ); + if( ! ( strcmp( cFieldType, "M" ) == 0 ) ) + { + cTemp = ( char * ) sx_GetVariant( ( PBYTE ) cFieldName ); + if( ! bSDF ) + cTemp = _sx_rtrim( cTemp ); + else + { + cTemp = _sx_padl( cTemp, ' ', + sx_FieldWidth( ( PBYTE ) cFieldName ) + sx_FieldDecimals( ( PBYTE ) cFieldName ) ); + cDelimiter = " "; + } + + if( i < uiLen - 1 ) + fprintf( hFileHandle, "%s%s", cTemp, cDelimiter ); + else + fprintf( hFileHandle, "%s", cTemp ); + } + + hb_xfree( cFieldName ); + } + + fprintf( hFileHandle, "\n" ); + } + else + { + uiLen = sx_FieldCount(); + for( i = 0; i < uiLen; i++ ) + { + cFieldName = ( char * ) sx_FieldName( ( WORD ) ( i + 1 ) ); + cFieldType = ( char * ) sx_FieldType( ( PBYTE ) cFieldName ); + if( ! ( strcmp( cFieldType, "M" ) == 0 ) ) + { + cTemp = ( char * ) sx_GetVariant( ( PBYTE ) cFieldName ); + if( ! bSDF ) + cTemp = _sx_rtrim( cTemp ); + else + { + cTemp = _sx_padl( cTemp, ' ', + sx_FieldWidth( ( PBYTE ) cFieldName ) + sx_FieldDecimals( ( PBYTE ) cFieldName ) ); + cDelimiter = " "; + } + + if( i < uiLen - 1 ) + fprintf( hFileHandle, "%s%s", cTemp, cDelimiter ); + else + fprintf( hFileHandle, "%s", cTemp ); + } + } + + fprintf( hFileHandle, "\n" ); + } + } +} + +HB_FUNC( __SX_DBDELIM ) /* (file, delim, afields, bfor, bwhile, nnext, nrec, lrest, cAlias ) */ +{ + LONG nNextRecords, + nRecNo; + HB_BOOL lRest, + bGoTop; + LONG nCurrentRecNo, + ulCount, + ulRecNo; + PHB_ITEM paFields = hb_param( 3, HB_IT_ARRAY ); + PHB_ITEM pbFor = hb_param( 4, HB_IT_BLOCK ); + PHB_ITEM pbCondition = hb_param( 5, HB_IT_BLOCK ); + FILE * hFileHandle; + char * cpFileName; + char * cDelimiter; + WORD iWorkArea = SX_DUMMY_NUMBER; + + /* Check WorkArea */ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_NOALIAS, NULL, "__SX_DBDELIM" ); + + if( ! HB_ISNIL( 9 ) ) + iWorkArea = _sx_select( hb_param( 9, HB_IT_ANY ) ); + + /* Current Record Position */ + nCurrentRecNo = sx_RecNo(); + + /* FileName To Create Passed ? */ + if( ! HB_ISCHAR( 1 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBDELIM" ); + else + { + cpFileName = ( char * ) hb_parc( 1 ); + if( strlen( cpFileName ) == 0 ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_NOALIAS, NULL, "__SX_DBDELIM" ); + + /* Delimiter passed ? Defaulted to space */ + if( HB_ISCHAR( 2 ) ) + cDelimiter = ( char * ) hb_parc( 2 ); + else + cDelimiter = " "; + + if( strcmp( cDelimiter, "SDF" ) == 0 ) + bSDF = HB_TRUE; + else + bSDF = HB_FALSE; + + /* CodeBlock passed ? */ + if( ! HB_ISNIL( 4 ) && ! HB_ISBLOCK( 4 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBDELIM" ); + + if( ! HB_ISNIL( 5 ) && ! HB_ISBLOCK( 5 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBDELIM" ); + + /* Next Records */ + if( HB_ISNUM( 6 ) ) + nNextRecords = hb_parnl( 6 ); + else + nNextRecords = -1; + + /* Record Number to process */ + if( HB_ISNUM( 7 ) ) + { + nRecNo = hb_parnl( 7 ); + + /* nRecNo should be <= LastRec() */ + if( nRecNo > sx_RecCount() || nRecNo < 1 ) + return; + + /* nRecNo vs Current Position vs Next Clause */ + if( nNextRecords > 0 && nRecNo <= nCurrentRecNo ) + return; + } + else + nRecNo = -1; + + /* Process all records ? */ + if( HB_ISLOG( 8 ) ) + lRest = hb_parl( 8 ); + else + lRest = HB_TRUE; + + if( nNextRecords == -1 && nRecNo == -1 ) + { + lRest = HB_TRUE; + bGoTop = HB_TRUE; + } + else + bGoTop = HB_FALSE; + + /* Creating File Handle */ + hFileHandle = hb_fopen( ( const char * ) cpFileName, "w+" ); + + if( ! hFileHandle ) + hb_retl( HB_FALSE ); + + /* Now Processing Data ..... */ + /* All Records Until Eof() With For And Condition */ + if( bGoTop && lRest && HB_ISBLOCK( 4 ) && HB_ISBLOCK( 5 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 4 ) && HB_ISBLOCK( 5 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISBLOCK( 4 ) && HB_ISNIL( 5 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 4 ) && HB_ISNIL( 5 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + } + } + /* nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 4 ) && HB_ISBLOCK( 5 ) ) + { + while + ( + ( ulCount <= nNextRecords - 1 ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + if( _sx_Eval( pbFor ) ) + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 4 ) && HB_ISBLOCK( 5 ) ) + { + while + ( + ( ulCount <= nNextRecords - 1 ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 4 ) && HB_ISNIL( 5 ) ) + { + while( ( ulCount <= nNextRecords - 1 ) && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 4 ) && HB_ISNIL( 5 ) ) + { + while( ( ulCount < nNextRecords - 1 ) && ! sx_Eof() ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nNextRecords Clause with nRecNo Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) && ( nRecNo > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 4 ) && HB_ISBLOCK( 5 ) ) + { + while + ( + ( ulCount <= nNextRecords - 1 ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 4 ) && HB_ISBLOCK( 5 ) ) + { + while + ( + ( ulCount <= nNextRecords - 1 ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 4 ) && HB_ISNIL( 5 ) ) + { + while( ( ulCount <= nNextRecords - 1 ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 4 ) && HB_ISNIL( 5 ) ) + { + while( ( ulCount <= nNextRecords - 1 ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nRecNo Clause with no nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nRecNo > 0 ) ) + { + if( HB_ISBLOCK( 4 ) && HB_ISBLOCK( 5 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 4 ) && HB_ISBLOCK( 5 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISBLOCK( 4 ) && HB_ISNIL( 5 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 4 ) && HB_ISNIL( 5 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_GetLine( paFields, hFileHandle, cDelimiter ); + break; + } + + sx_Skip( 1 ); + } + } + } + + /* Close The File */ + fclose( hFileHandle ); + hb_retl( HB_TRUE ); + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } +} diff --git a/harbour/examples/hbapollo/dbedit.prg b/harbour/examples/hbapollo/dbedit.prg new file mode 100644 index 0000000000..068c81ac32 --- /dev/null +++ b/harbour/examples/hbapollo/dbedit.prg @@ -0,0 +1,370 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * DBEDIT() function + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://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. + * + */ + +#include "dbedit.ch" +#include "inkey.ch" +#include "setcurs.ch" + +/* NOTE: Extension: Harbour supports codeblocks as the xUserFunc parameter + [vszakats] */ +/* NOTE: Clipper is buggy and will throw an error if the number of + columns is zero. (Check: dbEdit(0,0,20,20,{})) [vszakats] */ +/* NOTE: Clipper will throw an error if there's no database open [vszakats] */ +/* NOTE: The NG says that the return value is NIL, but it's not. [vszakats] */ +/* NOTE: Harbour is multithreading ready and Clipper only reentrant safe + [vszakats] */ + +FUNCTION DBEDIT( nTop, nLeft, nBottom, nRight, ; + acColumns, xUserFunc, ; + xColumnSayPictures, xColumnHeaders, ; + xHeadingSeparators, xColumnSeparators, ; + xFootingSeparators, xColumnFootings ) + + LOCAL nOldCUrsor, nKey, lContinue, nPos, nAliasPos, nColCount + LOCAL lDoIdleCall, lAppend, lFlag + LOCAL cHeading, cBlock + LOCAL bBlock + LOCAL oBrowse + LOCAL oColumn + LOCAL aCol + + IF !Used() + RETURN .F. + ELSEIF EOF() + dbGoBottom() + ENDIF + + IF ! HB_ISNUMERIC( nTop ) .OR. nTop < 0 + nTop := 0 + ENDIF + IF ! HB_ISNUMERIC( nLeft ) .OR. nLeft < 0 + nLeft := 0 + ENDIF + IF ! HB_ISNUMERIC( nBottom ) .OR. nBottom > MaxRow() .OR. nBottom < nTop + nBottom := MaxRow() + ENDIF + IF ! HB_ISNUMERIC( nRight ) .OR. nRight > MaxCol() .OR. nRight < nLeft + nRight := MaxCol() + ENDIF + + oBrowse := TBrowseDb( nTop, nLeft, nBottom, nRight ) + oBrowse:headSep := iif( HB_ISSTRING( xHeadingSeparators ), xHeadingSeparators, Chr( 205 ) + Chr( 209 ) + Chr( 205 ) ) + oBrowse:colSep := iif( HB_ISSTRING( xColumnSeparators ), xColumnSeparators, " " + Chr( 179 ) + " " ) + oBrowse:footSep := iif( HB_ISSTRING( xFootingSeparators ), xFootingSeparators, "" ) + oBrowse:skipBlock := {| nRecs | sx_dbSkipper( nRecs, lAppend ) } + oBrowse:autoLite := .F. /* Set to .F. just like in CA-Cl*pper. [vszakats] */ + + IF HB_ISARRAY( acColumns ) + nColCount := 0 + FOR EACH aCol IN acColumns + IF HB_ISSTRING( aCol ) .AND. !Empty( aCol ) + nColCount++ + ELSE + EXIT + ENDIF + NEXT + ELSE + nColCount := sx_FieldCount() + ENDIF + + IF nColCount == 0 + RETURN .F. + ENDIF + + /* Generate the TBrowse columns */ + + FOR nPos := 1 TO nColCount + + IF HB_ISARRAY( acColumns ) + cBlock := acColumns[ nPos ] + IF ( nAliasPos := At( "->", cBlock ) ) > 0 + cHeading := SubStr( cBlock, 1, nAliasPos - 1 ) + "->;" + ; + SubStr( cBlock, nAliasPos + 2 ) + ELSE + cHeading := cBlock + ENDIF + ELSE + cBlock := sx_FieldName( nPos ) + cHeading := cBlock + ENDIF + + /* Simplified logic compared to CA-Cl*pper. In the latter there + is logic to detect several typical cBlock types (memvar, + aliased field, field) and using MemvarBlock()/FieldWBlock()/FieldBlock() + calls to create codeblocks for them if possible. In Harbour, + simple macro compilation will result in faster code for all + situations. As Maurilio Longo has pointed, there is no point in + creating codeblocks which are able to _assign_ values, as dbEdit() + is a read-only function. [vszakats] */ + + bBlock := iif( Type( cBlock ) == "M", {|| " " }, hb_macroBlock( cBlock ) ) + + /* ; */ + + IF HB_ISARRAY( xColumnHeaders ) .AND. Len( xColumnHeaders ) >= nPos .AND. HB_ISSTRING( xColumnHeaders[ nPos ] ) + cHeading := xColumnHeaders[ nPos ] + ELSEIF HB_ISSTRING( xColumnHeaders ) + cHeading := xColumnHeaders + ENDIF + + oColumn := TBColumnNew( cHeading, bBlock ) + + IF HB_ISARRAY( xColumnSayPictures ) .AND. nPos <= Len( xColumnSayPictures ) .AND. HB_ISSTRING( xColumnSayPictures[ nPos ] ) .AND. !Empty( xColumnSayPictures[ nPos ] ) + oColumn:picture := xColumnSayPictures[ nPos ] + ELSEIF HB_ISSTRING( xColumnSayPictures ) .AND. !Empty( xColumnSayPictures ) + oColumn:picture := xColumnSayPictures + ENDIF + + IF HB_ISARRAY( xColumnFootings ) .AND. nPos <= Len( xColumnFootings ) .AND. HB_ISSTRING( xColumnFootings[ nPos ] ) + oColumn:footing := xColumnFootings[ nPos ] + ELSEIF HB_ISSTRING( xColumnFootings ) + oColumn:footing := xColumnFootings + ENDIF + + IF HB_ISARRAY( xHeadingSeparators ) .AND. nPos <= Len( xHeadingSeparators ) .AND. HB_ISSTRING( xHeadingSeparators[ nPos ] ) + oColumn:headSep := xHeadingSeparators[ nPos ] + ENDIF + + IF HB_ISARRAY( xColumnSeparators ) .AND. nPos <= Len( xColumnSeparators ) .AND. HB_ISSTRING( xColumnSeparators[ nPos ] ) + oColumn:colSep := xColumnSeparators[ nPos ] + ENDIF + + IF HB_ISARRAY( xFootingSeparators ) .AND. nPos <= Len( xFootingSeparators ) .AND. HB_ISSTRING( xFootingSeparators[ nPos ] ) + oColumn:footSep := xFootingSeparators[ nPos ] + ENDIF + + oBrowse:addColumn( oColumn ) + + NEXT + + nOldCUrsor := SetCursor( SC_NONE ) + + /* --------------------------- */ + /* Go into the processing loop */ + /* --------------------------- */ + + lAppend := .F. + lFlag := .T. + lDoIdleCall := .T. + lContinue := .T. + + DO WHILE lContinue + + DO WHILE ! oBrowse:stabilize() + nKey := Nextkey() +#ifdef HB_COMPAT_C53 + IF nKey != 0 .AND. nKey != K_MOUSEMOVE +#else + IF nKey != 0 +#endif + EXIT + ENDIF + ENDDO + + IF ( nKey := Inkey() ) == 0 + IF lDoIdleCall + lContinue := CallUser( oBrowse, xUserFunc, 0, @lAppend, @lFlag ) + oBrowse:forceStable() + ENDIF + IF lContinue .AND. lFlag + oBrowse:hiLite() +#ifdef HB_COMPAT_C53 + DO WHILE ( nKey := Inkey( 0 ) ) == K_MOUSEMOVE + ENDDO +#else + nKey := Inkey( 0 ) +#endif + oBrowse:deHilite() + IF ( bBlock := SetKey( nKey ) ) != NIL + Eval( bBlock, ProcName( 1 ), ProcLine( 1 ), "" ) + LOOP + ENDIF + ELSE + lFlag := .T. + ENDIF + ENDIF + + lDoIdleCall := .T. + + IF nKey != 0 +#ifdef HB_CLP_UNDOC + IF lAppend + SWITCH nKey + CASE K_DOWN + CASE K_PGDN + CASE K_CTRL_PGDN + oBrowse:hitBottom := .T. + LOOP + CASE K_UP + CASE K_PGUP + CASE K_CTRL_PGUP + oBrowse:hitTop := .T. + LOOP + ENDSWITCH + ENDIF +#endif + SWITCH nKey +#ifdef HB_COMPAT_C53 + CASE K_LBUTTONDOWN + CASE K_LDBLCLK + TBMouse( oBrowse, MRow(), MCol() ) + EXIT +#endif + CASE K_DOWN ; oBrowse:down() ; EXIT + CASE K_UP ; oBrowse:up() ; EXIT + CASE K_PGDN ; oBrowse:pageDown() ; EXIT + CASE K_PGUP ; oBrowse:pageUp() ; EXIT + CASE K_CTRL_PGUP ; oBrowse:goTop() ; EXIT + CASE K_CTRL_PGDN ; oBrowse:goBottom() ; EXIT + CASE K_RIGHT ; oBrowse:right() ; EXIT + CASE K_LEFT ; oBrowse:left() ; EXIT + CASE K_HOME ; oBrowse:home() ; EXIT + CASE K_END ; oBrowse:end() ; EXIT + CASE K_CTRL_LEFT ; oBrowse:panLeft() ; EXIT + CASE K_CTRL_RIGHT ; oBrowse:panRight() ; EXIT + CASE K_CTRL_HOME ; oBrowse:panHome() ; EXIT + CASE K_CTRL_END ; oBrowse:panEnd() ; EXIT + OTHERWISE + lContinue := CallUser( oBrowse, xUserFunc, nKey, @lAppend, @lFlag ) + lDoIdleCall := .F. + EXIT + ENDSWITCH + ENDIF + ENDDO + + SetCursor( nOldCUrsor ) + + RETURN .T. + + +/* NOTE: CA-Cl*pper uses intermediate function CALLUSER() + * to execute user function. We're replicating this behavior + * for code which may check ProcName() results in user function + */ +STATIC FUNCTION CallUser( oBrowse, xUserFunc, nKey, lAppend, lFlag ) + + LOCAL nPrevRecNo + + LOCAL nAction + LOCAL nMode := iif( nKey != 0, DE_EXCEPT, ; + iif( !lAppend .AND. IsDbEmpty(), DE_EMPTY, ; + iif( oBrowse:hitBottom, DE_HITBOTTOM, ; + iif( oBrowse:hitTop, DE_HITTOP, DE_IDLE ) ) ) ) + + oBrowse:forceStable() + + nPrevRecNo := sx_RecNo() + + /* NOTE: CA-Cl*pper won't check the type of the return value here, + and will crash if it's a non-NIL, non-numeric type. We're + replicating this behavior. */ + nAction := iif( HB_ISBLOCK( xUserFunc ), ; + Eval( xUserFunc, nMode, oBrowse:colPos ), ; + iif( HB_ISSTRING( xUserFunc ) .AND. !Empty( xUserFunc ), ; + &xUserFunc( nMode, oBrowse:colPos ), ; + iif( nKey == K_ENTER .OR. nKey == K_ESC, DE_ABORT, DE_CONT ) ) ) + + IF !lAppend .AND. sx_EOF() .AND. !IsDbEmpty() + sx_dbSkip( -1 ) + ENDIF + +#ifdef HB_CLP_UNDOC + IF nAction == DE_APPEND + + IF ( lAppend := !( lAppend .AND. sx_EOF() ) ) + dbGoBottom() + oBrowse:down() + ELSE + oBrowse:refreshAll():forceStable() + ENDIF + lFlag := .F. + RETURN .T. + ENDIF +#endif + + IF nAction == DE_REFRESH .OR. nPrevRecNo != RecNo() + + IF nAction != DE_ABORT + + lAppend := .F. + + IF ( Set( _SET_DELETED ) .AND. sx_Deleted() ) .OR. ; + ( !Empty( dbfilter() ) .AND. !&( dbFilter() ) ) + sx_dbSkip() + ENDIF + IF EOF() + sx_dbGoBottom() + ENDIF + + nPrevRecNo := sx_RecNo() + oBrowse:refreshAll():forceStable() + DO WHILE nPrevRecNo != sx_RecNo() + oBrowse:Up():forceStable() + ENDDO + + lFlag := .F. + + ENDIF + ELSE + oBrowse:refreshCurrent() + ENDIF + + RETURN nAction != DE_ABORT + + +/* helper function to detect empty tables. It's not perfect but + * it functionally uses the same conditions as CA-Cl*pper + */ +STATIC FUNCTION IsDbEmpty() + + RETURN sx_LastRec() == 0 .OR. ; + ( sx_BOF() .AND. ( sx_EOF() .OR. sx_RecNo() == sx_LastRec() + 1 ) ) diff --git a/harbour/examples/hbapollo/dbeval.c b/harbour/examples/hbapollo/dbeval.c new file mode 100644 index 0000000000..f9bfe93784 --- /dev/null +++ b/harbour/examples/hbapollo/dbeval.c @@ -0,0 +1,321 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_DBEVAL ) /* (bBlock,bFor,bCOndition,nNextRecords,nRecords,lRest) */ +{ + /* Param 7 added as work area selected 2003.05.08 */ + LONG nNextRecords, + nRecNo; + HB_BOOL lRest, + bGoTop; + LONG nCurrentRecNo, + ulCount, + ulRecNo; + WORD wPreviousArea = SX_DUMMY_NUMBER; + PHB_ITEM pbBlock = hb_param( 1, HB_IT_BLOCK ); + PHB_ITEM pbFor = hb_param( 2, HB_IT_BLOCK ); + PHB_ITEM pbCondition = hb_param( 3, HB_IT_BLOCK ); + + if( ! _sx_Used() ) + { + hb_itemRelease( pbBlock ); + hb_itemRelease( pbFor ); + hb_itemRelease( pbCondition ); + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_DBEVAL" ); + } + + if( ! HB_ISNIL( 7 ) ) + wPreviousArea = _sx_select( hb_param( 7, HB_IT_ANY ) ); + + /* Current Record Position */ + nCurrentRecNo = sx_RecNo(); + + /* CoceBlock passed ? */ + if( ! HB_ISBLOCK( 1 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "SX_DBEVAL" ); + + if( ! HB_ISNIL( 2 ) && ! HB_ISBLOCK( 2 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "SX_DBEVAL" ); + + if( ! HB_ISNIL( 3 ) && ! HB_ISBLOCK( 3 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "SX_DBEVAL" ); + + /* Next Records */ + if( HB_ISNUM( 4 ) ) + nNextRecords = hb_parnl( 4 ); + else + nNextRecords = -1; + + /* Record Number to process */ + if( HB_ISNUM( 5 ) ) + { + nRecNo = hb_parnl( 5 ); + + /* nRecNo should be <= LastRec() */ + if( nRecNo > sx_RecCount() || nRecNo < 1 ) + return; + + /* nRecNo vs Current Position vs Next Clause */ + if( nNextRecords > 0 && nRecNo <= nCurrentRecNo ) + return; + } + else + nRecNo = -1; + + /* Process all records ? */ + if( HB_ISLOG( 6 ) ) + lRest = hb_parl( 6 ); + else + lRest = HB_TRUE; + + if( nNextRecords == -1 && nRecNo == -1 ) + { + lRest = HB_TRUE; + bGoTop = HB_TRUE; + } + else + bGoTop = HB_FALSE; + + /* Now Processing Data ..... */ + /* All Records Until Eof() With For And Condition */ + if( bGoTop && lRest && HB_ISBLOCK( 2 ) && HB_ISBLOCK( 3 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_Eval( pbBlock ); + + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 2 ) && HB_ISBLOCK( 3 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + _sx_Eval( pbBlock ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISBLOCK( 2 ) && HB_ISNIL( 3 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_Eval( pbBlock ); + + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 2 ) && HB_ISNIL( 3 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + _sx_Eval( pbBlock ); + sx_Skip( 1 ); + } + } + /* nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 2 ) && HB_ISBLOCK( 3 ) ) + { + while( ulCount <= nNextRecords && _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_Eval( pbBlock ); + + sx_Skip( 1 ); + + ulCount++; + } + } + else if( HB_ISNIL( 2 ) && HB_ISBLOCK( 3 ) ) + { + while( ulCount <= nNextRecords && _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + _sx_Eval( pbBlock ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 2 ) && HB_ISNIL( 3 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + _sx_Eval( pbBlock ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 2 ) && HB_ISNIL( 3 ) ) + { + while( ulCount < nNextRecords && ! sx_Eof() ) + { + _sx_Eval( pbBlock ); + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nNextRecords Clause with nRecNo Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) && ( nRecNo > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 2 ) && HB_ISBLOCK( 3 ) ) + { + while( ulCount <= nNextRecords && _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 2 ) && HB_ISBLOCK( 3 ) ) + { + while( ulCount <= nNextRecords && _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 2 ) && HB_ISNIL( 3 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 2 ) && HB_ISNIL( 3 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nRecNo Clause with no nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nRecNo > 0 ) ) + { + if( HB_ISBLOCK( 2 ) && HB_ISBLOCK( 3 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 2 ) && HB_ISBLOCK( 3 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISBLOCK( 2 ) && HB_ISNIL( 3 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 2 ) && HB_ISNIL( 3 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + _sx_Eval( pbBlock ); + break; + } + + sx_Skip( 1 ); + } + } + } + + /* Back to Previous Work Area */ + if( ! ( wPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( wPreviousArea ); +} diff --git a/harbour/examples/hbapollo/dbsort.c b/harbour/examples/hbapollo/dbsort.c new file mode 100644 index 0000000000..0fa22d8492 --- /dev/null +++ b/harbour/examples/hbapollo/dbsort.c @@ -0,0 +1,465 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +static void __sx_CopyRecord( PBYTE cTargetAlias, PBYTE cSourceAlias ); + +HB_FUNC( __SX_DBSORT ) /* (file,afields,bfor,bwhile,nnext,nrec,lrest,rdd,ldescend,cAlias) */ +{ + LONG nNextRecords, + nRecNo; + HB_BOOL lRest, + bGoTop; + LONG nCurrentRecNo, + ulCount, + ulRecNo; + PHB_ITEM pArray = hb_param( 2, HB_IT_ARRAY ); + PHB_ITEM pbFor = hb_param( 3, HB_IT_BLOCK ); + PHB_ITEM pbCondition = hb_param( 4, HB_IT_BLOCK ); + PHB_ITEM vParam = hb_param( 10, HB_IT_ANY ); + int iRDEType; /* RDD to use for new DBF file */ + PBYTE cNewDBFFile; /* New DBF File name */ + PBYTE cSourceAlias; /* New Alias for new DBF opened */ + PBYTE cNewAlias; /* New Alias for new DBF opened */ + HB_ISIZ uilenpArray, + ui; + char * cFieldType, + * cFieldName; + char cIndexExpression[ 256 ]; + HB_BOOL bDescending = HB_FALSE; + int iWorkArea = 0; + + /* Check WorkArea */ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_NOALIAS, NULL, "__SX_DBSORT" ); + + if( vParam && ! HB_ISNIL( 10 ) ) + iWorkArea = _sx_select( vParam ); + + /* Alias of currently selected area */ + cSourceAlias = ( PBYTE ) sx_Alias( 0 ); + + /* Current Record Position */ + nCurrentRecNo = sx_RecNo(); + + /* New file name passed ? */ + if( ! HB_ISCHAR( 1 ) ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBSORT" ); + else + { + cNewDBFFile = ( PBYTE ) hb_parc( 1 ); + + /* Reject if empty string is passed */ + if( strlen( ( char * ) cNewDBFFile ) == 0 ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBSORT" ); + cNewAlias = ( PBYTE ) _sx_AutoAlias( ( char * ) hb_parc( 1 ) ); + + if( ! HB_ISNIL( 3 ) && ! HB_ISBLOCK( 3 ) ) + { + hb_xfree( cNewAlias ); + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBSORT" ); + } + + if( ! HB_ISNIL( 4 ) && ! HB_ISBLOCK( 4 ) ) + { + hb_xfree( cNewAlias ); + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBSORT" ); + } + + /* Next Records */ + if( HB_ISNUM( 5 ) ) + nNextRecords = hb_parnl( 5 ); + else + nNextRecords = -1; + + /* Record Number to process */ + if( HB_ISNUM( 6 ) ) + { + nRecNo = hb_parnl( 6 ); + + /* nRecNo should be <= LastRec() */ + if( nRecNo > sx_RecCount() || nRecNo < 1 ) + { + hb_xfree( cNewAlias ); + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBSORT" ); + return; + } + + /* nRecNo vs Current Position vs Next Clause */ + if( nNextRecords > 0 && nRecNo <= nCurrentRecNo ) + { + hb_xfree( cNewAlias ); + hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "__SX_DBSORT" ); + return; + } + } + else + nRecNo = -1; + + /* Process all records ? */ + if( HB_ISLOG( 7 ) ) + lRest = hb_parl( 7 ); + else + lRest = HB_TRUE; + + if( nNextRecords == -1 && nRecNo == -1 ) + { + lRest = HB_TRUE; + bGoTop = HB_TRUE; + } + else + bGoTop = HB_FALSE; + + /* RDE Type Passed ? */ + if( HB_ISCHAR( 8 ) ) + { + char * cRDDChosen = ( char * ) hb_parc( 8 ); + iRDEType = _sx_CheckRDD( cRDDChosen ); + } + else + iRDEType = i_sxApi_RDD_Default; + + if( HB_ISLOG( 9 ) ) + bDescending = hb_parl( 9 ); + + /* Now Processing Data ..... */ + /* All Records Until Eof() With For And Condition */ + sx_Select( sx_WorkArea( cSourceAlias ) ); + + /* Checking Array of Fields FOR MAKING INDEX ! */ + uilenpArray = hb_arrayLen( pArray ); + *cIndexExpression = '\0'; + if( uilenpArray > 0 ) + { + for( ui = 0; ui < uilenpArray; ui++ ) + { + cFieldName = ( char * ) hb_arrayGetC( pArray, ui + 1 ); + cFieldType = ( char * ) sx_FieldType( ( PBYTE ) cFieldName ); + switch( *cFieldType ) + { + case 'C': + _sx_strcat( cIndexExpression, cFieldName, NULL ); + if( ui < uilenpArray - 1 ) + _sx_strcat( cIndexExpression, "+", NULL ); + hb_xfree( cFieldName ); + break; + + case 'D': + _sx_strcat( cIndexExpression, "DTOS(", cFieldName, ")", NULL ); + if( ui < uilenpArray - 1 ) + _sx_strcat( cIndexExpression, "+", NULL ); + hb_xfree( cFieldName ); + break; + + case 'N': + _sx_strcat( cIndexExpression, "STR(", cFieldName, ")", NULL ); + if( ui < uilenpArray - 1 ) + _sx_strcat( cIndexExpression, "+", NULL ); + hb_xfree( cFieldName ); + break; + + case 'L': + _sx_strcat( cIndexExpression, "IF(", cFieldName, ",'T','F')", NULL ); + if( ui < uilenpArray - 1 ) + _sx_strcat( cIndexExpression, "+", NULL ); + hb_xfree( cFieldName ); + break; + } + } + + /* Make Index Here ... */ + if( *cIndexExpression ) + { + sx_Index( ( PBYTE ) "c:\\windows\\temp\\temporary", + ( PBYTE ) cIndexExpression, IDX_NONE, bDescending, ( PBYTE ) 0 ); + } + } + + /* Create New DBF based on Source Structure */ + if( ! sx_CopyStructure( cNewDBFFile, cNewAlias ) ) + return; + if( ! sx_Use( cNewDBFFile, cNewAlias, EXCLUSIVE, ( WORD ) iRDEType ) ) + return; + + /* Back to Source Alias */ + sx_Select( sx_WorkArea( cSourceAlias ) ); + + if( bGoTop && lRest && HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + sx_GoTop(); + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + } + } + else if( bGoTop && lRest && HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + sx_GoTop(); + while( ! sx_Eof() ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + } + } + /* nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + while + ( + ( ulCount <= nNextRecords ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + if( _sx_Eval( pbFor ) ) + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + while + ( + ( ulCount <= nNextRecords ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + if( _sx_Eval( pbFor ) ) + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount < nNextRecords && ! sx_Eof() ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nNextRecords Clause with nRecNo Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nNextRecords > 0 ) && ( nRecNo > 0 ) ) + { + ulCount = 0; + if( HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + while + ( + ( ulCount <= nNextRecords ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + while + ( + ( ulCount <= nNextRecords ) && + _sx_Eval( pbCondition ) && + ! sx_Eof() + ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + else if( HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + while( ulCount <= nNextRecords && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + ulCount++; + } + } + } + /* nRecNo Clause with no nNextRecords Clause */ + /* lRest is assumed HB_FALSE */ + else if( ! bGoTop && ( nRecNo > 0 ) ) + { + if( HB_ISBLOCK( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo && _sx_Eval( pbFor ) ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 3 ) && HB_ISBLOCK( 4 ) ) + { + while( _sx_Eval( pbCondition ) && ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISBLOCK( 3 ) && HB_ISNIL( 4 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + } + } + else if( HB_ISNIL( 3 ) && HB_ISNIL( 4 ) ) + { + while( ! sx_Eof() ) + { + ulRecNo = sx_RecNo(); + if( nRecNo == ulRecNo ) + { + __sx_CopyRecord( cNewAlias, cSourceAlias ); + break; + } + + sx_Skip( 1 ); + } + } + } + + /* Free allocated memory */ + sx_Select( sx_WorkArea( cNewAlias ) ); /* Select New Area */ + sx_Commit(); + sx_Close(); /* Close It */ + if( vParam && ! HB_ISNIL( 10 ) ) + sx_Select( ( WORD ) iWorkArea ); + + /* Now We In Source Area */ + #if 0 + sx_CloseIndexes(); + unlink((char*)"c:\\windows\\temp\\temporary"); + #endif + if( cNewAlias ) + hb_xfree( cNewAlias ); + } +} + +static void __sx_CopyRecord( PBYTE cTarget, PBYTE cSource ) +{ + char cRecord[ 256 ]; + + sx_GetRecord( ( PBYTE ) cRecord ); /* Get Record from source */ + sx_Select( sx_WorkArea( cTarget ) ); /* Select New Area */ + sx_AppendBlank(); /* Append Blank Record */ + sx_PutRecord( ( PBYTE ) cRecord ); /* Put the new record */ + sx_Select( sx_WorkArea( cSource ) ); /* Select Source Area */ +} diff --git a/harbour/examples/hbapollo/dbstru.c b/harbour/examples/hbapollo/dbstru.c new file mode 100644 index 0000000000..6d23d12da3 --- /dev/null +++ b/harbour/examples/hbapollo/dbstru.c @@ -0,0 +1,274 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_COPYSTRUCTURE ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_COPYSTRUCTURE" ); + + if( HB_ISCHAR( 1 ) ) + { +#if 0 + HB_BOOL bAllocated = HB_FALSE; +#endif + PHB_ITEM paFields = hb_param( 2, HB_IT_ARRAY ); + HB_ISIZ uilenpArray = 0; + WORD iWorkArea = SX_DUMMY_NUMBER; + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + if( paFields ) + uilenpArray = hb_arrayLen( paFields ); + + if( uilenpArray == 0 ) + { +#if 0 + paFields = _sx_FieldNames(); + bAllocated = HB_TRUE; +#endif + hb_retl( sx_CopyStructure( ( PBYTE ) szTmp, ( PBYTE ) "__TEMP" ) ); + } + else + { + hb_retl( _sx_CopyStructure( ( PBYTE ) szTmp, paFields ) ); + } + + hb_xfree( szTmp ); + +#if 0 + if( bAllocated ) + hb_itemRelease( paFields ); +#endif + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); +} + +HB_BOOL _sx_CopyStructure( PBYTE cpFileName, PHB_ITEM paFields ) +{ + PHB_ITEM pStruct = hb_itemNew( NULL ); + PHB_ITEM pData = hb_itemNew( NULL ); + PHB_ITEM pItem = hb_itemNew( NULL ); + PHB_ITEM pFieldDesc, + pTemp = NULL; + + int iLenSource = sx_FieldCount(); + HB_ISIZ i, + ui, + uilenpArray = 0; + + char * cpFieldName, + * cFieldToCopy; + + PBYTE cFieldName; + PBYTE cFieldType; + SHORT iFieldLen; + SHORT iDec; + HB_BOOL bSuccess = HB_FALSE; + + if( paFields ) + uilenpArray = hb_arrayLen( paFields ); + + if( uilenpArray ) + { + hb_arrayNew( pStruct, 0 ); + + for( i = 0; i < iLenSource; i++ ) + { + cpFieldName = ( char * ) sx_FieldName( ( WORD ) ( i + 1 ) ); + for( ui = 0; ui < uilenpArray; ui++ ) + { + cFieldToCopy = ( char * ) hb_arrayGetCPtr( paFields, ui + 1 ); + if( strcmp( cpFieldName, cFieldToCopy ) == 0 ) + { + hb_arrayNew( pItem, 4 ); + pTemp = hb_itemPutC( NULL, cpFieldName ); + hb_arraySet( pItem, 1, pTemp ); + hb_itemRelease( pTemp ); + pTemp = hb_itemPutC( NULL, ( char * ) sx_FieldType( ( PBYTE ) cpFieldName ) ); + hb_arraySet( pItem, 2, pTemp ); + hb_itemRelease( pTemp ); + hb_arraySet( pItem, 3, hb_itemPutNI( pData, sx_FieldWidth( ( PBYTE ) cpFieldName ) ) ); + hb_arraySet( pItem, 4, hb_itemPutNI( pData, sx_FieldDecimals( ( PBYTE ) cpFieldName ) ) ); + hb_arrayAdd( pStruct, pItem ); + } + } + } + + hb_itemRelease( pItem ); + hb_itemRelease( pData ); + + if( pTemp ) + hb_itemClear( pTemp ); + } + + /* Reuse variable for new array */ + uilenpArray = hb_arrayLen( pStruct ); + + /* OK Now we Get new array in &hb_stack.Return */ + /* Will create DBF as per new array */ + if( uilenpArray ) + { + #if 0 + printf( "_sx_CopyStructure... cpFileName=>>%s<<\n", cpFileName ); + printf( "_sx_CopyStructure... i_sxApi_RDD_Default=>>%i<<\n", i_sxApi_RDD_Default ); + printf( "_sx_CopyStructure... uilenpArray=>>%i<<\n", uilenpArray ); + sx_CreateNew( ( PBYTE ) cpFileName, ( PBYTE ) "TEMPORARY_STRUCT", i_sxApi_RDD_Default, uilenpArray ); + #endif + sx_CreateNew( ( PBYTE ) cpFileName, ( PBYTE ) "__TEMP", ( WORD ) i_sxApi_RDD_Default, + ( WORD ) uilenpArray ); + + /* printf( "_sx_CopyStructure...2\n"); */ + for( ui = 0; ui < uilenpArray; ui++ ) + { + pFieldDesc = hb_arrayGetItemPtr( pStruct, ui + 1 ); + cFieldName = ( PBYTE ) hb_arrayGetC( pFieldDesc, 1 ); + cFieldType = ( PBYTE ) hb_arrayGetC( pFieldDesc, 2 ); + iFieldLen = ( SHORT ) hb_arrayGetNI( pFieldDesc, 3 ); + iDec = ( SHORT ) hb_arrayGetNI( pFieldDesc, 4 ); + + /* printf("Creating %s\n", cFieldName ); */ + sx_CreateField( cFieldName, cFieldType, iFieldLen, iDec ); + hb_xfree( cFieldName ); + hb_xfree( cFieldType ); + } + + hb_itemRelease( pStruct ); + bSuccess = sx_CreateExec(); + if( bSuccess ) + sx_Close(); + } + + return bSuccess; +} + +HB_FUNC( SX_COPYSTRUCTUREEXTENDED ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, + "SX_COPYSTRUCTUREEXTENDED" ); + + if( HB_ISCHAR( 1 ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_CopyStructureExtended( ( PBYTE ) hb_parc( 1 ) ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); +} + +HB_FUNC( SX_DBSTRUCT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PHB_ITEM pStruct; + + if( ! _sx_Used() ) + return; + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + pStruct = _sx_DbStruct(); + hb_itemReturnRelease( pStruct ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +PHB_ITEM _sx_DbStruct() +{ + PHB_ITEM pStruct = hb_itemNew( NULL ); + PHB_ITEM pData = hb_itemNew( NULL ); + PHB_ITEM pItem = hb_itemNew( NULL ); + HB_USHORT uiFields = sx_FieldCount(), + uiCount; + + hb_arrayNew( pStruct, 0 ); + + for( uiCount = 1; uiCount <= uiFields; uiCount++ ) + { + int iWidth; + int iDec; + PBYTE cFieldName = ( PBYTE ) sx_FieldName( ( WORD ) uiCount ); + + iWidth = sx_FieldWidth( cFieldName ); + iDec = sx_FieldDecimals( cFieldName ); + + /* + iWidth and iDec MUST beinitialized as above else int returns 65535 + we cannot directly called: + hb_arraySet( pItem, 3, hb_itemPutNI( pData, sx_FieldWidth( cFieldName ) ) ); + hb_arraySet( pItem, 4, hb_itemPutNI( pData, sx_FieldDecimals( cFieldName ) ) ); + */ + hb_arrayNew( pItem, 4 ); + hb_arraySet( pItem, 1, hb_itemPutC( pData, ( char * ) cFieldName ) ); + hb_arraySet( pItem, 2, hb_itemPutC( pData, ( char * ) sx_FieldType( cFieldName ) ) ); + hb_arraySet( pItem, 3, hb_itemPutNI( pData, iWidth ) ); + hb_arraySet( pItem, 4, hb_itemPutNI( pData, iDec ) ); + hb_arrayAdd( pStruct, pItem ); + } + + hb_itemRelease( pItem ); + hb_itemRelease( pData ); + + return pStruct; +} + +PHB_ITEM _sx_FieldNames( void ) +{ + PHB_ITEM pStruct = hb_itemNew( NULL ); + HB_USHORT uiFields, + uiCount; + char * cFieldName; + PHB_ITEM pItem; + + hb_arrayNew( pStruct, 0 ); + + uiFields = sx_FieldCount(); + + for( uiCount = 1; uiCount <= uiFields; uiCount++ ) + { + cFieldName = ( char * ) sx_FieldName( uiCount ); + pItem = hb_itemPutC( NULL, cFieldName ); + hb_arrayAdd( pStruct, pItem ); + hb_itemRelease( pItem ); + } + + return pStruct; +} diff --git a/harbour/examples/hbapollo/decrypt.c b/harbour/examples/hbapollo/decrypt.c new file mode 100644 index 0000000000..bd703531c2 --- /dev/null +++ b/harbour/examples/hbapollo/decrypt.c @@ -0,0 +1,72 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_DBFDECRYPT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PBYTE cpPassword; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_DBFDECRYPT" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + { + cpPassword = ( PBYTE ) hb_parc( 1 ); + sx_SetPassword( cpPassword ); + } + + hb_retl( sx_DbfDecrypt() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +/* HB_FUNC( SX_DECRYPT ) */ + +/* Renamed, because of name conflict with Harbour RTL */ +HB_FUNC( _SX_DECRYPT ) +{ + if( HB_ISCHAR( 1 ) ) + { + if( HB_ISCHAR( 2 ) ) + { + hb_retc( ( char * ) sx_Decrypt( ( PBYTE ) hb_parc( 1 ), /* pbBuffer */ + ( PBYTE ) hb_parc( 2 ), /* cpPassword */ + ( int ) hb_parclen( 1 ) ) ); + } + else + { + hb_retc( ( char * ) sx_Decrypt( ( PBYTE ) hb_parc( 1 ), /* pbBuffer */ + ( PBYTE ) NULL, /* cpPassword */ + ( int ) hb_parclen( 1 ) ) ); + } + } + else + hb_retc_null(); +} diff --git a/harbour/examples/hbapollo/delete.c b/harbour/examples/hbapollo/delete.c new file mode 100644 index 0000000000..cb7ff95231 --- /dev/null +++ b/harbour/examples/hbapollo/delete.c @@ -0,0 +1,92 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_DELETE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_DELETE" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Delete(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_DELETED ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retl( HB_FALSE ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_Deleted() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_PACK ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_PACK" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Pack(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ZAP ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_ZAP" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Zap(); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/descend.c b/harbour/examples/hbapollo/descend.c new file mode 100644 index 0000000000..b4195d9516 --- /dev/null +++ b/harbour/examples/hbapollo/descend.c @@ -0,0 +1,35 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#include "sxapi.h" + +HB_EXTERN_BEGIN +extern void HB_FUN_DESCEND( void ); +HB_EXTERN_END + +HB_FUNC( SX_DESCEND ) +{ + HB_FUNCNAME( DESCEND ) (); +} diff --git a/harbour/examples/hbapollo/empty.c b/harbour/examples/hbapollo/empty.c new file mode 100644 index 0000000000..411052fe9a --- /dev/null +++ b/harbour/examples/hbapollo/empty.c @@ -0,0 +1,46 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_EMPTY ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_EMPTY" ); + + if( HB_ISCHAR( 1 ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_Empty( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); +} diff --git a/harbour/examples/hbapollo/encrypt.c b/harbour/examples/hbapollo/encrypt.c new file mode 100644 index 0000000000..aa07202aa6 --- /dev/null +++ b/harbour/examples/hbapollo/encrypt.c @@ -0,0 +1,98 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_DBFENCRYPT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_DBFENCRYPT" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + if( HB_ISCHAR( 1 ) ) /* Password */ + sx_SetPassword( ( PBYTE ) hb_parc( 1 ) ); + + hb_retl( sx_DbfEncrypt() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +/* HB_FUNC( SX_ENCRYPT ) */ + +/* Rename because of name conflict with Harbour RT */ +HB_FUNC( _SX_ENCRYPT ) +{ + if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + PBYTE cpBuffer = ( PBYTE ) hb_xgrab( iLen ); + hb_snprintf( ( char * ) cpBuffer, iLen, "%s", hb_parc( 1 ) ); + + if( HB_ISCHAR( 2 ) ) + { + hb_retc( ( char * ) sx_Encrypt( cpBuffer, + ( PBYTE ) hb_parc( 2 ) /* cpPassword */, ( int ) iLen ) ); + } + else + { + hb_retc( ( char * ) sx_Encrypt( cpBuffer, ( PBYTE ) NULL /* cpPassword */, ( int ) iLen ) ); + } + + hb_xfree( cpBuffer ); + } + else + hb_retc( "EMPTY STRING PASSED" ); +} + +HB_FUNC( SX_ISENCRYPTED ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + HB_BOOL lFile; + WORD nFile; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_ISENCRYPTED" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISLOG( 1 ) ) + lFile = hb_parl( 1 ); + else + lFile = HB_FALSE; + + if( lFile ) + nFile = 0; + else + nFile = 1; + + hb_retl( sx_IsEncrypted( nFile ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/eval.c b/harbour/examples/hbapollo/eval.c new file mode 100644 index 0000000000..a024765eb2 --- /dev/null +++ b/harbour/examples/hbapollo/eval.c @@ -0,0 +1,116 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_BOOL _sx_Eval( PHB_ITEM pItem ) +{ + hb_vmPushEvalSym(); + hb_vmPush( pItem ); + hb_vmDo( 0 ); + return hb_itemGetL( hb_stackReturnItem() ); +} + +HB_FUNC( SX_EVALDATE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + char * szDateStr; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_EVALDATE" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + szDateStr = ( char * ) sx_EvalString( ( PBYTE ) hb_parc( 1 ) ); + + hb_retds( szDateStr ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_EVALLOGICAL ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_EVALLOGICAL" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_EvalLogical( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_EVALNUMERIC ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_EVALNUMERIC" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnd( sx_EvalNumeric( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_EVALSTRING ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_EVALSTRING" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_EvalString( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_EVALTEST ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_EVALTEST" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retni( sx_EvalTest( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/fblock.prg b/harbour/examples/hbapollo/fblock.prg new file mode 100644 index 0000000000..73fb2599e2 --- /dev/null +++ b/harbour/examples/hbapollo/fblock.prg @@ -0,0 +1,28 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +FUNCTION sx_FieldBlock( cFieldName ) + + RETURN {| arg | if( arg == NIL, sx_GetValue( cFieldName ), sx_Replace( cFieldName, arg ) ) } diff --git a/harbour/examples/hbapollo/field.c b/harbour/examples/hbapollo/field.c new file mode 100644 index 0000000000..91657ca719 --- /dev/null +++ b/harbour/examples/hbapollo/field.c @@ -0,0 +1,189 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_FIELDCOUNT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retni( 0 ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( sx_FieldCount() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FCOUNT ) +{ + HB_FUNCNAME( SX_FIELDCOUNT ) (); +} + +HB_FUNC( SX_FIELDDECIMALS ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retni( -1 ); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + hb_retni( sx_FieldDecimals( ( PBYTE ) hb_parc( 1 ) ) ); + else if( HB_ISNUM( 1 ) ) + hb_retni( sx_FieldDecimals( ( PBYTE ) sx_FieldName( ( WORD ) hb_parni( 1 ) ) ) ); + else + hb_retni( -1 ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FIELDNAME ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retc_null(); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + hb_retc( ( char * ) sx_FieldName( ( WORD ) hb_parni( 1 ) ) ); + else + hb_retc_null(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FIELDNUM ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retni( 0 ); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + hb_retni( sx_FieldNum( ( PBYTE ) hb_parc( 1 ) ) ); + else if( HB_ISNUM( 1 ) ) + { + int iField = hb_parni( 1 ); + if( iField <= sx_FieldCount() ) + hb_retni( iField ); + else + hb_retni( 0 ); + } + else + hb_retni( 0 ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FIELDPOS ) +{ + HB_FUNCNAME( SX_FIELDNUM ) (); +} + +HB_FUNC( SX_FIELDOFFSET ) +{ + PHB_ITEM vParam = hb_param( 2, HB_IT_ANY ); + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( vParam && ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( vParam ); + + hb_retni( sx_FieldOffset( ( PBYTE ) hb_parc( 1 ) ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FIELDTYPE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_FIELDTYPE" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + hb_retc( ( char * ) sx_FieldType( ( PBYTE ) hb_parc( 1 ) ) ); + else if( HB_ISNUM( 1 ) ) + hb_retc( ( char * ) sx_FieldType( ( PBYTE ) sx_FieldName( ( WORD ) hb_parni( 1 ) ) ) ); + else + hb_retc_null(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FIELDWIDTH ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retni( 0 ); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + hb_retni( sx_FieldWidth( ( PBYTE ) hb_parc( 1 ) ) ); + else if( HB_ISNUM( 1 ) ) + hb_retni( sx_FieldWidth( ( PBYTE ) sx_FieldName( ( WORD ) hb_parni( 1 ) ) ) ); + else + hb_retni( -1 ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/filter.c b/harbour/examples/hbapollo/filter.c new file mode 100644 index 0000000000..cd740a41a0 --- /dev/null +++ b/harbour/examples/hbapollo/filter.c @@ -0,0 +1,80 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_DBFILTER ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_DBFILTER" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_DBFilter() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_SETFILTER ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SETFILTER" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + sx_SetFilter( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_CLEARFILTER ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_CLEARFILTER" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + sx_SetFilter( ( PBYTE ) 0 ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FILTERALIAS ) +{ + hb_retl( sx_FilterAlias( ( PBYTE ) hb_parc( 1 ) /* cpAliasName */, + ( PBYTE ) hb_parc( 2 ) /* cpFieldName */ + ) ); +} diff --git a/harbour/examples/hbapollo/finalize.c b/harbour/examples/hbapollo/finalize.c new file mode 100644 index 0000000000..def0991c72 --- /dev/null +++ b/harbour/examples/hbapollo/finalize.c @@ -0,0 +1,30 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_FINALIZESESSION ) +{ + sx_FinalizeSession(); +} diff --git a/harbour/examples/hbapollo/get.c b/harbour/examples/hbapollo/get.c new file mode 100644 index 0000000000..6f5616e722 --- /dev/null +++ b/harbour/examples/hbapollo/get.c @@ -0,0 +1,691 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +#if 0 + +/* Pending Item */ + +HB_FUNC( SX_GETBLOB ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETBLOB" ); + else + { + WORD iWorkArea = SX_DUMMY_NUMBER; + PVOID vpVar; + ULONG lBlob; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + vpVar = ( PVOID ) sx_MemAlloc( sx_GetBlobLength( ( PBYTE ) hb_parc( 1 ) ) ); + lBlob = sx_GetBlob( ( PBYTE ) hb_parc( 1 ), &vpVar ); + + hb_itemReturn( ( PHB_ITEM ) vpVar ); + sx_MemDealloc( vpVar ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); + } +} +#endif + +HB_FUNC( SX_GETBLOBLENGTH ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETBLOBLENGTH" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnl( sx_GetBlobLength( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETBITMAP ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + HWND hWnd = ( HWND ) hb_parptr( 2 ); + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETBITMAP" ); + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_GetBitMap( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */, + hWnd /* Window Handle */ + ) ); + + hb_storptr( ( void * ) hWnd, 2 ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETBYTE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETBYTE" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_GetByte( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETCOMMITLEVEL ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_COMMITLEVEL" ); + + if( HB_ISNUM( 1 ) ) + hb_retni( sx_GetCommitLevel( ( WORD ) hb_parni( 1 ) ) ); + else if( ! HB_ISNIL( 1 ) ) + { + WORD iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + { + hb_retni( sx_GetCommitLevel( iWorkArea ) ); + sx_Select( iWorkArea ); + } + } +} + +HB_FUNC( SX_GETDATEJULIAN ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETDATEJULIAN" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnl( sx_GetDateJulian( ( PBYTE ) hb_parc( 1 ) ) ); /* Field name */ + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETDATESTRING ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETDATESTRING" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_GetDateString( ( PBYTE ) hb_parc( 1 ) /* cpFieldname */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +char * _sx_GetDateValue( PBYTE cFieldName ) +{ + char * szDate = ( char * ) sx_GetVariant( cFieldName ); + int d_value = 0, + m_value = 0, + y_value = 0; + char szDateFormat[ 9 ]; + char * cRetval = ( char * ) hb_xgrab( 9 ); + + if( szDate ) + { + HB_ISIZ d_pos = 0, + m_pos = 0, + y_pos = 0; + HB_ISIZ count; + int digit, + non_digit; + char * szDF = ( char * ) hb_setGetDateFormat(); + HB_ISIZ size = strlen( hb_setGetDateFormat() ); + + for( count = 0; count < size; count++ ) + { + switch( szDF[ count ] ) + { + case 'D': + case 'd': + if( d_pos == 0 ) + { + if( m_pos == 0 && y_pos == 0 ) + d_pos = 1; + else if( m_pos == 0 || y_pos == 0 ) + d_pos = 2; + else + d_pos = 3; + } + break; + + case 'M': + case 'm': + if( m_pos == 0 ) + { + if( d_pos == 0 && y_pos == 0 ) + m_pos = 1; + else if( d_pos == 0 || y_pos == 0 ) + m_pos = 2; + else + m_pos = 3; + } + break; + + case 'Y': + case 'y': + if( y_pos == 0 ) + { + if( m_pos == 0 && d_pos == 0 ) + y_pos = 1; + else if( m_pos == 0 || d_pos == 0 ) + y_pos = 2; + else + y_pos = 3; + } + } + } + + /* If there are non-digits at the start of the date field, + they are not to be treated as date field separators */ + non_digit = 1; + size = strlen( szDate ); + for( count = 0; count < size; count++ ) + { + digit = szDate[ count ]; + if( HB_ISDIGIT( digit ) ) + { + /* Process the digit for the current date field */ + if( d_pos == 1 ) + d_value = ( d_value * 10 ) + digit - '0'; + else if( m_pos == 1 ) + m_value = ( m_value * 10 ) + digit - '0'; + else if( y_pos == 1 ) + y_value = ( y_value * 10 ) + digit - '0'; + + /* Treat the next non-digit as a date field separator */ + non_digit = 0; + } + else if( digit != ' ' ) + { + /* Process the non-digit */ + if( non_digit++ == 0 ) + { + /* Only move to the next date field on the first + consecutive non-digit that is encountered */ + d_pos--; + m_pos--; + y_pos--; + } + } + } + + if( y_value >= 0 && y_value < 100 ) + { + count = hb_setGetEpoch() % 100; + digit = hb_setGetEpoch() / 100; + + if( y_value >= count ) + y_value += ( digit * 100 ); + else + y_value += ( ( digit * 100 ) + 100 ); + } + } + + hb_snprintf( szDateFormat, 9, "%04i%02i%02i", y_value, m_value, d_value ); + memcpy( cRetval, szDateFormat, 8 ); + cRetval[ 8 ] = '\0'; + return cRetval; +} + +HB_FUNC( SX_GETDOUBLE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETDOUBLE" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnd( sx_GetDouble( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETINTEGER ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETINTEGER" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retni( ( int ) sx_GetInteger( ( PBYTE ) hb_parc( 1 ) /* cpFieldname */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETLOGICAL ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETLOGICAL" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_GetLogical( ( PBYTE ) hb_parc( 1 ) ) ); /* Field name */ + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETLONG ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETLONG" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnl( sx_GetLong( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETMEMO ) +{ + WORD uiLineWidth; + PBYTE cpFieldName, + cpMemo; + + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETMEMO" ); + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + { + cpFieldName = ( PBYTE ) hb_parc( 1 ); + + if( HB_ISNUM( 2 ) ) + uiLineWidth = ( WORD ) hb_parnd( 2 ); + else + uiLineWidth = 0; + + cpMemo = ( PBYTE ) sx_GetMemo( cpFieldName, uiLineWidth ); + + hb_retc( ( char * ) cpMemo ); + + if( lstrlen( ( const char * ) cpMemo ) ) /* TOFIX: lstrlen() usage */ + sx_MemDealloc( cpMemo ); + } + else + hb_retc_null(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETRECORD ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PBYTE cpRecord; + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + cpRecord = ( PBYTE ) hb_xgrab( ( LONG ) sx_RecSize() + 1 ); + sx_GetRecord( cpRecord ); + hb_retc( ( char * ) cpRecord ); + hb_xfree( cpRecord ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETRECORDEX ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PHB_ITEM pString; + int uiFieldCount; + PBYTE cpRecord; + HB_USHORT i, + iOffSet, + iFieldWidth; + PBYTE cpFieldName; + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + uiFieldCount = sx_FieldCount(); + cpRecord = ( PBYTE ) hb_xgrab( ( LONG ) sx_RecSize() + 1 ); + + hb_reta( uiFieldCount + 1 ); + + sx_GetRecord( cpRecord ); + pString = hb_itemPutCL( NULL, ( char * ) ( cpRecord ), 1 ); + hb_storvc( ( char * ) hb_itemGetCPtr( pString ), -1, 1 ); + if( pString ) + hb_itemRelease( pString ); + + for( i = 0; i < uiFieldCount; i++ ) + { + cpFieldName = ( PBYTE ) sx_FieldName( ( WORD ) ( i + 1 ) ); + iOffSet = sx_FieldOffset( cpFieldName ); + iFieldWidth = sx_FieldWidth( cpFieldName ); + pString = hb_itemPutCL( NULL, ( char * ) ( cpRecord + iOffSet - 1 ), + iFieldWidth ); + hb_storvc( hb_itemGetCPtr( pString ), -1, i + 2 ); + if( pString ) + hb_itemRelease( pString ); + } + + if( cpRecord ) + hb_xfree( cpRecord ); + if( pString ) + hb_itemClear( pString ); + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETSCOPE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_GetScope( ( WORD ) hb_parni( 1 ) /* iWhichScope */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETSTRING ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_GetString( ( PBYTE ) hb_parc( 1 ) ) ); /* Field name */ + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETTRIMSTRING ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( LPSTR ) sx_GetTrimString( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETVALUEDTOS ) /* ( cpFieldName ) */ +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_ret(); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + { + PBYTE cFieldName = ( PBYTE ) hb_parc( 1 ); + char * cFieldType = ( char * ) sx_FieldType( cFieldName ); + char szDate[ 9 ]; + + hb_retc( cFieldType[ 0 ] == 'D' ? hb_dateDecStr( szDate, sx_GetDateJulian( cFieldName ) ) : "" ); + } + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETVALUESTR ) /* ( cpFieldName ) */ +{ + HB_BOOL bTrim; + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_ret(); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + { + char * cFieldType = ( char * ) sx_FieldType( ( PBYTE ) hb_parc( 1 ) ); + PBYTE cFieldName = ( PBYTE ) hb_parc( 1 ); + + switch( *cFieldType ) + { + case 'D': + hb_retc( ( char * ) sx_GetDateString( cFieldName ) ); + break; + + case 'N': + case 'M': + hb_retc( ( char * ) sx_GetVariant( cFieldName ) ); + break; + + case 'L': + hb_retc( sx_EvalLogical( cFieldName ) ? ".T." : ".F." ); + break; + + case 'C': + bTrim = HB_ISLOG( 2 ) ? hb_parl( 2 ) : HB_FALSE; + hb_retc( ( bTrim || bSetTrimmedON + ) ? ( char * ) sx_GetTrimString( cFieldName ) : ( char * ) sx_GetString( cFieldName ) ); + break; + + default: + hb_retc_null(); + } + } + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETVALUE ) /* ( cpFieldName ) */ +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + HB_BOOL bTrim; + + /* char *szDateStr; */ + + if( ! _sx_Used() ) + { + hb_ret(); + return; + } + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + { + PBYTE cFieldName = ( PBYTE ) hb_parc( 1 ); + char * cFieldType = ( char * ) sx_FieldType( cFieldName ); + switch( *cFieldType ) + { + case 'N': + { + int iFieldWidth = sx_FieldWidth( cFieldName ); + int iDecimals = sx_FieldDecimals( cFieldName ); + if( iDecimals > 0 ) + { + /* GPF With __DMC__ */ + double d = sx_GetDouble( cFieldName ); + + /* hb_retnd( d ); */ + hb_retndlen( d, iFieldWidth, iDecimals ); + } + else + hb_retnl( sx_GetLong( cFieldName ) ); + } + break; + + case 'D': + { + int piYear, piMonth, piDay; + LONG lJulian = sx_GetDateJulian( cFieldName ); + + hb_dateDecode( lJulian, &piYear, &piMonth, &piDay ); + hb_retd( piYear, piMonth, piDay ); + } + break; + + case 'M': + hb_retc( ( char * ) sx_GetVariant( cFieldName ) ); + break; + + case 'L': + hb_retl( sx_EvalLogical( cFieldName ) ); + break; + + case 'C': + bTrim = HB_ISLOG( 2 ) ? hb_parl( 2 ) : HB_FALSE; + hb_retc( ( bTrim || bSetTrimmedON + ) ? ( char * ) sx_GetTrimString( cFieldName ) : ( char * ) sx_GetString( cFieldName ) ); + break; + } /* end switch ( *cFieldType ) */ + } + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FIELDGET ) +{ + HB_FUNCNAME( SX_GETVALUE ) (); +} + +HB_FUNC( SX_GETVALUEEX ) /* ( area ) */ +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + char * szDateStr; + int iField, + i; + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + iField = sx_FieldCount(); + + hb_reta( iField ); + + for( i = 0; i < iField; i++ ) + { + PBYTE cFieldName = ( PBYTE ) sx_FieldName( ( WORD ) ( i + 1 ) ); + char * cFieldType = ( char * ) sx_FieldType( cFieldName ); + switch( *cFieldType ) + { + case 'N': + hb_storvnd( sx_GetDouble( cFieldName ), -1, i + 1 ); + break; + + case 'D': + szDateStr = _sx_GetDateValue( cFieldName ); + hb_storvds( szDateStr, -1, i + 1 ); + hb_xfree( szDateStr ); + break; + + case 'M': + hb_storvc( ( char * ) sx_GetVariant( cFieldName ), -1, i + 1 ); + break; + + case 'L': + hb_storvl( sx_EvalLogical( cFieldName ), -1, i + 1 ); + break; + + case 'C': + if( bSetTrimmedON ) + hb_storvc( ( char * ) sx_GetTrimString( cFieldName ), -1, i + 1 ); + else + hb_storvc( ( char * ) sx_GetString( cFieldName ), -1, i + 1 ); + break; + } /* end switch ( *cFieldType ) */ + } + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GETVARIANT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GETVARIANT" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_GetVariant( ( PBYTE ) hb_parc( 1 ) ) ); /* Field name */ + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/global.c b/harbour/examples/hbapollo/global.c new file mode 100644 index 0000000000..0a11a7c9e7 --- /dev/null +++ b/harbour/examples/hbapollo/global.c @@ -0,0 +1,846 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +/* Modified To return .T. if Century is set ON or .F. is Century is set OFF. */ +static HB_BOOL bCenturyIsOn = HB_FALSE; +static char * aFormat[] = +{ + "AMERICAN", "ANSI", "BRITISH", "FRENCH", "GERMAN", "ITALIAN", "SPANISH", + "MM/DD/YY", "YY.MM.DD", "DD/MM/YY", "DD/MM/YY", "DD.MM.YY", "DD-MM-YY", + "DD-MM-YY", "MM/DD/YYYY", "YYYY.MM.DD", "DD/MM/YYYY", "DD/MM/YYYY", + "DD.MM.YYYY", "DD-MM-YYYY", "DD-MM-YYYY" +}; +static HB_BOOL lDeletedIsOn = HB_FALSE; +static int iBaseYear = 0; +static HB_BOOL bSetExactIsOn = HB_FALSE; +static HB_BOOL lSoftSeekIsOn; +static const char * sxApiRDD[] = +{ + "SDENTX", "SDEFOX", "SDENSX", "SDENSXDBT", "DBFNTX", "DBFIDX", "DBFNSX", + "DBFNSXDBT" +}; + +/* + C Declaration + VOID FAR PASCAL sx_SetSoftSeek + (HB_USHORT uiOnOff); + + Description + Indicates whether or not index seeks that result in failure (i.e., the + requested key value does not match any key in the index order either + partially or exactly) should result in a successful conclusion if a key + is found that is immediately greater than the requested key. + + Parameters + uiOnOff: If True, then soft seeks are performed for all files in the current + task. The soft seek setting is global in this respect. + sx_SetSoftSeek is normally only turned on when necessary, and then turned off + immediately after performing sx_Seek. See sx_Seek for details as to + its behavior when sx_SetSoftSeek is set to True. + */ + +HB_FUNC( SX_SETSOFTSEEK ) +{ + PHB_ITEM pItem; + WORD wSoftSeek = 0; + + lSoftSeekIsOn = hb_setGetSoftSeek(); + + hb_retl( lSoftSeekIsOn ); + + if( HB_ISLOG( 1 ) ) + lSoftSeekIsOn = hb_parl( 1 ); + else if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + + lSoftSeekIsOn = ( strcmp( _sx_upper( szTmp ), "ON" ) == 0 ) ? HB_TRUE : HB_FALSE; + + if( lSoftSeekIsOn ) + wSoftSeek = 1; + + hb_xfree( szTmp ); + } + + pItem = hb_itemPutL( NULL, lSoftSeekIsOn ); + hb_setSetItem( HB_SET_SOFTSEEK, pItem ); + hb_itemRelease( pItem ); + + sx_SetSoftSeek( wSoftSeek ); +} + +/* + C Declaration + + VOID FAR PASCAL sx_SetExact (HB_USHORT uiOnOff); + + Description + Indicates whether or not Seeks are to return True if a partial key match is + made. + + Parameters + uiOnOff: If True, key searches made with sx_Seek must match exactly in content + and length. Partial key matches will result in False returns from sx_Seek. + + If False, the exact condition is turned off. + + The sx_SetExact setting is applied to all index seeks in the current task. + It is global to the current task. + + NOTE: If sx_SetSoftSeek is set to True, the sx_SetExact setting is disabled. + */ + +HB_FUNC( SX_SETEXACT ) +{ + PHB_ITEM pItem; + WORD wSetExact = 0; + + bSetExactIsOn = hb_setGetExact(); + + hb_retl( bSetExactIsOn ); + + if( HB_ISLOG( 1 ) ) + bSetExactIsOn = hb_parl( 1 ); + else if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + + bSetExactIsOn = ( strcmp( _sx_upper( szTmp ), "ON" ) == 0 ) ? HB_TRUE : HB_FALSE; + + if( bSetExactIsOn ) + wSetExact = 1; + + hb_xfree( szTmp ); + } + + sx_SetExact( wSetExact ); + + pItem = hb_itemPutL( NULL, bSetExactIsOn ); + hb_setSetItem( HB_SET_EXACT, pItem ); + + hb_itemRelease( pItem ); +} + +/* + C Declaration + + HB_USHORT FAR PASCAL sx_SetEpoch (HB_USHORT uiBaseYear); + + Description + Determines the interpretation of date strings with only two year digits. When + such a string is converted to a date value, its year digits are compared with + the year digits of iBaseYear. If the year digits in the date are greater than + or equal to the year digits of iBaseYear, the date is assumed to fall within + the same century as iBaseYear. Otherwise, the date is assumed to fall in the + following century. + + Parameters + iBaseYear specifies the base year of a 100-year period in which all dates + containing only two year digits are assumed to fall. + + The default epoch value is 1900, causing dates with no century digits to be + interpreted as falling within the twentieth century. + */ + +HB_FUNC( SX_SETEPOCH ) +{ + WORD iEpoch; + PHB_ITEM pItem; + + iBaseYear = hb_setGetEpoch(); + + hb_retni( iBaseYear ); + + if( HB_ISNUM( 1 ) ) + { + iEpoch = ( WORD ) hb_parni( 1 ); + if( iEpoch == 0 ) + hb_errRT_BASE( EG_ARG, 2020, NULL, "SX_SETEPOCH", 1, hb_paramError( 1 ) ); + iBaseYear = iEpoch; + + pItem = hb_itemPutNI( NULL, iEpoch ); + hb_setSetItem( HB_SET_EPOCH, pItem ); + hb_itemRelease( pItem ); + + sx_SetEpoch( iEpoch ); + } +} + +/* + C Declaration + + VOID FAR PASCAL sx_SetDeleted(HB_USHORT uiDeleted); + + Description + Makes deleted records either transparent or visible to record positioning + functions. + + Setting sx_SetDeleted to HB_TRUE incurs certain performance penalties. Instead + of using sx_SetDeleted HB_TRUE, consider creating conditional index files with a + condition of .not. deleted. + + Parameters + If True, deleted records will be invisible to all record positioning functions + except sx_Go . + */ + +HB_FUNC( SX_SETDELETED ) +{ + PHB_ITEM pItem; + WORD wDeleted = 0; + + lDeletedIsOn = hb_setGetDeleted(); + + hb_retl( lDeletedIsOn ); + + if( HB_ISLOG( 1 ) ) + lDeletedIsOn = hb_parl( 1 ); + else if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + + lDeletedIsOn = ( strcmp( _sx_upper( szTmp ), "ON" ) == 0 ) ? HB_TRUE : HB_FALSE; + + if( lDeletedIsOn ) + wDeleted = 1; + + hb_xfree( szTmp ); + } + + pItem = hb_itemPutL( NULL, lDeletedIsOn ); + hb_setSetItem( HB_SET_DELETED, pItem ); + hb_itemRelease( pItem ); + + sx_SetDeleted( wDeleted ); +} + +static char * set_string( char * cDateFormat ) +{ + char * szString; + HB_SIZE ulLen = strlen( cDateFormat ); + + if( ulLen > USHRT_MAX ) + ulLen = USHRT_MAX; + + szString = ( char * ) hb_xgrab( ulLen + 1 ); + memcpy( szString, cDateFormat, ulLen ); + szString[ ulLen ] = '\0'; + + return szString; +} + +static int _sx_CheckFormat( char * cFormat ) +{ + int i; + + for( i = 0; i < 20; i++ ) + { + if( strcmp( aFormat[ i ], cFormat ) == 0 ) + return i; + } + + return -1; +} + +static void __hb_setDateFormat( char * pDateFormat ) +{ + HB_BOOL flag = HB_FALSE; + unsigned int i; + int ch, + year = 0; + char * szDateF = set_string( pDateFormat ); + + for( i = 0; i < strlen( szDateF ); i++ ) + { + ch = szDateF[ i ]; + if( ! flag && ( ch == 'Y' || ch == 'y' ) ) + year++; /* Only count the first set of consecutive "Y"s. */ + else if( year ) + flag = HB_TRUE; /* Indicate non-consecutive. */ + } + + flag = ( year >= 4 ); + + if( flag != hb_setGetCentury() ) + { + hb_setSetCentury( flag ); + } + + hb_xfree( szDateF ); +} + +/* + C Declaration + + VOID FAR PASCAL sx_SetDateFormat (HB_USHORT uiDateType); + + Description + Defines the format of date strings returned by sx_GetDateString. + + Parameters + Any one of the following defined constanant values: + + AMERICAN 0 "MM/DD/YY" + ANSI 1 "YY.MM.DD" + BRITISH 2 "DD/MM/YY" + FRENCH 3 "DD/MM/YY" + GERMAN 4 "DD.MM.YY" + ITALIAN 5 "DD-MM-YY" + SPANISH 6 "DD-MM-YY" + + If sx_SetCentury is True, the century digits will precede the year digits + in each of the formats shown above. + */ + +HB_FUNC( SX_SETDATEFORMAT ) +{ + WORD iChecked; + WORD iDateFormat; + char * szDateFormat; + + hb_retc( hb_setGetDateFormat() ); + + if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + iChecked = ( WORD ) _sx_CheckFormat( _sx_upper( szTmp ) ); + hb_xfree( szTmp ); + + if( iChecked == 0 ) + hb_errRT_BASE( EG_ARG, 2020, NULL, "SX_SETDATEFORMAT", 1, + hb_paramError( 1 ) ); + + if( iChecked < 7 ) + iDateFormat = iChecked; + else if( ( iChecked > 6 ) && ( iChecked < 14 ) ) + { + iDateFormat = ( WORD ) ( iChecked - 7 ); + sx_SetCentury( HB_FALSE ); + } + else + { + iDateFormat = ( WORD ) ( iChecked - 14 ); + sx_SetCentury( HB_TRUE ); + } + } + else + return; + + /* hb_errRT_BASE( EG_ARG, 2020, NULL, "SX_SETDATEFORMAT", 1, hb_paramError( 1 ) ); */ + sx_SetDateFormat( iDateFormat ); + + if( iChecked < 7 ) + { + if( _sx_SetCentury() ) + szDateFormat = aFormat[ iChecked + 14 ]; + else + szDateFormat = aFormat[ iChecked + 7 ]; + } + else + szDateFormat = aFormat[ iChecked ]; + + __hb_setDateFormat( szDateFormat ); +} + +HB_BOOL _sx_SetCentury() +{ + return bCenturyIsOn; +} + +/* + C Declaration + VOID FAR PASCAL sx_SetCentury (SHORT iValue); + + Description + Indicates whether or not the two digits of the year designating century are + to be returned by sx_GetDateString as part of a date string formatted + according to the sx_SetDateFormat setting. + + Parameters + If True, the century digits will be returned. If False, they will not. + */ + +HB_FUNC( SX_SETCENTURY ) +{ + WORD wCentury = 0; + + hb_retl( bCenturyIsOn ); + + if( HB_ISLOG( 1 ) ) + bCenturyIsOn = hb_parl( 1 ); + else if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + + bCenturyIsOn = ( strcmp( _sx_upper( szTmp ), "ON" ) == 0 ) ? HB_TRUE : HB_FALSE; + + if( bCenturyIsOn ) + wCentury = 1; + + hb_xfree( szTmp ); + } + + sx_SetCentury( wCentury ); +} + +HB_FUNC( SX_SETAUTOOPEN ) +{ + HB_BOOL lAuto = ! _sx_SysProp( SDE_SP_GETDISABLEAUTO, NULL ); + + if( HB_ISLOG( 1 ) ) + _sx_SysProp( SDE_SP_SETDISABLEAUTO, ( PVOID ) ( ! hb_parl( 1 ) ) ); + hb_retl( lAuto ); +} + +HB_FUNC( SX_ISAUTOOPENDISABLED ) +{ + hb_retl( sx_SysProp( SDE_SP_GETDISABLEAUTO, ( PVOID ) NULL ) ); +} + +HB_FUNC( SX_DISABLEAUTOOPEN ) +{ + hb_retl( _sx_SysProp( SDE_SP_SETDISABLEAUTO, ( PVOID ) 1 ) ); +} + +HB_FUNC( SX_SETCHRCOLLATE ) +{ + PHB_ITEM vParam = hb_param( 1, HB_IT_ARRAY ); + + if( vParam ) + { + const char * szChrCollate[ 255 ]; + HB_SIZE ulLen = hb_arrayLen( vParam ); + HB_SIZE u; + + for( u = 0; u < ulLen ; u++ ) + szChrCollate[ u ] = hb_arrayGetCPtr( vParam, u + 1 ); + + hb_retl( sx_SysProp( SDE_SP_SETCHRCOLLATE, ( PVOID ) szChrCollate ) ); + } + else + hb_retl( HB_FALSE ); +} + +/* + VB Declaration + Declare Function sx_SetHandles Lib "SDE7.DLL" + (ByVal iNumHandles As Integer) + + As Integer + + Description + Change the number of open file handles in the current Windows task. 255 max. + + Parameters + iNumHandles: The new number of file handles allowed for the current Windows + task. The maximum number is 255. + + Return Value + The total number of handles available. This number should always be 255 + (it is sent by the low level Windows API function when the handles are set). + If it is not 255, an error has occurred. + */ + +HB_FUNC( SX_SETHANDLES ) +{ + hb_retni( sx_SetHandles( ( WORD ) hb_parni( 1 ) /* iNumHandles */ ) ); +} + +/* + Both dBase and Clipper UPPER() and LOWER() case conversion functions + limit the characters eligible for case conversion. With UPPER(), only + characters a-z are converted to upper case. With LOWER(), only + characters A-Z are converted. Characters with diacritical marks ARE NOT + CONVERTED when this switch is HB_TRUE if sx_SetTranslate is also set to HB_TRUE. + To limit case conversion using this switch, set sx_SetTranslate to HB_TRUE + and set the sx_SysProp value on as well. + + sx_SetTranslate( HB_TRUE ); + sx_SysProp( SDE_SP_SETLIMITCASECONV, (VOIDP)1 ); + */ + +HB_FUNC( SX_SETLIMITCASECONV ) +{ + if( HB_ISLOG( 1 ) ) + { + if( hb_parl( 1 ) ) + sx_SysProp( SDE_SP_SETLIMITCASECONV, ( PVOID ) 1 ); + else + sx_SysProp( SDE_SP_SETLIMITCASECONV, ( PVOID ) 0 ); + } +} + +/* + VB Declaration + Declare Sub sx_SetLockTimeout Lib "SDE7.DLL" + (ByVal iSeconds As Integer) + + Description + Sets the number of seconds allowed to retry a lock operation before failing. + + Parameters + iSeconds: The lock operation will be continuously retried for this number of + seconds before reporting failure. The default value is 1 second. + */ + +HB_FUNC( SX_SETLOCKTIMEOUT ) +{ + sx_SetLockTimeout( ( WORD ) hb_parni( 1 ) /* iSeconds */ ); +} + +/* + VB Declaration + + Declare Sub sx_SetMemoBlockSize Lib "SDE7.DLL" + (ByVal uiBlockSize As Integer) + + Description + NOTE: This function does not apply to CA-Clipper .DBT memo files, which use + fixed 512 byte blocks. + The default .FPT memo block size is 32 bytes. The default .SMT memo block size + is 1. This function sets a new default block size that will be used when creating + any new table that has memos and will also change the block size in memo files + when the DBF is packed. It does not affect existing memo files except when the + corresponding DBF is packed. + + Parameters + uiBlockSize: The new default block size. The size must be a value from + 1 through 1024. + */ + +HB_FUNC( SX_SETMEMOBLOCKSIZE ) +{ + /* + The new default block size. + The size must be a value from 1 through 1024. + */ + hb_retni( sx_SetMemoBlockSize( ( WORD ) hb_parni( 1 ) ) ); +} + +HB_FUNC( SX_SETOEMCOLLATE ) +{ + PHB_ITEM vParam = hb_param( 1, HB_IT_ARRAY ); + + if( vParam ) + { + const char * sxOEMCollate[ 255 ]; + HB_SIZE ulLen = hb_arrayLen( vParam ); + HB_SIZE u; + + for( u = 0; u < ulLen ; u++ ) + sxOEMCollate[ u ] = hb_arrayGetCPtr( vParam, u + 1 ); + + hb_retl( sx_SysProp( SDE_SP_SETOEMCOLLATE, ( PVOID ) sxOEMCollate ) ); + } + else + hb_retl( HB_FALSE ); +} + +/* + C Declaration + + VOID FAR PASCAL sx_SetStringType (HB_USHORT uiStringType); + + Description + Indicate whether strings returned should be formatted as Visual Basic variable + length strings or "C" type binary zero delimited strings. + + The default value is to return Visual Basic strings. + C programs must always set the string type in their initialization routine. + + Parameters + uiStringType: Set uiStringType to 1 if C strings are to be returned. + A setting of 0 returns Visual Basic variable length strings. + */ + +HB_FUNC( SX_SETSTRINGTYPE ) +{ + sx_SetStringType( ( WORD ) hb_parni( 1 ) /* uiStringType */ ); +} + +/* + C Declaration + + VOID FAR PASCAL sx_SetTranslate (HB_USHORT uiOnOff); + + Description + Automatically translates record buffers stored in the OEM character set to + Windows ANSI. + + European tables make heavy use of the upper end of the character set (values + 128 to 255) to display characters with diacritical marks. If the table was + created with a DOS program, these characters are not the same as their ANSI + counterparts. The result is so much gibberish being displayed on the Windows + screen. + + OEM tables will automatically be translated to ANSI if sx_SetTranslate is set + to True. The table records and indexes will, however, be maintained in the OEM + character set if sx_SetTranslate remains True. This makes it possible to use + an OEM table created under DOS with both DOS and Windows programs + simultaneously. + + Parameters + uiOnOff: If True, the record buffer is translated from the OEM character set + to ANSI after being read. If still True at run time, it is translated back + again before writing. + + As long as the setting is True, all key changes to indexes are translated to + the OEM set before insertion. Search keys are also translated into OEM before + the search is undertaken. + + The setting applies to the current table only. + + Permanent Translation + To physically translate an OEM table to ANSI (if it will no longer be used in + a DOS environment), use sx_GetRecord and sx_PutRecord in a read loop and toggle + sx_SetTranslate on and off (True before the read, and False before the write). + Ensure that the setting is False before closing as well. See the examples below. + + Special Case when using DESCEND() + + If you need to support legacy DOS application and also use the xBase DESCEND() + function in the index key, you need to take special care to manage the translate + state. For example, when calling sx_Seek, sx_Index, or sx_IndexTag you should + first call sx_SetTranslate (HB_FALSE) and afterwards call sx_SetTranslate (HB_TRUE). + */ + +HB_FUNC( SX_SETTRANSLATE ) +{ + WORD wSetTrans = hb_parl( 1 ) ? ( WORD ) 1 : ( WORD ) 0; /* uiOnOff */ + + sx_SetTranslate( wSetTrans ); +} + +/* + C Declaration + + VOID FAR PASCAL sx_SetTurboRead (HB_USHORT uiOnOrOff); + + Description + sx_SetTurboRead is used to speed up record i/o functions (specifically sx_Skip + and sx_Seek). If you are going to be going into a lengthy record read or seek + loop, lock the file and then sx_SetTurboRead True. The default value is False. + + Parameters + See description above. + */ + +HB_FUNC( SX_SETTURBOREAD ) +{ + WORD wSetTurbo = hb_parl( 1 ) ? ( WORD ) 1 : ( WORD ) 0; /* uiOnOff */ + + sx_SetTurboRead( wSetTurbo ); +} + +HB_FUNC( SX_SETUDFPATH ) +{ + char * pbPath = ( char * ) hb_xgrab( 256 ); + + sx_GetUDFPath( ( PBYTE ) pbPath, 255 ); + hb_retc_buffer( ( char * ) pbPath ); + + if( HB_ISCHAR( 1 ) ) + sx_SetUDFPath( ( PBYTE ) hb_parc( 1 ) ); +} + +HB_FUNC( SX_GETCHRCOLLATE ) +{ + hb_retc( ( char * ) sx_SysProp( SDE_SP_GETCHRCOLLATE, ( PVOID ) NULL ) ); +} + +HB_FUNC( SX_CLOSEALL ) +{ + sx_CloseAll(); + + if( Opened_DBF_Property ) + hb_arraySize( Opened_DBF_Property, 0 ); +} + +HB_FUNC( SX_GETDATEFORMAT ) +{ + char * aDate[] = + { + "AMERICAN", "ANSI", "BRITISH", "FRENCH", "GERMAN", "ITALIAN", "SPANISH" + }; + HB_BOOL bAskString = HB_FALSE; + + if( HB_ISNIL( 1 ) ) + hb_retni( sx_GetDateFormat() ); + else + { + if( HB_ISLOG( 1 ) ) + bAskString = hb_parl( 1 ); + + if( bAskString ) + { + int iFormat = sx_GetDateFormat(); + hb_retc( aDate[ iFormat ] ); + } + else + hb_retni( sx_GetDateFormat() ); + } +} + +HB_FUNC( SX_GETOEMCOLLATE ) +{ + hb_retc( ( char * ) sx_SysProp( SDE_SP_GETOEMCOLLATE, ( PVOID ) NULL ) ); +} + +HB_FUNC( SX_GETQUERYBIT ) +{ + hb_retl( sx_GetQueryBit( hb_parnl( 1 ) /* lRecNum */ ) ); +} + +HB_FUNC( SX_GETSYSTEMCHARORDER ) +{ + hb_retc( sx_GetSystemCharOrder() ); +} + +HB_FUNC( SX_GETSYSTEMLOCALE ) +{ + hb_retc( sx_GetSystemLocale() ); +} + +HB_FUNC( SX_GETUDFPATH ) +{ + char pbPath[ 256 ]; + + sx_GetUDFPath( ( PBYTE ) pbPath, 255 ); + hb_retc( ( char * ) pbPath ); + hb_xfree( pbPath ); +} + +HB_FUNC( SX_SETGETTRIMMED ) +{ + if( HB_ISLOG( 1 ) ) + bSetTrimmedON = hb_parl( 1 ); + else if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", hb_parc( 1 ) ); + + bSetTrimmedON = ( strcmp( _sx_upper( szTmp ), "ON" ) == 0 ) ? HB_TRUE : HB_FALSE; + + hb_xfree( szTmp ); + } + + hb_retl( bSetTrimmedON ); +} + +HB_FUNC( SX_RDDSETDEFAULT ) +{ + int ui; + + hb_retc( ( char * ) sxApiRDD[ i_sxApi_RDD_Default - 1 ] ); + + if( HB_ISCHAR( 1 ) ) + { + ui = _sx_CheckRDD( hb_parc( 1 ) ); + if( ( ui > 0 ) && ( ui < 5 ) ) + i_sxApi_RDD_Default = ui; + else + hb_errInternal( HB_EI_RDDINVALID, NULL, NULL, NULL ); + } +} + +int _sx_CheckRDD( const char * sSetDefault ) +{ + int ui; + + if( HB_ISCHAR( 1 ) ) + { + HB_BOOL bCorrect = HB_FALSE; + + #if 0 + HB_ISIZ iLen = strlen( sSetDefault ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + hb_snprintf( szTmp, iLen, "%s", sSetDefault ); + szTmp = _sx_upper( szTmp ); + #endif + for( ui = 0; ui < 8; ui++ ) + { + if( strcmp( sxApiRDD[ ui ], sSetDefault /* szTmp */ ) == 0 ) + { + bCorrect = HB_TRUE; + break; + } + } + + #if 0 + hb_xfree( szTmp ); + #endif + + if( bCorrect ) + { + if( ui > 3 ) + ui -= 4; + return ui + 1; + } + else + return -1; + } + else + return -1; +} + +HB_FUNC( SX_ERRORLEVEL ) +{ + /* + ERRLEVEL_NONE 0 No error message at all. + ERRLEVEL_FATAL 1 Only report Fatal errors (Default). + ERRLEVEL_STANDARD 2 Report all errors. + */ + if( HB_ISNUM( 1 ) ) + { + WORD iErrorLevel = ( WORD ) hb_parni( 1 ); + + if( iErrorLevel > 2 ) + iErrorLevel = 2; + + i_sxApi_Error_Level = iErrorLevel; + + sx_ErrorLevel( iErrorLevel ); + } + + hb_retni( i_sxApi_Error_Level ); /* Default ErrorLevel */ +} diff --git a/harbour/examples/hbapollo/go.c b/harbour/examples/hbapollo/go.c new file mode 100644 index 0000000000..9d41f40801 --- /dev/null +++ b/harbour/examples/hbapollo/go.c @@ -0,0 +1,71 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_GO ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GO" ); + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + if( HB_ISNUM( 1 ) ) + sx_Go( hb_parnl( 1 ) ); + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GOBOTTOM ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GOBOTTOM" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_GoBottom(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_GOTOP ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_GOTOP" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_GoTop(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/hbapollo.hbc b/harbour/examples/hbapollo/hbapollo.hbc new file mode 100644 index 0000000000..1ea99fdf48 --- /dev/null +++ b/harbour/examples/hbapollo/hbapollo.hbc @@ -0,0 +1,13 @@ +# +# $Id$ +# + +{dos}skip=yes + +incpaths=. +libpaths=lib/${hb_plat}/${hb_comp} + +libs=${hb_name} + +libs={win&&HB_WITH_APOLLO_VER61}sde61 +libs={win&&!HB_WITH_APOLLO_VER61}sde7 diff --git a/harbour/examples/hbapollo/hbapollo.hbp b/harbour/examples/hbapollo/hbapollo.hbp new file mode 100644 index 0000000000..34b4dad72c --- /dev/null +++ b/harbour/examples/hbapollo/hbapollo.hbp @@ -0,0 +1,78 @@ +# +# $Id$ +# + +-stop{!win|!x86} + +-hblib +-inc + +-olib/${hb_plat}/${hb_comp}/${hb_name} + +-w3 -es2 + +{HB_WITH_APOLLO_VER61}-depkeyhead=apollo:Sde61.h +{!HB_WITH_APOLLO_VER61}-depkeyhead=apollo:Sde7.h +-depcontrol=apollo:${HB_WITH_APOLLO} +-depincpath=apollo:/usr/include +-depincpath=apollo:/boot/common/include + +{HB_WITH_APOLLO_VER61}-cflag=-DHB_WITH_APOLLO_VER61 + +{hbdyn}-cflag=_SDELIB_ + +-instfile=inc:sixapi.ch +-instfile=inc:unsix.ch + +alias.c +append.c +base.c +bofeof.c +close.c +commit.c +copy.c +count.c +create.c +dbcopy.c +dbdelim.c +dbeval.c +dbsort.c +dbstru.c +decrypt.c +delete.c +descend.c +empty.c +encrypt.c +eval.c +field.c +filter.c +finalize.c +get.c +global.c +go.c +index.c +isnull.c +lock.c +put.c +query.c +rec.c +replace.c +ryo.c +sde.c +seek.c +select.c +set.c +skip.c +str.c +sysprop.c +tools.c +use.c + +array.prg +browdb.prg +browse.prg +dbedit.prg +fblock.prg +tindex.prg +ttable.prg +ttag.prg diff --git a/harbour/examples/hbapollo/index.c b/harbour/examples/hbapollo/index.c new file mode 100644 index 0000000000..1fc123f22a --- /dev/null +++ b/harbour/examples/hbapollo/index.c @@ -0,0 +1,612 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +static int _sx_CheckIndexMode( char * szIndexMode ) +{ + char * sxIndexMode[] = { "UNIQUE", "RYO" }; + int ui; + int iIndexMode = 0; + + HB_ISIZ iLen = strlen( szIndexMode ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", szIndexMode ); + szTmp = _sx_upper( szTmp ); + + for( ui = 0; ui < 2; ui++ ) + { + if( strcmp( sxIndexMode[ ui ], szTmp ) == 0 ) + { + iIndexMode = ui; + break; + } + } + + hb_xfree( szTmp ); + return iIndexMode; +} + +HB_FUNC( SX_SETORDER ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SETORDER" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + { + SHORT iIndex = ( SHORT ) hb_parni( 1 ); + if( iIndex < 0 ) + hb_retni( sx_SetOrder( 0 ) ); + else + hb_retni( sx_SetOrder( iIndex ) ); + } + else if( HB_ISCHAR( 1 ) ) + hb_retni( sx_SetOrder( sx_TagArea( ( PBYTE ) hb_parc( 1 ) ) ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ORDSETFOCUS ) +{ + HB_FUNCNAME( SX_SETORDER ) (); +} + +HB_FUNC( SX_CLOSEINDEXES ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_CLOSEINDEXES" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_CloseIndexes(); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEX ) +{ + WORD iOption = 0; + PBYTE cpCondition = ( PBYTE ) 0; + WORD iWorkArea = SX_DUMMY_NUMBER; + + /* + Any Table Opened ? + */ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEX" ); + + /* + Index Filename and index expression passed correctly + */ + if( ! HB_ISCHAR( 1 ) && ! HB_ISCHAR( 2 ) ) + { + hb_retni( -1 ); + return; + } + + /* + Workarea + */ + if( ! HB_ISNIL( 6 ) ) + iWorkArea = _sx_select( hb_param( 6, HB_IT_ANY ) ); + + /* + Indexing Option + */ + if( HB_ISCHAR( 3 ) ) + iOption = ( WORD ) _sx_CheckIndexMode( ( char * ) hb_parc( 3 ) ); + + /* + Condition + */ + if( HB_ISCHAR( 5 ) ) + cpCondition = ( PBYTE ) hb_parc( 5 ); + + hb_retni( sx_Index( ( PBYTE ) hb_parc( 1 ), /* cpFileName */ + ( PBYTE ) hb_parc( 2 ), /* cpExpr*/ + iOption, /* iOption: IDX_NONE=0 IDX_UNIQUE=1 IDX_EMPTY=2 */ + hb_parl( 4 ), /* bDescend */ + cpCondition /* cpCondition */ + ) ); + + /* + Go to previous area + */ + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_REINDEX ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_REINDEX" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Reindex(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXCLOSE ) +{ +/* + sx_IndexClose() applied only to SDENSXDBT ! + */ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXCLOSE" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_IndexClose(); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXCONDITION ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXCONDITION" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_IndexCondition() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXFLIP ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXFLIP" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_IndexFlip() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXKEY ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXKEY" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_IndexKey() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ORDKEY ) +{ + HB_FUNCNAME( SX_INDEXKEY ) (); +} + +HB_FUNC( SX_INDEXKEYFIELD ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXKEYFIELD" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_IndexKeyField() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXNAME ) +{ + WORD iIndex; + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXNAME" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + { + iIndex = ( WORD ) hb_parni( 1 ); + hb_retc( ( char * ) sx_IndexName( iIndex ) ); + } + else + hb_retc_null(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXOPEN ) +{ + if( _sx_Used() ) + { + if( HB_ISCHAR( 1 ) ) + { + HB_ISIZ iLen = hb_parclen( 1 ) + 1; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", ( char * ) hb_parc( 1 ) ); + if( hb_fsFileExists( ( const char * ) szTmp ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retni( sx_IndexOpen( ( PBYTE ) szTmp ) ); + + hb_xfree( szTmp ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); + } + else + { + hb_xfree( szTmp ); + hb_errRT_BASE( EG_OPEN, 2020, NULL, "SX_INDEXOPEN", 1, + hb_paramError( 1 ) ); + } + } + else + hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, "SX_INDEXOPEN" ); + } + else + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXOPEN" ); +} + +HB_FUNC( SX_INDEXORD ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXORD" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( sx_IndexOrd() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ORDNUMBER ) +{ + HB_FUNCNAME( SX_INDEXORD ) (); +} + +HB_FUNC( SX_INDEXTAG ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + WORD iIndexType; + PBYTE cpFileName, + cpCondition, + cpTagName; + HB_BOOL bDescend; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXTAG" ); + + if( ! HB_ISCHAR( 2 ) && ! HB_ISCHAR( 3 ) ) + { + hb_retni( -1 ); + return; + } + + if( ! HB_ISNIL( 7 ) ) + iWorkArea = _sx_select( hb_param( 7, HB_IT_ANY ) ); + + cpFileName = HB_ISCHAR( 1 ) ? ( PBYTE ) hb_parc( 1 ) : ( PBYTE ) 0; + cpTagName = ( PBYTE ) hb_parc( 2 ); + iIndexType = HB_ISNUM( 4 ) ? ( WORD ) hb_parni( 4 ) : ( WORD ) 0; + + if( iIndexType > 2 ) + iIndexType = 0; + + bDescend = HB_ISLOG( 5 ) ? hb_parl( 5 ) : HB_FALSE; + cpCondition = HB_ISCHAR( 6 ) ? ( PBYTE ) hb_parc( 6 ) : ( PBYTE ) 0; + + hb_retni( sx_IndexTag( cpFileName, cpTagName, ( PBYTE ) hb_parc( 3 ) /* cpExpr */, + iIndexType, bDescend, cpCondition ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_INDEXTYPE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_INDEXTYPE" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( sx_IndexType() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_KEYADD ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PBYTE cpTagName; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_KEYADD" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + cpTagName = HB_ISCHAR( 1 ) ? ( PBYTE ) hb_parc( 1 ) : ( PBYTE ) 0; + + hb_retl( sx_KeyAdd( cpTagName ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_KEYDROP ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PBYTE cpTagname; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_KEYDROP" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + cpTagname = HB_ISCHAR( 1 ) ? ( PBYTE ) hb_parc( 1 ) : ( PBYTE ) NULL; + + hb_retl( sx_KeyDrop( cpTagname ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_KEYDATA ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_KEYDATA" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_KeyData() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ORDERPOSGET ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( ( int ) sx_OrderPosGet() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ORDERPOSSET ) +{ + double iPos; + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + iPos = hb_parnd( 1 ); + + sx_OrderPosSet( iPos ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_ORDERRECNO ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_ORDERRECNO" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retnl( sx_OrderRecNo() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_TAGAREA ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_TAGAREA" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retni( sx_TagArea( ( PBYTE ) hb_parc( 1 ) /* cpTagName */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_TAGCOUNT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_TAGCOUNT" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( sx_SysProp( SDE_SP_GETINDEXCOUNT, ( PVOID ) NULL ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_TAGDELETE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_TAGDELETE" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_TagDelete( ( PBYTE ) hb_parc( 1 ) ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_TAGINFO ) +{ + PHB_ITEM pItem; + PHB_ITEM pData; + WORD uiCount, + nTagCount, + nOldOrd; + + /* char *cFieldName; */ + /* HB_USHORT nIndexArea = -1; */ + WORD uiIndex = 1; + PHB_ITEM pTagInfo = hb_itemNew( NULL ); + + hb_arrayNew( pTagInfo, 0 ); + + if( _sx_Used() ) + { + nOldOrd = sx_IndexOrd(); + nTagCount = ( HB_USHORT ) sx_SysProp( SDE_SP_GETINDEXCOUNT, ( PVOID ) NULL ); + pData = hb_itemNew( NULL ); + pItem = hb_itemNew( NULL ); + + if( HB_ISNUM( 1 ) ) + { + uiIndex = ( WORD ) hb_parni( 1 ); + nTagCount = uiIndex; + } + else if( HB_ISCHAR( 1 ) ) + { + uiIndex = sx_TagArea( ( PBYTE ) hb_parc( 1 ) ); + nTagCount = uiIndex; + } + + for( uiCount = uiIndex; uiCount <= nTagCount; uiCount++ ) + { + sx_SetOrder( uiCount ); + hb_arrayNew( pItem, 8 ); + hb_arraySet( pItem, 1, hb_itemPutC( pData, ( char * ) sx_TagName( uiCount ) ) ); + hb_arraySet( pItem, 2, hb_itemPutC( pData, ( char * ) sx_IndexKey() ) ); + hb_arraySet( pItem, 3, hb_itemPutC( pData, ( char * ) sx_IndexCondition() ) ); + hb_arraySet( pItem, 4, hb_itemPutNI( pData, sx_IndexType() ) ); + hb_arraySet( pItem, 5, hb_itemPutL( pData, + ( HB_BOOL ) sx_SysProp( SDE_SP_GETDESCENDING, ( PVOID ) &uiCount ) + ) ); + hb_arraySet( pItem, 6, hb_itemPutL( pData, ( HB_BOOL ) ( ( int ) sx_SysProp( + SDE_SP_GETEMPTY, ( PVOID ) &uiCount ) == 2 ) ) ); + hb_arraySet( pItem, 7, hb_itemPutC( pData, ( char * ) sx_IndexName( uiCount ) ) ); + hb_arraySet( pItem, 8, hb_itemPutC( pData, ( char * ) sx_IndexKeyField() ) ); + hb_arrayAdd( pTagInfo, pItem ); + } + + hb_itemRelease( pItem ); + hb_itemRelease( pData ); + sx_SetOrder( nOldOrd ); + } + + hb_itemCopy( hb_stackReturnItem(), pTagInfo ); + hb_itemRelease( pTagInfo ); +} + +HB_FUNC( SX_TAGNAME ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_TAGNAME" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retc( ( char * ) sx_TagName( ( WORD ) hb_parni( 1 ) /* iTagArea */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/isnull.c b/harbour/examples/hbapollo/isnull.c new file mode 100644 index 0000000000..6f14a734f0 --- /dev/null +++ b/harbour/examples/hbapollo/isnull.c @@ -0,0 +1,48 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_ISNULL ) +{ + if( _sx_Used() ) + { + if( HB_ISCHAR( 1 ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_IsNull( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */ ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); + } + else + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_ISNULL" ); +} diff --git a/harbour/examples/hbapollo/lock.c b/harbour/examples/hbapollo/lock.c new file mode 100644 index 0000000000..85d76bfb98 --- /dev/null +++ b/harbour/examples/hbapollo/lock.c @@ -0,0 +1,205 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_RLOCK ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RLOCK" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + { + hb_retl( sx_Rlock( hb_parni( 1 ) ) ); + } + else if( HB_ISARRAY( 1 ) ) + { + PHB_ITEM vLock = hb_param( 1, HB_IT_ARRAY ); + HB_ISIZ uilenLock = hb_arrayLen( vLock ); + HB_ISIZ ui; + int iRecNo; + HB_BOOL bSuccess = HB_TRUE; + for( ui = 0; ui < uilenLock; ui++ ) + { + iRecNo = hb_arrayGetNI( vLock, ui + 1 ); + if( ! sx_Rlock( iRecNo ) ) + bSuccess = HB_FALSE; + } + + hb_retl( bSuccess ); + } + else + hb_retl( sx_Rlock( sx_RecNo() ) ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_DBRLOCK ) +{ + HB_FUNCNAME( SX_RLOCK ) (); +} + +HB_FUNC( SX_LOCKED ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + hb_retl( sx_Locked( hb_parnl( 1 ) /* lRecNum */ ) ); + else + hb_retl( sx_Locked( sx_RecNo() ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_LOCKCOUNT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_LOCKCOUNT" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( sx_LockCount() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_DBRLOCKLIST ) +{ + int iCount; + int i; + WORD iWorkArea = SX_DUMMY_NUMBER; + PULONG lLocks; + + if( ! _sx_Used() ) + { + hb_reta( 0 ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + iCount = sx_LockCount(); + + if( iCount ) + { + lLocks = ( PULONG ) hb_xgrab( iCount * sizeof( PULONG ) ); + + sx_DBRlockList( lLocks ); + + hb_reta( iCount ); + + for( i = 0; i < iCount; i++ ) + hb_storvni( lLocks[ i ], -1, i + 1 ); + + hb_xfree( lLocks ); + } + else + hb_reta( 0 ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FLOCK ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_FLOCK" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_Flock() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_UNLOCK ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_UNLOCK" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + sx_Unlock( hb_parnl( 1 ) ); + else if( HB_ISARRAY( 1 ) ) + { + PHB_ITEM vLock = hb_param( 1, HB_IT_ARRAY ); + HB_ISIZ uilenLock = hb_arrayLen( vLock ); + HB_ISIZ ui; + int iRecNo; + for( ui = 0; ui < uilenLock; ui++ ) + { + iRecNo = hb_arrayGetNI( vLock, ui + 1 ); + sx_Unlock( iRecNo ); + } + } + else + sx_Unlock( sx_RecNo() ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_UNLOCKALL ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_UNLOCKALL" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Unlock( 0 ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_DBRUNLOCK ) +{ + HB_FUNCNAME( SX_UNLOCK ) (); +} diff --git a/harbour/examples/hbapollo/put.c b/harbour/examples/hbapollo/put.c new file mode 100644 index 0000000000..7da162a730 --- /dev/null +++ b/harbour/examples/hbapollo/put.c @@ -0,0 +1,149 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_PUTBLOB ) /* The number of bytes written */ +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 4 ) ) + iWorkArea = _sx_select( hb_param( 4, HB_IT_ANY ) ); + + hb_retnl( sx_PutBlob( ( PBYTE ) hb_parc( 1 ) /* cpFieldName */, + ( PVOID ) hb_parc( 2 ) /* vpVar */, hb_parnl( 3 ) /* lSize */ + ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_PUTRECORD ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + sx_PutRecord( ( PBYTE ) hb_parc( 1 ) /* cpRecord */ ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_PUTVALUEEX ) /* ( aValues, nArea ) */ +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISARRAY( 1 ) ) + { + PHB_ITEM pValue = hb_param( 1, HB_IT_ARRAY ); + HB_USHORT uiLen = ( HB_USHORT ) hb_arrayLen( pValue ); + HB_USHORT uiSize; + WORD uVarType; + PBYTE cFieldName; + + for( uiSize = 0; uiSize < uiLen; uiSize++ ) + { + uVarType = ( WORD ) hb_arrayGetType( pValue, uiSize + 1 ); + cFieldName = ( PBYTE ) sx_FieldName( ( WORD ) ( uiSize + 1 ) ); + switch( uVarType ) + { + case HB_IT_DOUBLE: + case HB_IT_LONG: + case HB_IT_INTEGER: + { + double pDouble = hb_arrayGetND( pValue, uiSize + 1 ); + sx_Replace( cFieldName, R_DOUBLE, ( PVOID ) &pDouble ); + } + break; + + case HB_IT_DATE: + { + char szDate[ 9 ]; + char * buffer; + hb_dateDecStr( szDate, hb_arrayGetDL( pValue, uiSize + 1 ) ); + buffer = ( char * ) hb_xgrab( 11 ); + #if 0 + hb_dateFormat( szDate, buffer, hb_set.HB_SET_DATEFORMAT ); + #else + hb_dateFormat( szDate, buffer, hb_setGetDateFormat() ); + #endif + sx_Replace( cFieldName, R_DATESTR, ( PVOID ) buffer ); + hb_xfree( buffer ); + } + break; + + case HB_IT_LOGICAL: + { + HB_BOOL bValue = hb_arrayGetL( pValue, uiSize + 1 ); + sx_Replace( cFieldName, R_LOGICAL, ( PVOID ) &bValue ); + } + break; + + case HB_IT_STRING: + { + PBYTE cVar = ( PBYTE ) hb_arrayGetC( pValue, uiSize + 1 ); + char * cFieldType = ( char * ) sx_FieldType( cFieldName ); + switch( *cFieldType ) + { + case 'C': + sx_Replace( cFieldName, R_CHAR, cVar ); + hb_xfree( cVar ); + break; + + case 'D': + sx_Replace( cFieldName, R_DATESTR, cVar ); + hb_xfree( cVar ); + break; + + case 'M': + sx_Replace( cFieldName, R_MEMO, cVar ); + hb_xfree( cVar ); + break; + } + } + break; + } /* end switch ( uVarType ) */ + } /* end for( uiSize = 0; uiSize < uiLen; uiSize++ ) */ + } + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_PUTVARIANT ) +{ +/* + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + lpVariant: A variant containing the replacement data. + Logical field values should be passed as either zero (HB_FALSE) or -1 (HB_TRUE). + Date strings must be formatted according to the setting of sx_SetDateFormat + and sx_SetCentury. + */ + sx_PutVariant( ( PBYTE ) hb_parc( 1 ), ( PVOID ) hb_parc( 2 ) ); +} diff --git a/harbour/examples/hbapollo/query.c b/harbour/examples/hbapollo/query.c new file mode 100644 index 0000000000..927f97b57c --- /dev/null +++ b/harbour/examples/hbapollo/query.c @@ -0,0 +1,89 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_QUERY ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_QUERY" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnl( sx_Query( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_QUERYCLEAR ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_QUERYCLEAR" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retnl( sx_Query( ( PBYTE ) 0 ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_QUERYRECCOUNT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_QUERYRECCOUNT" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retnl( sx_QueryRecCount() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_QUERYTEST ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_QUERYTEST" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retni( sx_QueryTest( ( PBYTE ) hb_parc( 1 ) /* cpExpression */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/rec.c b/harbour/examples/hbapollo/rec.c new file mode 100644 index 0000000000..7605cf6bdd --- /dev/null +++ b/harbour/examples/hbapollo/rec.c @@ -0,0 +1,113 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_RECCOUNT ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retnl( 0 ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retnl( sx_RecCount() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_LASTREC ) +{ + HB_FUNCNAME( SX_RECCOUNT ) (); +} + +HB_FUNC( SX_RECALL ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_ret(); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_Recall(); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_RECNO ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retnl( 0 ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retnl( sx_RecNo() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_RECSIZE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retnl( 0 ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retnl( sx_RecSize() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_RECTOSTRING ) +{ + hb_retc( ( char * ) sx_RecToString( ( PBYTE ) hb_parc( 1 ) /* cpRecStruc */, + ( WORD ) hb_parni( 2 ) /* iLength */ + ) ); +} diff --git a/harbour/examples/hbapollo/replace.c b/harbour/examples/hbapollo/replace.c new file mode 100644 index 0000000000..1fc13cd473 --- /dev/null +++ b/harbour/examples/hbapollo/replace.c @@ -0,0 +1,329 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC_EXTERN( SX_REPLACEARRAY ); + +HB_FUNC( SX_REPLACE ) /* ( cpFieldName, xData, cArea ) */ +{ + PHB_ITEM pItem = hb_param( 2, HB_IT_ANY ); + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_REPLACE" ); + + if( HB_ISCHAR( 1 ) ) + { + WORD wPreviousArea = SX_DUMMY_NUMBER; + PBYTE cFieldName = ( PBYTE ) hb_parc( 1 ); + + if( ! HB_ISNIL( 3 ) ) + wPreviousArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + switch( hb_itemType( pItem ) ) + { + case HB_IT_ARRAY: + { + PHB_ITEM pAlias = hb_itemNew( NULL ); + PHB_ITEM pFieldName = hb_itemNew( NULL ); + PHB_ITEM pResult; + + hb_itemPutC( pAlias, (const char*) sx_Alias( 0 ) ); + hb_itemPutC( pFieldName, (const char*) cFieldName ); + pResult = hb_itemDoC( "SX_REPLACEARRAY", 3, pFieldName, hb_param( 2, HB_IT_ARRAY ), pAlias ); + hb_itemRelease( pAlias ); + hb_itemRelease( pFieldName ); + hb_itemRelease( pResult ); + break; + } + + case HB_IT_STRING: + { + PVOID pValue = ( PVOID ) hb_parc( 2 ); + char * cFieldType = ( char * ) sx_FieldType( cFieldName ); + switch( *cFieldType ) + { + case 'C': + sx_Replace( cFieldName, R_CHAR, pValue ); + break; + + case 'D': + sx_Replace( cFieldName, R_DATESTR, pValue ); + break; + + case 'M': + sx_Replace( cFieldName, R_MEMO, pValue ); + break; + } + + hb_retc( ( char * ) pValue ); + break; + } /* enf of if ( HB_IS_STRING( vData ) ) */ + + case HB_IT_DOUBLE: + { + double pValue = hb_parnd( 2 ); + sx_Replace( cFieldName, R_DOUBLE, ( PVOID ) &pValue ); + hb_retnd( pValue ); + break; + } + + case HB_IT_LONG: + { + long pValue = hb_parnl( 2 ); + sx_Replace( cFieldName, R_LONG, ( PVOID ) &pValue ); + hb_retnl( pValue ); + break; + } + + case HB_IT_INTEGER: + { + int pValue = hb_parni( 2 ); + sx_Replace( cFieldName, R_INTEGER, ( PVOID ) &pValue ); + hb_retni( pValue ); + break; + } + + case HB_IT_LOGICAL: + { + HB_BOOL pValue = hb_parl( 2 ); + sx_Replace( cFieldName, R_LOGICAL, ( PVOID ) &pValue ); + hb_retl( pValue ); + break; + } /* end of else if ( HB_IS_LOGICAL( vData ) ) */ + + case HB_IT_DATE: + { + long lJulian = hb_itemGetDL( pItem ); + sx_Replace( cFieldName, R_JULIAN, ( PVOID ) &lJulian ); + break; + } /* end of else if ( HB_IS_DATE( vData ) ) */ + } + + /* Back to Previous Area */ + if( ! ( wPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( wPreviousArea ); + } +} + +HB_FUNC( SX_FIELDPUT ) +{ + HB_FUNCNAME( SX_REPLACE ) (); +} + +HB_FUNC( SX_REPLACEBITMAP ) /* ( cpFieldName, xData, cArea ) */ +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_REPLACEBITMAP" ); + + if( HB_ISCHAR( 1 ) && HB_ISCHAR( 2 ) ) + { + WORD wPreviousArea = SX_DUMMY_NUMBER; + PVOID pValue; + PBYTE cFieldName = ( PBYTE ) hb_parc( 1 ); + + if( ! HB_ISNIL( 3 ) ) + wPreviousArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + pValue = ( PVOID ) hb_parc( 2 ); + sx_Replace( cFieldName, R_BITMAP, pValue ); + + /* Back to Previous Area */ + if( ! ( wPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( wPreviousArea ); + } +} + +HB_FUNC( __SX_FORCELINK_SX_REPLACEARRAY ) +{ + HB_FUNC_EXEC( SX_REPLACEARRAY ); +} + +HB_FUNC( SX_REPLACEBLOB ) /* ( cpFieldName, xData, cArea ) */ +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_REPLACEBLOB" ); + + if( HB_ISCHAR( 1 ) ) + { + WORD wPreviousArea = SX_DUMMY_NUMBER; + PVOID pValue; + PBYTE cFieldName = ( PBYTE ) hb_parc( 1 ); + long lResult = 0; + + if( ! HB_ISNIL( 3 ) ) + wPreviousArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + if( HB_ISCHAR( 2 ) ) + { + pValue = ( PVOID ) hb_parc( 2 ); + sx_Replace( cFieldName, R_BLOBFILE, pValue ); + } + else if( HB_ISARRAY( 2 ) ) + { + PHB_ITEM pAlias = hb_itemNew( NULL ); + PHB_ITEM pFieldName = hb_itemNew( NULL ); + PHB_ITEM pResult; + + hb_itemPutC( pAlias, (const char*) sx_Alias( 0 ) ); + hb_itemPutC( pFieldName, (const char*) cFieldName ); + pResult = hb_itemDoC( "SX_REPLACEARRAY", 3, pFieldName, hb_param( 2, HB_IT_ARRAY ), pAlias ); + lResult = hb_itemGetL( pResult ); + hb_itemRelease( pAlias ); + hb_itemRelease( pFieldName ); + hb_itemRelease( pResult ); + } + + /* Back to Previous Area */ + if( ! ( wPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( wPreviousArea ); + + hb_retnl( lResult ); + } +} + +HB_FUNC( SX_REPLACEEX ) /* ( aReplace, cArea ) */ +{ + WORD wPreviousArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_REPLACEEX" ); + + if( HB_ISARRAY( 1 ) ) + { + PHB_ITEM pReplace = hb_param( 1, HB_IT_ARRAY ); + PHB_ITEM pInfo; + HB_USHORT uiLen = ( HB_USHORT ) hb_arrayLen( pReplace ); + HB_USHORT uiSize; + PBYTE cFieldName; + WORD uVarType; + + if( ! HB_ISNIL( 2 ) ) + wPreviousArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + for( uiSize = 0; uiSize < uiLen; uiSize++ ) + { + pInfo = hb_arrayGetItemPtr( pReplace, uiSize + 1 ); + + /* Give Protection of NOT an array */ + if( HB_IS_ARRAY( pInfo ) && hb_arrayLen( pInfo ) >= 2 ) + { + /* if ( pInfo->item.asArray.value->ulLen >= 2 ) */ + cFieldName = ( PBYTE ) hb_arrayGetC( pInfo, 1 ); + uVarType = ( WORD ) hb_arrayGetType( pInfo, 2 ); + switch( uVarType ) + { + case HB_IT_DOUBLE: + case HB_IT_LONG: + case HB_IT_INTEGER: + { + double pDouble = hb_arrayGetND( pInfo, 2 ); + sx_Replace( cFieldName, R_DOUBLE, ( PVOID ) &pDouble ); + } + + hb_xfree( cFieldName ); + break; + + case HB_IT_DATE: + { + long lJulian = hb_arrayGetDL( pInfo, 2 ); + sx_Replace( cFieldName, R_JULIAN, ( PVOID ) &lJulian ); + } + + hb_xfree( cFieldName ); + break; + + case HB_IT_LOGICAL: + { + HB_BOOL pValue = hb_arrayGetL( pInfo, 2 ); + sx_Replace( cFieldName, R_LOGICAL, ( PVOID ) &pValue ); + hb_xfree( cFieldName ); + } + break; + + case HB_IT_STRING: + { + PBYTE cVar = ( PBYTE ) hb_arrayGetC( pInfo, 2 ); + char * cFieldType = ( char * ) sx_FieldType( cFieldName ); + switch( *cFieldType ) + { + case 'C': + sx_Replace( cFieldName, R_CHAR, cVar ); + break; + + case 'D': + sx_Replace( cFieldName, R_DATESTR, cVar ); + break; + + case 'M': + sx_Replace( cFieldName, R_MEMO, cVar ); + break; + } + + hb_xfree( cVar ); + hb_xfree( cFieldName ); + } + break; + } + } + } + + if( ! ( wPreviousArea == SX_DUMMY_NUMBER ) ) + sx_Select( wPreviousArea ); + } +} + +HB_FUNC( SX_BLOBTOFILE ) +{ + if( HB_ISCHAR( 1 ) && HB_ISCHAR( 2 ) ) + { + WORD iWorkArea = SX_DUMMY_NUMBER; + PBYTE cpFieldName; + char * pFieldType; + + cpFieldName = ( PBYTE ) hb_parc( 1 ); + + /* Work area passed */ + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + /* Check if the field is of MEMO type */ + pFieldType = ( char * ) sx_FieldType( cpFieldName ); + switch( *pFieldType ) + { + case 'P': + case 'B': + hb_retl( sx_BlobToFile( cpFieldName, ( PBYTE ) hb_parc( 2 ) ) ); + break; + + default: + hb_retl( HB_FALSE ); + } + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); + } + else + hb_retl( HB_FALSE ); +} diff --git a/harbour/examples/hbapollo/ryo.c b/harbour/examples/hbapollo/ryo.c new file mode 100644 index 0000000000..d4e3b7aacb --- /dev/null +++ b/harbour/examples/hbapollo/ryo.c @@ -0,0 +1,208 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_RYOFILTERACTIVATE ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERACTIVATE" ); + + hb_retl( sx_RYOFilterActivate( ( WORD ) hb_parni( 1 ) /* iFilterHandle */, + ( WORD ) hb_parni( 2 ) /* iBoolOperation */ + ) ); +} + +HB_FUNC( SX_RYOFILTERCOPY ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERCOPY" ); + + hb_retni( sx_RYOFilterCopy() ); +} + +HB_FUNC( SX_RYOFILTERCREATE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERCREATE" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retni( sx_RYOFilterCreate() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_RYOFILTERDESTROY ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERDESTROY" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_RYOFilterDestroy( ( WORD ) hb_parni( 1 ) /* iFilterHandle */ ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_RYOFILTERGETBIT ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERGETBIT" ); + + hb_retl( sx_RYOFilterGetBit( ( WORD ) hb_parni( 1 ) /* iFilterHandle */, + hb_parnl( 2 ) /* lRecNo */ + ) ); + + /* + Description + + Gets a bit corresponding to the table record represented by lRecNo. + + iFilterHandle: + An integer identifier of the bitmap returned from either sx_RYOFilterCopy + or sx_RYOFilterCreate. If this parameter is passed as zero, the active + bitmap is acted upon. + lRecNo: + The number of the bit to be retrieved. This number represents the physical + location of the table record. + */ +} + +HB_FUNC( SX_RYOFILTERRESTORE ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERRESTORE" ); + + hb_retl( sx_RYOFilterRestore( ( PBYTE ) hb_parc( 1 ) /* cpFileName */ ) ); + + /* + Description + Sets or resets the active bitmap to one saved to disk by sx_RYOFilterSave. + + Parameters + cpFileName: + A fully qualified filename containing a bitmap saved with sx_RYOFilterSave. + */ +} + +HB_FUNC( SX_RYOFILTERSAVE ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_FILTERSAVE" ); + + hb_retl( sx_RYOFilterSave( ( WORD ) hb_parni( 1 ) /* iFilterHandle */, + ( PBYTE ) hb_parc( 2 ) /* cpFileName */ + ) ); + + /* + Description + + Saves the defined bitmap in a disk file. + + Parameters + + iFilterHandle: + An integer identifier of the bitmap returned from either sx_RYOFilterCopy + or sx_RYOFilterCreate. If this parameter is passed as zero, the active + bitmap is acted upon. + cpFileName: + A user supplied file name fully qualified with path and extension. + If the file already exists, it is overwritten without warning. + */ +} + +HB_FUNC( SX_RYOFILTERSETBIT ) +{ + WORD wOnOff = hb_parl( 3 ) ? ( WORD ) 1 : ( WORD ) 0; /* iOnOrOff */ + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOFILTERSETBIT" ); + + hb_retl( sx_RYOFilterSetBit( ( WORD ) hb_parni( 1 ) /* iFilterHandle */, + ( WORD ) hb_parnl( 2 ) /* lRecNo */, wOnOff /* iOnOrOff */ + ) ); + + /* + Description + + Sets or resets a bit corresponding to the table record represented by lRecNo. + + Parameters + + iFilterHandle: + An integer identifier of the bitmap returned from either sx_RYOFilterCopy or + sx_RYOFilterCreate. If this parameter is passed as zero, the active bitmap + is acted upon. + lRecNo: + The number of the bit to be set or reset. This number represents the + physical location of the table record. + iOnOrOff: + If HB_TRUE, the bit is set and the record becomes visible. + If HB_FALSE, the bit is reset and is no longer visible when this bitmap is + activated. + */ +} + +HB_FUNC( SX_RYOKEYADD ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOKEYADD" ); + + hb_retl( sx_RYOKeyAdd( ( PBYTE ) hb_parc( 1 ) /* cpTagname */, + ( PBYTE ) hb_parc( 2 ) /* cpKey */ + ) ); + + /* + Description + + Adds a key to an existing sxChar RYO index tag that points to the current table + record. Any existing key for the record is dropped. SxChar RYO indexes are + limited to the FoxPro (SDEFOX) and HiPer-SIx (SDENSX) drivers. + + Parameters + + cpTagName: + The name of the index tag containing the sxChar index. + If passed as NULL, the current tag is used. + cpKey: + A character string of the defined sxChar length. + */ +} + +HB_FUNC( SX_RYOKEYDROP ) +{ + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_RYOKEYDROP" ); + + hb_retl( sx_RYOKeyDrop( ( PBYTE ) hb_parc( 1 ) /* cpTagname */ ) ); +} diff --git a/harbour/examples/hbapollo/sde.c b/harbour/examples/hbapollo/sde.c new file mode 100644 index 0000000000..6b3176a072 --- /dev/null +++ b/harbour/examples/hbapollo/sde.c @@ -0,0 +1,229 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#define __SXAPI_INIT +#include "sxapi.h" + +#ifdef __cplusplus +extern "C" { +#endif + +extern PHB_ITEM Opened_DBF_Property; + +#ifdef __cplusplus +} +#endif + +static void __sx_CreateINITFile( const char * pIniFile ) +{ + FILE * FIniHandle = hb_fopen( pIniFile, "w" ); + + fprintf( FIniHandle, ";==========================\n" ); + fprintf( FIniHandle, ";SIXAPI initialization file\n" ); + fprintf( FIniHandle, ";==========================\n" ); + + /* Notes */ + fprintf( FIniHandle, ";DateFormat AMERICAN 0 /* MM/DD/YY */\n" ); + fprintf( FIniHandle, ";DateFormat ANSI 1 /* YY.MM.DD */\n" ); + fprintf( FIniHandle, ";DateFormat BRITISH 2 /* DD/MM/YY */\n" ); + fprintf( FIniHandle, ";DateFormat FRENCH 3 /* DD/MM/YY */\n" ); + fprintf( FIniHandle, ";DateFormat GERMAN 4 /* DD.MM.YY */\n" ); + fprintf( FIniHandle, ";DateFormat ITALIAN 5 /* DD-MM-YY */\n" ); + fprintf( FIniHandle, ";DateFormat SPANISH 6 /* DD-MM-YY */\n\n" ); + fprintf( FIniHandle, ";RDEType SDENTX 1\n" ); + fprintf( FIniHandle, ";RDEType SDEFOX 2\n" ); + fprintf( FIniHandle, ";RDEType SDENSX 3\n" ); + fprintf( FIniHandle, ";RDEType SDENSXDBT 4\n\n" ); + fprintf( FIniHandle, ";RDEType DBFNTX 1\n" ); + fprintf( FIniHandle, ";RDEType DBFFOX 2\n" ); + fprintf( FIniHandle, ";RDEType DBFNSX 3\n" ); + fprintf( FIniHandle, ";RDEType DBFNSXDBT 4\n\n" ); + + fprintf( FIniHandle, ";Commit Level\n" ); + fprintf( FIniHandle, ";0. Full commit. Always write data to disk. Do not use SDE buffers and force\n" ); + fprintf( FIniHandle, ";Windows to write any cached data. This offers the slowest performance\n" ); + fprintf( FIniHandle, ";(100x slower than level = 2 in some cases) but the data is guaranteed to\n" ); + fprintf( FIniHandle, ";always be saved upon each write.\n" ); + fprintf( FIniHandle, ";1. Normal commit. Do not use the SDE buffers, but do not force Windows to\n" ); + fprintf( FIniHandle, ";write the cached data. This offers very good performance and allows Windows\n" ); + fprintf( FIniHandle, ";to manage the data caching. (Usually 50-100%s slower than level = 2)\n", "%" ); + fprintf( FIniHandle, ";2. None. Let the SDE use its buffering mechanisms and do not force Windows\n" ); + fprintf( FIniHandle, ";to write the cached data. This offers the best performance\n" ); + fprintf( FIniHandle, ";(100x faster than level = 0 in some cases).\n\n" ); + + fprintf( FIniHandle, ";ErrorLevel\n" ); + fprintf( FIniHandle, ";0 No error message at all.\n" ); + fprintf( FIniHandle, ";1 Only report Fatal errors (Default).\n" ); + fprintf( FIniHandle, ";2 Report all errors.\n\n" ); + + fprintf( FIniHandle, ";MemoBlock Size\n" ); + fprintf( FIniHandle, ";This does not apply to CA-Clipper .DBT memo files, which use\n" ); + fprintf( FIniHandle, ";fixed 512 byte blocks.\n" ); + fprintf( FIniHandle, ";The default .FPT memo block size is 32 bytes. The default .SMT memo block size\n" ); + fprintf( FIniHandle, ";is 1. This function sets a new default block size that will be used when creating\n" ); + fprintf( FIniHandle, ";any new table that has memos and will also change the block size in memo files\n" ); + fprintf( FIniHandle, ";when the DBF is packed. It does not affect existing memo files except when the\n" ); + fprintf( FIniHandle, ";corresponding DBF is packed.\n" ); + fprintf( FIniHandle, ";The size must be a value from 1 through 1024.\n\n" ); + + /* Preset Defaults */ + fprintf( FIniHandle, "\n[Setup]\n" ); + fprintf( FIniHandle, "SetErrorLevel=1\n" ); + fprintf( FIniHandle, "SetCommitLevel=2\n" ); + fprintf( FIniHandle, "SetDateFormat=2\n" ); + fprintf( FIniHandle, "SetCentury=1\n" ); + fprintf( FIniHandle, "SetDeleted=1\n" ); + fprintf( FIniHandle, "SetRDDDefault=3\n" ); + fprintf( FIniHandle, "SetMemoBlockSize=1\n" ); + fprintf( FIniHandle, "AutoOpenIndexIsDisabled=1\n" ); + fclose( FIniHandle ); +} + +static void hb_sixapiRddInit( void * cargo ) +{ + BYTE bBufferEXE[ 250 ]; + char pIniFile[ 256 ]; + int iDateFormat, + iCentury, + iDeleted, + iAutoOpenDisabled, + iCommitLevel; + PHB_FNAME pFileName; + + HB_SYMBOL_UNUSED( cargo ); + + GetModuleFileName( NULL, ( char * ) bBufferEXE, 249 ); + + pFileName = hb_fsFNameSplit( ( const char * ) bBufferEXE ); + + /* Modifiable SET-UP in SDE.INI */ + hb_snprintf( pIniFile, sizeof( pIniFile ), "%s/%s", pFileName->szPath, "sde.ini" ); + + hb_xfree( pFileName ); + + if( ! hb_fsFileExists( ( const char * ) pIniFile ) ) + __sx_CreateINITFile( ( const char * ) pIniFile ); + + i_sxApi_Error_Level = GetPrivateProfileInt( "Setup", "SetErrorLevel", 1, pIniFile ); + i_sxApi_RDD_Default = GetPrivateProfileInt( "Setup", "SetRDDDefault", 3, pIniFile ); + iDateFormat = GetPrivateProfileInt( "Setup", "SetDateFormat", 2, pIniFile ); + iDeleted = GetPrivateProfileInt( "Setup", "SetDeleted", 1, pIniFile ); + iCentury = GetPrivateProfileInt( "Setup", "SetCentury", 1, pIniFile ); + iCommitLevel = GetPrivateProfileInt( "Setup", "SetCommitLevel", 2, pIniFile ); + iAutoOpenDisabled = GetPrivateProfileInt( "Setup", "AutoOpenIndexIsDisabled", 1, pIniFile ); + i_sxApi_MemoBlock_Size = GetPrivateProfileInt( "Setup", "SetMemoBlockSize", 32, pIniFile ); + + /* Disable AutoOpen Index File */ + if( iAutoOpenDisabled == 1 ) + _sx_SysProp( SDE_SP_SETDISABLEAUTO, ( PVOID ) 1 ); + + sx_ErrorLevel( ( WORD ) i_sxApi_Error_Level ); + sx_CommitLevel( ( WORD ) iCommitLevel ); + sx_SetMemoBlockSize( ( WORD ) i_sxApi_MemoBlock_Size ); + + /* + C Declaration + INT SDEAPI WINAPI sx_CommitLevel (INT nNewLevel); + + Description + Set how and the SDE and Windows writes data to disk. + + Parameters + nNewLevel: Value to set the commit level to. Possible values are 0,1 or 2. + + 0. Full commit. Always write data to disk. Do not use SDE buffers and force + Windows to write any cached data. This offers the slowest performance + (100x slower than level = 2 in some cases) but the data is guaranteed to + always be saved upon each write. + + 1. Normal commit. Do not use the SDE buffers, but do not force Windows to + write the cached data. This offers very good performance and allows Windows + to manage the data caching. (Usually 50-100% slower than level = 2) + + 2. None. Let the SDE use its buffering mechanisms and do not force Windows + to write the cached data. This offers the best performance + (100x faster than level = 0 in some cases). + + Return Value + Current commit level value. + */ + + /* Global Set Ups */ + sx_SetStringType( 1 ); /* C strings */ + sx_SetCentury( ( WORD ) iCentury ); /* dates to display century */ + sx_SetDateFormat( ( WORD ) iDateFormat ); /* date format DD/MM/CCYY */ + sx_SetDeleted( ( WORD ) iDeleted ); /* filter deleted records */ + + /* + Both dBase and Clipper UPPER() and LOWER() case conversion functions + limit the characters eligible for case conversion. With UPPER(), only + characters a-z are converted to upper case. With LOWER(), only + characters A-Z are converted. Characters with diacritical marks ARE NOT + CONVERTED when this switch is HB_TRUE if sx_SetTranslate is also set to HB_TRUE. + To limit case conversion using this switch, set sx_SetTranslate to HB_TRUE + and set the sx_SysProp value on as well. + + sx_SetTranslate( HB_TRUE ); + sx_SysProp( SDE_SP_SETLIMITCASECONV, (VOIDP)1 ); + */ + + /* required database to be opened */ + #if 0 + sx_SetTranslate( HB_TRUE ); + sx_SysProp( SDE_SP_SETLIMITCASECONV, (PVOID)1 ); + #endif + /* Init PHB_ITEM To Hold Opened DBF */ + if( Opened_DBF_Property == NULL ) + { + Opened_DBF_Property = hb_itemNew( NULL ); + hb_arrayNew( Opened_DBF_Property, 0 ); + } +} + +static void hb_sixapiRddExit( void * cargo ) +{ + HB_SYMBOL_UNUSED( cargo ); + + sx_CloseAll(); + sx_FinalizeSession(); + + if( Opened_DBF_Property ) + { + hb_itemRelease( Opened_DBF_Property ); + Opened_DBF_Property = NULL; + } +} + +HB_CALL_ON_STARTUP_BEGIN( _hb_sixapi_rdd_init_ ) + hb_vmAtInit( hb_sixapiRddInit, NULL ); + hb_vmAtExit( hb_sixapiRddExit, NULL ); +HB_CALL_ON_STARTUP_END( _hb_sixapi_rdd_init_ ) + +#if defined( HB_PRAGMA_STARTUP ) +# pragma startup _hb_sixapi_rdd_init_ +#elif defined( HB_DATASEG_STARTUP ) + #define HB_DATASEG_BODY HB_DATASEG_FUNC( _hb_sixapi_rdd_init_ ) + #include "hbiniseg.h" +#endif diff --git a/harbour/examples/hbapollo/seek.c b/harbour/examples/hbapollo/seek.c new file mode 100644 index 0000000000..4c7bac6e92 --- /dev/null +++ b/harbour/examples/hbapollo/seek.c @@ -0,0 +1,120 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_SEEK ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SEEK" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + hb_retl( sx_Seek( ( PBYTE ) hb_parc( 1 ) ) ); + else + hb_retl( HB_FALSE ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_SEEKBIN ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SEEKBIN" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + hb_retl( sx_SeekBin( ( PBYTE ) hb_parc( 1 ) /* cpKeyValue */, + ( HB_USHORT ) hb_parclen( 1 ) /* uiLength */ + ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); + + /* + Description + + Searches the current order for a supplied key. The key may contain binary + zeroes. Some xBase programmers become very innovative in inventing data + storage algorithms that bypass the standard xBase character fields. + These data storage functions usually involve some type of binary + representation to conserve space (e.g., representing time in two bytes - + the first byte hours and the second minutes). If indexes are constructed + on these fields, the search value cannot be passed as a string because the + value may contain a binary zero - which normally signifies the end of a + string. + + Parameters + + cpKeyValue: + The binary value to search for. The search key value may be a partial + key (if sx_SetExact is not True). + + uiLength: The length of the search key. + */ +} + +HB_FUNC( SX_LOCATE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EG_NOTABLE, NULL, "SX_LOCATE" ); + if( ! HB_ISNIL( 4 ) ) + iWorkArea = _sx_select( hb_param( 4, HB_IT_ANY ) ); + + hb_retnl( sx_Locate( ( PBYTE ) hb_parc( 1 ) /* cpExpression */, + ( SHORT ) hb_parni( 2 ) /* iDirection */, hb_parl( 3 ) /* bContinue */ + ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_FOUND ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + { + hb_retl( HB_FALSE ); + return; + } + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + hb_retl( sx_Found() ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/select.c b/harbour/examples/hbapollo/select.c new file mode 100644 index 0000000000..753462b648 --- /dev/null +++ b/harbour/examples/hbapollo/select.c @@ -0,0 +1,53 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_SELECT ) +{ + if( HB_ISNUM( 1 ) ) + hb_retnl( sx_Select( ( WORD ) hb_parni( 1 ) ) ); + + /* Added in Beta 0.2 2003-05-08 */ + else if( HB_ISCHAR( 1 ) ) + hb_retnl( sx_Select( sx_WorkArea( ( PBYTE ) hb_parc( 1 ) ) ) ); + else + hb_retnl( 1 ); +} + +/* For C Calls 2003.05.08 */ +WORD _sx_select( PHB_ITEM vParam ) +{ + WORD iSelected = SX_DUMMY_NUMBER; + + if( HB_IS_NUMERIC( vParam ) ) + iSelected = sx_Select( ( WORD ) hb_itemGetNI( vParam ) ); + else if( HB_IS_STRING( vParam ) ) + iSelected = sx_Select( sx_WorkArea( ( PBYTE ) hb_itemGetCPtr( vParam ) ) ); + + if( iSelected == SX_DUMMY_NUMBER ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_NOALIAS, NULL, "_sx_select" ); + + return iSelected; +} diff --git a/harbour/examples/hbapollo/set.c b/harbour/examples/hbapollo/set.c new file mode 100644 index 0000000000..f44ef7ee18 --- /dev/null +++ b/harbour/examples/hbapollo/set.c @@ -0,0 +1,122 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_SETPASSWORD ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + PBYTE cpPassword; + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISCHAR( 1 ) ) + cpPassword = ( PBYTE ) hb_parc( 1 ); + else + cpPassword = ( PBYTE ) 0; + + sx_SetPassword( cpPassword ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_SETQUERYBIT ) +{ + sx_SetQueryBit( hb_parnl( 1 ), hb_parl( 1 ) ); +} + +HB_FUNC( SX_SETRELATION ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + WORD uiChildArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SETRELATION" ); + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + uiChildArea = ( WORD ) hb_parni( 1 ); + else if( HB_ISCHAR( 1 ) ) + uiChildArea = sx_WorkArea( ( PBYTE ) hb_parc( 1 ) ); + + if( uiChildArea != SX_DUMMY_NUMBER ) + sx_SetRelation( uiChildArea, ( PBYTE ) hb_parc( 2 ) /* cpKeyExpr */ ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_CLEARRELATION ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_CLEARRELATION" ); + + if( ! HB_ISNIL( 1 ) ) + iWorkArea = _sx_select( hb_param( 1, HB_IT_ANY ) ); + + sx_SetRelation( 0, ( PBYTE ) " " ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_CLEARSCOPE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_CLEARSCOPE" ); + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + hb_retl( sx_SetScope( ( PBYTE ) 0, ( PBYTE ) 0 ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_SETSCOPE ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SETSCOPE" ); + + if( ! HB_ISNIL( 3 ) ) + iWorkArea = _sx_select( hb_param( 3, HB_IT_ANY ) ); + + hb_retl( sx_SetScope( ( PBYTE ) hb_parc( 1 ) /* cpLowVal */, + ( PBYTE ) hb_parc( 2 ) /* cpHighVal */ + ) ); + + if( iWorkArea != SX_DUMMY_NUMBER ) + sx_Select( iWorkArea ); +} diff --git a/harbour/examples/hbapollo/sixapi.ch b/harbour/examples/hbapollo/sixapi.ch new file mode 100644 index 0000000000..ae4a6092ed --- /dev/null +++ b/harbour/examples/hbapollo/sixapi.ch @@ -0,0 +1,350 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#ifndef __SIXAPI__ +#define __SIXAPI__ + +#command SET INDEX TO [ <(index1)> [, <(indexn)>]] [] ; + ; + => if !<.add.> ; sx_CloseIndexes() ; end ; + ; + [; sx_IndexOpen( <(index1)> )] ; + [; sx_IndexOpen( <(indexn)> )] + +#command SET RELATION TO => sx_ClearRelation() + +#command SET RELATION ; + [] ; + [TO INTO <(alias1)> [, [TO] INTO <(aliasn)>]] ; + ; + => if ( !<.add.> ) ; + ; sx_ClearRelation() ; + ; end ; + ; + ; sx_SetRelation( <(alias1)>, <"key1"> ) ; + [; sx_SetRelation( <(aliasn)>, <"keyn"> )] + +#command APPEND [FROM ] ; + [FOR ] ; + [VIA ] ; + ; + => sx_AppendFrom( ; + , ; + ,<(for)> ; + ) + +#command REPLACE [ WITH [, WITH ] ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => sx_DBEval( ; + {|| sx_Replace(<(f1)>,) [, sx_Replace(<(fn)>,)]}, ; + <{for}>, <{while}>, , , <.rest.>,<(alias)> ; + ) + +#command DELETE ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => sx_DBEval( ; + {|| sx_Delete()}, ; + <{for}>, <{while}>, , , <.rest.>,<(alias)> ; + ) + +#command RECALL ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => sx_DBEval( ; + {|| sx_Recall()}, ; + <{for}>, <{while}>, , , <.rest.>,<(alias)> ; + ) + +#command COUNT [TO ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => := 0 ; + ; sx_DBEval( ; + {|| := + 1}, ; + <{for}>, <{while}>, , , <.rest.>,<(alias)> ; + ) + +#command SUM [ [, ] TO [, ] ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => := [ := ] 0 ; + ; sx_DBEval( ; + {|| := + sx_GetValue(<(x1)>) [, := + sx_GetValue(<(xn)>)]},; + <{for}>, <{while}>, , , <.rest.>, <(alias)> ; + ) + +#xtranslate AVERAGE [ [, ] TO [, ] ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => M->__Avg := := [ := ] 0 ; + ; sx_DBEval( ; + {|| M->__Avg := M->__Avg + 1, ; + := + sx_GetValue(<(x1)>) [, := + sx_GetValue(<(xn)>)] },; + <{for}>, <{while}>, , , <.rest.>, <(alias)>) ; + ; := / M->__Avg [; := / M->__Avg ] + +#command TOTAL [TO <(file)>] [ON ] ; + [FIELDS ] ; + [FOR ] ; + [WHILE ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => __sx_dbTotal( ; + <(file)>, <{key}>, { <(fields)> }, ; + <{for}>, <{while}>, , , <.rest.> ; + ) + + +#command COPY [STRUCTURE] [TO <(file)>] [FIELDS ] ; + => sx_CopyStructure( <(file)>, { <(fields)> } ) + +#command COPY [STRUCTURE] EXTENDED [TO <(file)>] ; + => sx_CopyStructureExtended (<(file)>) + +#command COPY [TO <(file)>] [DELIMITED [WITH <*delim*>]] ; + [FIELDS ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => __sx_dbDelim( ; + <(file)>, , { <(fields)> }, ; + <{for}>, <{while}>, , , <.rest.>, ; + <(alias)> ; + ) + +#command COPY [TO <(file)>] [SDF] ; + [FIELDS ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => __sx_dbDelim( ; + <(file)>, "SDF", { <(fields)> }, ; + <{for}>, <{while}>, , , <.rest.>, ; + <(alias)> ; + ) + +#command COPY [TO <(file)>] ; + [FIELDS ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [VIA ] ; + [ALL] ; + ; + => __sx_dbCopy( ; + <(file)>, { <(fields)> }, ; + <{for}>, <{while}>, , , <.rest.>, , ; + <(alias)> ; + ) + +#command CREATE <(file1)> ; + [FROM <(file2)>] ; + [ <(rdd)>] ; + [ALIAS ] ; + => sx_CreateFrom( <(file1)>, <(a)>, <(file2)>, <(rdd)> ) + +#command COPYTEXT TO <(cTextFile)> [DELIMITED WITH ] [ALIAS ] => ; + ; + sx_CopyFileText( <(cTextFile)>, , <(alias)> ) + +#command SORT [TO <(file)>] [ON ] ; + [FOR ] ; + [WHILE ] ; + [AREA ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [] ; + [] ; + [ALL] ; + ; + => __sx_dbSort( ; + <(file)>, { <(fields)> }, ; + <{for}>, <{while}>, , , <.rest.>,<(rdd)>, ; + <.descend.>, <(alias)> ; + ) + +#command USE [ALIAS <(cAlias)>] [ <(cRDD)>] [VAR ] [COMMITLEVEL ] [<(cOpenMode)>] =>; + [ :=]; + sx_Use(; + ,; + [<(cAlias)>],; + [<(cOpenMode)>],; + [<(cRDD)>],; + []; + ) + +#command CREATE [VAR ] [ ] [ALIAS ] [COMMITLEVEL ] =>; + [ :=]; + sx_DbCreate(; + ,; + ,; + [<(cDriver)>],; + [<(cAlias)>],; + []) + +#command SET DATE =>; + sx_SetDateFormat(<(cCountry)>) + +#command REPLACE [ALIAS ] WITH ; + [, [ALIAS ] WITH ] => ; + ; + sx_Replace( <(cField)>, , <(alias)> ) ; + [; sx_Replace( <(cFieldN)>, , <(aliasN)> ) ] + +#command INDEX ON TO [ FOR ] [] [] =>; + sx_Index(; + <(cIndexFile)>,; + <(cExpression)>,; + [<(mod)>],; + [<.order.>],; + [<(cCondition)>]) + +#command SET COMMITLEVEL [TO] => Sx_CommitLevel() +#command SET ERRORLEVEL [TO] => Sx_ErrorLevel() +#command SET RDD [TO] <(rdd)> => Sx_RddsetDefault(<(rdd)>) +#command SET TRIM => Sx_SetGetTrimmed(<(ON)>) +#command SET SOFTSEEK => Sx_SetSoftSeek(<(ON)>) +#command SET CENTURY => Sx_SetCentury(<(ON)>) +#command SET EXACT => Sx_SetExact(<(ON)>) +#command SET DELETED => Sx_SetDeleted(<(ON)>) +#command SET EPOCH [TO] => Sx_SetEpoch() +#command SET LOCK TIMEOUT => Sx_SetLockTimeOut() +#command SET [FILE] HANDLE [TO] => Sx_SetHandles() +#command RECALL => sx_Recall() +#command DELETE => sx_Delete() +#command SKIP [] => sx_Skip([]) +#command SELECT => sx_Select(sx_WorkArea( <(selectarea)> )) + +#xtranslate Seek() => sx_Seek() +#xtranslate Found() => sx_Found() +#xtranslate dbSkip() => sx_Skip() +#xtranslate Bof() => sx_Bof() +#xtranslate Eof() => sx_Eof() +#xtranslate Deleted() => sx_Deleted() +#xtranslate RecCount() => sx_RecCount() +#xtranslate SetSoftSeek([]) => sx_SetSoftSeek([]) +#xtranslate RecNo() => sx_RecNo() +#xtranslate SetDateFormat( ) => ; + sx_SetDateFormat(<(cDateFormat)>) + +#xtranslate Alias() => sx_Alias() +#xtranslate FCount() => sx_FieldCount() +#xtranslate FieldPut(,) => sx_Replace(<(x)>,) +#xtranslate FieldGet() => sx_GetValue(<(x)>) +#xtranslate FieldGetStr() => sx_GetValueStr(<(x)>) +#xtranslate FieldGetDtos() => sx_GetValueDtos(<(x)>) +#xtranslate FieldGetJulian() => sx_GetDateJulian(<(x)>) +#xtranslate FieldPos() => sx_FieldNum(<(x)>) +#xtranslate FieldName() => sx_FieldName() +#xtranslate FieldType() => sx_FieldType(<(x)>) +#xtranslate FieldWidth() => sx_FieldWidth(<(x)>) +#xtranslate FieldOffset() => sx_FieldOffset(<(x)>) +#xtranslate FieldDecimals() => sx_FieldDecimals(<(x)>) + +#xcommand APPEND BLANK [TO <(cArea)>] [] => sx_Append([<(cArea)>],) +#xcommand GO [TO] [ALIAS ] => sx_Go(,<(alias)>) +#xcommand GOTO [ALIAS ] => sx_Go(,<(alias)>) +#xcommand GO TOP [ALIAS ] => sx_GoTop(<(alias)>) +#xcommand GO TO TOP [ALIAS ] => sx_GoTop(<(alias)>) +#xcommand GOTOP [ALIAS ] => sx_GoTop(<(alias)>) +#xcommand GO BOTTOM [ALIAS ] => sx_GoBottom(<(alias)>) +#xcommand GO TO BOTTOM [ALIAS ] => sx_GoBottom(<(alias)>) +#xcommand GOBOTTOM [ALIAS ] => sx_GoBottom(<(alias)>) +#xcommand ZAP [] => sx_Zap(<(alias)>) +#xcommand COMMIT [ALIAS ] => sx_Commit(<(alias)>) +#xcommand CLOSE ALL => sx_CloseAll() +#xcommand CLOSE [DATABASE] [ALIAS ] => sx_Close(<(alias)>) +#xcommand CLOSE DATA => sx_CloseAll() +#xcommand CLOSE INDEXES => sx_CloseIndexes() +#xcommand PACK [] => sx_Pack(<(alias)>) +#xcommand BROWSE => sx_Browse() +#xcommand PAUSE => inkey(0) + +#define INDEX_STANDARD 1 +#define INDEX_STANDARD_UNIQUE 2 +#define INDEX_CONDITIONAL 3 +#define INDEX_CONDITIONAL_UNIQUE 4 + +#define COMMA_DELIM 21 +#define SDF_FILE 22 +#define TAB_DELIM 23 +#define SPACE_DELIM 24 + +#endif /* __SIXAPI__ */ diff --git a/harbour/examples/hbapollo/skip.c b/harbour/examples/hbapollo/skip.c new file mode 100644 index 0000000000..905d93df26 --- /dev/null +++ b/harbour/examples/hbapollo/skip.c @@ -0,0 +1,93 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_SKIP ) +{ + WORD iWorkArea = SX_DUMMY_NUMBER; + long iSkipRec; + + if( ! _sx_Used() ) + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "SX_SKIP" ); + + if( ! HB_ISNIL( 2 ) ) + iWorkArea = _sx_select( hb_param( 2, HB_IT_ANY ) ); + + if( HB_ISNUM( 1 ) ) + iSkipRec = hb_parnl( 1 ); + else + iSkipRec = 1; + + sx_Skip( iSkipRec ); + + if( ! ( iWorkArea == SX_DUMMY_NUMBER ) ) + sx_Select( iWorkArea ); +} + +HB_FUNC( SX_DBSKIPPER ) +{ + long nSkipped = 0; + long nRecs = hb_parnl( 1 ); + + if( ! ( sx_Eof() && sx_Bof() ) ) + { + if( nRecs == 0 ) + sx_Skip( 0 ); + else if( ( nRecs > 0 ) && ! sx_Eof() ) + { + nSkipped = 0; + while( nSkipped < nRecs ) + { + sx_Skip( 1 ); + if( sx_Eof() ) + { + sx_Skip( -1 ); + nRecs = nSkipped; + } + else + { + nSkipped++; + } + } + } + else if( nRecs < 0 ) + { + while( nSkipped > nRecs ) + { + sx_Skip( -1 ); + if( sx_Bof() ) + { + nRecs = nSkipped; + } + else + { + nSkipped--; + } + } + } + } + + hb_retnl( nSkipped ); +} diff --git a/harbour/examples/hbapollo/str.c b/harbour/examples/hbapollo/str.c new file mode 100644 index 0000000000..fff1c2a35f --- /dev/null +++ b/harbour/examples/hbapollo/str.c @@ -0,0 +1,155 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" +#include + +/* + Synopsis: + Concatenates multiple strings into a single result. + Eg. xstrcat (buffer, "A", "B", NULL) stores "AB" in buffer. + Returns dest. Append the string to any existing contents of dest. + From DDJ Nov 1992 p. 155, with adaptions. + */ +char * _sx_randomname( const char * szPrefix ) +{ + HB_ISIZ iLen = szPrefix ? strlen( szPrefix ) : 0; + char * szRet = ( char * ) hb_xgrab( iLen + 8 ); /* _011200 */ + SYSTEMTIME t; + + GetLocalTime( &t ); + + if( iLen == 0 ) + szPrefix = "_"; + + hb_snprintf( szRet, iLen + 8, "%s%02d%02d%02d", szPrefix, t.wHour, t.wMinute, + t.wSecond ); + + return szRet; +} + +char * _sx_strcat( char * dest, const char * src, ... ) +{ + char * feedback = dest; + va_list va; + + while( *dest ) /* Find end of dest string */ + dest++; + va_start( va, src ); + while( src ) + { + while( *src ) + *dest++ = *src++; + src = va_arg( va, char * ); + } + + *dest = '\0'; /* Append a null character */ + va_end( va ); + return feedback; +} + +char * _sx_insertchar( char * strbuf, char chrtoins, HB_ISIZ pos ) +{ + memmove( ( strbuf + pos ) + 1, ( strbuf + pos ), strlen( ( strbuf + pos ) ) + 1 ); + *( strbuf + pos ) = chrtoins; + return strbuf; +} + +char * _sx_alltrim( char * string ) +{ + return _sx_ltrim( _sx_rtrim( string ) ); +} + +char * _sx_padl( char * strbuf, char chrtofill, HB_SIZE len ) +{ + while( strlen( strbuf ) < len ) + { + _sx_insertchar( strbuf, chrtofill, 0 ); + } + + return strbuf; +} + +char * _sx_padr( char * strbuf, char chrtofill, HB_SIZE len ) +{ + while( strlen( strbuf ) < len ) + { + _sx_insertchar( strbuf, chrtofill, strlen( strbuf ) ); + } + + return strbuf; +} + +char * _sx_rtrim( char * string ) +{ + char * last; + + if( string ) + { + last = string + strlen( string ); + while( last > string ) + { + if( ! isspace( *( last - 1 ) ) ) + break; + last--; + } + + *last = 0; + } + + return string; +} + +char * _sx_ltrim( char * string ) +{ + while( isspace( *string ) ) + hb_xstrcpy( string, string + 1 ); + + return string; +} + +char * _sx_upper( char * pszText ) +{ + char * pszPos; + + for( pszPos = pszText; *pszPos; pszPos++ ) + *pszPos = ( char ) toupper( ( UCHAR ) *pszPos ); + + return pszText; + +#if 0 + char * scan; + if( string ) + { + scan = string; + while( *scan ) + { + *scan = ( char ) toupper( *scan ); + scan++; + } + } + + return string; +#endif +} diff --git a/harbour/examples/hbapollo/sxapi.h b/harbour/examples/hbapollo/sxapi.h new file mode 100644 index 0000000000..dc4c774a45 --- /dev/null +++ b/harbour/examples/hbapollo/sxapi.h @@ -0,0 +1,345 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#ifndef __SIXAPIC__ +#define __SIXAPIC__ + +/* NOTE: This hack is needed to suppress 'non-ANSI + keyword' warnings inside Sde61.h. */ +#if defined( __MINGW32__ ) || defined( __BORLANDC__ ) || defined( __WATCOMC__ ) + #define _declspec __declspec +#endif + +#include "hbapi.h" +#include "hbapifs.h" +#include "hbapiitm.h" +#include "hbapierr.h" +#include "hbapirdd.h" +#include "hbset.h" +#include "hbdate.h" +#include "error.ch" +#include "hbvm.h" +#include "hbstack.h" + +#if defined( HB_OS_WIN ) + #include +#endif + +#if defined( HB_WITH_APOLLO_VER61 ) + #include "Sde61.h" +#else + #include "sde7.h" +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/* ******************************************************* */ +/* SDE defines */ +/* ******************************************************* */ +#define READWRITE 0 +#define READONLY 1 +#define EXCLUSIVE 2 + +/* ********* */ +/* RDE types */ +/* ********* */ +#define SDENTX 1 +#define SDEFOX 2 +#define SDENSX 3 +#define SDENSXDBT 4 + +/* text file types */ +#define COMMA_DELIM 21 +#define SDF_FILE 22 +#define TAB_DELIM 23 +#define SPACE_DELIM 24 +#define USER_DELIM 25 + +/* OEM Source types for AppendFrom */ +#define OEMNTX 31 +#define OEMFOX 32 +#define OEMNSX 33 + +/* Outdated RDE Names */ +#define DBFNTX SDENTX +#define DBFIDX SDEFOX +#define DBFNSX SDENSX +#define DBFNSXDBT SDENSXDBT + +/* *********** */ +/* Index Types */ +/* *********** */ +#define INDEX_STANDARD 1 +#define INDEX_STANDARD_UNIQUE 2 +#define INDEX_CONDITIONAL 3 +#define INDEX_CONDITIONAL_UNIQUE 4 + +/* ************* */ +/* date types */ +/* ************* */ +#define AMERICAN 0 +#define ANSI 1 +#define BRITISH 2 +#define FRENCH 3 +#define GERMAN 4 +#define ITALIAN 5 +#define SPANISH 6 +#define WIN_DEFAULT 99 + +/* ************************************ */ +/* Data type identifiers for sx_Replace */ +/* ************************************ */ +#define R_INTEGER 1 +#define R_LONG 2 +#define R_DOUBLE 8 +#define R_JULIAN 32 +#define R_LOGICAL 128 +#define R_CHAR 1024 +#define R_DATESTR 1056 +#define R_MEMO 3072 +#define R_BITMAP 4096 +#define R_BLOBFILE 8192 +#define R_BLOBPTR 8193 +#define R_GENERAL 8195 + +/* ******************************** */ +/* sx_QueryTest Results */ +/* ******************************** */ +#define OPTIMIZE_NONE 0 +#define OPTIMIZE_PART 1 +#define OPTIMIZE_FULL 2 + +/* ******************************** */ +/* sx_EvalTest Results */ +/* ******************************** */ +#define EVAL_CHARACTER 1 +#define EVAL_NUMERIC 2 +#define EVAL_LOGICAL 3 + +/* ******************************** */ +/* sx_Index(tag) iOptions */ +/* ******************************** */ +#define IDX_NONE 0 +#define IDX_UNIQUE 1 +#define IDX_EMPTY 2 + +/* ******************************** */ +/* sx_ErrorLevel uiErrorLevels */ +/* ******************************** */ +#define ERRLEVEL_NONE 0 +#define ERRLEVEL_FATAL 1 +#define ERRLEVEL_STANDARD 2 + +/* ***************************************** */ +/* RYO HB_BOOL Operations for RYOFilterActivate */ +/* ***************************************** */ +#define RYOFILTER_NEW 1 +#define RYOFILTER_AND 2 +#define RYOFILTER_OR 3 +#define RYOFILTER_XOR 4 +#define RYOFILTER_ANDNOT 5 +#define RYOFILTER_ORNOT 6 +#define RYOFILTER_XORNOT 7 + +/* ***************************************** */ +/* Collation rule type */ +/* ***************************************** */ +#define ALPHABETICAL 0 /* usual linguistic */ +#define SPELLING 1 /* == Duden */ +#define EXPANDING 2 /* additonal groups coalltion rule */ +#define MACHINE 3 /* simple value ordering */ + +/* ***************************************** */ +/* Collation rule order */ +/* ***************************************** */ +#define DEFAULT_SET 0 /* ALPHABETICAL or duden or expanding default */ + +/* ******************************** */ +/* sx_SysProp Constants */ +/* ******************************** */ + +/* Global Task Information */ +/* Gets should always be even numbers */ +#define SDE_SP_GETSOFTSEEK 1000 /* Get the softseek flag */ +#define SDE_SP_SETSOFTSEEK 1001 /* Set the softseek flag */ +#define SDE_SP_GETEXACT 1002 /* Get the extact flag */ +#define SDE_SP_SETEXACT 1003 /* Set the extact flag */ +#define SDE_SP_GETDELETED 1006 /* Get the deleted flag */ +#define SDE_SP_PUTOBUFFER 1007 /* Write the optimistic buffer on commit */ +#define SDE_SP_GETOBUFFER 1008 /* Get the optimistic buffer flag */ +#define SDE_SP_SETOBUFFER 1009 /* Set the optimistic buffer flag */ +#define SDE_SP_GETSTRINGTYPE 1010 /* Get the stringtype flag */ +#define SDE_SP_SETSTRINGTYPE 1011 /* Set the stringtype flag */ +#define SDE_SP_GETDISABLEAUTO 1012 /* Get the disable auto open flag */ +#define SDE_SP_SETDISABLEAUTO 1013 /* Set the disable auto open flag */ +#define SDE_SP_SETOEMCOLLATE 1101 /* Set the collation sequence for OEM tables. */ +#define SDE_SP_GETOEMCOLLATE 1111 /* Get the collation sequence for OEM tables. */ +#define SDE_SP_SETCHRCOLLATE 1102 /* Set the collation sequence for Win tables. */ +#define SDE_SP_GETCHRCOLLATE 1122 /* Get the collation sequence for Win tables. */ +#define SDE_SP_SETLGTRCOLLATE 1103 /* Set the ligatures collation dimmension */ +#define SDE_SP_GETLGTRCOLLATE 1133 /* Get the ligatures collation dimmension */ +#define SDE_SP_SETSPECIALCOLLATE 1108 /* Set the international collation like DUDEN collate flag */ +#define SDE_SP_GETSPECIALCOLLATE 1109 /* Set the international collation like DUDEN collate flag */ +#define SDE_SP_GETLANGUAGECOLLATE 1110 /* Get language, according to collation done */ +#define SDE_SP_GETDUDENCOLLATE 1104 /* get the German DUDEN collate flag */ +#define SDE_SP_SETDUDENCOLLATE 1105 /* set the German DUDEN collate flag */ +#define SDE_SP_GETLIMITCASECONV 1106 /* limit case conv to A-Z, a-z if HB_TRUE */ +#define SDE_SP_SETLIMITCASECONV 1107 /* limit case conv to A-Z, a-z if HB_TRUE */ + +/* Behavior settings which bridge the differences between 1.40 and 2.00 */ +#define SDE_SP_GETADDQUERY 1300 /* Get the AddQueryFlag */ +#define SDE_SP_SETADDQUERY 1301 /* Set the AddQueryFlag */ +#define SDE_SP_GETUSECONDITIONAL 1302 /* Get the bUseConditional flag */ +#define SDE_SP_SETUSECONDITIONAL 1303 /* Get the bUseConditional flag */ +#define SDE_SP_SETWRITEBLOBHDR 1305 /* Set the bWriteBlobHdr */ +#define SDE_SP_GETQUERYRELAXFLAG 1306 /* Get flag that dictates rules of query */ +#define SDE_SP_SETQUERYRELAXFLAG 1307 /* Set flag that dictates rules of query */ + +/* WorkArea information */ +#define SDE_SP_GETDRIVER 2000 /* Get the active driver */ +#define SDE_SP_SETSTRDEFLEN 2001 /* Set the default lenght for STR, if 2nd parameter is absent and field lenght zero */ +#define SDE_SP_SETSTRDEFDEC 2002 /* Set the default decimals for STR, if 3d parameter is absent and field lenght zero */ +#define SDE_SP_SETDEFAPPEND 2003 /* Set default behavior for ordering ordering for non-unique key like FOX/Clipper */ +#define SDE_SP_SETMEMOMIXED 2004 /* Set pure Clipper's memo for NSX driver */ +#define SDE_SP_BDESPECIFIC 2005 /* Set the treatment of LIKE operator in accoring to BDE */ +#define SDE_SP_DBASEDATEHEADER 2006 /* Set the using of DBF header in according to DbaseIII+ specification */ +#define SDE_SP_SETAUTOPAD 2007 +#define SDE_SP_GETAUTOPAD 2008 + +/* Index information for current workarea */ +#define SDE_SP_GETINDEXCOUNT 3000 /* Get the number of indexes */ +#define SDE_SP_GETDESCENDING 3002 /* Get the descending flag */ +#define SDE_SP_GETEMPTY 3004 /* Get the empty index flag */ +#define NIL '\0' + +/* Verify Types */ +#define VBEG 1 /* verify at begining of string only */ +#define VEND 2 /* verify at end of string only */ +#define VAND 3 /* verify all tokens in target */ +#define VONE 4 /* don't tokenize target */ + +/* FTS File Open Modes */ +#define FTS_SHARE 0x0 /* SHARE */ +#define FTS_EXCL 0x1 /* EXCLUSIVE */ +#define FTS_RDONLY 0x2 /* READ-ONLY */ + +#define FTSifdelete FTSisdelete /* permit old name */ + +/* FTS Error Codes */ +#define FTS_CREATEFAIL -1 +#define FTS_MEMERR -2 +#define FTS_NULLPTR -3 +#define FTS_BADSEEK -4 +#define FTS_BADREAD -5 +#define FTS_BADWRITE -6 +#define FTS_RECBOUND -7 +#define FTS_ISDELETED -8 +#define FTS_NOTDELETED -9 +#define FTS_OPENERR -10 +#define FTS_INTERR -11 +#define FTS_NORECS -13 +#define FTS_BADPARMS -16 +#define FTS_NOMOREHANDLES -17 +#define FTS_BADHANDLE -18 +#define FTS_BADIHANDLE -19 +#define FTS_LOCKFAILED -20 +#define FTS_NOMORELOCKS -21 +#define FTS_CANNOTUNLOCK -22 +#define FTS_BADCOMMIT -23 + +#define SX_DUMMY_NUMBER 9999 + +typedef struct SX_DBOPENINFO +{ + HB_USHORT uiArea; + const char * cFilename; + const char * cAlias; + HB_BOOL fShared; + HB_BOOL fReadonly; + HB_USHORT iRDEType; + HB_USHORT iMode; + const char * cRDD; + HB_USHORT iCommitLevel; + HB_USHORT iRecSize; + HB_USHORT iFieldCount; + PHB_ITEM aFieldInfo; +} SX_DBOPENINFO; + +extern LONG _sx_SysProp( WORD uiSysItem, PVOID vpData ); +extern char * _sx_randomname( const char * szPrefix ); +extern PHB_ITEM _sx_FieldNames( void ); +extern int _sx_CheckRDD( const char * sSetDefault ); +extern HB_BOOL _sx_Eval( PHB_ITEM pItem ); +extern HB_BOOL _sx_Used( VOID ); +extern HB_BOOL _sx_SetCentury( VOID ); +extern HB_BOOL _sx_CopyStructure( PBYTE cpFileName, PHB_ITEM paFields ); +extern char * _sx_insertchar( char * strbuf, char chrtoins, HB_ISIZ pos ); +extern char * _sx_ltrim( char * string ); +extern char * _sx_rtrim( char * string ); +extern char * _sx_alltrim( char * string ); +extern char * _sx_padl( char * strbuf, char chrtofill, HB_SIZE len ); +extern char * _sx_padr( char * strbuf, char chrtofill, HB_SIZE len ); +extern char * _sx_upper( char * string ); +extern char * _sx_strcat( char * dest, const char * src, ... ); +extern char * _sx_AutoAlias( const char * cpFileName ); +extern PHB_ITEM _sx_DbStruct( VOID ); +extern WORD _sx_select( PHB_ITEM vParam ); +extern int _sx_CheckOpenMode( const char * sxOpenMode ); +extern char * _sx_GetDateValue( PBYTE cFieldName ); +extern void _sx_SetDBFInfo( int iOpenedArea, const char * szAlias, + int iOpenMode, int iRDEType ); +extern void _sx_DelOpenInfo( const char * szAlias ); +extern const char * _sx_CheckFileExt( const char * szFileName ); +extern PHB_ITEM _sx_GetAlias( void ); + +#if defined( __SXAPI_INIT ) + int i_sxApi_MemoBlock_Size; /* Default Memo Block Size */ + int i_sxApi_Error_Level; /* Default ErrorLevel */ + int i_sxApi_RDD_Default; /* Default RDD Driver */ + HB_BOOL bSetTrimmedON = HB_FALSE; + PHB_ITEM Opened_DBF_Property = NULL; +#else + extern int i_sxApi_MemoBlock_Size; /* Default Memo Block Size */ + extern int i_sxApi_Error_Level; /* Default ErrorLevel */ + extern int i_sxApi_RDD_Default; /* Default RDD Driver */ + extern HB_BOOL bSetTrimmedON; + extern PHB_ITEM Opened_DBF_Property; +#endif + +#define AMERICAN 0 /* MM/DD/YY */ +#define ANSI 1 /* YY.MM.DD */ +#define BRITISH 2 /* DD/MM/YY */ +#define FRENCH 3 /* DD/MM/YY */ +#define GERMAN 4 /* DD.MM.YY */ +#define ITALIAN 5 /* DD-MM-YY */ +#define SPANISH 6 /* DD-MM-YY */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/harbour/examples/hbapollo/sysprop.c b/harbour/examples/hbapollo/sysprop.c new file mode 100644 index 0000000000..d5e49cb53d --- /dev/null +++ b/harbour/examples/hbapollo/sysprop.c @@ -0,0 +1,53 @@ +/* + * $Id$ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +HB_FUNC( SX_SYSPROP ) +{ + int i = hb_parni( 2 ); + + if( HB_ISNIL( 2 ) ) + sx_SysProp( ( WORD ) hb_parni( 1 ), ( PVOID ) NULL ); + else + hb_retni( sx_SysProp( + ( WORD ) hb_parni( 1 ), /* One of the predefined constant values. */ + ( void * ) i ) ); +} + +HB_FUNC( SX_RDDDRIVER ) +{ + int iDriverName; + char * cRDD[] = { "SDENTX", "SDEFOX", "SDENSX", "SDENSX_DBT" }; + + if( hb_pcount() == 0 ) + iDriverName = sx_SysProp( SDE_SP_GETDRIVER, ( PVOID ) NULL ); + else + { + int iWorkArea = hb_parni( 1 ); + iDriverName = sx_SysProp( SDE_SP_GETDRIVER, ( void * ) iWorkArea ); + } + + hb_retc( cRDD[ iDriverName - 1 ] ); +} diff --git a/harbour/examples/hbapollo/tests/hbmk.hbm b/harbour/examples/hbapollo/tests/hbmk.hbm new file mode 100644 index 0000000000..d8acbe34ec --- /dev/null +++ b/harbour/examples/hbapollo/tests/hbmk.hbm @@ -0,0 +1,7 @@ +# +# $Id$ +# + +hbapollo.hbc + +-w3 -es2 diff --git a/harbour/examples/hbapollo/tests/test01.prg b/harbour/examples/hbapollo/tests/test01.prg new file mode 100644 index 0000000000..2537f5425e --- /dev/null +++ b/harbour/examples/hbapollo/tests/test01.prg @@ -0,0 +1,38 @@ +/* + * $Id$ + */ +/* + Demo Creating DBF and Append Blank Records + Using SDENSX +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "TEST","C",10,0 }, { "MYDATE","C",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + + ? SX_VERSION() + + CREATE DBF cFile STRUCT aStruct VIA SDENSX + + USE cFile ALIAS MYALIAS VIA SDENSX VAR nArea EXCLUSIVE + + ? "-----------------------------------" + ? "Test Appending 10,000 Blank Records" + ? "-----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + for j := 1 TO 10000 + APPEND BLANK + next + + CLOSE ALL + + ? "End : ", seconds() + ? "Time : ", seconds() - n diff --git a/harbour/examples/hbapollo/tests/test02.prg b/harbour/examples/hbapollo/tests/test02.prg new file mode 100644 index 0000000000..9e3c1c9dcb --- /dev/null +++ b/harbour/examples/hbapollo/tests/test02.prg @@ -0,0 +1,89 @@ +/* + * $Id$ + */ +/* + Demo Creating DBF and Append Blank Records + Replacing and Retrieving Data + Using SDENSX +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR", "C", 25, 0 }, ; + { "MYDATE", "D", 8, 0 }, ; + { "MYNUM0", "N", 10, 0 }, ; + { "MYNUM2", "N", 10, 2 }, ; + { "MYNUM3", "N", 10, 3 }, ; + { "MYMEMO", "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea + + // SET CENTURY ON + // Automatically ON woth the following date format + SET EPOCH 1950 + SET DATE "DD-MM-YYYY" + SET( 4, "DD-MM-YYYY" ) + + // Set Trim On to RTRIM String Value of FieldGets + // Default is OFF + SET TRIM ON + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + APPEND BLANK + + REPLACE MYCHAR WITH "Harbour Power" + REPLACE MYDATE WITH DATE() + REPLACE MYNUM0 WITH 10000 + REPLACE MYNUM2 WITH 250.25 + REPLACE MYNUM3 WITH 10000.123 + REPLACE MYLOGIC WITH .T. + REPLACE MYMEMO WITH "This is some text but you can use MEMOREAD()" + + COMMIT + + ? "---------------------------------------------" + ? "Test Appending, Replacing and Retrieving Data" + ? "---------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? 'FieldGet( MYCHAR ) = ', FieldGet( MYCHAR ) , "[" + ValType( FieldGet( MYCHAR ) ) + "]" + ? 'FieldGet( MYDATE ) = ', FieldGet( MYDATE ) , "[" + ValType( FieldGet( MYDATE ) ) + "]" + ? 'FieldGet( MYNUM0 ) = ', FieldGet( MYNUM0 ) , "[" + ValType( FieldGet( MYNUM0 ) ) + "]" + ? 'FieldGet( MYNUM2 ) = ', FieldGet( MYNUM2 ) , "[" + ValType( FieldGet( MYNUM2 ) ) + "]" + ? 'FieldGet( MYNUM3 ) = ', FieldGet( MYNUM3 ) , "[" + ValType( FieldGet( MYNUM3 ) ) + "]" + ? 'FieldGet( MYMEMO ) = ', FieldGet( MYMEMO ) , "[" + ValType( FieldGet( MYMEMO ) ) + "]" + ? 'FieldGet( MYLOGIC ) = ', FieldGet( MYLOGIC ) , "[" + ValType( FieldGet( MYLOGIC ) ) + "]" + ? 'FieldGet( UNEXIST ) = ', FieldGet( UNEXIST ) , "[" + ValType( FieldGet( UNEXIST ) ) + "]" + + ? + ? "Now Get All Field as String ... Press any key ... " + PAUSE + ? + ? 'FieldGetStr( MYCHAR ) = ', FieldGetStr( MYCHAR ) , "[" + ValType( FieldGetStr( MYCHAR ) ) + "]" + ? 'FieldGetStr( MYDATE ) = ', FieldGetStr( MYDATE ) , "[" + ValType( FieldGetStr( MYDATE ) ) + "]" + ? 'FieldGetStr( MYNUM0 ) = ', FieldGetStr( MYNUM0 ) , "[" + ValType( FieldGetStr( MYNUM0 ) ) + "]" + ? 'FieldGetStr( MYNUM2 ) = ', FieldGetStr( MYNUM2 ) , "[" + ValType( FieldGetStr( MYNUM2 ) ) + "]" + ? 'FieldGetStr( MYNUM3 ) = ', FieldGetStr( MYNUM3 ) , "[" + ValType( FieldGetStr( MYNUM3 ) ) + "]" + ? 'FieldGetStr( MYMEMO ) = ', FieldGetStr( MYMEMO ) , "[" + ValType( FieldGetStr( MYMEMO ) ) + "]" + ? 'FieldGetStr( MYLOGIC ) = ', FieldGetStr( MYLOGIC ) , "[" + ValType( FieldGetStr( MYLOGIC ) ) + "]" + ? 'FieldGetStr( UNEXIST ) = ', FieldGetStr( UNEXIST ) , "[" + ValType( FieldGetStr( UNEXIST ) ) + "]" + + ? + ? "Now Get Date Field as DTOS ... Press any key ... " + PAUSE + ? + ? 'FieldGetDTOS( MYDATE ) = ', FieldGetDTOS( MYDATE ) , "[" + ValType( FieldGetDTOS( MYDATE ) ) + "]" + + ? + ? "Now Get Date Field as Julian Date ... Press any key ... " + PAUSE + ? + ? 'FieldGetJulian( MYDATE ) = ', FieldGetJulian( "MYDATE" ), "[" + ValType( FieldGetJulian( MYDATE ) ) + "]" + + CLOSE DATABASE diff --git a/harbour/examples/hbapollo/tests/test03.prg b/harbour/examples/hbapollo/tests/test03.prg new file mode 100644 index 0000000000..328e4db9d7 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test03.prg @@ -0,0 +1,71 @@ +/* + * $Id$ + */ +/* + Showing field properties +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL nArea, i, j + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "TEST","C",10,0 }, ; + { "MYDATE", "D", 8, 0 }, ; + { "MYNUM", "N", 8, 2 }, ; + { "MYMEMO", "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + + //IF FILE( "sixtest.nsx" ) + // FERASE( "sixtest.nsx" ) + //ENDIF + // SX_DISABLEAUTOOPEN() + // SX_SETAUTOOPEN(.t.) + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + ? "sx_version() = ", sx_version() + ? "Alias() = ", Alias() + ? + ? "FCount() = ", i := FCount() + ? + + for j := 1 TO i + ? "FieldName(" + ltrim( str( j ) ) + ") = ", FieldName( j ) + next + + ? + ? 'FieldType("TEST") = ', FieldType( "TEST" ) + ? 'FieldType("MYDATE") = ', FieldType( "MYDATE" ) + ? 'FieldType("MYNUM") = ', FieldType( "MYNUM" ) + ? 'FieldType("MYMEMO") = ', FieldType( "MYMEMO" ) + ? 'FieldType("MYLOGIC") = ', FieldType( "MYLOGIC" ) + ? + ? 'FieldPos( TEST ) = ', FieldPos( TEST ) + ? 'FieldPos( MYDATE ) = ', FieldPos( MYDATE ) + ? 'FieldPos( MYNUM ) = ', FieldPos( MYNUM ) + ? 'FieldPos( MYMEMO ) = ', FieldPos( MYMEMO ) + ? 'FieldPos( MYLOGIC ) = ', FieldPos( MYLOGIC ) + ? + ? 'FieldWidth("TEST") = ', FieldWidth( "TEST" ) + ? 'FieldWidth("MYDATE") = ', FieldWidth( "MYDATE" ) + ? 'FieldWidth("MYNUM") = ', FieldWidth( "MYNUM" ) + ? 'FieldWidth("MYMEMO") = ', FieldWidth( "MYMEMO" ) + ? 'FieldWidth("MYLOGIC") = ', FieldWidth( "MYLOGIC" ) + ? + ? 'FieldOffset("TEST") = ', FieldOffset( "TEST" ) + ? 'FieldOffset("MYDATE") = ', FieldOffset( "MYDATE" ) + ? 'FieldOffset("MYNUM") = ', FieldOffset( "MYNUM" ) + ? 'FieldOffset("MYMEMO") = ', FieldOffset( "MYMEMO" ) + ? 'FieldOffset("MYLOGIC") = ', FieldOffset( "MYLOGIC" ) + ? + ? 'FieldDecimals("TEST") = ', FieldDecimals( "TEST" ) + ? 'FieldDecimals("MYDATE") = ', FieldDecimals( "MYDATE" ) + ? 'FieldDecimals("MYNUM") = ', FieldDecimals( "MYNUM" ) + ? 'FieldDecimals("MYMEMO") = ', FieldDecimals( "MYMEMO" ) + ? 'FieldDecimals("MYLOGIC") = ', FieldDecimals( "MYLOGIC" ) + + CLOSE DATABASE diff --git a/harbour/examples/hbapollo/tests/test04.prg b/harbour/examples/hbapollo/tests/test04.prg new file mode 100644 index 0000000000..2bb9127343 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test04.prg @@ -0,0 +1,89 @@ +/* + * $Id$ + */ +/* + BOF(), EOF(), SKIP, GOTOP, GOBOTTOM, GOTO, ZAP +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL nArea, i + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "NAME","C",10,0 } } + +/* ALIAS is assigned so the file will be automatically opened + after created +*/ + + CREATE DBF cFile STRUCT aStruct RDD SDENSX ALIAS MYALIAS + +/* ALIAS is NOT assigned during creation, must open file manually + CREATE DBF cFile STRUCT aStruct RDD SDENSX + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE +*/ + + ? "Appending 1000 records ..." + FOR i := 1 TO 1000 + APPEND BLANK + REPLACE NAME WITH "NAME_" + PADL( i, 5, "0" ) + NEXT + COMMIT + + ? "Finished appending records ..." + ? "RecCount() = ", M_Say( RecCount() ) + ? "Now go to top of file ..." + GO TOP + ? "RecNo() = ", M_Say( RecNo() ) + ? "Now go to bottom ..." + GO BOTTOM + ? "RecNo() = ", M_Say( RecNo() ) + + ? + ? "Begin skipping until EOF ... Press any Key ..." + GO TOP + PAUSE + WHILE !EOF() + ? FieldGet( NAME ) + SKIP + ENDDO + + ? + ? "Begin skipping backward until BOF ... Press any Key ..." + PAUSE + WHILE !BOF() + ? FieldGet( NAME ) + SKIP - 1 + ENDDO + + ? + ? "Begin skipping (skip 2) until EOF ... Press any Key ..." + PAUSE + WHILE !EOF() + ? FieldGet( NAME ) + SKIP 2 + ENDDO + + ? + ? "Now Goto 500 .. Press any key ..." + GO 500 + PAUSE + ? + ? 'FieldGet( NAME ) = ', FieldGet( NAME ) + ? "RecNo() = ", M_Say( RecNo() ) + + ? + ? "Now will ZAP Database .. Press any key ..." + PAUSE + ZAP + ? "RecCount() = ", M_Say( RecCount() ) + ? + ? "Test completed ..." + + CLOSE DATABASE + +STATIC FUNCTION M_Say( nNumber ) + + RETURN ltrim( str( nNumber ) ) diff --git a/harbour/examples/hbapollo/tests/test05.prg b/harbour/examples/hbapollo/tests/test05.prg new file mode 100644 index 0000000000..004908fe93 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test05.prg @@ -0,0 +1,94 @@ +/* + * $Id$ + */ +/* + Default Settings +*/ +#include "sixapi.ch" + +PROCEDURE MAIN() + +/* Defines the format of date strings returned by sx_GetDateString. + AMERICAN "MM/DD/YY" + ANSI "YY.MM.DD" + BRITISH "DD/MM/YY" + FRENCH "DD/MM/YY" + GERMAN "DD.MM.YY" + ITALIAN "DD-MM-YY" + SPANISH "DD-MM-YY" +*/ + + SET DATE BRITISH + +/* + Indicates whether or not the two digits of the year designating + century are to be returned by sx_GetDateString as part of a date + string formatted according to the sx_SetDateFormat setting. +*/ + SET CENTURY ON + +/* + Makes deleted records either transparent or visible to record positioning + functions. Setting Deleted ON incurs certain performance penalties. + Instead of using Set Deleted ON, consider creating conditional index + files with a condition of .not. deleted. + + If True, deleted records will be invisible to all record positioning + functions except GO. +*/ + SET DELETED ON + +/* + Determines the interpretation of date strings with only two year digits. + When such a string is converted to a date value, its year digits are + compared with the year digits of iBaseYear. If the year digits in the + date are greater than or equal to the year digits of iBaseYear, the date + is assumed to fall within the same century as iBaseYear. Otherwise, + the date is assumed to fall in the following century. + + iBaseYear specifies the base year of a 100-year period in which all dates + containing only two year digits are assumed to fall. + + The default epoch value is 1900, causing dates with no century digits + to be interpreted as falling within the twentieth century. +*/ + SET EPOCH 1950 + +/* Indicates whether or not Seeks are to return True if a partial key + match is made. If True, key searches made with sx_Seek must match + exactly in content and length. Partial key matches will result in + False returns from sx_Seek. +*/ + SET EXACT ON + +/* + Change the number of open file handles in the current Windows task. + 255 max. +*/ + SET HANDLE 200 + +/* + Sets the number of seconds allowed to retry a lock operation before failing. + The lock operation will be continuously retried for this number of seconds + before reporting failure. The default value is 1 second. +*/ + SET LOCK TIMEOUT 5 + +/* + Indicates whether or not index seeks that result in failure + (i.e., the requested key value does not match any key in the index + order either partially or exactly) should result in a successful + conclusion if a key is found that is immediately greater than the + requested key. + + If ON, then soft seeks are performed for all files in the current task. + The soft seek setting is global in this respect. + sx_SetSoftSeek is normally only turned on when necessary, and then + turned off immediately after performing sx_Seek. + See sx_Seek for details as to its behavior when sx_SetSoftSeek is set + to True. + + NOTE: This is a global system setting that affects all index seeks once + it is turned on. +*/ + SET SOFTSEEK ON diff --git a/harbour/examples/hbapollo/tests/test06.prg b/harbour/examples/hbapollo/tests/test06.prg new file mode 100644 index 0000000000..433f24b329 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test06.prg @@ -0,0 +1,57 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "TEST","C",10,0 }, { "MYDATE","C",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + FieldPut( TEST, "NAME_" + PADL( j, 5, "0" ) ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(TEST) TO SIXTEST' + ? + INDEX ON UPPER( TEST ) TO SIXTEST + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Seek( "NAME_07567" ) =', Seek( "NAME_07567" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + ? + ? 'Seek( "NOTEXIST" ) =', Seek( "NOTEXIST" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test07.prg b/harbour/examples/hbapollo/tests/test07.prg new file mode 100644 index 0000000000..33782cf28d --- /dev/null +++ b/harbour/examples/hbapollo/tests/test07.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "MYCHAR","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + LOCAL nIndex + + SET EPOCH 1950 + + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + FieldPut( MYCHAR, "NAME_" + PADL( j, 5, "0" ) ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_SetOrder( 1 ) =', sx_SetOrder( 1 ) + ? 'sx_IndexName( 1 ) =', sx_IndexName( 1 ) + ? + ? 'Must explisitely set order 1 because we opened one index file' + ? + ? 'Seek( "NAME_07567" ) =', Seek( "NAME_07567" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + ? + ? 'Seek( "NOTEXIST" ) =', Seek( "NOTEXIST" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test08.prg b/harbour/examples/hbapollo/tests/test08.prg new file mode 100644 index 0000000000..e92e4764f2 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test08.prg @@ -0,0 +1,83 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + using different index file name than DBF file name +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "MYCHAR","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + LOCAL nIndex + + SET EPOCH 1950 + + IF FILE( "myindex.nsx" ) + FERASE( "myindex.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + FieldPut( MYCHAR, "NAME_" + PADL( j, 5, "0" ) ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO MYINDEX' + ? + INDEX ON UPPER( MYCHAR ) TO MYINDEX + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_IndexOpen( "myindex.nsx" ) =', sx_IndexOpen( "myindex.nsx" ) + ? + ? 'Must sx_IndexOpen() because index file name is different' + ? + ? 'sx_SetOrder( 1 ) =', sx_SetOrder( 1 ) + ? 'sx_IndexName( 1 ) =', sx_IndexName( 1 ) + ? + ? 'Must explisitely set order 1 because we opened one index file' + ? + ? 'Seek( "NAME_07567" ) =', Seek( "NAME_07567" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + ? + ? 'Seek( "NOTEXIST" ) =', Seek( "NOTEXIST" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test09.prg b/harbour/examples/hbapollo/tests/test09.prg new file mode 100644 index 0000000000..952a136c1f --- /dev/null +++ b/harbour/examples/hbapollo/tests/test09.prg @@ -0,0 +1,69 @@ +/* + * $Id$ + */ +/* + testing date settings + Options: + "AMERICAN" + "ANSI" + "BRITISH" + "FRENCH" + "GERMAN" + "ITALIAN" + "SPANISH" + "MM/DD/YY" + "YY.MM.DD" + "DD/MM/YY" + "DD.MM.YY" + "DD-MM-YY" + "MM/DD/YYYY" + "YYYY.MM.DD" + "DD/MM/YYYY" + "DD.MM.YYYY" + "DD-MM-YYYY" +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL e + + SET CENTURY ON + ? Date() + + SET DATE AMERICAN + ? Date() + + SET DATE BRITISH + ? Date() + + ? "Before :", sx_SetDateFormat( "AMERICAN" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "ANSI" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "BRITISH" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "FRENCH" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "GERMAN" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "ITALIAN" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "SPANISH" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "MM/DD/YY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "YY.MM.DD" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "DD/MM/YY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "DD.MM.YY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "DD-MM-YY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "MM/DD/YYYY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "YYYY.MM.DD" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "DD/MM/YYYY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "DD.MM.YYYY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + ? "Before :", sx_SetDateFormat( "DD-MM-YYYY" ), ", Now :", sx_SetDateFormat(), ", Date() =", Date() + BEGIN SEQUENCE WITH {| e | Break( e ) } + ? sx_SetDateFormat( "YYYY-MM-DD" ), Date() + RECOVER USING e + ? "This is Invalid =>", e:SubSystem, PadL( e:SubCode, 4 ), e:Operation, e:Description, ValToPrg( e:Args ) + END + + BEGIN SEQUENCE WITH {| e | Break( e ) } + ? sx_SetDateFormat( "AFRIKAANS" ), Date() + RECOVER USING e + ? "This is Invalid =>", e:SubSystem, PadL( e:SubCode, 4 ), e:Operation, e:Description, ValToPrg( e:Args ) + END diff --git a/harbour/examples/hbapollo/tests/test10.prg b/harbour/examples/hbapollo/tests/test10.prg new file mode 100644 index 0000000000..5038ca7bda --- /dev/null +++ b/harbour/examples/hbapollo/tests/test10.prg @@ -0,0 +1,25 @@ +/* + * $Id$ + */ +/* + Setting SoftSeek ON/OFF +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + ? 'SYSTEM DEFAULT' + ? 'sx_SetSoftSeek() =', sx_SetSoftSeek() + ? + SET SOFTSEEK ON + ? 'SET SOFTSEEK ON' + ? 'sx_SetSoftSeek() =', sx_SetSoftSeek() + ? + SET SOFTSEEK OFF + ? 'SET SOFTSEEK OFF' + ? 'sx_SetSoftSeek() =', sx_SetSoftSeek() + ? + ? 'Before :', sx_SetSoftSeek(), ', sx_SetSoftSeek(.T.) =', sx_SetSoftSeek( .T. ), ', Now :', sx_SetSoftSeek() + ? 'Before :', sx_SetSoftSeek(), ', sx_SetSoftSeek(.F.) =', sx_SetSoftSeek( .F. ), ', Now :', sx_SetSoftSeek() diff --git a/harbour/examples/hbapollo/tests/test11.prg b/harbour/examples/hbapollo/tests/test11.prg new file mode 100644 index 0000000000..0e93310926 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test11.prg @@ -0,0 +1,96 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + ... browsimg ... to test DBF compatilility ... :) + Note: No MEMO field for RDENSX or RDEFOX please or you'll get data + corrupt ... unless you link _SIX +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "MYCHAR","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + LOCAL nIndex + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + FieldPut( MYCHAR, "NAME_" + PADL( j, 5, "0" ) ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_SetOrder( 1 ) =', sx_SetOrder( 1 ) + ? 'sx_IndexName( 1 ) =', sx_IndexName( 1 ) + ? + ? 'Must explisitely set order 1 because we opened one index file' + ? + ? 'Seek( "NAME_07567" ) =', Seek( "NAME_07567" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + ? + ? 'Seek( "NOTEXIST" ) =', Seek( "NOTEXIST" ) + ? 'Found() =', Found() + ? 'Eof() =', Eof() + ? 'RecNo() =', RecNo() + + CLOSE ALL + +#include "unSix.ch" + + ? + ? "Now will browse DBF ... Press any key ..." + ? + + PAUSE + + cls + USE 'sixtest' new + browse() + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test12.prg b/harbour/examples/hbapollo/tests/test12.prg new file mode 100644 index 0000000000..3cfa2ccf5c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test12.prg @@ -0,0 +1,89 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + ... browsimg ...... :) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + // This is the usual behaviour of NSX file + // Erase the Old NSX if we are to create new one + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + + PAUSE + + CLOSE ALL + + // ReOpen Database + // USE "TEST\TEST" ALIAS TEST RDD SDENSX VAR nArea EXCLUSIVE + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_Alias = ', sx_Alias() + ? 'sx_SetOrder( 1 ) = ', sx_SetOrder( 1 ), ' was previous order' + ? 'sx_IndexName( 1 ) = ', sx_IndexName( 1 ) + ? + ? "Now will browse DBF ... Press any key ..." + ? + + PAUSE + cls + cOldColor = SetColor( "W+/B" ) + BROWSE + + CLOSE ALL + setcolor( cOldColor ) diff --git a/harbour/examples/hbapollo/tests/test13.prg b/harbour/examples/hbapollo/tests/test13.prg new file mode 100644 index 0000000000..d76866994d --- /dev/null +++ b/harbour/examples/hbapollo/tests/test13.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + ... dbedit ...... :) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "MYCHAR","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + LOCAL nIndex + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + FieldPut( MYCHAR, "NAME_" + PADL( j, 5, "0" ) ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_Alias = ', sx_Alias() + ? 'sx_SetOrder( 1 ) = ', sx_SetOrder( 1 ), ' was previous order' + ? 'sx_IndexName( 1 ) = ', sx_IndexName( 1 ) + ? + ? "Now will call SX_DBEDIT() ... Press any key ..." + ? + + PAUSE + cls + GO TOP + sx_dbedit() + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test14.prg b/harbour/examples/hbapollo/tests/test14.prg new file mode 100644 index 0000000000..dd4143d397 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test14.prg @@ -0,0 +1,89 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + DESCENDING INDEX .... + ... browsimg ...... :) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + // This is the usual behaviour of NSX file + // Erase the Old NSX if we are to create new one + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST DESCENDING' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST DESCENDING + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_Alias = ', sx_Alias() + ? 'sx_SetOrder( 1 ) = ', sx_SetOrder( 1 ), ' was previous order' + ? 'sx_IndexName( 1 ) = ', sx_IndexName( 1 ) + ? + ? "Now will browse DBF ... Press any key ..." + ? + + PAUSE + cls + cOldColor = SetColor( "W+/B" ) + BROWSE + + CLOSE ALL + setcolor( cOldColor ) diff --git a/harbour/examples/hbapollo/tests/test15.prg b/harbour/examples/hbapollo/tests/test15.prg new file mode 100644 index 0000000000..97d85ac69a --- /dev/null +++ b/harbour/examples/hbapollo/tests/test15.prg @@ -0,0 +1,89 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + DESCENDING INDEX .... WITH CONDITION ... + ... browsimg ...... :) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + // This is the usual behaviour of NSX file + // Erase the Old NSX if we are to create new one + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST DESCENDING FOR MYNUM < 5000 .AND. MYNUM > 2000' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST DESCENDING FOR MYNUM < 5000 .AND. MYNUM > 2000 + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_Alias = ', sx_Alias() + ? 'sx_SetOrder( 1 ) = ', sx_SetOrder( 1 ), ' was previous order' + ? 'sx_IndexName( 1 ) = ', sx_IndexName( 1 ) + ? + ? "Now will browse DBF ... Press any key ..." + ? + + PAUSE + cls + cOldColor = SetColor( "W+/B" ) + BROWSE + + CLOSE ALL + setcolor( cOldColor ) diff --git a/harbour/examples/hbapollo/tests/test16.prg b/harbour/examples/hbapollo/tests/test16.prg new file mode 100644 index 0000000000..ce02918265 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test16.prg @@ -0,0 +1,26 @@ +/* + * $Id$ + */ +/* + setting up valid RDD .... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN( x ) + + LOCAL e + + ? + ? '=================================' + ? 'These are the valid RDD options :' + ? '---------------------------------' + ? 'This is the default driver :', sx_RDDSetDefault() + ? 'Setting RDD to SDENTX ', ', Before :', sx_RDDSetDefault( "SDENTX" ), ', Now :', sx_RDDSetDefault() + ? 'Setting RDD to SDENSX ', ', Before :', sx_RDDSetDefault( "SDENSX" ), ', Now :', sx_RDDSetDefault() + ? 'Setting RDD to SDEFOX ', ', Before :', sx_RDDSetDefault( "SDEFOX" ), ', Now :', sx_RDDSetDefault() + ? 'Setting RDD to SDENSXDBT ', ', Before :', sx_RDDSetDefault( "SDENSXDBT" ), ', Now :', sx_RDDSetDefault() + ? 'This is now the default driver :', sx_RDDSetDefault() + // The next will cause an Internal Error + ? sx_RDDSetDefault( "SIXCDX" ) diff --git a/harbour/examples/hbapollo/tests/test17.prg b/harbour/examples/hbapollo/tests/test17.prg new file mode 100644 index 0000000000..e2b8c5e532 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test17.prg @@ -0,0 +1,38 @@ +/* + * $Id$ + */ +/* + Demo Creating DBF and Append Blank Records + Using SDEFOX ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "TEST","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYMEMO","M",10,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + + sx_RDDSetDefault( "SDEFOX" ) + + CREATE DBF cFile STRUCT aStruct + + USE cFile ALIAS MYALIAS VAR nArea SHARED // RDD SDEFOX + + ? "-----------------------------------" + ? "Test Appending 100,000 Blank Records" + ? "-----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + for j := 1 TO 100000 + APPEND BLANK + next + + CLOSE ALL + + ? "End : ", seconds() + ? "Time : ", seconds() - n diff --git a/harbour/examples/hbapollo/tests/test18.prg b/harbour/examples/hbapollo/tests/test18.prg new file mode 100644 index 0000000000..6725a3fd5c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test18.prg @@ -0,0 +1,38 @@ +/* + * $Id$ + */ +/* + Demo Creating DBF and Append Blank Records + Using SDENTX ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "TEST","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYMEMO","M",10,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + + sx_RDDSetDefault( "SDENTX" ) + + CREATE DBF cFile STRUCT aStruct + + USE cFile ALIAS MYALIAS VAR nArea SHARED // RDD SDEFOX + + ? "-----------------------------------" + ? "Test Appending 10,000 Blank Records" + ? "-----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + for j := 1 TO 10000 + APPEND BLANK + next + + CLOSE ALL + + ? "End : ", seconds() + ? "Time : ", seconds() - n diff --git a/harbour/examples/hbapollo/tests/test19.prg b/harbour/examples/hbapollo/tests/test19.prg new file mode 100644 index 0000000000..55d464822f --- /dev/null +++ b/harbour/examples/hbapollo/tests/test19.prg @@ -0,0 +1,38 @@ +/* + * $Id$ + */ +/* + Demo Creating DBF and Append Blank Records + Using SDENSXDBT ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "TEST","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYMEMO","M",10,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + + sx_RDDSetDefault( "SDENSXDBT" ) + + CREATE DBF cFile STRUCT aStruct + + USE cFile ALIAS MYALIAS VAR nArea SHARED // RDD SDEFOX + + ? "-----------------------------------" + ? "Test Appending 10,000 Blank Records" + ? "-----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + for j := 1 TO 10000 + APPEND BLANK + next + + CLOSE ALL + + ? "End : ", seconds() + ? "Time : ", seconds() - n diff --git a/harbour/examples/hbapollo/tests/test20.prg b/harbour/examples/hbapollo/tests/test20.prg new file mode 100644 index 0000000000..8435d14088 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test20.prg @@ -0,0 +1,64 @@ +/* + * $Id$ + */ +/* + index file properties ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { { "MYCHAR","C",10,0 }, { "MYDATE","D",8,0 }, { "MYNUM","N",8,0 }, { "MYLOGIC","L",1,0 } } + LOCAL j, n := seconds(), nArea + LOCAL nOrd + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + FieldPut( MYCHAR, "NAME_" + PADL( j, 5, "0" ) ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST FOR MYNUM > 5000' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST FOR MYNUM > 5000 + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? 'sx_IndexCondition() = ', sx_IndexCondition() + ? 'sx_IndexKey() = ', sx_IndexKey() + ? 'sx_IndexKeyField() = ', sx_IndexKeyField() + ? 'nOrd := sx_IndexOrd() = ', nOrd := sx_IndexOrd() + ? 'sx_IndexName( nOrd ) = ', sx_IndexName( nOrd ) + ? 'sx_IndexType() = ', sx_IndexType() + ? + ? 'sx_IndexType() returns one of the followings:' + ? 'INDEX_STANDARD 1' + ? 'INDEX_STANDARD_UNIQUE 2' + ? 'INDEX_CONDITIONAL 3' + ? 'INDEX_CONDITIONAL_UNIQUE 4' diff --git a/harbour/examples/hbapollo/tests/test21.prg b/harbour/examples/hbapollo/tests/test21.prg new file mode 100644 index 0000000000..10f3fd54d2 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test21.prg @@ -0,0 +1,143 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + DESCENDING INDEX .... + DELETING ... RECALLING ... BROWSIMG ...... :) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + // This is the usual behaviour of NSX file + // Erase the Old NSX if we are to create new one + IF FILE( "sixtest.nsx" ) + FERASE( "sixtest.nsx" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "------------------------------------------------------" + ? "Test Appending 10,000 Blank Records and Creating Index" + ? "------------------------------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? + ? 'INDEX ON UPPER(MYCHAR) TO SIXTEST DESCENDING' + ? + INDEX ON UPPER( MYCHAR ) TO SIXTEST DESCENDING + ? "End : ", seconds() + ? "Time : ", seconds() - n, "Quick enough ?" + ? + ? "Now CLOSE ALL and ReOpen DBF ... Press any key ..." + + PAUSE + + CLOSE ALL + + // ReOpen Database + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea SHARED + // Automatically Open index file if it has same name with DBF + // Must explisitely set order 1 because we opened one index file + ? + ? 'sx_Alias = ', sx_Alias() + ? 'sx_SetOrder( 1 ) = ', sx_SetOrder( 1 ), ' was previous order' + ? 'sx_IndexName( 1 ) = ', sx_IndexName( 1 ) + ? + ? 'Will GO TOP and Delete even RecNo until EOF ... Press any key ...' + PAUSE + ? + ? "Working ..." + n := seconds() + GO TOP + WHILE !sx_Eof() + IF FieldGet( MYNUM ) % 2 == 0 + DELETE + ENDIF + sx_Skip() + ENDDO + + ? + ? 'Deleting even MYNUM completed in', ltrim( str( seconds() - n ) ) + " seconds" + ? + ? "Now will browse DBF ... Press any key ..." + ? + + PAUSE + cls + cOldColor = SetColor( "W+/B" ) + BROWSE + + SetColor( cOldColor ) + cls + + ? + ? + ? + ? + ? + ? + ? + ? + ? + ? + ? + ? 'Now will GO TOP and RECALL deleted records ... Press any key ...' + PAUSE + + ? + ? "Working ...." + n := seconds() + GO TOP + WHILE !sx_Eof() + IF sx_Deleted() + RECALL + ENDIF + sx_Skip() + ENDDO + + ? + ? 'Recalling deleted records completed in', ltrim( str( seconds() - n ) ) + " seconds" + ? + ? "Now will browse DBF ... Press any key ..." + ? + PAUSE + cls + cOldColor = SetColor( "W+/B" ) + BROWSE + + CLOSE ALL + setcolor( cOldColor ) diff --git a/harbour/examples/hbapollo/tests/test22.prg b/harbour/examples/hbapollo/tests/test22.prg new file mode 100644 index 0000000000..26375f1edf --- /dev/null +++ b/harbour/examples/hbapollo/tests/test22.prg @@ -0,0 +1,91 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "----------------------------------" + ? "Polupating DBF with 10,000 Records" + ? "----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + BROWSE + + cls + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'REPLACE MYCHAR WITH "Harbour Power",' + ? ' MYMEMO WITH "Changed",;' + ? ' MYDATE WITH date(),;' + ? ' MYNUM WITH 0,;' + ? ' MYLOGIC WITH .T. ALL' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + ? + REPLACE MYCHAR WITH "Harbour Power", ; + MYMEMO WITH "Changed", ; + MYDATE WITH date(), ; + MYNUM WITH 0, ; + MYLOGIC WITH .T. ALL + + COMMIT + + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test23.prg b/harbour/examples/hbapollo/tests/test23.prg new file mode 100644 index 0000000000..390c14a4cb --- /dev/null +++ b/harbour/examples/hbapollo/tests/test23.prg @@ -0,0 +1,95 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ WITH NEXT CLAUSE ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "-------------------------------" + ? "Polupating DBF with 100 Records" + ? "-------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 100 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + BROWSE + + cls + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'REPLACE MYCHAR WITH "Harbour Power",' + ? ' MYMEMO WITH "Changed with NEXT Clause",;' + ? ' MYDATE WITH date(),;' + ? ' MYNUM WITH 0,;' + ? ' MYLOGIC WITH .T. NEXT 10' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + ? + ? 'GOTO 10' + + GOTO 10 + REPLACE MYCHAR WITH "Harbour Power", ; + MYMEMO WITH "Changed with NEXT Clause", ; + MYDATE WITH date(), ; + MYNUM WITH 0, ; + MYLOGIC WITH .T. NEXT 10 + + COMMIT + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test24.prg b/harbour/examples/hbapollo/tests/test24.prg new file mode 100644 index 0000000000..11907bd27b --- /dev/null +++ b/harbour/examples/hbapollo/tests/test24.prg @@ -0,0 +1,92 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ WITH RECORD CLAUSE ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "-------------------------------" + ? "Polupating DBF with 100 Records" + ? "-------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 100 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + BROWSE + + cls + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'REPLACE MYCHAR WITH "Harbour Power",' + ? ' MYMEMO WITH "Changed with RECORD Clause",;' + ? ' MYDATE WITH date(),;' + ? ' MYNUM WITH 0,;' + ? ' MYLOGIC WITH .T. RECORD 10' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + + REPLACE MYCHAR WITH "Harbour Power", ; + MYMEMO WITH "Changed with RECORD Clause", ; + MYDATE WITH date(), ; + MYNUM WITH 0, ; + MYLOGIC WITH .T. RECORD 10 + + COMMIT + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test25.prg b/harbour/examples/hbapollo/tests/test25.prg new file mode 100644 index 0000000000..f61d89d3c8 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test25.prg @@ -0,0 +1,85 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ ANOTHER TESTS ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET DELETED ON + SET COMMITLEVEL 2 + SET EPOCH 1950 + SET DATE "dd/mm/yyyy" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "---------------------------------" + ? "Polupating DBF with 10000 Records" + ? "---------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + APPEND BLANK 10000 + j := 0 + SX_DBEVAL( { ||; + cPad := PADL( ++ j, 5, "0" ), ; + SX_REPLACEEX( { ; + { "MYDATE", date() + j }, ; + { "MYCHAR", "NAME_" + cPad }, ; + { "MYNUM", j }, ; + { "MYMEMO", "This is Record Number " + cPad }, ; + { "MYLOGIC", j % 2 == 0 } } ) } ) + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + BROWSE + + cls + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'DELETE FOR !sx_GetValue("MYLOGIC")' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + + DELETE FOR !sx_GetValue( "MYLOGIC" ) + + COMMIT + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test26.prg b/harbour/examples/hbapollo/tests/test26.prg new file mode 100644 index 0000000000..32733bec77 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test26.prg @@ -0,0 +1,109 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ ANOTHER TESTS ... RECALL +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor + + SET DELETED ON + SET COMMITLEVEL 2 + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "-------------------------------" + ? "Polupating DBF with 100 Records" + ? "-------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 100 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + BROWSE + + cls + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'DELETE ALL' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + + DELETE ALL + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + PAUSE + BROWSE + + cls + + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'RECALL ALL' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + + SET DELETED OFF + RECALL ALL + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse DBF file ... Press any key ...' + + PAUSE + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test27.prg b/harbour/examples/hbapollo/tests/test27.prg new file mode 100644 index 0000000000..cc09828986 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test27.prg @@ -0,0 +1,74 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ ANOTHER TESTS ... COUNT TO +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor, nCount + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "---------------------------------" + ? "Polupating DBF with 10000 Records" + ? "---------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'COUNT TO nCount FOR sx_GetValue("MYDATE") >= CTOD("01/01/2004") ;' + ? ' .AND. sx_GetValue("MYDATE") <= CTOD("31/12/2004")' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + + COUNT TO nCount FOR sx_GetValue( "MYDATE" ) >= CTOD( "01/01/2004" ) ; + .AND. sx_GetValue( "MYDATE" ) <= CTOD( "31/12/2004" ) + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nCount =', nCount + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test28.prg b/harbour/examples/hbapollo/tests/test28.prg new file mode 100644 index 0000000000..837de5bb94 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test28.prg @@ -0,0 +1,75 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ ANOTHER TESTS ... COUNT TO ... NEXT n +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUM" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor, nCount + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "---------------------------------" + ? "Polupating DBF with 10000 Records" + ? "---------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUM, j ) + FieldPut( MYMEMO, "This is Record Number " + cPad ) + FieldPut( MYLOGIC, j % 2 == 0 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'COUNT TO nCount FOR sx_GetValue("MYDATE") >= CTOD("01/01/2008") ;' + ? ' .AND. sx_GetValue("MYDATE") <= CTOD("31/12/2008") ;' + ? ' NEXT 365' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + COUNT TO nCount FOR sx_GetValue( "MYDATE" ) >= CTOD( "01/01/2008" ) ; + .AND. sx_GetValue( "MYDATE" ) <= CTOD( "31/12/2008" ) ; + NEXT 365 + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nCount =', nCount + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test29.prg b/harbour/examples/hbapollo/tests/test29.prg new file mode 100644 index 0000000000..1eb4ece958 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test29.prg @@ -0,0 +1,112 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ SUM TO ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor, nSum1, nSum2 + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j ) + FieldPut( MYNUMBER2, j * 2 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'SUM MYNUMBER1, MYNUMBER2 TO nSum1, nSum2' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + SUM MYNUMBER1, MYNUMBER2 TO nSum1, nSum2 + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nSum1 =', nSum1 + ? 'nSum2 =', nSum2 + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'SUM MYNUMBER1, MYNUMBER2 TO nSum1, nSum2 NEXT 100' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + SUM MYNUMBER1, MYNUMBER2 TO nSum1, nSum2 NEXT 100 + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nSum1 =', nSum1 + ? 'nSum2 =', nSum2 + + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'SUM MYNUMBER1, MYNUMBER2 TO nSum1, nSum2 ;' + ? ' FOR sx_GetValue("MYDATE") <= CTOD("31/12/2003")' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + SUM MYNUMBER1, MYNUMBER2 TO nSum1, nSum2 ; + FOR sx_GetValue( "MYDATE" ) <= CTOD( "31/12/2003" ) + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nSum1 =', nSum1 + ? 'nSum2 =', nSum2 + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test30.prg b/harbour/examples/hbapollo/tests/test30.prg new file mode 100644 index 0000000000..1a14a94b86 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test30.prg @@ -0,0 +1,112 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + SX_DBEVAL ........ AVERAGE TO ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor, nAverage1, nAverage2 + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j * 10 ) + FieldPut( MYNUMBER2, j * 20 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'AVERAGE MYNUMBER1, MYNUMBER2 TO nAverage1, nAverage2' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + AVERAGE MYNUMBER1, MYNUMBER2 TO nAverage1, nAverage2 + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nAverage1 =', nAverage1 + ? 'nAverage2 =', nAverage2 + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'AVERAGE MYNUMBER1, MYNUMBER2 TO nAverage1, nAverage2 NEXT 100' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + AVERAGE MYNUMBER1, MYNUMBER2 TO nAverage1, nAverage2 NEXT 100 + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nAverage1 =', nAverage1 + ? 'nAverage2 =', nAverage2 + + ? + ? 'Now testing sx_DBEval with the following expressions :' + ? + ? 'AVERAGE MYNUMBER1, MYNUMBER2 TO nAverage1, nAverage2 ;' + ? ' FOR sx_GetValue("MYDATE") <= CTOD("31/12/2008")' + ? + ? 'Press any key ...' + PAUSE + n := seconds() + ? + ? 'Working .....' + GO TOP + AVERAGE MYNUMBER1, MYNUMBER2 TO nAverage1, nAverage2 ; + FOR sx_GetValue( "MYDATE" ) <= CTOD( "31/12/2008" ) + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'nAverage1 =', nAverage1 + ? 'nAverage2 =', nAverage2 + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test31.prg b/harbour/examples/hbapollo/tests/test31.prg new file mode 100644 index 0000000000..6064bfdbc4 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test31.prg @@ -0,0 +1,22 @@ +/* + * $Id$ + */ +#command TOTAL [TO <(file)>] [ON ] ; + [FIELDS ] ; + [FOR ] ; + [WHILE ] ; + [NEXT ] ; + [RECORD ] ; + [] ; + [ALL] ; + ; + => __dbTotal( ; + < ( file ) > , < { key } > , { < ( fields ) > }, ; + < { for } > , < { while } > , < next > , < rec > , < .rest. > ; + ) + + Notes: + + Frankly, I never USE this command. And I DO not know how this command can be + useful. IF somebody can give me a sample program, please .. + I READ the NG but it is not too CLEAR TO me :( diff --git a/harbour/examples/hbapollo/tests/test32.prg b/harbour/examples/hbapollo/tests/test32.prg new file mode 100644 index 0000000000..98cccf6707 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test32.prg @@ -0,0 +1,50 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + COPY STRUCTURE EXTENDED TO ... + CREATE FROM ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER" , "N", 8, 0 }, ; + { "MYDECIMAL" , "N", 8, 2 }, ; + { "MYLOGIC" , "L", 1, 0 }, ; + { "MYMEMO" , "M", 10, 0 } } + + ? 'CREATE DBF cFile STRUCT aStruct' + ? 'USE cFile ALIAS MYALIAS' + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS + ? + ? 'Now will copy structure extended ... Press any key ...' + PAUSE + ? + ? 'COPY STRUCTURE EXTENDED TO TESTSTRUCT' + COPY STRUCTURE EXTENDED TO TESTSTRUCT + USE "TESTSTRUCT" ALIAS MYSTRUCT + ? 'Now browse the structure DBF ... Press any key ...' + PAUSE + BROWSE + + cls + ? 'Now will CREATE FROM structure DBF ... Press any key ...' + PAUSE + ? + ? 'CREATE NEWFILE FROM TESTSTRUCT VIA SDENSX ALIAS NEWALIAS' + CREATE NEWFILE FROM TESTSTRUCT VIA SDENSX ALIAS NEWALIAS + ? 'Now browse the structure DBF ... Press any key ...' + PAUSE + cls + BROWSE + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test33.prg b/harbour/examples/hbapollo/tests/test33.prg new file mode 100644 index 0000000000..aa917bf445 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test33.prg @@ -0,0 +1,55 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + COPY STRUCTURE TO FIELDS ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER" , "N", 8, 0 }, ; + { "MYDECIMAL" , "N", 8, 2 }, ; + { "MYLOGIC" , "L", 1, 0 }, ; + { "MYMEMO" , "M", 10, 0 } } + + ? 'CREATE DBF cFile STRUCT aStruct' + ? 'USE cFile ALIAS MYALIAS' + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS + ? + ? 'Now will copy structure ... Press any key ...' + PAUSE + ? + ? 'COPY STRUCTURE TO TSTSTRU' + COPY STRUCTURE TO TSTSTRU + ? + ? 'Now browse the newly created DBF ... Press any key ...' + PAUSE + cls + USE "TSTSTRU" ALIAS MYSTRUCT + BROWSE + sx_Close() + + ? + ? 'Now will copy structure using FIELDS clause ... Press any key ...' + PAUSE + ? + ? 'COPY STRUCTURE TO TSTSTRU FIELDS MYCHAR, MYDATE, MYDECIMAL, MYLOGIC' + COPY STRUCTURE TO TSTSTRU FIELDS MYCHAR, MYDATE, MYDECIMAL, MYLOGIC + + ? 'Now browse the newly created DBF ... Press any key ...' + PAUSE + cls + USE "TSTSTRU" ALIAS MYSTRUCT + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test34.prg b/harbour/examples/hbapollo/tests/test34.prg new file mode 100644 index 0000000000..666108fd8a --- /dev/null +++ b/harbour/examples/hbapollo/tests/test34.prg @@ -0,0 +1,77 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + COPYTEXT ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL cApplication + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF File( "C:\WINDOWS\TEMP\myText.Txt" ) + FErase( "C:\WINDOWS\TEMP\myText.Txt" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j * 10 ) + FieldPut( MYNUMBER2, j * 20 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + +/* +Delimiter should be one of the followings: + COMMA_DELIM + SDF_FILE + TAB_DELIM + SPACE_DELIM +*/ + + COPYTEXT TO C:\WINDOWS\TEMP\mytext.txt DELIMITED WITH TAB_DELIM + // COPYTEXT TO mytext.txt DELIMITED WITH COMMA_DELIM + // COPYTEXT TO mytext.txt DELIMITED WITH SDF_DELIM + // COPYTEXT TO mytext.txt DELIMITED WITH SPACE_DELIM + + CLOSE ALL + + IF !empty( cApplication := appReg( "txt" ) ) + ? 'Now will browse text file ... Press any key ...' + PAUSE + IF File( "c:\windows\temp\myText.Txt" ) + __run( cApplication + " " + "c:\windows\temp\mytext.txt" ) + ENDIF + ENDIF diff --git a/harbour/examples/hbapollo/tests/test35.prg b/harbour/examples/hbapollo/tests/test35.prg new file mode 100644 index 0000000000..1fac5beb1b --- /dev/null +++ b/harbour/examples/hbapollo/tests/test35.prg @@ -0,0 +1,93 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + COPY TO DELIMITED WITH FIELDS FOR NEXT ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 } } // Memo field will not be printed + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor, nAverage1, nAverage2, cApplication + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF File( "c:\windows\temp\myText.Txt" ) + FErase( "c:\windows\temp\myText.Txt" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j * 10 ) + FieldPut( MYNUMBER2, j * 20 ) + FieldPut( MYMEMO, "My Memo" ) // Memo Field Will Not Be Printed + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will COPY TO ... Press any key ...' + PAUSE + ? + n := seconds() + ? 'COPY TO mytext.txt FIELDS MYCHAR, MYDATE, MYNUMBER1, MYNUMBER2, MYMEMO ;' + ? ' FOR sx_GetValue( "MYDATE" ) <= CTOD("31/12/2008") ;' + ? ' NEXT 100 DELIMITED WITH CHR(9)' + ? 'Please note that MEMO field will not be printed' + + GO TOP + // if no FIELDS clause is used, all fields will be printed + // COPY TO mytext.txt ; + // DELIMITED clause should come last + COPY TO c:\windows\temp\mytext.txt FIELDS MYCHAR, MYDATE, MYNUMBER1, MYNUMBER2, MYMEMO ; + FOR sx_GetValue( "MYDATE" ) <= CTOD( "31/12/2008" ) ; + NEXT 100 DELIMITED WITH CHR( 9 ) + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + + CLOSE ALL + + // if file("c:\windows\temp\mytext.txt") + // ? 'File c:\windows\temp\mytext.txt created ...' + // endif + + IF !empty( cApplication := appReg( "txt" ) ) + ? 'Now will browse text file ... Press any key ...' + PAUSE + IF File( "c:\windows\temp\myText.Txt" ) + __Run( cApplication + " " + "c:\windows\temp\mytext.txt" ) + ENDIF + ENDIF diff --git a/harbour/examples/hbapollo/tests/test36.prg b/harbour/examples/hbapollo/tests/test36.prg new file mode 100644 index 0000000000..a386570edd --- /dev/null +++ b/harbour/examples/hbapollo/tests/test36.prg @@ -0,0 +1,93 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + COPY TO FILE SDF WITH FIELDS FOR NEXT ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 }, ; + { "MYMEMO" , "M", 10, 0 } } // Memo field will not be printed + LOCAL j, n := seconds(), nArea, cPad + LOCAL nIndex, cOldColor, nAverage1, nAverage2, cApplication + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF File( "c:\windows\temp\myText.Txt" ) + FErase( "c:\windows\temp\myText.Txt" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j * 10 ) + FieldPut( MYNUMBER2, j * 20 ) + FieldPut( MYMEMO, "My Memo" ) // Memo Field Will Not Be Printed + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will COPY TO ... Press any key ...' + PAUSE + ? + n := seconds() + ? 'COPY TO mytext.txt SDF FIELDS MYCHAR, MYDATE, MYNUMBER1, MYNUMBER2, MYMEMO ;' + ? ' FOR sx_GetValue( "MYDATE" ) <= CTOD("31/12/2003") ;' + ? ' NEXT 100' + ? 'Please note that MEMO field will not be printed' + + GO TOP + // if no FIELDS clause is used, all fields will be printed + // COPY TO mytext.txt ; + // DELIMITED clause should come last + COPY TO c:\windows\temp\mytext.txt SDF FIELDS MYCHAR, MYDATE, MYNUMBER1, MYNUMBER2, MYMEMO ; + FOR sx_GetValue( "MYDATE" ) <= CTOD( "31/12/2003" ) ; + NEXT 100 + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + + CLOSE ALL + + // if file("c:\windows\temp\mytext.txt") + // ? 'File c:\windows\temp\mytext.txt created ...' + // endif + + IF !empty( cApplication := appReg( "txt" ) ) + ? 'Now will browse text file ... Press any key ...' + PAUSE + IF File( "c:\windows\temp\myText.Txt" ) + __run( cApplication + " " + "c:\windows\temp\mytext.txt" ) + ENDIF + ENDIF diff --git a/harbour/examples/hbapollo/tests/test37.prg b/harbour/examples/hbapollo/tests/test37.prg new file mode 100644 index 0000000000..f814ccfa8f --- /dev/null +++ b/harbour/examples/hbapollo/tests/test37.prg @@ -0,0 +1,104 @@ +/* + * $Id$ + */ +/* + Copying records to a new DBF files from current work area .... + COPY TO FILE FIELDS FOR NEXT ..... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 2 }, ; + { "MYLOGICAL" , "L", 1, 0 }, ; + { "MYMEMO" , "M", 10, 0 } } + LOCAL j, n := seconds(), nArea, cPad + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF File( "c:\windows\temp\myText.Txt" ) + FErase( "c:\windows\temp\myText.Txt" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct + + USE cFile ALIAS MYALIAS VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j * 10 ) + FieldPut( MYNUMBER2, ( j * 13 ) / 3 ) + FieldPut( MYLOGICAL, ( j % 2 ) == 0 ) + FieldPut( MYMEMO, "My Memo" ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + + ? + ? 'Now will copy to new file using FIELD clause ... Press any key ...' + PAUSE + n := seconds() + ? + ? 'COPY TO MYCOPY FIELDS MYCHAR,MYNUMBER1,MYLOGICAL;' + ? ' WHILE SX_GETVALUE("MYDATE")<= CTOD("31/12/2003")' + + // COPY TO MYCOPY ALL + + COPY TO MYCOPY FIELDS MYCHAR, MYNUMBER1, MYLOGICAL ; + WHILE SX_GETVALUE( "MYDATE" ) <= CTOD( "31/12/2003" ) + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse the newly created DBF ... Press any key ...' + PAUSE + + USE "MYCOPY" + BROWSE + CLOSE + cls + + ? + ? 'Now will copy to new file (NOT using FIELDS clause) ... Press any key ...' + PAUSE + n := seconds() + ? + ? 'COPY TO MYCOPY WHILE SX_GETVALUE("MYDATE")<= CTOD("31/12/2003")' + + COPY TO MYCOPY WHILE SX_GETVALUE( "MYDATE" ) <= CTOD( "31/12/2003" ) + + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now will browse the newly created DBF ... Press any key ...' + PAUSE + + USE "MYCOPY" + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test38.prg b/harbour/examples/hbapollo/tests/test38.prg new file mode 100644 index 0000000000..08ae998bcc --- /dev/null +++ b/harbour/examples/hbapollo/tests/test38.prg @@ -0,0 +1,43 @@ +/* + * $Id$ + */ +/* + Copying records to a new DBF files from current work area .... + SX_DBSTRUCT() ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 2 }, ; + { "MYLOGICAL" , "L", 1, 0 }, ; + { "MYMEMO" , "M", 10, 0 } } + LOCAL j, aStructure + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF File( "c:\windows\temp\myText.Txt" ) + FErase( "c:\windows\temp\myText.Txt" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct + + USE cFile ALIAS MYALIAS + ? + ? 'SX_DBSTRUCT() Test ...' + ? + ? 'len( aStructure ) :=', ltrim( str( len(aStructure := sx_dbstruct() ) ) ) + ? + for j := 1 TO len( aStructure ) + ? padr( aStructure[j][1], 16 ) + aStructure[j][2] + str( aStructure[j][3] ) + str( aStructure[j][4] ) + next + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test39.prg b/harbour/examples/hbapollo/tests/test39.prg new file mode 100644 index 0000000000..bf0a219aa5 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test39.prg @@ -0,0 +1,74 @@ +/* + * $Id$ + */ +/* + creating new index files, seek and found tests + closing files and reusing existing index file + LOCATE ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + LOCAL j, n := seconds(), nArea, cPad + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + IF File( "myText.Txt" ) + FErase( "myText.Txt" ) + ENDIF + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + + ? "--------------------------------" + ? "Polupating DBF with 1000 Records" + ? "--------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + FOR j := 1 TO 1000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + FieldPut( MYCHAR, "NAME_" + cPad ) + FieldPut( MYDATE, date() + j ) + FieldPut( MYNUMBER1, j * 10 ) + FieldPut( MYNUMBER2, j * 20 ) + NEXT + + COMMIT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + + ? + ? 'GO TOP' + ? [sx_locate( 'MYCHAR = "NAME_00100"', .F., .F. )] + GO TOP + // Syntax : SX_LOCATE( cExpression, lBackward, lContinue ) => RecNo() + // Locate forward + ? '->', sx_locate( 'MYCHAR = "NAME_00100"', .F. , .F. ) + ? + ? [sx_locate( 'MYCHAR = "NAME_00035"', .T., .F. )] + ? '->', sx_locate( 'MYCHAR = "NAME_00035"', .T. , .F. ) + ? + + ? 'GO BOTTOM' + ? [sx_locate( 'MYCHAR = "NAME_00100"', .T., .F. )] + GO BOTTOM + // Locate backward + ? '->', sx_locate( 'MYCHAR = "NAME_00100"', .T. , .F. ) + ? + ? [sx_locate( 'MYCHAR = "NAME_00800"', .F., .F. )] + ? '->', sx_locate( 'MYCHAR = "NAME_00800"', .F. , .F. ) diff --git a/harbour/examples/hbapollo/tests/test40.prg b/harbour/examples/hbapollo/tests/test40.prg new file mode 100644 index 0000000000..9e8b2053ce --- /dev/null +++ b/harbour/examples/hbapollo/tests/test40.prg @@ -0,0 +1,56 @@ +/* + * $Id$ + */ +#include "sixapi.ch" +/* + __dx_dbSort( ...... ) +*/ + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL n := seconds() + + ? 'Demo on SORT TO ... command .. Press any key ...' + PAUSE + ? 'USE "TEST\TEST" ALIAS TEST EXCLUSIVE' + ? 'Working ...' + USE "TEST\TEST" ALIAS TEST EXCLUSIVE + ? 'SORT TO NEWFILE ON LAST DESCENDING' + SORT TO NEWFILE ON LAST DESCENDING + ? + ? 'Done!' + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'BROWSE .. Press any key ...' + PAUSE + USE "NEWFILE" + BROWSE + CLS + CLOSE DATABASE + SELECT TEST + CLOSE INDEXES + + ? + ? 'SORT with DATE Field ... Press any key ...' + PAUSE + n := seconds() + ? 'SORT TO NEWFILE ON HIREDATE DESCENDING' + SORT TO NEWFILE ON HIREDATE DESCENDING + ? + ? 'Done!' + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'BROWSE .. Press any key ...' + PAUSE + USE "NEWFILE" + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test41.prg b/harbour/examples/hbapollo/tests/test41.prg new file mode 100644 index 0000000000..4e1b100caa --- /dev/null +++ b/harbour/examples/hbapollo/tests/test41.prg @@ -0,0 +1,68 @@ +/* + * $Id$ + */ +/* + Append Many Blank Records at Once +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + LOCAL j, n := seconds() + + SX_RDDSETDEFAULT( "SDEFOX" ) + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + ? + ? 'Using APPEND BLANK 10000 ... Press any key ...' + PAUSE + + n := seconds() + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS + APPEND BLANK 10000 + + ? "---------------------------------" + ? "Polupating DBF with 10000 Records" + ? "---------------------------------" + ? "RDD : " + sx_rddDriver( ) + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'sx_RecCount() =', sx_RecCount() + + CLOSE ALL + + ? + ? 'Using conventional FOR-NEXT LOOP ... Press any key ...' + PAUSE + + n := seconds() + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS + + ? "---------------------------------" + ? "Polupating DBF with 10000 Records" + ? "---------------------------------" + ? "RDD : " + sx_rddDriver() + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK TO MYALIAS + NEXT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'sx_RecCount() =', sx_RecCount() + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test42.prg b/harbour/examples/hbapollo/tests/test42.prg new file mode 100644 index 0000000000..a1987013f7 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test42.prg @@ -0,0 +1,79 @@ +/* + * $Id$ + */ +/* + Enhanced DBEval, and alias assignment +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile1 := "test_1.dbf" + LOCAL cFile2 := "test_2.dbf" + LOCAL cFile3 := "test_3.dbf" + + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + + SX_RDDSETDEFAULT( "SDEFOX" ) + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile1 STRUCT aStruct + USE cFile1 ALIAS MYALIAS_1 EXCLUSIVE + + CREATE DBF cFile2 STRUCT aStruct + USE cFile2 ALIAS MYALIAS_2 EXCLUSIVE + + CREATE DBF cFile3 STRUCT aStruct + USE cFile3 ALIAS MYALIAS_3 EXCLUSIVE + + APPEND BLANK TO MYALIAS_1 100 + APPEND BLANK TO MYALIAS_2 200 + APPEND BLANK TO MYALIAS_3 300 + + ? 'sx_LastRec("MYALIAS_1")=', sx_LastRec( "MYALIAS_1" ) + ? 'sx_LastRec("MYALIAS_2")=', sx_LastRec( "MYALIAS_2" ) + ? 'sx_LastRec("MYALIAS_3")=', sx_LastRec( "MYALIAS_3" ) + + ? 'GOTO 100 ALIAS MYALIAS_1' + GOTO 100 ALIAS MYALIAS_1 + + ? 'REPLACE MYCHAR ALIAS MYALIAS_1 WITH "my_alias_3"' + REPLACE MYCHAR ALIAS MYALIAS_1 WITH "my_alias_3" + + // SX_REPLACE("MYCHAR","My_Alias_3","MYALIAS_1") + + ? 'DELETE FOR sx_RecNo() <= 50 AREA MYALIAS_1' + ? 'DELETE FOR sx_RecNo() <= 70 AREA MYALIAS_2' + ? 'SX_GETVALUE("MYCHAR","MYALIAS_1")=', SX_GETVALUE( "MYCHAR", "MYALIAS_1" ) + + ? 'sx_Recno("MYALIAS_1") =', sx_Recno( "myalias_1" ) + + DELETE FOR sx_RecNo() <= 50 AREA MYALIAS_1 + DELETE FOR sx_RecNo() <= 70 AREA MYALIAS_2 + + ? 'PACK MYALIAS_1' + ? 'PACK MYALIAS_2' + + PACK MYALIAS_1 + PACK MYALIAS_2 + + ? 'sx_LastRec("MYALIAS_1")=', sx_LastRec( "MYALIAS_1" ) + ? 'sx_LastRec("MYALIAS_2")=', sx_LastRec( "MYALIAS_2" ) + ? 'sx_LastRec("MYALIAS_3")=', sx_LastRec( "MYALIAS_3" ) + + ? 'ZAP MYALIAS_1' + ? 'ZAP MYALIAS_2' + + ZAP MYALIAS_1 + ZAP MYALIAS_2 + + ? 'sx_LastRec("MYALIAS_1")=', sx_LastRec( "MYALIAS_1" ) + ? 'sx_LastRec("MYALIAS_2")=', sx_LastRec( "MYALIAS_2" ) + ? 'sx_LastRec("MYALIAS_3")=', sx_LastRec( "MYALIAS_3" ) diff --git a/harbour/examples/hbapollo/tests/test43.prg b/harbour/examples/hbapollo/tests/test43.prg new file mode 100644 index 0000000000..52edf5e4d6 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test43.prg @@ -0,0 +1,47 @@ +/* + * $Id$ + */ +/* + test sx_CopyFile() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile1 := "test_1.dbf" + LOCAL cFile2 := "test_2.dbf" + LOCAL cFile3 := "test_3.dbf" + + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + + SX_RDDSETDEFAULT( "SDEFOX" ) + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile1 STRUCT aStruct + USE cFile1 ALIAS MYALIAS_1 EXCLUSIVE + + CREATE DBF cFile2 STRUCT aStruct + USE cFile2 ALIAS MYALIAS_2 EXCLUSIVE + + CREATE DBF cFile3 STRUCT aStruct + USE cFile3 ALIAS MYALIAS_3 EXCLUSIVE + + ? 'APPEND BLANK TO MYALIAS_1 100' + APPEND BLANK TO MYALIAS_1 100 + ? 'APPEND BLANK TO MYALIAS_2 200' + APPEND BLANK TO MYALIAS_2 200 + ? 'APPEND BLANK TO MYALIAS_3 300' + APPEND BLANK TO MYALIAS_3 300 + + ? 'sx_CopyFile( "NEWFILE1", "MYALIAS_1" ) =', sx_CopyFile( "NEWFILE1", "MYALIAS_1" ) + ? 'sx_CopyFile( "NEWFILE2", "MYALIAS_2" ) =', sx_CopyFile( "NEWFILE2", "MYALIAS_2" ) + ? 'sx_CopyFile( "NEWFILE3", "MYALIAS_3" ) =', sx_CopyFile( "NEWFILE3", "MYALIAS_3" ) + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test44.prg b/harbour/examples/hbapollo/tests/test44.prg new file mode 100644 index 0000000000..48eebc191f --- /dev/null +++ b/harbour/examples/hbapollo/tests/test44.prg @@ -0,0 +1,24 @@ +/* + * $Id$ + */ +/* + Test sx_Encrypt()/sx_Decrypt() +*/ + +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cname := "Harbour Power" + LOCAL c + + ? + ? 'local cname := "Harbour Power"' + ? 'local c' + ? + ? 'sx_encrypt( cname, "password" ) = ', c := sx_encrypt( cname, "password" ) + ? 'sx_decrypt( c, "password" ) = ', sx_decrypt( c, "password" ) + ? + ? 'sx_decrypt( c, "wrongpass" ) = ', sx_decrypt( c, "wrongpass" ) diff --git a/harbour/examples/hbapollo/tests/test45.prg b/harbour/examples/hbapollo/tests/test45.prg new file mode 100644 index 0000000000..f4d6852e9a --- /dev/null +++ b/harbour/examples/hbapollo/tests/test45.prg @@ -0,0 +1,67 @@ +/* + * $Id$ + */ +/* + Manipulation of Database Field Values + sx_EvalTest() + sx_EvalString() + sx_EvalNumeric() + sx_EvalLogical() +*/ +#include "sixapi.ch" + +#define EVAL_CHARACTER 1 +#define EVAL_NUMERIC 2 +#define EVAL_LOGICAL 3 +#define EVAL_DATESTRING 4 + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "TEST.DBF" + LOCAL i + LOCAL aStruct := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYLOGIC" , "L", 1, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 0 } } + + SX_RDDSETDEFAULT( "SDEFOX" ) + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS EXCLUSIVE + APPEND BLANK + REPLACE MYCHAR WITH "JUST TEST", ; + MYDATE WITH DATE(), ; + MYLOGIC WITH .T. , ; + MYNUMBER1 WITH 111 , ; + MYNUMBER2 WITH 222 + + //--- sxApi way .... + ? 'sxApi way ...' + ? + ? "TEST" $ sx_GetValue( "MYCHAR" ) + ? IF( sx_GetValue( "MYLOGIC" ), "TRUE", "FALSE" ) + ? sx_GetValue( "MYNUMBER1" ) + sx_GetValue( "MYNUMBER2" ) + ? sx_GetValue( "MYDATE" ) + 30 + ? + //--- Apollo way ... + ? 'Apollo way ...' + ? + ? sx_EvalLogical( '"TEST" $ MYCHAR' ) + ? sx_EvalNumeric( 'MYNUMBER1 + MYNUMBER2' ) + ? sx_EvalString( 'MYCHAR + " " + DTOS( MYDATE )' ) + ? STOD( sx_EvalString( 'MYDATE + 30' ) ) + ? + ? 'sx_Evaltest() ....' + ? + ? sx_EvalTest( 'MYCHAR + " " + DTOS( MYDATE )' ) + ? sx_EvalTest( 'MYNUMBER1 + MYNUMBER2' ) + ? sx_EvalTest( '"TEST" $ MYCHAR' ) + ? sx_EvalTest( 'MYDATE + 30' ) + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test46.prg b/harbour/examples/hbapollo/tests/test46.prg new file mode 100644 index 0000000000..710dd4b307 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test46.prg @@ -0,0 +1,75 @@ +/* + * $Id$ + */ +/* + sx_FieldCount ( nArea | cAlias ) + sx_FieldDecimals ( cFieldName, nArea | cAlias ) + sx_FieldName ( iFieldNum, nArea | cAlias ) + sx_FieldNum ( cFieldName, nArea | cAlias ) + sx_FieldOffset ( cFieldName, nArea | cAlias ) + sx_FieldType ( cFieldName, nArea | cAlias ) + sx_FieldWidth ( cFieldName, nArea | cAlias ) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile1 := "TEST1.DBF" + LOCAL cFile2 := "TEST2.DBF" + LOCAL aStruct1 := { ; + { "MYCHAR" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYLOGIC" , "L", 1, 0 }, ; + { "MYNUM1" , "N", 8, 0 }, ; + { "MYNUM2" , "N", 7, 2 }, ; + { "MYMEMO" , "M", 10, 0 } } + LOCAL aStruct2 := { ; + { "YOURCHAR" , "C", 25, 0 }, ; + { "YOURDATE" , "D", 8, 0 }, ; + { "YOURLOGIC" , "L", 1, 0 }, ; + { "YOURNUM0" , "N", 10, 3 }, ; + { "YOURNUM1" , "N", 8, 0 }, ; + { "YOURNUM2" , "N", 9, 2 }, ; + { "YOURMEMO" , "M", 10, 0 } } + LOCAL MYFIELD, YOURFIELD, I, J + + SX_RDDSETDEFAULT( "SDEFOX" ) + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile1 STRUCT aStruct1 + USE cFile1 ALIAS MYALIAS EXCLUSIVE + + CREATE DBF cFile2 STRUCT aStruct2 + USE cFile2 ALIAS YOURALIAS EXCLUSIVE + + i := sx_FieldCount( "MYALIAS" ) + ? + ? 'sx_FieldCount( "MYALIAS" ) = ', padl( i, 4 ) + ? + for j := 1 TO i + myField := sx_FieldName ( j, "MYALIAS" ) + ? padr( myField, 10 ), ; + padl( sx_FieldNum ( myfield, "MYALIAS" ), 4 ), ; + padl( sx_FieldType ( myfield, "MYALIAS" ), 3 ), ; + padl( sx_FieldWidth ( myfield, "MYALIAS" ), 4 ), ; + padl( sx_FieldDecimals ( myfield, "MYALIAS" ), 4 ), ; + padl( sx_FieldOffset ( myfield, "MYALIAS" ), 4 ) + next + ? + i := sx_FieldCount( "YOURALIAS" ) + ? 'sx_FieldCount( "YOURALIAS" ) = ', padl( i, 2 ) + ? + for j := 1 TO i + myField := sx_FieldName ( j, "YOURALIAS" ) + ? padr( myField, 10 ), ; + padl( sx_FieldNum ( myfield, "YOURALIAS" ), 4 ), ; + padl( sx_FieldType ( myfield, "YOURALIAS" ), 3 ), ; + padl( sx_FieldWidth ( myfield, "YOURALIAS" ), 4 ), ; + padl( sx_FieldDecimals ( myfield, "YOURALIAS" ), 4 ), ; + padl( sx_FieldOffset ( myfield, "YOURALIAS" ), 4 ) + next + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test47.prg b/harbour/examples/hbapollo/tests/test47.prg new file mode 100644 index 0000000000..730b0bd9dc --- /dev/null +++ b/harbour/examples/hbapollo/tests/test47.prg @@ -0,0 +1,72 @@ +/* + * $Id$ + */ +/* + How to Encrypt/Decrypt DBF on The Fly +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile1 := "TEST1.DBF" + LOCAL aStruct1 := { ; + { "MYCHAR1" , "C", 15, 0 }, ; + { "MYCHAR2" , "C", 15, 0 }, ; + { "MYCHAR3" , "C", 15, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYLOGIC" , "L", 1, 0 }, ; + { "MYNUM1" , "N", 8, 0 }, ; + { "MYNUM2" , "N", 7, 2 }, ; + { "MYMEMO" , "M", 10, 0 } } + + CLS + SX_RDDSETDEFAULT( "SDEFOX" ) + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + ? + ? 'Creating DBF ...' + CREATE DBF cFile1 STRUCT aStruct1 + ? 'Opening File ...' + USE cFile1 ALIAS MYALIAS EXCLUSIVE + ? 'Setting Password ...' + SX_SETPASSWORD( "HARBOUR" ) // Set Password On Current Area - MAX 8 characters + ? 'Append Blank ...' + APPEND BLANK + ? 'Update Record ...' + REPLACE MYCHAR1 WITH "THIS IS MYCHAR1", ; + MYCHAR2 WITH "THIS IS MYCHAR2", ; + MYCHAR3 WITH "THIS IS MYCHAR3", ; + MYDATE WITH DATE(), ; + MYLOGIC WITH .T. , ; + MYNUM1 WITH 100, ; + MYNUM2 WITH 200.50, ; + MYMEMO WITH "Harbour Power!" + ? + ? 'Now BROWSE .. Press any key ...' + PAUSE + CLS + BROWSE + CLOSE ALL + CLS + ? + ? 'Browse with Wrong PASSWORD .. Press any key ...' + PAUSE + USE cFile1 ALIAS MYALIAS EXCLUSIVE + SX_SETPASSWORD( "XHARBOUR" ) // Wrong Password + CLS + BROWSE + CLOSE ALL + + CLS + ? + ? 'Browse with Correct PASSWORD .. Press any key ...' + PAUSE + USE cFile1 ALIAS MYALIAS EXCLUSIVE + SX_SETPASSWORD( "HARBOUR" ) // Correct Password + CLS + BROWSE + + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test48.prg b/harbour/examples/hbapollo/tests/test48.prg new file mode 100644 index 0000000000..7405dc132e --- /dev/null +++ b/harbour/examples/hbapollo/tests/test48.prg @@ -0,0 +1,72 @@ +/* + * $Id$ + */ +/* + How to DBFEncrypt/DBFDecrypt EXISTING DBF +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile1 := "test\test.dbf" + + ? + ? 'Opening TEST.DBF and Copy to NEWTEST.DBF ...' + USE cFile1 ALIAS MYALIAS EXCLUSIVE + sx_CopyFile( "NEWTEST.DBF" ) + USE "NEWTEST.DBF" ALIAS NEWTEST EXCLUSIVE + sx_Close( "MYALIAS" ) + ? 'Now BROWSE NEWTEST .. Press any key ...' + PAUSE + CLS + BROWSE + CLOSE ALL + CLS + + ? + ? 'Now ENCRYPTING NEWTEST.DBF' + ? 'And BROWSE with CORRECT PASSWORD ... Press any key ...' + PAUSE + USE "NEWTEST" ALIAS NEWTEST EXCLUSIVE + SX_SETPASSWORD( "HARBOUR" ) // Password + ? 'Working ...' + ? SX_DBFEncrypt() + CLS + BROWSE + CLOSE ALL + + CLS + ? + ? 'BROWSE with WRONG PASSWORD .. Press any key ...' + PAUSE + USE "NEWTEST" ALIAS MYALIAS EXCLUSIVE + SX_SETPASSWORD( "XHARBOUR" ) // Wrong Password + CLS + BROWSE + CLOSE ALL + + CLS + ? + ? 'BROWSE with CORRECT PASSWORD .. Press any key ...' + PAUSE + USE "NEWTEST" ALIAS MYALIAS EXCLUSIVE + SX_SETPASSWORD( "HARBOUR" ) // Wrong Password + CLS + BROWSE + CLOSE ALL + + CLS + ? + ? 'Now PHYSICALLY DECRYPTING NEWTEST.DBF' + ? 'Reset PASSWORD and BROWSE with NO PASSWORD.. Press any key ...' + PAUSE + USE "NEWTEST" ALIAS MYALIAS EXCLUSIVE + SX_SETPASSWORD( "HARBOUR" ) // Wrong Password + ? sx_DBFDecrypt() + SX_SETPASSWORD( "" ) // Reset Password + // No longer required because DBF is normal now + CLS + BROWSE + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test49.prg b/harbour/examples/hbapollo/tests/test49.prg new file mode 100644 index 0000000000..a3a24913ae --- /dev/null +++ b/harbour/examples/hbapollo/tests/test49.prg @@ -0,0 +1,97 @@ +/* + * $Id$ + */ +/* + Tests for Locking Mechanisms ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile1 := "test\test.dbf" + LOCAL aLockList := {} + + ? + ? 'Opening TEST.DBF and Copy to NEWTEST.DBF ...' + USE cFile1 ALIAS MYALIAS + + ? 'sx_Rlock( 10 ) =', sx_Rlock( 10 ) + ? 'sx_Rlock( 20 ) =', sx_Rlock( 20 ) + ? 'sx_Rlock( 30 ) =', sx_Rlock( 30 ) + + ? 'sx_Locked( 10 ) =', sx_Locked( 10 ) + ? 'sx_Locked( 20 ) =', sx_Locked( 20 ) + ? 'sx_Locked( 30 ) =', sx_Locked( 30 ) + + ? 'sx_LockCount() =', __trim( sx_LockCount() ) + aLockList := sx_DBRlockList() + ? 'aLockList := sx_DBRlockList() =>', __trim( len( aLockList ) ) + aeval( aLockList, { |e, i| outstd( "aLockList[" + __trim(i ) + "] = " + __trim(e ), hb_eol() ) } ) + + ? + ? 'sx_Unlock( 10 ) =', sx_Unlock( 10 ) + ? 'sx_Unlock( 20 ) =', sx_Unlock( 20 ) + ? 'sx_Unlock( 30 ) =', sx_Unlock( 30 ) + + ? 'sx_Locked( 10 ) =', sx_Locked( 10 ) + ? 'sx_Locked( 20 ) =', sx_Locked( 20 ) + ? 'sx_Locked( 30 ) =', sx_Locked( 30 ) + + ? 'sx_LockCount() =', __trim( sx_LockCount() ) + aLockList := sx_DBRlockList() + ? 'aLockList := sx_DBRlockList() =>', __trim( len( aLockList ) ) + aeval( aLockList, { |e, i| outstd( "aLockList[" + __trim(i ) + "] = " + __trim(e ), hb_eol() ) } ) + + ? + ? 'sx_Rlock( 10 ) =', sx_Rlock( 10 ) + ? 'sx_Rlock( 20 ) =', sx_Rlock( 20 ) + ? 'sx_Rlock( 30 ) =', sx_Rlock( 30 ) + + ? 'sx_UnLockAll( ) =', sx_UnLockAll() + + ? 'sx_Locked( 10 ) =', sx_Locked( 10 ) + ? 'sx_Locked( 20 ) =', sx_Locked( 20 ) + ? 'sx_Locked( 30 ) =', sx_Locked( 30 ) + + ? 'sx_LockCount() =', __trim( sx_LockCount() ) + aLockList := sx_DBRlockList() + ? 'aLockList := sx_DBRlockList() =>', __trim( len( aLockList ) ) + aeval( aLockList, { |e, i| outstd( "aLockList[" + __trim(i ) + "] = " + __trim(e ), hb_eol() ) } ) + + sx_UnLockAll() + + ? + ? 'sx_DBRlock( { 1, 2 ,3 ,50, 66 } ) =', sx_DBRlock( { 1, 2 , 3 , 50, 66 } ) + ? 'sx_LockCount() =', __trim( sx_LockCount() ) + aLockList := sx_DBRlockList() + ? 'aLockList := sx_DBRlockList() =>', __trim( len( aLockList ) ) + aeval( aLockList, { |e, i| outstd( "aLockList[" + __trim(i ) + "] = " + __trim(e ), hb_eol() ) } ) + + ? sx_LastRec() + + ? 'sx_UnLockAll( ) =', sx_UnLockAll() + ? + ? 'sx_Rlock( {3,6,8,9,23,55,78} ) =', sx_Rlock( { 3, 6, 8, 9, 23, 55, 78 } ) + ? 'sx_LockCount() =', __trim( sx_LockCount() ) + aLockList := sx_DBRlockList() + ? 'aLockList := sx_DBRlockList() =>', __trim( len( aLockList ) ) + aeval( aLockList, { |e, i| outstd( "aLockList[" + __trim(i ) + "] = " + __trim(e ), hb_eol() ) } ) + ? + ? 'sx_DbrUnLock( aLockList ) =', sx_DbrUnLock( aLockList ) + // ? 'sx_UnLock( aLockList ) =', sx_UnLock( aLockList ) + ? + ? 'sx_LockCount() =', __trim( sx_LockCount() ) + aLockList := sx_DBRlockList() + ? 'aLockList := sx_DBRlockList() =>', __trim( len( aLockList ) ) + aeval( aLockList, { |e, i| outstd( "aLockList[" + __trim(i ) + "] = " + __trim(e ), hb_eol() ) } ) + + ? 'sx_LastRec() =', sx_LastRec() + ? 'sx_RecCount() =', sx_RecCount() + + CLOSE ALL + +STATIC FUNCTION __trim( no ) + + RETURN alltrim( str( no ) ) diff --git a/harbour/examples/hbapollo/tests/test50.prg b/harbour/examples/hbapollo/tests/test50.prg new file mode 100644 index 0000000000..68dc982500 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test50.prg @@ -0,0 +1,122 @@ +/* + * $Id$ + */ +/* + Index thingies ... +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL nArea, i + LOCAL cFile := "test\test.dbf" + + SX_RDDSETDEFAULT( "SDEFOX" ) + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + SX_COMMITLEVEL( 2 ) + + IF file( "test\mytest.cdx" ) + ferase( "test\mytest.cdx" ) + ENDIF + + USE cFile ALIAS MYFILE EXCLUSIVE + + sx_IndexTag ( "mytest", "first", "first", 0, .F. , , ) + sx_IndexTag ( "mytest", "last", "last", 0, .F. , , ) + sx_IndexTag ( "mytest", "complete", "first+last", 0, .F. , , ) + + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_IndexType() =', __trim( sx_IndexType() ) + ? 'sx_TagName() =', sx_TagName() + ? 'sx_TagName(1) =', sx_TagName( 1 ) + ? 'sx_TagName(2) =', sx_TagName( 2 ) + ? 'sx_TagArea("first") =', __trim( sx_TagArea( "first" ) ) + ? 'sx_TagArea("last") =', __trim( sx_TagArea( "last" ) ) + ? 'sx_TagArea("dummy") =', __trim( sx_TagArea( "dummy" ) ) + ? 'sx_IndexKey() =', sx_IndexKey() + ? 'sx_IndexKeyField () =', sx_IndexKeyField () + ? 'sx_IndexName () =', sx_IndexName () + ? 'sx_IndexName (1) =', sx_IndexName ( 1 ) + ? 'sx_OrderPosSet (1) =', sx_OrderPosSet ( 1 ) + ? 'sx_OrderPosGet () =', __trim( sx_OrderPosGet() ) + ? 'sx_OrderRecNo () =', __trim( sx_OrderRecNo () ) + ? 'sx_IndexCondition() =', sx_IndexCondition () + ? + ? 'sx_SetOrder (2) =', __trim( sx_SetOrder( 2 ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? + ? 'sx_SetOrder (1) =', __trim( sx_SetOrder( 1 ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? + ? 'sx_SetOrder("last") =', __trim( sx_SetOrder( "last" ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? + ? 'sx_SetOrder("first") =', __trim( sx_SetOrder( "first" ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? + ? 'sx_TagCount () =', __trim( sx_TagCount() ) + ? + ? 'sx_OrdSetFocus (2) =', __trim( sx_OrdSetFocus( 2 ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? 'sx_IndexKey() =', sx_IndexKey() + ? 'sx_OrdKey() =', sx_OrdKey() + ? 'sx_IndexKeyField () =', sx_IndexKeyField () + ? + ? 'sx_OrdSetFocus (1) =', __trim( sx_OrdSetFocus( 1 ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? 'sx_IndexKey() =', sx_IndexKey() + ? 'sx_OrdKey() =', sx_OrdKey() + ? 'sx_IndexKeyField () =', sx_IndexKeyField () + ? + ? 'sx_OrdSetFocus("last") =', __trim( sx_OrdSetFocus( "last" ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? 'sx_IndexKey() =', sx_IndexKey() + ? 'sx_OrdKey() =', sx_OrdKey() + ? 'sx_IndexKeyField () =', sx_IndexKeyField () + ? + ? 'sx_OrdSetFocus("first") =', __trim( sx_OrdSetFocus( "first" ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? 'sx_IndexKey() =', sx_IndexKey() + ? 'sx_OrdKey() =', sx_OrdKey() + ? 'sx_IndexKeyField () =', sx_IndexKeyField () + ? + ? 'sx_OrdSetFocus("complete") =', __trim( sx_OrdSetFocus( "complete" ) ) + ? 'sx_IndexOrd() =', __trim( sx_IndexOrd() ) + ? 'sx_OrdNumber() =', __trim( sx_OrdNumber() ) + ? 'sx_IndexKey() =', sx_IndexKey() + ? 'sx_OrdKey() =', sx_OrdKey() + ? 'sx_IndexKeyField () =', sx_IndexKeyField () + + ? + ? 'sx_SetAutoOpen() =', sx_SetAutoOpen() + ? 'sx_SetAutoOpen(.F.) =', sx_SetAutoOpen( .F. ) + ? 'sx_SetAutoOpen() =', sx_SetAutoOpen() + ? + + ? 'sx_SetAutoOpen(.T.) =', sx_SetAutoOpen( .T. ) + ? 'sx_SetAutoOpen() =', sx_SetAutoOpen() + + ? + ? 'sx_TagDelete("complete") =', sx_TagDelete( "complete" ) + ? 'sx_TagCount() =', __trim( sx_TagCount() ) + + ? 'sx_TagDelete("first") =', sx_TagDelete( "first" ) + ? 'sx_TagCount() =', __trim( sx_TagCount() ) + + ? 'sx_TagDelete("last") =', sx_TagDelete( "last" ) + ? 'sx_TagCount() =', __trim( sx_TagCount() ) + +FUNCTION __trim( n ) + + RETURN ltrim( str( n ) ) diff --git a/harbour/examples/hbapollo/tests/test51.prg b/harbour/examples/hbapollo/tests/test51.prg new file mode 100644 index 0000000000..0351f2e9d5 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test51.prg @@ -0,0 +1,108 @@ +/* + * $Id$ + */ +/* + Testing Sx_CommitLevel() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN( nLevel ) + + IF nLevel == NIL + nLevel := 2 + ELSE + nLevel := val( nLevel ) + IF nLevel < 0 .OR. nLevel > 2 + ? 'Usage : TEST51 , where nLevel: 0, 1 or 2' + RETURN + ENDIF + ENDIF + + ? + ? 'Set Commit Level To ' + ltrim( str( nLevel ) ), sx_CommitLevel( nLevel ) + ? + ? 'Appending 10,000 Records Using Commit Level ' + ltrim( str( nLevel ) ) + ? 'Working ...' + ? + Test_1() + ? + Test_2() + ? + GOTOP + CLS + ? + ? + ? + ? + ? 'BROWSE ... Press any key ...' + PAUSE + CLS + BROWSE + CLOSE ALL + CLS + +PROC Test_2( nCommit ) + + LOCAL n + + sx_Gotop() + + ? 'Now On RecNo =>', ltrim( str( sx_RecNo() ) ), "Press any key ..." + PAUSE + + n := seconds() + WHILE !sx_Eof() + sx_Skip() + ENDDO + + ? + ? "Skipping ..." + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now On RecNo =>', ltrim( str( sx_RecNo() ) ) + ? + +FUNCTION Test_1( nCommit ) + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 2 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL cApplication + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENTX + USE cFile ALIAS MYALIAS RDD SDENTX VAR nArea EXCLUSIVE + APPEND BLANK 10000 + GO TOP + ? "----------------------------------" + ? "Polupating DBF with 10,000 Records" + ? "----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Commit Level : ", sx_GetCommitLevel( nArea ) + ? "Start : ", n + j := 0 + WHILE !sx_Eof() + cPad := PADL( ++ j, 5, "0" ) + sx_Replace( "MYCHAR", "NAME_" + cPad ) + sx_Replace( "MYDATE", date() + j ) + sx_Replace( "MYNUMBER1", j * 10 ) + sx_Replace( "MYNUMBER2", j * 20 / 3 ) + sx_skip( 1 ) + ENDDO + + ? "End : ", seconds() + ? "Time : ", seconds() - n + + RETURN NIL diff --git a/harbour/examples/hbapollo/tests/test51h.prg b/harbour/examples/hbapollo/tests/test51h.prg new file mode 100644 index 0000000000..d5d2454b61 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test51h.prg @@ -0,0 +1,77 @@ +/* + * $Id$ + */ +/* + For comparison with Harbour/xHarbour + Using Harbour RDD .... +*/ + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 2 } } + LOCAL cApplication + + DBCREATE( ( CFILE ), ASTRUCT ) + USE SIXTEST ALIAS MYALIAS EXCLUSIVE + TEST_1() + TEST_2() + + //--- + +PROC TEST_2() + + LOCAL n + + DBGotop() + + ? 'Now On RecNo =>', ltrim( str( RecNo() ) ), "Press any key ..." + INKEY( 0 ) + + n := seconds() + WHILE !Eof() + DBSkip() + ENDDO + + ? + ? "Skipping ..." + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now On RecNo =>', ltrim( str( RecNo() ) ) + ? + ? 'BROWSE ... Press any key ..' + dbgotop() + Browse() + + //--- + +PROC TEST_1() + + LOCAL j, n := seconds(), nArea, cPad + + ? "----------------------------------" + ? "Polupating DBF with 10,000 Records" + ? "----------------------------------" + ? "Start : ", n + + FOR j := 1 TO 10000 + APPEND BLANK + cPad := PADL( j, 5, "0" ) + MYALIAS -> MYCHAR := "NAME_" + cPad + MYALIAS -> MYDATE := date() + j + MYALIAS -> MYNUMBER1 := j * 10 + MYALIAS -> MYNUMBER2 := j * 20 / 3 + NEXT + + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + + RETURN diff --git a/harbour/examples/hbapollo/tests/test52.prg b/harbour/examples/hbapollo/tests/test52.prg new file mode 100644 index 0000000000..3b2b7239a8 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test52.prg @@ -0,0 +1,105 @@ +/* + * $Id$ + */ +/* + Testing sx_ReplaceEx( aArray ) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN( nLevel ) + + IF nLevel == NIL + nLevel := 2 + ELSE + nLevel := val( nLevel ) + IF nLevel < 0 .OR. nLevel > 2 + ? 'Usage : TEST51 , where nLevel: 0, 1 or 2' + RETURN + ENDIF + ENDIF + + ? + ? 'Set Commit Level To ' + ltrim( str( nLevel ) ), sx_CommitLevel( nLevel ) + ? + ? 'Appending 10,000 Records Using Commit Level ' + ltrim( str( nLevel ) ) + ? 'Working ...' + ? + Test_1() + ? + ? + ? 'BROWSE ... Press any key ...' + PAUSE + CLS + BROWSE + CLOSE ALL + CLS + +PROC Test_2( nCommit ) + + LOCAL n + + sx_Gotop() + + ? 'Now On RecNo =>', ltrim( str( sx_RecNo() ) ), "Press any key ..." + PAUSE + + n := seconds() + WHILE !sx_Eof() + sx_Skip() + ENDDO + + ? + ? "Skipping ..." + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now On RecNo =>', ltrim( str( sx_RecNo() ) ) + ? + +FUNCTION Test_1( nCommit ) + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 2 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL cApplication + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENTX + USE cFile ALIAS MYALIAS RDD SDENTX VAR nArea EXCLUSIVE + + ? "----------------------------------" + ? "Polupating DBF with 10,000 Records" + ? "----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Commit Level : " , sx_GetCommitLevel( "MYALIAS" ) + ? "Start : ", n + + APPEND BLANK 10000 + GO TOP + j := 0 + + WHILE !sx_Eof() + cPad := PADL( ++ j, 5, "0" ) + sx_ReplaceEx( { ; + { "MYCHAR", "NAME_" + cPad }, ; + { "MYDATE", date() + j }, ; + { "MYNUMBER1", j * 10 }, ; + { "MYNUMBER2", j * 10 / 20 } } ) + sx_skip( 1 ) + ENDDO + + ? "End : ", seconds() + ? "Time : ", seconds() - n + + RETURN NIL diff --git a/harbour/examples/hbapollo/tests/test53.prg b/harbour/examples/hbapollo/tests/test53.prg new file mode 100644 index 0000000000..0d41e075b3 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test53.prg @@ -0,0 +1,111 @@ +/* + * $Id$ + */ +/* + Testing sx_ReplaceEx( aArray ) .. sx_dbEval() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN( nLevel ) + + IF nLevel == NIL + nLevel := 2 + ELSE + nLevel := val( nLevel ) + IF nLevel < 0 .OR. nLevel > 2 + ? 'Usage : TEST51 , where nLevel: 0, 1 or 2' + RETURN + ENDIF + ENDIF + + ? + ? 'Set Commit Level To ' + ltrim( str( nLevel ) ), sx_CommitLevel( nLevel ) + ? + ? 'Appending 10,000 Records Using Commit Level ' + ltrim( str( nLevel ) ) + ? 'Working sx_dbEval() ...' + ? + Test_1() + ? + ? 'BROWSE ... Press any key ...' + PAUSE + BROWSE + CLOSE ALL + CLS + +PROC Test_2( nCommit ) + + LOCAL n + + sx_Gotop() + + ? 'Now On RecNo =>', ltrim( str( sx_RecNo() ) ), "Press any key ..." + PAUSE + + n := seconds() + WHILE !sx_Eof() + sx_Skip() + ENDDO + + ? + ? "Skipping ..." + ? + ? "Start : ", n + ? "End : ", seconds() + ? "Time : ", seconds() - n + ? + ? 'Now On RecNo =>', ltrim( str( sx_RecNo() ) ) + ? + +FUNCTION Test_1( nCommit ) + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR" , "C", 10, 0 }, ; + { "MYDATE" , "D", 8, 0 }, ; + { "MYNUMBER1" , "N", 8, 0 }, ; + { "MYNUMBER2" , "N", 8, 2 } } + LOCAL j, n := seconds(), nArea, cPad + LOCAL cApplication + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + CREATE DBF cFile STRUCT aStruct RDD SDENTX + USE cFile ALIAS MYALIAS RDD SDENTX VAR nArea EXCLUSIVE + + ? "----------------------------------" + ? "Polupating DBF with 10,000 Records" + ? "----------------------------------" + ? "Area : ", nArea + ? "RDD : " + sx_rddDriver( nArea ) + ? "Start : ", n + + APPEND BLANK 10000 + j := 0 + sx_DbEval( ; + { || cPad := PADL( ++ j, 5, "0" ) , ; + sx_ReplaceEx( { ; + { "MYCHAR", "NAME_" + cPad } , ; + { "MYDATE", date() + j } , ; + { "MYNUMBER1", j * 10 } , ; + { "MYNUMBER2", j * 10 / 20 } } ); + } ) + +/* +while !sx_Eof() + cPad := PADL( ++j, 5, "0") + sx_ReplaceEx({; + {"MYCHAR", "NAME_" + cPad },; + {"MYDATE", date() + j },; + {"MYNUMBER1", j * 10 },; + {"MYNUMBER2", j * 10 / 20 }} ) + sx_skip(1) +enddo +*/ + + ? "End : ", seconds() + ? "Time : ", seconds() - n + + RETURN NIL diff --git a/harbour/examples/hbapollo/tests/test54.prg b/harbour/examples/hbapollo/tests/test54.prg new file mode 100644 index 0000000000..f579d42e1c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test54.prg @@ -0,0 +1,68 @@ +/* + * $Id$ + */ +/* + sx_GetValueEx( nArea | cArea ) + sx_PutValueEx( aValues, nArea | cArea ) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR", "C", 25, 0 }, ; + { "MYDATE", "D", 8, 0 }, ; + { "MYNUM0", "N", 10, 0 }, ; + { "MYNUM2", "N", 10, 2 }, ; + { "MYNUM3", "N", 10, 3 }, ; + { "MYMEMO", "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea + LOCAL aGet + + // SET CENTURY ON + // Automatically ON woth the following date format + SET EPOCH 1950 + SET DATE "DD-MM-YYYY" + + // Set Trim On to RTRIM String Value of FieldGets + // Default is OFF + SET TRIM ON + + CREATE DBF cFile STRUCT aStruct RDD SDENSX + USE cFile ALIAS MYALIAS RDD SDENSX VAR nArea EXCLUSIVE + APPEND BLANK + + REPLACE MYCHAR WITH "Harbour Power" + REPLACE MYDATE WITH DATE() + REPLACE MYNUM0 WITH 10000 + REPLACE MYNUM2 WITH 250.25 + REPLACE MYNUM3 WITH 10000.123 + REPLACE MYLOGIC WITH .T. + REPLACE MYMEMO WITH "This is some text but you can use MEMOREAD()" + + COMMIT + + aGet := sx_GetValueEx() + ? + ? 'aGet := sx_GetValueEx()' + ? + ? 'Len( aGet ) =', padl( Len( aGet ), 2 ) + ? + FOR J := 1 TO LEN( AGET ) + ? "aGet[" + ltrim( str( j ) ) + "] =", aGet[j], "[" + ValType( aGet[j] ) + "]" + NEXT + ? + ? 'sx_LastRec() =', padl( sx_LastRec(), 2 ) + ? 'Append Blank and sx_PutValueEx( aGet ) ... Press any key ...' + PAUSE + APPEND BLANK + sx_putvalueex( aGet ) + ? + ? 'sx_LastRec() =', padl( sx_LastRec(), 2 ), "... Press any key ..." + PAUSE + + BROWSE diff --git a/harbour/examples/hbapollo/tests/test55.prg b/harbour/examples/hbapollo/tests/test55.prg new file mode 100644 index 0000000000..c1d702bf22 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test55.prg @@ -0,0 +1,83 @@ +/* + * $Id$ + */ +/* + sx_IndexClose() + This function is only valid for RDD SDENSXDBT + After sx_IndexClose(), workarea is into 0 index, must sx_setOrder() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "sixtest.dbf" + LOCAL aStruct := { ; + { "MYCHAR", "C", 25, 0 }, ; + { "MYDATE", "D", 8, 0 }, ; + { "MYNUM0", "N", 10, 0 }, ; + { "MYNUM2", "N", 10, 2 }, ; + { "MYNUM3", "N", 10, 3 }, ; + { "MYMEMO", "M", 10, 0 }, ; + { "MYLOGIC", "L", 1, 0 } } + LOCAL j, n := seconds(), nArea + LOCAL aGet, nTagCount + + // SET ERRORLEVEL 0 + SET RDD SDENSXDBT + SET EPOCH 1950 + SET DATE "DD-MM-YYYY" + SET TRIM ON + + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS VAR nArea EXCLUSIVE + APPEND BLANK + + REPLACE MYCHAR WITH "Harbour Power" + REPLACE MYDATE WITH DATE() + REPLACE MYNUM0 WITH 10000 + REPLACE MYNUM2 WITH 250.25 + REPLACE MYNUM3 WITH 10000.123 + REPLACE MYLOGIC WITH .T. + REPLACE MYMEMO WITH "This is some text but you can use MEMOREAD()" + + COMMIT + + INDEX ON MYCHAR TO "TESTNTX" + ? + ? '---------------------------------------------' + ? 'INDEX ON MYCHAR TO "TESTNTX"' + ? 'Sx_SetOrder(1) =', padl( Sx_SetOrder( 1 ), 1 ) + ? 'sx_IndexOrd() =', padl( sx_IndexOrd(), 1 ) + ? 'Sx_IndexKey() =', Sx_IndexKey() + ? 'Sx_IndexKeyField() =', Sx_IndexKeyField() + ? '---------------------------------------------' + INDEX ON DTOS( MYDATE ) TO "TESTNTX1" + ? 'INDEX ON DTOS(MYDATE) TO "TESTNTX1"' + ? 'Sx_IndexKey() =', Sx_IndexKey() + ? 'Sx_IndexKeyField() =', Sx_IndexKeyField() + ? '---------------------------------------------' + ? 'Sx_Tagcount() =', padl( nTagCount := Sx_Tagcount(), 1 ) + FOR j := 1 TO nTagCount + ? 'sx_TagName(' + ltrim( str( j ) ) + ') =', sx_TagName( j ) + ? 'sx_IndexName(' + ltrim( str( j ) ) + ') =', sx_IndexName( j ) + NEXT + ? '---------------------------------------------' + ? 'sx_IndexOrd() =', padl( sx_IndexOrd(), 1 ) + ? '---------------------------------------------' + ? 'sx_IndexClose() =', sx_IndexClose() + ? 'Sx_Tagcount() =', padl( nTagCount := Sx_Tagcount(), 1 ) + ? 'Sx_SetOrder(1) =', padl( Sx_SetOrder( 1 ), 1 ) + FOR j := 1 TO nTagCount + ? 'sx_TagName(' + ltrim( str( j ) ) + ') =', sx_TagName( j ) + ? 'sx_IndexName(' + ltrim( str( j ) ) + ') =', sx_IndexName( j ) + NEXT + ? 'sx_IndexOrd() =', padl( sx_IndexOrd(), 1 ) + ? 'Sx_IndexKey() =', Sx_IndexKey() + ? 'Sx_IndexKeyField() =', Sx_IndexKeyField() + ? '---------------------------------------------' + ? 'sx_IndexClose() =', sx_IndexClose() + ? 'Sx_Tagcount() =', padl( nTagCount := Sx_Tagcount(), 1 ) + // Should be runtime error here because no index is open + ? 'Sx_SetOrder(1) =', padl( Sx_SetOrder( 1 ), 1 ) diff --git a/harbour/examples/hbapollo/tests/test56.prg b/harbour/examples/hbapollo/tests/test56.prg new file mode 100644 index 0000000000..6655f9220b --- /dev/null +++ b/harbour/examples/hbapollo/tests/test56.prg @@ -0,0 +1,80 @@ +/* + * $Id$ + */ +/* + sx_TagInfo() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "FIRST", "C", 25, 0 }, ; + { "LAST", "C", 25, 0 }, ; + { "HIREDATE", "D", 8, 0 } } + LOCAL j, n := seconds(), nArea, i + LOCAL aGet, nTagCount, aTagInfo + + SET RDD SDEFOX + SET EPOCH 1950 + SET DATE "DD-MM-YYYY" + SET TRIM ON + + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS VAR nArea EXCLUSIVE + APPEND BLANK + + sx_IndexTag ( "MYTEST", "FIRST_TAG", "FIRST", 0, .F. , "LEFT(FIRST,1)='A'" ) + sx_IndexTag ( "MYTEST", "LAST_TAG", "LAST", 0, .T. , "RIGHT(LAST,1)='Z'" ) + sx_IndexTag ( "MYTEST", "DATE_TAG", "DTOS(HIREDATE)", 0, .T. , ) + ? + ? 'sx_TagCount() =', sx_TagCount() + ? + ? 'aTagInfo := TagInfo()' + aTagInfo := TagInfo() + for j := 1 TO len( aTagInfo ) + ? 'TagName :', aTagInfo[ j, 1 ] + ? 'Index Expression :', aTagInfo[ j, 2 ] + ? 'Index Condition :', aTagInfo[ j, 3 ] + ? 'Index Type :', aTagInfo[ j, 4 ] + ? 'Descending :', aTagInfo[ j, 5 ] + ? 'RYO :', aTagInfo[ j, 6 ] + ? 'Index File Name :', aTagInfo[ j, 7 ] + ? 'Index Key Field :', aTagInfo[ j, 8 ] + ? + next + + ? 'aTagInfo := sx_TagInfo(2)' + aTagInfo := sx_TagInfo( 2 ) + for j := 1 TO len( aTagInfo ) + ? 'TagName :', aTagInfo[ j, 1 ] + ? 'Index Expression :', aTagInfo[ j, 2 ] + ? 'Index Condition :', aTagInfo[ j, 3 ] + ? 'Index Type :', aTagInfo[ j, 4 ] + ? 'Descending :', aTagInfo[ j, 5 ] + ? 'RYO :', aTagInfo[ j, 6 ] + ? 'Index File Name :', aTagInfo[ j, 7 ] + ? 'Index Key Field :', aTagInfo[ j, 8 ] + ? + next + + ? 'aTagInfo := sx_TagInfo( "FIRST_TAG" )' + aTagInfo := sx_TagInfo( "FIRST_TAG" ) + for j := 1 TO len( aTagInfo ) + ? 'TagName :', aTagInfo[ j, 1 ] + ? 'Index Expression :', aTagInfo[ j, 2 ] + ? 'Index Condition :', aTagInfo[ j, 3 ] + ? 'Index Type :', aTagInfo[ j, 4 ] + ? 'Descending :', aTagInfo[ j, 5 ] + ? 'RYO :', aTagInfo[ j, 6 ] + ? 'Index File Name :', aTagInfo[ j, 7 ] + ? 'Index Key Field :', aTagInfo[ j, 8 ] + ? + next + +FUNCTION TagInfo( nTag ) + + RETURN sx_TagInfo( nTag ) diff --git a/harbour/examples/hbapollo/tests/test57.prg b/harbour/examples/hbapollo/tests/test57.prg new file mode 100644 index 0000000000..326bce6d31 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test57.prg @@ -0,0 +1,81 @@ +/* + * $Id$ + */ +/* + sx_TagInfo() on NTX +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "FIRST", "C", 25, 0 }, ; + { "LAST", "C", 25, 0 }, ; + { "HIREDATE", "D", 8, 0 } } + LOCAL j, n := seconds(), nArea, i + LOCAL aGet, nTagCount, aTagInfo + + SET RDD SDENTX + SET EPOCH 1950 + SET DATE "DD-MM-YYYY" + SET TRIM ON + + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS VAR nArea EXCLUSIVE + APPEND BLANK + + sx_IndexTag ( "MYTEST_1", "FIRST_TAG", "FIRST", 0, .F. , "LEFT(FIRST,1)='A'" ) + sx_IndexTag ( "MYTEST_2", "LAST_TAG", "LAST", 0, .T. , "RIGHT(LAST,1)='Z'" ) + sx_IndexTag ( "MYTEST_3", "DATE_TAG", "DTOS(HIREDATE)", 0, .T. , ) + ? + ? 'sx_TagCount() =', sx_TagCount() + ? + ? 'aTagInfo := sx_TagInfo()' + aTagInfo := sx_TagInfo() + for j := 1 TO len( aTagInfo ) + ? 'TagName :', aTagInfo[ j, 1 ] + ? 'Index Expression :', aTagInfo[ j, 2 ] + ? 'Index Condition :', aTagInfo[ j, 3 ] + ? 'Index Type :', aTagInfo[ j, 4 ] + ? 'Descending :', aTagInfo[ j, 5 ] + ? 'RYO :', aTagInfo[ j, 6 ] + ? 'Index File Name :', aTagInfo[ j, 7 ] + ? 'Index Key Field :', aTagInfo[ j, 8 ] + ? + next + + ? 'aTagInfo := sx_TagInfo(2)' + aTagInfo := sx_TagInfo( 2 ) + for j := 1 TO len( aTagInfo ) + ? 'TagName :', aTagInfo[ j, 1 ] + ? 'Index Expression :', aTagInfo[ j, 2 ] + ? 'Index Condition :', aTagInfo[ j, 3 ] + ? 'Index Type :', aTagInfo[ j, 4 ] + ? 'Descending :', aTagInfo[ j, 5 ] + ? 'RYO :', aTagInfo[ j, 6 ] + ? 'Index File Name :', aTagInfo[ j, 7 ] + ? 'Index Key Field :', aTagInfo[ j, 8 ] + ? + next + + // !!! WILL NOT WORK IN NON-COMPOUND INDEX !!! + ? 'aTagInfo := sx_TagInfo( "FIRST_TAG" )' + aTagInfo := sx_TagInfo( "FIRST_TAG" ) + for j := 1 TO len( aTagInfo ) + ? 'TagName :', aTagInfo[ j, 1 ] + ? 'Index Expression :', aTagInfo[ j, 2 ] + ? 'Index Condition :', aTagInfo[ j, 3 ] + ? 'Index Type :', aTagInfo[ j, 4 ] + ? 'Descending :', aTagInfo[ j, 5 ] + ? 'RYO :', aTagInfo[ j, 6 ] + ? 'Index File Name :', aTagInfo[ j, 7 ] + ? 'Index Key Field :', aTagInfo[ j, 8 ] + ? + next + +FUNCTION TagInfo( nTag ) + + RETURN sx_TagInfo( nTag ) diff --git a/harbour/examples/hbapollo/tests/test58.prg b/harbour/examples/hbapollo/tests/test58.prg new file mode 100644 index 0000000000..ddcbfc8f96 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test58.prg @@ -0,0 +1,52 @@ +/* + * $Id$ + */ +/* + sx_GetRecord() + sx_GetRecordEx() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cFile := "c:\windows\temp\sixtest.dbf" + LOCAL aStruct := { ; + { "FIRST", "C", 25, 0 }, ; + { "LAST", "C", 25, 0 }, ; + { "HIREDATE", "D", 8, 0 } } + LOCAL j, n := seconds(), nArea, i + LOCAL aGet, nTagCount, aTagInfo + LOCAL cGetRecord + + SET RDD SDENTX + SET EPOCH 1950 + SET DATE "DD-MM-YYYY" + SET TRIM ON + + CREATE DBF cFile STRUCT aStruct + USE cFile ALIAS MYALIAS VAR nArea EXCLUSIVE + APPEND BLANK + + REPLACE FIRST WITH "First_Name" + REPLACE LAST WITH "Last_LastName" + REPLACE HIREDATE WITH Date() + sx_delete() + cGetRecord := sx_GetRecord() + ? + ? '-----------------------------------' + ? 'sx_GetRecord() and sx_GetRecordEx()' + ? '-----------------------------------' + ? 'cGetRecord := sx_GetRecord()' + ? 'cGetRecord =', cGetRecord + ? 'Vaptype(cGetRecord) =', ValType( cGetRecord ) + + ? + ? 'cGetRecord := sx_GetRecordEx()' + cGetRecord := sx_GetRecordEx() + ? 'Valtype(cGetRecord) =', ValType( cGetRecord ) + ? 'len(cGetRecord) =', padl( len( cGetRecord ), 1 ) + for i := 1 TO len( cGetRecord ) + ? "cGetRecord[" + padl( i, 1 ) + "] =", cGetRecord[i], "[" + ValType( cGetRecord[i] ) + "]" + next diff --git a/harbour/examples/hbapollo/tests/test59.prg b/harbour/examples/hbapollo/tests/test59.prg new file mode 100644 index 0000000000..3a765d2c16 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test59.prg @@ -0,0 +1,52 @@ +/* + * $Id$ + */ +/* + sx_AppendFrom() + DEMO APPEND FROM DBF FILE + + Option for VIA Clause: + SDENTX 1 CA-Clipper DBT/NTX driver + SDEFOX 2 FoxPro FPT/IDX/CDX driver + SDENSX 3 Six SMT/NSX driver + SDENSX_DBT 4 CA-Clipper DBT with NSX indexes + COMMA_DELIM 21 Comma-Delimited Text File + SDF_FILE 22 Space-Delimited (SDF) Text File + TAB_DELIM 23 Tab-Delimited Text File + OEMNTX 31 Source SDENTX file translated from OEM + OEMFOX 32 Source SDEFOX file translated from OEM + OEMNSX 33 Source SDENSX file translated from OEM +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cSource := "test\test.dbf" + LOCAL n := seconds() + + ? + ? 'USE cSource' + ? 'COPY STRUCTURE TO sixtest' + ? 'CLOSE DATABASE' + ? 'USE "sixtest"' + ? 'APPEND FROM cSource' + + USE cSource + COPY STRUCTURE TO sixtest.dbf + CLOSE DATABASE + USE "sixtest" + APPEND FROM cSource + // APPEND FROM cSource FOR STATE='IA' VIA SDENSX + ? + ? "Start =", n + ? "Finished =", seconds() + ? "Time =", seconds() - n + ? + ? "BROWSE ... Press any key ..." + PAUSE + CLS + BROWSE + CLOSE ALL + CLS diff --git a/harbour/examples/hbapollo/tests/test60.prg b/harbour/examples/hbapollo/tests/test60.prg new file mode 100644 index 0000000000..0e7bc6c98d --- /dev/null +++ b/harbour/examples/hbapollo/tests/test60.prg @@ -0,0 +1,66 @@ +/* + * $Id$ + */ +/* + sx_AppendFrom() + DEMO APPEND FROM TEXT FILE DELIMITED WITH COMMA + + Option for VIA Clause: + SDENTX 1 CA-Clipper DBT/NTX driver + SDEFOX 2 FoxPro FPT/IDX/CDX driver + SDENSX 3 Six SMT/NSX driver + SDENSX_DBT 4 CA-Clipper DBT with NSX indexes + COMMA_DELIM 21 Comma-Delimited Text File + SDF_FILE 22 Space-Delimited (SDF) Text File + TAB_DELIM 23 Tab-Delimited Text File + OEMNTX 31 Source SDENTX file translated from OEM + OEMFOX 32 Source SDEFOX file translated from OEM + OEMNSX 33 Source SDENSX file translated from OEM +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cSource := "sixtest.dbf" + LOCAL n, nHandle + LOCAL aStruct := { { "_FIRST","C",20,0 }, { "_LAST","C",20,0 }, ; + { "_SALARY", "N", 12, 0 } } + LOCAL i, cPad + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + // Making comma delimited dummy file to append to DBF file + ? + ? 'Creating Text File ...' + nHandle := FCreate( "testing.txt" ) + FOR i := 1 TO 100 + cPad := padl( i, 5, "0" ) + FWrite( nHAndle, "First_" + cPad + "," + "Last_" + cPad + "," + str( i * 2 ) + CHR( 13 ) + CHR( 10 ) ) + NEXT + FClose( nHandle ) + + ? + ? 'USE cSource' + ? 'COPY STRUCTURE TO sixtest' + ? 'CLOSE DATABASE' + ? 'USE "sixtest"' + ? 'APPEND FROM cSource' + + CREATE TABLE cSource STRUCT aStruct + USE CsOURCE + n := seconds() + APPEND FROM "testing.txt" VIA "COMMA_DELIM" + ? + ? "Start =", n + ? "Finished =", seconds() + ? "Time =", seconds() - n + ? + ? "BROWSE ... Press any key ..." + PAUSE + CLS + BROWSE + CLOSE ALL + CLS diff --git a/harbour/examples/hbapollo/tests/test61.prg b/harbour/examples/hbapollo/tests/test61.prg new file mode 100644 index 0000000000..4a2b34301d --- /dev/null +++ b/harbour/examples/hbapollo/tests/test61.prg @@ -0,0 +1,66 @@ +/* + * $Id$ + */ +/* + sx_AppendFrom() + DEMO APPEND FROM TEXT FILE DELIMITED WITH TAB + + Option for VIA Clause: + SDENTX 1 CA-Clipper DBT/NTX driver + SDEFOX 2 FoxPro FPT/IDX/CDX driver + SDENSX 3 Six SMT/NSX driver + SDENSX_DBT 4 CA-Clipper DBT with NSX indexes + COMMA_DELIM 21 Comma-Delimited Text File + SDF_FILE 22 Space-Delimited (SDF) Text File + TAB_DELIM 23 Tab-Delimited Text File + OEMNTX 31 Source SDENTX file translated from OEM + OEMFOX 32 Source SDEFOX file translated from OEM + OEMNSX 33 Source SDENSX file translated from OEM +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cSource := "sixtest.dbf" + LOCAL n, nHandle + LOCAL aStruct := { { "_FIRST","C",20,0 }, { "_LAST","C",20,0 }, ; + { "_SALARY", "N", 12, 0 } } + LOCAL i, cPad + + SET EPOCH 1950 + SET DATE "DD/MM/YYYY" + + // Making comma delimited dummy file to append to DBF file + ? + ? 'Creating Text File ...' + nHandle := FCreate( "testing.txt" ) + FOR i := 1 TO 1000 + cPad := padl( i, 5, "0" ) + FWrite( nHAndle, "First_" + cPad + CHR( 9 ) + "Last_" + cPad + CHR( 9 ) + str( i * 2 ) + CHR( 13 ) + CHR( 10 ) ) + NEXT + FClose( nHandle ) + + ? + ? 'USE cSource' + ? 'COPY STRUCTURE TO sixtest' + ? 'CLOSE DATABASE' + ? 'USE "sixtest"' + ? 'APPEND FROM cSource' + + CREATE TABLE cSource STRUCT aStruct + USE "sixtest" + n := seconds() + APPEND FROM "testing.txt" VIA "TAB_DELIM" + ? + ? "Start =", n + ? "Finished =", seconds() + ? "Time =", seconds() - n + ? + ? "BROWSE ... Press any key ..." + PAUSE + CLS + BROWSE + CLOSE ALL + CLS diff --git a/harbour/examples/hbapollo/tests/test62.prg b/harbour/examples/hbapollo/tests/test62.prg new file mode 100644 index 0000000000..624947408d --- /dev/null +++ b/harbour/examples/hbapollo/tests/test62.prg @@ -0,0 +1,47 @@ +/* + * $Id$ + */ +/* + sx_DbInfo() Without Arguments +*/ + +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aInfo, i, j + LOCAL s, t + LOCAL aStruct1 := { { "PART_NO","C",10,0 }, { "PRICE","N",10,2 }, { "NOTES","M",10,0 } } + LOCAL aStruct2 := { { "CUST_NAME","C",20,0 }, { "AMOUNT","N",12,0 }, { "DUEDATE","D",8,0 }, { "PAID","L",1,0 } } + + SET RDD SDEFOX + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 + CREATE TABLE "TEST2" STRUCT aStruct2 + USE "test1" ALIAS ONE readonly + USE "test2" ALIAS two exclusive + + aInfo := sx_DbInfo() + ? 'SX_DBINFO() ....' + ? + FOR j := 1 TO LEN( aInfo ) + ? REPL( "-", 76 ) + ? "Work Area :", aInfo[j][1] + ? "DBF Name :", aInfo[j][2] + ? "Alias :", aInfo[j][3] + ? "Shared :", aInfo[j][4] + ? "Readonly :", aInfo[j][5] + ? "RDE Type :", aInfo[j][6] + ? "Open Mode :", aInfo[j][7] + ? "RDD :", aInfo[j][8] + ? "CommitLevel :", aInfo[j][9] + ? "RecSize :", aInfo[j][10] + ? "No of Fields:", aInfo[j][11] + ? "Field Properties:" + FOR s := 1 TO LEN ( aInfo[j][12] ) + ? " ", padr( aInfo[j][12][s][1], 20 ), aInfo[j][12][s][2], aInfo[j][12][s][3], aInfo[j][12][s][4] + NEXT + NEXT + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test63.prg b/harbour/examples/hbapollo/tests/test63.prg new file mode 100644 index 0000000000..e23df4fb7e --- /dev/null +++ b/harbour/examples/hbapollo/tests/test63.prg @@ -0,0 +1,65 @@ +/* + * $Id$ + */ +/* + sx_DbInfo() With Argument +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aInfo, i, j + LOCAL s, t + LOCAL aStruct1 := { { "PART_NO","C",10,0 }, { "PRICE","N",10,2 }, { "NOTES","M",10,0 } } + LOCAL aStruct2 := { { "CUST_NAME","C",20,0 }, { "AMOUNT","N",12,0 }, { "DUEDATE","D",8,0 }, { "PAID","L",1,0 } } + + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDEFOX + CREATE TABLE "TEST2" STRUCT aStruct2 RDD SDENSX + USE "test1" ALIAS ONE READONLY RDD SDEFOX + USE "test2" ALIAS two EXCLUSIVE RDD SDENSX + + aInfo := sx_DbInfo( "ONE" ) + ? 'SX_DBINFO( "ONE" ) ....' + ? REPL( "-", 76 ) + FOR s := 1 TO LEN ( aInfo ) + ? "Work Area :", aInfo[s][1] + ? "DBF Name :", aInfo[s][2] + ? "Alias :", aInfo[s][3] + ? "Shared :", aInfo[s][4] + ? "Readonly :", aInfo[s][5] + ? "RDE Type :", aInfo[s][6] + ? "Open Mode :", aInfo[s][7] + ? "RDD :", aInfo[s][8] + ? "CommitLevel :", aInfo[s][9] + ? "RecSize :", aInfo[s][10] + ? "No of Fields:", aInfo[s][11] + ? "Field Properties:" + FOR t := 1 TO LEN ( aInfo[s][12] ) + ? " ", padr( aInfo[s][12][t][1], 20 ), aInfo[s][12][t][2], aInfo[s][12][t][3], aInfo[s][12][t][4] + NEXT + NEXT + ? + aInfo := sx_DbInfo( 2 ) + ? 'SX_DBINFO( 2 ) ....' + ? REPL( "-", 76 ) + FOR s := 1 TO LEN ( aInfo ) + ? "Work Area :", aInfo[s][1] + ? "DBF Name :", aInfo[s][2] + ? "Alias :", aInfo[s][3] + ? "Shared :", aInfo[s][4] + ? "Readonly :", aInfo[s][5] + ? "RDE Type :", aInfo[s][6] + ? "Open Mode :", aInfo[s][7] + ? "RDD :", aInfo[s][8] + ? "CommitLevel :", aInfo[s][9] + ? "RecSize :", aInfo[s][10] + ? "No of Fields:", aInfo[s][11] + ? "Field Properties:" + FOR t := 1 TO LEN ( aInfo[s][12] ) + ? " ", padr( aInfo[s][12][t][1], 20 ), aInfo[s][12][t][2], aInfo[s][12][t][3], aInfo[s][12][t][4] + NEXT + NEXT + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test64.prg b/harbour/examples/hbapollo/tests/test64.prg new file mode 100644 index 0000000000..63a525c5f1 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test64.prg @@ -0,0 +1,33 @@ +/* + * $Id$ + */ +/* + sx_BaseDate(), sx_BaseName() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aInfo, i, j + LOCAL s, t + LOCAL aStruct1 := { { "PART_NO","C",10,0 }, { "PRICE","N",10,2 }, { "NOTES","M",10,0 } } + LOCAL aStruct2 := { { "CUST_NAME","C",20,0 }, { "AMOUNT","N",12,0 }, { "DUEDATE","D",8,0 }, { "PAID","L",1,0 } } + + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDEFOX + CREATE TABLE "TEST2" STRUCT aStruct2 RDD SDENSX + USE "test1" ALIAS ONE READONLY RDD SDEFOX + USE "test2" ALIAS two EXCLUSIVE RDD SDENSX + + ? 'sx_BaseDate() =', sx_BaseDate() + ? 'sx_BaseDate(1) =', sx_BaseDate( 1 ) + ? 'sx_BaseDate(2) =', sx_BaseDate( 2 ) + ? 'sx_BaseDate("ONE") =', sx_BaseDate( "ONE" ) + ? 'sx_BaseDate("TWO") =', sx_BaseDate( "TWO" ) + ? + ? 'sx_BaseName(1) =', sx_BaseName( 1 ) + ? 'sx_BaseName(2) =', sx_BaseName( 2 ) + ? 'sx_BaseName("ONE") =', sx_BaseName( "ONE" ) + ? 'sx_BaseName("TWO") =', sx_BaseName( "TWO" ) diff --git a/harbour/examples/hbapollo/tests/test65.prg b/harbour/examples/hbapollo/tests/test65.prg new file mode 100644 index 0000000000..570c54a526 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test65.prg @@ -0,0 +1,28 @@ +/* + * $Id$ + */ +/* + sx_ReplaceBlob()/sx_BlobToFile() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aInfo, i, j + LOCAL s, t + LOCAL aStruct1 := { { "NO","C",5,0 }, { "BINARY","M",10,0 } } + + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDEFOX + USE "test1" ALIAS ONE RDD SDEFOX + APPEND BLANK + REPLACE NO WITH "001" + IF File( "C:\WINDOWS\SYSTEM.INI" ) + sx_ReplaceBLOB( "BINARY", "C:\WINDOWS\SYSTEM.INI" ) + sx_Commit() + ? sx_BLOBToFile( "BINARY", "test.ini" ) + ELSE + ? "File C:\WINDOWS\SYSTEM.INI required for testing. Not found." + ENDIF diff --git a/harbour/examples/hbapollo/tests/test66.prg b/harbour/examples/hbapollo/tests/test66.prg new file mode 100644 index 0000000000..f11a5cc09c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test66.prg @@ -0,0 +1,30 @@ +/* + * $Id$ + */ +/* + sx_ReplaceBitmap()/sx_BlobToFile() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aInfo, i, j + LOCAL s, t + LOCAL aStruct1 := { { "NO","C",5,0 }, { "BINARY","M",10,0 } } + + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDENSX + USE "test1" ALIAS ONE RDD SDENSX + //CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDEFOX + //use "test1" alias ONE RDD SDEFOX + APPEND BLANK + REPLACE NO WITH "001" + IF file( "C:\WINDOWS\ACD Wallpaper.bmp" ) + sx_ReplaceBitmap( "BINARY", "C:\WINDOWS\ACD Wallpaper.bmp" ) + sx_Commit() + ? sx_BLOBToFile( "BINARY", "test.bmp" ) + ELSE + ? "File C:\WINDOWS\setup.bmp required for testing. Not found!" + ENDIF diff --git a/harbour/examples/hbapollo/tests/test67.prg b/harbour/examples/hbapollo/tests/test67.prg new file mode 100644 index 0000000000..d1bea599cd --- /dev/null +++ b/harbour/examples/hbapollo/tests/test67.prg @@ -0,0 +1,25 @@ +/* + * $Id$ + */ +/* + sx_CopyFile( cFileToCopy, cAlias) +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cCopy := "mynew.dbf" + LOCAL lResult + + USE "test/test" + + ? 'lResult := sx_CopyFile( cCopy ) =>', lResult := sx_CopyFile( cCopy ) + IF lResult + ? 'Copy success ... Press any key ...' + PAUSE + CLOSE ALL + USE "mynew.dbf" + BROWSE + ENDIF diff --git a/harbour/examples/hbapollo/tests/test68.prg b/harbour/examples/hbapollo/tests/test68.prg new file mode 100644 index 0000000000..aa4cd10c81 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test68.prg @@ -0,0 +1,14 @@ +/* + * $Id$ + */ +/* + sx_Count() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + USE "test/test" + ? 'sx_Count() =', sx_Count() diff --git a/harbour/examples/hbapollo/tests/test69.prg b/harbour/examples/hbapollo/tests/test69.prg new file mode 100644 index 0000000000..8a0716500c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test69.prg @@ -0,0 +1,26 @@ +/* + * $Id$ + */ +/* + sx_CreateFrom() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + USE "test/test" ALIAS TESTME + COPY STRUCTURE EXTENDED TO "Foo" + // Alias "BAR" passed and "newdbf.dbf" will be opened after creation + ? sx_CreateFrom( "newdbf.dbf", "bar", "Foo", "SDENSX" ) + sx_Close( "TESTME" ) + ? sx_Alias() // should be in "BAR" + CLOSE ALL + ? + USE "test/test" ALIAS TESTME + COPY STRUCTURE EXTENDED TO "Foo" + // No alias passed, FOO will not be opened + ? sx_CreateFrom( "newdbf.dbf", , "Foo", "SDENSX" ) + ? sx_Alias() // should be in "TESTME" + CLOSE ALL diff --git a/harbour/examples/hbapollo/tests/test70.prg b/harbour/examples/hbapollo/tests/test70.prg new file mode 100644 index 0000000000..a326ba3a95 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test70.prg @@ -0,0 +1,20 @@ +/* + * $Id$ + */ +/* + sx_DBFEncrypt(), sx_DbfDecrypt() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + USE "test/test" ALIAS TESTME + sx_Copyfile( "newtest" ) // Copy DBF to newtest + USE "newtest" EXCLUSIVE // Open Exclusive + sx_DBFEncrypt( "harbour" ) // Encrypt with password + sx_SetPassword() // Reset password to test encryption + BROWSE + sx_DBFDecrypt( "harbour" ) // Decrypt DBF with password + BROWSE diff --git a/harbour/examples/hbapollo/tests/test71.prg b/harbour/examples/hbapollo/tests/test71.prg new file mode 100644 index 0000000000..f90e3117f3 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test71.prg @@ -0,0 +1,23 @@ +/* + * $Id$ + */ +/* + sx_Encrypt(), sx_Decrypt() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cString := "Harbour Power" + LOCAL cEncrypted + + ? 'cEncrypted:=sx_Encrypt( cString, "password" )=', cEncrypted := sx_Encrypt( cString, "password" ) + ? 'sx_Decrypt( cEncrypted, "password" )=', sx_Decrypt( cEncrypted, "password" ) + ? + ? 'cString=', cString + ? 'cString="Harbour Power"', cString := "Harbour Power" + ? + ? 'cEncrypted:=sx_Encrypt( cString, "password" )=', cEncrypted := sx_Encrypt( cString, "password" ) + ? 'sx_Decrypt( cEncrypted, "nopass" )=', sx_Decrypt( cEncrypted, "nopass" ) diff --git a/harbour/examples/hbapollo/tests/test72.prg b/harbour/examples/hbapollo/tests/test72.prg new file mode 100644 index 0000000000..77d71658fc --- /dev/null +++ b/harbour/examples/hbapollo/tests/test72.prg @@ -0,0 +1,15 @@ +/* + * $Id$ + */ +/* + sx_Descend() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cString := "Harbour" + + ? sx_Descend( cString ) diff --git a/harbour/examples/hbapollo/tests/test73.prg b/harbour/examples/hbapollo/tests/test73.prg new file mode 100644 index 0000000000..f0c6fa1fe8 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test73.prg @@ -0,0 +1,24 @@ +/* + * $Id$ + */ +/* + sx_Empty()/sx_IsNull() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aStruct1 := { { "PART_NO","C",10,0 }, { "PRICE","N",10,2 }, { "NOTES","M",10,0 } } + + SET RDD SDEFOX + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 + USE "test1" + APPEND BLANK + REPLACE PRICE WITH 20 + ? sx_Empty( "PART_NO" ) + ? sx_IsNull( "PART_NO" ) + ? sx_Empty( "PRICE" ) + ? sx_IsNull( "PRICE" ) diff --git a/harbour/examples/hbapollo/tests/test74.prg b/harbour/examples/hbapollo/tests/test74.prg new file mode 100644 index 0000000000..09074a5319 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test74.prg @@ -0,0 +1,47 @@ +/* + * $Id$ + */ +/* + sx_EvalLogical() + sx_EvalNumeric() + sx_EvalString() + sx_EvalDate() + sx_EvalTest() +*/ + +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aStruct1 := { ; + { "PART_NO" , "C" , 10, 0 }, ; + { "PART_NAME" , "C", 10, 0 }, ; + { "PRICE" , "N", 10, 2 }, ; + { "DATE_SOLD" , "D", 8, 0 }, ; + { "COST" , "N", 10, 2 }, ; + { "NOTES" , "M", 10, 0 } } + LOCAL d + + SET RDD SDENSX + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 + USE "test1" + APPEND BLANK + REPLACE PRICE WITH 20 + REPLACE COST WITH 10 + REPLACE PART_NO WITH "PART" + REPLACE PART_NAME WITH "0010" + REPLACE DATE_SOLD WITH DATE() + + ? [sx_EvalLogical( "Upper(PART_NO)='PART'" ) =>], sx_EvalLogical( "Upper(PART_NO)='PART'" ) + ? 'sx_EvalNumeric( "PRICE-COST" ) =>', sx_EvalNumeric( "PRICE-COST" ) + ? 'sx_EvalString( "ALLTRIM(PART_NO) + ALLTRIM(PART_NAME)" ) =>', sx_EvalString( "ALLTRIM(PART_NO) + ALLTRIM(PART_NAME)" ) + ? 'sx_EvalString( "DATE_SOLD + 30" ) =>', sx_EvalString( "DATE_SOLD + 30" ) + ? 'sx_EvalDate( "DATE_SOLD + 30" ) =>', sx_EvalDate( "DATE_SOLD + 30" ) + ? + ? [sx_EvalTest( "Upper(PART_NO)='PART'" ) =>], sx_EvalTest( "Upper(PART_NO)='PART'" ) + ? 'sx_EvalTest( "PRICE-COST" ) =>', sx_EvalTest( "PRICE-COST" ) + ? 'sx_EvalTest( "ALLTRIM(PART_NO) + ALLTRIM(PART_NAME)" ) =>', sx_EvalTest( "ALLTRIM(PART_NO) + ALLTRIM(PART_NAME)" ) + ? 'sx_EvalTest( "DATE_SOLD + 30" ) =>', sx_EvalTest( "DATE_SOLD + 30" ) diff --git a/harbour/examples/hbapollo/tests/test75.prg b/harbour/examples/hbapollo/tests/test75.prg new file mode 100644 index 0000000000..c9ba109fa5 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test75.prg @@ -0,0 +1,52 @@ +/* + * $Id$ + */ +/* + sx_FieldCount () + sx_FieldDecimals () + sx_FieldName () + sx_FieldNum () + sx_FieldType () + sx_FieldWidth () +*/ + +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aStruct1 := { ; + { "PART_NO" , "C" , 10, 0 }, ; + { "PART_NAME" , "C", 10, 0 }, ; + { "PRICE" , "N", 10, 2 }, ; + { "DATE_SOLD" , "D", 8, 0 }, ; + { "COST" , "N", 10, 2 }, ; + { "NOTES" , "M", 10, 0 } } + LOCAL nCount, i, cFieldName + + SET RDD SDENSX + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 + USE "test1" + APPEND BLANK + + ? 'nCount := sx_FieldCount() =>', nCount := sx_FieldCount() + + FOR i := 1 TO nCount + ? 'sx_FieldName(' + ltrim( str( i ) ) + ') =', cFieldName := sx_FieldName( i ) + ? 'sx_FieldType(' + cFieldName + ') =', sx_FieldType( cFieldName ) + ? 'sx_FieldNum(' + cFieldName + ') =', sx_FieldNum( cFieldName ) + ? 'sx_FieldWidth(' + cFieldName + ') =', sx_FieldWidth( cFieldName ) + ? 'sx_FieldDecimals(' + cFieldName + ') =', sx_FieldDecimals( cFieldName ) + ? + NEXT + + FOR i := 1 TO nCount + ? 'sx_FieldName(' + ltrim( str( i ) ) + ') =', cFieldName := sx_FieldName( i ) + ? 'sx_FieldType(' + ltrim( str( i ) ) + ') =', sx_FieldType( i ) + ? 'sx_FieldNum(' + ltrim( str( i ) ) + ') =', sx_FieldNum( i ) + ? 'sx_FieldWidth(' + ltrim( str( i ) ) + ') =', sx_FieldWidth( i ) + ? 'sx_FieldDecimals(' + ltrim( str( i ) ) + ') =', sx_FieldDecimals( i ) + ? + NEXT diff --git a/harbour/examples/hbapollo/tests/test76.prg b/harbour/examples/hbapollo/tests/test76.prg new file mode 100644 index 0000000000..a0e61693ed --- /dev/null +++ b/harbour/examples/hbapollo/tests/test76.prg @@ -0,0 +1,29 @@ +/* + * $Id$ + */ +/* + sx_FLock() +*/ + +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aStruct1 := { ; + { "PART_NO" , "C" , 10, 0 }, ; + { "PART_NAME" , "C", 10, 0 }, ; + { "PRICE" , "N", 10, 2 }, ; + { "DATE_SOLD" , "D", 8, 0 }, ; + { "COST" , "N", 10, 2 }, ; + { "NOTES" , "M", 10, 0 } } + LOCAL nCount, i, cFieldName + + SET RDD SDENSX + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 + USE "test1" + APPEND BLANK + + ? sx_Flock() diff --git a/harbour/examples/hbapollo/tests/test77.prg b/harbour/examples/hbapollo/tests/test77.prg new file mode 100644 index 0000000000..8a4686824c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test77.prg @@ -0,0 +1,30 @@ +/* + * $Id$ + */ +/* + sx_GetBlobLength() + sx_ReplaceBlob()/sx_BlobToFile() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aInfo, i, j + LOCAL s, t + LOCAL aStruct1 := { { "NO","C",5,0 }, { "BINARY","M",10,0 } } + + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDEFOX + USE "test1" ALIAS ONE RDD SDEFOX + APPEND BLANK + REPLACE NO WITH "001" + IF File( "C:\WINDOWS\SYSTEM.INI" ) + sx_ReplaceBLOB( "BINARY", "C:\WINDOWS\SYSTEM.INI" ) + sx_Commit() + ? 'sx_GetBlobLength( "BINARY" ) =>', sx_GetBlobLength( "BINARY" ) + ? 'sx_BLOBToFile( "BINARY", "test.ini" ) =>', sx_BLOBToFile( "BINARY", "test.ini" ) + ELSE + ? "File C:\WINDOWS\SYSTEM.INI required for testing. Not found." + ENDIF diff --git a/harbour/examples/hbapollo/tests/test78.prg b/harbour/examples/hbapollo/tests/test78.prg new file mode 100644 index 0000000000..b3010eaee1 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test78.prg @@ -0,0 +1,56 @@ +/* + * $Id$ + */ +/* + sx_GetByte () + sx_GetDateJulian () + sx_GetDateString () + sx_GetDouble () + sx_GetInteger () + sx_GetLogical () + sx_GetLong () + sx_GetMemo () + sx_GetString () + sx_GetTrimString () + sx_GetVariant () +*/ + +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aStruct1 := { ; + { "PART_NO" , "C", 20, 0 }, ; + { "PART_NAME" , "C", 10, 0 }, ; + { "PRICE" , "N", 10, 2 }, ; + { "DATE_SOLD" , "D", 8, 0 }, ; + { "COST" , "N", 10, 2 }, ; + { "SOLD" , "L", 1, 0 }, ; + { "NOTES" , "M", 10, 0 } } + LOCAL xVar + + SET RDD SDEFOX + SET DATE "DD/MM/YYYY" + CREATE TABLE "TEST1" STRUCT ASTRUCT1 + USE "TEST1" + APPEND BLANK + REPLACE PART_NO WITH "MY_PARTNO" + REPLACE DATE_SOLD WITH DATE() + REPLACE PRICE WITH 25.30 + REPLACE SOLD WITH .F. + REPLACE NOTES WITH "This is some notes for testing purposes" + COMMIT + + ? 'sx_GetString( "PART_NO" ) =>', xVar := sx_GetString( "PART_NO" ), '[' + ValType( xVar ) + ']' + ? 'sx_GetTrimString( "PART_NO" ) =>', xVar := sx_GetTrimString( "PART_NO" ), '[' + ValType( xVar ) + ']' + ? 'sx_GetByte( "PART_NO" ) =>', xVar := sx_GetByte( "PART_NO" ), '[' + ValType( xVar ) + ']' + ? 'sx_GetDateJulian ( "DATE_SOLD" ) =>', xVar := sx_GetDateJulian ( "DATE_SOLD" ), '[' + ValType( xVar ) + ']' + ? 'sx_GetDateString ("DATE_SOLD" ) =>', xVar := sx_GetDateString ( "DATE_SOLD" ), '[' + Valtype( xVar ) + ']' + ? 'sx_GetValue ("DATE_SOLD" ) =>', xVar := sx_GetValue ( "DATE_SOLD" ), '[' + Valtype( xVar ) + ']' + ? 'sx_GetDouble( "PRICE" ) =>', xVar := sx_GetDouble( "PRICE" ), '[' + Valtype( xVar ) + ']' + ? 'sx_GetInteger( "PRICE" ) =>', xVar := sx_GetInteger( "PRICE" ), '[' + Valtype( xVar ) + ']' + ? 'sx_GetLong( "PRICE" ) =>', xVar := sx_GetLong( "PRICE" ), '[' + Valtype( xVar ) + ']' + ? 'sx_GetLogical( "SOLD" ) =>', xVar := sx_GetLogical( "SOLD" ), '[' + Valtype( xVar ) + ']' + ? 'sx_GetMemo( "NOTES" ) =>', xVar := sx_GetMemo( "NOTES" ), '[' + Valtype( xVar ) + ']' diff --git a/harbour/examples/hbapollo/tests/test79.prg b/harbour/examples/hbapollo/tests/test79.prg new file mode 100644 index 0000000000..e25965669c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test79.prg @@ -0,0 +1,38 @@ +/* + * $Id$ + */ +/* + sx_SetScope()/sx_GetScope()/sx_ClearScope()/sx_QueryRecCount() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + USE "test/test" + FERASE( "TEST.NSX" ) + INDEX ON LAST TO TEST + ? 'sx_QueryRecCount() =>', sx_QueryRecCount() + ? 'BROWSE without scoping ... Press any key ...' + PAUSE + CLS + BROWSE + CLS + ? 'sx_SetScope( "Jones", "Smith" ) =>', sx_SetScope( "Jones", "Smith" ) + ? 'sx_GetScope() =>', sx_GetScope() + ? 'sx_GetScope(1) =>', sx_GetScope( 1 ) + ? 'sx_QueryRecCount() =>', sx_QueryRecCount() + ? 'BROWSE with scoping ... Press any key ...' + PAUSE + CLS + BROWSE + CLS + ? 'sx_ClearScope() =>', sx_ClearScope() + ? 'sx_GetScope() =>', sx_GetScope() + ? 'sx_GetScope(1) =>', sx_GetScope( 1 ) + ? 'sx_QueryRecCount() =>', sx_QueryRecCount() + ? 'Scope has been cleared ... Press any key ...' + PAUSE + CLS + BROWSE diff --git a/harbour/examples/hbapollo/tests/test80.prg b/harbour/examples/hbapollo/tests/test80.prg new file mode 100644 index 0000000000..05d0af2c19 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test80.prg @@ -0,0 +1,61 @@ +/* + * $Id$ + */ +/* + sx_SetRelation()/sx_ClearRelation() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL struct1 := { { "PART_NO","C",5,0 }, { "BOUGHT","N",10,2 } } + LOCAL struct2 := { { "PART_NO","C",5,0 }, { "SOLD","N",10,2 } } + LOCAL i, nParent, nChild + + ? 'Creating Files ...' + sx_DBCreate( "PARENT", struct1 ) + ? 'PARENT Created ...' + USE "PARENT" ALIAS PARENT VAR nParent EXCLUSIVE + FOR i := 1 TO 100 + sx_Append() + sx_Replace( "PART_NO", PADL( i,5,"0" ) ) + sx_Replace( "BOUGHT" , i * 2 ) + NEXT + ? 'Indexing ...' + INDEX ON PART_NO TO PARENT + ? 'Open Index ...' + sx_IndexOpen( "PARENT.NSX" ) + + sx_DBCreate( "CHILD" , struct2 ) + ? 'CHILD Created .....' + USE "CHILD" ALIAS CHILD VAR nChild EXCLUSIVE + FOR i := 1 TO 100 + sx_Append() + sx_Replace( "PART_NO", PADL( i,5,"0" ) ) + sx_Replace( "SOLD" , i * 2.5 ) + NEXT + INDEX ON PART_NO TO CHILD + sx_IndexOpen( "CHILD.NSX" ) + + sx_Select( "PARENT" ) + sx_SetRelation( "CHILD", "PART_NO" ) + sx_Gotop( "PARENT" ) + + ? 'Parent is related to Child with PART_NO as key ... Press any key ...' + PAUSE + WHILE !sx_Eof( "PARENT" ) + ? sx_GetValue( "PART_NO", "PARENT" ), sx_GetValue( "BOUGHT" , "PARENT" ), sx_GetValue( "SOLD", "CHILD" ) + sx_Skip( 1, "PARENT" ) + ENDDO + + ? + ? 'Now relation is to be cleared ... Press any key ... ' + sx_ClearRelation ( "PARENT" ) + sx_GoTop( "PARENT" ) + PAUSE + WHILE !sx_Eof( "PARENT" ) + ? sx_GetValue( "PART_NO", "PARENT" ), sx_GetValue( "BOUGHT" , "PARENT" ), sx_GetValue( "SOLD", "CHILD" ) + sx_Skip( 1, "PARENT" ) + ENDDO diff --git a/harbour/examples/hbapollo/tests/test81.prg b/harbour/examples/hbapollo/tests/test81.prg new file mode 100644 index 0000000000..1d9e04fff0 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test81.prg @@ -0,0 +1,58 @@ +/* + * $Id$ + */ +/* + sx_SetRelation()/sx_ClearRelation() Using Command +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL struct1 := { { "PART_NO","C",5,0 }, { "BOUGHT","N",10,2 } } + LOCAL struct2 := { { "PART_NO","C",5,0 }, { "SOLD","N",10,2 } } + LOCAL i, nParent, nChild + + ? 'Creating Files ...' + sx_DBCreate( "PARENT", struct1 ) + USE "PARENT" ALIAS PARENT VAR nParent EXCLUSIVE + FOR i := 1 TO 100 + sx_Append() + sx_Replace( "PART_NO", PADL( i,5,"0" ) ) + sx_Replace( "BOUGHT" , i * 2 ) + NEXT + INDEX ON PART_NO TO PARENT + sx_IndexOpen( "PARENT.NSX" ) + + sx_DBCreate( "CHILD" , struct2 ) + USE "CHILD" ALIAS CHILD VAR nChild EXCLUSIVE + FOR i := 1 TO 100 + sx_Append() + sx_Replace( "PART_NO", PADL( i,5,"0" ) ) + sx_Replace( "SOLD" , i * 2.5 ) + NEXT + INDEX ON PART_NO TO CHILD + sx_IndexOpen( "CHILD.NSX" ) + + sx_Select( "PARENT" ) + SET RELATION TO PART_NO INTO CHILD + // sx_SetRelation( "CHILD", "PART_NO" ) + sx_Gotop( "PARENT" ) + + ? 'Parent is related to Child with PART_NO as key ... Press any key ...' + PAUSE + WHILE !sx_Eof( "PARENT" ) + ? sx_GetValue( "PART_NO", "PARENT" ), sx_GetValue( "BOUGHT" , "PARENT" ), sx_GetValue( "SOLD", "CHILD" ) + sx_Skip( 1, "PARENT" ) + ENDDO + + ? + ? 'Now relation is to be cleared ... Press any key ... ' + SET RELATION TO // sx_ClearRelation ( "PARENT" ) + sx_GoTop( "PARENT" ) + PAUSE + WHILE !sx_Eof( "PARENT" ) + ? sx_GetValue( "PART_NO", "PARENT" ), sx_GetValue( "BOUGHT" , "PARENT" ), sx_GetValue( "SOLD", "CHILD" ) + sx_Skip( 1, "PARENT" ) + ENDDO diff --git a/harbour/examples/hbapollo/tests/test82.prg b/harbour/examples/hbapollo/tests/test82.prg new file mode 100644 index 0000000000..33fc92f137 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test82.prg @@ -0,0 +1,32 @@ +/* + * $Id$ + */ +/* + sx_ReplaceArray()/sx_GetValueArray() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL aValue, i, j + LOCAL aStruct1 := { { "NO","C",5,0 }, { "BINARY","M",10,0 } } + + SET DATE "dd/mm/yyyy" + CREATE TABLE "TEST1" STRUCT aStruct1 RDD SDEFOX + USE "test1" ALIAS ONE RDD SDEFOX + APPEND BLANK + REPLACE NO WITH "001" + ? sx_ReplaceArray( "BINARY", aStruct1 ) + sx_Commit() + + aValue := sx_GetValueArray ( "BINARY" ) + + FOR i := 1 TO Len( aValue ) + ? "Element: ", ltrim( str( i ) ) + FOR j := 1 TO Len( aValue [i] ) + ? aValue[i][j], "[" + ValType( aValue[i][j] ) + "]" + NEXT + ? + NEXT diff --git a/harbour/examples/hbapollo/tests/test83.prg b/harbour/examples/hbapollo/tests/test83.prg new file mode 100644 index 0000000000..3fe4693b62 --- /dev/null +++ b/harbour/examples/hbapollo/tests/test83.prg @@ -0,0 +1,31 @@ +/* + * $Id$ + */ +/* + sx_Query(), sx_QueryTest(), sx_QueryRecCount() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + USE "TEST/TEST" + ? 'Creating index ...' + FERASE( "TEST.NSX" ) + INDEX ON STATE TO TEST + ? 'Making Query ...' + ? [sx_QueryTest( "STATE LIKE '%L%'" ) =], sx_QueryTest( "STATE LIKE '%L'" ) +  + ? [sx_QueryTest( "STATE='LA'" ) =], sx_QueryTest( "STATE='LA'" ) + ? [sx_Query( "STATE='LA'" ) =], sx_Query( "STATE='LA'" ) + ? [sx_QueryRecCount() =], sx_QueryRecCount() + ? 'Now Browse .. Press any key ...' + PAUSE + BROWSE + CLS + ? + ? 'Now clear the Query and BROWSE ... Press any key ...' + PAUSE + sx_QueryClear() + BROWSE diff --git a/harbour/examples/hbapollo/tests/test84.prg b/harbour/examples/hbapollo/tests/test84.prg new file mode 100644 index 0000000000..bf5085547c --- /dev/null +++ b/harbour/examples/hbapollo/tests/test84.prg @@ -0,0 +1,31 @@ +/* + * $Id$ + */ +/* + sx_Query(), sx_QueryTest(), sx_QueryRecCount() +*/ +#include "sixapi.ch" + +#include "simpleio.ch" + +PROCEDURE MAIN() + + USE "TEST/TEST" + ? 'Creating index ...' + IF FILE( "TEST.NSX" ) + FERASE( "TEST.NSX" ) + ENDIF + INDEX ON LAST TO TEST + ? 'Making Query ...' + ? [sx_QueryTest( "LAST LIKE '%B%'" ) =], sx_QueryTest( "LAST LIKE '%B%'" ) + ? [sx_Query( "LAST LIKE '%B%'" ) =], sx_Query( "LAST LIKE '%B%'" ) + ? [sx_QueryRecCount() =], sx_QueryRecCount() + ? 'Now Browse .. Press any key ...' + PAUSE + BROWSE + CLS + ? + ? 'Now clear the Query and BROWSE ... Press any key ...' + PAUSE + sx_QueryClear() + BROWSE diff --git a/harbour/examples/hbapollo/tests/test85.prg b/harbour/examples/hbapollo/tests/test85.prg new file mode 100644 index 0000000000..068429968d --- /dev/null +++ b/harbour/examples/hbapollo/tests/test85.prg @@ -0,0 +1,62 @@ +/* + * $Id$ + */ +/* + sx_KeyAdd(), sx_KeyDrop(), sx_KeyData() +*/ +#include "sixapi.ch" + +#define IDX_NONE 0 // Standard index (Not UNIQUE or EMPTY (RYO)) +#define IDX_UNIQUE 1 // UNIQUE, allows unique keys only +#define IDX_EMPTY 2 // Roll-Your-Own (RYO) empty index header + +#include "simpleio.ch" + +PROCEDURE MAIN() + + LOCAL cState + + SET RDD SDEFOX + USE "TEST/TEST" EXCLUSIVE + ? 'Creating index ...' + FErase( "TEST/TEST.CDX" ) + sx_IndexTag ( "TEST/TEST", "STATE", "STATE", IDX_EMPTY ) + sx_IndexTag ( "TEST/TEST", "FIRST", "FIRST" ) + sx_Gotop() + ? 'Adding Key ...' + WHILE !sx_Eof() + cState := SX_GETVALUE( "STATE" ) + IF cState == "LA" + ? 'SX_KEYADD( "STATE" ) =', SX_KEYADD( "STATE" ) + ENDIF + sx_skip( 1 ) + ENDDO + ? 'Now examining with sx_KeyData() .. Press any key ...' + PAUSE + sx_SetOrder( "STATE" ) + sx_Gotop() + WHILE !sx_Eof() + ? "sx_RecNo() =", ltrim( str( sx_recNo() ) ), ' sx_KeyData()=', sx_KeyData() + sx_skip() + ENDDO + + ? 'BROWSE .. Press any key ...' + PAUSE + sx_SetOrder( "STATE" ) + BROWSE + CLS + ? 'Now Deleting Key ....' + sx_SetOrder( "FIRST" ) + sx_GoTop() + WHILE !sx_Eof() + cState := SX_GETVALUE( "STATE" ) + IF cState == "LA" + ? 'SX_KEYDROP( "STATE" ) =', SX_KEYDROP( "STATE" ) + ENDIF + sx_skip() + ENDDO + + ? 'BROWSE .. Press any key ...' + PAUSE + sx_SetOrder( "STATE" ) + BROWSE diff --git a/harbour/examples/hbapollo/tests/tsix.prg b/harbour/examples/hbapollo/tests/tsix.prg new file mode 100644 index 0000000000..c9c0042271 --- /dev/null +++ b/harbour/examples/hbapollo/tests/tsix.prg @@ -0,0 +1,91 @@ +/* + * $Id$ + */ + +/* + tsix.prg + Demo using TApollo Class + Class is not complete yet, please contribute codes to make it complete :-) +*/ + +#include "simpleio.ch" + +EXTERNAL HB_GT_WIN_DEFAULT + +PROCEDURE MAIN() + + LOCAL oDBF := TApollo():New() + LOCAL oDBF1 := TApollo():New() + LOCAL nsec + + SX_ERRORLEVEL( 0 ) + + oDBF1:cDBFFile := "test.dbf" + oDBF1:cAlias := "CUSTOMER" + oDBF1:cRDD := "SDENSX" + + oDBF:cDBFFile := "test.dbf" + oDBF:cAlias := "MYTEST" + oDBF:cRDD := "SDENSX" + + oDBF1:Open() + ? "oDbf1:Reccount()", oDbf1:Reccount() + + oDBF:Open() + ? "oDbf:Reccount()", oDbf:Reccount() + + ? "oDBF1:nWorkArea()=", oDBF1:nWorkArea() + ? "oDBF:nWorkArea()=", oDBF:nWorkArea() + + ? "oDBF1:cAlias=", oDBF1:cAlias + ? "oDBF:cAlias=", oDBF:cAlias + + ? "oDBF1:cRDD=", oDBF1:cRDD + ? "oDBF:cRDD=", oDBF:cRDD + + ? 'oDBF:FIRST=',oDBF:FIRST + ? 'oDBF:AGE := 99' + oDBF:AGE := 99 + oDBF:Commit() + ? oDBF:AGE + ? 'oDBF:AGE := 25' + oDBF:AGE := 25 + oDBF:Commit() + ? oDBF:AGE + ? 'oDBF:FIRST=',oDBF:FIRST + ? 'oDBF:FIRST="Andi"' + oDBF:FIRST := "Andi" + ? 'oDBF:FIRST=',oDBF:FIRST + inkey(0) + + nsec := seconds() + + oDBF:dbGotop() + While !oDBF:Eof() + ? oDbf:First + " " + oDbf:Last + oDbf:dbSkip() + Enddo + + ? + + While !oDBF:Bof() + ? oDbf:First + " " + oDbf:Last + oDbf:dbSkip(-1) + Enddo + + ? seconds() - nsec + ? "Now browsing oDBF1", odbf1:cDBFFile + inkey(0) + + nsec := seconds() + oDBF1:dbGotop() + While !oDBF1:Eof() + ? oDbf1:First + " " + oDbf1:Last + oDbf1:dbSkip() + Enddo + + oDBF:Close() + ? "oDBF Closed ..." + ? seconds() - nsec + ? sx_version() + ? sx_sxapi_version() diff --git a/harbour/examples/hbapollo/tindex.prg b/harbour/examples/hbapollo/tindex.prg new file mode 100644 index 0000000000..cb0b3ced08 --- /dev/null +++ b/harbour/examples/hbapollo/tindex.prg @@ -0,0 +1,58 @@ +/* + * $Id: tindex.prg 9576 2012-07-17 16:41:57Z andijahja $ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#include "hbclass.ch" + +CLASS TIndex + + VAR cIndexFile /* Index File Name */ + VAR cExpression /* Index Expression */ + VAR iMode /* iOption: IDX_NONE=0 IDX_UNIQUE=1 IDX_EMPTY=2 */ + VAR lDescending /* BOOL lDescending */ + VAR cCondition /* FOR Condition */ + VAR cAlias + + METHOD New( cIndexFile, cExpression, iMode, lDescending, cCondition, cAlias ) + METHOD CREATE() + +ENDCLASS + +METHOD New( cIndexFile, cExpression, iMode, lDescending, cCondition, cAlias ) CLASS TIndex + + ::cIndexFile := cIndexFile /* Index File Name */ + ::cExpression := cExpression /* Index Expression */ + ::iMode := iMode /* iOption: IDX_NONE=0 IDX_UNIQUE=1 IDX_EMPTY=2 */ + ::lDescending := lDescending /* BOOL lDescending */ + ::cCondition := cCondition /* FOR Condition */ + ::cAlias := cAlias /* Alias */ + + RETURN Self + +METHOD CREATE() CLASS TIndex + + // This is For Single TAG Index File : DBFNTX + // DBFCDX and DBFNSX Should Use TAG + + RETURN sx_Index( ::cIndexFile, ::cExpression, ::iMode, ::lDescending, ::cCondition, ::cAlias ) diff --git a/harbour/examples/hbapollo/tools.c b/harbour/examples/hbapollo/tools.c new file mode 100644 index 0000000000..8c9c383c2a --- /dev/null +++ b/harbour/examples/hbapollo/tools.c @@ -0,0 +1,106 @@ +/* + * $Id: tools.c 9576 2012-07-17 16:41:57Z andijahja $ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#include "sxapi.h" + +const char * _sx_CheckFileExt( const char * szFileName ) +{ + PHB_FNAME pFileName = hb_fsFNameSplit( szFileName ); + static char _szFileName[ HB_PATH_MAX ]; + + memset( _szFileName, 0, HB_PATH_MAX ); + + if( ! pFileName->szExtension ) + { + pFileName->szExtension = ".dbf"; + hb_fsFNameMerge( _szFileName, pFileName ); + } + else + hb_xstrcpy( _szFileName, szFileName, 0 ); + + hb_xfree( pFileName ); + + return _szFileName; +} + +double sx_GetPrivateProfileDouble( LPSTR lpSectionName, LPSTR lpEntryName, + LPSTR lpDefault, LPSTR lpIniFileName ) +{ + BYTE bBuffer[ 1024 ]; + + GetPrivateProfileString( lpSectionName, /* Section */ + lpEntryName, /* Entry */ + lpDefault, /* Default */ + ( char * ) bBuffer, /* Destination Buffer */ + sizeof( bBuffer ) - 1, lpIniFileName ); /* Inifile Name */ + if( ! ( *bBuffer ) ) + { + return atof( ( char * ) lpDefault ); + } + + return atof( ( char * ) bBuffer ); +} + +static void hb_objProcessMessage( PHB_ITEM pObj, PHB_DYNS pDyns, ULONG ulArg, ... ) +{ + hb_vmPushSymbol( hb_dynsymSymbol( pDyns ) ); + hb_vmPush( pObj ); + + if( ulArg ) + { + ULONG i; + + va_list ap; + + va_start( ap, ulArg ); + + for( i = 0; i < ulArg; i++ ) + { + hb_vmPush( va_arg( ap, PHB_ITEM ) ); + } + + va_end( ap ); + } + + hb_vmSend( ( HB_USHORT ) ulArg ); +} + +PHB_ITEM _sx_GetAlias( void ) +{ + PHB_ITEM pResult; + +#ifdef __cplusplus + static PHB_DYNS +#else + static PHB_DYNS pFunc = NULL; + if( ! pFunc ) +#endif + pFunc = hb_dynsymFind( "CALIAS" ); + + hb_objProcessMessage( hb_stackSelfItem(), pFunc, 0 ); + pResult = hb_itemNew( NULL ); + hb_itemCopy( pResult, hb_stackReturnItem() ); + return pResult; +} diff --git a/harbour/examples/hbapollo/ttable.prg b/harbour/examples/hbapollo/ttable.prg new file mode 100644 index 0000000000..990d5dfb6b --- /dev/null +++ b/harbour/examples/hbapollo/ttable.prg @@ -0,0 +1,196 @@ +/* + * $Id: ttable.prg 9576 2012-07-17 16:41:57Z andijahja $ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#include "hbclass.ch" + +#define SX_READWRITE 1 +#define SX_READONLY 2 +#define SX_EXCLUSIVE 3 + + // SX_DBINFO( CALIAS ) => ARRAY +#define SXINFO_AREA 1 // INTEGER +#define SXINFO_FILENAME 2 // STRING +#define SXINFO_ALIAS 3 // STRING +#define SXINFO_SHARED 4 // LOGICAL +#define SXINFO_READONLY 5 // LOGICAL +#define SXINFO_RDETYPE 6 // INTEGER +#define SXINFO_MODE 7 // INTEGER +#define SXINFO_RDD 8 // STRING +#define SXINFO_COMMITLEVEL 9 // INTEGER +#define SXINFO_RECSIZE 10 // INTEGER +#define SXINFO_FIELDCOUNT 11 // INTEGER +#define SXINFO_FIELDINFO 12 // ARRAY + +CLASS TApollo + + VAR cDBFFile + VAR cIndexFile + VAR cAlias + VAR nWorkArea + VAR nOpenMode INIT SX_READWRITE // { "READWRITE","READONLY","EXCLUSIVE" }; + VAR nCommitLevel INIT 1 // 1 or 2 + VAR cRDD // "SDENTX","SDEFOX","SDENSX","SDENSX_DBT" + VAR aFieldName INIT {} + + METHOD New( cDBFFile, nOpenMode ) + METHOD Open( nOpenMode ) + METHOD CLOSE() + METHOD RecCount() + METHOD LastRec() + METHOD RecNo() + METHOD COMMIT() + METHOD dbGoTop() + METHOD dbGoto( nRecNo ) + METHOD dbGoBottom() + METHOD dbSkip( nSkip ) + METHOD FCount() + METHOD FieldName( iFieldNum ) + METHOD FieldGet( cFieldName ) + METHOD BOF() + METHOD EOF() + METHOD REPLACE( cpFieldName, xData ) + METHOD dbSeek( cSeek ) + METHOD Found() + METHOD DBLocate( cpExpression, iDirection, bContinue ) + +ENDCLASS + +METHOD New( cDBFFile, nOpenMode ) CLASS TApollo + + ::cDBFFile := cDBFFile + ::nOpenMode := nOpenMode + + RETURN Self + +METHOD Open( nOpenMode ) CLASS TApollo + + LOCAL i, j, cField + LOCAL hClass := self:ClassH + + IF ValType( nOpenMode ) == "N" + ::nOpenMode := nOpenMode + ENDIF + + ::nWorkArea := sx_Use( ; + ::cDBFFile, ; + ::cAlias, ; + ::nOpenMode, ; + ::cRDD, ; + ::nCommitLevel ) + + j := sx_FieldCount( ::cAlias ) + + FOR i := 1 TO j + cField := sx_FieldName( i, ::cAlias ) + AAdd( ::aFieldName, cField ) + __clsAddMsg( hClass, cField, __blockGet( cField ), HB_OO_MSG_INLINE ) + __clsAddMsg( hClass, "_" + cField, __blockPut( cField ), HB_OO_MSG_INLINE ) + NEXT + + RETURN Self + +METHOD RecCount() CLASS TApollo + + RETURN sx_RecCount( ::cAlias ) + +METHOD LastRec() CLASS TApollo + + RETURN sx_RecCount( ::cAlias ) + +METHOD CLOSE() CLASS TApollo + + RETURN sx_Close( ::cAlias ) + +METHOD RecNo() CLASS TApollo + + RETURN sx_RecNo( ::cAlias ) + +METHOD dbGoto( nRecNo ) CLASS TApollo + + RETURN sx_Go( nRecNo, ::cAlias ) + +METHOD dbGoTop() CLASS TApollo + + RETURN sx_GoTop( ::cAlias ) + +METHOD dbGoBottom() CLASS TApollo + + RETURN sx_GoBottom( ::cAlias ) + +METHOD FCount() CLASS TApollo + + RETURN sx_FieldCount( ::cAlias ) + +METHOD FieldName( iFieldNum ) CLASS TApollo + + RETURN sx_FieldName( iFieldNum, ::cAlias ) + +METHOD FieldGet( cFieldName ) CLASS TApollo + + RETURN sx_FieldGet( cFieldName, ::cAlias ) + +METHOD BOF() CLASS TApollo + + RETURN sx_Bof( ::cAlias ) + +METHOD EOF() CLASS TApollo + + RETURN sx_Eof( ::cAlias ) + +METHOD COMMIT() CLASS TApollo + + RETURN sx_Commit( ::cAlias ) + +METHOD dbSkip( nSkip ) CLASS TApollo + + IF nSkip == NIL + nSkip := 1 + ENDIF + + RETURN sx_Skip( nSkip, ::cAlias ) + +METHOD REPLACE( cpFieldName, xData ) CLASS TAPOLLO + + RETURN sx_Replace( cpFieldName, xData, ::cAlias ) + +METHOD dbSeek( cSeek ) CLASS TAPOLLO + + RETURN sx_Seek( cSeek, ::cAlias ) + +METHOD Found() CLASS TAPOLLO + + RETURN sx_Found( ::cAlias ) + +METHOD DBLocate( cpExpression, iDirection, bContinue ) CLASS TAPOLLO + + RETURN sx_Locate( cpExpression, iDirection, bContinue, ::cAlias ) + +STATIC FUNCTION __blockGet( cField ) + + RETURN {| self | sx_FieldGet( cField, ::cAlias ) } + +STATIC FUNCTION __blockPut( cField ) + + RETURN {| self, xval | iif( xval == nil, , sx_Replace( cField, xval, ::cAlias ) ) } diff --git a/harbour/examples/hbapollo/ttag.prg b/harbour/examples/hbapollo/ttag.prg new file mode 100644 index 0000000000..3cbaef2019 --- /dev/null +++ b/harbour/examples/hbapollo/ttag.prg @@ -0,0 +1,105 @@ +/* + * $Id: ttag.prg 9576 2012-07-17 16:41:57Z andijahja $ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#include "hbclass.ch" + +CLASS TTag + + VAR cIndexFile /* Index File Name */ + VAR aTagName INIT {} /* Index Tag Name */ + VAR aExpression INIT {} /* Index Expression */ + VAR iMode /* iOption: IDX_NONE=0 IDX_UNIQUE=1 IDX_EMPTY=2 */ + VAR lDescending /* BOOL lDescending */ + VAR cCondition /* FOR Condition */ + VAR cAlias + + METHOD New( cIndexFile, atagName, aExpression, iMode, lDescending, cCondition, cAlias ) + METHOD CREATE( lEraseOld ) + METHOD Open() + METHOD CLOSE() + METHOD SetOrder( xOrder ) /* nOrder OR cOrder */ + METHOD TagCount() + METHOD IndexOrd() + +ENDCLASS + +METHOD CLOSE() CLASS TTag + + RETURN sx_indexClose( ::cAlias ) + +METHOD IndexOrd() CLASS TTag + + RETURN SX_INDEXORD( ::cAlias ) + +METHOD SetOrder( xOrder ) CLASS TTag + + RETURN sx_setOrder( xOrder, ::cAlias ) + +METHOD Open() CLASS TTag + + RETURN Sx_IndexOpen( ::cIndexFile, ::cAlias ) + +METHOD TagCount() CLASS TTag + + RETURN sx_TagCount( ::cAlias ) + +METHOD New( cIndexFile, atagName, aExpression, iMode, lDescending, cCondition, cAlias ) CLASS TTag + + ::cIndexFile := cIndexFile /* Index File Name */ + ::aTagName := aTagName /* Index TagName */ + ::aExpression := aExpression /* Index Expression */ + ::iMode := iMode /* iOption: IDX_NONE=0 IDX_UNIQUE=1 IDX_EMPTY=2 */ + ::lDescending := lDescending /* BOOL lDescending */ + ::cCondition := cCondition /* FOR Condition */ + ::cAlias := cAlias /* Alias */ + + RETURN Self + +METHOD CREATE( lEraseOld ) CLASS TTag + + // This is For MULTI TAG Index File : DBFNSX and DBFCDX + // DBFNTX Should Use TIndex + LOCAL i, ul, nResult + + IF lEraseOld == NIL + lEraseOld := .T. + ENDIF + + IF lEraseOld .AND. File( ::cIndexFile ) + FErase( ::cIndexFile ) + ENDIF + + IF ! Empty( ::aTagName ) .AND. ! Empty( ::aExpression ) .AND. ; + ( ul := Len( ::aTagName ) ) == Len( ::aExpression ) + + FOR i := 1 TO ul + nResult := sx_IndexTag( ::cIndexFile, ::aTagName[ i ], ::aExpression[ i ], ::iMode, ::lDescending, ::cCondition, ::cAlias ) + NEXT + + RETURN nResult + + ENDIF + + RETURN 0 diff --git a/harbour/examples/hbapollo/unsix.ch b/harbour/examples/hbapollo/unsix.ch new file mode 100644 index 0000000000..a12cec332e --- /dev/null +++ b/harbour/examples/hbapollo/unsix.ch @@ -0,0 +1,83 @@ +/* + * $Id: unsix.ch 9576 2012-07-17 16:41:57Z andijahja $ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ + +#ifndef __UNSIX__ +#define __UNSIX__ + +#xuntranslate USE [ALIAS <(cAlias)>] [ <(cRDD)>] [VAR ] [<(cOpenMode)>] +#xuntranslate CREATE [VAR ] [ ] [ALIAS ] +#xuntranslate SET DATE +#xuntranslate REPLACE WITH +#xuntranslate INDEX ON TO [ FOR ] [] [] +#xuntranslate Seek() +#xuntranslate Found() + +#xuntranslate SET TRIM +#xuntranslate SET SOFTSEEK +#xuntranslate SET CENTURY +#xuntranslate SET EXACT +#xuntranslate SET DELETED +#xuntranslate SET EPOCH [TO] +#xuntranslate SET LOCK TIMEOUT +#xuntranslate SET [FILE] HANDLE [TO] + +#xuntranslate SKIP [] +#xuntranslate Bof() +#xuntranslate Eof() +#xuntranslate RecCount() +#xuntranslate SetSoftSeek([]) +#xuntranslate RecNo() +#xuntranslate SetDateFormat( ) + +#xuntranslate Alias() +#xuntranslate FCount() +#xuntranslate FieldPut(,) +#xuntranslate FieldGet() +#xuntranslate FieldGetStr() +#xuntranslate FieldGetDtos() +#xuntranslate FieldGetJulian() +#xuntranslate FieldPos() +#xuntranslate FieldName() +#xuntranslate FieldType() +#xuntranslate FieldWidth() +#xuntranslate FieldOffset() +#xuntranslate FieldDecimals() + +#xuncommand APPEND BLANK +#xuncommand GO [TO] +#xuncommand GO TOP +#xuncommand GO TO TOP +#xuncommand GOTOP +#xuncommand GO BOTTOM +#xuncommand GO TO BOTTOM +#xuncommand GOBOTTOM +#xuncommand ZAP +#xuncommand COMMIT +#xuncommand CLOSE ALL +#xuncommand CLOSE DATABASE +#xuncommand CLOSE DATA +#xuncommand PACK + +#endif // end __UNSIX__ diff --git a/harbour/examples/hbapollo/use.c b/harbour/examples/hbapollo/use.c new file mode 100644 index 0000000000..bd8abda15e --- /dev/null +++ b/harbour/examples/hbapollo/use.c @@ -0,0 +1,305 @@ +/* + * $Id: use.c 9576 2012-07-17 16:41:57Z andijahja $ + */ + +/* + * SixAPI Project source code: + * + * Copyright 2010 Andi Jahja + * + * 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/). + */ +#include "sxapi.h" + +static const char * cRDD[] = { "SDENTX", "SDEFOX", "SDENSX", "SDENSX_DBT" }; +static const char * aDescription[] = +{ + "WORKAREA (INTEGER)", "FILENAME (STRING)", "ALIAS (STRING)", + "SHARED (HB_BOOL)", "READONLY (HB_BOOL)", "RDE TYTE (INTEGER)", + "OPEN MODE (INTEGER)", "RDE TYPE (STRING)", "COMMIT LEVEL (INTEGER)", + "RECSIZE (INTEGER)", "FIELD COUNT (INTEGER)", "DBF STRUCTURE (ARRAY)" +}; + +static void _sx_UseGlobalInfo( SX_DBOPENINFO OpenInfo ) +{ + PHB_ITEM pData = hb_itemNew( NULL ); + PHB_ITEM pItem = hb_itemNew( NULL ); + + hb_arrayNew( pItem, 12 ); /* Elements of SX_DBOPENINFO */ + hb_arraySet( pItem, 1, hb_itemPutNI( pData, OpenInfo.uiArea ) ); + hb_arraySet( pItem, 2, hb_itemPutC( pData, OpenInfo.cFilename ) ); + hb_arraySet( pItem, 3, hb_itemPutC( pData, OpenInfo.cAlias ) ); + hb_arraySet( pItem, 4, hb_itemPutL( pData, OpenInfo.fShared ) ); + hb_arraySet( pItem, 5, hb_itemPutL( pData, OpenInfo.fReadonly ) ); + hb_arraySet( pItem, 6, hb_itemPutNI( pData, OpenInfo.iRDEType ) ); + hb_arraySet( pItem, 7, hb_itemPutNI( pData, OpenInfo.iMode ) ); + hb_arraySet( pItem, 8, hb_itemPutC( pData, OpenInfo.cRDD ) ); + hb_arraySet( pItem, 9, hb_itemPutNI( pData, OpenInfo.iCommitLevel ) ); + hb_arraySet( pItem, 10, hb_itemPutNI( pData, OpenInfo.iRecSize ) ); + hb_arraySet( pItem, 11, hb_itemPutNI( pData, OpenInfo.iFieldCount ) ); + hb_arraySet( pItem, 12, OpenInfo.aFieldInfo ); + hb_arrayAdd( Opened_DBF_Property, pItem ); + + hb_itemRelease( pData ); + hb_itemRelease( pItem ); +} + +void _sx_SetDBFInfo( int iOpenedArea, const char * szAlias, int iOpenMode, + int iRDEType ) +{ + SX_DBOPENINFO OpenInfo; + PHB_ITEM pStruct = _sx_DbStruct(); + + OpenInfo.uiArea = ( HB_USHORT ) iOpenedArea; + OpenInfo.cFilename = ( char * ) sx_BaseName(); + OpenInfo.cAlias = szAlias; + OpenInfo.fShared = ( ( iOpenMode == 0 ) ? HB_TRUE : HB_FALSE ); + OpenInfo.fReadonly = ( ( iOpenMode == READONLY ) ? HB_TRUE : HB_FALSE ); + OpenInfo.iRDEType = ( HB_USHORT ) iRDEType; + OpenInfo.iMode = ( HB_USHORT ) iOpenMode; + OpenInfo.cRDD = cRDD[ iRDEType - 1 ]; + OpenInfo.iCommitLevel = ( HB_USHORT ) sx_GetCommitLevel( ( WORD ) iOpenedArea ); + OpenInfo.iRecSize = ( HB_USHORT ) sx_RecSize(); + OpenInfo.iFieldCount = sx_FieldCount(); + OpenInfo.aFieldInfo = hb_itemNew( NULL ); + hb_itemCopy( OpenInfo.aFieldInfo, pStruct /* _sx_DbStruct() */ ); + _sx_UseGlobalInfo( OpenInfo ); + hb_itemRelease( OpenInfo.aFieldInfo ); + hb_itemRelease( pStruct ); +} + +HB_FUNC( SX_USE ) +{ + if( HB_ISCHAR( 1 ) ) + { + PBYTE szDBFFileName = ( PBYTE ) _sx_CheckFileExt( hb_parc( 1 ) ); + + if( hb_fsFileExists( ( const char * ) szDBFFileName ) ) + { + char * szAlias = NULL; + HB_BOOL bIsAlloc; + int iRDEType; + int iOpenMode; + int iOpenedArea; + + /* Alias Passed? */ + if( HB_ISCHAR( 2 ) ) + { + szAlias = ( char * ) hb_parc( 2 ); + bIsAlloc = ( strlen( szAlias ) == 0 ); + } + else + bIsAlloc = HB_TRUE; + + if( bIsAlloc ) + { + szAlias = _sx_AutoAlias( hb_parc( 1 ) ); + hb_storc( szAlias, 2 ); + } + + /* Open Mode Passed? */ + if( HB_ISCHAR( 3 ) ) + iOpenMode = _sx_CheckOpenMode( hb_parc( 3 ) ); + else if( HB_ISNUM( 3 ) ) + iOpenMode = hb_parni( 3 ); + else + iOpenMode = READWRITE; + + /* RDE Type Passed? */ + iRDEType = HB_ISCHAR( 4 ) ? _sx_CheckRDD( hb_parc( 4 ) ) : i_sxApi_RDD_Default; + + if( HB_ISNUM( 5 ) ) + { + UINT iCommitLevel = hb_parni( 5 ); + + if( iCommitLevel > 2 ) + iCommitLevel = 2; + + iOpenedArea = sx_UseEx( szDBFFileName, ( PBYTE ) szAlias, ( WORD ) iOpenMode, + ( WORD ) iRDEType, ( WORD ) iCommitLevel ); + } + else + { + iOpenedArea = sx_Use( szDBFFileName, ( PBYTE ) szAlias, ( WORD ) iOpenMode, + ( WORD ) iRDEType ); + } + + hb_retni( iOpenedArea ); + + if( iOpenedArea > 0 ) + _sx_SetDBFInfo( iOpenedArea, szAlias, iOpenMode, iRDEType ); + + if( bIsAlloc ) + hb_xfree( szAlias ); + } + else + hb_errRT_BASE( EG_OPEN, 2020, NULL, "SX_USE", 1, hb_paramError( 1 ) ); + } + else + hb_errRT_BASE( EG_ARG, 2020, NULL, "SX_USE", 1, hb_paramError( 1 ) ); +} + +HB_FUNC( SX_DBINFO ) +{ + if( Opened_DBF_Property ) + { + if( HB_ISCHAR( 1 ) || HB_ISNUM( 1 ) ) + { + PHB_ITEM aSingleInfo = hb_itemNew( NULL ); + char * szAlias = HB_ISCHAR( 1 ) ? ( char * ) hb_parc( 1 ) : ( char * ) sx_Alias( ( WORD ) hb_parni( 1 ) ); + HB_ISIZ iLen = strlen( szAlias ) + 1; + + hb_arrayNew( aSingleInfo, 0 ); + + /* printf("Here....?\n"); */ + if( iLen > 1 ) + { + HB_USHORT ui; + char * szTmp = ( char * ) hb_xgrab( iLen ); + + hb_snprintf( szTmp, iLen, "%s", szAlias ); + szTmp = _sx_upper( szTmp ); + + for( ui = 0; ui < (HB_USHORT) hb_arrayLen( Opened_DBF_Property ); + ui++ ) + { + HB_BOOL bFound = HB_FALSE; + PHB_ITEM pInfo = hb_arrayGetItemPtr( Opened_DBF_Property, ui + 1 ); + const char * cAliasInfo = hb_arrayGetCPtr( pInfo, 3 ); + + if( cAliasInfo ) + { + if( strcmp( szTmp, cAliasInfo ) == 0 ) + { + hb_arrayAdd( aSingleInfo, pInfo ); + bFound = HB_TRUE; + } + + if( bFound ) + break; + } + } + + hb_xfree( szTmp ); + } + + hb_itemReturnRelease( aSingleInfo ); + } + else + { + if( HB_ISLOG( 2 ) && hb_parl( 2 ) ) + { + /* Complete Info With Description */ + ULONG i; + PHB_ITEM pInfo = NULL; + + hb_arrayCloneTo( pInfo, Opened_DBF_Property ); + + for( i = 0; i < hb_arrayLen( pInfo ); i++ ) + { + PHB_ITEM aDesc = hb_arrayGetItemPtr( pInfo, i + 1 ); + ULONG j; + HB_BOOL bNotArray = HB_FALSE; + + for( j = 0; j < hb_arrayLen( aDesc ); j++ ) + { + PHB_ITEM pData = hb_itemNew( NULL ); + char * szDesc = ( char * ) hb_xgrab( 256 ); + + if( hb_arrayGetType( aDesc, j + 1 ) & HB_IT_STRING ) + { + char * szStr = hb_arrayGetC( aDesc, j + 1 ); + hb_snprintf( szDesc, 255, "%s=%s", aDescription[ j ], szStr ); + hb_xfree( szStr ); + } + else if( hb_arrayGetType( aDesc, j + 1 ) & HB_IT_NUMERIC ) + hb_snprintf( szDesc, 255, "%s=%i", aDescription[ j ], + hb_arrayGetNI( aDesc, j + 1 ) ); + else if( hb_arrayGetType( aDesc, j + 1 ) & HB_IT_LOGICAL ) + hb_snprintf( szDesc, 255, "%s=%s", aDescription[ j ], + hb_arrayGetL( aDesc, j + 1 ) ? ".T." : ".F." ); + else if( hb_arrayGetType( aDesc, j + 1 ) & HB_IT_ARRAY ) + { + PHB_ITEM aField = hb_arrayGetItemPtr( aDesc, j + 1 ); + ULONG u; + + bNotArray = HB_TRUE; + + for( u = 0; u < hb_arrayLen( aField ); u++ ) + { + PHB_ITEM _pF = hb_arrayGetItemPtr( aField, u + 1 ); + char * szField = ( char * ) hb_xgrab( 256 ); + char * FName = hb_arrayGetC( _pF, 1 ); + char * FType = hb_arrayGetC( _pF, 2 ); + int FSize = ( int ) hb_arrayGetNI( _pF, 3 ); + int FDec = ( int ) hb_arrayGetNI( _pF, 4 ); + PHB_ITEM pField = hb_itemNew( NULL ); + + hb_snprintf( szField, 255, "{\"%s\", \"%s\", %i, %i}", + FName, FType, FSize, FDec ); + hb_arraySet( aField, u + 1, hb_itemPutC( pField, szField ) ); + hb_xfree( szField ); + hb_xfree( FName ); + hb_xfree( FType ); + hb_itemRelease( pField ); + } + } /* hb_arrayGetType( aDesc, j + 1 ) & HB_IT_ARRAY */ + + if( ! bNotArray ) + hb_arraySet( aDesc, j + 1, hb_itemPutC( pData, szDesc ) ); + + hb_xfree( szDesc ); + hb_itemRelease( pData ); + } /* for ( j = 0; j < hb_arrayLen( aDesc ); j++ ) */ + } /* for ( i = 0; i< hb_arrayLen( pInfo ); i++ ) */ + + hb_itemReturnRelease( pInfo ); + } /* (HB_ISLOG(2) && hb_parl(2) ) */ + else + { + hb_itemReturn( Opened_DBF_Property ); + } + } + } +} + +HB_BOOL _sx_Used( void ) +{ + return Opened_DBF_Property ? hb_arrayLen( Opened_DBF_Property ) > 0 : HB_FALSE; +} + +HB_FUNC( SX_USED ) +{ + hb_retl( Opened_DBF_Property ? hb_arrayLen( Opened_DBF_Property ) > 0 : HB_FALSE ); +} + +int _sx_CheckOpenMode( const char * sSetDefault ) +{ + const char * sxOpenMode[] = { "READWRITE", "READONLY", "EXCLUSIVE" }; + int ui; + int iOpenMode = READWRITE; + + for( ui = 0; ui < 3; ui++ ) + { + if( strcmp( sxOpenMode[ ui ], sSetDefault ) == 0 ) + { + iOpenMode = ui; + break; + } + } + + return iOpenMode; +}