Index: basic/source/runtime/makefile.mk =================================================================== RCS file: /cvs/script/basic/source/runtime/makefile.mk,v retrieving revision 1.3 diff -u -r1.3 makefile.mk --- basic/source/runtime/makefile.mk 10 Jan 2002 11:10:20 -0000 1.3 +++ basic/source/runtime/makefile.mk 10 Aug 2005 13:29:42 -0000 @@ -71,6 +71,9 @@ .INCLUDE : settings.mk .INCLUDE : sv.mk +.IF "$(ENABLE_VBA)"=="YES" + CDEFS+=-DENABLE_VBA +.ENDIF # --- Allgemein ----------------------------------------------------------- --- basic.orig/source/runtime/step1.cxx 2005-09-19 09:36:54.000000000 +0100 +++ basic/source/runtime/step1.cxx 2005-09-19 09:28:25.000000000 +0100 @@ -71,6 +71,11 @@ #include "image.hxx" #include "sbunoobj.hxx" +#ifdef ENABLE_VBA +bool checkUnoObjectType( SbUnoObject* refVal, + const String& aClass ); +#endif //ENABLE_VBA + // Laden einer numerischen Konstanten (+ID) void SbiRuntime::StepLOADNC( USHORT nOp1 ) @@ -501,9 +506,22 @@ { if( !implIsClass( pObj, aClass ) ) { +#ifndef ENABLE_VBA if( bRaiseErrors ) Error( SbERR_INVALID_USAGE_OBJECT ); bOk = false; +#else + if ( SbiRuntime::isVBAEnabled() && pObj->IsA( TYPE(SbUnoObject) ) ) + { + SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj); + bOk = checkUnoObjectType( pUnoObj, aClass ); + } + else + bOk = false; + if ( !bOk ) + if( bRaiseErrors ) + Error( SbERR_INVALID_USAGE_OBJECT ); +#endif // ENABLE_VBA } else { --- basic.orig/source/runtime/step2.cxx 2005-09-19 09:36:54.000000000 +0100 +++ basic/source/runtime/step2.cxx 2005-09-19 09:40:10.000000000 +0100 @@ -72,6 +72,9 @@ using namespace com::sun::star::container; using namespace com::sun::star::lang; +#ifdef ENABLE_VBA +SbxVariable* getVBAConstant( const String& rName ); +#endif //ENABLE_VBA // Suchen eines Elements @@ -152,10 +160,25 @@ pElem->SetName( aName ); refLocals->Put( pElem, refLocals->Count() ); } +#ifdef ENABLE_VBA + else if ( bIsVBAInterOp ) + { + // last gasp see if name matches a + // vba idl constant (with no namespace) + // + pElem = getVBAConstant( aName ); + //Not sure whether I should + //store this as a local ref or not, + //what are the implications? + + //refLocals->Put( pElem, refLocals->Count() ); + } +#endif //ENABLE_VBA } if( !pElem ) { + // Nicht da und nicht im Objekt? // Hat das Ding Parameter, nicht einrichten! if( nOp1 & 0x8000 ) Index: basic/source/classes/sbunoobj.cxx =================================================================== RCS file: /cvs/script/basic/source/classes/sbunoobj.cxx,v retrieving revision 1.32 diff -u -r1.32 sbunoobj.cxx --- basic/source/classes/sbunoobj.cxx 13 Apr 2005 09:10:23 -0000 1.32 +++ basic/source/classes/sbunoobj.cxx 29 Sep 2005 12:30:49 -0000 @@ -134,6 +134,11 @@ #include #include +#ifdef ENABLE_VBA +#include +#include +#include +#endif //ENABLE_VBA TYPEINIT1(SbUnoMethod,SbxMethod) TYPEINIT1(SbUnoProperty,SbxProperty) @@ -154,6 +160,8 @@ static String aIllegalArgumentExceptionName ( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.lang.IllegalArgumentException" ) ); static OUString aSeqLevelStr( RTL_CONSTASCII_USTRINGPARAM("[]") ); +static OUString defaultNameSpace( RTL_CONSTASCII_USTRINGPARAM("org.openoffice.vba.") ); +static OUString defaultNameSpaceParent( RTL_CONSTASCII_USTRINGPARAM("org.openoffice") ); Reference< XComponentContext > getComponentContext_Impl( void ) @@ -1383,6 +1391,50 @@ return aName; } +bool checkUnoObjectType( SbUnoObject* pUnoObj, + const String& aClass ) +{ + bool result = false; + Any aToInspectObj = pUnoObj->getUnoAny(); + TypeClass eType = aToInspectObj.getValueType().getTypeClass(); + if( eType != TypeClass_INTERFACE ) + return false; + const Reference< XInterface > x = *(Reference< XInterface >*)aToInspectObj.getValue(); + Reference< XTypeProvider > xTypeProvider( x, UNO_QUERY ); + if( xTypeProvider.is() ) + { + Sequence< Type > aTypeSeq = xTypeProvider->getTypes(); + const Type* pTypeArray = aTypeSeq.getConstArray(); + UINT32 nIfaceCount = aTypeSeq.getLength(); + for( UINT32 j = 0 ; j < nIfaceCount ; j++ ) + { + const Type& rType = pTypeArray[j]; + + Reference xClass = TypeToIdlClass( rType ); + if( xClass.is() ) + { + OUString sClassName = xClass->getName(); + OSL_TRACE("Checking if object implements %s", + OUStringToOString( defaultNameSpace + aClass, + RTL_TEXTENCODING_UTF8 ).getStr() ); + // although interfaces in the org.openoffice.vba namespace + // obey the idl rules and have a leading X, in basic we + // want to be able to do something like + // 'dim wrkbooks as WorkBooks' + // so test assumes the 'X' has been dropped + if ( sClassName.equalsIgnoreAsciiCase( defaultNameSpace + OUString( RTL_CONSTASCII_USTRINGPARAM("X") ) + aClass ) || + sClassName.equalsIgnoreAsciiCase( aClass ) ) + { + result = true; + break; + } + } + else + break; + } + } + return result; +} // Dbg-Hilfsmethode zum Auslesen der in einem Object implementierten Interfaces String Impl_GetSupportedInterfaces( SbUnoObject* pUnoObj ) @@ -2896,26 +2943,189 @@ refVar->PutBool( TRUE ); } -// Funktion, um einen globalen Bezeichner im -// UnoScope zu suchen und fuer Sbx zu wrappen -SbxVariable* findUnoClass( const String& rName ) +#ifdef ENABLE_VBA +typedef std::hash_map< OUString, std::vector< OUString >, OUStringHash, ::std::equal_to< OUString > > ModuleHash; + + +// helper wrapper function to interact with TypeProvider and +// XTypeDescriptionEnumerationAccess. +// if it fails for whatever reason +// returned Reference<> be null e.g. .is() will be false + +Reference< XTypeDescriptionEnumeration > +getTypeDescriptorEnumeration( const OUString& sSearchRoot, + const Sequence< TypeClass >& types, TypeDescriptionSearchDepth depth ) +{ + Reference< XTypeDescriptionEnumeration > xEnum; + Reference< XTypeDescriptionEnumerationAccess> xTypeEnumAccess( getTypeProvider_Impl(), UNO_QUERY ); + if ( xTypeEnumAccess.is() ) + { + try + { + xEnum = xTypeEnumAccess->createTypeDescriptionEnumeration( + sSearchRoot, types, depth ); + } + catch( NoSuchTypeNameException& nstne ) {} + catch( InvalidTypeNameException& nstne ) {} + } + return xEnum; +} + +// Returns the list of child modules relative to sSearchRoot +// names are fully qualified e.g. search with sSearchRoot = "org.openoffice.vba" +// will return elements like "org.openoffice.vba.child" + +const std::vector< OUString >& getModulesToSearch( const OUString& sSearchRoot ) { - // #105550 Check if module exists - SbUnoClass* pUnoClass = NULL; + // cache previous searches ( creating EnumerationAccess is expensive + // apparently see api doc for XTypeDescriptionEnumerationAccess ) + static ModuleHash aModCache; + + ModuleHash::const_iterator it = aModCache.find( sSearchRoot ); + + if ( it != aModCache.end() ) + return it->second; + + Sequence< TypeClass > types(2); + types[ 0 ] = TypeClass_MODULE; + types[ 1 ] = TypeClass_CONSTANTS; + Reference< XTypeDescriptionEnumeration > xEnum = getTypeDescriptorEnumeration( sSearchRoot, types, TypeDescriptionSearchDepth_INFINITE ); + if ( xEnum.is() ) + { + std::vector< OUString > modules; + while ( xEnum->hasMoreElements() ) + { + Reference< XTypeDescription > xType( xEnum->nextElement(), UNO_QUERY ); + if ( xType.is() ) + modules.push_back( xType->getName() ); + } + aModCache[ sSearchRoot ] = modules; + } + + // any failures above will result in no names to search (returned) + return aModCache[ sSearchRoot ]; +} +typedef std::hash_map< OUString, Any, OUStringHash, ::std::equal_to< OUString > > VBAConstantsHash; + +SbxVariable* getVBAConstant( const String& rName ) +{ + SbxVariable* pConst = NULL; + static VBAConstantsHash aConstCache; + static bool isInited = false; + if ( !isInited ) + { + Sequence< TypeClass > types(1); + types[ 0 ] = TypeClass_CONSTANTS; + Reference< XTypeDescriptionEnumeration > xEnum = getTypeDescriptorEnumeration( defaultNameSpace, types, TypeDescriptionSearchDepth_INFINITE ); + + while ( xEnum->hasMoreElements() ) + { + Reference< XConstantsTypeDescription > xConstants( xEnum->nextElement(), UNO_QUERY ); + if ( xConstants.is() ) + { + Sequence< Reference< XConstantTypeDescription > > aConsts = xConstants->getConstants(); + Reference< XConstantTypeDescription >* pSrc = aConsts.getArray(); + sal_Int32 nLen = aConsts.getLength(); + for ( sal_Int32 index =0; index& rXConst = + *pSrc; + OUString sFullName = rXConst->getName(); + sal_Int32 indexLastDot = sFullName.lastIndexOf('.'); + OUString sLeafName; + if ( indexLastDot > -1 ) + sLeafName = sFullName.copy( indexLastDot + 1); + aConstCache[ sLeafName.toAsciiLowerCase() ] = rXConst->getConstantValue(); + } + } + } + isInited = true; + } + OUString sKey( rName ); + VBAConstantsHash::const_iterator it = aConstCache.find( sKey.toAsciiLowerCase() ); + if ( it != aConstCache.end() ) + { + pConst = new SbxVariable( SbxVARIANT ); + pConst->SetName( rName ); + unoToSbxValue( pConst, it->second ); + } + return pConst; +} + +#endif //ENABLE_VBA + +SbUnoClass* findUnoClass_Impl( const String& rName ) +{ + OSL_TRACE("findUnoClass_Impl for %s", + OUStringToOString( rName, RTL_TEXTENCODING_UTF8 ).getStr() ); + + SbUnoClass* pUnoClass = NULL; Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl(); Reference< XTypeDescription > xTypeDesc; - if( xTypeAccess->hasByHierarchicalName( rName ) ) + Reference< XExactName > xExact( xTypeAccess, UNO_QUERY ); + OUString sName = rName; + + if ( xExact.is() + && SbiRuntime::isVBAEnabled() + && ( sName.indexOf( defaultNameSpace ) == 0 ) + ) + { + OUString sExactName = xExact->getExactName( sName ); + if ( sExactName.getLength() ) + sName = sExactName; + } + if( xTypeAccess->hasByHierarchicalName( sName ) ) { - Any aRet = xTypeAccess->getByHierarchicalName( rName ); + Any aRet = xTypeAccess->getByHierarchicalName( sName ); aRet >>= xTypeDesc; - + if( xTypeDesc.is() ) { TypeClass eTypeClass = xTypeDesc->getTypeClass(); if( eTypeClass == TypeClass_MODULE || eTypeClass == TypeClass_CONSTANTS ) - pUnoClass = new SbUnoClass( rName ); + pUnoClass = new SbUnoClass( sName ); } } + return pUnoClass; +} +// Funktion, um einen globalen Bezeichner im +// UnoScope zu suchen und fuer Sbx zu wrappen +SbxVariable* findUnoClass( const String& rName ) +{ + OSL_TRACE("findUnoClass for %s", + OUStringToOString( rName, RTL_TEXTENCODING_UTF8 ).getStr() ); + // #105550 Check if module exists + SbUnoClass* pUnoClass = NULL; +#if 0 // #ifdef ENABLE_VBA // constant resolving is unbareably slow + + pUnoClass = findUnoClass_Impl( rName ); + // only search thru namespaces if handling imported vba code is set + // and of course not after finding a constant group or module for + // rName + if ( !pUnoClass && SbiRuntime::isVBAEnabled() ) + { + if ( rName.CompareTo( defaultNameSpace.getStr(), defaultNameSpace.getLength() ) != COMPARE_EQUAL ) + + { + const std::vector< OUString >& modules = getModulesToSearch( defaultNameSpaceParent ); + std::vector< OUString >::const_iterator it = modules.begin(); + std::vector< OUString >::const_iterator it_end = modules.end(); + for ( ; it != it_end; ++it ) + { + static OUString sDot( RTL_CONSTASCII_USTRINGPARAM(".") ); + OUString sClassName = *it; + sClassName += (sDot + rName); + OSL_TRACE("...Searching for %s", + OUStringToOString( sClassName, RTL_TEXTENCODING_UTF8 ).getStr() ); + if ( pUnoClass = findUnoClass_Impl( sClassName ) ) + break; + } + } + } +#else + pUnoClass = findUnoClass_Impl( rName ); +#endif //ENABLE_VBA + return pUnoClass; } @@ -2967,7 +3387,21 @@ SbxVariable* SbUnoClass::Find( const Xub aNewName.AppendAscii( "." ); aNewName += rName; +#ifdef ENABLE_VBA + Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl(); + Reference< XExactName > xExact( xTypeAccess, UNO_QUERY ); + String vbaNamespace = defaultNameSpace; + if ( xExact.is() + && SbiRuntime::isVBAEnabled() + && ( aNewName.Search( vbaNamespace ) == 0 ) + ) + { + OUString sExactName = xExact->getExactName( aNewName ); + if ( sExactName.getLength() ) + aNewName = sExactName; + } +#endif //ENABLE_VBA // CoreReflection holen Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl(); if( xCoreReflection.is() )