FiveTech Software tech support forums

www.FiveTechSoft.com
https://fivetechsoft.com/forums/

Enviando un mensaje a un objeto desde bajo nivel

https://fivetechsoft.com/forums/viewtopic.php?f=6&t=21778

Page 1 of 3

Enviando un mensaje a un objeto desde bajo nivel

Posted: Sun Jun 19, 2011 4:35 am
by Antonio Linares
Usando hb_objSendMsg()

Code: Select all

#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
 

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Mon Jun 20, 2011 3:06 pm
by 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? :roll: :?: :D

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Wed Jun 22, 2011 4:05 am
by 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.

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Wed Jun 22, 2011 7:32 pm
by xmanuel
Hola Carlos, esa te la puedo decir yo ;-)

Prueba con: hbapi.h :mrgreen:

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Thu Jun 23, 2011 4:55 am
by 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 :-)

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Thu Jun 23, 2011 6:30 pm
by xmanuel
Antonio...
Mira tu correo :-)

Saludos
Manu Expósito

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Fri Jun 24, 2011 7:05 pm
by 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

#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

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Fri Jun 24, 2011 11:42 pm
by 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

#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
 

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Fri Jun 24, 2011 11:49 pm
by Daniel Garcia-Gil
Antonio Linares wrote: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

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

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Sat Jun 25, 2011 12:01 am
by Antonio Linares
Cierto, gracias Daniel :-)

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Sat Jun 25, 2011 11:49 am
by 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...

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Sat Jun 25, 2011 11:56 am
by 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 :D

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Sat Jun 25, 2011 6:59 pm
by 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

// 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

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Sat Jun 25, 2011 7:27 pm
by Antonio Linares
Y aqui lo prometido: una Clase construida enteramente desde lenguaje C :-)

Code: Select all

// 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

Re: Enviando un mensaje a un objeto desde bajo nivel

Posted: Sun Jun 26, 2011 12:08 pm
by 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...
All times are UTC
Page 1 of 3

Powered by phpBB® Forum Software © phpBB Limited