diff --git a/harbour/source/rdd/usrrdd/example/exarr.prg b/harbour/source/rdd/usrrdd/example/exarr.prg new file mode 100644 index 0000000000..defafbd265 --- /dev/null +++ b/harbour/source/rdd/usrrdd/example/exarr.prg @@ -0,0 +1,144 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * ARRAY RDD example + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +REQUEST ARRAYRDD + +// Actually: 20090126 doesn't work +//#define USE_DBCREATE_EXTENSIONS + +PROCEDURE MAIN() + LOCAL aStruct + + SET DATE TO ITALIAN + SET CENTURY ON + SET DELETED OFF + CLEAR SCREEN + + ? "Create a new dbf in memory using dbCreate() command" + aStruct := { ; + { "NAME" , "C", 40, 0 } ,; + { "ADDRESS" , "C", 40, 0 } ,; + { "BIRTHDAY" , "D", 8, 0 } ,; + { "AGE" , "N", 3, 0 } ; + } + +#ifndef USE_DBCREATE_EXTENSIONS + ? "Create it" + dbCreate( "arrtest.dbf", aStruct, "ARRAYRDD" ) + ? "Open it" + USE arrtest.dbf VIA "ARRAYRDD" +#else + ? "Create it and leave opened" + dbCreate( "arrtest.dbf", aStruct, "ARRAYRDD", .T., "arrtest" ) +#endif + + ? "Show structure" + ? hb_ValToExp( dbStruct() ) + WAIT + + ? "ALIAS", ALIAS(), "RECNO", RECNO(), ; + "BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC() + ? RECNO(), '"' + FIELD->NAME + '"' + DBGOBOTTOM() + ? RECNO(), '"' + FIELD->NAME + '"' + DBGOTOP() + ? RECNO(), '"' + FIELD->NAME + '"' + WAIT + + ? "Adding some data" + dbAppend() + field->name := "Giudice Francesco Saverio" + field->address := "Main Street 10" + field->birthday := CToD( "03/01/1967" ) + field->age := 39 + + ? RECNO(), '"' + FIELD->NAME + '"' + + dbAppend() + field->name := "Mouse Mickey" + field->address := "Main Street 20" + field->birthday := CToD( "01/01/1940" ) + field->age := 66 + + WHILE !EOF() + ? RECNO(), '"' + FIELD->NAME + '"' + IF RECNO()==20 + INKEY(0) + ENDIF + DBSKIP() + ENDDO + ? "ALIAS", ALIAS(), "RECNO", RECNO(), ; + "BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC() + WAIT + DBGOBOTTOM() + ? "ALIAS", ALIAS(), "RECNO", RECNO(), ; + "BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC() + WAIT + WHILE !BOF() + ? RECNO(), '[' + FIELD->NAME + ']' + IF RECNO()==LASTREC()-20 + INKEY(0) + ENDIF + DBSKIP(-1) + ENDDO + ? "ALIAS", ALIAS(), "RECNO", RECNO(), ; + "BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC() + WAIT + + ? "Show it - Please don't press any key except movement keys and ESC" + ? " to exit from browse(), otherwise you will get an error" + ? " due to missing index support" + WAIT + BROWSE() + +RETURN + diff --git a/harbour/source/rdd/usrrdd/example/hbmk_b32.bat b/harbour/source/rdd/usrrdd/example/hbmk_b32.bat new file mode 100644 index 0000000000..0fbde07d75 --- /dev/null +++ b/harbour/source/rdd/usrrdd/example/hbmk_b32.bat @@ -0,0 +1,15 @@ +@echo off +rem +rem $Id$ +rem + +if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\..\bin +if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\..\lib +if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\..\include + +set HB_ARCHITECTURE=w32 +set HB_COMPILER=bcc32 +set HB_USER_LIBS=hbuddall.lib hbusrrdd.lib xhb.lib +rem set PRG_USR=-p + +call %HB_BIN_INSTALL%\hbmk.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 \ No newline at end of file diff --git a/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg b/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg index 13f1e9faa5..41a2befe69 100644 --- a/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg +++ b/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg @@ -203,6 +203,8 @@ STATIC FUNCTION AR_CREATE( nWA, aOpenInfo ) LOCAL cName LOCAL cFullName, aDBFData + //hb_ToOutDebug( "AR_CREATE(): aOpenInfo = %s\n\r", hb_ValToExp( aOpenInfo ) ) + /* getting database infos from current workarea */ aDBFData := aWAData[ WADATA_DATABASE ] @@ -266,6 +268,8 @@ STATIC FUNCTION AR_OPEN( nWA, aOpenInfo ) LOCAL cFullName, cName, hRDDData, aWAData, aDBFData LOCAL aStruct, oError, aFieldStruct, aField, nResult + //hb_ToOutDebug( "AR_OPEN(): aOpenInfo = %s\n\r", hb_ValToExp( aOpenInfo ) ) + cFullName := Upper( aOpenInfo[ UR_OI_NAME ] ) /* When there is no ALIAS we will create new one using file name */ @@ -279,7 +283,7 @@ STATIC FUNCTION AR_OPEN( nWA, aOpenInfo ) hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) - IF cFullName $ hRDDData:Keys + IF HB_HHasKey( hRDDData, cFullName ) aDBFData := hRDDData[ cFullName ] aStruct := aDBFData[ DATABASE_STRUCT ] @@ -639,7 +643,7 @@ STATIC FUNCTION AR_DELETE( nWA ) ENDIF - IF aOpenInfo[ UR_OI_SHARED ] .AND. !( aWAData[ WADATA_RECNO ] $ aWAData[ WADATA_LOCKS ] ) + IF aOpenInfo[ UR_OI_SHARED ] .AND. !( aScan( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) > 0 ) oError := ErrorNew() oError:GenCode := EG_UNLOCKED @@ -879,7 +883,7 @@ FUNCTION hb_EraseArrayRdd( cFullName ) IF ISCHARACTER( cFullName ) cFullName := Upper( cFullName ) // First search if memory dbf exists - IF cFullName $ hRDDData:Keys + IF HB_HHasKey( hRDDData, cFullName ) // Get ARRAY data aDBFData := hRDDData[ cFullName ] @@ -971,7 +975,7 @@ FUNCTION hb_FileArrayRdd( cFullName ) IF ISCHARACTER( cFullName ) cFullName := Upper( cFullName ) // First search if memory dbf exists - IF cFullName $ hRDDData:Keys + IF HB_HHasKey( hRDDData, cFullName ) nReturn := SUCCESS