2009-01-26 16:47 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)

* harbour/source/rdd/usrrdd/rdds/arrayrdd.prg
    * fixed harbour version without using hbcompat.ch
      ; TODO: USRRDD not supports dbCreate() extension params
  + harbour/source/rdd/usrrdd/example/exarr.prg
    + ARRAYRDD example
  + harbour/source/rdd/usrrdd/example/hbmk_b32.bat
    + BCC make file

harbour/source/rdd/usrrdd/example/exarr.prg

@@ -0,0 +1,144 @@
+/*
+ * $Id$
+ */
+
+/*
+ * Harbour Project source code:
+ *    ARRAY RDD example
+ *
+ * Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice / dot / com>
+ * 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
+

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

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