Clase TPUBLIC

[Compuin]

Buenos dias,

Alguien tiene la clase TPUBLIC para que me la envie por email? wbguerrero@gmail.com

Saludos

[Armando]

Wilmer:

Ya debe estar en tu buzon.

Saludos

[Compuin]

Gracias Armando

[Antonio Linares]

Armando,

Serias tan amable de publicar su código aqui ? gracias

[Daniel Garcia-Gil]

Saludos

esta es una clase TPublic que diseñe hace un tiempo, es muy simple y corta, pero creo que abarca lo suficiente para satisfacer algunas necesidades

Code: Select all | Expand

//
//Designed by: Daniel Garcia-Gil [ danielgarciagil@gmail.com ]
//
//Class TPublic
//Create dynamically Datas
//Create "in fly" new methods

#include "hbclass.ch"


function Main

   local oPublic 

   oPublic = TPublic():New( )
   oPublic:AddMethod( "Msg", @Ok() )   
   oPublic:cTest = "Testing"
   oPublic:nTest = 12345
   oPublic:lTest = .T. 
   
   MsgInfo( oPublic:SendMsg( "lTest" ) )
   
   oPublic:Msg( oPublic:cTest )
   oPublic:Msg( oPublic:nTest )
   oPublic:Msg( oPublic:lTest )
   MsgInfo( "i'll change cTest Value'" )
   
   //sending messages
   oPublic:SendMsg( "_cTest", "value changed succeful by SendMsg" )
   MsgInfo( oPublic:cTest )
   MsgInfo( oPublic:SendMsg( "cTest" ), "Retrieve Value by SendMsg" )
   
   oPublic:cTest = "New Value Again by inline assignment"
   MsgInfo( oPublic:cTest )
   
   oPublic:Msg( "Parameters", oPublic:cTest, oPublic:nTest, oPublic:lTest, Date(), Time() )

return nil

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

function Ok( ... )

   local aParams := hb_aParams()
   local cList := "", n
   
   for n = 1 to Len ( aParams )
      cList += cValToChar( aParams[ n ] ) + Chr( 13 ) + Chr( 10 )
   next
   MsgInfo( cList, "Parametros:" + Str( Len( aParams ), 2 ) ) 
   
return nil


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

CLASS TPublic

   METHOD New()
   METHOD AddData( cData )
   METHOD AddMethod( cMethod )
   METHOD DelData( cData )
   METHOD DelMethod( cMethod )
   METHOD SendMsg()
   
   ERROR HANDLER ONERROR()    

ENDCLASS

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

METHOD New( ) CLASS TPublic

return Self

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

METHOD AddData( cData ) CLASS TPublic

   if ! __objHasData( Self, cData )
      __objAddData( Self, cData )      
   endif
   
return nil   
   
//------------------------------------------------//

METHOD AddMethod( cMethod, pFunc )
 
   if ! __objHasMethod( Self, cMethod )  
      __objAddMethod( Self, cMethod, pFunc )    
   endif

return nil

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

METHOD DelData( cData ) CLASS TPublic

   if ! __objHasData( Self, cData )
      __objDelMethod( Self, cData )      
   endif
   
return nil   

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

METHOD DelMethod( cMethod, pFunc ) CLASS TPublic
 
   if ! __objHasMethod( Self, cMethod )  
      __objDelMethod( Self, cMethod )    
   endif

return nil

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

#ifndef __XHARBOUR__
METHOD SendMsg( cMsg, ...  ) CLASS TPublic
   if "(" $ cMsg
      cMsg = StrTran( cMsg, "()", "" )
   endif
return __ObjSendMsg( Self, cMsg, ... )
#else   
METHOD SendMsg( ... ) CLASS TPublic
   local aParams := hb_aParams()
      
   if "(" $ aParams[ 1 ]
      aParams[ 1 ] = StrTran( aParams[ 1 ], "()", "" )
   endif
 
   ASize( aParams, Len( aParams ) + 1 )
   AIns( aParams, 1 )
   aParams[ 1 ] = Self
   
   return hb_execFromArray( aParams )   
      
#endif 


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

METHOD ONERROR( uParam1 ) CLASS TPublic
   local cCol    := __GetMessage()
   local uRet
   
   if Left( cCol, 1 ) == "_"
      cCol = Right( cCol, Len( cCol ) - 1 )
   endif
   
   if ! __objHasData( Self, cCol )
      ::AddData( cCol )
   endif
   
#ifndef __XHARBOUR__
   if uParam1 == nil
      uRet = __ObjSendMsg( Self, cCol )
   else
      uRet = __ObjSendMsg( Self, "_" + cCol, uParam1 )
   endif
#else   
   if uParam1 == nil
      uRet = hb_execFromArray( Self, cCol )
   else
      uRet = hb_execFromArray( Self, cCol, { uParam1 } )
   endif
#endif    
   
   
RETURN uRet
 

[Armando]

Antonio, Daniel:

No se si se trata de la misma clase, algun día alguien me la compartió, en los remarks se observan varios
nombres de los autores. honor a quíen honor merece.

Code: Select all | Expand

/*  -----------------------------------------------------------------------------
 *  TPublic()
 *  Clase para el reemplazo de Variables Publicas
 *  Version 5.2b - 01/04/2006
 *
 *  Oscar Chacon
 *  ventas@busmatic.com
 *  http://www.busmatic.com
 *
 *  Aportes: [ER]   Ray Islas

 *  DATAS
 *  -----------------------------------------------------------------------------
 * aVars      - Arreglo de variables
 * cName      - Nombre ultima variable accedida
 * nPos       - Valor ultimo variable accedida
 * automata - Asignación automatica, por defecto TRUE [WA]
 *
 *  METODOS
 *  -----------------------------------------------------------------------------
 * New()      - Contructor
 * Add()      - Agrega/define nueva variable
 * Del()      - Borra variable
 * Get()      - Accede a una veriable directamente
 * Set()      - Define nuevo valor directamente
 * GetPos()   - Obtener la posición en el array
 * Release()  - Borra todas las variables
 * IsDef()    - Chequea si una variable fue definida
 * Clone()    - Clona la DATA aVars
 * nCount()   - Devuelve cantidad de variables definidas
 * Save()     - Salva DATA aVars
 * Restore()  - Restaura DATA aVars
 *
 *  NOTA
 *  -----------------------------------------------------------------------------
 * Para acceder al valor de una variable, se puede hacer de 2 formas,
 * una directa usando oPub:Get("Codigo") o por Prueba/Error oPub:Codigo,
 * este último es mas simple de usar pero más lento.
 *
 * Para definir un nuevo valor a una variable tambien puede ser por 2 formas,
 * directamente por oPub:Set("Codigo", "ABC" ), o por Prueba/Error
 * oPub:Codigo := "ABC".
 *
 * Atencion: Los metodos Get() y Set() no controlan si la variable existe,
 * para ganar en velocidad.
 *
 * Las variables definidas NO son case sensitive.
 *
 *  MODIFICACIONES Y AGREGADOS
 *  -----------------------------------------------------------------------------
 * 2.2b Correción Bug en metodo Add() sobre FWH.
 * 2.2a Modificado para não restringir o número de variáveis em [x]Harbour [WA]
 * 2.2  Modificada para funcionar en [x]Harbour
 *
 * 2.1  Se guarda el Nombre y Posición de la última variable accedida para incrementar
 *      la velocidad. (Implementado por Eduardo Rizzolo)
 *
 *  EJEMPLO
 *  -----------------------------------------------------------------------------
 * FUNCTION Test()
 * local oP := TPublic():New(), aSave, nPos
 *
 * oP:Add("Codigo")           // Defino variable sin valor inicial
 * oP:Add("Precio", 1.15)     // Defino variable con valor inicial
 * oP:Add("Cantidad", 10 )
 * oP:Add("TOTAL" )
 *
 * // Acceso a variables por prueba/error
 * oP:Total := oP:Precio * oP:Cantidad
 *
 * // Definicion y Acceso a variables directamente
 * oP:Set("Total", oP:Get("precio") * oP:Get("CANTIDAD") )
 *
 * oP:Del("Total")         // Borro una variable
 * ? oP:IsDef("TOTAL")     // Varifico si existe una variable
 *
 * nPos := oP:GetPos("Total") // Obtengo la posición en el array
 * oP:aVars[nPos,2] := 0      // Modifico el Valor en el array directo
 *
 * aSave := oP:Save()      // Guardo las Variables
 * oP:Release()         // Borro TODAS las variables
 * oP:Restore( aSave )     // Restauro las variables
 *
 * oP:End()       // Termino
 *
 * RETURN NIL
 *
 *  EXEMPLO (Asignación Automática)
 *
 * FUNCTION MAIN()
 * LOCAL oP:=TPublic():New(.T.)
 *
 * op:nome     := "Wilson Alves"
 * op:Endereco := "Rua dos Cravos,75"
 * op:Cidade   := "Londrina-PR"
 * op:Celular  := "9112-5495"
 * op:Empresa  := "WCW Software"
 *
 * ? op:Nome,op:Endereco,op:Cidade,op:celular,op:empresa
 *
 * op:End()
 * RETURN NIL
 *
 */

# include "FiveWin.ch"

#ifdef __xHARBOUR__
  # xtranslate BYNAME <V> [, <VN> ]     => ::<V> := <V> [; ::<VN> := <VN> ]
  # xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>
  # xtranslate BYNAME <V> IFNONIL       => if <V> != NIL ; ::<V> := <V> ; endif
  # xtranslate BYDEFAULT <V>, <Val>     => if( <V> == NIL, <Val>, <V> )
#endif

/*
 * TPublic()
 */
CLASS TPublic

   DATA  automata  AS LOGICAL     INIT .T.    // [WA]

   DATA  aVars       AS ARRAY       INIT NIL
   DATA  nPos        AS NUMERIC     INIT 0   READONLY // [ER]
   DATA  cName       AS CHARACTER   INIT ""  READONLY // [ER]

   METHOD New( automata )
   METHOD End()      INLINE ::Release()

   METHOD Add( cName, xValue )
   METHOD Del( cName )
   METHOD Get( cName )
   METHOD Set( cName, xValue )

   METHOD GetPos( cName )

   METHOD Release()
   METHOD IsDef( cName )

   METHOD Clone()    INLINE aClone( ::aClone )
   METHOD nCount()      INLINE Len( ::aVars )

   METHOD Save()     INLINE aClone( ::aVars )
   METHOD Restore( aVars ) INLINE ::aVars := aClone( aVars )

#ifdef __HARBOUR__
   ERROR HANDLER OnError( uParam1 )
#else
   ERROR HANDLER OnError( cMsg, nError )
#endif

ENDCLASS

/*
 *  TPublic:New()
 */
METHOD New( automata ) CLASS TPublic // [WA]

   ::aVars := {}

* BYNAME  automata DEFAULT .T.   // [WA]

RETURN Self

/*
 *  TPublic:Add()
 */
METHOD Add( cName, xValue ) CLASS TPublic // [ER]

  if cName != NIL
    if (::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
      ::aVars[::nPos,2] := xValue

#ifndef __HARBOUR__                 // [WA]
    elseif Len(::aVars) < 4000      // [JJMG]
      aAdd( ::aVars, { AllTrim(Upper(cName)), xValue } )
      ::nPos := Len(::aVars)

    else
      MsgAlert("Demasiadas variables definidas para la Clase TPublic()")

#else
    else
      aAdd( ::aVars, { AllTrim(Upper(cName)), xValue } )
      ::nPos := Len(::aVars)
#endif                              // [WA]

    endif

    ::cName  := cName
  endif

RETURN Self

/*
 *  TPublic:Del()
 */
METHOD Del( cName ) CLASS TPublic
   local nPos

   if cName != NIL
      if (nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
         aDel( ::aVars, nPos )
         ::aVars := aSize( ::aVars, Len(::aVars) - 1 )

         ::nPos   := 0
         ::cName  := ""
      endif
   endif

RETURN Self

/*
 *  TPublic:Get()
 */
METHOD Get( cName ) CLASS TPublic                  // [by ER]

   if cName != ::cName
      ::nPos   := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
      ::cName  := cName
   endif

RETURN ::aVars[::nPos,2]

/*
 *  TPublic:Set()
 */
METHOD Set( cName, xValue ) CLASS TPublic             // [by ER]

   if cName != ::cName
      ::nPos   := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
      ::cName  := cName
   endif

   ::aVars[::nPos,2] := xValue

RETURN Self

/*
 *  TPublic:GetPos()                         // [by ER]
 */
METHOD GetPos( cName ) CLASS TPublic

   ::cName  := cName

RETURN ::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )


/*
 *  TPublic:Release()
 */
METHOD Release() CLASS TPublic

   ASIZE(::aVars,0)
   ::cName  := ""
   ::nPos   := 0

RETURN Self

/*
 *  TPublic:IsDef()
 */
METHOD IsDef( cName ) CLASS TPublic                // [by ER]

   local lOk := .F.

   if cName != NIL
      if (::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
         ::cName := cName
         lOk := .T.
      endif
   endif

RETURN lOk

/*
 *  OnError()
 */
#ifdef __HARBOUR__
   METHOD OnError( uParam1 ) CLASS TPublic
      local cMsg   := __GetMessage()
      local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
#else
   METHOD OnError( cMsg, nError ) CLASS TPublic
      local uParam1 := GetParam( 1, 1 )
#endif

   cMsg := Upper( AllTrim( cMsg ))

   if SubStr( cMsg, 1, 1 ) == "_"
      cMsg := SubStr( cMsg, 2 )

      if cMsg == Upper(::cName)
         ::aVars[::nPos,2] := uParam1

      elseif ( ::nPos := aScan( ::aVars, { |e,n| e[1] == cMsg } ) ) != 0
         ::cName  := cMsg
         ::aVars[::nPos,2] := uParam1

      else

         if !::automata  // [WA]
            _ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
            ::cName  := ""
            ::nPos   := 0
         else
            ::add(cmsg)
            ::aVars[::nPos,2] := uParam1
         endif
      endif
   else
      if cMsg == Upper(::cName)           // [by ER]
         RETURN ::aVars[::nPos,2]

      elseif ( ::nPos := aScan( ::aVars, { |e,n| e[1] == cMsg } ) ) != 0
         ::cName  := cMsg
         RETURN ::aVars[::nPos,2]
      else
         _ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
         ::cName  := ""
         ::nPos   := 0
      endif
   endif

RETURN NIL
// Andrade Daniel (2001-2003)
 

Servido master, espero no infringir ningun derecho de autor.

[Antonio Linares]

Daniel, Armando,

Gracias!

[Daniel Garcia-Gil]

Armando

No es la misma clase, esa que has publicado usa un array para el control de variables, la que diseñe crea dinamicamente Datas y Metodos directamente en la clase, lo que la hace un poco mas rapida, se le podrian añadir mas funcionalidades esta bastante "basica" y a mi criterio muy util y funcional

[Armando]

Daniel:

Efectivamente no es la misma clase, ahora hay más tela de donde cortar, te comento que hasta hoy la clase que compartí
ha llenado mis necesidades y funciona muy bien.

Saludos

[Daniel Garcia-Gil]

Les dejo una nueva version con nuevas funcionalidades

agregados metodos IsDefData, IsDefMethod, Save, Restore

Code: Select all | Expand

//
//Designed by: Daniel Garcia-Gil [ danielgarciagil@gmail.com ]
//
//Class TPublic
//Create dynamically Datas
//Create "in fly" new methods

#include "hbclass.ch"

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

CLASS TPublic

   DATA __hVar__

   METHOD New()
   METHOD AddData( cData )
   METHOD AddMethod( cMethod )
   METHOD DelData( cData )
   METHOD DelMethod( cMethod )
   METHOD IsDefData( cData )     INLINE __objHasData( Self, cData )
   METHOD IsDefMethod( cMethod ) INLINE __objHasMethod( Self, cMethod )

   METHOD Restore()
   
   METHOD Save() 
   METHOD SendMsg()

   ERROR HANDLER ONERROR()    


ENDCLASS

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

METHOD New( ) CLASS TPublic

   ::__hVar__ = {=>}

return Self

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

METHOD AddData( cData ) CLASS TPublic
   
   if ! __objHasData( Self, cData )
      __objAddData( Self, cData )      
   endif
   
return nil   
   
//------------------------------------------------//

METHOD AddMethod( cMethod, pFunc )
 
   if ! __objHasMethod( Self, cMethod )  
      __objAddMethod( Self, cMethod, pFunc )    
   endif

return nil

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

METHOD DelData( cData ) CLASS TPublic

   if ! __objHasData( Self, cData )
      __objDelMethod( Self, cData )      
   endif
   
return nil   

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

METHOD DelMethod( cMethod, pFunc ) CLASS TPublic
 
   if ! __objHasMethod( Self, cMethod )  
      __objDelMethod( Self, cMethod )    
   endif

return nil

//------------------------------------------------//
//Return a Array with current data values
METHOD Restore() CLASS TPublic

   local b := {| cKey, uValue | ::SendMsg( "_" + cKey, uValue ) }
   local aOld := __objGetValueList( Self, HB_OO_DATA_SYMBOL )
   
#ifndef __XHARBOUR__  
   hb_HEVAL( ::__hVar__, b )
#else   
   HEVAL( ::__hVar__, b )
#endif   
   
return aOld

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

METHOD Save() CLASS TPublic
   
   local aDatas
   local a, cData
   
   aDatas = __objGetValueList( Self, HB_OO_DATA_SYMBOL ) 
   
   for each a in aDatas
      cData = Upper( a[ 1 ] ) 
      if cData != "__HVAR__"
         ::__hVar__[ cData ] = a[ 2 ]
      endif
   next
   
RETURN NIL

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

#ifndef __XHARBOUR__
METHOD SendMsg( cMsg, ...  ) CLASS TPublic
   if "(" $ cMsg
      cMsg = StrTran( cMsg, "()", "" )
   endif
return __ObjSendMsg( Self, cMsg, ... )
#else   
METHOD SendMsg( ... ) CLASS TPublic
   local aParams := hb_aParams()
      
   if "(" $ aParams[ 1 ]
      aParams[ 1 ] = StrTran( aParams[ 1 ], "()", "" )
   endif
 
   ASize( aParams, Len( aParams ) + 1 )
   AIns( aParams, 1 )
   aParams[ 1 ] = Self
   
   return hb_execFromArray( aParams )   
      
#endif 


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

METHOD ONERROR( uParam1 ) CLASS TPublic
   local cCol    := __GetMessage()
   local uRet
   
   if Left( cCol, 1 ) == "_"
      cCol = Right( cCol, Len( cCol ) - 1 )
   endif
   
   if ! __objHasData( Self, cCol )
      ::AddData( cCol )
   endif
   
#ifndef __XHARBOUR__
   if uParam1 == nil
      uRet = __ObjSendMsg( Self, cCol )
   else
      uRet = __ObjSendMsg( Self, "_" + cCol, uParam1 )
   endif
#else   
   if uParam1 == nil
      uRet = hb_execFromArray( Self, cCol )
   else
      uRet = hb_execFromArray( Self, cCol, { uParam1 } )
   endif
#endif    
   
   
RETURN uRet
 

[RSalazarU]

Hola Amigos:

Muy buenas las dos clases:

Yo manejo una modificada, y con buenos resultados.

La pregunta es ¿donde se graban los valores con el método Save() y de donde los recupera Restore()?

Acá le dejo una clase adicional que graba los valores en una tabla DBF.

La idea es que las variables puedan ser compartidas, sobre todo si son de configuración.

Code: Select all | Expand

#Include "FiveWin.ch"
#ifdef __CDXAX__
   #include "ads.ch"
#endif

#ifdef __HARBOUR__
  # xtranslate BYNAME <V> [, <VN> ]     => ::<V> := <V> [; ::<VN> := <VN> ]
  # xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>
  # xtranslate BYNAME <V> IFNONIL       => if <V> != NIL ; ::<V> := <V> ; endif
  # xtranslate BYDEFAULT <V>, <Val>     => if( <V> == NIL, <Val>, <V> )
#endif

#ifdef __CDXAX__
   #define DRIVER "ADS"
#else
   #define DRIVER "DBFCDX"
#endif

#define VARNAME   1
#define VARVALUE  2

FIELD Name

//----------------------------------------------------------------------------//
CLASS TDBPublic FROM TPublic

   DATA   cPath, cFile, oDBVariables

   #ifdef __CDXAX__
   DATA   cFileDD, nServerType, nConnection
   #endif

   #ifdef __CDXAX__
   METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile, cFileDD, nServerType, nConnection ) CONSTRUCTOR
   #else
   METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile ) CONSTRUCTOR
   #endif

   METHOD Reindex( ) VIRTUAL //esto ya no va porque se realiza un mantenimiento automatico

   METHOD Read( cName, uDefault ) //Recupera una Variable, si no esta en ::aVars la busca en oDBVariables = "Tabla Variable"
   METHOD Save( cName, uValue )   //Establece una Variable en ::aVars y en oDBVariables = "Tabla Variable"

ENDCLASS

//----------------------------------------------------------------------------//
#ifdef __CDXAX__
METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile, cFileDD, nServerType, nConnection ) CLASS TDBPublic
   LOCAL nConnect
#else
METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile ) CLASS TDBPublic
#endif

   local cFileName,;
         nAreaAnterior := Select()

   Super:New( nLenVarName, lAutomatic )

   DEFAULT lQuick := .T.,;
           lRebuild := .F.,;
       cFile := "Variable",;
       cPath := SET( _SET_DEFAULT )

   cPath := TRUENAME( cPath )

   ::cFile := cFile
   ::cPath := cPath

   #ifdef __CDXAX__
   DEFAULT cFileDD := "",;
           nServerType := 0,;
           nConnection := 0

   ::cFileDD := cFileDD
   ::nServerType := nServerType
   ::nConnection := nConnection

   if nConnection > 0
      AdsConnection( nConnection )  //Cambiamos la conexion a nConnection
   endif
   #endif

//Verificamos si se hara el Rebuild
   IF lRebuild .AND.;
      !MsgNoYes("Se reconstruira la tabla de VARIABLES. Usted es el unico usuario activo?","TDBVariable:New(..)")
      lRebuild := .F. //si se responde que no a la pregunta, no se hace el Rebuild
   ENDIF

   #ifdef __CDXAX__
   cFileName := cFile
   #else
   cFileName := cPath + "\" + cFile 
   #endif

   #ifdef __CDXAX__
   IF ( !lQuick .OR. lRebuild ) .AND. nServerType < ADS_AIS_SERVER
   #else
   IF ( !lQuick .OR. lRebuild )
   #endif

      #ifdef __CDXAX__
      IF !_AdsIsTablePresent( cFile ) .OR. lRebuild
         if nServerType>0
            _AdsDDDecriptTable( cFile )
     endif
      #else
      IF ! File( cFileName + ".dbf" ) .OR. lRebuild
      #endif

         Rebuild( cFile, cPath,;
                  { { "NAME",     "C",   nLenVarName, 0 },;
                    { "TYPE",     "C",             1, 0 },;
                    { "VALUE",    "C",           256, 0 } }, DRIVER  )
         USE ( cFileName ) NEW EXCLUSIVE
         INDEX ON UPPER(FIELD->NAME) TAG "NAME" TO ( cFileName ) FOR ! Deleted() UNIQUE
         USE

      ENDIF

   ENDIF //End lQuick


   #ifdef __CDXAX__
   //Mantenimiento de la tabla
   //OJO!!!! Falta: Elim. duplicados y reindexar
   //REOJO!!!!!: al tener el valor UNIQUE el indice de la tabla, y reindexarla, no es necesario borrar lo registros duplicados
   if nServerType < ADS_AIS_SERVER .AND. SELECT( cFile ) = 0
      TRY
         USE ( cFileName ) NEW EXCLUSIVE
     PACK //tb se reindexa, y al tener el valor UNIQUE en el indice de la tabla, y ahora reindexarla, no es necesario borrar lo registros duplicados
     //REINDEX //al tener el valor UNIQUE en el indice de la tabla, y ahora reindexarla, no es necesario borrar lo registros duplicados

         //Verificamos si la Longitud de los nombres de Variable es la correcta...
     //si no es asi, colocamos la señal para que mas tarde se haga el ReBuild()
         lRebuild := .F.
         IF .NOT. (LEN(FIELD->NAME) = ::nLenVarName)
            lRebuild := .T.
         ENDIF

         USE

         //para hacer el Rebuild(), primero hemos cerrado el area de trabajo
         IF lRebuild

            if nServerType>0
           _AdsDDDecriptTable( cFile )
        endif

            Rebuild( cFile, cPath,;
                     { { "NAME",     "C",   ::nLenVarName, 0 },;
                       { "TYPE",     "C",               1, 0 },;
                       { "VALUE",    "C",             256, 0 } }, DRIVER  )

            USE ( cFileName ) NEW EXCLUSIVE
            INDEX ON UPPER(FIELD->NAME) TAG "NAME" TO ( cFileName ) FOR ! Deleted() UNIQUE
            USE

         ENDIF
      CATCH
      END TRY
   endif

   TRY
   USE ( cFileName ) NEW SHARED
   CATCH
      if nServerType < ADS_AIS_SERVER .AND.;
         !EMPTY(cFileDD) .AND.;
         nConnection > 0 .AND.;
         AdsDDAddTable( cFile, cPath + "\" + cFile + ".dbf", cPath + "\" + cFile + OrdBagExt(), nConnection ) //Enlazamos a un AdsDD si se puede

         USE ( cFileName ) NEW SHARED

      else
         MsgStop("No se pudo abrir la tabla: " + cPath +"\"+ cFile + ".Dbf", "TDBVariable(..)")
         DBSELECTAREA( nAreaAnterior )
     return nil
      endif
   END TRY

   #else

   //Mantenimiento de la tabla
   //OJO!!!! Falta: Elim. duplicados y reindexar
   //REOJO!!!!!: al tener el valor UNIQUE el indice de la tabla, y reindexarla, no es necesario borrar lo registros duplicados
   if SELECT( cFile ) = 0
      TRY
         USE ( cFileName ) NEW EXCLUSIVE
     PACK
     //REINDEX //al tener el valor UNIQUE en el indice de la tabla, y ahora reindexarla, no es necesario borrar lo registros duplicados

         //Verificamos si la Longitud de los nombres de Variable es la correcta...
     //si no es asi, colocamos la señal para que mas tarde se haga el ReBuild()
         IF .NOT. LEN(FIELD->NAME) = ::nLenVarName
            lRebuild := .T.
         ENDIF

         USE

         IF lRebuild
            Rebuild( cFile, cPath,;
                     { { "NAME",     "C",   ::nLenVarName, 0 },;
                       { "TYPE",     "C",               1, 0 },;
                       { "VALUE",    "C",             256, 0 } }, DRIVER  )

            USE ( cFileName ) NEW EXCLUSIVE
            INDEX ON UPPER(FIELD->NAME) TAG "NAME" TO ( cFileName ) FOR ! Deleted() UNIQUE
            USE
         ENDIF
      CATCH
      END TRY
   endif

   USE ( cFileName ) NEW SHARED

   #endif

   SET ORDER TO 1

   DATABASE ::oDBVariables
   ::oDBVariables:bEoF = nil

   DBSELECTAREA( nAreaAnterior )

return Self

//------------------------------------//
//Read(cVar, uDefault) Read Variable, retorna el valor de la variable establecida en la tabla VARIABLES
METHOD Read( cName, uDefault ) CLASS TDBPublic
   LOCAL uValue

   cName := AllTrim(Upper(cName))

   IF ::Get( cName ) = NIL

      //Recuperar del archivos de variables
      ::oDBVariables:SetOrder( "NAME" )
      IF ::oDBVariables:Seek( cName, .F. )

         IF uDefault <> NIL .AND. ValType(uDefault) <> ::oDBVariables:Type
        ::oDBVariables:Type := ValType(uDefault)
        ::oDBVariables:Save()
         ENDIF

         DO CASE
         CASE ::oDBVariables:Type $ "CM"
              uValue := RTRIM(::oDBVariables:Value) //en el caso de las variables caracter/memo se les quita los blancos de la derecha
         CASE ::oDBVariables:Type = "N"
              uValue := VAL(RTRIM(::oDBVariables:Value))
         CASE ::oDBVariables:Type = "D"
              uValue := CTOD(::oDBVariables:Value)
         CASE ::oDBVariables:Type = "L"
              uValue := UPPER(RTRIM(::oDBVariables:Value))=".T."
         CASE ::oDBVariables:Type = "A"
              uValue:=ARRAY(VAL( SubStr(::oDBVariables:Value,AT("[",::oDBVariables:Value)+1,AT("]",::oDBVariables:Value)-AT("[",::oDBVariables:Value)-1) ))
          AEVAL(uValue, {|x,i| uValue[i] := ::Read("{"+cValToChar(i)+"}"+cName) } )
         CASE ::oDBVariables:Type $ "UO"
              uValue := NIL
         CASE ::oDBVariables:Type = "B" //Los CodeBlock solo se los puede restaurar. !No se los puede salvar!.
                                        //La edicion de estas variables es direcctamente en la tabla
              //uValue := GenBlock( ::oDBVariables:Value )
         END CASE

         if AT("{",cName)>0 .AND. AT("}",cName)>0
        RETURN uValue
     else
            ::nPos := ASCAN( ::aVars, {|aVal| aVal[ VARNAME ] == cName } )
            ::aVars[::nPos, VARVALUE] := uValue
     endif

      ELSE

         Return ::Save( cName, uDefault )

      ENDIF

   endif

RETURN ::aVars[::nPos, VARVALUE]

//----------------------------------------------------------------//
//Save(cName, uValue ) Salva el valor de Variable en el arreglo ::aVars y la graba a la tabla Variables
METHOD Save( cName, uValue ) CLASS TDBPublic

   cName := AllTrim(Upper(cName))

   DEFAULT uValue := ::Get(cName)

   ::Set( cName, uValue )

   IF !( cName == ::oDBVariables:NAME)

      ::oDBVariables:SetOrder( "NAME" )
      IF ! ::oDBVariables:Seek( cName, .F. )
         ::oDBVariables:APPEND()
         ::oDBVariables:NAME := cName
      ENDIF

   ENDIF

   ::oDBVariables:TYPE := ValType(uValue)

   IF ::oDBVariables:TYPE="A" //para grabar arreglos
      ::oDBVariables:VALUE := cValToChar(uValue)+"["+cValToChar(LEN(uValue))+"]"
      ::oDBVariables:Save()
      AEVAL(uValue, {|uValue,i| ::Save("{"+cValToChar(i)+"}"+cName, uValue) } )
   else
      ::oDBVariables:VALUE := cValToChar(uValue)
      ::oDBVariables:Save()
   ENDIF

return uValue

Atentamente,

Rolando

Desde Cochabamba, Bolivia.

[Daniel Garcia-Gil]

Hola

La pregunta es ¿donde se graban los valores con el método Save() y de donde los recupera Restore()?

La guarda temporalmente en un hash y las restaura en los valores de sus datas

La idea es que las variables puedan ser compartidas, sobre todo si son de configuración.

es una de las ventajas que tiene la clase, puede crear metodos dinamicamente y si quieres que los guarde los valores, fisicamente puedes crear la funcion y asignarla como un metodo o simplemete modificar la clase

[Compuin]

Les dejo una nueva version con nuevas funcionalidades

agregados metodos IsDefData, IsDefMethod, Save, Restore

Code: Select all | Expand

//
//Designed by: Daniel Garcia-Gil [ danielgarciagil@gmail.com ]
//
//Class TPublic
//Create dynamically Datas
//Create "in fly" new methods

#include "hbclass.ch"

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

CLASS TPublic

   DATA __hVar__

   METHOD New()
   METHOD AddData( cData )
   METHOD AddMethod( cMethod )
   METHOD DelData( cData )
   METHOD DelMethod( cMethod )
   METHOD IsDefData( cData )     INLINE __objHasData( Self, cData )
   METHOD IsDefMethod( cMethod ) INLINE __objHasMethod( Self, cMethod )

   METHOD Restore()
   
   METHOD Save() 
   METHOD SendMsg()

   ERROR HANDLER ONERROR()    


ENDCLASS

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

METHOD New( ) CLASS TPublic

   ::__hVar__ = {=>}

return Self

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

METHOD AddData( cData ) CLASS TPublic
   
   if ! __objHasData( Self, cData )
      __objAddData( Self, cData )      
   endif
   
return nil   
   
//------------------------------------------------//

METHOD AddMethod( cMethod, pFunc )
 
   if ! __objHasMethod( Self, cMethod )  
      __objAddMethod( Self, cMethod, pFunc )    
   endif

return nil

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

METHOD DelData( cData ) CLASS TPublic

   if ! __objHasData( Self, cData )
      __objDelMethod( Self, cData )      
   endif
   
return nil   

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

METHOD DelMethod( cMethod, pFunc ) CLASS TPublic
 
   if ! __objHasMethod( Self, cMethod )  
      __objDelMethod( Self, cMethod )    
   endif

return nil

//------------------------------------------------//
//Return a Array with current data values
METHOD Restore() CLASS TPublic

   local b := {| cKey, uValue | ::SendMsg( "_" + cKey, uValue ) }
   local aOld := __objGetValueList( Self, HB_OO_DATA_SYMBOL )
   
#ifndef __XHARBOUR__  
   hb_HEVAL( ::__hVar__, b )
#else   
   HEVAL( ::__hVar__, b )
#endif   
   
return aOld

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

METHOD Save() CLASS TPublic
   
   local aDatas
   local a, cData
   
   aDatas = __objGetValueList( Self, HB_OO_DATA_SYMBOL ) 
   
   for each a in aDatas
      cData = Upper( a[ 1 ] ) 
      if cData != "__HVAR__"
         ::__hVar__[ cData ] = a[ 2 ]
      endif
   next
   
RETURN NIL

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

#ifndef __XHARBOUR__
METHOD SendMsg( cMsg, ...  ) CLASS TPublic
   if "(" $ cMsg
      cMsg = StrTran( cMsg, "()", "" )
   endif
return __ObjSendMsg( Self, cMsg, ... )
#else   
METHOD SendMsg( ... ) CLASS TPublic
   local aParams := hb_aParams()
      
   if "(" $ aParams[ 1 ]
      aParams[ 1 ] = StrTran( aParams[ 1 ], "()", "" )
   endif
 
   ASize( aParams, Len( aParams ) + 1 )
   AIns( aParams, 1 )
   aParams[ 1 ] = Self
   
   return hb_execFromArray( aParams )   
      
#endif 


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

METHOD ONERROR( uParam1 ) CLASS TPublic
   local cCol    := __GetMessage()
   local uRet
   
   if Left( cCol, 1 ) == "_"
      cCol = Right( cCol, Len( cCol ) - 1 )
   endif
   
   if ! __objHasData( Self, cCol )
      ::AddData( cCol )
   endif
   
#ifndef __XHARBOUR__
   if uParam1 == nil
      uRet = __ObjSendMsg( Self, cCol )
   else
      uRet = __ObjSendMsg( Self, "_" + cCol, uParam1 )
   endif
#else   
   if uParam1 == nil
      uRet = hb_execFromArray( Self, cCol )
   else
      uRet = hb_execFromArray( Self, cCol, { uParam1 } )
   endif
#endif    
   
   
RETURN uRet
 

Hola Daniel/Armando

Esta TPublic podria ser funcional para Harbour tambien ?

Se le pueden agregar los metodos Get y Set ?

Gracias

[Busmatic_wpb]

Buenas Listeros
Yo he usado de la Daniel y trabaja exelente muy buena la aportacion del compañero.
Gracias por compartir .

[Compuin]

Buenas Listeros
Yo he usado de la Daniel y trabaja exelente muy buena la aportacion del compañero.
Gracias por compartir .

Hola, la usas con Harbour ?