Saber Metodos de un CREATEOBJECT

Post Reply
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

http://msdn.microsoft.com/en-us/library/cc237820.aspx
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Ya mostramos el tipo de cada uno: (faltan los parámetros)

Image

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

   local o := CreateObject( "ADODB.Recordset" )
   // local pTypeInfo

   if GetTypeInfoCount( o:hObj ) == 1 // There is info
      
      // pTypeInfo = TOleAuto():New( GetTypeInfo( o:hObj ) )
      
      // MsgInfo( pTypeInfo:GetType() )

      // GetType( o:hObj )
      
      if Len( GetTypeVars( o:hObj ) ) > 0
         XBROWSER GetTypeVars( o:hObj ) TITLE "Variables"
      endif
      
      XBROWSER ASort( GetTypeFuncs( o:hObj ) ) TITLE "Functions"
   endif

return nil

#pragma BEGINDUMP

#include <hbapi.h>
#include "c:\harbour\contrib\hbwin\hbwinole.h"

HB_FUNC( GETTYPEINFOCOUNT )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   HRESULT     lOleError;
   UINT        ctinfo;
   
   lOleError = HB_VTBL( pDisp )->GetTypeInfoCount( HB_THIS( pDisp ), &ctinfo );
   
   hb_retnl( ( lOleError == S_OK ) ? ctinfo: -1 ); 
}     

static LPSTR WideToAnsi( LPWSTR cWide )
{
   WORD wLen;
   LPSTR cString = NULL;

   wLen = WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, 0, NULL, NULL );

   cString = ( LPSTR ) hb_xgrab( wLen );
   WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, wLen, NULL, NULL );

   return cString;
}

HB_FUNC( GETTYPEINFO )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) == S_OK )
      hb_oleItemPut( hb_stackReturnItem(), ( IDispatch * ) pInfo );
   else
      hb_ret();   
}

HB_FUNC( GETTYPE )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   lOleError = HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo );

   lOleError = HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta );
}
   
HB_FUNC( GETTYPEVARS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   lOleError = HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo );

   lOleError = HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta );

   hb_reta( pta->cVars );

   for( i = 0; i < pta->cVars; i++ )
   {
      BSTR bsName;
      VARDESC * pVar;
      char * pszName; 
   
      lOleError = HB_VTBL( pInfo )->GetVarDesc( HB_THIS( pInfo ), i, &pVar );

      lOleError = HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pVar->memid, &bsName, NULL, NULL, NULL );

      pszName = WideToAnsi( bsName );
      hb_storvclen( pszName, strlen( pszName ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      
      HB_VTBL( pInfo )->ReleaseVarDesc( HB_THIS( pInfo ), pVar );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     
   
HB_FUNC( GETTYPEFUNCS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   lOleError = HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo );

   lOleError = HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta );

   hb_reta( pta->cFuncs );

   for( i = 0; i < pta->cFuncs; i++ )
   {
      BSTR bsName;
      FUNCDESC * pfd;
      char * pszName; 
      char * pszType;
      char buffer[ 100 ];
   
      lOleError = HB_VTBL( pInfo )->GetFuncDesc( HB_THIS( pInfo ), i, &pfd );

      // lOleError = HB_VTBL( pInfo )->GetNames( HB_THIS( pInfo ), pfd->memid, &bsName, 1, &uiNames );
      lOleError = HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pfd->memid, &bsName, NULL, NULL, NULL );

      pszName = WideToAnsi( bsName );
      
      switch( pfd->elemdescFunc.tdesc.vt )
      {
         case VT_PTR:
              pszType = "PTR";
              break;
              
         case VT_ARRAY:
              pszType = "ARRAY";
              break;

         case VT_CARRAY:
              pszType = "CARRAY";
              break;

         case VT_USERDEFINED:
              pszType = "USERDEFINED";
              break;

         case VT_I2: 
              pszType = "short";
              break;
              
         case VT_I4: 
              pszType = "int";
              break;
              
         case VT_R4: 
              pszType = "float";
              break;
              
         case VT_R8: 
              pszType = "double";
              break;
              
         case VT_CY: 
              pszType = "CY";
              break;
              
         case VT_DATE: 
              pszType = "DATE";
              break;
              
         case VT_BSTR: 
              pszType = "BSTR";
              break;
              
         case VT_DECIMAL: 
              pszType = "DECIMAL";
              break;
              
         case VT_DISPATCH: 
              pszType = "IDispatch";
              break;
              
         case VT_ERROR: 
              pszType = "SCODE";
              break;
              
         case VT_BOOL: 
              pszType = "VARIANT_BOOL";
              break;
              
         case VT_VARIANT: 
              pszType = "VARIANT";
              break;
              
         case VT_UNKNOWN: 
              pszType = "IUnknown";
              break;
              
         case VT_UI1: 
              pszType = "BYTE";
              break;
              
         case VT_I1: 
              pszType = "char";
              break;
              
         case VT_UI2: 
              pszType = "unsigned short";
              break;
              
         case VT_UI4: 
              pszType = "unsigned long";
              break;
              
         case VT_I8: 
              pszType = "__int64";
              break;
              
         case VT_UI8: 
              pszType = "unsigned __int64";
              break;
              
         case VT_INT: 
              pszType = "int";
              break;
              
         case VT_UINT: 
              pszType = "unsigned int";
              break;
              
         case VT_HRESULT: 
              pszType = "HRESULT";
              
         case VT_VOID: 
              pszType = "void";
              break;
              
         case VT_LPSTR: 
              pszType = "char *";
              break;
              
         case VT_LPWSTR: 
              pszType = "wchar *";
              break;

         default:
              pszType = "Error";
              break;              
      }
      sprintf( buffer, "%s %s()\n", pszType, pszName );
      hb_storvclen( buffer, strlen( buffer ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      HB_VTBL( pInfo )->ReleaseFuncDesc( HB_THIS( pInfo ), pfd );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     

#pragma ENDDUMP
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Ya podemos ver los parámetros :-)

Image

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

   local o := CreateObject( "ADODB.Recordset" )
   local aVars, aFuncs

   if GetTypeInfoCount( o:hObj ) == 1 // There is info

      if Len( aVars := GetTypeVars( o:hObj ) ) > 0
         XBROWSER ASort( aVars ) TITLE "Variables"
      endif
      
      if Len( aFuncs := GetTypeFuncs( o:hObj ) ) > 0
         XBROWSER ASort( aFuncs ) TITLE "Functions"
      endif   
   endif

return nil

#pragma BEGINDUMP

#include <hbapi.h>
#include "c:\harbour\contrib\hbwin\hbwinole.h"

HB_FUNC( GETTYPEINFOCOUNT )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   HRESULT     lOleError;
   UINT        ctinfo;
   
   lOleError = HB_VTBL( pDisp )->GetTypeInfoCount( HB_THIS( pDisp ), &ctinfo );
   
   hb_retnl( ( lOleError == S_OK ) ? ctinfo: -1 ); 
}     

static LPSTR WideToAnsi( LPWSTR cWide )
{
   WORD wLen;
   LPSTR cString = NULL;

   wLen = WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, 0, NULL, NULL );

   cString = ( LPSTR ) hb_xgrab( wLen );
   WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, wLen, NULL, NULL );

   return cString;
}
   
HB_FUNC( GETTYPEVARS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
      return;

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
      return;

   hb_reta( pta->cVars );

   for( i = 0; i < pta->cVars; i++ )
   {
      BSTR bsName;
      VARDESC * pVar;
      char * pszName; 
   
      if( HB_VTBL( pInfo )->GetVarDesc( HB_THIS( pInfo ), i, &pVar ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pVar->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );
      hb_storvclen( pszName, strlen( pszName ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      
      HB_VTBL( pInfo )->ReleaseVarDesc( HB_THIS( pInfo ), pVar );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     
   
static char * GetType( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case VT_PTR:
           pszType = "PTR";
           break;
           
      case VT_ARRAY:
           pszType = "ARRAY";
           break;

      case VT_CARRAY:
           pszType = "CARRAY";
           break;

      case VT_USERDEFINED:
           pszType = "USERDEFINED";
           break;

      case VT_I2: 
           pszType = "short";
           break;
           
      case VT_I4: 
           pszType = "int";
           break;
           
      case VT_R4: 
           pszType = "float";
           break;
           
      case VT_R8: 
           pszType = "double";
           break;
           
      case VT_CY: 
           pszType = "CY";
           break;
           
      case VT_DATE: 
           pszType = "DATE";
           break;
           
      case VT_BSTR: 
           pszType = "BSTR";
           break;
           
      case VT_DECIMAL: 
           pszType = "DECIMAL";
           break;
           
      case VT_DISPATCH: 
           pszType = "IDispatch";
           break;
           
      case VT_ERROR: 
           pszType = "SCODE";
           break;
           
      case VT_BOOL: 
           pszType = "VARIANT_BOOL";
           break;
           
      case VT_VARIANT: 
           pszType = "VARIANT";
           break;
           
      case VT_UNKNOWN: 
           pszType = "IUnknown";
           break;
           
      case VT_UI1: 
           pszType = "BYTE";
           break;
           
      case VT_I1: 
           pszType = "char";
           break;
           
      case VT_UI2: 
           pszType = "unsigned short";
           break;
           
      case VT_UI4: 
           pszType = "unsigned long";
           break;
           
      case VT_I8: 
           pszType = "__int64";
           break;
           
      case VT_UI8: 
           pszType = "unsigned __int64";
           break;
           
      case VT_INT: 
           pszType = "int";
           break;
           
      case VT_UINT: 
           pszType = "unsigned int";
           break;
           
      case VT_HRESULT: 
           pszType = "HRESULT";
           break;
           
      case VT_VOID: 
           pszType = "void";
           break;
           
      case VT_LPSTR: 
           pszType = "char *";
           break;
           
      case VT_LPWSTR: 
           pszType = "wchar *";
           break;

      default:
           pszType = "Error";
           break;              
   }
   return pszType;
}   
   
HB_FUNC( GETTYPEFUNCS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
   {
      hb_ret();
      return;
   }   

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
   {
      hb_ret();
      return;
   }   

   hb_reta( pta->cFuncs );

   for( i = 0; i < pta->cFuncs; i++ )
   {
      BSTR bsName;
      FUNCDESC * pfd;
      char * pszName; 
      char * pszType;
      char buffer[ 100 ];
      int n;
   
      if( HB_VTBL( pInfo )->GetFuncDesc( HB_THIS( pInfo ), i, &pfd ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pfd->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );

      sprintf( buffer, "%s %s(", GetType( pfd->elemdescFunc.tdesc.vt ), pszName );
      
      for( n = 0; n < pfd->cParams; n++ )
      {
         if( n != 0 )
            strcat( buffer, ", " );
         else
            strcat( buffer, " " );   
         
         strcat( buffer, GetType( pfd->lprgelemdescParam[ n ].tdesc.vt ) );
         
         if( n == pfd->cParams - 1 )
            strcat( buffer, " " );
      }    

      strcat( buffer, ")" );
      hb_storvclen( buffer, strlen( buffer ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      HB_VTBL( pInfo )->ReleaseFuncDesc( HB_THIS( pInfo ), pfd );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     

#pragma ENDDUMP
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Un poco más... :-)

Image

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

   local o := CreateObject( "ADODB.Recordset" )
   local aVars, aFuncs

   if GetTypeInfoCount( o:hObj ) == 1 // There is info

      if Len( aVars := GetTypeVars( o:hObj ) ) > 0
         XBROWSER ASort( aVars ) TITLE "Variables"
      endif
      
      if Len( aFuncs := GetTypeFuncs( o:hObj ) ) > 0
         XBROWSER ASort( aFuncs ) TITLE "Functions"
      endif   
   endif

return nil

#pragma BEGINDUMP

#include <hbapi.h>
#include "c:\harbour\contrib\hbwin\hbwinole.h"

HB_FUNC( GETTYPEINFOCOUNT )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   HRESULT     lOleError;
   UINT        ctinfo;
   
   lOleError = HB_VTBL( pDisp )->GetTypeInfoCount( HB_THIS( pDisp ), &ctinfo );
   
   hb_retnl( ( lOleError == S_OK ) ? ctinfo: -1 ); 
}     

static LPSTR WideToAnsi( LPWSTR cWide )
{
   WORD wLen;
   LPSTR cString = NULL;

   wLen = WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, 0, NULL, NULL );

   cString = ( LPSTR ) hb_xgrab( wLen );
   WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, wLen, NULL, NULL );

   return cString;
}
   
HB_FUNC( GETTYPEVARS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
      return;

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
      return;

   hb_reta( pta->cVars );

   for( i = 0; i < pta->cVars; i++ )
   {
      BSTR bsName;
      VARDESC * pVar;
      char * pszName; 
   
      if( HB_VTBL( pInfo )->GetVarDesc( HB_THIS( pInfo ), i, &pVar ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pVar->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );
      hb_storvclen( pszName, strlen( pszName ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      
      HB_VTBL( pInfo )->ReleaseVarDesc( HB_THIS( pInfo ), pVar );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     
   
static char * GetType( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case VT_PTR:
           pszType = "PTR";
           break;
           
      case VT_ARRAY:
           pszType = "ARRAY";
           break;

      case VT_CARRAY:
           pszType = "CARRAY";
           break;

      case VT_USERDEFINED:
           pszType = "USERDEFINED";
           break;

      case VT_I2: 
           pszType = "short";
           break;
           
      case VT_I4: 
           pszType = "int";
           break;
           
      case VT_R4: 
           pszType = "float";
           break;
           
      case VT_R8: 
           pszType = "double";
           break;
           
      case VT_CY: 
           pszType = "CY";
           break;
           
      case VT_DATE: 
           pszType = "DATE";
           break;
           
      case VT_BSTR: 
           pszType = "BSTR";
           break;
           
      case VT_DECIMAL: 
           pszType = "DECIMAL";
           break;
           
      case VT_DISPATCH: 
           pszType = "IDispatch";
           break;
           
      case VT_ERROR: 
           pszType = "SCODE";
           break;
           
      case VT_BOOL: 
           pszType = "VARIANT_BOOL";
           break;
           
      case VT_VARIANT: 
           pszType = "VARIANT";
           break;
           
      case VT_UNKNOWN: 
           pszType = "IUnknown";
           break;
           
      case VT_UI1: 
           pszType = "BYTE";
           break;
           
      case VT_I1: 
           pszType = "char";
           break;
           
      case VT_UI2: 
           pszType = "unsigned short";
           break;
           
      case VT_UI4: 
           pszType = "unsigned long";
           break;
           
      case VT_I8: 
           pszType = "__int64";
           break;
           
      case VT_UI8: 
           pszType = "unsigned __int64";
           break;
           
      case VT_INT: 
           pszType = "int";
           break;
           
      case VT_UINT: 
           pszType = "unsigned int";
           break;
           
      case VT_HRESULT: 
           pszType = "HRESULT";
           break;
           
      case VT_VOID: 
           pszType = "void";
           break;
           
      case VT_LPSTR: 
           pszType = "char *";
           break;
           
      case VT_LPWSTR: 
           pszType = "wchar *";
           break;

      default:
           pszType = "Error";
           break;              
   }
   return pszType;
}   

static char * GetFuncKind( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case FUNC_PUREVIRTUAL:
           pszType = "virtual";
           break;

      case FUNC_STATIC:
           pszType = "static";
           break;
           
      case FUNC_DISPATCH:
           pszType = "dispatch";
           break;
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetInvKind( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case INVOKE_FUNC:
           pszType = "FUNC";
           break;

      case INVOKE_PROPERTYGET:
           pszType = "PROPERTYGET";
           break;
           
      case INVOKE_PROPERTYPUT:
           pszType = "PROPERTYPUT";
           break;
           
      case INVOKE_PROPERTYPUTREF:
           pszType = "PROPERTYPUTREF";
           break;     
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     
   
HB_FUNC( GETTYPEFUNCS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
   {
      hb_ret();
      return;
   }   

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
   {
      hb_ret();
      return;
   }   

   hb_reta( pta->cFuncs );

   for( i = 0; i < pta->cFuncs; i++ )
   {
      BSTR bsName;
      FUNCDESC * pfd;
      char * pszName; 
      char * pszType;
      char buffer[ 100 ];
      int n;
   
      if( HB_VTBL( pInfo )->GetFuncDesc( HB_THIS( pInfo ), i, &pfd ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pfd->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );

      sprintf( buffer, "%s %s %s %s(", GetFuncKind( pfd->funckind ), GetInvKind( pfd->invkind ), 
               GetType( pfd->elemdescFunc.tdesc.vt ), pszName );
      
      for( n = 0; n < pfd->cParams; n++ )
      {
         if( n != 0 )
            strcat( buffer, ", " );
         else
            strcat( buffer, " " );   
         
         strcat( buffer, GetType( pfd->lprgelemdescParam[ n ].tdesc.vt ) );
         
         if( n == pfd->cParams - 1 )
            strcat( buffer, " " );
      }    

      strcat( buffer, ")" );
      hb_storvclen( buffer, strlen( buffer ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      HB_VTBL( pInfo )->ReleaseFuncDesc( HB_THIS( pInfo ), pfd );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     

#pragma ENDDUMP
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Documentación usada:

FUNCDESC
http://msdn.microsoft.com/en-us/library/cc237619.aspx

http://www.adp-gmbh.ch/win/tlb/
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Con esta versión practicamente tenemos todo :-)

Image

Code: Select all | Expand

// Docs: http://msdn.microsoft.com/en-us/library/cc237619.aspx

#include "FiveWin.ch"

function Main()

   local o := CreateObject( "ADODB.Recordset" )
   local aVars, aFuncs

   if GetTypeInfoCount( o:hObj ) == 1 // There is info

      if Len( aVars := GetTypeVars( o:hObj ) ) > 0
         XBROWSER ASort( aVars ) TITLE "Variables"
      endif
      
      if Len( aFuncs := GetTypeFuncs( o:hObj ) ) > 0
         XBROWSER ASort( aFuncs ) TITLE "Functions"
      endif   
   endif

return nil

#pragma BEGINDUMP

#include <hbapi.h>
#include "c:\harbour\contrib\hbwin\hbwinole.h"

HB_FUNC( GETTYPEINFOCOUNT )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   HRESULT     lOleError;
   UINT        ctinfo;
   
   lOleError = HB_VTBL( pDisp )->GetTypeInfoCount( HB_THIS( pDisp ), &ctinfo );
   
   hb_retnl( ( lOleError == S_OK ) ? ctinfo: -1 ); 
}     

static LPSTR WideToAnsi( LPWSTR cWide )
{
   WORD wLen;
   LPSTR cString = NULL;

   wLen = WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, 0, NULL, NULL );

   cString = ( LPSTR ) hb_xgrab( wLen );
   WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, wLen, NULL, NULL );

   return cString;
}
   
HB_FUNC( GETTYPEVARS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
      return;

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
      return;

   hb_reta( pta->cVars );

   for( i = 0; i < pta->cVars; i++ )
   {
      BSTR bsName;
      VARDESC * pVar;
      char * pszName; 
   
      if( HB_VTBL( pInfo )->GetVarDesc( HB_THIS( pInfo ), i, &pVar ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pVar->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );
      hb_storvclen( pszName, strlen( pszName ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      
      HB_VTBL( pInfo )->ReleaseVarDesc( HB_THIS( pInfo ), pVar );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     
   
static char * GetType( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case VT_PTR:
           pszType = "PTR";
           break;
           
      case VT_ARRAY:
           pszType = "ARRAY";
           break;

      case VT_CARRAY:
           pszType = "CARRAY";
           break;

      case VT_USERDEFINED:
           pszType = "USERDEFINED";
           break;

      case VT_I2: 
           pszType = "short";
           break;
           
      case VT_I4: 
           pszType = "int";
           break;
           
      case VT_R4: 
           pszType = "float";
           break;
           
      case VT_R8: 
           pszType = "double";
           break;
           
      case VT_CY: 
           pszType = "CY";
           break;
           
      case VT_DATE: 
           pszType = "DATE";
           break;
           
      case VT_BSTR: 
           pszType = "BSTR";
           break;
           
      case VT_DECIMAL: 
           pszType = "DECIMAL";
           break;
           
      case VT_DISPATCH: 
           pszType = "IDispatch";
           break;
           
      case VT_ERROR: 
           pszType = "SCODE";
           break;
           
      case VT_BOOL: 
           pszType = "VARIANT_BOOL";
           break;
           
      case VT_VARIANT: 
           pszType = "VARIANT";
           break;
           
      case VT_UNKNOWN: 
           pszType = "IUnknown";
           break;
           
      case VT_UI1: 
           pszType = "BYTE";
           break;
           
      case VT_I1: 
           pszType = "char";
           break;
           
      case VT_UI2: 
           pszType = "unsigned short";
           break;
           
      case VT_UI4: 
           pszType = "unsigned long";
           break;
           
      case VT_I8: 
           pszType = "__int64";
           break;
           
      case VT_UI8: 
           pszType = "unsigned __int64";
           break;
           
      case VT_INT: 
           pszType = "int";
           break;
           
      case VT_UINT: 
           pszType = "unsigned int";
           break;
           
      case VT_HRESULT: 
           pszType = "HRESULT";
           break;
           
      case VT_VOID: 
           pszType = "void";
           break;
           
      case VT_LPSTR: 
           pszType = "char *";
           break;
           
      case VT_LPWSTR: 
           pszType = "wchar *";
           break;

      default:
           pszType = "Error";
           break;              
   }
   return pszType;
}   

static char * GetFuncKind( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case FUNC_PUREVIRTUAL:
           pszType = "virtual";
           break;

      case FUNC_STATIC:
           pszType = "static";
           break;
           
      case FUNC_DISPATCH:
           pszType = "dispatch";
           break;
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetInvKind( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case INVOKE_FUNC:
           pszType = "FUNC";
           break;

      case INVOKE_PROPERTYGET:
           pszType = "PROPERTYGET";
           break;
           
      case INVOKE_PROPERTYPUT:
           pszType = "PROPERTYPUT";
           break;
           
      case INVOKE_PROPERTYPUTREF:
           pszType = "PROPERTYPUTREF";
           break;     
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetCallConv( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case CC_CDECL:
           pszType = "CDECL";
           break;

      case CC_PASCAL:
           pszType = "PASCAL";
           break;
           
      case CC_STDCALL:
           pszType = "STDCALL";
           break;
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetParamType( USHORT iType )
{
   char * pszType = "error";
   
   if( iType & PARAMFLAG_NONE )
      pszType = "";
      
   if( iType & PARAMFLAG_FIN )
      pszType = "[in]";
      
   if( iType & PARAMFLAG_FOUT )
      pszType = "[out]";

   if( iType & PARAMFLAG_FLCID )
      pszType = "[lcid]";

   if( iType & PARAMFLAG_FRETVAL )
      pszType = "[retval]";

   if( iType & PARAMFLAG_FOPT )
      pszType = "[optional]";

   if( iType & PARAMFLAG_FHASDEFAULT )
      pszType = "[defaultvalue]";

   if( iType & PARAMFLAG_FHASCUSTDATA )
      pszType = "[custom]";
   
   return pszType;
}                     
   
HB_FUNC( GETTYPEFUNCS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
   {
      hb_ret();
      return;
   }   

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
   {
      hb_ret();
      return;
   }   

   hb_reta( pta->cFuncs );

   for( i = 0; i < pta->cFuncs; i++ )
   {
      BSTR bsName;
      FUNCDESC * pfd;
      char * pszName; 
      char * pszType;
      char buffer[ 200 ];
      int n;
   
      if( HB_VTBL( pInfo )->GetFuncDesc( HB_THIS( pInfo ), i, &pfd ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pfd->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );

      sprintf( buffer, "%s %s %s %s %s(", GetCallConv( pfd->callconv ), 
               GetFuncKind( pfd->funckind ), GetInvKind( pfd->invkind ), 
               GetType( pfd->elemdescFunc.tdesc.vt ), pszName );
      
      for( n = 0; n < pfd->cParams; n++ )
      {
         if( n != 0 )
            strcat( buffer, ", " );
         else
            strcat( buffer, " " );   
         
         strcat( buffer, GetParamType( pfd->lprgelemdescParam[ n ].paramdesc.wParamFlags ) );
         strcat( buffer, " " );
         strcat( buffer, GetType( pfd->lprgelemdescParam[ n ].tdesc.vt ) );
         
         if( n == pfd->cParams - 1 )
            strcat( buffer, " " );
      }    

      strcat( buffer, ")" );
      hb_storvclen( buffer, strlen( buffer ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      HB_VTBL( pInfo )->ReleaseFuncDesc( HB_THIS( pInfo ), pfd );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     

#pragma ENDDUMP
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
ADutheil
Posts: 368
Joined: Sun May 31, 2009 6:25 pm
Location: Salvador - Bahia - Brazil

Re: Saber Metodos de un CREATEOBJECT

Post by ADutheil »

Antonio,

is this specific to adodb or can it be used with excel? I tried with CreateObject( "Excel.Application" ) and GetTypeVars returns an empty array while GetTypeFuncs seems to abend.
Regards,

André Dutheil
FWH 13.04 + HB 3.2 + MSVS 10
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

André,

You can use it with any OLE object, so Excel, Word, etc. all of them are fine :-)

We have not found yet an object that provides Vars. Until now we have only found "Functions".

If someone find an object with Vars, please say it :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
ADutheil
Posts: 368
Joined: Sun May 31, 2009 6:25 pm
Location: Salvador - Bahia - Brazil

Re: Saber Metodos de un CREATEOBJECT

Post by ADutheil »

Antônio,

It´s not working for me neither with Excel nor with word.

Code: Select all | Expand

function Main()

   local o := CreateObject( "Excel.Application" ) //WinWordObj() //CreateObject( "Word.Application" )
   local aVars, aFuncs

   if GetTypeInfoCount( o:hObj ) == 1 // There is info
        msginfo("1")

      if Len( aVars := GetTypeVars( o:hObj ) ) > 0
            msginfo("2")
         XBROWSER ASort( aVars ) TITLE "Variables"
        else
        msginfo("nada 2")
      endif
        msginfo("aqui")     


        if Len( aFuncs := GetTypeFuncs( o:hObj ) ) > 0
            msginfo("3")
         XBROWSER ASort( aFuncs ) TITLE "Functions"
       else
        msginfo("nada 3")
      endif
   else
    msginfo("nada 1")
   endif
return nil
 


I´m using buildh from fwh\samples to build the test. With excel I can see msginfo("1") msginfo("nada 2") msginfo("aqui") and after a few seconds buildh ends and goes back to prompt.
With word can see msginfo("1") msginfo("nada 2") msginfo("aqui") and nothing else happens.

Sorry I just noticed I´m writing in English in the Spanish forum. The best I can do is switch to Portuguese.
Last edited by ADutheil on Sat May 11, 2013 3:09 pm, edited 1 time in total.
Regards,

André Dutheil
FWH 13.04 + HB 3.2 + MSVS 10
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

André,

In order to make it work with Word and Excel, please modify line 359:

char buffer[ 200 ];

with

char buffer[ 700 ];

Now it is fine :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
ADutheil
Posts: 368
Joined: Sun May 31, 2009 6:25 pm
Location: Salvador - Bahia - Brazil

Re: Saber Metodos de un CREATEOBJECT

Post by ADutheil »

Bingo! Agora funciona. Me pergunto porque tem tantas funções DUMMY? (I wonder why there so many DUMMY functions)
Regards,

André Dutheil
FWH 13.04 + HB 3.2 + MSVS 10
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

André,

I guess it depends on the inspected object properties.
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Adolfo
Posts: 861
Joined: Tue Oct 11, 2005 11:57 am
Location: Chile
Contact:
Contact Adolfo

Re: Saber Metodos de un CREATEOBJECT

Post by Adolfo »

Antonio.

E X C E L E N T E.

Mejor de lo que esperaba, ya solo con los nombres era suficiente, para lo demas google.
Pero esto es excelente.
Gracias.

Desde Chile
Adolfo
;-) Ji,ji,ji... buena la cosa... "all you need is code"

http://www.xdata.cl - Desarrollo Inteligente
----------
Asus TUF F15, 32GB Ram, 2 * 1 TB NVME M.2, GTX 1650
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Inspeccionando "Scripting.FileSystemObject"

Code: Select all | Expand


function Main()

   local o := CreateObject( "Scripting.FileSystemObject" )
   local aVars, aFuncs, cFuncs := ""

   if GetTypeInfoCount( o:hObj ) == 1 // There is info

      if Len( aVars := GetTypeVars( o:hObj ) ) > 0
         XBROWSER ASort( aVars ) TITLE "Variables"
      endif
      
      if Len( aFuncs := GetTypeFuncs( o:hObj ) ) > 0
         AEval( aFuncs, { | c | cFuncs += c + CRLF } )
         MemoEdit( cFuncs )
      endif   
   endif

return nil

STDCALL dispatch FUNC void QueryInterface( [in] PTR, [out] PTR )
STDCALL dispatch FUNC unsigned long AddRef()
STDCALL dispatch FUNC unsigned long Release()
STDCALL dispatch FUNC void GetTypeInfoCount( [out] PTR )
STDCALL dispatch FUNC void GetTypeInfo( [in] unsigned int, [in] unsigned long, [out] PTR )
STDCALL dispatch FUNC void GetIDsOfNames( [in] PTR, [in] PTR, [in] unsigned int, [in] unsigned long, [out] PTR )
STDCALL dispatch FUNC void Invoke( [in] int, [in] PTR, [in] unsigned long, [in] unsigned short, [in] PTR, [out] PTR, [out] PTR, [out] PTR )
STDCALL dispatch PROPERTYGET PTR Drives()
STDCALL dispatch FUNC BSTR BuildPath( [in] BSTR, [in] BSTR )
STDCALL dispatch FUNC BSTR GetDriveName( [in] BSTR )
STDCALL dispatch FUNC BSTR GetParentFolderName( [in] BSTR )
STDCALL dispatch FUNC BSTR GetFileName( [in] BSTR )
STDCALL dispatch FUNC BSTR GetBaseName( [in] BSTR )
STDCALL dispatch FUNC BSTR GetExtensionName( [in] BSTR )
STDCALL dispatch FUNC BSTR GetAbsolutePathName( [in] BSTR )
STDCALL dispatch FUNC BSTR GetTempName()
STDCALL dispatch FUNC VARIANT_BOOL DriveExists( [in] BSTR )
STDCALL dispatch FUNC VARIANT_BOOL FileExists( [in] BSTR )
STDCALL dispatch FUNC VARIANT_BOOL FolderExists( [in] BSTR )
STDCALL dispatch FUNC PTR GetDrive( [in] BSTR )
STDCALL dispatch FUNC PTR GetFile( [in] BSTR )
STDCALL dispatch FUNC PTR GetFolder( [in] BSTR )
STDCALL dispatch FUNC PTR GetSpecialFolder( [in] USERDEFINED )
STDCALL dispatch FUNC void DeleteFile( [in] BSTR, [defaultvalue] VARIANT_BOOL )
STDCALL dispatch FUNC void DeleteFolder( [in] BSTR, [defaultvalue] VARIANT_BOOL )
STDCALL dispatch FUNC void MoveFile( [in] BSTR, [in] BSTR )
STDCALL dispatch FUNC void MoveFolder( [in] BSTR, [in] BSTR )
STDCALL dispatch FUNC void CopyFile( [in] BSTR, [in] BSTR, [defaultvalue] VARIANT_BOOL )
STDCALL dispatch FUNC void CopyFolder( [in] BSTR, [in] BSTR, [defaultvalue] VARIANT_BOOL )
STDCALL dispatch FUNC PTR CreateFolder( [in] BSTR )
STDCALL dispatch FUNC PTR CreateTextFile( [in] BSTR, [defaultvalue] VARIANT_BOOL, [defaultvalue] VARIANT_BOOL )
STDCALL dispatch FUNC PTR OpenTextFile( [in] BSTR, [defaultvalue] USERDEFINED, [defaultvalue] VARIANT_BOOL, [defaultvalue] USERDEFINED )
STDCALL dispatch FUNC PTR GetStandardStream( [in] USERDEFINED, [defaultvalue] VARIANT_BOOL )
STDCALL dispatch FUNC BSTR GetFileVersion( [in] BSTR )
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Antonio Linares
Site Admin
Posts: 42521
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 76 times
Contact:
Contact Antonio Linares

Re: Saber Metodos de un CREATEOBJECT

Post by Antonio Linares »

Inspeccionando "Scripting.Dictionary"

STDCALL dispatch FUNC void QueryInterface( [in] PTR, [out] PTR )
STDCALL dispatch FUNC unsigned long AddRef()
STDCALL dispatch FUNC unsigned long Release()
STDCALL dispatch FUNC void GetTypeInfoCount( [out] PTR )
STDCALL dispatch FUNC void GetTypeInfo( [in] unsigned int, [in] unsigned long, [out] PTR )
STDCALL dispatch FUNC void GetIDsOfNames( [in] PTR, [in] PTR, [in] unsigned int, [in] unsigned long, [out] PTR )
STDCALL dispatch FUNC void Invoke( [in] int, [in] PTR, [in] unsigned long, [in] unsigned short, [in] PTR, [out] PTR, [out] PTR, [out] PTR )
STDCALL dispatch PROPERTYPUTREF void Item( [in] PTR, [in] PTR )
STDCALL dispatch PROPERTYPUT void Item( [in] PTR, [in] PTR )
STDCALL dispatch PROPERTYGET VARIANT Item( [in] PTR )
STDCALL dispatch FUNC void Add( [in] PTR, [in] PTR )
STDCALL dispatch PROPERTYGET int Count()
STDCALL dispatch FUNC VARIANT_BOOL Exists( [in] PTR )
STDCALL dispatch FUNC VARIANT Items()
STDCALL dispatch PROPERTYPUT void Key( [in] PTR, [in] PTR )
STDCALL dispatch FUNC VARIANT Keys()
STDCALL dispatch FUNC void Remove( [in] PTR )
STDCALL dispatch FUNC void RemoveAll()
STDCALL dispatch PROPERTYPUT void CompareMode( [in] USERDEFINED )
STDCALL dispatch PROPERTYGET USERDEFINED CompareMode()
STDCALL dispatch FUNC IUnknown _NewEnum()
STDCALL dispatch PROPERTYGET VARIANT HashVal( [in] PTR )
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
Post Reply

Return to “FiveWin para Harbour/xHarbour”