summaryrefslogtreecommitdiff
path: root/basic/source/classes/sbunoobj.cxx
diff options
context:
space:
mode:
Diffstat (limited to 'basic/source/classes/sbunoobj.cxx')
-rwxr-xr-x[-rw-r--r--]basic/source/classes/sbunoobj.cxx288
1 files changed, 285 insertions, 3 deletions
diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx
index 849fd839bfd1..e51a0c09270b 100644..100755
--- a/basic/source/classes/sbunoobj.cxx
+++ b/basic/source/classes/sbunoobj.cxx
@@ -49,6 +49,7 @@
#include <com/sun/star/uno/XComponentContext.hpp>
#include <com/sun/star/uno/DeploymentException.hpp>
#include <com/sun/star/lang/XTypeProvider.hpp>
+#include <com/sun/star/lang/XSingleServiceFactory.hpp>
#include <com/sun/star/lang/XMultiServiceFactory.hpp>
#include <com/sun/star/lang/XServiceInfo.hpp>
#include <com/sun/star/beans/PropertyAttribute.hpp>
@@ -1074,8 +1075,19 @@ Any sbxToUnoValueImpl( SbxVariable* pVar, bool bBlockConversionToSmallestType =
if( eBaseType == SbxOBJECT )
{
SbxBaseRef xObj = (SbxBase*)pVar->GetObject();
- if( xObj.Is() && xObj->ISA(SbUnoAnyObject) )
- return ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue();
+ if( xObj.Is() )
+ {
+ if( xObj->ISA(SbUnoAnyObject) )
+ return ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue();
+ if( xObj->ISA(SbClassModuleObject) )
+ {
+ Any aRetAny;
+ SbClassModuleObject* pClassModuleObj = (SbClassModuleObject*)(SbxBase*)xObj;
+ SbModule* pClassModule = pClassModuleObj->getClassModule();
+ if( pClassModule->createCOMWrapperForIface( aRetAny, pClassModuleObj ) )
+ return aRetAny;
+ }
+ }
}
Type aType = getUnoTypeForSbxValue( pVar );
@@ -1581,12 +1593,18 @@ String getBasicObjectTypeName( SbxObject* pObj )
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();
+
+ // Return true for XInvocation based objects as interface type names don't count then
+ Reference< XInvocation > xInvocation( x, UNO_QUERY );
+ if( xInvocation.is() )
+ return true;
+
+ bool result = false;
Reference< XTypeProvider > xTypeProvider( x, UNO_QUERY );
if( xTypeProvider.is() )
{
@@ -4135,3 +4153,267 @@ void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
refVar->PutObject( xUnoAnyObject );
}
+//==========================================================================
+
+typedef WeakImplHelper1< XInvocation > ModuleInvocationProxyHelper;
+
+class ModuleInvocationProxy : public ModuleInvocationProxyHelper
+{
+ ::rtl::OUString m_aPrefix;
+ SbxObjectRef m_xScopeObj;
+ bool m_bProxyIsClassModuleObject;
+
+public:
+ ModuleInvocationProxy( const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj );
+ ~ModuleInvocationProxy()
+ {}
+
+ // XInvocation
+ virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection() throw();
+ virtual void SAL_CALL setValue( const ::rtl::OUString& rProperty, const Any& rValue )
+ throw( UnknownPropertyException );
+ virtual Any SAL_CALL getValue( const ::rtl::OUString& rProperty )
+ throw( UnknownPropertyException );
+ virtual sal_Bool SAL_CALL hasMethod( const ::rtl::OUString& rName ) throw();
+ virtual sal_Bool SAL_CALL hasProperty( const ::rtl::OUString& rProp ) throw();
+
+ virtual Any SAL_CALL invoke( const ::rtl::OUString& rFunction,
+ const Sequence< Any >& rParams,
+ Sequence< sal_Int16 >& rOutParamIndex,
+ Sequence< Any >& rOutParam )
+ throw( CannotConvertException, InvocationTargetException );
+};
+
+ModuleInvocationProxy::ModuleInvocationProxy( const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj )
+ : m_aPrefix( aPrefix + ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("_") ) )
+ , m_xScopeObj( xScopeObj )
+{
+ m_bProxyIsClassModuleObject = xScopeObj.Is() ? xScopeObj->ISA(SbClassModuleObject) : false;
+}
+
+Reference< XIntrospectionAccess > SAL_CALL ModuleInvocationProxy::getIntrospection() throw()
+{
+ return Reference< XIntrospectionAccess >();
+}
+
+void SAL_CALL ModuleInvocationProxy::setValue( const ::rtl::OUString& rProperty, const Any& rValue ) throw( UnknownPropertyException )
+{
+ if( !m_bProxyIsClassModuleObject )
+ throw UnknownPropertyException();
+
+ NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
+
+ ::rtl::OUString aPropertyFunctionName( RTL_CONSTASCII_USTRINGPARAM( "Property Set ") );
+ aPropertyFunctionName += m_aPrefix;
+ aPropertyFunctionName += rProperty;
+
+ SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxCLASS_METHOD );
+ SbMethod* pMeth = p != NULL ? PTR_CAST(SbMethod,p) : NULL;
+ if( pMeth == NULL )
+ {
+ // TODO: Check vba behavior concernig missing function
+ //StarBASIC::Error( SbERR_NO_METHOD, aFunctionName );
+ throw UnknownPropertyException();
+ }
+
+ // Setup parameter
+ SbxArrayRef xArray = new SbxArray;
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( (SbxVariable*)xVar, rValue );
+ xArray->Put( xVar, 1 );
+
+ // Call property method
+ SbxVariableRef xValue = new SbxVariable;
+ pMeth->SetParameters( xArray );
+ pMeth->Call( xValue );
+ //aRet = sbxToUnoValue( xValue );
+ pMeth->SetParameters( NULL );
+
+ // TODO: OutParameter?
+
+ // throw InvocationTargetException();
+
+ //return aRet;
+
+}
+
+Any SAL_CALL ModuleInvocationProxy::getValue( const ::rtl::OUString& rProperty ) throw( UnknownPropertyException )
+{
+ if( !m_bProxyIsClassModuleObject )
+ throw UnknownPropertyException();
+
+ NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
+
+ ::rtl::OUString aPropertyFunctionName( RTL_CONSTASCII_USTRINGPARAM( "Property Get ") );
+ aPropertyFunctionName += m_aPrefix;
+ aPropertyFunctionName += rProperty;
+
+ SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxCLASS_METHOD );
+ SbMethod* pMeth = p != NULL ? PTR_CAST(SbMethod,p) : NULL;
+ if( pMeth == NULL )
+ {
+ // TODO: Check vba behavior concernig missing function
+ //StarBASIC::Error( SbERR_NO_METHOD, aFunctionName );
+ throw UnknownPropertyException();
+ }
+
+ // Call method
+ SbxVariableRef xValue = new SbxVariable;
+ pMeth->Call( xValue );
+ Any aRet = sbxToUnoValue( xValue );
+ return aRet;
+}
+
+sal_Bool SAL_CALL ModuleInvocationProxy::hasMethod( const ::rtl::OUString& ) throw()
+{
+ return sal_False;
+}
+
+sal_Bool SAL_CALL ModuleInvocationProxy::hasProperty( const ::rtl::OUString& ) throw()
+{
+ return sal_False;
+}
+
+Any SAL_CALL ModuleInvocationProxy::invoke( const ::rtl::OUString& rFunction,
+ const Sequence< Any >& rParams,
+ Sequence< sal_Int16 >&,
+ Sequence< Any >& )
+ throw( CannotConvertException, InvocationTargetException )
+{
+ NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
+
+ Any aRet;
+ if( !m_xScopeObj.Is() )
+ return aRet;
+
+ ::rtl::OUString aFunctionName = m_aPrefix;
+ aFunctionName += rFunction;
+
+ SbxVariable* p = m_xScopeObj->Find( aFunctionName, SbxCLASS_METHOD );
+ SbMethod* pMeth = p != NULL ? PTR_CAST(SbMethod,p) : NULL;
+ if( pMeth == NULL )
+ {
+ // TODO: Check vba behavior concernig missing function
+ //StarBASIC::Error( SbERR_NO_METHOD, aFunctionName );
+ return aRet;
+ }
+
+ // Setup parameters
+ SbxArrayRef xArray;
+ sal_Int32 nParamCount = rParams.getLength();
+ if( nParamCount )
+ {
+ xArray = new SbxArray;
+ const Any *pArgs = rParams.getConstArray();
+ for( sal_Int32 i = 0 ; i < nParamCount ; i++ )
+ {
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( (SbxVariable*)xVar, pArgs[i] );
+ xArray->Put( xVar, sal::static_int_cast< USHORT >(i+1) );
+ }
+ }
+
+ // Call method
+ SbxVariableRef xValue = new SbxVariable;
+ if( xArray.Is() )
+ pMeth->SetParameters( xArray );
+ pMeth->Call( xValue );
+ aRet = sbxToUnoValue( xValue );
+ pMeth->SetParameters( NULL );
+
+ // TODO: OutParameter?
+
+ return aRet;
+}
+
+Reference< XInterface > createComListener( const Any& aControlAny, const ::rtl::OUString& aVBAType,
+ const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj )
+{
+ Reference< XInterface > xRet;
+
+ Reference< XComponentContext > xContext = getComponentContext_Impl();
+ Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+
+ Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPrefix, xScopeObj );
+
+ Sequence<Any> args( 3 );
+ args[0] <<= aControlAny;
+ args[1] <<= aVBAType;
+ args[2] <<= xProxy;
+
+ try
+ {
+ xRet = xServiceMgr->createInstanceWithArgumentsAndContext(
+ ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.custom.UnoComListener")),
+ args, xContext );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+
+ return xRet;
+}
+
+// Handle module implements mechanism for OLE types
+bool SbModule::createCOMWrapperForIface( Any& o_rRetAny, SbClassModuleObject* pProxyClassModuleObject )
+{
+ // For now: Take first interface that allows to instantiate COM wrapper
+ // TODO: Check if support for multiple interfaces is needed
+
+ Reference< XComponentContext > xContext = getComponentContext_Impl();
+ Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+ Reference< XSingleServiceFactory > xComImplementsFactory
+ (
+ xServiceMgr->createInstanceWithContext(
+ ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.custom.ComImplementsFactory")), xContext ),
+ UNO_QUERY
+ );
+ if( !xComImplementsFactory.is() )
+ return false;
+
+ bool bSuccess = false;
+
+ SbxArray* pModIfaces = pClassData->mxIfaces;
+ USHORT nCount = pModIfaces->Count();
+ for( USHORT i = 0 ; i < nCount ; ++i )
+ {
+ SbxVariable* pVar = pModIfaces->Get( i );
+ ::rtl::OUString aIfaceName = pVar->GetName();
+
+ if( aIfaceName.getLength() != 0 )
+ {
+ ::rtl::OUString aPureIfaceName = aIfaceName;
+ sal_Int32 indexLastDot = aIfaceName.lastIndexOf('.');
+ if ( indexLastDot > -1 )
+ aPureIfaceName = aIfaceName.copy( indexLastDot + 1 );
+
+ Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPureIfaceName, pProxyClassModuleObject );
+
+ Sequence<Any> args( 2 );
+ args[0] <<= aIfaceName;
+ args[1] <<= xProxy;
+
+ Reference< XInterface > xRet;
+ bSuccess = false;
+ try
+ {
+ xRet = xComImplementsFactory->createInstanceWithArguments( args );
+ bSuccess = true;
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+
+ if( bSuccess )
+ {
+ o_rRetAny <<= xRet;
+ break;
+ }
+ }
+ }
+
+ return bSuccess;
+}
+