Create a file with a stored procedure in Advantage Database

[Massimo Linossi]

[Antonio Linares]

We can not use that.

I found the docs for it:
https://books.google.es/books?id=vvh8DjXFaBEC&pg=PA207&lpg=PA207&dq=%22Get10Percent%22&source=bl&ots=R2T5BnxFNk&sig=eSEbePqwv1pz11zJLy_HfrA9xVk&hl=es&sa=X&ved=0ahUKEwj048vM787RAhVGtRQKHfkgDu8Q6AEIJDAB#v=onepage&q=%22Get10Percent%22&f=false

Please review it

[Massimo Linossi]

I'll give it a look.
Thanks a lot.
Massimo

[reinaldocrespo]

Hi Massimo;

The SQL statement you are trying to execute can be **and** looks more like a trigger. I don't see the need to use c or any other language to create or execute this SQL procedure. It can be done via Harbour. You could, for example, have a trigger to create a table or add a new record to a table anytime certain database operation happens. That's a simple way to implement notifications between workstations which seems is what you are looking for. It would be interesting to see exactly what the problem is as there might be no need to inform other workstations but let the trigger take care of whatever task is needed.

However, going back to the original statement of the problem; I think you are trying to communicate to another workstation when an event has occurred. Perhaps you know, but I'd like to say that ADS already has an event notification mechanism that allows an action at the server to proactively notify clients that an event they are interested in has occurred. Use the canned stored procedure sp_SignalEvent() inside a trigger. Using this stored procedure can only done from a stored procedures or a trigger. You can create as many events to be notified as you want. There is no limit.

Here is the source to a trigger that signals an event:

Code: Select all  Expand view

CREATE TRIGGER [UpdatePatient] ON PATIENTS
AFTER UPDATE
BEGIN
   //pass the record number to the listening workstation
   EXECUTE PROCEDURE sp_SignalEvent( 'Patient_has_been_updated', false, 0, ::stmt.TriggerRowId );
END;
 

Parameters:
1. event name
2. wait until transaction has been completed
3. not implemented
4. event data is passed as a string

::stmt.TriggerRowId is a special variable that exists inside all triggers and contains the record number affected by the trigger.

sp_SignalEvent procedure receives a parameter that controls whether or not the event is signaled immediately if in a transaction or if it is signaled when the transaction is committed. That is parameter #2 above. If you are not using or don't know what transactions are, then just send false.

The data option allows you to send a data string to the receiving client/workstation running an ADS enabled application. The string could be a long XML string. Most likely you would use this string to send something like a record number to the receiving client. You also need to know that the data being sent is stored unencrypted and therefore you shouldn't send sensitive data.

The best way to receive notifications at the workstation is to execute the sp_WaitForEvent() stored procedure from the client on an endless loop but on a separate thread. sp_WaitForEvent() returns immediately informing if the event has occurred. However, it is also possible to have the workstation execute sp_WaitForEvent() using a FW timer. I had problems implementing threads from xharbour and ended up using a FW timer. I currently use notifications to inform another fw application that shows realtime graphs and totals that it needs to recalculate as something has happened that changes the totals being shown.

Code: Select all  Expand view

EXECUTE PROCEDURE sp_WaitForEvent( 'patient_has_been_updated', 2000, 0, 0 );
 

Parameters:
1. event name you are interested on.
2. timeout in milliseconds
3. pollinterval -like a fw timer -only makes sense from a separate thread
4. options

The procedure returns:
1. Name of event that was signaled. They only implemented this for compatibility with other similar stored procedures.
2. an integer value that indicates how many times the event was signaled. A value of 0 means that it timed out (the event did not happen)
3. String data. Data sent from the sp_signalEvent procedure.

Here is some FW code that shows how to listen to an event being broadcast by the server when something happens:

Code: Select all  Expand view

   //oEventQuery will create EncChrgsUpdate event for later listenting

   ::oEventQuery := TAdsQuery():New()
   ::oEventQuery:cSql := "EXECUTE PROCEDURE sp_CreateEvent( 'CaseUpdate', 2 );"
   ::oEventQuery:Run()

   //Afer sp_CreateEvent, reuse oEventQuery.  sp_WaitForEvent will run on the
   //background updating xbrowse and graph in realtime every time the server
   //issues a notification alerting us that the data being watched has
   //changed and how.  Event notification return a 3 column cursor.  Column 1 is
   //the EventName, in this case it is always CaseUpdate since this is the only
   //event we are listenting for.  Column 2 is the sequence number of the event.
   //Column 3 is a string containing the record number in Pathlgs that changed.
   //xharbour background code execution.  A FW timer probably works better.

   ::oEventQuery:cSql := "EXECUTE PROCEDURE sp_WaitForEvent( 'CaseUpdate', 0, 0, 0 );"
   ::nIdle := hb_IdleAdd( {|| hb_BackGroundRun() } )
   ::hTask := hb_BackGroundAdd( {|| ::ListenForMyEventOnBckgrnd() }, _WAIT, .T. )

 

Now some code to inform the server that no longer needs to broadcast messages to this application:

Code: Select all  Expand view

  ::bEnd := { || ;//drop listening subscription
      ::oEventQuery:cSql := "EXECUTE PROCEDURE sp_DropEvent( 'CaseUpdate', 0 ) ",;
      ::oEventQuery:Run(),;
      ;//delete background tasks
      hb_BackGroundDel( ::hTask ),;
      hb_IdleDel( ::nIdle ),;
      ::oEventQuery:End() }
 

I think this is what you are looking for.


Reinaldo.

[Massimo Linossi]

Hi Reinaldo.
Thanks for your info, I'll try to make something as you suggested.
The only problem is that I don't have your class TadsQuery. Where can I find it ?
Thanks a lot.
Massimo

[reinaldocrespo]

Massimo/Everyone;

You don't need the class to execute SQL statements with ADS. You could simply use ACE API functions. To execute a sql statement using the API simply call function AdsExecuteSqlDirect( cSql ), where cSql is a string parameter with the sql you want to execute.

The class itself is only a wrapper to ease the use of ACE API. If you think you'd do better with my class, I provide the source code here. The class also uses another class I call xDBF. xDBF is just another Tdata or TDatabase class and I'm sure you can substitute it for any you are using. I provide source code for both classes:

Code: Select all  Expand view

//Author: Reinaldo Crespo-Bazán
//reinaldo.crespo@gmail.com
//
//Class AdsQuery is made public with the hope that others may contribute and benefit from
//better/easier access model to ADS SQLs from (x)Harbour compilers.  10/29/2015 3:49:04 PM
//
//Class xDbf is a simple Tdata style class to manage sql returning cursors as a data object.




#ifdef __HARBOUR__
   #include "hbclass.ch"
#else
   #include "objects.ch"
#endif

#include "ads.ch"
#include "dbstruct.ch"
#include "fileio.ch"
#include "set.ch"
#include "ord.ch"
#include "error.ch"


#define CRLF Chr(13)+Chr(10)

#xcommand DEFAULT <uVar1> := <uVal1> ;
                [, <uVarN> := <uValN> ] => ;
                  <uVar1> := iif( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
                [ <uVarN> := iif( <uVarN> == nil, <uValN>, <uVarN> ); ]


#define COMPILE(cExpr) &("{||" + cExpr + "}")

#translate nTrim(<n>)   => AllTrim(Str(<n>))



static aDbfOpen   := {}
static afiles     := {}
static nErr       := 0
static cErr       := ""

//Static aUsedworkAreas := {}
//------------------------------------------------------------------
CLASS ADSQuery

   DATA bProgress    //optional code block to execute anytime ACE API functions can show progress.
   DATA bOnError     //optional code block to execute anytime there ACE returs some error.

   DATA aSubstitutes AS ARRAY INIT {}     //array of substitute strings that make up ::cSQL data.
                                          //::cSQL string to be executed can include $n$ as codes to be
                                          //substituted before it is executed with the contents of this array.
   DATA aFieldsInfo  AS ARRAY INIT {}     //array with column information for returned cursor.
   DATA aResultSet   AS ARRAY INIT {}     //array with contents of returned cursor.

   DATA Cargo                             //Generic data for multi-use.
   DATA cSql         AS CHARACTER INIT '' //actual SQL statement to be executed.
   DATA cAlias       AS CHARACTER         //alias for returned cursor after ::cSQL is executed.
   DATA cLastERR     AS CHARACTER INIT '' //Error text from last operation
   DATA cProgressMsg AS CHARACTER INIT "Working..." //defualt message to show when ::bProgress is not null

   DATA hAdsConnection                    //handle to ADS connection
   DATA hStatement                        //handle to SQL statement
   DATA hTask                             //handle to background task should the statment be executed on the background
                                          // -nor implemented for now.
   
   DATA lCursor      AS LOGICAL INIT .F.  //if .T. then a cursor is retured after executing ::cSQL otherwise an aResultSet
                                          //is loaded with cursor information before cursor is destroyed.
   DATA lArray       AS LOGICAL INIT .T.  //lCursor may be .T. as well as ::lArray in which case ::cSQL statament will return
                                          //a cursor ::cAlias as well as the contents are loaded into ::aResultSet
   DATA lDebug       AS LOGICAL INIT .F.  //when .t. "SqlTrace.log" will contain the formated and substituted ::cSql executed.
   DATA lShowErrors  AS LOGICAL INIT .T.  //when .f. all errors are suppressed and not displayed.
   DATA lshowProgress AS LOGICAL INIT .F. //when .t. and ::bProgress is not null then it gets used as progress indicator
                                          //when .t. and ::bProgress is null then a generic progress bar is created.
   DATA lRunOnBckGrnd AS LOGICAL INIT .F. //when .t. ::cSql is executed on a background thread. --not implemented for now.
   DATA lWasCanceled AS LOGICAL INIT .F.  //if sql statament is interrupted/canceled then this becomes .t.

   DATA nRow      AS NUMERIC INIT 0
   DATA nRows     AS NUMERIC INIT 0       //total rows returned by statment
   DATA nLastErr  AS NUMERIC INIT 0       //last error number returned by ACE
   DATA nTblType  AS NUMERIC INIT ADS_ADT
   DATA nAffected AS NUMERIC INIT 0
   DATA nIdle

   DATA oDbf                              //Treat ::cAlias returned cursor as a data object.  
   

   METHOD New() INLINE SELF
   METHOD ExecuteAdsSqlScript( cSql )
   METHOD CloseCursor()
   METHOD End()
   METHOD Run()
   
   METHOD SqlAffectedRecords() INLINE AdsGetRecordCount( ::hStatement )
   METHOD RunDirect( cSql, aSubstitutes )
   METHOD RunToArray()
    METHOD LogLastError( isGood, cMsg, cSql )

   METHOD AdsPrepareSQL()
    METHOD RunAdsPreparedSql()
   METHOD SetParameters()

   METHOD FieldType( n )               //returns the field type for column n
   METHOD Field( n, xValue ) INLINE IF( xValue != NIL, ::FieldPut( n, xValue ), ::FieldGet( n ) )
   METHOD FieldGet( n ) INLINE (::cAlias)->( FieldGet( n ) )
   METHOD FieldPos( cFld ) INLINE (::cAlias)->( FieldPos( cFld ) )
   METHOD FieldPut( n, xValue )
   
   METHOD GetCursorContents( cScript )

   METHOD CreateoDbf()
   METHOD CreateIndexBag( cField )

END CLASS



//------------------------------------------------------------------
//Method AdsPrepareSQL sets up the sql statement so that is may executed
//as a prepared sql (see ACE documentations for details on a prepared sql)
//as opposed to direct sql execution.
//
METHOD AdsPrepareSQL( cSql ) CLASS ADSQuery
    LOCAL isGood := .F.

   DEFAULT ::cAlias := ValidAlias( "SqlArea" )
   DEFAULT cSql := ::cSql

   //function Format_Statement_Using_Substitutes being used below only
   //substitutes $n$ for contents on array ::aSubstitutes to form the
   //actual sql sentence to be be executed in a more readable friendly format.
   //for example when ::cSql is:  
   //    SELECT custNo, CustName \n
   //      FROM customers \n
   //     WHERE custNo = '$1$' \n
   //
   //and ::aSubstitutes contains { "C00001" } the method below makes sure the
   //sql being set for execution is as shown below without actually changing the original
   //contents of ::cSQL.  That allows for ::cSql to be used subsequently if necessary.
   //
   //    SELECT custNo, CustName
   //      FROM customers
   //     WHERE custNo = 'C00001'
   
   cSql := Format_Statement_Using_Substitutes( cSql, ::aSubstitutes, ::lDebug )

   //let's make sure the ::cAlias isn't already being used.
   IF SELECT( ::cAlias ) > 0 ; ( ::cAlias )-> ( DBCLOSEAREA() ) ;ENDIF

   ::nLastErr := 0    ;::cLastErr := ""

   IF !EMPTY( cSql )

      AdsCacheOpenCursors( 0 )
      DBSELECTAREA(0)

      IF ADSCreateSQLStatement( ::cAlias, ::nTblType, ::hAdsConnection ) //.or. !ADSVerifySQL( cScript )
            isGood := AdsPrepareSQL( cSql )
        ENDIF
       
   ENDIF

    ::LogLastError( isGood, "AdsPrepareSQL", cSql )
   ::hStatement := AdsGetSQLHandle()

RETURN isGood



//------------------------------------------------------------------
METHOD RunAdsPreparedSql( aParms ) CLASS ADSQuery
    LOCAL isGood := .F.
   
    IF aParms != NIL  ;::SetParameters( aParms ) ;ENDIF

    IF ::lShowProgress .AND. ::bProgress == Nil

      Register_CallBack( { | nPercent | EVAL( ::bProgress, nPercent ) } )
      //AdsRegCallBack( { | nPercent | EVAL( ::bProgress, nPercent ) } )

   ENDIF
   
   
   isGood      := AdsExecuteSQL( ::hStatement )
   ::nAffected := ::SqlAffectedRecords()

    IF ::lShowProgress .AND. ::bProgress != Nil
   
        //AdsClrCallBack()
      Unregister_callback()

    ENDIF

    ::LogLastError( isGood, "RunAdsPreparedSql" )

RETURN isGood




//----------------------------------------------------------------------------
//METHOD SetParameters sets parameters for a prepared query.
//Receives a double dimenssioned array.
//each row contains an array of three values
// 1. fieldname to Set as on parameter name on the parametized query
// 2. value to store on fieldname
// 3. type of value I = Integer, C=Character, D=Date, B=binary, N = double
//
// for some basic xbase data types, the 3rd parameter may be omitted
//
METHOD SetParameters( aParms ) CLASS ADSQuery
   LOCAL aParm, cVar, xVal, cType
   
   FOR EACH aParm IN aParms
   
      cVar := aParm[ 1 ]
      xVal := aParm[ 2 ]
      cType:= IIF( LEN( aParm ) > 2, UPPER( aParm[ 3 ] ), UPPER( VALTYPE( xVal ) ) )

      IF ::lDebug ;logfile( "SQLtrace.log", aParm )   ;ENDIF

      DO CASE
     
         CASE cType == "U" .OR. cType == NIL .OR. xVal == NIL
            AdsSetNull( cVar, ::hStatement )

         CASE cType == "C" //Character
            AdsSetString( cVar, xVal, ::hStatement )

         CASE cType == "D" //DateType
            IF xVal != NIL .AND. !EMPTY( xVal );  AdsSetDate( cVar, Date2Sql( xVal ), ::hStatement )
            ELSE ; AdsSetNull( cVar, ::hStatement ) ;ENDIF

         CASE cType == "I" //Integer
            AdsSetLong( cVar, xVal, ::hStatement )
         
         CASE cType == "B" //binary
            AdsSetBinary( cVar, xVal, ::hStatement )
         
         CASE cType == "L" //Logical
            AdsSetLogical( cVar, xVal, ::hStatement )

         CASE cType == "N" //double
            AdsSetDouble( cVar, xVal, ::hStatement )

      END

   NEXT
   
RETURN NIL



//------------------------------------------------------------------
//creates a data object so that the calias may be treated as
//a data object.
METHOD CreateoDbf() CLASS ADSQuery

   IF ::oDbf != NIL  ; ::oDbf:End()    ;ENDIF

   ::oDbf := xDBF():New( ::cAlias )
   ::oDbf:lMessage := .F.
   ::oDbf:cAlias := ::cAlias
   ::oDbf:lOpen := .T.
   ::oDbf:lReadOnly    := .T.

   //::oDbf:lOpen := .T.   ??
   // Save the complete structure
   ::oDbf:aFldsInfo := ( ::oDbf:cAlias )->( DbStruct() )

   // Set Buffer
   ::oDbf:aBuffer := Array( len( ::oDbf:aFldsInfo ) )
   //::oDbf:aModify := Array( len( ::oDbf:aFldsInfo ) )
   ::oDbf:Load()   //load buffers with current record at file pointer

RETURN ::oDbf


//------------------------------------------------------------------
//Creates an index bag on the dbf object crated with method CreateOdbf.
//this methos uses methods from txDbf class.
METHOD CreateIndexBag( cField ) CLASS ADSQuery
   LOCAL aIndxTags := ::oDbf:GetTags()
   
   cField := UPPER( cField )

   IF cField $ aIndxTags

      ::oDbf:OrdSetFocus( cField )

   ELSE

      //METHOD Sort( cExp, lDes, cTagName, lLocal ) creates an index bag
      ::oDbf:Sort( cField,,cField, .F. )

   ENDIF
   
RETURN NIL




//------------------------------------------------------------------
METHOD ExecuteAdsSqlScript( cSql ) CLASS ADSQuery
   LOCAL aStruc, i
   LOCAL nCount := 1
   LOCAL a := {}
   LOCAL xTmp
   LOCAL isGood := .f.

   DEFAULT ::cAlias := ValidAlias( "SqlArea" )
   DEFAULT cSql := ::cSql

   if Select( ::cAlias ) > 0 ; ( ::cAlias )-> ( DBCLOSEAREA() ) ;endif

   ::nLastErr := 0    ;::cLastErr := ""

   if !empty( cSql )

      AdsCacheOpenCursors( 0 )
      DBSELECTAREA(0)

      IF !ADSCreateSQLStatement( ::cAlias, ::nTblType, ::hAdsConnection ) //.or. !ADSVerifySQL( cScript )

         ::nLastErr := ADSGetLastError( @::cLastErr )
         logfile( "SQLError.log", { ::nLastErr, ::cLastErr, cSql } )

         if Select( ::cAlias ) > 0  ;( ::cAlias )-> ( DBCLOSEAREA() ) ;endif

      ELSE

         ::hStatement := AdsGetSQLHandle()

         IF ::lShowProgress .AND. ::bProgress != NIL

            Register_CallBack( { | nPercent | EVAL( ::bProgress, nPercent ) } )
            //AdsRegCallBack( { | nPercent | EVAL( ::bProgress, nPercent ) } )

                TRY 
                isgood := ADSExecuteSQLDirect( cSql )
            CATCH
                isgood := .F.
            END

            Unregister_callback()
            //AdsClrCallBack()

         ELSE
         
            TRY
                isgood := ADSExecuteSQLDirect( cSql )
            CATCH
                isgood := .F.
            END
           
         ENDIF

            ::LogLastError( isGood, "ADSExecuteSQLDirect", cSql )

         IF isgood

            ::nRows      := (::cAlias)->( RecCount() )
            IF ::lCursor   ;RETURN NIL ;ENDIF
           
            ::aResultSet := ::GetCursorContents( cSql )
            ::nRows      := LEN( ::aResultSet )
            ::nAffected  := ::SqlAffectedRecords()

         ENDIF

         //to get here either isgood == .F. or ::lCursor = .F.  either way we need to cleanup.
         AdsCacheOpenCursors( 0 )
         IF SELECT ( ::cAlias ) > 0 ; (::cAlias)->( DBCLOSEAREA() ) ;ENDIF
          AdsCloseSQLStatement()

      ENDIF

   ENDIF

RETURN ::aResultSet      //backward compatability 8/15/2011 4:20:34 PM

//------------------------------------------------------------------
METHOD Run( aSubstitutes ) CLASS ADSQuery
   LOCAL xRet, cSql

   IF ::lCursor == NIL     ;::lCursor := .F.          ;ENDIF
   IF ::lArray == NIL      ;::lArray := !::lCursor    ;ENDIF

   IF !empty( ::cSql )

      IF aSubstitutes != NIL  ;::aSubstitutes := aClone( aSubstitutes );  ENDIF
     
      cSql := Format_Statement_Using_Substitutes( ::cSql, ::aSubstitutes, ::lDebug )

      IF ::lRunOnBckGrnd

         ::nIdle := hb_IdleAdd( {|| hb_BackGroundRun() } )
         ::hTask := hb_BackGroundAdd( {|| ::ExecuteAdsSqlScript( cSql ) }, 0, .T. )

      ELSE

         ::ExecuteAdsSQLScript( cSql )
         
      ENDIF

   ENDIF

RETURN NIL


//------------------------------------------------------------------------------
METHOD RunDirect( cSql, aSubstitutes ) CLASS ADSQuery
   ::cSql        := cSql

RETURN ::Run( aSubstitutes )


//------------------------------------------------------------------------------
METHOD RunToArray() CLASS ADSQuery
   LOCAL lOrg := ::lArray

   ::lArray := .T.
   ::Run()
   ::lArray := lOrg

RETURN ::aResultSet


//------------------------------------------------------------------
METHOD CloseCursor() CLASS ADSQuery

   IF SELECT( ::cAlias ) > 0   ;DBCLOSEAREA( ::cAlias )   ;ENDIF
   //IF SELECT( ::cAlias ) > 0 ; ( ::cAlias )->( dbCloseArea() )      ;ENDIF

RETURN NIL



//------------------------------------------------------------------
//lets just make sure we cleanup.
METHOD End() CLASS ADSQuery

   IF ::hTask != NIL
      hb_BackGroundDel( ::hTask )
      hb_IdleDel( ::nIdle )
   ENDIF
   
   ::aResultSet := NIL
   ::CloseCursor()
   
RETURN NIL



//------------------------------------------------------------------
METHOD FieldType( n ) CLASS ADSQuery

   IF ::nRow == 0      ; ::nRow := 1      ;ENDIF

   IF EMPTY( ::aFieldsInfo   )

      IF ::lArray .AND. !EMPTY( ::aResultSet )

         aEVAL( ::aResultSet[ 1 ], { |e, n| AADD( ::aFieldsInfo, { STRZERO( n, 4 ), ;
                                                VALTYPE( e ),;
                                                LEN( e ), 0 } ) } )
      ELSEIF ::lCursor

         ::aFieldsInfo := ( ::cAlias )->( dbstruct() )

      ENDIF

   ENDIF

   IF n <= LEN( ::aFieldsInfo )
      RETURN ::aFieldsInfo[ n, DBS_TYPE ]
   ENDIF

RETURN ''


//------------------------------------------------------------------
//place xvalue on line ::nrow column n of array or
//place xvalue on row ::nrow of cursor field n
//temporary cursors are read-only so this idea might not go anywhere
//for cursors.
METHOD FieldPut( n, xValue )

   IF ::aResultSet != NIL .AND. ::nRow <= LEN( ::aResultSet ) .AND. n <= LEN( ::aResultSet[ ::nRow ] )
      ::aResultSet[ ::nRow, n ] := xValue
   ENDIF
   
RETURN NIL


//------------------------------------------------------------------
//
//TraceLog( cMsg, ElapTime( cStartTime, cEndTime ) )
METHOD LogLastError( isGood, cMsg, cSql ) CLASS ADSQuery
    LOCAL xRet

    DEFAULT cSql := ::cSql
    DEFAULT isGood := .T.
    DEFAULT cMsg := "SQL Error"
   
    ::nLastErr := ADSGetLastError( @::cLastErr )

    IF !isGood
    logfile( "SQLError.log", { cMsg, ::nLastErr, ::cLastErr, cSql } )
    ENDIF
   
   IF ::nLastErr > 0 .OR. !EMPTY( ::cLastErr )

      IF ::bOnError != NIL
         Eval( ::bOnError, SELF )
      ENDIF

      IF ::lShowErrors

         //remove cryptic [ASA] Error text from ACE error text information
         xRet := SUBSTR( ::cLastErr, At( "[ASA] Error", ::cLastErr ) )
         xRet := SUBSTR( xRet, 13, At( ":", xRet ) -13 )

         IF Val( xRet ) > 0
            ::nLastErr := Val( xRet )
            ::cLastErr := Substr( ::cLastErr, At( "[ASA] ", ::cLastErr ) )
         ENDIF

         Alert( ::cLastErr, "Error :" + HB_ValToStr( ::nLastErr ) )

      ENDIF

   ENDIF

RETURN NIL



//------------------------------------------------------------------------------
//reads a resulting cursor and loads each record as an array element.
//cScript is the actual executed sql statement and it is not necessarely the same
//as ::cSql as it might have been modified after substituting $n$'s
METHOD GetCursorContents( cScript ) CLASS ADSQuery

   LOCAL aStruc, e, nLastRec
   LOCAL i, xTmp
   LOCAL a              := {}
   LOCAL nCount         := 1


   IF SELECT( ::cAlias ) > 0  .AND. ( ::cAlias )->( lastrec() ) > 0

      TRY

         nLastRec := ( ::cAlias )->( lastrec() )
         aStruc   := ( ::cAlias )->( dbStruct() )
         a        := array( nLastRec )

         WHILE !( ::cAlias )->( eof() )

            IF nCount > LEN( a )    
               ( ::cAlias )->( dbSkip() )
               LOOP    
            ENDIF

            a[ nCount ] := ARRAY( LEN( aStruc ) )
            aFILL( a[ nCount ], " " )
           
            IF ::lShowProgress .AND. !EMPTY( ::bProgress )  ;EVAL( ::bProgress, ( nCount / nLastRec ) * 100 )  ;ENDIF

            FOR i := 1 TO LEN( aStruc )

               xTmp := NIL

               TRY

                  xTmp := ( ::cAlias )->( FieldGet( i ) )
                   IF xTmp == Nil      ;xTmp := blank( aStruc[ i, DBS_TYPE ] )   ;Endif

               CATCH e
                  LogError( e, i, cScript )
               END

               a[ nCount, i ]:= xTmp

            NEXT i

            nCount++
            ( ::cAlias )->( dbSkip() )

         END

      CATCH e
         LogError( e, i, cScript )
         a := {}
      END

   ENDIF

   aSIZE( a, nCount-1 )

RETURN a



//------------------------------------------------------------------------------
// This funcion only takes care of string replaces.
// Funcion para formar la sentencia SQL, cada parametro $n$, sera reemplazado
// del array aSubstitutes, si se desea visualizar la formación de la sentencia
// se debe pasar lDebug = .T.
//
FUNCTION Format_Statement_Using_Substitutes( consulta, aParametros, lDebug )
   LOCAL i, busqueda
   DEFAULT lDebug := .F.
   DEFAULT aParametros := {}

   FOR i := 1 TO LEN( aParametros )
      busqueda := "$" + AllTrim( Str( i ) ) + "$"
      consulta := STRTRAN( consulta, busqueda, aParametros[ i ] )
   NEXT

   // reemplazamos los \n por CRLF
   consulta := STRTRAN( consulta, '\n', CRLF )

   IF lDebug
      Logfile( "Sqltrace.log", { consulta } )
   ENDIF

RETURN consulta


//------------------------------------------------------------------------//
//this function will return an unsed cAlias name with the limit of up
//to 99 different aliases are allowed for the same table name.
//
FUNCTION ValidAlias( cAlias )
   LOCAL cRetAlias, nCounter
   LOCAL lContinue := .T.
   LOCAL cOldAlias, cCounter
   LOCAL cNewAlias := PADR( ALLTRIM( LEFT ( cAlias, 8 ) ), 8, "0" )
         //Left( cAlias, 4 ) + HB_ValToStr( hb_randomInt( 0, Val( Replicate( "9", 4 ) ) ) )
   
   nCounter  := 0
   cOldAlias := Alias()

   WHILE nCounter < 100 .AND. lContinue

      cCounter  := ALLTRIM( STR( nCounter++, 2 ) )
      cRetAlias := cNewAlias + cCounter
     
      if Select( alltrim( cRetAlias ) ) == 0
         lContinue := .F.
      endif

   END

   If !empty( cOldAlias )  ;Select( cOldAlias ) ;Endif

RETURN cRetAlias


//---------------------------------------------------------------------------//
Function Date2SqlString( d )

   if empty( d )
      RETURN " /  /    "
   ENDIF

   d := StrZero( Year( d ), 4 ) + "-" + ;
        StrZero( Month( d ), 2 ) + "-" + ;
        StrZero( Day( d ), 2 )


RETURN( d )

//---------------------------------------------------------------------------//
Function Date2Sql( d )

   if empty( d )
      RETURN NIL
   ENDIF

   d := StrZero( Year( d ), 4 ) + "-" + ;
        StrZero( Month( d ), 2 ) + "-" + ;
        StrZero( Day( d ), 2 )


RETURN( d )

//---------------------------------------------------------------------------//
Function Date2SqlDTString( d )
   d := Date2SqlString( d ) + " 00:00:00"
RETURN ( d )


//---------------------------------------------------------------------------//
STATIC FUNCTION LogError( e, i, cScript )

   Logfile( "SQLError.log", { i, cScript, e:SubSystem, ;
                  e:SubCode, ;
                  e:Operation, ;
                  e:Description, ;
                  e:FileName, ;
                  e:moduleName,;
                  e:ProcName,;
                  e:procLine } )
RETURN NIL



//---------------------------------------------------------------------------//
STATIC FUNCTION LogFile( cFileName, aInfo )

   local hFile, cLine := DToC( Date() ) + " " + Time() + ": ", n
   
   if ValType( aInfo ) != "A"
      aInfo = { aInfo }
   endif  

   for n = 1 to Len( aInfo )
      cLine += HB_ValToStr( aInfo[ n ] ) + Chr( 9 )
   next
   cLine += CRLF

   if ! File( cFileName )
      FClose( FCreate( cFileName ) )
   endif

   if( ( hFile := FOpen( cFileName, FO_WRITE ) ) != -1 )
      FSeek( hFile, 0, FS_END )
      FWrite( hFile, cLine, Len( cLine ) )
      FClose( hFile )
   endif

return nil


//---------------------------------------------------------------------------//
Function Blank( xValue )

   do Case
      Case xValue == "C"
         Retur( "" )
      case xValue == "N"
         Retur( 0 )
      case xValue == "D"
         Retur( ctod( "" ) )
   EndCase

Return 0


*-------------------------------------------------------------------------------------------------------
#pragma BEGINDUMP
#include <windows.h>

#include "ace.h"
#include "hbapi.h"
#include "hbvm.h"
#include "hbapiitm.h"

UNSIGNED32 _stdcall ShowPercentage( UNSIGNED16 usPercentDone , UNSIGNED32 ulCallbackID );
UNSIGNED32 _stdcall CancelSql();

static PHB_ITEM pBlock;
static PHB_ITEM pAbortBlock;

//---------------------------------------------------------------------------//
HB_FUNC( REGISTER_SQL_ABORT )
{
   pAbortBlock = hb_itemParam( 1 );
   AdsRegisterSQLAbortFunc( CancelSql );
}

//---------------------------------------------------------------------------//
HB_FUNC( UNREGISTER_SQL_ABORT )
{
   AdsClearCallbackFunction();

   if( pAbortBlock )
   {
      hb_itemRelease( pAbortBlock );
   }
}

//---------------------------------------------------------------------------//
UNSIGNED32 _stdcall CancelSql()
{

   BOOL fResult = 0 ;

   if( pAbortBlock )
   {
      fResult = hb_itemGetL( hb_vmEvalBlockV( pAbortBlock, 1 ) );
   }

   return fResult;
}

//---------------------------------------------------------------------------//
HB_FUNC( REGISTER_CALLBACK )
{
   pBlock = hb_itemParam( 1 );
   hb_retni( AdsRegisterCallbackFunction( ShowPercentage , 1 ) );
}

//---------------------------------------------------------------------------//
HB_FUNC( UNREGISTER_CALLBACK )
{
   AdsClearCallbackFunction();

   if( pBlock )
   {
      hb_itemRelease( pBlock );
   }
}

//---------------------------------------------------------------------------//
UNSIGNED32 _stdcall ShowPercentage( UNSIGNED16 usPercentDone, UNSIGNED32 ulCallbackID )
{
   BOOL fResult = 0 ;
   PHB_ITEM pPercent = hb_itemPutNI( NULL, usPercentDone );

   if( pPercent && pBlock)
   {
      fResult = hb_itemGetL( hb_vmEvalBlockV( pBlock, ulCallbackID /*1*/, pPercent ) );
      hb_itemRelease( pPercent );
   }

   return fResult;
}

#pragma ENDDUMP



/*-------------------------------------------------------------------------------------------------------------------------------
//RCB 12/17/2012 2:01:09 PM
//AdsRegisterCallBackFunction() will work just as AdsRegCallBack() above but it will
//also allow you to cancel execution of an SQL that takes more than 2 seconds
//to complete.  I decided not to replace AdsRegCallBack() above, to avoid breaking
//code that is working but users should note that it is preferable to use
//this function instead.
//
//If the return value of the EVALED codeblock sent to this function is anything other
//than false or zero, then execution of the SQL command will be canceled by the server.
//Here is an idea of how to use it:
//    AdsRegisterCallBackFunction( { |nPercent| oMeter:Update( nPercent ), oMeter:isCancel } )
//
//I choose to keep the same name as the actual ACE function to ease understanding
//what it does.  From ACE documentation:
//Registers a callback function that the Advantage Client Engine can call during
//long operations for the purpose of cancellation of progress updates.  
//AdsRegisterCallBackFunction directecs ACE to call the register function during
//operations that support callback functionality.  A non-zero return value from
//the registered user function will cuse the ACE to signal the current operation
//to abort.  
//Registered callback function should not make any ACE calls.  If it does it is
//possible to get error code 6619. "Communications Layer is busy".
//
//---------------------------------------------------------------------------//
UNSIGNED32 WINAPI ShowPercentage( UNSIGNED16 usPercentDone, UNSIGNED32 ulCallbackID )
{
   BOOL fResult = 0 ;
   PHB_ITEM pPercent = hb_itemPutNI( NULL, usPercentDone );

   if( pPercent && pBlock)
   {
      fResult = hb_itemGetL( hb_vmEvalBlockV( pBlock, 1, pPercent ) );
      hb_itemRelease( pPercent );
   }

   return fResult;
}

//---------------------------------------------------------------------------//
HB_FUNC( ADSREGISTERCALLBACKFUNCTION )
{
   pBlock = hb_itemParam( 1 );
   hb_retni( AdsRegisterCallbackFunction( ShowPercentage , 1 ) );
}

//---------------------------------------------------------------------------//
HB_FUNC( ADSCLEARCALLBACKFUNCTION )
{
   AdsClearCallbackFunction();

   if( pBlock )
   {
      hb_itemRelease( pBlock );
   }
}




STATIC Function NewAlias( cBaseName )
   LOCAL nCounter := 0
   LOCAL cAlias

   cBaseName := Left( AllTrim( cBaseName ), 7 )

   WHILE .T.
      cAlias := cBaseName + HB_ValToStr( nCounter++ )
      IF aScan( aUsedworkAreas, cAlias ) == 0 .OR. nCounter > 999 ;Exit ;ENDIF
   END

   AADD( aUsedworkAreas, cAlias )

RETURN cAlias */


//------------------------------------------------------------------




//------------------------------------------------------------------------------------//
//there are very many tData cases out there.  I pickup a few things here and there
//the purpose here is to be able to treat cursors as data objects.  Class may be
//extended by inheritance.

CLASS xDbf

   DATA aBuffer, aFldsInfo, aState, aUserVars, aScopes, aIdxFile

   DATA cPrimaryKey AS CHARACTER INIT ""
   DATA cFileName, cTableName, cAlias, cRDD, cLogFile, cSortFile, cFileType
   DATA cSortExp HIDDEN

   DATA lShared, lReadOnly, lNew, lMessage, lOpen, lLogErrors
   DATA lSortDesc HIDDEN

   DATA nLockTimeOut
   DATA nCnt AS NUMERIC INIT 1

   DATA oQuery

   DATA Cargo

   METHOD New( cFileName )   CONSTRUCTOR
   METHOD Open()
   METHOD End()
   METHOD Close()

   METHOD AdsSetFileType()
   METHOD AdsSetAof( cFilterCond ) INLINE ( ::oDbf:cAlias )->( AdsSetAof( cFilterCond ) )

   METHOD AddIdxFile( cFile )

   METHOD RecLock( nRecord, nTimeOut )
   METHOD RecUnLock( nRecord )
   METHOD FilLock( nTimeOut )
   METHOD FilUnLock() INLINE ( ::cAlias )->( DbUnlock() )
   METHOD IsRecordLocked() INLINE Ascan(::Recno(), ( ::cAlias )->( DbrLockList() ) ) > 0

   METHOD Load()
   METHOD Blank()

   MESSAGE OrdSetFocus( xTag, cBag, lError ) METHOD _OrdSetFocus( xTag, cBag, lError )
   METHOD Seek( xValue, lSoftSeek, lError )
   METHOD SeekAndLoad( xValue )
   METHOD ForcedSeek( xValue ) INLINE ::Seek( xValue, .f., .t. )
   METHOD Locate( cExp, lContinue ) INLINE ( ( ::cAlias )->( __dbLocate( COMPILE(cExp),,,, lContinue) ),;
                                             ( ::cAlias )->( Found() ) )
   METHOD Continue()                INLINE ( ( ::cAlias )->( __dbContinue() ),;
                                             ( ::cAlias )->( Found() ) )

   METHOD GetTags( lUserTags )
   METHOD DeleteTag( cTag, cFile ) INLINE ( ::cAlias )->( OrdDestroy( cTag, cFile ) )

   METHOD Alias()          INLINE ::cAlias
   METHOD Select()         INLINE DbSelectArea( ::cAlias )
   METHOD GoTop()          INLINE ( ::cAlias )->( DbGoTop() )
   METHOD GoBottom()       INLINE ( ::cAlias )->( DbGoBottom() )
   METHOD Goto( n )        INLINE ( ::cAlias )->( DbGoto( n ) )
   METHOD Skip( n )        INLINE ( iif(n == nil, n := 1,), ( ::cAlias )->( DbSkip( n ) ) )
   METHOD Bof()            INLINE ( ::cAlias )->( Bof() )
   METHOD Eof()            INLINE ( ::cAlias )->( Eof() )
   METHOD Recno()          INLINE ( ::cAlias )->( Recno() )

   METHOD Found()          INLINE ( ::cAlias )->( Found() )
   METHOD RecCount()       INLINE ( ::cAlias )->( RecCount() )
   METHOD LastRec()        INLINE ( ::cAlias )->( LASTREC() )

   METHOD OrdKeyVal()      INLINE ( ::cAlias )->( OrdKeyVal() )
   METHOD OrdKeyNo()       INLINE ( ::cAlias )->( OrdKeyNo() )
   METHOD OrdKeyCount()    INLINE ( ::cAlias )->( OrdKeyCount() )

   METHOD Filter( cFilter )
   METHOD SetFilter( cFilter ) INLINE ::Filter( cFilter )
   METHOD ClearFilter()        INLINE ::Filter( "" )

   METHOD SetScope( xTop, xBottom )
   METHOD GetScopes()      INLINE ::aScopes HIDDEN
   METHOD ClearScope()

   METHOD FieldGet( n )    INLINE ( ::cAlias )->( FieldGet( n ) )

   METHOD FieldPos( c )    INLINE ( ::cAlias )->( FieldPos( c ) )
   METHOD FieldName( n )   INLINE ::aFldsInfo[ n, DBS_NAME ]
   METHOD FieldType( n )   INLINE ::aFldsInfo[ n, DBS_TYPE ]
   METHOD FieldLen( n )    INLINE ::aFldsInfo[ n, DBS_LEN ]
   METHOD FieldDec( n )    INLINE ::aFldsInfo[ n, DBS_DEC ]
   METHOD FieldCount()     INLINE len( ::aFldsInfo )
   METHOD isField( cField )

   METHOD SaveState()
   METHOD RestoreState()
   METHOD ReleaseState()

   METHOD SaveToArray( bBlock, bFor )

   METHOD Sort( cExpression, lDescend )

   ERROR HANDLER OnError( uParam1 )



ENDCLASS

//------------------------------------------------------------------------//

METHOD New( cFileName ) CLASS xDbf
LOCAL nIndex

   cFileName := alltrim( cFileName )

   ::aState       := {}
   ::aScopes      := {}
   ::aIdxFile     := {}
   ::cFileName    := cFileName + iif( left( right( cFileName, 4 ), 1 ) <> ".", ".adt", "" )
   ::cRdd         := RDDSetDefault()

   ::cFileType    := ADS_ADT
   hb_FNameSplit( lower( cFilename ),,@::cTableName, )

   ::cAlias       := ValidAlias( ::cTableName )
   ::cLogFile     := "xdbfioerr.log"
   ::cSortFile    := ""
   ::cSortExp     := ""
   ::nLockTimeOut := 10
   ::lOpen        := .f.   //once the table is open this property is changed to .t.
   ::lShared      := .t.
   ::lReadOnly    := .f.
   ::lNew         := .t.
   ::lMessage     := .t.
   ::lLogErrors   := .t.
   ::lSortDesc    := .f.
    ::oQuery        := adsQuery():New()

RETURN Self


//------------------------------------------------------------------------//
METHOD Open( nMode ) CLASS xDbf
LOCAL e, cExt, cfname

   // If object alredy openened then there is nothing to do
   IF ::lOpen

      IF ::lMessage  ;Alert( ::cTableName + " is already openened." ) ;ENDIF
      RETURN .T.

   ENDIF

   hb_FNameSplit( lower( ::cTableName ),,@cfName, @cExt )
   
   ADSSetFileType( ::cFileType )

   ::cFileName := cfName + cExt

   TRY
   
      WHILE SELECT( ::cAlias ) != 0    ;::cAlias := ValidAlias( ::cTableName )   ;END
     
      Dbusearea( ::lNew ,::cRDD , ::cFileName,::cAlias , ::lShared ,::lReadonly )

   CATCH e

      Alert( "Problems opening file " + ::cTableName, "Operation Aborted" )
      Logfile( "trace.log", { ::cAlias, ::cRDD, ::cfilename, ::cTableName, e:SubSystem, e:SubCode, e:Operation, e:Description } )
      return .F.

   END

   // If there is an error then show message and if a process is defined then
   // close all files openened by that process
   IF NetErr()

      IF ::lMessage

         IF ::lShared
            Alert( ::cFileName + " in exclusive. " + CRLF )
         ELSE
            Alert( ::cFileName + " can't be opened "+ CRLF )
         ENDIF

      ENDIF

      RETURN .F.

   ENDIF

   ::Select()

   IF !Empty( ::cSortFile ) .and. file( ::cSortFile )
      (::cAlias)->(OrdListAdd( ::cSortFile ) )
   ENDIF
   
   IF LEN( ::aIdxFile ) > 0

      TRY
         Aeval( ::aIdxFile, {|v| (::cAlias)->( OrdListAdd( v ) ) } )
         ::OrdSetFocus( IIF( !EMPTY( ::cPrimaryKey ), ::cPrimaryKey, 1 ) )
         ( ::calias )->( dbGoTop() )

      CATCH
      END

   Endif

   ::lOpen := .t.

   // Append this object to the array of aDbfOpen.
   AADD( aDbfOpen, SELF )

   // Save the complete structure
   ::aFldsInfo := ( ::cAlias )->( DbStruct() )

   // Set Buffer
   ::aBuffer := Array( len( ::aFldsInfo ) )
   ::Load()   //load VAR buffers with current record

RETURN .t.



//------------------------------------------------------------------------//
METHOD AdsSetFileType() CLASS xDbf
LOCAL narea := Select()
LOCAL nFileType := ADS_NTX

   ::Select()
   nFileType := AdsSetFileType()
   Select( nArea )

Return nFileType



//------------------------------------------------------------------------//
METHOD Close() CLASS xDbf
LOCAL nAt

   if ::lOpen

      If Select( ::cAlias ) > 0
         ( ::cAlias )->( DbCloseArea() )
      Endif

      ::lOpen := .f.

   endif

   nAt := Ascan( aDbfOpen, { |v| v:cFileName == ::cFileName } )

   IF nAt > 0  ;Adel( aDbfOpen, nAt, .T. )   ;ENDIF

RETURN Self

//------------------------------------------------------------------------//

METHOD End() CLASS xDbf

   If !Empty(::cSortFile)
      ::DeleteTag( "TEMPTAG", ::cSortFile )
   Endif
   
    ::oQuery:End()
   ::Close()

RETURN Self



//------------------------------------------------------------------------//
METHOD RecLock( nRecord, nTimeOut ) CLASS xDbf
LOCAL lForever
LOCAL nCounter := 0

   DEFAULT nRecord  := ::Recno(),;
           nTimeOut := ::nLockTimeOut

   lForever := ( nTimeOut == 0 )

   while lForEver .OR. nTimeOut > 0

      if ( ::cAlias )->( DbRlock( nRecord ) )
         return .t.
      endif

      Inkey( .5 )
      nTimeOut -= .5

      if lForever .and. nTimeOut <= 0
         Alert( "Record can't be locked." + ::cAlias )
         nTimeOut := ::nLockTimeOut
      endif

   end

   ::GenError( "Problems locking record on " + ::cAlias )

   if ::lMessage
      Alert( "Record locked at this time "+ ::cAlias )
   endif

RETURN .f.

//------------------------------------------------------------------------//

METHOD RecUnLock( nRecord ) CLASS xDbf

   DEFAULT nRecord  := ::Recno()

   ( ::cAlias )->( DbrUnlock( nRecord ) )

return nil


//------------------------------------------------------------------------//

METHOD FilLock( nTimeOut ) CLASS xDbf

   local lForever
   Local nCounter := 0

   DEFAULT nTimeOut := ::nLockTimeOut

   lForever := ( nTimeOut == 0 )

   WHILE lForEver .OR. nTimeOut > 0

      IF ( ::cAlias )->( Flock() )     ;RETURN .T.    ;ENDIF

      Inkey( .5 )
      nTimeOut -= .5

      IF lForever .AND. nTimeOut <= 0 .AND. ::lMessage

         Alert( "Timeout trying to lock " + ::cAlias )
         nTimeOut := ::nLockTimeOut

      ENDIF

   END

RETURN .f.



//------------------------------------------------------------------------//

METHOD Load() CLASS xDbf
LOCAL nFor
LOCAL nLen := len( ::abuffer )

   FOR nFor := 1 TO nLen
      ::aBuffer[ nFor ] := ( ::cAlias )->( FieldGet( nFor ) )
   NEXT


RETURN NIL




//------------------------------------------------------------------------//

METHOD Blank() CLASS xDbf
local nFor, nLen
local cType

   nLen := len( ::aBuffer )

   FOR nFor := 1 to nLen

      IF upper( ::FieldName( nFor ) ) != "GUID" .and. ;
            ::FieldType( nFor ) != [MODTIME] .and. ;
            ::FieldType( nFor ) != [ROWVERSION]

         cType := ::FieldType( nFor )

         do case
            case cType == "C"
               ::aBuffer[ nFor ] := Spac( ::fieldLen( nFor ) )
            case cType == "D"
               ::aBuffer[ nFor ] := Ctod("")
            case cType $ "N"
               ::aBuffer[ nFor ] := 0
            case cType == "L"
               ::aBuffer[ nFor ] := .f.
            case cType == "M"
               ::aBuffer[ nFor ] := ""
            case cType == "Y"       //Money
               ::aBuffer[ nFor ] := 0.00
            case cType == "TIMESTAMP"
               ::aBuffer[ nFor ] := DateTime()
            otherwise
               //?
         end case

      ENDIF

   NEXT

RETURN nil

//------------------------------------------------------------------------//
METHOD _OrdSetFocus( xTag, cBag, lError ) CLASS xDbf
LOCAL oError
LOCAL cOldTag
LOCAL cExt, cfname

   DEFAULT lError := .t.
   hb_FNameSplit( ::aIdxFile[ 1 ],, @cfname, @cExt )

   IF VALTYPE( xtag ) == "N" .AND. !EMPTY( ::aIdxFile ) .AND. LOWER( cExt ) == "ntx"
      hb_FNameSplit( LOWER( ::aIdxFile[ xTag ] ), @cfname )
      xtag := cfName
   Endif

   cOldTag := ( ::cAlias )->( OrdSetFocus( xTag, cBag ) )

   IF !EMPTY( xTag ) .AND. ( ::cAlias )->( IndexOrd() ) == 0 .AND. lError
      oError := ErrorNew()
      oError:Subsystem   := "xDbf-Class"
      oError:Severity    := ES_WARNING
      oError:CanDefault  := .F.
      oError:Description := "Error on _OrdSetFocus " + ::cAlias
      oError:Operation   := "Invalid tag " + HB_ValToStr( xTag )
      Eval( ErrorBlock(), oError)
   ENDIF

RETURN cOldTag



//------------------------------------------------------------------------//
METHOD Seek( xValue, lSoftSeek, lError ) CLASS xDbf

   local oError
   local lSuccess

   DEFAULT lSoftSeek := Set( _SET_SOFTSEEK ),;
           lError    := .f.

   lSuccess := ( ::cAlias )->( DbSeek( xValue, lSoftSeek ) )

   IF !lSoftSeek .and. !lSuccess .and. lError
      oError := ErrorNew()
      oError:Subsystem   := "xDbfClass"
      oError:Severity    := ES_WARNING
      oError:CanDefault  := .F.
      oError:Description := "Seek error " + ::cAlias
      oError:Operation   := HB_ValToStr( xValue )
      Eval( ErrorBlock(), oError)
   ENDIF

RETURN lSuccess


//------------------------------------------------------------------------//
METHOD SeekAndLoad( xValue ) CLASS xDbf

   IIF( ::Seek( xValue ) .AND. ::found(), ::Load(), ::Blank() )

RETURN NIL



//------------------------------------------------------------------------//
METHOD GetTags( lUserTags ) CLASS xDbf
LOCAL aTags := {}
LOCAL cTag
LOCAL nTag := 1

   DEFAULT lUserTags := .t.

   WHILE !EMPTY( cTag := ( ::cAlias )->( OrdName( nTag ) ) )

      IF LEFT( cTag, 1 ) != "_" .OR. !lUserTags    ;AADD( aTags, cTag )    ;ENDIF
     
      nTag ++

   END

RETURN aTags



//------------------------------------------------------------------------//

METHOD SetScope( xTop, xBottom ) CLASS xDbf
LOCAL cTag
LOCAL nTag

   cTag := ( ::cAlias )->( OrdName() )

   ( ::cAlias )->( OrdScope( TOPSCOPE, xTop ) )

   if xBottom != nil
      ( ::cAlias )->( OrdScope( BOTTOMSCOPE, xBottom ) )
   else
      ( ::cAlias )->( OrdScope(BOTTOMSCOPE, xTop) )
      xBottom := xTop
   endif

   ::GoTop()

   nTag := Ascan( ::aScopes, {|v| v[1] == cTag } )

   IF nTag == 0
      Aadd( ::aScopes, Array(3) )
      nTag := LEN( ::aScopes )
   ENDIF

   ::aScopes[ nTag, 1 ] := cTag
   ::aScopes[ nTag, 2 ] := xTop
   ::aScopes[ nTag, 3 ] := xBottom

RETURN NIL

//------------------------------------------------------------------------//
METHOD ClearScope() CLASS xDbf

   local cTag
   local nTag

   cTag := ( ::cAlias )->( OrdName() )

   ( ::cAlias )->( OrdScope(TOPSCOPE, nil) )
   ( ::cAlias )->( OrdScope(BOTTOMSCOPE, nil) )

   nTag := Ascan( ::aScopes, {|v| v[1] == cTag } )

   If nTag > 0
      Adel( ::aScopes, nTag )
      Asize( ::aScopes, len( ::aScopes ) - 1 )
   Endif

return nil


//-------------------------------------------------------------------------//
METHOD isField( cField ) CLASS xDbf

   cField := Upper( cField )

RETURN Ascan(::aFldsInfo, {|v| v[ DBS_NAME ] == cField } ) > 0


//------------------------------------------------------------------------//
METHOD Filter( cFilter ) CLASS xDbf

   local cOldFilter

   cOldFilter := ( ::cAlias )->(DbFilter())

   If cFilter != nil
      If Empty( cFilter )
         ( ::cAlias )->(DbClearFilter())
      else
         ( ::cAlias )->(DbSetFilter( COMPILE( cFilter ), cFilter ))
      Endif
      ::GoTop()
   Endif

return cOldFilter

//------------------------------------------------------------------------//
METHOD SaveState() CLASS xDbf
                                                                           // MVG 19 Aug 2011
   Aadd(::aState, { ::Recno(), ;
                    ::OrdSetFocus(), ;
                    ::Filter(), ;
                    ::GetScopes(), ;
                    IF( 'ADT' $ ::cRDD, ( ::cAlias ) -> ( AdsGetAOF() ), NIL ) } )

return .t.


//------------------------------------------------------------------------//
METHOD RestoreState() CLASS xDbf
local aData
local nFor

   If len( ::aState ) == 0
      retur .f.
   Endif

   aData := Atail( ::aState )

   For nFor := 1 to len( aData[4] )
      ::OrdSetFocus( aData[4, nFor, 1] )
      ::SetScope( aData[4, nFor, 2], aData[4, nFor, 3] )
   Next

   if adata[ 2 ] <> nil
      ::OrdSetFocus( aData[2] )
   endif

   ::Filter( aData[3] )

   // MVG 19 Aug 2011

   IF aData[5] != NIL
      (::cAlias) -> ( ADSSetAof( aData[5] ) )
   ELSE
      IF ::cRDD == 'ADS'
         (::cAlias) -> ( ADSClearAof() )
      ENDIF
   ENDIF

   //----------------

   If aData[1] <= ::RecCount()
      ::Goto( aData[1] )
   else
      ::GoTop()
   Endif

   Asize( ::aState, len( ::aState) - 1 )

return .t.

//------------------------------------------------------------------------//

METHOD ReleaseState() CLASS xDbf

   If len( ::aState ) == 0
      retur .f.
   Endif

   Asize( ::aState, len( ::aState) - 1 )

return .t.

//------------------------------------------------------------------------//

METHOD SaveToArray( bBlock, bFor ) CLASS xDbf
Local aData := {}
local bEval
DEFAULT bFor := { ||.t. }

   bEval := {|| Aadd(aData, Eval(bBlock, Self)) }

   ::SaveState()

   ( ::cAlias )->( DbEval( bEval, bfor ) )

   ::RestoreState()

return aData


//------------------------------------------------------------------------//
METHOD Sort( cExp, lDes, cTagName, lLocal )
LOCAL cPath

   DEFAULT  lDes := .f.,;
            cTagName := "TEMPTAG",;
            lLocal := .T.

   ::cSortExp := cExp

   hb_FNameSplit( ::cFileName, @cPath )
   
   If !Empty(::cSortFile)
   
      ::DeleteTag( cTagName, ::cSortFile )
     
   else
   
      ::cSortFile := IIF( lLocal, FUnique( cPath, "TMP", Left(::cAlias, 6) ), ::cAlias )

   Endif

   //CursorWait()

   ( ::cAlias )->( ordCondSet( "",,.t.,,,0,0,0,0,.f.,lDes,.t., .t., .f. ) )
   ( ::cAlias )->( OrdCreate( ::cSortFile, cTagName, cExp, COMPILE( cExp ) ) )

   ::OrdSetFocus( cTagName )

   //CursorArrow()

return .t.


//------------------------------------------------------------------------//
METHOD AddIdxFile( cFileName ) CLASS xDbf

   cFileName := lower( cFileName )

   If Ascan( ::aIdxFile, cFileName ) == 0
      Aadd( ::aIdxFile, cFileName )
      If ::lOpen
         ( ::cAlias )->( OrdListAdd( cFileName ) )
      Endif
   Endif

RETURN .t.



//------------------------------------------------------------------------//
METHOD OnError( uParam1 ) CLASS xDbf
   local cMsg   := __GetMessage()
   local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
   LOCAL nField := ::FieldPos( cMsg )

   if nField > 0  ;RETURN ::FieldGet( nField )  ; ENDIF

   //_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )

RETURN NIL


//------------------------------------------------------------------------//

EXIT PROCEDURE xDbfExitProc()

   local oDbf
   local cError
   local nFor

   cError := ""

   for nFor := 1 to len( aDbfOpen )

      oDbf   := aDbfOpen[ nFor ]
      cError += oDbf:cTableName + " not closed." + CRLF

      If Select( oDbf:cAlias ) > 0
         ( oDbf:cAlias )->( DbCloseArea() )
      endif

   next

   If !Empty( cError )
      Alert( cError )
   Endif

RETURN


//----------------------------------------------------------------------------//

STATIC FUNCTION Funique(cDir, cExt, cRootName)

   local cFileName
   local n := 1

   DEFAULT cDir      := GetEnv("TEMP"),;
           cExt      := "TMP" ,;
           cRootName := "MP_"

   if Right(cDir,1) != "\"
      cDir += "\"
   endif

   cFileName := cRootName + ltrim(str(n)) + "." + cExt

   fErase(cDir + cFileName)

   //loop in case I can't delete the file
   do while File(cDir + cFileName)
      cFileName := cRootName + ltrim(str(++n)) + "." + cExt
      fErase(cDir + cFileName)
   enddo

   cFileName := cDir + cFileName

RETURN cFileName


//----------------------------------------------------------------------------//
FUNCTION IsInDictionary( odbf, cFileName, isRefresh )
LOCAL isFound    := .f.
LOCAL i         := 1
LOCAL nLen, cFile, oQ

   DEFAULT isRefresh := .f.

   IF cFileName == NIL  ;hb_FNameSplit( oDbf:cTableName,,@cFileName )   ;ENDIF

   IF EMPTY( aFiles ) .or. isRefresh

      afiles := AdsDirectory()
      aEval( afiles, { |e,n| aFiles[ n ] := STRTRAN( ALLTRIM( LOWER( e ) ), chr(0), "" ) } )

   ENDIF

   i := 0
   nLen := Len( aFiles )
   WHILE !isfound .AND. ++i <= nLen

      isfound := ALLTRIM( LOWER( cfilename ) ) == aFiles[ i ]

   END

RETURN isFound

On the next reply on this thread I will provide sample uses of the class that also demonstrate things you can do with ADS.

Reinaldo.

[reinaldocrespo]

Here are some sample uses of the class that also implement some nice features of ADS SQL. On this link you can download the class as well as SampleSQLUsage.prg that shows how to use the class.

http://www.main.structuredsystems.com/adssamples/

AdsQuery.prg is a class that allows you to use ADS SQL queries as an object making it simpler to use.

SampleSQLUsage.prg shows how to use the class plus it should answer some of the most common questions most people from Harbour have about ADS. You will see on this .prg how to use stored procedures in default existence of actual ACE wrappers on rddads.lib.

“Building rddads.lib.pdf" is just text explaining how to build the necessary .libs to use ACE.

Hope that helps;


Reinaldo.