Enviando un mensaje a un objeto desde bajo nivel

[Antonio Linares]

Usando hb_objSendMsg()

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

  local o := Test()
 
  o:nData = 1234
 
  SetValue( o, 4321 )
 
  ? o:nData

return nil

CLASS Test

   DATA nData
   
ENDCLASS

#pragma BEGINDUMP
#include <hbapicls.h>

HB_FUNC( SETVALUE )
{
   hb_objSendMsg( hb_param( 1, HB_IT_OBJECT ), "_NDATA", 1, hb_param( 2, HB_IT_ANY ) );
}

#pragma ENDDUMP
 

[xmanuel]

Antonio este tema me interesa mucho...

Podrías poner un ejemplo muy simple de una clase con una o dos datas y uno o dos métodos creada desde C?

[Cgallegoa]

Antonio,

Cuál es el equivalente de hbapicls.h en xHarbour ?

Saludos,

Carlos Gallego

P.D. No dejes de lado xHarbour o algunos quedaremos fuera de posibilidades.

[xmanuel]

Hola Carlos, esa te la puedo decir yo

Prueba con: hbapi.h

[Antonio Linares]

Manu,

No tiene mucho interés crear la clase desde C si tenemos que crearla llamando a métodos de alto nivel (PRG) de la Clase HBClass, para eso es más sencillo usar CLASS ... ENDCLASS

Lo que si sería muy interesante es enlazar una clase en C++ con el motor de clases de Harbour. Esto es algo que hizo nuestro querido Bruno Cantero en su C3 pero nunca explicó exactamente como lo hacia

[xmanuel]

Antonio...
Mira tu correo

Saludos
Manu Expósito

[Antonio Linares]

Manu,

Esta es una prueba del concepto de Bruno de usar un objeto C++ mantenido desde el objeto PRG

El objeto PRG mantiene un puntero al objeto C++ y a su vez el objeto C++ mantiene un puntero al objeto PRG, con lo que pueden comunicarse en uno y otro sentido

La ventaja principal es que una vez estamos en bajo nivel (C++) podemos acceder a métodos en bajo nivel (C++) sin pasar por la máquina virtual de Harbour con lo que la velocidad mejoraría mucho, como contrapartida hay que escribir más código al crear la clase para hacer la conexión en ambos sentidos.

Hay que probarlo en modo C++, por lo que no sirve samples\buildh.bat, sino que hay que usar buildhm.bat ó build64.bat para usar el compilador de Microsoft.

cpp.prg

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

   local o := Test():New()

   o:One()
   
   MsgInfo( o:lData1 )
   
   o:lData1 = 345
   
   MsgInfo( o:lData1 )
   
   MsgInfo( o:Self:ClassName() )

   o:End()

return nil

CLASS Test

   DATA pCppObj
   
   METHOD New() INLINE ::pCppObj := TestNew( Self ), Self

   METHOD One() INLINE TestOne( ::pCppObj )
   
   METHOD lData1 INLINE TestGetData1( ::pCppObj )
   
   METHOD _lData1( nVal ) INLINE TestSetData1( ::pCppObj, nVal )
   
   METHOD Self() INLINE TestGetSelf( ::pCppObj )
   
   METHOD End() INLINE TestEnd( ::pCppObj ), ::pCppObj := nil

ENDCLASS

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapiitm.h>
#include <windows.h>

class Test
{
   public:
      PHB_ITEM pPrgObj;
      long lData1;
      char * cData2;
      BOOL bData3;
   
      void Create( void );
      void One( void );
};

void Test::Create( void )
{
   lData1 = 123;
}

void Test::One( void )
{
   MessageBox( 0, "One", "from C++ level", 0 );
}  

HB_FUNC( TESTNEW )
{
   Test * pTest = new Test;
   
   pTest->Create();
   pTest->pPrgObj = hb_gcGripGet( hb_param( 1, HB_IT_OBJECT ) );
   
   hb_retptr( pTest );
}  

HB_FUNC( TESTONE )
{
   Test * pTest = ( Test * ) hb_parptr( 1 );
   
   pTest->One();
}

HB_FUNC( TESTGETDATA1 )
{
   Test * pTest = ( Test * ) hb_parptr( 1 );
   
   hb_retnl( pTest->lData1 );
}

HB_FUNC( TESTSETDATA1 )
{
   Test * pTest = ( Test * ) hb_parptr( 1 );
   
   pTest->lData1 = hb_parnl( 2 );
}

HB_FUNC( TESTGETSELF )
{
   Test * pTest = ( Test * ) hb_parptr( 1 );
   
   hb_itemReturn( pTest->pPrgObj );
}

HB_FUNC( TESTEND )
{
   Test * pTest = ( Test * ) hb_parptr( 1 );

   hb_gcGripDrop( pTest->pPrgObj );
   delete pTest;
}
   
#pragma ENDDUMP

[Daniel Garcia-Gil]

Hola

Me parecio buen sitio para exponer el ejemplo de una tecnica para accesar datos desde C y cambiar el valor de los mismos desde Cusando el puntero a los valores...
tecnica que estoy usando para una nueva funcionalidad de TDolphin (no terminada), para el uso de sentencias preparadas.

usar en el compilador de C el flag -D_HB_API_INTERNAL_

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

 local o := TBind():New()
 
 o:uno = 123
 o:dos = "hola"
 o:tres = .T.
 
 o:BuildBind()
 
 ? "Valores Iniciales", o:uno, o:dos, o:tres
 
 o:uno = 321
 o:dos = "adios"
 o:tres = .F.

 ? "Valores Cambiados", o:uno, o:dos, o:tres
 
 o:ChangeValue( "uno" )
 
 ? "Valor cambiado desde C DATA 'uno'",  o:uno
 
 o:End()

CLASS TBind
 
  DATA hDatas
  DATA hBind

  METHOD New()
  METHOD End() INLINE EndBind( @::hBind )
  METHOD AddData( cName, uValue )
  METHOD BuildBind()
 
  METHOD changevalue()
 
  METHOD GetValue( cName )
  METHOD SetValue( cName, cValue )
 
  ERROR HANDLER ONERROR()    
 

ENDCLASS

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


METHOD New() CLASS TBind

 ::hDatas = hb_HASH()
 
return Self

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


METHOD AddData( cName ) CLASS TBind
 
  cName := Upper( cName )
 
  if ! hb_HHasKey( ::hDatas, cName )
     hb_HSet( ::hDatas, cName, NIL )
  endif
 
  ::hDatas[ cName ] = ItemNew( 0 )
 
return nil

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

METHOD BuildBind() CLASS TBind

   local n
   local nLen := Len( ::hDatas )
   ::hBind = NewBind( nLen )

   for n = 1 to nLen
      setbind( @::hBind, n, @::hDatas[ hb_HKEYAT( ::hDatas, n ) ] )
   next

return nil

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

METHOD changevalue( cName ) CLASS TBind
   
   local nPos := hb_HPOS( ::hDatas, Upper( cName ) )
   
   changevalue( @::hBind, nPos )

return nil


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

METHOD GetValue( cName ) CLASS TBind

   local uValue
   local nPos := hb_HPOS( ::hDatas, Upper( cName ) )
   
   uValue = GetBind( @::hBind, nPos )
   
return uValue

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

METHOD SetValue( cName, uValue ) CLASS TBind

   SetValue( ::hDatas[ cName ], uValue )  

return uValue

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

METHOD ONERROR( uParam1 ) CLASS TBind
   local cCol    := Upper( __GetMessage() )
   local uRet
   
   if Left( cCol, 1 ) == "_"
      cCol = Right( cCol, Len( cCol ) - 1 )
   endif
   
   if ! hb_HHasKey( ::hDatas, cCol )
      ::AddData( cCol )
   endif
   
   if uParam1 == nil
      uRet = ::GetValue( cCol )
   else
      uRet = ::SetValue( cCol, uParam1 )
   endif
   
RETURN uRet


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


#pragma BEGINDUMP
#include <hbapi.h>
#include <hbapiitm.h>
#include <windows.h>


typedef struct _MYSQL_BIND
{
  HB_TYPE type;
  int iLen;
  void * pValue;
} MYSQL_BIND;


HB_FUNC( ENDBIND )
{
   MYSQL_BIND * pBind = ( MYSQL_BIND * ) hb_parptr( 1 );
   hb_xfree( pBind );
}



HB_FUNC( GETBIND )
{
   MYSQL_BIND * pBind = ( MYSQL_BIND * ) hb_parptr( 1 );
   MYSQL_BIND * bind = &pBind[ hb_parni( 2 ) - 1 ];
   void * u = bind->pValue;


   switch( bind->type )
   {
      case HB_IT_INTEGER:
         hb_retni( * (( int * ) u) );
         break;
      case HB_IT_LONG:
         hb_retnl( *(( long * ) u ));
         break;
      case HB_IT_STRING:
         hb_retclen( ( ( char * ) u ), bind->iLen );
         break;
      default:
         hb_retni( *( ( int * ) u ) );
   }
   
}

HB_FUNC( NEWBIND )
{
   MYSQL_BIND * pBind = ( MYSQL_BIND * ) hb_xgrab( sizeof( MYSQL_BIND ) * hb_parni( 1 ) );
   hb_retptr( pBind );
}


HB_FUNC( SETBIND )
{
   PHB_ITEM pData;
   MYSQL_BIND * pBind;
   MYSQL_BIND * bind;

   pData = ( PHB_ITEM ) hb_parptr( 3 );

   pBind = ( MYSQL_BIND * ) hb_parptr( 1 );
   bind = &pBind[ hb_parni( 2 ) - 1 ];
   
   bind->type = pData->type;
   
   switch( pData->type )
   {
      case HB_IT_LONG:
         bind->pValue = ( void *) &pData->item.asLong.value;
         break;
      case HB_IT_STRING:
         bind->pValue = ( void *) pData->item.asString.value;
         bind->iLen = pData->item.asString.length;
         break;
      case HB_IT_INTEGER:
      default:
         bind->pValue = ( void *) &pData->item.asInteger.value;
         break;
   }    
}

HB_FUNC( ITEMNEW )
{
  hb_retptr( ( void * ) hb_itemParam( 1 ) );
}

HB_FUNC( SETVALUE )
{
  hb_itemCopy( ( PHB_ITEM ) hb_parptr( 1 ), hb_param( 2, HB_IT_ANY ) );
}

HB_FUNC( GETVALUE )
{
  hb_itemReturn( ( PHB_ITEM ) hb_parptr( 1 ) );
}

HB_FUNC( CHANGEVALUE )
{
   MYSQL_BIND * pBind = ( MYSQL_BIND * ) hb_parptr( 1 );
   MYSQL_BIND * bind = &pBind[ hb_parni( 2 ) - 1 ];
   int * u = ( int * )bind->pValue;

  *u = 11111;
   
}

#pragma ENDDUMP
 

[Daniel Garcia-Gil]

Hay que probarlo en modo C++, por lo que no sirve samples\buildh.bat, sino que hay que usar buildhm.bat ó build64.bat para usar el compilador de Microsoft.

bastaria con agregar el flag -P al compilador de borland

Code: Select all  Expand view  RUN

echo -O2 -e%1.exe -I%hdir%\include -I%bcdir%\include %1.c > b32.bc
%bcdir%\bin\bcc32 -M -c -P @b32.bc

[Antonio Linares]

Cierto, gracias Daniel

[xmanuel]

Gracias Antonio...

Aunque la idea es hacer totalmente la clase en C como está hecha la clase Error de (x)Harbour... mira errapi.c
Pero ahí sólo hay datas y esta muy bien por que se acceden a ellas por el indice que ocupan. El tema es meter también métodos...

[xmanuel]

Hola Daniel...
Está muy bien la idea de las sentencias precompiladas en el lado del servidor...

Yo ya las tengo implementadas desde hace un poco de tiempo, los usuarios registrados tienen la parte PRG en la clase mspreparedstmt.prg
He conseguido definir variables tipo (x)Hb y asignarles el valor actual del registro en el que se encuentra directamente. Lo consigo asignado el puntero del valor del item al bind... todo bien, peroooooooooooooooo de vez en cuando me da un precioso "error de protección general" así que he decidido estudiar el tema más profundamente... cuando lo tenga resuelto lo publicaré en Eagle1 v10.00

[Antonio Linares]

Manu,

Buena observación la de mirar en errapi.c, no se me había ocurrido

Aqui esta! Mi ejemplo anterior pasado integramente a bajo nivel (lenguaje C)

En un siguiente ejemplo pondré algo más simple, sin usar un objeto en C++.

Code: Select all  Expand view  RUN

// Using a C++ Class and object from a Harbour Class and object
// Build it using samples\buildhm.bat or samples\build64.bat or add -P flag to bcc32 in samples\buildh.bat

#include "FiveWin.ch"

function Main()

   local o := Test():New()
   
   MsgInfo( ValType( o:pCppObj ) )

   o:One()
   
   MsgInfo( o:lData1 )
   
   o:lData1 = 345
   
   MsgInfo( o:lData1 )
   
   o:End()
   
   MsgInfo( ValType( o:pCppObj ) )

return nil

/*
CLASS Test

   DATA pCppObj
   
   METHOD New() INLINE ::pCppObj := TestNew( Self ), Self

   METHOD One() INLINE TestOne( ::pCppObj )
   
   METHOD lData1 INLINE TestGetData1( ::pCppObj )
   
   METHOD _lData1( nVal ) INLINE TestSetData1( ::pCppObj, nVal )
   
   METHOD End() INLINE TestEnd( ::pCppObj ), ::pCppObj := nil

ENDCLASS
*/

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapiitm.h>
#include <hbapicls.h>
#include <hbstack.h>
#include <windows.h>

class Test
{
   public:
      PHB_ITEM pPrgObj;
      long lData1;
      char * cData2;
      BOOL bData3;
   
      void Create( void );
      void One( void );
};

void Test::Create( void )
{
   lData1 = 123;
}

void Test::One( void )
{
   MessageBox( 0, "One", "from C++ level", 0 );
}  

HB_FUNC_STATIC( TESTNEW )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );
   Test * pTest = new Test;
     
   pTest->Create();
   pTest->pPrgObj = hb_gcGripGet( pSelf );

   hb_arraySetPtr( pSelf, 1, pTest ); // pSelf[ 1 ] = pTest;
   hb_itemReturn( pSelf );  // return Self
}  

HB_FUNC_STATIC( TESTGETPCPPOBJ )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );
}  

HB_FUNC_STATIC( TESTONE )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );
   Test * pTest = ( Test * ) hb_arrayGetPtr( pSelf, 1 );
   
   pTest->One();
}

HB_FUNC_STATIC( TESTGETDATA1 )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );
   Test * pTest = ( Test * ) hb_arrayGetPtr( pSelf, 1 );
   
   hb_retnl( pTest->lData1 );
}

HB_FUNC_STATIC( TESTSETDATA1 )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );
   Test * pTest = ( Test * ) hb_arrayGetPtr( pSelf, 1 );
   
   pTest->lData1 = hb_parnl( 1 );
}

HB_FUNC_STATIC( TESTEND )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );
   Test * pTest = ( Test * ) hb_arrayGetPtr( pSelf, 1 );

   hb_gcGripDrop( pTest->pPrgObj );
   delete pTest;
   hb_arrayDel( pSelf, 1 ); // pSelf[ 1 ] = nil
}
   
HB_FUNC( TEST )
{
   static HB_USHORT usClassH = 0;
   
   if( usClassH == 0 )
   {
      usClassH = hb_clsCreate( 1, "TEST" ); // 1 DATA pCppObj
   
      hb_clsAdd( usClassH, "PCPPOBJ", HB_FUNCNAME( TESTGETPCPPOBJ ) );
      hb_clsAdd( usClassH, "LDATA1",  HB_FUNCNAME( TESTGETDATA1 ) );
      hb_clsAdd( usClassH, "_LDATA1", HB_FUNCNAME( TESTSETDATA1 ) );
      hb_clsAdd( usClassH, "ONE",     HB_FUNCNAME( TESTONE ) );
      hb_clsAdd( usClassH, "NEW",     HB_FUNCNAME( TESTNEW ) );
      hb_clsAdd( usClassH, "END",     HB_FUNCNAME( TESTEND ) );
   }
   
   hb_clsAssociate( usClassH ); // Creates an object of Class usClassH
}

#pragma ENDDUMP

[Antonio Linares]

Y aqui lo prometido: una Clase construida enteramente desde lenguaje C

Code: Select all  Expand view  RUN

// This example shows how to create a Harbour Class entirely from language C (low level)

#include "FiveWin.ch"

function Main()

   local o := Test():New()

   MsgInfo( o:ClassName() )
   MsgInfo( o:Data1 )
   
   o:Data1 = 345
   MsgInfo( o:Data1 )
   
   MsgInfo( o:Data2 )

return nil

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapiitm.h>
#include <hbapicls.h>
#include <hbstack.h>

HB_FUNC_STATIC( TESTGETDATA1 )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );

   hb_arrayGet( pSelf, 1, hb_stackReturnItem() );
}

HB_FUNC_STATIC( TESTSETDATA1 )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );

   hb_arraySet( pSelf, 1, hb_param( 1, HB_IT_ANY ) );
}

HB_FUNC_STATIC( TESTGETDATA2 )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );

   hb_arrayGet( pSelf, 2, hb_stackReturnItem() );
}

HB_FUNC_STATIC( TESTSETDATA2 )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );

   hb_arraySet( pSelf, 2, hb_param( 1, HB_IT_ANY ) );
}

HB_FUNC_STATIC( TESTNEW )
{
   PHB_ITEM pSelf = hb_param( 0, HB_IT_OBJECT );

   hb_arraySetNL( pSelf, 1, 123 ); // pSelf[ 1 ] = 123
   hb_arraySetC( pSelf, 2, "Hello world!" ); // pSelf[ 2 ] = "Hello world!"

   hb_itemReturn( pSelf );  // return Self
}

HB_FUNC( TEST )
{
   static HB_USHORT usClassH = 0;
   
   if( usClassH == 0 )
   {
      usClassH = hb_clsCreate( 2, "TEST" ); // 2 DATAs
   
      hb_clsAdd( usClassH, "DATA1",   HB_FUNCNAME( TESTGETDATA1 ) );
      hb_clsAdd( usClassH, "_DATA1",  HB_FUNCNAME( TESTSETDATA1 ) );
      hb_clsAdd( usClassH, "DATA2",   HB_FUNCNAME( TESTGETDATA2 ) );
      hb_clsAdd( usClassH, "_DATA2",  HB_FUNCNAME( TESTSETDATA2 ) );
      hb_clsAdd( usClassH, "NEW",     HB_FUNCNAME( TESTNEW ) );
   }
   
   hb_clsAssociate( usClassH ); // Creates an object of Class usClassH
}

#pragma ENDDUMP

[xmanuel]

Muchísimas gracias Antonio.

La semana que viene termino el primer curso de DAI (Desarrollo de Aplicaciones Informáticas) es un módulo de grado superior. El lunes recojo las notas... y, la buena noticia es que tendré tiempoooooo... me pondré con ello a ver qué saco

Espero que esto tenga utilidad para nuestro querido FiveWin...

Como siempre, muchas gracias Antonio... tú eres grande y te mereces lo mejor!!!!

Ahora que caigo, nos conocemos desde hace 20 años (qué viejossss!!!), jajajajajaja me acuerdo cuando iba a tu casa de Marbella con Javi y Santi (te acuerdas?)a hacerte un atraco a manos armada de código, la verdad es que siempre has estado ahí y, lo que sé, en gran medida te lo debo a ti amigo

Me siento orgulloso de tenerte...