For Each on an OLE object

[ABuch]

Hi All,

I'd like to enumerate all properties of an object

is this suppose to work?

--------------------------

local obj

local p

obj  :=  win_oleCreateObject( "ValidOLEAutomationObject" )

for each p in obj

? p

next

---------------------

what I get is

ERROR WINOLE/1005  Argument error: __OLEENUMCREATE
(DOS ERROR -2147352573)
[1] == TypoErr: P Val: <pointer> [2] == TypoErr: L Val: .F.
__OLEENUMCREATE(0) In: 

Thanks

Abe

[Alex Strickland]

Hi Abe

I think only if it is an array.

There are Harbour functions to enumerate the class properties, but that would not be via "for each" in the way you are attempting.

--

Regards

Alex

--
You received this message because you are subscribed to the Google Groups "Harbour Developers" group.
To unsubscribe from this group and stop receiving emails from it, send an email to harbour-deve...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-devel/dfead111-4b6a-4e18-9dd5-39efd5cee155n%40googlegroups.com.

[Antonio Linares]

olebrow.prg developed by FiveTech Software:

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

#include "FiveWin.ch"

#define  HKEY_CLASSES_ROOT       2147483648

function Main()

   local nHandle, nHandle2, n := 1
   local aValues := {}, cDesc, cValue, aDescriptors := {}

   if RegOpenKey( HKEY_CLASSES_ROOT, "CLSID", @nHandle ) == 0
      while RegEnumKey( nHandle, n++, @cDesc ) == 0
         if RegOpenKey( HKEY_CLASSES_ROOT, "CLSID\" + cDesc, @nHandle2 ) == 0
            if RegQueryValue( nHandle2, "ProgID", @cValue ) != 2
               if ! Empty( cValue )
                  AAdd( aValues, { PadR( cValue, 40 ), PadR( ServerName( cDesc ), 85 ) } )
               endif
            endif      
            RegCloseKey( nHandle2 )
         endif
      end      
      RegCloseKey( nHandle )  
   endif  

   XBROWSER ASort( aValues,,, { | x, y | x[ 1 ] < y[ 1 ] }  ) TITLE "Available OLE classes" ;
      SELECT OleInspect( oBrw:aCols[ 1 ]:Value, oBrw:aCols[ 2 ]:Value ) ;
      VALID MsgYesNo( "want to end ?" ) ;
      SETUP ( oBrw:aCols[ 1 ]:cHeader := "ProgID",;
              oBrw:aCols[ 2 ]:cHeader := "Server filename",;
              oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW )

return nil
   
function OleInspect( cProgID, cValue )

   local o, aVars, aFuncs, cFuncs := ""

   try
      o := CreateObject( cProgID )
   catch
      MsgAlert( "can't create the object" )
      return nil
   end  

   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 aFuncs ;
            TITLE "Functions for " + AllTrim( cProgID )
         // AEval( aFuncs, { | c | cFuncs += c + CRLF } )
         // MemoEdit( cFuncs )
      endif  
   endif

return nil

static function ServerName( cValue )

   local oReg := TReg32():New( HKEY_CLASSES_ROOT, "CLSID\" + cValue + ;
                               "\InprocServer32" )
   local cTypeLib := oReg:Get( "" )
   
   oReg:Close()
   
return cTypeLib  

#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[ 700 ];
      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

best regards

[ABuch]

Thanks Alex,

can you point me to an example, please?

Thank you,

Abe

[ABuch]

Thanks, Antonio.

I could not get it to compile in strict Harbour. I got some missing registry functions.