"swaping" de funciones

User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

"swaping" de funciones

Post by Antonio Linares »

Esto es un "hack" de la máquina virtual :-), pero puede resultar muy util en determinadas circunstancias. Lo publico aqui por si alguien quiere probarlo:

test.prg

Code: Select all

#include "FiveWin.ch"

static pOld

function Main()

   pOld := FunSwap( "TIME", "MYTIME" )

   MsgInfo( Time() ) // Hemos reemplazado la función Time() original ! :-)

return nil

function MyTime()

   local uRet := ExecPtr( pOld ) // en caso de que queramos llamar a la función original

return "now"

#pragma BEGINDUMP

#include <hbapi.h>

typedef void ( * PFUNC ) ( void );

HB_FUNC( FUNSWAP )
{
   PHB_SYMB symFirst = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 1 ) ) );
   PHB_SYMB symLast  = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 2 ) ) );
   PHB_FUNC pFirst   = symFirst->value.pFunPtr;
   
   symFirst->value.pFunPtr = symLast->value.pFunPtr;
   
   hb_retnl( ( LONG ) pFirst );
}

HB_FUNC( EXECPTR )
{
   PFUNC p = ( PFUNC ) hb_parnl( hb_pcount() );
   
   p();
}   

#pragma ENDDUMP   
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Otro ejemplo:

test.prg

Code: Select all

#include "FiveWin.ch"

static pOld

function Main()

   pOld := FunSwap( "DATE", "TOMORROW" )

   MsgInfo( Date() ) // We have replaced the original Date() function! :-)

return nil

function Tomorrow()

   local uRet := ExecPtr( pOld ) // in case that we want to call the original function

return uRet + 1

#pragma BEGINDUMP

#include <hbapi.h>

typedef void ( * PFUNC ) ( void );

HB_FUNC( FUNSWAP )
{
   PHB_SYMB symFirst = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 1 ) ) );
   PHB_SYMB symLast  = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 2 ) ) );
   PHB_FUNC pFirst   = symFirst->value.pFunPtr;
   
   symFirst->value.pFunPtr = symLast->value.pFunPtr;
   
   hb_retnl( ( LONG ) pFirst );
}

HB_FUNC( EXECPTR )
{
   PFUNC p = ( PFUNC ) hb_parnl( hb_pcount() );
   
   p();
}   

#pragma ENDDUMP   
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Una manera util de crear logs ó verificar parámetros:

test.prg

Code: Select all

#include "FiveWin.ch"

static pOld

function Main()

   pOld := FunSwap( "TEST", "LOGIT" )

   MsgInfo( Test( "Hello", " world!" ) )

return nil

function Test( u1, u2 )

return u1 + u2

function LogIt( u1, u2 )

   local uRet := ExecPtr( u1, u2, pOld ) // in case that we want to call the original function

   MsgInfo( "Test() called with these parameters: " + u1 + ", " + u2 )

return uRet

#pragma BEGINDUMP

#include <hbapi.h>

typedef void ( * PFUNC ) ( void );

HB_FUNC( FUNSWAP )
{
   PHB_SYMB symFirst = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 1 ) ) );
   PHB_SYMB symLast  = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 2 ) ) );
   PHB_FUNC pFirst   = symFirst->value.pFunPtr;
   
   symFirst->value.pFunPtr = symLast->value.pFunPtr;
   
   hb_retnl( ( LONG ) pFirst );
}

HB_FUNC( EXECPTR )
{
   PFUNC p = ( PFUNC ) hb_parnl( hb_pcount() );
   
   p();
}   

#pragma ENDDUMP   
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Gracias, esto esta muy interesante, con esto ya no hay duda a la hora de querer reemplazar una función de la librería por una nuestra, ya le encontré utilidad con la gran ventaja de poder hacer llamado a la original, algo así como si fuera un método de la clase superior :)

¿habrá alguna manera de poder leer el valor de una variable estática?
Saludos
Quique
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

¿habrá alguna manera de mandar el apuntador para poder substituir por una función estática? algo como esto (es xharbour no se si también lo tenga harbour)

pOld := FunSwap( "TIME", @mytime() )

o inclusive

pOld := FunSwap( @time(), @mytime() )

realmente la única importante sería la primera, ya que time() siempre es visible
Saludos
Quique
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Quique,

Sabía que te iba a interesar este tema :-)

Se puede hacer todo lo que comentas, pero ojo, el código ha de ser distinto, ya que @name() devuelve un item "pointer", pero a partir de él podemos llegar a su puntero real :-) (El verdadero puntero en C del código).
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Jajajajaja ¿tan obvio soy? :P

Si me interesa, de hecho, ya tengo el programa en el que lo voy a probar, pero si me interesa la posibilidad de utilizar funciones estáticas para las funciones substitutas, esto es con el fin de no tener que preocuparme si existe alguna otra con el mismo nombre, ya sea en en el programa o alguna librería, despues de todo no será llamada en ningún otro lado con el nombre real.

Y el tema de las estáticas también lo tengo, necesito conocer el valor de una variable estática (en este caso dentro del prg no de la función), para no tener que copiar todo el prg para modificar una sola función.
Saludos
Quique
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Quique,

No es que sea adivino, sino que esta mañana encontré esto :-)

http://groups.google.com/group/comp.lan ... b43475b371

Basándote en el código que he proporcionado, y usando un item "pointer" deberias poder acceder a funciones estáticas.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Pues me echaré un clavado, si no, le pediré ayuda a los expertos, lo que pasa es que mi conocimiento de C es algo menos que básico, ya escribiré aquí la solución para que la suban al fivewin wiki
Saludos
Quique
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Cortesia de Vic (vic@guerra.com.mx) (no es conocido del foro porque no se asoma por aquí), gracias gran gurú de xharbour.

Code: Select all

function Main()
    FunSwapPtr( "DATE", @MyDate() )

    ? DATE()
    ? &( "DATE()" )
return nil

#pragma BEGINDUMP

#include <hbapi.h>

typedef void ( * PFUNC ) ( void );

HB_FUNC( FUNSWAPPTR )
{
    PHB_SYMB symFirst = hb_dynsymSymbol( hb_dynsymFindName( hb_parc( 1 ) ) );
    PHB_FUNC pFirst   = symFirst->value.pFunPtr;

    symFirst->value.pFunPtr = ( ( PHB_SYMB ) hb_parptr( 2 ) )->value.pFunPtr;

    hb_retnl( ( LONG ) pFirst );
}

#pragma ENDDUMP

STATIC FUNCTION MyDate()
RETURN STOD( "19680329" )

Saludos
Quique
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Quique,

Me dejastes pensando con esto que comentastes:

> con la gran ventaja de poder hacer llamado a la original, algo así como si fuera un método de la clase superior

Y he jugado un poco con el asunto, creando la Clase TFunction :-)

Ojo, este código solo sirve para Harbour, ya que xHarbour usa un tipo distinto para @name(), asi que habría que modificarlo para xHarbour. Mis saludos a Vic y nuestra invitación a visitarnos :-)

test.prg

Code: Select all

#include "FiveWin.ch"

function Main()

   local oTime := TFunction():New( @Time() )
   local oMyTime := TFunction():New( @MyTime() ) 

   MsgInfo( oTime:Exec() )

   oTime:Swap( oMyTime )

   MsgInfo( Time() )
   MsgInfo( oTime:Original() )

   oTime:Restore()

   MsgInfo( Time() )

return nil

function MyTime()

return "now"

CLASS TFunction

   DATA   pFunction
   DATA   hPointer

   METHOD New( pFunction )
   
   METHOD Exec() INLINE HB_ExecFromArray( ::pFunction, HB_aParams() )
   
   METHOD Swap( oFunction ) INLINE FunSwap( ::pFunction, oFunction:pFunction )  

   METHOD Restore() INLINE FunRestore( ::pFunction, ::hPointer )
   
   METHOD Original() INLINE HB_ExecFromArray( GenSymbol( @FunDummy(), ::hPointer ), HB_aParams() )

ENDCLASS

METHOD New( pFunction ) CLASS TFunction

   ::pFunction = pFunction
   ::hPointer = FunPtr( pFunction )
   
return Self

#pragma BEGINDUMP

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

HB_FUNC( FUNPTR )
{
   PHB_ITEM pFunction = hb_param( 1, HB_IT_SYMBOL );
   
   hb_retnl( ( LONG ) ( pFunction ? hb_itemGetSymbol( pFunction )->value.pFunPtr : 0 ) );
}

HB_FUNC( FUNSWAP )
{
   PHB_ITEM pFirst = hb_param( 1, HB_IT_SYMBOL );
   PHB_ITEM pLast  = hb_param( 2, HB_IT_SYMBOL );
   
   if( pFirst && pLast )
   {
      hb_itemGetSymbol( pFirst )->value.pFunPtr = hb_itemGetSymbol( pLast )->value.pFunPtr;
   }
}       

HB_FUNC( FUNRESTORE )
{
   PHB_ITEM pFunction = hb_param( 1, HB_IT_SYMBOL );
   PHB_SYMB pSymbol = hb_itemGetSymbol( pFunction );
   
   if( pSymbol )
      pSymbol->value.pFunPtr = ( void * ) hb_parnl( 2 );
}   

HB_FUNC( GENSYMBOL )
{
   PHB_SYMB pSymbol = hb_dynsymSymbol( hb_dynsymFindName( "FUNDUMMY" ) );
   
   pSymbol->value.pFunPtr = ( void * ) hb_parnl( 2 );
   hb_itemPutSymbol( hb_stackReturnItem(), pSymbol );
}

HB_FUNC( FUNDUMMY )
{
}

#pragma ENDDUMP   
regards, saludos

Antonio Linares
www.fivetechsoft.com
Rossine
Posts: 343
Joined: Tue Oct 11, 2005 11:33 am

Post by Rossine »

Olá Antonio,

Ao compilar seu exemplo , me é gerado o erro abaixo:

Code: Select all

xLINK: error: Unresolved external symbol '_hb_itemPutSymbol'.
xLINK: fatal error: 1 unresolved external(s).
Saludos,

Rossine.
Obrigado, Regards, Saludos

Rossine.

xHarbour comercial (xAcc) -> Testando harbour + bcc / msvc
fwh 9.05
Windows XP SP2
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Rossine, según veo utilizas xHarbour, Antonio dijo que ese código es para harbour, intenté pasarlo, pero no pude, ya pedí ayuda ;)
Saludos
Quique
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Rossine,

Como te ha comentado Quique, esa versión es para Harbour. Para xHarbour hay que hacer _, pues xHarbour no usa el tipo "symbol" sino el tipo "pointer":

Harbour:
MsgInfo( ValType( @Time() ) ) // muestra "S"

xHarbour:
MsgInfo( ValType( @Time() ) ) // muestra "P"
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Modificaciones para xHarbour gracias de nuevo al master Vic, no se si también funcione para harbour

Code: Select all

#include "hbclass.ch"



PROCEDURE Main()

   TimeTest()

   StodTest()

RETURN



PROCEDURE TimeTest

LOCAL oMyTime := TFunction():New( @MyTime() )

local oTime := TFunction():New( @Time() )



   ? "Time() test..."

   ? oTime:Exec()



   oTime:Swap( oMyTime )



   ? Time()

   ? oTime:Original()



   oTime:Restore()



   ? Time()

   ?

RETURN



FUNCTION MyTime()

RETURN "now"



PROCEDURE StodTest

LOCAL oMyStod := TFunction():New( @MyStod() )

LOCAL cDate := "20080131"

PRIVATE oStod := TFunction():New( @Stod() )



   ? "Stod() test..."

   ? oStod:Exec( cDate )



   oStod:Swap( oMyStod )



   ? Stod( cDate )

   ? "Atencion: ", Stod( "20080131" )

   ? oStod:Original( cDate )



   oStod:Restore()



   ? Stod( cDate )

   ?

RETURN nil



FUNCTION MyStod( s )

RETURN oStod:Original( s ) - 1







CLASS TFunction

   DATA   pFunction

   DATA   hPointer



   METHOD New( pFunction )

   METHOD Exec

   METHOD Swap( oFunction ) INLINE FunSwap( ::pFunction, oFunction:pFunction)

   METHOD Restore() INLINE FunRestore( ::pFunction, ::hPointer )

   METHOD Original

ENDCLASS



METHOD New( pFunction ) CLASS TFunction

   ::pFunction = pFunction

   ::hPointer = FunPtr( pFunction )

RETURN Self



#pragma BEGINDUMP



#include <hbapi.h>

#include <hbapiitm.h>

#include <hbvm.h>

#include <hbstack.h>

#include <windows.h>



HB_FUNC( FUNPTR )

{

   PHB_SYMB pFunction = ( PHB_SYMB ) hb_parptr( 1 );

   hb_retptr( ( void * ) ( pFunction ? pFunction->value.pFunPtr : 0 ) );

}



HB_FUNC( FUNSWAP )

{

   PHB_SYMB pFirst = ( PHB_SYMB ) hb_parptr( 1 );

   PHB_SYMB pLast  = ( PHB_SYMB ) hb_parptr( 2 );



   if( pFirst && pLast )

   {

      pFirst->value.pFunPtr = pLast->value.pFunPtr;

   }

}



HB_FUNC( FUNRESTORE )

{

   PHB_SYMB pSymbol = ( PHB_SYMB ) hb_parptr( 1 );



   if( pSymbol )

   {

      pSymbol->value.pFunPtr = ( void * ) hb_parptr( 2 );

   }

}



typedef void ( * PFUNC ) ( void );



HB_FUNC( TFUNCTION_EXEC )

{

   PHB_ITEM pSelf = hb_stackSelfItem();

   PHB_SYMB pFunction;

   PFUNC p;

   static PHB_SYMB hPointer = 0;



   if( ! hPointer )

   {

      hPointer = hb_dynsymSymbol( hb_dynsymFind( "PFUNCTION" ) );

   }



   hb_vmPushSymbol( hPointer );

   hb_vmPush( pSelf );

   hb_vmSend( 0 );



   pFunction = ( PHB_SYMB ) hb_parptr( -1 );

   p = ( PFUNC ) pFunction->value.pFunPtr;



   p();

}



HB_FUNC( TFUNCTION_ORIGINAL )

{

   PHB_ITEM pSelf = hb_stackSelfItem();

   PFUNC p;

   static PHB_SYMB hPointer = 0;



   if( ! hPointer )

   {

      hPointer = hb_dynsymSymbol( hb_dynsymFind( "HPOINTER" ) );

   }



   hb_vmPushSymbol( hPointer );

   hb_vmPush( pSelf );

   hb_vmSend( 0 );



   p = ( PFUNC ) hb_parptr( -1 );



   p();

}



#pragma ENDDUMP
Saludos
Quique
Post Reply