ADO RDD xHarbour

[Antonio Linares]

Antonio,

My suggestion is to test it, as much as possible, by you and other users. Its the only way to know if it will work fine.

Regarding the failure, you should raise an error object. Please review arrayrdd.prg for an example

[cnavarro]

In case you may be interested
Two functions ADO to FWH
- Clear Table
- Mostras database tables (other than those included in FW AdoFuncs)


Por si puede interesar
Dos funciones ADO para FWH
- Borrar tabla
- Mostras tablas de base de datos ( distinta a la incluida en FW AdoFuncs )

viewtopic.php?f=19&t=27296&p=164348&hilit=empezando+con+ado#p164348

[AHF]

Antonio,

When we use select() what function does it call in rdd?

Thanks Cristobal any help is most welcome

[Antonio Linares]

Antonio,

Code: Select all  Expand view  RUN

/*
 * Select a WorkArea by the number.
 */
HB_ERRCODE hb_rddSelectWorkAreaNumber( int iArea )
{
   PHB_STACKRDD pRddInfo;

   HB_TRACE( HB_TR_DEBUG, ( "hb_rddSelectWorkAreaNumber(%d)", iArea ) );

   pRddInfo = hb_stackRDD();
   if( iArea < 1 || iArea > HB_RDD_MAX_AREA_NUM )
      HB_SET_WA( 0 );
   else
      HB_SET_WA( ( HB_AREANO ) iArea );

   return ( pRddInfo->pCurrArea == NULL ) ? HB_FAILURE : HB_SUCCESS;
}

Code: Select all  Expand view  RUN

#define HB_SET_WA( n )  \
   do \
   { \
      pRddInfo->uiCurrArea = n; \
      pRddInfo->pCurrArea  = ( ( pRddInfo->uiCurrArea < pRddInfo->uiWaNumMax ) ? \
                               pRddInfo->waList[ pRddInfo->waNums[ pRddInfo->uiCurrArea ] ] : \
                               NULL ); \
   } while( 0 )

[lucasdebeltran]

Antonio,

Option a) worked.

This is the code for Harbour:

Code: Select all  Expand view  RUN

#ifndef __XHARBOUR__

   #include "fivewin.ch"        // as Harbour does not have TRY / CATCH
   #define UR_FI_FLAGS           6
   #define UR_FI_STEP            7
   #define UR_FI_SIZE            5 // by Lucas for Harbour


#endif
 

Unfortunatelly, xBrowse() does not work.

It needs in ADO_INFO() to have DBI_FULLPATH.

I hacked like this with no luck:

Code: Select all  Expand view  RUN

    CASE uInfoType == DBI_FULLPATH // 10  /* The Full path to the data file      */

             MSGINFO("IN SQL FULL PATH DOES NOT MATTER!", "DBI_FULLPATH ")
             uReturn := ""
 

Now, I get:


Error description: (DOS Error -2147352567) WINOLE/1007 El recordset actual no admite marcadores. Puede deberse a una limitación del proveedor o del tipo de cursor seleccionado. (0x800A0CB3): ADODB.Recordset
Args:
[ 1] = N -1
[ 2] = N 0

Stack Calls
===========
Called from: => TOLEAUTO:MOVE( 0 )
Called from: lucas2.prg => ADO_GOTOID( 524 )
Called from: => DBGOTO( 0 )
Called from: .\source\classes\XBROWSE.PRG => (b)TXBROWSE_SETRDD( 4083 )
Called from: .\source\classes\XBROWSE.PRG => (b)TXBROWSE( 439 )
Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:_BOOKMARK( 0 )
Called from: .\source\function\XBROWSER.PRG => FITSIZES( 283 )
Called from: .\source\function\XBROWSER.PRG => (b)XBROWSE( 220 )
Called from: .\source\classes\DIALOG.PRG => TDIALOG:INITIATE( 700 )
Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT( 890 )
Called from: => DIALOGBOXINDIRECT( 0 )
Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 286 )
Called from: .\source\function\XBROWSER.PRG => XBROWSE( 220 )
Called from: lucas2.prg => MAIN( 44 )

[lucasdebeltran]

In English:

The current recordset does not support bookmarks . It may be due to a limitation of the provider or cursor type selected

[AHF]

Lucas,

#define UR_FI_SIZE 5 // by Lucas for Harbour

xHarbour needs 7 as the len of the array.

You succed to return the fullpath ? Why xbrowse needs fullpath?
Checking if file exists isnt still ready for SQL.

Try use CursorLocation= adUseClient ADO assures bookmarks with this cursor.

I think in a multiuser envirements using absolutepositon does not assure that you will be able to get back to that position for ex a row its deleted the rows are renumbered.

I think we should had in ado_open

if orecordset:supports(adBookmarks)
use servercursor
else
use clientcursor

I will check that later.

What DB are you using?

[AHF]

Antonio,

1) In hbusrdd.ch DBRELINFO what is UR_RI_NEXT for ?

2) What shall we put in ADO_INFO :

DBI_FULLPATH
DBI_TABLEEXT
DBI_FILEHANDLE

[lucasdebeltran]

Hello,

I am using Access for the tests.

We shall ask Mr. Nages about this xBrowse() issue.

Pure Browse() works, but scrolling does not work ok.

Append blank fails.

Thank you

[Antonio Linares]

Antonio,

Code: Select all  Expand view  RUN

static PHB_ITEM hb_usrRelInfoToItem( LPDBRELINFO pRelInfo )
{
   PHB_ITEM pItem;

   pItem = hb_itemArrayNew( UR_RI_SIZE );
   if( pRelInfo->itmCobExpr )
      hb_itemCopy( hb_arrayGetItemPtr( pItem, UR_RI_BEXPR ), pRelInfo->itmCobExpr );
   if( pRelInfo->abKey )
      hb_itemCopy( hb_arrayGetItemPtr( pItem, UR_RI_CEXPR ), pRelInfo->abKey );
   hb_itemPutL( hb_arrayGetItemPtr( pItem, UR_RI_SCOPED ), pRelInfo->isScoped );
   hb_itemPutL( hb_arrayGetItemPtr( pItem, UR_RI_OPTIMIZED ), pRelInfo->isOptimized );
   hb_itemPutNI( hb_arrayGetItemPtr( pItem, UR_RI_PARENT ), pRelInfo->lpaParent ? pRelInfo->lpaParent->uiArea : 0 );
   hb_itemPutNI( hb_arrayGetItemPtr( pItem, UR_RI_CHILD ), pRelInfo->lpaChild ? pRelInfo->lpaChild->uiArea : 0 );
   hb_itemPutPtr( hb_arrayGetItemPtr( pItem, UR_RI_NEXT ), pRelInfo->lpdbriNext );

   return pItem;
}

Code: Select all  Expand view  RUN

/*
 *  DBRELINFO
 *  ---------
 *  The Relationship Info structure
 */

typedef struct _DBRELINFO
{
   PHB_ITEM            itmCobExpr;   /* Block representation of the relational SEEK key */
   PHB_ITEM            abKey;        /* String representation of the relational SEEK key */
   HB_BOOL             isScoped;     /* Is this relation scoped */
   HB_BOOL             isOptimized;  /* Is relation optimized */
   struct _AREA      * lpaParent;    /* The parent of this relation */
   struct _AREA      * lpaChild;     /* The parents children */
   struct _DBRELINFO * lpdbriNext;   /* Next child or parent */
} DBRELINFO;

typedef DBRELINFO * LPDBRELINFO;
 

[Antonio Linares]

Antonio,

2) What shall we put in ADO_INFO :

DBI_FULLPATH
DBI_TABLEEXT
DBI_FILEHANDLE

FileHandle and TableExt I would set nil to them. For FullPath you may use the database path if defined.

[AHF]

Antonio,

struct _DBRELINFO * lpdbriNext; /* Next child or parent */

This always comes empty. Its never used ?

[AHF]

Pure Browse() works, but scrolling does not work ok.

Can you be more precise? Here Browse() works fine.

Append blank fails.

Why? This has nothing that can be a problem. Can you explain what is the problem?
Here works ok.

Code: Select all  Expand view  RUN

STATIC FUNCTION ADO_APPEND( nWA, lUnLockAll )

   LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
   LOCAL aWdata := USRRDD_AREADATA( nWA )
   
   HB_SYMBOL_UNUSED( lUnLockAll )

    oRecordSet:AddNew()
    oRecordSet:Update()
   
    IF !lUnlockAll
        ADO_UNLOCK(nWA)
    ENDIF   
    AADD(aWdata[ WA_LOCKLIST ],oRecordSet:BookMark)

   RETURN HB_SUCCESS

[Antonio Linares]

Code: Select all  Expand view  RUN

HB_FUNC( DBSETRELATION )
{
   AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();

   if( pArea )
   {
      DBRELINFO dbRelations;
      AREAP pChildArea;
      HB_AREANO uiChildArea;
      char * szAlias = NULL;

      if( hb_pcount() < 2 ||
          hb_param( 1, HB_IT_NUMERIC | HB_IT_STRING ) == NULL ||
          ! ( HB_ISNIL( 4 ) || HB_ISLOG( 4 ) ) )
      {
         hb_errRT_DBCMD( EG_ARG, EDBCMD_REL_BADPARAMETER, NULL, HB_ERR_FUNCNAME );
         return;
      }

      if( HB_ISNUM( 1 ) )
      {
         uiChildArea = ( HB_AREANO ) hb_parni( 1 );
      }
      else
      {
         int iArea = hb_rddGetCurrentWorkAreaNumber();

         hb_rddSelectWorkAreaAlias( hb_parcx( 1 ) );
         if( hb_vmRequestQuery() )
            return;
         uiChildArea = ( HB_AREANO ) hb_rddGetCurrentWorkAreaNumber();
         hb_rddSelectWorkAreaNumber( iArea );
      }

      pChildArea = uiChildArea ? ( AREAP ) hb_rddGetWorkAreaPointer( uiChildArea ) : NULL;

      if( ! pChildArea )
      {
         hb_errRT_BASE( EG_NOALIAS, EDBCMD_NOALIAS, NULL, szAlias, 0 );
         return;
      }

      dbRelations.itmCobExpr = hb_itemNew( hb_param( 2, HB_IT_BLOCK ) );
      dbRelations.abKey = hb_itemNew( hb_param( 3, HB_IT_STRING ) );
      dbRelations.isScoped = hb_parl( 4 );
      dbRelations.isOptimized = HB_FALSE;
      dbRelations.lpaChild = pChildArea;
      dbRelations.lpaParent = pArea;
      dbRelations.lpdbriNext = NULL;

      SELF_SETREL( pArea, &dbRelations );
   }
   else
      hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, HB_ERR_FUNCNAME );
}

[Antonio Linares]

Code: Select all  Expand view  RUN

static void hb_sxRollBackChild( AREAP pArea, PHB_ITEM pItem )
{
   LPDBRELINFO lpdbRelation = pArea->lpdbRelations;

   while( lpdbRelation )
   {
      if( SELF_INFO( lpdbRelation->lpaChild, DBI_ROLLBACK, pItem ) != HB_SUCCESS )
         break;
      hb_sxRollBackChild( lpdbRelation->lpaChild, pItem );
      lpdbRelation = lpdbRelation->lpdbriNext;
   }
}