1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
3 * This file is part of the LibreOffice project.
5 * This Source Code Form is subject to the terms of the Mozilla Public
6 * License, v. 2.0. If a copy of the MPL was not distributed with this
7 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 * This file incorporates work covered by the following license notice:
11 * Licensed to the Apache Software Foundation (ASF) under one or more
12 * contributor license agreements. See the NOTICE file distributed
13 * with this work for additional information regarding copyright
14 * ownership. The ASF licenses this file to you under the Apache
15 * License, Version 2.0 (the "License"); you may not use this file
16 * except in compliance with the License. You may obtain a copy of
17 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
20 #include <sal/config.h>
22 #include <o3tl/any.hxx>
23 #include <osl/mutex.hxx>
24 #include <vcl/svapp.hxx>
25 #include <vcl/errcode.hxx>
26 #include <svl/hint.hxx>
28 #include <cppuhelper/implbase.hxx>
29 #include <cppuhelper/exc_hlp.hxx>
30 #include <comphelper/interfacecontainer2.hxx>
31 #include <comphelper/extract.hxx>
32 #include <comphelper/processfactory.hxx>
33 #include <cppuhelper/weakref.hxx>
35 #include <rtl/math.hxx>
36 #include <rtl/ustrbuf.hxx>
38 #include <com/sun/star/script/ArrayWrapper.hpp>
39 #include <com/sun/star/script/CannotConvertException.hpp>
40 #include <com/sun/star/script/NativeObjectWrapper.hpp>
42 #include <com/sun/star/uno/XComponentContext.hpp>
43 #include <com/sun/star/uno/DeploymentException.hpp>
44 #include <com/sun/star/lang/XTypeProvider.hpp>
45 #include <com/sun/star/lang/XSingleServiceFactory.hpp>
46 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
47 #include <com/sun/star/lang/XServiceInfo.hpp>
48 #include <com/sun/star/beans/PropertyAttribute.hpp>
49 #include <com/sun/star/beans/PropertyConcept.hpp>
50 #include <com/sun/star/beans/MethodConcept.hpp>
51 #include <com/sun/star/beans/XPropertySet.hpp>
52 #include <com/sun/star/beans/theIntrospection.hpp>
53 #include <com/sun/star/script/BasicErrorException.hpp>
54 #include <com/sun/star/script/InvocationAdapterFactory.hpp>
55 #include <com/sun/star/script/XAllListener.hpp>
56 #include <com/sun/star/script/Converter.hpp>
57 #include <com/sun/star/script/XDefaultProperty.hpp>
58 #include <com/sun/star/script/XDirectInvocation.hpp>
59 #include <com/sun/star/container/XNameAccess.hpp>
60 #include <com/sun/star/container/XHierarchicalNameAccess.hpp>
61 #include <com/sun/star/reflection/XIdlArray.hpp>
62 #include <com/sun/star/reflection/XIdlReflection.hpp>
63 #include <com/sun/star/reflection/XServiceConstructorDescription.hpp>
64 #include <com/sun/star/reflection/XSingletonTypeDescription.hpp>
65 #include <com/sun/star/reflection/theCoreReflection.hpp>
66 #include <com/sun/star/bridge/oleautomation/NamedArgument.hpp>
67 #include <com/sun/star/bridge/oleautomation/Date.hpp>
68 #include <com/sun/star/bridge/oleautomation/Decimal.hpp>
69 #include <com/sun/star/bridge/oleautomation/Currency.hpp>
70 #include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
71 #include <com/sun/star/script/XAutomationInvocation.hpp>
73 #include <rtlproto.hxx>
75 #include <basic/sbstar.hxx>
76 #include <basic/sbuno.hxx>
77 #include <basic/sberrors.hxx>
78 #include <sbunoobj.hxx>
79 #include <sbintern.hxx>
80 #include <runtime.hxx>
85 #include <string_view>
86 #include <unordered_map>
87 #include <com/sun/star/reflection/XTypeDescriptionEnumerationAccess.hpp>
88 #include <com/sun/star/reflection/XConstantsTypeDescription.hpp>
90 using com::sun::star::uno::Reference
;
91 using namespace com::sun::star::uno
;
92 using namespace com::sun::star::lang
;
93 using namespace com::sun::star::reflection
;
94 using namespace com::sun::star::beans
;
95 using namespace com::sun::star::script
;
96 using namespace com::sun::star::container
;
97 using namespace com::sun::star::bridge
;
101 // Identifiers for creating the strings for dbg_Properties
102 constexpr OUStringLiteral ID_DBG_SUPPORTEDINTERFACES
= u
"Dbg_SupportedInterfaces";
103 constexpr OUStringLiteral ID_DBG_PROPERTIES
= u
"Dbg_Properties";
104 constexpr OUStringLiteral ID_DBG_METHODS
= u
"Dbg_Methods";
106 char const aSeqLevelStr
[] = "[]";
108 // Gets the default property for a uno object. Note: There is some
109 // redirection built in. The property name specifies the name
110 // of the default property.
112 bool SbUnoObject::getDefaultPropName( SbUnoObject
const * pUnoObj
, OUString
& sDfltProp
)
114 bool bResult
= false;
115 Reference
< XDefaultProperty
> xDefaultProp( pUnoObj
->maTmpUnoObj
, UNO_QUERY
);
116 if ( xDefaultProp
.is() )
118 sDfltProp
= xDefaultProp
->getDefaultPropertyName();
119 if ( !sDfltProp
.isEmpty() )
125 SbxVariable
* getDefaultProp( SbxVariable
* pRef
)
127 SbxVariable
* pDefaultProp
= nullptr;
128 if ( pRef
->GetType() == SbxOBJECT
)
130 SbxObject
* pObj
= dynamic_cast<SbxObject
*>(pRef
);
133 SbxBase
* pObjVarObj
= pRef
->GetObject();
134 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
136 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
))
138 pDefaultProp
= pUnoObj
->GetDfltProperty();
144 void SetSbUnoObjectDfltPropName( SbxObject
* pObj
)
146 SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
);
149 OUString sDfltPropName
;
151 if ( SbUnoObject::getDefaultPropName( pUnoObj
, sDfltPropName
) )
153 pUnoObj
->SetDfltProperty( sDfltPropName
);
158 // save CoreReflection statically
159 static Reference
< XIdlReflection
> getCoreReflection_Impl()
161 return css::reflection::theCoreReflection::get(
162 comphelper::getProcessComponentContext());
165 // save CoreReflection statically
166 static Reference
< XHierarchicalNameAccess
> const & getCoreReflection_HierarchicalNameAccess_Impl()
168 static Reference
< XHierarchicalNameAccess
> xCoreReflection_HierarchicalNameAccess
;
170 if( !xCoreReflection_HierarchicalNameAccess
.is() )
172 Reference
< XIdlReflection
> xCoreReflection
= getCoreReflection_Impl();
173 if( xCoreReflection
.is() )
175 xCoreReflection_HierarchicalNameAccess
=
176 Reference
< XHierarchicalNameAccess
>( xCoreReflection
, UNO_QUERY
);
179 return xCoreReflection_HierarchicalNameAccess
;
182 // Hold TypeProvider statically
183 static Reference
< XHierarchicalNameAccess
> const & getTypeProvider_Impl()
185 static Reference
< XHierarchicalNameAccess
> xAccess
;
187 // Do we have already CoreReflection; if not obtain it
190 Reference
< XComponentContext
> xContext(
191 comphelper::getProcessComponentContext() );
194 xContext
->getValueByName(
195 "/singletons/com.sun.star.reflection.theTypeDescriptionManager" )
197 OSL_ENSURE( xAccess
.is(), "### TypeDescriptionManager singleton not accessible!?" );
201 throw DeploymentException(
202 "/singletons/com.sun.star.reflection.theTypeDescriptionManager singleton not accessible" );
208 // Hold TypeConverter statically
209 static Reference
< XTypeConverter
> const & getTypeConverter_Impl()
211 static Reference
< XTypeConverter
> xTypeConverter
;
213 // Do we have already CoreReflection; if not obtain it
214 if( !xTypeConverter
.is() )
216 Reference
< XComponentContext
> xContext(
217 comphelper::getProcessComponentContext() );
220 xTypeConverter
= Converter::create(xContext
);
222 if( !xTypeConverter
.is() )
224 throw DeploymentException(
225 "com.sun.star.script.Converter service not accessible" );
228 return xTypeConverter
;
232 // #111851 factory function to create an OLE object
233 SbUnoObject
* createOLEObject_Impl( const OUString
& aType
)
235 static const Reference
<XMultiServiceFactory
> xOLEFactory
= [] {
236 Reference
<XMultiServiceFactory
> xFactory
;
237 Reference
< XComponentContext
> xContext( comphelper::getProcessComponentContext() );
240 Reference
<XMultiComponentFactory
> xSMgr
= xContext
->getServiceManager();
242 xSMgr
->createInstanceWithContext( "com.sun.star.bridge.OleObjectFactory", xContext
),
248 SbUnoObject
* pUnoObj
= nullptr;
249 if( xOLEFactory
.is() )
251 // some type names available in VBA can not be directly used in COM
252 OUString aOLEType
= aType
;
253 if ( aOLEType
== "SAXXMLReader30" )
255 aOLEType
= "Msxml2.SAXXMLReader.3.0";
257 Reference
< XInterface
> xOLEObject
= xOLEFactory
->createInstance( aOLEType
);
258 if( xOLEObject
.is() )
260 pUnoObj
= new SbUnoObject( aType
, Any(xOLEObject
) );
261 OUString sDfltPropName
;
263 if ( SbUnoObject::getDefaultPropName( pUnoObj
, sDfltPropName
) )
264 pUnoObj
->SetDfltProperty( sDfltPropName
);
273 void lcl_indent( OUStringBuffer
& _inout_rBuffer
, sal_Int32 _nLevel
)
275 while ( _nLevel
-- > 0 )
277 _inout_rBuffer
.append( " " );
282 static void implAppendExceptionMsg( OUStringBuffer
& _inout_rBuffer
, const Exception
& _e
, std::u16string_view _rExceptionType
, sal_Int32 _nLevel
)
284 _inout_rBuffer
.append( "\n" );
285 lcl_indent( _inout_rBuffer
, _nLevel
);
286 _inout_rBuffer
.append( "Type: " );
288 if ( _rExceptionType
.empty() )
289 _inout_rBuffer
.append( "Unknown" );
291 _inout_rBuffer
.append( _rExceptionType
);
293 _inout_rBuffer
.append( "\n" );
294 lcl_indent( _inout_rBuffer
, _nLevel
);
295 _inout_rBuffer
.append( "Message: " );
296 _inout_rBuffer
.append( _e
.Message
);
300 // construct an error message for the exception
301 static OUString
implGetExceptionMsg( const Exception
& e
, std::u16string_view aExceptionType_
)
303 OUStringBuffer aMessageBuf
;
304 implAppendExceptionMsg( aMessageBuf
, e
, aExceptionType_
, 0 );
305 return aMessageBuf
.makeStringAndClear();
308 static OUString
implGetExceptionMsg( const Any
& _rCaughtException
)
310 auto e
= o3tl::tryAccess
<Exception
>(_rCaughtException
);
311 OSL_PRECOND( e
, "implGetExceptionMsg: illegal argument!" );
316 return implGetExceptionMsg( *e
, _rCaughtException
.getValueTypeName() );
319 static Any
convertAny( const Any
& rVal
, const Type
& aDestType
)
322 const Reference
< XTypeConverter
>& xConverter
= getTypeConverter_Impl();
325 aConvertedVal
= xConverter
->convertTo( rVal
, aDestType
);
327 catch( const IllegalArgumentException
& )
329 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
,
330 implGetExceptionMsg( ::cppu::getCaughtException() ) );
331 return aConvertedVal
;
333 catch( const CannotConvertException
& e2
)
335 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
,
336 implGetExceptionMsg( e2
, u
"com.sun.star.lang.IllegalArgumentException" ) );
337 return aConvertedVal
;
339 return aConvertedVal
;
343 // #105565 Special Object to wrap a strongly typed Uno Any
346 // TODO: source out later
347 static Reference
<XIdlClass
> TypeToIdlClass( const Type
& rType
)
349 return getCoreReflection_Impl()->forName(rType
.getTypeName());
352 // Exception type unknown
353 template< class EXCEPTION
>
354 static OUString
implGetExceptionMsg( const EXCEPTION
& e
)
356 return implGetExceptionMsg( e
, cppu::UnoType
<decltype(e
)>::get().getTypeName() );
359 static void implHandleBasicErrorException( BasicErrorException
const & e
)
361 ErrCode nError
= StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16
>(e
.ErrorCode
) );
362 StarBASIC::Error( nError
, e
.ErrorMessageArgument
);
365 static void implHandleWrappedTargetException( const Any
& _rWrappedTargetException
)
367 Any
aExamine( _rWrappedTargetException
);
369 // completely strip the first InvocationTargetException, its error message isn't of any
370 // interest to the user, it just says something like "invoking the UNO method went wrong.".
371 InvocationTargetException aInvocationError
;
372 if ( aExamine
>>= aInvocationError
)
373 aExamine
= aInvocationError
.TargetException
;
375 BasicErrorException aBasicError
;
377 ErrCode
nError( ERRCODE_BASIC_EXCEPTION
);
378 OUStringBuffer aMessageBuf
;
380 // strip any other WrappedTargetException instances, but this time preserve the error messages.
381 WrappedTargetException aWrapped
;
382 sal_Int32 nLevel
= 0;
383 while ( aExamine
>>= aWrapped
)
385 // special handling for BasicErrorException errors
386 if ( aWrapped
.TargetException
>>= aBasicError
)
388 nError
= StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16
>(aBasicError
.ErrorCode
) );
389 aMessageBuf
.append( aBasicError
.ErrorMessageArgument
);
394 // append this round's message
395 implAppendExceptionMsg( aMessageBuf
, aWrapped
, aExamine
.getValueTypeName(), nLevel
);
396 if ( aWrapped
.TargetException
.getValueTypeClass() == TypeClass_EXCEPTION
)
397 // there is a next chain element
398 aMessageBuf
.append( "\nTargetException:" );
401 aExamine
= aWrapped
.TargetException
;
405 if ( auto e
= o3tl::tryAccess
<Exception
>(aExamine
) )
407 // the last element in the chain is still an exception, but no WrappedTargetException
408 implAppendExceptionMsg( aMessageBuf
, *e
, aExamine
.getValueTypeName(), nLevel
);
411 StarBASIC::Error( nError
, aMessageBuf
.makeStringAndClear() );
414 static void implHandleAnyException( const Any
& _rCaughtException
)
416 BasicErrorException aBasicError
;
417 WrappedTargetException aWrappedError
;
419 if ( _rCaughtException
>>= aBasicError
)
421 implHandleBasicErrorException( aBasicError
);
423 else if ( _rCaughtException
>>= aWrappedError
)
425 implHandleWrappedTargetException( _rCaughtException
);
429 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
, implGetExceptionMsg( _rCaughtException
) );
435 // NativeObjectWrapper handling
438 SbxObjectRef m_xNativeObj
;
440 explicit ObjectItem( SbxObject
* pNativeObj
)
441 : m_xNativeObj( pNativeObj
)
447 typedef std::vector
< ObjectItem
> NativeObjectWrapperVector
;
451 NativeObjectWrapperVector gaNativeObjectWrapperVector
;
455 void clearNativeObjectWrapperVector()
457 gaNativeObjectWrapperVector
.clear();
460 static sal_uInt32
lcl_registerNativeObjectWrapper( SbxObject
* pNativeObj
)
462 sal_uInt32 nIndex
= gaNativeObjectWrapperVector
.size();
463 gaNativeObjectWrapperVector
.emplace_back( pNativeObj
);
467 static SbxObject
* lcl_getNativeObject( sal_uInt32 nIndex
)
469 SbxObjectRef xRetObj
;
470 if( nIndex
< gaNativeObjectWrapperVector
.size() )
472 ObjectItem
& rItem
= gaNativeObjectWrapperVector
[ nIndex
];
473 xRetObj
= rItem
.m_xNativeObj
;
475 return xRetObj
.get();
478 // convert from Uno to Sbx
479 static SbxDataType
unoToSbxType( TypeClass eType
)
481 SbxDataType eRetType
= SbxVOID
;
485 case TypeClass_INTERFACE
:
487 case TypeClass_STRUCT
:
488 case TypeClass_EXCEPTION
: eRetType
= SbxOBJECT
; break;
490 case TypeClass_ENUM
: eRetType
= SbxLONG
; break;
491 case TypeClass_SEQUENCE
:
492 eRetType
= SbxDataType( SbxOBJECT
| SbxARRAY
);
496 case TypeClass_ANY
: eRetType
= SbxVARIANT
; break;
497 case TypeClass_BOOLEAN
: eRetType
= SbxBOOL
; break;
498 case TypeClass_CHAR
: eRetType
= SbxCHAR
; break;
499 case TypeClass_STRING
: eRetType
= SbxSTRING
; break;
500 case TypeClass_FLOAT
: eRetType
= SbxSINGLE
; break;
501 case TypeClass_DOUBLE
: eRetType
= SbxDOUBLE
; break;
502 case TypeClass_BYTE
: eRetType
= SbxINTEGER
; break;
503 case TypeClass_SHORT
: eRetType
= SbxINTEGER
; break;
504 case TypeClass_LONG
: eRetType
= SbxLONG
; break;
505 case TypeClass_HYPER
: eRetType
= SbxSALINT64
; break;
506 case TypeClass_UNSIGNED_SHORT
: eRetType
= SbxUSHORT
; break;
507 case TypeClass_UNSIGNED_LONG
: eRetType
= SbxULONG
; break;
508 case TypeClass_UNSIGNED_HYPER
: eRetType
= SbxSALUINT64
;break;
514 static SbxDataType
unoToSbxType( const Reference
< XIdlClass
>& xIdlClass
)
516 SbxDataType eRetType
= SbxVOID
;
519 TypeClass eType
= xIdlClass
->getTypeClass();
520 eRetType
= unoToSbxType( eType
);
525 static void implSequenceToMultiDimArray( SbxDimArray
*& pArray
, Sequence
< sal_Int32
>& indices
, Sequence
< sal_Int32
>& sizes
, const Any
& aValue
, sal_Int32 dimension
, bool bIsZeroIndex
, Type
const * pType
)
527 const Type
& aType
= aValue
.getValueType();
528 TypeClass eTypeClass
= aType
.getTypeClass();
530 sal_Int32 dimCopy
= dimension
;
532 if ( eTypeClass
== TypeClass_SEQUENCE
)
534 Reference
< XIdlClass
> xIdlTargetClass
= TypeToIdlClass( aType
);
535 Reference
< XIdlArray
> xIdlArray
= xIdlTargetClass
->getArray();
536 typelib_TypeDescription
* pTD
= nullptr;
537 aType
.getDescription( &pTD
);
538 Type
aElementType( reinterpret_cast<typelib_IndirectTypeDescription
*>(pTD
)->pType
);
539 ::typelib_typedescription_release( pTD
);
541 sal_Int32 nLen
= xIdlArray
->getLen( aValue
);
542 for ( sal_Int32 index
= 0; index
< nLen
; ++index
)
544 auto pindices
= indices
.getArray();
545 Any aElementAny
= xIdlArray
->get( aValue
, static_cast<sal_uInt32
>(index
) );
546 // This detects the dimension were currently processing
547 if ( dimCopy
== dimension
)
550 if ( sizes
.getLength() < dimCopy
)
552 sizes
.realloc( sizes
.getLength() + 1 );
553 sizes
.getArray()[ sizes
.getLength() - 1 ] = nLen
;
554 indices
.realloc( indices
.getLength() + 1 );
555 pindices
= indices
.getArray();
560 pindices
[ dimCopy
- 1 ] = index
;
562 pindices
[ dimCopy
- 1] = index
+ 1;
564 implSequenceToMultiDimArray( pArray
, indices
, sizes
, aElementAny
, dimCopy
, bIsZeroIndex
, &aElementType
);
570 if ( !indices
.hasElements() )
572 // Should never ever get here ( indices.getLength()
573 // should equal number of dimensions in the array )
574 // And that should at least be 1 !
575 // #QUESTION is there a better error?
576 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT
);
580 SbxDataType eSbxElementType
= unoToSbxType( pType
? pType
->getTypeClass() : aValue
.getValueTypeClass() );
583 pArray
= new SbxDimArray( eSbxElementType
);
584 sal_Int32 nIndexLen
= indices
.getLength();
586 // Dimension the array
587 for ( sal_Int32 index
= 0; index
< nIndexLen
; ++index
)
590 pArray
->unoAddDim(0, sizes
[index
] - 1);
592 pArray
->unoAddDim(1, sizes
[index
]);
599 auto xVar
= tools::make_ref
<SbxVariable
>( eSbxElementType
);
600 unoToSbxValue( xVar
.get(), aValue
);
602 sal_Int32
* pIndices
= indices
.getArray();
603 pArray
->Put(xVar
.get(), pIndices
);
609 void unoToSbxValue( SbxVariable
* pVar
, const Any
& aValue
)
611 const Type
& aType
= aValue
.getValueType();
612 TypeClass eTypeClass
= aType
.getTypeClass();
617 // Map Type to IdlClass
620 Reference
<XIdlClass
> xClass
= TypeToIdlClass( aType_
);
622 aClassAny
<<= xClass
;
624 // instantiate SbUnoObject
625 SbUnoObject
* pSbUnoObject
= new SbUnoObject( OUString(), aClassAny
);
626 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(pSbUnoObject
);
628 // If the object is invalid deliver null
629 if( !pSbUnoObject
->getUnoAny().hasValue() )
631 pVar
->PutObject( nullptr );
635 pVar
->PutObject( xWrapper
.get() );
639 // Interfaces and Structs must be wrapped in a SbUnoObject
640 case TypeClass_INTERFACE
:
641 case TypeClass_STRUCT
:
642 case TypeClass_EXCEPTION
:
644 if( eTypeClass
== TypeClass_STRUCT
)
647 NativeObjectWrapper aNativeObjectWrapper
;
648 if ( aValue
>>= aWrap
)
650 SbxDimArray
* pArray
= nullptr;
651 Sequence
< sal_Int32
> indices
;
652 Sequence
< sal_Int32
> sizes
;
653 implSequenceToMultiDimArray( pArray
, indices
, sizes
, aWrap
.Array
, /*dimension*/0, aWrap
.IsZeroIndex
, nullptr );
656 SbxDimArrayRef xArray
= pArray
;
657 SbxFlagBits nFlags
= pVar
->GetFlags();
658 pVar
->ResetFlag( SbxFlagBits::Fixed
);
659 pVar
->PutObject( xArray
.get() );
660 pVar
->SetFlags( nFlags
);
666 else if ( aValue
>>= aNativeObjectWrapper
)
668 sal_uInt32 nIndex
= 0;
669 if( aNativeObjectWrapper
.ObjectId
>>= nIndex
)
671 SbxObject
* pObj
= lcl_getNativeObject( nIndex
);
672 pVar
->PutObject( pObj
);
680 SbiInstance
* pInst
= GetSbData()->pInst
;
681 if( pInst
&& pInst
->IsCompatibility() )
683 oleautomation::Date aDate
;
684 if( aValue
>>= aDate
)
686 pVar
->PutDate( aDate
.Value
);
691 oleautomation::Decimal aDecimal
;
692 if( aValue
>>= aDecimal
)
694 pVar
->PutDecimal( aDecimal
);
699 oleautomation::Currency aCurrency
;
700 if( aValue
>>= aCurrency
)
702 pVar
->PutCurrency( aCurrency
.Value
);
710 // instantiate a SbUnoObject
711 SbUnoObject
* pSbUnoObject
= new SbUnoObject( OUString(), aValue
);
712 //If this is called externally e.g. from the scripting
713 //framework then there is no 'active' runtime the default property will not be set up
714 //only a vba object will have XDefaultProp set anyway so... this
715 //test seems a bit of overkill
716 //if ( SbiRuntime::isVBAEnabled() )
718 OUString sDfltPropName
;
720 if ( SbUnoObject::getDefaultPropName( pSbUnoObject
, sDfltPropName
) )
722 pSbUnoObject
->SetDfltProperty( sDfltPropName
);
725 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(pSbUnoObject
);
727 // If the object is invalid deliver null
728 if( !pSbUnoObject
->getUnoAny().hasValue() )
730 pVar
->PutObject( nullptr );
734 pVar
->PutObject( xWrapper
.get() );
743 enum2int( nEnum
, aValue
);
744 pVar
->PutLong( nEnum
);
748 case TypeClass_SEQUENCE
:
750 Reference
< XIdlClass
> xIdlTargetClass
= TypeToIdlClass( aType
);
751 Reference
< XIdlArray
> xIdlArray
= xIdlTargetClass
->getArray();
752 sal_Int32 i
, nLen
= xIdlArray
->getLen( aValue
);
754 typelib_TypeDescription
* pTD
= nullptr;
755 aType
.getDescription( &pTD
);
756 assert( pTD
&& pTD
->eTypeClass
== typelib_TypeClass_SEQUENCE
);
757 Type
aElementType( reinterpret_cast<typelib_IndirectTypeDescription
*>(pTD
)->pType
);
758 ::typelib_typedescription_release( pTD
);
760 // build an Array in Basic
761 SbxDimArrayRef xArray
;
762 SbxDataType eSbxElementType
= unoToSbxType( aElementType
.getTypeClass() );
763 xArray
= new SbxDimArray( eSbxElementType
);
766 xArray
->unoAddDim(0, nLen
- 1);
768 // register the elements as variables
769 for( i
= 0 ; i
< nLen
; i
++ )
772 Any aElementAny
= xIdlArray
->get( aValue
, static_cast<sal_uInt32
>(i
) );
773 auto xVar
= tools::make_ref
<SbxVariable
>( eSbxElementType
);
774 unoToSbxValue( xVar
.get(), aElementAny
);
776 // put into the Array
777 xArray
->Put(xVar
.get(), &i
);
782 xArray
->unoAddDim(0, -1);
786 SbxFlagBits nFlags
= pVar
->GetFlags();
787 pVar
->ResetFlag( SbxFlagBits::Fixed
);
788 pVar
->PutObject( xArray
.get() );
789 pVar
->SetFlags( nFlags
);
795 case TypeClass_BOOLEAN
: pVar
->PutBool( *o3tl::forceAccess
<bool>(aValue
) ); break;
798 pVar
->PutChar( *o3tl::forceAccess
<sal_Unicode
>(aValue
) );
801 case TypeClass_STRING
: { OUString val
; aValue
>>= val
; pVar
->PutString( val
); } break;
802 case TypeClass_FLOAT
: { float val
= 0; aValue
>>= val
; pVar
->PutSingle( val
); } break;
803 case TypeClass_DOUBLE
: { double val
= 0; aValue
>>= val
; pVar
->PutDouble( val
); } break;
804 case TypeClass_BYTE
: { sal_Int8 val
= 0; aValue
>>= val
; pVar
->PutInteger( val
); } break;
805 case TypeClass_SHORT
: { sal_Int16 val
= 0; aValue
>>= val
; pVar
->PutInteger( val
); } break;
806 case TypeClass_LONG
: { sal_Int32 val
= 0; aValue
>>= val
; pVar
->PutLong( val
); } break;
807 case TypeClass_HYPER
: { sal_Int64 val
= 0; aValue
>>= val
; pVar
->PutInt64( val
); } break;
808 case TypeClass_UNSIGNED_SHORT
: { sal_uInt16 val
= 0; aValue
>>= val
; pVar
->PutUShort( val
); } break;
809 case TypeClass_UNSIGNED_LONG
: { sal_uInt32 val
= 0; aValue
>>= val
; pVar
->PutULong( val
); } break;
810 case TypeClass_UNSIGNED_HYPER
: { sal_uInt64 val
= 0; aValue
>>= val
; pVar
->PutUInt64( val
); } break;
811 default: pVar
->PutEmpty(); break;
815 // Deliver the reflection for Sbx types
816 static Type
getUnoTypeForSbxBaseType( SbxDataType eType
)
818 Type aRetType
= cppu::UnoType
<void>::get();
821 case SbxNULL
: aRetType
= cppu::UnoType
<XInterface
>::get(); break;
822 case SbxINTEGER
: aRetType
= cppu::UnoType
<sal_Int16
>::get(); break;
823 case SbxLONG
: aRetType
= cppu::UnoType
<sal_Int32
>::get(); break;
824 case SbxSINGLE
: aRetType
= cppu::UnoType
<float>::get(); break;
825 case SbxDOUBLE
: aRetType
= cppu::UnoType
<double>::get(); break;
826 case SbxCURRENCY
: aRetType
= cppu::UnoType
<oleautomation::Currency
>::get(); break;
827 case SbxDECIMAL
: aRetType
= cppu::UnoType
<oleautomation::Decimal
>::get(); break;
829 SbiInstance
* pInst
= GetSbData()->pInst
;
830 if( pInst
&& pInst
->IsCompatibility() )
831 aRetType
= cppu::UnoType
<double>::get();
833 aRetType
= cppu::UnoType
<oleautomation::Date
>::get();
836 case SbxSTRING
: aRetType
= cppu::UnoType
<OUString
>::get(); break;
837 case SbxBOOL
: aRetType
= cppu::UnoType
<sal_Bool
>::get(); break;
838 case SbxVARIANT
: aRetType
= cppu::UnoType
<Any
>::get(); break;
839 case SbxCHAR
: aRetType
= cppu::UnoType
<cppu::UnoCharType
>::get(); break;
840 case SbxBYTE
: aRetType
= cppu::UnoType
<sal_Int8
>::get(); break;
841 case SbxUSHORT
: aRetType
= cppu::UnoType
<cppu::UnoUnsignedShortType
>::get(); break;
842 case SbxULONG
: aRetType
= ::cppu::UnoType
<sal_uInt32
>::get(); break;
843 // map machine-dependent ones to long for consistency
844 case SbxINT
: aRetType
= ::cppu::UnoType
<sal_Int32
>::get(); break;
845 case SbxUINT
: aRetType
= ::cppu::UnoType
<sal_uInt32
>::get(); break;
851 // Converting of Sbx to Uno without a know target class for TypeClass_ANY
852 static Type
getUnoTypeForSbxValue( const SbxValue
* pVal
)
854 Type aRetType
= cppu::UnoType
<void>::get();
858 // convert SbxType to Uno
859 SbxDataType eBaseType
= pVal
->SbxValue::GetType();
860 if( eBaseType
== SbxOBJECT
)
862 SbxBaseRef xObj
= pVal
->GetObject();
865 aRetType
= cppu::UnoType
<XInterface
>::get();
869 if( auto pArray
= dynamic_cast<SbxDimArray
*>( xObj
.get() ) )
871 sal_Int32 nDims
= pArray
->GetDims();
872 Type aElementType
= getUnoTypeForSbxBaseType( static_cast<SbxDataType
>(pArray
->GetType() & 0xfff) );
873 TypeClass eElementTypeClass
= aElementType
.getTypeClass();
875 // Normal case: One dimensional array
876 sal_Int32 nLower
, nUpper
;
877 if (nDims
== 1 && pArray
->GetDim(1, nLower
, nUpper
))
879 if( eElementTypeClass
== TypeClass_VOID
|| eElementTypeClass
== TypeClass_ANY
)
881 // If all elements of the arrays are from the same type, take
882 // this one - otherwise the whole will be considered as Any-Sequence
883 bool bNeedsInit
= true;
885 for (sal_Int32 aIdx
[1] = { nLower
}; aIdx
[0] <= nUpper
; ++aIdx
[0])
887 SbxVariableRef xVar
= pArray
->Get(aIdx
);
888 Type aType
= getUnoTypeForSbxValue( xVar
.get() );
891 if( aType
.getTypeClass() == TypeClass_VOID
)
893 // if only first element is void: different types -> []any
894 // if all elements are void: []void is not allowed -> []any
895 aElementType
= cppu::UnoType
<Any
>::get();
898 aElementType
= aType
;
901 else if( aElementType
!= aType
)
903 // different types -> AnySequence
904 aElementType
= cppu::UnoType
<Any
>::get();
910 OUString aSeqTypeName
= aSeqLevelStr
+ aElementType
.getTypeName();
911 aRetType
= Type( TypeClass_SEQUENCE
, aSeqTypeName
);
913 // #i33795 Map also multi dimensional arrays to corresponding sequences
916 if( eElementTypeClass
== TypeClass_VOID
|| eElementTypeClass
== TypeClass_ANY
)
918 // For this check the array's dim structure does not matter
919 sal_uInt32 nFlatArraySize
= pArray
->Count();
921 bool bNeedsInit
= true;
922 for( sal_uInt32 i
= 0 ; i
< nFlatArraySize
; i
++ )
924 SbxVariableRef xVar
= pArray
->SbxArray::Get(i
);
925 Type aType
= getUnoTypeForSbxValue( xVar
.get() );
928 if( aType
.getTypeClass() == TypeClass_VOID
)
930 // if only first element is void: different types -> []any
931 // if all elements are void: []void is not allowed -> []any
932 aElementType
= cppu::UnoType
<Any
>::get();
935 aElementType
= aType
;
938 else if( aElementType
!= aType
)
940 // different types -> AnySequence
941 aElementType
= cppu::UnoType
<Any
>::get();
947 OUStringBuffer aSeqTypeName
;
948 for(sal_Int32 iDim
= 0 ; iDim
< nDims
; iDim
++ )
950 aSeqTypeName
.append(aSeqLevelStr
);
952 aSeqTypeName
.append(aElementType
.getTypeName());
953 aRetType
= Type( TypeClass_SEQUENCE
, aSeqTypeName
.makeStringAndClear() );
957 else if( auto obj
= dynamic_cast<SbUnoObject
*>( xObj
.get() ) )
959 aRetType
= obj
->getUnoAny().getValueType();
962 else if( auto any
= dynamic_cast<SbUnoAnyObject
*>( xObj
.get() ) )
964 aRetType
= any
->getValue().getValueType();
966 // Otherwise it is a No-Uno-Basic-Object -> default==deliver void
968 // No object, convert basic type
971 aRetType
= getUnoTypeForSbxBaseType( eBaseType
);
976 // converting of Sbx to Uno without known target class for TypeClass_ANY
977 static Any
sbxToUnoValueImpl( const SbxValue
* pVar
, bool bBlockConversionToSmallestType
= false )
979 SbxDataType eBaseType
= pVar
->SbxValue::GetType();
980 if( eBaseType
== SbxOBJECT
)
982 SbxBaseRef xObj
= pVar
->GetObject();
985 if( auto obj
= dynamic_cast<SbUnoAnyObject
*>( xObj
.get() ) )
986 return obj
->getValue();
987 if( auto pClassModuleObj
= dynamic_cast<SbClassModuleObject
*>( xObj
.get() ) )
990 SbModule
* pClassModule
= pClassModuleObj
->getClassModule();
991 if( pClassModule
->createCOMWrapperForIface( aRetAny
, pClassModuleObj
) )
994 if( dynamic_cast<const SbUnoObject
*>( xObj
.get() ) == nullptr )
996 // Create NativeObjectWrapper to identify object in case of callbacks
997 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( pVar
->GetObject() );
998 if( pObj
!= nullptr )
1000 NativeObjectWrapper aNativeObjectWrapper
;
1001 sal_uInt32 nIndex
= lcl_registerNativeObjectWrapper( pObj
);
1002 aNativeObjectWrapper
.ObjectId
<<= nIndex
;
1004 aRetAny
<<= aNativeObjectWrapper
;
1011 Type aType
= getUnoTypeForSbxValue( pVar
);
1012 TypeClass eType
= aType
.getTypeClass();
1014 if( !bBlockConversionToSmallestType
)
1016 // #79615 Choose "smallest" representation for int values
1017 // because up cast is allowed, downcast not
1020 case TypeClass_FLOAT
:
1021 case TypeClass_DOUBLE
:
1023 double d
= pVar
->GetDouble();
1024 if( rtl::math::approxEqual(d
, floor( d
)) )
1026 if( d
>= -128 && d
<= 127 )
1027 aType
= ::cppu::UnoType
<sal_Int8
>::get();
1028 else if( d
>= SbxMININT
&& d
<= SbxMAXINT
)
1029 aType
= ::cppu::UnoType
<sal_Int16
>::get();
1030 else if( d
>= -SbxMAXLNG
&& d
<= SbxMAXLNG
)
1031 aType
= ::cppu::UnoType
<sal_Int32
>::get();
1035 case TypeClass_SHORT
:
1037 sal_Int16 n
= pVar
->GetInteger();
1038 if( n
>= -128 && n
<= 127 )
1039 aType
= ::cppu::UnoType
<sal_Int8
>::get();
1042 case TypeClass_LONG
:
1044 sal_Int32 n
= pVar
->GetLong();
1045 if( n
>= -128 && n
<= 127 )
1046 aType
= ::cppu::UnoType
<sal_Int8
>::get();
1047 else if( n
>= SbxMININT
&& n
<= SbxMAXINT
)
1048 aType
= ::cppu::UnoType
<sal_Int16
>::get();
1051 case TypeClass_UNSIGNED_SHORT
:
1053 sal_uInt16 n
= pVar
->GetUShort();
1055 aType
= cppu::UnoType
<sal_uInt8
>::get();
1058 case TypeClass_UNSIGNED_LONG
:
1060 sal_uInt32 n
= pVar
->GetLong();
1062 aType
= cppu::UnoType
<sal_uInt8
>::get();
1063 else if( n
<= SbxMAXUINT
)
1064 aType
= cppu::UnoType
<cppu::UnoUnsignedShortType
>::get();
1067 // TODO: need to add hyper types ?
1072 return sbxToUnoValue( pVar
, aType
);
1076 // Helper function for StepREDIMP
1077 static Any
implRekMultiDimArrayToSequence( SbxDimArray
* pArray
,
1078 const Type
& aElemType
, sal_Int32 nMaxDimIndex
, sal_Int32 nActualDim
,
1079 sal_Int32
* pActualIndices
, sal_Int32
* pLowerBounds
, sal_Int32
* pUpperBounds
)
1081 sal_Int32 nSeqLevel
= nMaxDimIndex
- nActualDim
+ 1;
1082 OUStringBuffer aSeqTypeName
;
1084 for( i
= 0 ; i
< nSeqLevel
; i
++ )
1086 aSeqTypeName
.append(aSeqLevelStr
);
1088 aSeqTypeName
.append(aElemType
.getTypeName());
1089 Type
aSeqType( TypeClass_SEQUENCE
, aSeqTypeName
.makeStringAndClear() );
1091 // Create Sequence instance
1093 Reference
< XIdlClass
> xIdlTargetClass
= TypeToIdlClass( aSeqType
);
1094 xIdlTargetClass
->createObject( aRetVal
);
1096 // Alloc sequence according to array bounds
1097 sal_Int32 nUpper
= pUpperBounds
[nActualDim
];
1098 sal_Int32 nLower
= pLowerBounds
[nActualDim
];
1099 sal_Int32 nSeqSize
= nUpper
- nLower
+ 1;
1100 Reference
< XIdlArray
> xArray
= xIdlTargetClass
->getArray();
1101 xArray
->realloc( aRetVal
, nSeqSize
);
1103 sal_Int32
& ri
= pActualIndices
[nActualDim
];
1105 for( ri
= nLower
,i
= 0 ; ri
<= nUpper
; ri
++,i
++ )
1109 if( nActualDim
< nMaxDimIndex
)
1111 aElementVal
= implRekMultiDimArrayToSequence( pArray
, aElemType
,
1112 nMaxDimIndex
, nActualDim
+ 1, pActualIndices
, pLowerBounds
, pUpperBounds
);
1116 SbxVariable
* pSource
= pArray
->Get(pActualIndices
);
1117 aElementVal
= sbxToUnoValue( pSource
, aElemType
);
1122 // transfer to the sequence
1123 xArray
->set( aRetVal
, i
, aElementVal
);
1125 catch( const IllegalArgumentException
& )
1127 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
,
1128 implGetExceptionMsg( ::cppu::getCaughtException() ) );
1130 catch (const IndexOutOfBoundsException
&)
1132 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
1138 // Map old interface
1139 Any
sbxToUnoValue( const SbxValue
* pVar
)
1141 return sbxToUnoValueImpl( pVar
);
1144 // function to find a global identifier in
1145 // the UnoScope and to wrap it for Sbx
1146 static bool implGetTypeByName( const OUString
& rName
, Type
& rRetType
)
1148 bool bSuccess
= false;
1150 const Reference
< XHierarchicalNameAccess
>& xTypeAccess
= getTypeProvider_Impl();
1151 if( xTypeAccess
->hasByHierarchicalName( rName
) )
1153 Any aRet
= xTypeAccess
->getByHierarchicalName( rName
);
1154 Reference
< XTypeDescription
> xTypeDesc
;
1157 if( xTypeDesc
.is() )
1159 rRetType
= Type( xTypeDesc
->getTypeClass(), xTypeDesc
->getName() );
1167 // converting of Sbx to Uno with known target class
1168 Any
sbxToUnoValue( const SbxValue
* pVar
, const Type
& rType
, Property
const * pUnoProperty
)
1172 // #94560 No conversion of empty/void for MAYBE_VOID properties
1173 if( pUnoProperty
&& pUnoProperty
->Attributes
& PropertyAttribute::MAYBEVOID
)
1175 if( pVar
->IsEmpty() )
1179 SbxDataType eBaseType
= pVar
->SbxValue::GetType();
1180 if( eBaseType
== SbxOBJECT
)
1182 SbxBaseRef xObj
= pVar
->GetObject();
1183 if ( auto obj
= dynamic_cast<SbUnoAnyObject
*>( xObj
.get() ) )
1185 return obj
->getValue();
1189 TypeClass eType
= rType
.getTypeClass();
1192 case TypeClass_INTERFACE
:
1193 case TypeClass_STRUCT
:
1194 case TypeClass_EXCEPTION
:
1196 Reference
< XIdlClass
> xIdlTargetClass
= TypeToIdlClass( rType
);
1199 if( pVar
->IsNull() && eType
== TypeClass_INTERFACE
)
1201 Reference
< XInterface
> xRef
;
1202 OUString aClassName
= xIdlTargetClass
->getName();
1203 Type
aClassType( xIdlTargetClass
->getTypeClass(), aClassName
);
1204 aRetVal
.setValue( &xRef
, aClassType
);
1208 // #112368 Special conversion for Decimal, Currency and Date
1209 if( eType
== TypeClass_STRUCT
)
1211 SbiInstance
* pInst
= GetSbData()->pInst
;
1212 if( pInst
&& pInst
->IsCompatibility() )
1214 if( rType
== cppu::UnoType
<oleautomation::Decimal
>::get())
1216 oleautomation::Decimal aDecimal
;
1217 pVar
->fillAutomationDecimal( aDecimal
);
1218 aRetVal
<<= aDecimal
;
1221 else if( rType
== cppu::UnoType
<oleautomation::Currency
>::get())
1223 // assumes per previous code that ole Currency is Int64
1224 aRetVal
<<= pVar
->GetInt64();
1227 else if( rType
== cppu::UnoType
<oleautomation::Date
>::get())
1229 oleautomation::Date aDate
;
1230 aDate
.Value
= pVar
->GetDate();
1237 SbxBaseRef pObj
= pVar
->GetObject();
1238 if( auto obj
= dynamic_cast<SbUnoObject
*>( pObj
.get() ) )
1240 aRetVal
= obj
->getUnoAny();
1242 else if( auto structRef
= dynamic_cast<SbUnoStructRefObject
*>( pObj
.get() ) )
1244 aRetVal
= structRef
->getUnoAny();
1248 // null object -> null XInterface
1249 Reference
<XInterface
> xInt
;
1256 case TypeClass_TYPE
:
1258 if( eBaseType
== SbxOBJECT
)
1261 Reference
< XIdlClass
> xIdlClass
;
1263 SbxBaseRef pObj
= pVar
->GetObject();
1264 if( auto obj
= dynamic_cast<SbUnoObject
*>( pObj
.get() ) )
1266 Any aUnoAny
= obj
->getUnoAny();
1267 aUnoAny
>>= xIdlClass
;
1270 if( xIdlClass
.is() )
1272 OUString aClassName
= xIdlClass
->getName();
1273 Type
aType( xIdlClass
->getTypeClass(), aClassName
);
1277 else if( eBaseType
== SbxSTRING
)
1279 OUString aTypeName
= pVar
->GetOUString();
1281 bool bSuccess
= implGetTypeByName( aTypeName
, aType
);
1291 case TypeClass_ENUM
:
1293 aRetVal
= int2enum( pVar
->GetLong(), rType
);
1297 case TypeClass_SEQUENCE
:
1299 SbxBaseRef xObj
= pVar
->GetObject();
1300 if( auto pArray
= dynamic_cast<SbxDimArray
*>( xObj
.get() ) )
1302 sal_Int32 nDims
= pArray
->GetDims();
1304 // Normal case: One dimensional array
1305 sal_Int32 nLower
, nUpper
;
1306 if (nDims
== 1 && pArray
->GetDim(1, nLower
, nUpper
))
1308 sal_Int32 nSeqSize
= nUpper
- nLower
+ 1;
1310 // create the instance of the required sequence
1311 Reference
< XIdlClass
> xIdlTargetClass
= TypeToIdlClass( rType
);
1312 xIdlTargetClass
->createObject( aRetVal
);
1313 Reference
< XIdlArray
> xArray
= xIdlTargetClass
->getArray();
1314 xArray
->realloc( aRetVal
, nSeqSize
);
1317 OUString aClassName
= xIdlTargetClass
->getName();
1318 typelib_TypeDescription
* pSeqTD
= nullptr;
1319 typelib_typedescription_getByName( &pSeqTD
, aClassName
.pData
);
1321 Type
aElemType( reinterpret_cast<typelib_IndirectTypeDescription
*>(pSeqTD
)->pType
);
1323 // convert all array member and register them
1326 for (sal_Int32 i
= 0 ; i
< nSeqSize
; ++i
, ++aIdx
[0])
1328 SbxVariableRef xVar
= pArray
->Get(aIdx
);
1330 // Convert the value of Sbx to Uno
1331 Any aAnyValue
= sbxToUnoValue( xVar
.get(), aElemType
);
1335 // insert in the sequence
1336 xArray
->set( aRetVal
, i
, aAnyValue
);
1338 catch( const IllegalArgumentException
& )
1340 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
,
1341 implGetExceptionMsg( ::cppu::getCaughtException() ) );
1343 catch (const IndexOutOfBoundsException
&)
1345 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
1349 // #i33795 Map also multi dimensional arrays to corresponding sequences
1350 else if( nDims
> 1 )
1353 typelib_TypeDescription
* pSeqTD
= nullptr;
1354 Type
aCurType( rType
);
1355 sal_Int32 nSeqLevel
= 0;
1359 OUString aTypeName
= aCurType
.getTypeName();
1360 typelib_typedescription_getByName( &pSeqTD
, aTypeName
.pData
);
1362 if( pSeqTD
->eTypeClass
== typelib_TypeClass_SEQUENCE
)
1364 aCurType
= Type( reinterpret_cast<typelib_IndirectTypeDescription
*>(pSeqTD
)->pType
);
1369 aElemType
= aCurType
;
1375 if( nSeqLevel
== nDims
)
1377 std::unique_ptr
<sal_Int32
[]> pLowerBounds(new sal_Int32
[nDims
]);
1378 std::unique_ptr
<sal_Int32
[]> pUpperBounds(new sal_Int32
[nDims
]);
1379 std::unique_ptr
<sal_Int32
[]> pActualIndices(new sal_Int32
[nDims
]);
1380 for(sal_Int32 i
= 1 ; i
<= nDims
; i
++ )
1382 sal_Int32 lBound
, uBound
;
1383 pArray
->GetDim(i
, lBound
, uBound
);
1385 sal_Int32 j
= i
- 1;
1386 pActualIndices
[j
] = pLowerBounds
[j
] = lBound
;
1387 pUpperBounds
[j
] = uBound
;
1390 aRetVal
= implRekMultiDimArrayToSequence( pArray
, aElemType
,
1391 nDims
- 1, 0, pActualIndices
.get(), pLowerBounds
.get(), pUpperBounds
.get() );
1399 // for Any use the class independent converting routine
1402 aRetVal
= sbxToUnoValueImpl( pVar
);
1406 case TypeClass_BOOLEAN
:
1408 aRetVal
<<= pVar
->GetBool();
1411 case TypeClass_CHAR
:
1413 aRetVal
<<= pVar
->GetChar();
1416 case TypeClass_STRING
: aRetVal
<<= pVar
->GetOUString(); break;
1417 case TypeClass_FLOAT
: aRetVal
<<= pVar
->GetSingle(); break;
1418 case TypeClass_DOUBLE
: aRetVal
<<= pVar
->GetDouble(); break;
1420 case TypeClass_BYTE
:
1422 sal_Int16 nVal
= pVar
->GetInteger();
1423 bool bOverflow
= false;
1429 else if( nVal
> 255 ) // 128..255 map to -128..-1
1435 StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW
);
1437 sal_Int8 nByteVal
= static_cast<sal_Int8
>(nVal
);
1438 aRetVal
<<= nByteVal
;
1441 case TypeClass_SHORT
: aRetVal
<<= pVar
->GetInteger(); break;
1442 case TypeClass_LONG
: aRetVal
<<= pVar
->GetLong(); break;
1443 case TypeClass_HYPER
: aRetVal
<<= pVar
->GetInt64(); break;
1444 case TypeClass_UNSIGNED_SHORT
: aRetVal
<<= pVar
->GetUShort(); break;
1445 case TypeClass_UNSIGNED_LONG
: aRetVal
<<= pVar
->GetULong(); break;
1446 case TypeClass_UNSIGNED_HYPER
: aRetVal
<<= pVar
->GetUInt64(); break;
1453 static void processAutomationParams( SbxArray
* pParams
, Sequence
< Any
>& args
, sal_uInt32 nParamCount
)
1455 AutomationNamedArgsSbxArray
* pArgNamesArray
= dynamic_cast<AutomationNamedArgsSbxArray
*>( pParams
);
1457 args
.realloc( nParamCount
);
1458 Any
* pAnyArgs
= args
.getArray();
1459 bool bBlockConversionToSmallestType
= GetSbData()->pInst
->IsCompatibility();
1461 if( pArgNamesArray
)
1463 Sequence
< OUString
>& rNameSeq
= pArgNamesArray
->getNames();
1464 OUString
* pNames
= rNameSeq
.getArray();
1466 for( i
= 0 ; i
< nParamCount
; i
++ )
1468 sal_uInt32 iSbx
= i
+ 1;
1470 aValAny
= sbxToUnoValueImpl(pParams
->Get(iSbx
),
1471 bBlockConversionToSmallestType
);
1473 OUString aParamName
= pNames
[iSbx
];
1474 if( !aParamName
.isEmpty() )
1476 oleautomation::NamedArgument aNamedArgument
;
1477 aNamedArgument
.Name
= aParamName
;
1478 aNamedArgument
.Value
= aValAny
;
1479 pAnyArgs
[i
] <<= aNamedArgument
;
1483 pAnyArgs
[i
] = aValAny
;
1489 for( i
= 0 ; i
< nParamCount
; i
++ )
1491 pAnyArgs
[i
] = sbxToUnoValueImpl(pParams
->Get(i
+ 1),
1492 bBlockConversionToSmallestType
);
1500 enum class INVOKETYPE
1508 static Any
invokeAutomationMethod( const OUString
& Name
, Sequence
< Any
> const & args
, SbxArray
* pParams
, sal_uInt32 nParamCount
, Reference
< XInvocation
> const & rxInvocation
, INVOKETYPE invokeType
)
1510 Sequence
< sal_Int16
> OutParamIndex
;
1511 Sequence
< Any
> OutParam
;
1514 switch( invokeType
)
1516 case INVOKETYPE::Func
:
1517 aRetAny
= rxInvocation
->invoke( Name
, args
, OutParamIndex
, OutParam
);
1519 case INVOKETYPE::GetProp
:
1521 Reference
< XAutomationInvocation
> xAutoInv( rxInvocation
, UNO_QUERY
);
1522 aRetAny
= xAutoInv
->invokeGetProperty( Name
, args
, OutParamIndex
, OutParam
);
1526 assert(false); break;
1529 const sal_Int16
* pIndices
= OutParamIndex
.getConstArray();
1530 sal_uInt32 nLen
= OutParamIndex
.getLength();
1533 const Any
* pNewValues
= OutParam
.getConstArray();
1534 for( sal_uInt32 j
= 0 ; j
< nLen
; j
++ )
1536 sal_Int16 iTarget
= pIndices
[ j
];
1537 if( iTarget
>= static_cast<sal_Int16
>(nParamCount
) )
1539 unoToSbxValue(pParams
->Get(j
+ 1), pNewValues
[j
]);
1545 // Debugging help method to readout the implemented interfaces of an object
1546 static OUString
Impl_GetInterfaceInfo( const Reference
< XInterface
>& x
, const Reference
< XIdlClass
>& xClass
, sal_uInt16 nRekLevel
)
1548 Type aIfaceType
= cppu::UnoType
<XInterface
>::get();
1549 static Reference
< XIdlClass
> xIfaceClass
= TypeToIdlClass( aIfaceType
);
1551 OUStringBuffer aRetStr
;
1552 for( sal_uInt16 i
= 0 ; i
< nRekLevel
; i
++ )
1553 aRetStr
.append( " " );
1554 aRetStr
.append( xClass
->getName() );
1555 OUString aClassName
= xClass
->getName();
1556 Type
aClassType( xClass
->getTypeClass(), aClassName
);
1558 // checking if the interface is really supported
1559 if( !x
->queryInterface( aClassType
).hasValue() )
1561 aRetStr
.append( " (ERROR: Not really supported!)\n" );
1563 // Are there super interfaces?
1566 aRetStr
.append( "\n" );
1568 // get the super interfaces
1569 Sequence
< Reference
< XIdlClass
> > aSuperClassSeq
= xClass
->getSuperclasses();
1570 const Reference
< XIdlClass
>* pClasses
= aSuperClassSeq
.getConstArray();
1571 sal_uInt32 nSuperIfaceCount
= aSuperClassSeq
.getLength();
1572 for( sal_uInt32 j
= 0 ; j
< nSuperIfaceCount
; j
++ )
1574 const Reference
< XIdlClass
>& rxIfaceClass
= pClasses
[j
];
1575 if( !rxIfaceClass
->equals( xIfaceClass
) )
1576 aRetStr
.append( Impl_GetInterfaceInfo( x
, rxIfaceClass
, nRekLevel
+ 1 ) );
1579 return aRetStr
.makeStringAndClear();
1582 static OUString
getDbgObjectNameImpl(SbUnoObject
& rUnoObj
)
1584 OUString aName
= rUnoObj
.GetClassName();
1585 if( aName
.isEmpty() )
1587 Any aToInspectObj
= rUnoObj
.getUnoAny();
1588 Reference
< XInterface
> xObj(aToInspectObj
, css::uno::UNO_QUERY
);
1591 Reference
< XServiceInfo
> xServiceInfo( xObj
, UNO_QUERY
);
1592 if( xServiceInfo
.is() )
1593 aName
= xServiceInfo
->getImplementationName();
1599 static OUString
getDbgObjectName(SbUnoObject
& rUnoObj
)
1601 OUString aName
= getDbgObjectNameImpl(rUnoObj
);
1602 if( aName
.isEmpty() )
1605 OUStringBuffer aRet
;
1606 if( aName
.getLength() > 20 )
1608 aRet
.append( "\n" );
1610 aRet
.append( "\"" );
1611 aRet
.append( aName
);
1612 aRet
.append( "\":" );
1613 return aRet
.makeStringAndClear();
1616 OUString
getBasicObjectTypeName( SbxObject
* pObj
)
1620 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
))
1622 return getDbgObjectNameImpl(*pUnoObj
);
1624 else if (SbUnoStructRefObject
* pUnoStructObj
= dynamic_cast<SbUnoStructRefObject
*>(pObj
))
1626 return pUnoStructObj
->GetClassName();
1634 bool matchesBasicTypeName(
1635 css::uno::Reference
<css::reflection::XIdlClass
> const & unoType
, OUString
const & basicTypeName
)
1637 if (unoType
->getName().endsWithIgnoreAsciiCase(basicTypeName
)) {
1640 auto const sups
= unoType
->getSuperclasses();
1642 sups
.begin(), sups
.end(),
1643 [&basicTypeName
](auto const & t
) { return matchesBasicTypeName(t
, basicTypeName
); });
1648 bool checkUnoObjectType(SbUnoObject
& rUnoObj
, const OUString
& rClass
)
1650 Any aToInspectObj
= rUnoObj
.getUnoAny();
1652 // Return true for XInvocation based objects as interface type names don't count then
1653 Reference
< XInvocation
> xInvocation( aToInspectObj
, UNO_QUERY
);
1654 if( xInvocation
.is() )
1658 bool bResult
= false;
1659 Reference
< XTypeProvider
> xTypeProvider( aToInspectObj
, UNO_QUERY
);
1660 if( xTypeProvider
.is() )
1662 /* Although interfaces in the ooo.vba namespace obey the IDL rules and
1663 have a leading 'X', in Basic we want to be able to do something
1664 like 'Dim wb As Workbooks' or 'Dim lb As MSForms.Label'. Here we
1665 add a leading 'X' to the class name and a leading dot to the entire
1666 type name. This results e.g. in '.XWorkbooks' or '.MSForms.XLabel'
1667 which matches the interface names 'ooo.vba.excel.XWorkbooks' or
1668 'ooo.vba.msforms.XLabel'.
1670 OUString aClassName
;
1671 if ( SbiRuntime::isVBAEnabled() )
1674 sal_Int32 nClassNameDot
= rClass
.lastIndexOf( '.' );
1675 if( nClassNameDot
>= 0 )
1677 aClassName
+= OUString::Concat(rClass
.subView( 0, nClassNameDot
+ 1 )) + "X" + rClass
.subView( nClassNameDot
+ 1 );
1681 aClassName
+= "X" + rClass
;
1684 else // assume extended type declaration support for basic ( can't get here
1686 aClassName
= rClass
;
1688 Sequence
< Type
> aTypeSeq
= xTypeProvider
->getTypes();
1689 const Type
* pTypeArray
= aTypeSeq
.getConstArray();
1690 sal_uInt32 nIfaceCount
= aTypeSeq
.getLength();
1691 for( sal_uInt32 j
= 0 ; j
< nIfaceCount
; j
++ )
1693 const Type
& rType
= pTypeArray
[j
];
1695 Reference
<XIdlClass
> xClass
= TypeToIdlClass( rType
);
1698 OSL_FAIL("failed to get XIdlClass for type");
1701 OUString aInterfaceName
= xClass
->getName();
1702 if ( aInterfaceName
== "com.sun.star.bridge.oleautomation.XAutomationObject" )
1704 // there is a hack in the extensions/source/ole/oleobj.cxx to return the typename of the automation object, lets check if it
1706 Reference
< XInvocation
> xInv( aToInspectObj
, UNO_QUERY
);
1710 xInv
->getValue( "$GetTypeName" ) >>= sTypeName
;
1711 if ( sTypeName
.isEmpty() || sTypeName
== "IDispatch" )
1713 // can't check type, leave it pass
1718 bResult
= sTypeName
== rClass
;
1721 break; // finished checking automation object
1724 if ( matchesBasicTypeName(xClass
, aClassName
) )
1734 // Debugging help method to readout the implemented interfaces of an object
1735 static OUString
Impl_GetSupportedInterfaces(SbUnoObject
& rUnoObj
)
1737 Any aToInspectObj
= rUnoObj
.getUnoAny();
1739 // allow only TypeClass interface
1740 OUStringBuffer aRet
;
1741 auto x
= o3tl::tryAccess
<Reference
<XInterface
>>(aToInspectObj
);
1744 aRet
.append( ID_DBG_SUPPORTEDINTERFACES
);
1745 aRet
.append( " not available.\n(TypeClass is not TypeClass_INTERFACE)\n" );
1749 Reference
< XTypeProvider
> xTypeProvider( *x
, UNO_QUERY
);
1751 aRet
.append( "Supported interfaces by object " );
1752 aRet
.append(getDbgObjectName(rUnoObj
));
1753 aRet
.append( "\n" );
1754 if( xTypeProvider
.is() )
1756 // get the interfaces of the implementation
1757 Sequence
< Type
> aTypeSeq
= xTypeProvider
->getTypes();
1758 const Type
* pTypeArray
= aTypeSeq
.getConstArray();
1759 sal_uInt32 nIfaceCount
= aTypeSeq
.getLength();
1760 for( sal_uInt32 j
= 0 ; j
< nIfaceCount
; j
++ )
1762 const Type
& rType
= pTypeArray
[j
];
1764 Reference
<XIdlClass
> xClass
= TypeToIdlClass( rType
);
1767 aRet
.append( Impl_GetInterfaceInfo( *x
, xClass
, 1 ) );
1771 typelib_TypeDescription
* pTD
= nullptr;
1772 rType
.getDescription( &pTD
);
1774 aRet
.append( "*** ERROR: No IdlClass for type \"" );
1775 aRet
.append( pTD
->pTypeName
);
1776 aRet
.append( "\"\n*** Please check type library\n" );
1781 return aRet
.makeStringAndClear();
1785 // Debugging help method SbxDataType -> String
1786 static OUString
Dbg_SbxDataType2String( SbxDataType eType
)
1788 OUStringBuffer aRet
;
1791 case SbxEMPTY
: aRet
.append("SbxEMPTY"); break;
1792 case SbxNULL
: aRet
.append("SbxNULL"); break;
1793 case SbxINTEGER
: aRet
.append("SbxINTEGER"); break;
1794 case SbxLONG
: aRet
.append("SbxLONG"); break;
1795 case SbxSINGLE
: aRet
.append("SbxSINGLE"); break;
1796 case SbxDOUBLE
: aRet
.append("SbxDOUBLE"); break;
1797 case SbxCURRENCY
: aRet
.append("SbxCURRENCY"); break;
1798 case SbxDECIMAL
: aRet
.append("SbxDECIMAL"); break;
1799 case SbxDATE
: aRet
.append("SbxDATE"); break;
1800 case SbxSTRING
: aRet
.append("SbxSTRING"); break;
1801 case SbxOBJECT
: aRet
.append("SbxOBJECT"); break;
1802 case SbxERROR
: aRet
.append("SbxERROR"); break;
1803 case SbxBOOL
: aRet
.append("SbxBOOL"); break;
1804 case SbxVARIANT
: aRet
.append("SbxVARIANT"); break;
1805 case SbxDATAOBJECT
: aRet
.append("SbxDATAOBJECT"); break;
1806 case SbxCHAR
: aRet
.append("SbxCHAR"); break;
1807 case SbxBYTE
: aRet
.append("SbxBYTE"); break;
1808 case SbxUSHORT
: aRet
.append("SbxUSHORT"); break;
1809 case SbxULONG
: aRet
.append("SbxULONG"); break;
1810 case SbxSALINT64
: aRet
.append("SbxINT64"); break;
1811 case SbxSALUINT64
: aRet
.append("SbxUINT64"); break;
1812 case SbxINT
: aRet
.append("SbxINT"); break;
1813 case SbxUINT
: aRet
.append("SbxUINT"); break;
1814 case SbxVOID
: aRet
.append("SbxVOID"); break;
1815 case SbxHRESULT
: aRet
.append("SbxHRESULT"); break;
1816 case SbxPOINTER
: aRet
.append("SbxPOINTER"); break;
1817 case SbxDIMARRAY
: aRet
.append("SbxDIMARRAY"); break;
1818 case SbxCARRAY
: aRet
.append("SbxCARRAY"); break;
1819 case SbxUSERDEF
: aRet
.append("SbxUSERDEF"); break;
1820 case SbxLPSTR
: aRet
.append("SbxLPSTR"); break;
1821 case SbxLPWSTR
: aRet
.append("SbxLPWSTR"); break;
1822 case SbxCoreSTRING
: aRet
.append("SbxCoreSTRING"); break;
1823 case SbxOBJECT
| SbxARRAY
: aRet
.append("SbxARRAY"); break;
1824 default: aRet
.append("Unknown Sbx-Type!");break;
1826 return aRet
.makeStringAndClear();
1829 // Debugging help method to display the properties of a SbUnoObjects
1830 static OUString
Impl_DumpProperties(SbUnoObject
& rUnoObj
)
1832 OUStringBuffer aRet
;
1833 aRet
.append("Properties of object ");
1834 aRet
.append(getDbgObjectName(rUnoObj
));
1836 // analyse the Uno-Infos to recognise the arrays
1837 Reference
< XIntrospectionAccess
> xAccess
= rUnoObj
.getIntrospectionAccess();
1840 Reference
< XInvocation
> xInvok
= rUnoObj
.getInvocation();
1842 xAccess
= xInvok
->getIntrospection();
1846 aRet
.append( "\nUnknown, no introspection available\n" );
1847 return aRet
.makeStringAndClear();
1850 Sequence
<Property
> props
= xAccess
->getProperties( PropertyConcept::ALL
- PropertyConcept::DANGEROUS
);
1851 sal_uInt32 nUnoPropCount
= props
.getLength();
1852 const Property
* pUnoProps
= props
.getConstArray();
1854 SbxArray
* pProps
= rUnoObj
.GetProperties();
1855 sal_uInt32 nPropCount
= pProps
->Count();
1856 sal_uInt32 nPropsPerLine
= 1 + nPropCount
/ 30;
1857 for( sal_uInt32 i
= 0; i
< nPropCount
; i
++ )
1859 SbxVariable
* pVar
= pProps
->Get(i
);
1862 OUStringBuffer aPropStr
;
1863 if( (i
% nPropsPerLine
) == 0 )
1864 aPropStr
.append( "\n" );
1866 // output the type and name
1867 // Is it in Uno a sequence?
1868 SbxDataType eType
= pVar
->GetFullType();
1870 bool bMaybeVoid
= false;
1871 if( i
< nUnoPropCount
)
1873 const Property
& rProp
= pUnoProps
[ i
];
1875 // For MAYBEVOID freshly convert the type from Uno,
1876 // so not just SbxEMPTY is returned.
1877 if( rProp
.Attributes
& PropertyAttribute::MAYBEVOID
)
1879 eType
= unoToSbxType( rProp
.Type
.getTypeClass() );
1882 if( eType
== SbxOBJECT
)
1884 Type aType
= rProp
.Type
;
1885 if( aType
.getTypeClass() == TypeClass_SEQUENCE
)
1886 eType
= SbxDataType( SbxOBJECT
| SbxARRAY
);
1889 aPropStr
.append( Dbg_SbxDataType2String( eType
) );
1891 aPropStr
.append( "/void" );
1892 aPropStr
.append( " " );
1893 aPropStr
.append( pVar
->GetName() );
1895 if( i
== nPropCount
- 1 )
1896 aPropStr
.append( "\n" );
1898 aPropStr
.append( "; " );
1900 aRet
.append( aPropStr
);
1903 return aRet
.makeStringAndClear();
1906 // Debugging help method to display the methods of an SbUnoObjects
1907 static OUString
Impl_DumpMethods(SbUnoObject
& rUnoObj
)
1909 OUStringBuffer aRet
;
1910 aRet
.append("Methods of object ");
1911 aRet
.append(getDbgObjectName(rUnoObj
));
1913 // XIntrospectionAccess, so that the types of the parameter could be outputted
1914 Reference
< XIntrospectionAccess
> xAccess
= rUnoObj
.getIntrospectionAccess();
1917 Reference
< XInvocation
> xInvok
= rUnoObj
.getInvocation();
1919 xAccess
= xInvok
->getIntrospection();
1923 aRet
.append( "\nUnknown, no introspection available\n" );
1924 return aRet
.makeStringAndClear();
1926 Sequence
< Reference
< XIdlMethod
> > methods
= xAccess
->getMethods
1927 ( MethodConcept::ALL
- MethodConcept::DANGEROUS
);
1928 const Reference
< XIdlMethod
>* pUnoMethods
= methods
.getConstArray();
1930 SbxArray
* pMethods
= rUnoObj
.GetMethods();
1931 sal_uInt32 nMethodCount
= pMethods
->Count();
1934 aRet
.append( "\nNo methods found\n" );
1935 return aRet
.makeStringAndClear();
1937 sal_uInt32 nPropsPerLine
= 1 + nMethodCount
/ 30;
1938 for( sal_uInt32 i
= 0; i
< nMethodCount
; i
++ )
1940 SbxVariable
* pVar
= pMethods
->Get(i
);
1943 if( (i
% nPropsPerLine
) == 0 )
1944 aRet
.append( "\n" );
1946 // address the method
1947 const Reference
< XIdlMethod
>& rxMethod
= pUnoMethods
[i
];
1949 // Is it in Uno a sequence?
1950 SbxDataType eType
= pVar
->GetFullType();
1951 if( eType
== SbxOBJECT
)
1953 Reference
< XIdlClass
> xClass
= rxMethod
->getReturnType();
1954 if( xClass
.is() && xClass
->getTypeClass() == TypeClass_SEQUENCE
)
1955 eType
= SbxDataType( SbxOBJECT
| SbxARRAY
);
1957 // output the name and the type
1958 aRet
.append( Dbg_SbxDataType2String( eType
) );
1960 aRet
.append ( pVar
->GetName() );
1961 aRet
.append( " ( " );
1963 // the get-method mustn't have a parameter
1964 Sequence
< Reference
< XIdlClass
> > aParamsSeq
= rxMethod
->getParameterTypes();
1965 sal_uInt32 nParamCount
= aParamsSeq
.getLength();
1966 const Reference
< XIdlClass
>* pParams
= aParamsSeq
.getConstArray();
1968 if( nParamCount
> 0 )
1970 for( sal_uInt32 j
= 0; j
< nParamCount
; j
++ )
1972 aRet
.append ( Dbg_SbxDataType2String( unoToSbxType( pParams
[ j
] ) ) );
1973 if( j
< nParamCount
- 1 )
1974 aRet
.append( ", " );
1978 aRet
.append( "void" );
1980 aRet
.append( " ) " );
1982 if( i
== nMethodCount
- 1 )
1983 aRet
.append( "\n" );
1985 aRet
.append( "; " );
1988 return aRet
.makeStringAndClear();
1992 // Implementation SbUnoObject
1993 void SbUnoObject::Notify( SfxBroadcaster
& rBC
, const SfxHint
& rHint
)
1995 if( bNeedIntrospection
)
1998 const SbxHint
* pHint
= dynamic_cast<const SbxHint
*>(&rHint
);
2002 SbxVariable
* pVar
= pHint
->GetVar();
2003 SbxArray
* pParams
= pVar
->GetParameters();
2004 SbUnoProperty
* pProp
= dynamic_cast<SbUnoProperty
*>( pVar
);
2005 SbUnoMethod
* pMeth
= dynamic_cast<SbUnoMethod
*>( pVar
);
2008 bool bInvocation
= pProp
->isInvocationBased();
2009 if( pHint
->GetId() == SfxHintId::BasicDataWanted
)
2012 sal_Int32 nId
= pProp
->nId
;
2015 // Id == -1: Display implemented interfaces according the ClassProvider
2016 if( nId
== -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
2018 OUString aRetStr
= Impl_GetSupportedInterfaces(*this);
2019 pVar
->PutString( aRetStr
);
2021 // Id == -2: output properties
2022 else if( nId
== -2 ) // Property ID_DBG_PROPERTIES
2024 // now all properties must be created
2026 OUString aRetStr
= Impl_DumpProperties(*this);
2027 pVar
->PutString( aRetStr
);
2029 // Id == -3: output the methods
2030 else if( nId
== -3 ) // Property ID_DBG_METHODS
2032 // now all properties must be created
2034 OUString aRetStr
= Impl_DumpMethods(*this);
2035 pVar
->PutString( aRetStr
);
2040 if( !bInvocation
&& mxUnoAccess
.is() )
2046 StructRefInfo aMember
= maStructInfo
->getStructMember( pProp
->GetName() );
2047 if ( aMember
.isEmpty() )
2049 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND
);
2053 if ( pProp
->isUnoStruct() )
2055 SbUnoStructRefObject
* pSbUnoObject
= new SbUnoStructRefObject( pProp
->GetName(), aMember
);
2056 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(pSbUnoObject
);
2057 pVar
->PutObject( xWrapper
.get() );
2061 Any aRetAny
= aMember
.getValue();
2062 // take over the value from Uno to Sbx
2063 unoToSbxValue( pVar
, aRetAny
);
2069 Reference
< XPropertySet
> xPropSet( mxUnoAccess
->queryAdapter( cppu::UnoType
<XPropertySet
>::get()), UNO_QUERY
);
2070 Any aRetAny
= xPropSet
->getPropertyValue( pProp
->GetName() );
2071 // The use of getPropertyValue (instead of using the index) is
2072 // suboptimal, but the refactoring to XInvocation is already pending
2073 // Otherwise it is possible to use FastPropertySet
2075 // take over the value from Uno to Sbx
2076 unoToSbxValue( pVar
, aRetAny
);
2078 catch( const Exception
& )
2080 implHandleAnyException( ::cppu::getCaughtException() );
2083 else if( bInvocation
&& mxInvocation
.is() )
2087 sal_uInt32 nParamCount
= pParams
? (pParams
->Count() - 1) : 0;
2088 bool bCanBeConsideredAMethod
= mxInvocation
->hasMethod( pProp
->GetName() );
2090 if ( bCanBeConsideredAMethod
&& nParamCount
)
2092 // Automation properties have methods, so... we need to invoke this through
2095 processAutomationParams( pParams
, args
, nParamCount
);
2096 aRetAny
= invokeAutomationMethod( pProp
->GetName(), args
, pParams
, nParamCount
, mxInvocation
, INVOKETYPE::GetProp
);
2099 aRetAny
= mxInvocation
->getValue( pProp
->GetName() );
2100 // take over the value from Uno to Sbx
2101 unoToSbxValue( pVar
, aRetAny
);
2102 if( pParams
&& bCanBeConsideredAMethod
)
2103 pVar
->SetParameters( nullptr );
2106 catch( const Exception
& )
2108 implHandleAnyException( ::cppu::getCaughtException() );
2112 else if( pHint
->GetId() == SfxHintId::BasicDataChanged
)
2114 if( !bInvocation
&& mxUnoAccess
.is() )
2116 if( pProp
->aUnoProp
.Attributes
& PropertyAttribute::READONLY
)
2118 StarBASIC::Error( ERRCODE_BASIC_PROP_READONLY
);
2123 StructRefInfo aMember
= maStructInfo
->getStructMember( pProp
->GetName() );
2124 if ( aMember
.isEmpty() )
2126 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND
);
2130 Any aAnyValue
= sbxToUnoValue( pVar
, pProp
->aUnoProp
.Type
, &pProp
->aUnoProp
);
2131 aMember
.setValue( aAnyValue
);
2135 // take over the value from Uno to Sbx
2136 Any aAnyValue
= sbxToUnoValue( pVar
, pProp
->aUnoProp
.Type
, &pProp
->aUnoProp
);
2140 Reference
< XPropertySet
> xPropSet( mxUnoAccess
->queryAdapter( cppu::UnoType
<XPropertySet
>::get()), UNO_QUERY
);
2141 xPropSet
->setPropertyValue( pProp
->GetName(), aAnyValue
);
2142 // The use of getPropertyValue (instead of using the index) is
2143 // suboptimal, but the refactoring to XInvocation is already pending
2144 // Otherwise it is possible to use FastPropertySet
2146 catch( const Exception
& )
2148 implHandleAnyException( ::cppu::getCaughtException() );
2151 else if( bInvocation
&& mxInvocation
.is() )
2153 // take over the value from Uno to Sbx
2154 Any aAnyValue
= sbxToUnoValueImpl( pVar
);
2158 mxInvocation
->setValue( pProp
->GetName(), aAnyValue
);
2160 catch( const Exception
& )
2162 implHandleAnyException( ::cppu::getCaughtException() );
2169 bool bInvocation
= pMeth
->isInvocationBased();
2170 if( pHint
->GetId() == SfxHintId::BasicDataWanted
)
2172 // number of Parameter -1 because of Param0 == this
2173 sal_uInt32 nParamCount
= pParams
? (pParams
->Count() - 1) : 0;
2175 bool bOutParams
= false;
2177 if( !bInvocation
&& mxUnoAccess
.is() )
2180 const Sequence
<ParamInfo
>& rInfoSeq
= pMeth
->getParamInfos();
2181 const ParamInfo
* pParamInfos
= rInfoSeq
.getConstArray();
2182 sal_uInt32 nUnoParamCount
= rInfoSeq
.getLength();
2183 sal_uInt32 nAllocParamCount
= nParamCount
;
2185 // ignore surplus parameter; alternative: throw an error
2186 if( nParamCount
> nUnoParamCount
)
2188 nParamCount
= nUnoParamCount
;
2189 nAllocParamCount
= nParamCount
;
2191 else if( nParamCount
< nUnoParamCount
)
2193 SbiInstance
* pInst
= GetSbData()->pInst
;
2194 if( pInst
&& pInst
->IsCompatibility() )
2197 bool bError
= false;
2198 for( sal_uInt32 i
= nParamCount
; i
< nUnoParamCount
; i
++ )
2200 const ParamInfo
& rInfo
= pParamInfos
[i
];
2201 const Reference
< XIdlClass
>& rxClass
= rInfo
.aType
;
2202 if( rxClass
->getTypeClass() != TypeClass_ANY
)
2205 StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL
);
2209 nAllocParamCount
= nUnoParamCount
;
2213 if( nAllocParamCount
> 0 )
2215 args
.realloc( nAllocParamCount
);
2216 Any
* pAnyArgs
= args
.getArray();
2217 for( sal_uInt32 i
= 0 ; i
< nParamCount
; i
++ )
2219 const ParamInfo
& rInfo
= pParamInfos
[i
];
2220 const Reference
< XIdlClass
>& rxClass
= rInfo
.aType
;
2222 css::uno::Type
aType( rxClass
->getTypeClass(), rxClass
->getName() );
2224 // ATTENTION: Don't forget for Sbx-Parameter the offset!
2225 pAnyArgs
[i
] = sbxToUnoValue(pParams
->Get(i
+ 1), aType
);
2227 // If it is not certain check whether the out-parameter are available.
2230 ParamMode aParamMode
= rInfo
.aMode
;
2231 if( aParamMode
!= ParamMode_IN
)
2237 else if( bInvocation
&& pParams
&& mxInvocation
.is() )
2239 processAutomationParams( pParams
, args
, nParamCount
);
2243 GetSbData()->bBlockCompilerError
= true; // #106433 Block compiler errors for API calls
2246 if( !bInvocation
&& mxUnoAccess
.is() )
2248 Any aRetAny
= pMeth
->m_xUnoMethod
->invoke( getUnoAny(), args
);
2250 // take over the value from Uno to Sbx
2251 unoToSbxValue( pVar
, aRetAny
);
2253 // Did we to copy back the Out-Parameter?
2256 const Any
* pAnyArgs
= args
.getConstArray();
2259 const Sequence
<ParamInfo
>& rInfoSeq
= pMeth
->getParamInfos();
2260 const ParamInfo
* pParamInfos
= rInfoSeq
.getConstArray();
2263 for( j
= 0 ; j
< nParamCount
; j
++ )
2265 const ParamInfo
& rInfo
= pParamInfos
[j
];
2266 ParamMode aParamMode
= rInfo
.aMode
;
2267 if( aParamMode
!= ParamMode_IN
)
2268 unoToSbxValue(pParams
->Get(j
+ 1), pAnyArgs
[j
]);
2272 else if( bInvocation
&& mxInvocation
.is() )
2274 Any aRetAny
= invokeAutomationMethod( pMeth
->GetName(), args
, pParams
, nParamCount
, mxInvocation
, INVOKETYPE::Func
);
2275 unoToSbxValue( pVar
, aRetAny
);
2278 // remove parameter here, because this was not done anymore in unoToSbxValue()
2281 pVar
->SetParameters( nullptr );
2283 catch( const Exception
& )
2285 implHandleAnyException( ::cppu::getCaughtException() );
2287 GetSbData()->bBlockCompilerError
= false; // #106433 Unblock compiler errors
2291 SbxObject::Notify( rBC
, rHint
);
2295 SbUnoObject::SbUnoObject( const OUString
& aName_
, const Any
& aUnoObj_
)
2296 : SbxObject( aName_
)
2297 , bNeedIntrospection( true )
2298 , bNativeCOMObject( false )
2300 // beat out again the default properties of Sbx
2301 Remove( "Name", SbxClassType::DontCare
);
2302 Remove( "Parent", SbxClassType::DontCare
);
2304 // check the type of the objects
2305 TypeClass eType
= aUnoObj_
.getValueType().getTypeClass();
2306 Reference
< XInterface
> x
;
2307 if( eType
== TypeClass_INTERFACE
)
2309 // get the interface from the Any
2315 Reference
< XTypeProvider
> xTypeProvider
;
2316 // Did the object have an invocation itself?
2317 mxInvocation
.set( x
, UNO_QUERY
);
2319 xTypeProvider
.set( x
, UNO_QUERY
);
2321 if( mxInvocation
.is() )
2324 // get the ExactName
2325 mxExactNameInvocation
.set( mxInvocation
, UNO_QUERY
);
2327 // The remainder refers only to the introspection
2328 if( !xTypeProvider
.is() )
2330 bNeedIntrospection
= false;
2334 // Ignore introspection based members for COM objects to avoid
2335 // hiding of equally named COM symbols, e.g. XInvocation::getValue
2336 Reference
< oleautomation::XAutomationObject
> xAutomationObject( aUnoObj_
, UNO_QUERY
);
2337 if( xAutomationObject
.is() )
2338 bNativeCOMObject
= true;
2341 maTmpUnoObj
= aUnoObj_
;
2344 //*** Define the name ***
2345 bool bFatalError
= true;
2347 // Is it an interface or a struct?
2348 bool bSetClassName
= false;
2349 OUString aClassName_
;
2350 if( eType
== TypeClass_STRUCT
|| eType
== TypeClass_EXCEPTION
)
2353 bFatalError
= false;
2355 // insert the real name of the class
2356 if( aName_
.isEmpty() )
2358 aClassName_
= aUnoObj_
.getValueType().getTypeName();
2359 bSetClassName
= true;
2361 StructRefInfo
aThisStruct( maTmpUnoObj
, maTmpUnoObj
.getValueType(), 0 );
2362 maStructInfo
= std::make_shared
<SbUnoStructRefObject
>( GetName(), aThisStruct
);
2364 else if( eType
== TypeClass_INTERFACE
)
2366 // Interface works always through the type in the Any
2367 bFatalError
= false;
2370 SetClassName( aClassName_
);
2372 // Neither interface nor Struct -> FatalError
2375 StarBASIC::FatalError( ERRCODE_BASIC_EXCEPTION
);
2379 // pass the introspection primal on demand
2382 SbUnoObject::~SbUnoObject()
2387 // pass the introspection on Demand
2388 void SbUnoObject::doIntrospection()
2390 if( !bNeedIntrospection
)
2393 Reference
<XComponentContext
> xContext
= comphelper::getProcessComponentContext();
2399 // get the introspection service
2400 Reference
<XIntrospection
> xIntrospection
;
2404 xIntrospection
= theIntrospection::get(xContext
);
2406 catch ( const css::uno::DeploymentException
& )
2410 if (!xIntrospection
.is())
2413 bNeedIntrospection
= false;
2415 // pass the introspection
2418 mxUnoAccess
= xIntrospection
->inspect( maTmpUnoObj
);
2420 catch( const RuntimeException
& e
)
2422 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
, implGetExceptionMsg( e
) );
2425 if( !mxUnoAccess
.is() )
2427 // #51475 mark to indicate an invalid object (no mxMaterialHolder)
2431 // get MaterialHolder from access
2432 mxMaterialHolder
.set( mxUnoAccess
, UNO_QUERY
);
2434 // get ExactName from access
2435 mxExactName
.set( mxUnoAccess
, UNO_QUERY
);
2439 // Start of a list of all SbUnoMethod-Instances
2440 static SbUnoMethod
* pFirst
= nullptr;
2442 void clearUnoMethodsForBasic( StarBASIC
const * pBasic
)
2444 SbUnoMethod
* pMeth
= pFirst
;
2447 SbxObject
* pObject
= pMeth
->GetParent();
2450 StarBASIC
* pModBasic
= dynamic_cast< StarBASIC
* >( pObject
->GetParent() );
2451 if ( pModBasic
== pBasic
)
2453 // for now the solution is to remove the method from the list and to clear it,
2454 // but in case the element should be correctly transferred to another StarBASIC,
2455 // we should either set module parent to NULL without clearing it, or even
2456 // set the new StarBASIC as the parent of the module
2457 // pObject->SetParent( NULL );
2459 if( pMeth
== pFirst
)
2460 pFirst
= pMeth
->pNext
;
2461 else if( pMeth
->pPrev
)
2462 pMeth
->pPrev
->pNext
= pMeth
->pNext
;
2464 pMeth
->pNext
->pPrev
= pMeth
->pPrev
;
2466 pMeth
->pPrev
= nullptr;
2467 pMeth
->pNext
= nullptr;
2469 pMeth
->SbxValue::Clear();
2470 pObject
->SbxValue::Clear();
2472 // start from the beginning after object clearing, the cycle will end since the method is removed each time
2476 pMeth
= pMeth
->pNext
;
2479 pMeth
= pMeth
->pNext
;
2483 void clearUnoMethods()
2485 SbUnoMethod
* pMeth
= pFirst
;
2488 pMeth
->SbxValue::Clear();
2489 pMeth
= pMeth
->pNext
;
2494 SbUnoMethod::SbUnoMethod
2496 const OUString
& aName_
,
2497 SbxDataType eSbxType
,
2498 Reference
< XIdlMethod
> const & xUnoMethod_
,
2501 : SbxMethod( aName_
, eSbxType
)
2502 , mbInvocation( bInvocation
)
2504 m_xUnoMethod
= xUnoMethod_
;
2505 pParamInfoSeq
= nullptr;
2507 // enregister the method in a list
2512 pNext
->pPrev
= this;
2515 SbUnoMethod::~SbUnoMethod()
2517 pParamInfoSeq
.reset();
2519 if( this == pFirst
)
2522 pPrev
->pNext
= pNext
;
2524 pNext
->pPrev
= pPrev
;
2527 SbxInfo
* SbUnoMethod::GetInfo()
2529 if( !pInfo
.is() && m_xUnoMethod
.is() )
2531 SbiInstance
* pInst
= GetSbData()->pInst
;
2532 if( pInst
&& pInst
->IsCompatibility() )
2534 pInfo
= new SbxInfo();
2536 const Sequence
<ParamInfo
>& rInfoSeq
= getParamInfos();
2537 const ParamInfo
* pParamInfos
= rInfoSeq
.getConstArray();
2538 sal_uInt32 nParamCount
= rInfoSeq
.getLength();
2540 for( sal_uInt32 i
= 0 ; i
< nParamCount
; i
++ )
2542 const ParamInfo
& rInfo
= pParamInfos
[i
];
2543 OUString aParamName
= rInfo
.aName
;
2545 pInfo
->AddParam( aParamName
, SbxVARIANT
, SbxFlagBits::Read
);
2552 const Sequence
<ParamInfo
>& SbUnoMethod::getParamInfos()
2556 Sequence
<ParamInfo
> aTmp
;
2557 if (m_xUnoMethod
.is())
2558 aTmp
= m_xUnoMethod
->getParameterInfos();
2559 pParamInfoSeq
.reset( new Sequence
<ParamInfo
>(aTmp
) );
2561 return *pParamInfoSeq
;
2564 SbUnoProperty::SbUnoProperty
2566 const OUString
& aName_
,
2567 SbxDataType eSbxType
,
2568 SbxDataType eRealSbxType
,
2569 const Property
& aUnoProp_
,
2574 : SbxProperty( aName_
, eSbxType
)
2575 , aUnoProp( aUnoProp_
)
2577 , mbInvocation( bInvocation
)
2578 , mRealType( eRealSbxType
)
2579 , mbUnoStruct( bUnoStruct
)
2581 // as needed establish a dummy array so that SbiRuntime::CheckArray() works
2582 static SbxArrayRef xDummyArray
= new SbxArray( SbxVARIANT
);
2583 if( eSbxType
& SbxARRAY
)
2584 PutObject( xDummyArray
.get() );
2587 SbUnoProperty::~SbUnoProperty()
2591 SbxVariable
* SbUnoObject::Find( const OUString
& rName
, SbxClassType t
)
2593 static Reference
< XIdlMethod
> xDummyMethod
;
2594 static Property aDummyProp
;
2596 SbxVariable
* pRes
= SbxObject::Find( rName
, t
);
2598 if( bNeedIntrospection
)
2601 // New 1999-03-04: Create properties on demand. Therefore search now via
2602 // IntrospectionAccess if a property or a method of the required name exist
2605 OUString
aUName( rName
);
2606 if( mxUnoAccess
.is() && !bNativeCOMObject
)
2608 if( mxExactName
.is() )
2610 OUString aUExactName
= mxExactName
->getExactName( aUName
);
2611 if( !aUExactName
.isEmpty() )
2613 aUName
= aUExactName
;
2616 if( mxUnoAccess
->hasProperty( aUName
, PropertyConcept::ALL
- PropertyConcept::DANGEROUS
) )
2618 const Property
& rProp
= mxUnoAccess
->
2619 getProperty( aUName
, PropertyConcept::ALL
- PropertyConcept::DANGEROUS
);
2621 // If the property could be void the type had to be set to Variant
2622 SbxDataType eSbxType
;
2623 if( rProp
.Attributes
& PropertyAttribute::MAYBEVOID
)
2624 eSbxType
= SbxVARIANT
;
2626 eSbxType
= unoToSbxType( rProp
.Type
.getTypeClass() );
2628 SbxDataType eRealSbxType
= ( ( rProp
.Attributes
& PropertyAttribute::MAYBEVOID
) ? unoToSbxType( rProp
.Type
.getTypeClass() ) : eSbxType
);
2629 // create the property and superimpose it
2630 auto pProp
= tools::make_ref
<SbUnoProperty
>( rProp
.Name
, eSbxType
, eRealSbxType
, rProp
, 0, false, ( rProp
.Type
.getTypeClass() == css::uno::TypeClass_STRUCT
) );
2631 QuickInsert( pProp
.get() );
2634 else if( mxUnoAccess
->hasMethod( aUName
,
2635 MethodConcept::ALL
- MethodConcept::DANGEROUS
) )
2637 // address the method
2638 const Reference
< XIdlMethod
>& rxMethod
= mxUnoAccess
->
2639 getMethod( aUName
, MethodConcept::ALL
- MethodConcept::DANGEROUS
);
2641 // create SbUnoMethod and superimpose it
2642 auto xMethRef
= tools::make_ref
<SbUnoMethod
>( rxMethod
->getName(),
2643 unoToSbxType( rxMethod
->getReturnType() ), rxMethod
, false );
2644 QuickInsert( xMethRef
.get() );
2645 pRes
= xMethRef
.get();
2648 // If nothing was found check via XNameAccess
2653 Reference
< XNameAccess
> xNameAccess( mxUnoAccess
->queryAdapter( cppu::UnoType
<XPropertySet
>::get()), UNO_QUERY
);
2655 if( xNameAccess
.is() && xNameAccess
->hasByName( rName
) )
2657 Any aAny
= xNameAccess
->getByName( rName
);
2659 // ATTENTION: Because of XNameAccess, the variable generated here
2660 // may not be included as a fixed property in the object and therefore
2661 // won't be stored anywhere.
2662 // If this leads to problems, it has to be created
2663 // synthetically or a class SbUnoNameAccessProperty,
2664 // which checks the existence on access and which
2665 // is disposed if the name is not found anymore.
2666 pRes
= new SbxVariable( SbxVARIANT
);
2667 unoToSbxValue( pRes
, aAny
);
2670 catch( const NoSuchElementException
& e
)
2672 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
, implGetExceptionMsg( e
) );
2674 catch( const Exception
& )
2676 // Establish so that the exception error will not be overwritten
2678 pRes
= new SbxVariable( SbxVARIANT
);
2680 implHandleAnyException( ::cppu::getCaughtException() );
2684 if( !pRes
&& mxInvocation
.is() )
2686 if( mxExactNameInvocation
.is() )
2688 OUString aUExactName
= mxExactNameInvocation
->getExactName( aUName
);
2689 if( !aUExactName
.isEmpty() )
2691 aUName
= aUExactName
;
2697 if( mxInvocation
->hasProperty( aUName
) )
2699 // create a property and superimpose it
2700 auto xVarRef
= tools::make_ref
<SbUnoProperty
>( aUName
, SbxVARIANT
, SbxVARIANT
, aDummyProp
, 0, true, false );
2701 QuickInsert( xVarRef
.get() );
2702 pRes
= xVarRef
.get();
2704 else if( mxInvocation
->hasMethod( aUName
) )
2706 // create SbUnoMethode and superimpose it
2707 auto xMethRef
= tools::make_ref
<SbUnoMethod
>( aUName
, SbxVARIANT
, xDummyMethod
, true );
2708 QuickInsert( xMethRef
.get() );
2709 pRes
= xMethRef
.get();
2713 Reference
< XDirectInvocation
> xDirectInvoke( mxInvocation
, UNO_QUERY
);
2714 if ( xDirectInvoke
.is() && xDirectInvoke
->hasMember( aUName
) )
2716 auto xMethRef
= tools::make_ref
<SbUnoMethod
>( aUName
, SbxVARIANT
, xDummyMethod
, true );
2717 QuickInsert( xMethRef
.get() );
2718 pRes
= xMethRef
.get();
2723 catch( const RuntimeException
& e
)
2725 // Establish so that the exception error will not be overwritten
2727 pRes
= new SbxVariable( SbxVARIANT
);
2729 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
, implGetExceptionMsg( e
) );
2734 // At the very end checking if the Dbg_-Properties are meant
2738 if( rName
.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES
) ||
2739 rName
.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES
) ||
2740 rName
.equalsIgnoreAsciiCase(ID_DBG_METHODS
) )
2743 implCreateDbgProperties();
2745 // Now they have to be found regular
2746 pRes
= SbxObject::Find( rName
, SbxClassType::DontCare
);
2753 // help method to create the dbg_-Properties
2754 void SbUnoObject::implCreateDbgProperties()
2758 // Id == -1: display the implemented interfaces corresponding the ClassProvider
2759 auto xVarRef
= tools::make_ref
<SbUnoProperty
>( OUString(ID_DBG_SUPPORTEDINTERFACES
), SbxSTRING
, SbxSTRING
, aProp
, -1, false, false );
2760 QuickInsert( xVarRef
.get() );
2762 // Id == -2: output the properties
2763 xVarRef
= tools::make_ref
<SbUnoProperty
>( OUString(ID_DBG_PROPERTIES
), SbxSTRING
, SbxSTRING
, aProp
, -2, false, false );
2764 QuickInsert( xVarRef
.get() );
2766 // Id == -3: output the Methods
2767 xVarRef
= tools::make_ref
<SbUnoProperty
>( OUString(ID_DBG_METHODS
), SbxSTRING
, SbxSTRING
, aProp
, -3, false, false );
2768 QuickInsert( xVarRef
.get() );
2771 void SbUnoObject::implCreateAll()
2773 // throw away all existing methods and properties
2774 pMethods
= tools::make_ref
<SbxArray
>();
2775 pProps
= tools::make_ref
<SbxArray
>();
2777 if( bNeedIntrospection
) doIntrospection();
2779 // get introspection
2780 Reference
< XIntrospectionAccess
> xAccess
= mxUnoAccess
;
2781 if( !xAccess
.is() || bNativeCOMObject
)
2783 if( mxInvocation
.is() )
2784 xAccess
= mxInvocation
->getIntrospection();
2785 else if( bNativeCOMObject
)
2791 // Establish properties
2792 Sequence
<Property
> props
= xAccess
->getProperties( PropertyConcept::ALL
- PropertyConcept::DANGEROUS
);
2793 sal_uInt32 nPropCount
= props
.getLength();
2794 const Property
* pProps_
= props
.getConstArray();
2797 for( i
= 0 ; i
< nPropCount
; i
++ )
2799 const Property
& rProp
= pProps_
[ i
];
2801 // If the property could be void the type had to be set to Variant
2802 SbxDataType eSbxType
;
2803 if( rProp
.Attributes
& PropertyAttribute::MAYBEVOID
)
2804 eSbxType
= SbxVARIANT
;
2806 eSbxType
= unoToSbxType( rProp
.Type
.getTypeClass() );
2808 SbxDataType eRealSbxType
= ( ( rProp
.Attributes
& PropertyAttribute::MAYBEVOID
) ? unoToSbxType( rProp
.Type
.getTypeClass() ) : eSbxType
);
2809 // Create property and superimpose it
2810 auto xVarRef
= tools::make_ref
<SbUnoProperty
>( rProp
.Name
, eSbxType
, eRealSbxType
, rProp
, i
, false, ( rProp
.Type
.getTypeClass() == css::uno::TypeClass_STRUCT
) );
2811 QuickInsert( xVarRef
.get() );
2814 // Create Dbg_-Properties
2815 implCreateDbgProperties();
2818 Sequence
< Reference
< XIdlMethod
> > aMethodSeq
= xAccess
->getMethods
2819 ( MethodConcept::ALL
- MethodConcept::DANGEROUS
);
2820 sal_uInt32 nMethCount
= aMethodSeq
.getLength();
2821 const Reference
< XIdlMethod
>* pMethods_
= aMethodSeq
.getConstArray();
2822 for( i
= 0 ; i
< nMethCount
; i
++ )
2825 const Reference
< XIdlMethod
>& rxMethod
= pMethods_
[i
];
2827 // Create SbUnoMethod and superimpose it
2828 auto xMethRef
= tools::make_ref
<SbUnoMethod
>
2829 ( rxMethod
->getName(), unoToSbxType( rxMethod
->getReturnType() ), rxMethod
, false );
2830 QuickInsert( xMethRef
.get() );
2836 Any
SbUnoObject::getUnoAny()
2839 if( bNeedIntrospection
) doIntrospection();
2841 aRetAny
= maTmpUnoObj
;
2842 else if( mxMaterialHolder
.is() )
2843 aRetAny
= mxMaterialHolder
->getMaterial();
2844 else if( mxInvocation
.is() )
2845 aRetAny
<<= mxInvocation
;
2849 // help method to create a Uno-Struct per CoreReflection
2850 static SbUnoObjectRef
Impl_CreateUnoStruct( const OUString
& aClassName
)
2852 // get CoreReflection
2853 Reference
< XIdlReflection
> xCoreReflection
= getCoreReflection_Impl();
2854 if( !xCoreReflection
.is() )
2857 // search for the class
2858 Reference
< XIdlClass
> xClass
;
2859 const Reference
< XHierarchicalNameAccess
>& xHarryName
=
2860 getCoreReflection_HierarchicalNameAccess_Impl();
2861 if( xHarryName
.is() && xHarryName
->hasByHierarchicalName( aClassName
) )
2862 xClass
= xCoreReflection
->forName( aClassName
);
2866 // Is it really a struct?
2867 TypeClass eType
= xClass
->getTypeClass();
2868 if ( ( eType
!= TypeClass_STRUCT
) && ( eType
!= TypeClass_EXCEPTION
) )
2871 // create an instance
2873 xClass
->createObject( aNewAny
);
2874 // make a SbUnoObject out of it
2875 SbUnoObjectRef pUnoObj
= new SbUnoObject( aClassName
, aNewAny
);
2880 // Factory-Class to create Uno-Structs per DIM AS NEW
2881 SbxBaseRef
SbUnoFactory::Create( sal_uInt16
, sal_uInt32
)
2883 // Via SbxId nothing works in Uno
2887 SbxObjectRef
SbUnoFactory::CreateObject( const OUString
& rClassName
)
2889 return Impl_CreateUnoStruct( rClassName
).get();
2893 // Provisional interface for the UNO-Connection
2894 // Deliver a SbxObject, that wrap a Uno-Interface
2895 SbxObjectRef
GetSbUnoObject( const OUString
& aName
, const Any
& aUnoObj_
)
2897 return new SbUnoObject( aName
, aUnoObj_
);
2900 // Force creation of all properties for debugging
2901 void createAllObjectProperties( SbxObject
* pObj
)
2906 SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
);
2907 SbUnoStructRefObject
* pUnoStructObj
= dynamic_cast<SbUnoStructRefObject
*>( pObj
);
2910 pUnoObj
->createAllProperties();
2912 else if ( pUnoStructObj
)
2914 pUnoStructObj
->createAllProperties();
2919 void RTL_Impl_CreateUnoStruct( SbxArray
& rPar
)
2921 // We need 1 parameter minimum
2922 if (rPar
.Count() < 2)
2924 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2928 // get the name of the class of the struct
2929 OUString aClassName
= rPar
.Get(1)->GetOUString();
2931 // try to create Struct with the same name
2932 SbUnoObjectRef xUnoObj
= Impl_CreateUnoStruct( aClassName
);
2937 // return the object
2938 SbxVariableRef refVar
= rPar
.Get(0);
2939 refVar
->PutObject( xUnoObj
.get() );
2942 void RTL_Impl_CreateUnoService( SbxArray
& rPar
)
2944 // We need 1 Parameter minimum
2945 if (rPar
.Count() < 2)
2947 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2951 // get the name of the class of the struct
2952 OUString aServiceName
= rPar
.Get(1)->GetOUString();
2954 // search for the service and instantiate it
2955 Reference
< XMultiServiceFactory
> xFactory( comphelper::getProcessServiceFactory() );
2956 Reference
< XInterface
> xInterface
;
2959 xInterface
= xFactory
->createInstance( aServiceName
);
2961 catch( const Exception
& )
2963 implHandleAnyException( ::cppu::getCaughtException() );
2966 SbxVariableRef refVar
= rPar
.Get(0);
2967 if( xInterface
.is() )
2969 // Create a SbUnoObject out of it and return it
2970 SbUnoObjectRef xUnoObj
= new SbUnoObject( aServiceName
, Any(xInterface
) );
2971 if( xUnoObj
->getUnoAny().hasValue() )
2973 // return the object
2974 refVar
->PutObject( xUnoObj
.get() );
2978 refVar
->PutObject( nullptr );
2983 refVar
->PutObject( nullptr );
2987 void RTL_Impl_CreateUnoServiceWithArguments( SbxArray
& rPar
)
2989 // We need 2 parameter minimum
2990 if (rPar
.Count() < 3)
2992 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2996 // get the name of the class of the struct
2997 OUString aServiceName
= rPar
.Get(1)->GetOUString();
2998 Any aArgAsAny
= sbxToUnoValue(rPar
.Get(2),
2999 cppu::UnoType
<Sequence
<Any
>>::get() );
3000 Sequence
< Any
> aArgs
;
3001 aArgAsAny
>>= aArgs
;
3003 // search for the service and instantiate it
3004 Reference
< XMultiServiceFactory
> xFactory( comphelper::getProcessServiceFactory() );
3005 Reference
< XInterface
> xInterface
;
3008 xInterface
= xFactory
->createInstanceWithArguments( aServiceName
, aArgs
);
3010 catch( const Exception
& )
3012 implHandleAnyException( ::cppu::getCaughtException() );
3015 SbxVariableRef refVar
= rPar
.Get(0);
3016 if( xInterface
.is() )
3018 // Create a SbUnoObject out of it and return it
3019 SbUnoObjectRef xUnoObj
= new SbUnoObject( aServiceName
, Any(xInterface
) );
3020 if( xUnoObj
->getUnoAny().hasValue() )
3022 // return the object
3023 refVar
->PutObject( xUnoObj
.get() );
3027 refVar
->PutObject( nullptr );
3032 refVar
->PutObject( nullptr );
3036 void RTL_Impl_GetProcessServiceManager( SbxArray
& rPar
)
3038 SbxVariableRef refVar
= rPar
.Get(0);
3040 // get the global service manager
3041 Reference
< XMultiServiceFactory
> xFactory( comphelper::getProcessServiceFactory() );
3043 // Create a SbUnoObject out of it and return it
3044 SbUnoObjectRef xUnoObj
= new SbUnoObject( "ProcessServiceManager", Any(xFactory
) );
3045 refVar
->PutObject( xUnoObj
.get() );
3048 void RTL_Impl_HasInterfaces( SbxArray
& rPar
)
3050 // We need 2 parameter minimum
3051 sal_uInt32 nParCount
= rPar
.Count();
3054 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3058 // variable for the return value
3059 SbxVariableRef refVar
= rPar
.Get(0);
3060 refVar
->PutBool( false );
3062 // get the Uno-Object
3063 SbxBaseRef pObj
= rPar
.Get(1)->GetObject();
3064 auto obj
= dynamic_cast<SbUnoObject
*>( pObj
.get() );
3065 if( obj
== nullptr )
3069 Any aAny
= obj
->getUnoAny();
3070 auto x
= o3tl::tryAccess
<Reference
<XInterface
>>(aAny
);
3076 // get CoreReflection
3077 Reference
< XIdlReflection
> xCoreReflection
= getCoreReflection_Impl();
3078 if( !xCoreReflection
.is() )
3082 for( sal_uInt32 i
= 2 ; i
< nParCount
; i
++ )
3084 // get the name of the interface of the struct
3085 OUString aIfaceName
= rPar
.Get(i
)->GetOUString();
3087 // search for the class
3088 Reference
< XIdlClass
> xClass
= xCoreReflection
->forName( aIfaceName
);
3093 // check if the interface will be supported
3094 OUString aClassName
= xClass
->getName();
3095 Type
aClassType( xClass
->getTypeClass(), aClassName
);
3096 if( !(*x
)->queryInterface( aClassType
).hasValue() )
3102 // Everything works; then return TRUE
3103 refVar
->PutBool( true );
3106 void RTL_Impl_IsUnoStruct( SbxArray
& rPar
)
3108 // We need 1 parameter minimum
3109 if (rPar
.Count() < 2)
3111 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3115 // variable for the return value
3116 SbxVariableRef refVar
= rPar
.Get(0);
3117 refVar
->PutBool( false );
3119 // get the Uno-Object
3120 SbxVariableRef xParam
= rPar
.Get(1);
3121 if( !xParam
->IsObject() )
3125 SbxBaseRef pObj
= xParam
->GetObject();
3126 auto obj
= dynamic_cast<SbUnoObject
*>( pObj
.get() );
3127 if( obj
== nullptr )
3131 Any aAny
= obj
->getUnoAny();
3132 TypeClass eType
= aAny
.getValueType().getTypeClass();
3133 if( eType
== TypeClass_STRUCT
)
3135 refVar
->PutBool( true );
3140 void RTL_Impl_EqualUnoObjects( SbxArray
& rPar
)
3142 if (rPar
.Count() < 3)
3144 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3148 // variable for the return value
3149 SbxVariableRef refVar
= rPar
.Get(0);
3150 refVar
->PutBool( false );
3152 // get the Uno-Objects
3153 SbxVariableRef xParam1
= rPar
.Get(1);
3154 if( !xParam1
->IsObject() )
3158 SbxBaseRef pObj1
= xParam1
->GetObject();
3159 auto obj1
= dynamic_cast<SbUnoObject
*>( pObj1
.get() );
3160 if( obj1
== nullptr )
3164 Any aAny1
= obj1
->getUnoAny();
3165 TypeClass eType1
= aAny1
.getValueType().getTypeClass();
3166 if( eType1
!= TypeClass_INTERFACE
)
3170 Reference
< XInterface
> x1
;
3173 SbxVariableRef xParam2
= rPar
.Get(2);
3174 if( !xParam2
->IsObject() )
3178 SbxBaseRef pObj2
= xParam2
->GetObject();
3179 auto obj2
= dynamic_cast<SbUnoObject
*>( pObj2
.get() );
3180 if( obj2
== nullptr )
3184 Any aAny2
= obj2
->getUnoAny();
3185 TypeClass eType2
= aAny2
.getValueType().getTypeClass();
3186 if( eType2
!= TypeClass_INTERFACE
)
3190 Reference
< XInterface
> x2
;
3195 refVar
->PutBool( true );
3200 // helper wrapper function to interact with TypeProvider and
3201 // XTypeDescriptionEnumerationAccess.
3202 // if it fails for whatever reason
3203 // returned Reference<> be null e.g. .is() will be false
3205 static Reference
< XTypeDescriptionEnumeration
> getTypeDescriptorEnumeration( const OUString
& sSearchRoot
,
3206 const Sequence
< TypeClass
>& types
,
3207 TypeDescriptionSearchDepth depth
)
3209 Reference
< XTypeDescriptionEnumeration
> xEnum
;
3210 Reference
< XTypeDescriptionEnumerationAccess
> xTypeEnumAccess( getTypeProvider_Impl(), UNO_QUERY
);
3211 if ( xTypeEnumAccess
.is() )
3215 xEnum
= xTypeEnumAccess
->createTypeDescriptionEnumeration(
3216 sSearchRoot
, types
, depth
);
3218 catch(const NoSuchTypeNameException
& /*nstne*/ ) {}
3219 catch(const InvalidTypeNameException
& /*nstne*/ ) {}
3225 VBAConstantHelper::instance()
3227 static VBAConstantHelper aHelper
;
3231 void VBAConstantHelper::init()
3236 Reference
< XTypeDescriptionEnumeration
> xEnum
= getTypeDescriptorEnumeration( "ooo.vba", {TypeClass_CONSTANTS
}, TypeDescriptionSearchDepth_INFINITE
);
3242 while ( xEnum
->hasMoreElements() )
3244 Reference
< XConstantsTypeDescription
> xConstants( xEnum
->nextElement(), UNO_QUERY
);
3245 if ( xConstants
.is() )
3247 // store constant group name
3248 OUString sFullName
= xConstants
->getName();
3249 sal_Int32 indexLastDot
= sFullName
.lastIndexOf('.');
3250 OUString
sLeafName( sFullName
);
3251 if ( indexLastDot
> -1 )
3253 sLeafName
= sFullName
.copy( indexLastDot
+ 1);
3255 aConstCache
.push_back( sLeafName
); // assume constant group names are unique
3256 const Sequence
< Reference
< XConstantTypeDescription
> > aConsts
= xConstants
->getConstants();
3257 for (const auto& ctd
: aConsts
)
3259 // store constant member name
3260 sFullName
= ctd
->getName();
3261 indexLastDot
= sFullName
.lastIndexOf('.');
3262 sLeafName
= sFullName
;
3263 if ( indexLastDot
> -1 )
3265 sLeafName
= sFullName
.copy( indexLastDot
+ 1);
3267 aConstHash
[ sLeafName
.toAsciiLowerCase() ] = ctd
->getConstantValue();
3275 VBAConstantHelper::isVBAConstantType( const OUString
& rName
)
3278 bool bConstant
= false;
3280 for (auto const& elem
: aConstCache
)
3282 if( rName
.equalsIgnoreAsciiCase(elem
) )
3292 VBAConstantHelper::getVBAConstant( const OUString
& rName
)
3294 SbxVariable
* pConst
= nullptr;
3297 auto it
= aConstHash
.find( rName
.toAsciiLowerCase() );
3299 if ( it
!= aConstHash
.end() )
3301 pConst
= new SbxVariable( SbxVARIANT
);
3302 pConst
->SetName( rName
);
3303 unoToSbxValue( pConst
, it
->second
);
3309 // Function to search for a global identifier in the
3310 // UnoScope and to wrap it for Sbx
3311 SbUnoClass
* findUnoClass( const OUString
& rName
)
3313 // #105550 Check if module exists
3314 SbUnoClass
* pUnoClass
= nullptr;
3316 const Reference
< XHierarchicalNameAccess
>& xTypeAccess
= getTypeProvider_Impl();
3317 if( xTypeAccess
->hasByHierarchicalName( rName
) )
3319 Any aRet
= xTypeAccess
->getByHierarchicalName( rName
);
3320 Reference
< XTypeDescription
> xTypeDesc
;
3323 if( xTypeDesc
.is() )
3325 TypeClass eTypeClass
= xTypeDesc
->getTypeClass();
3326 if( eTypeClass
== TypeClass_MODULE
|| eTypeClass
== TypeClass_CONSTANTS
)
3328 pUnoClass
= new SbUnoClass( rName
);
3335 SbxVariable
* SbUnoClass::Find( const OUString
& rName
, SbxClassType
)
3337 SbxVariable
* pRes
= SbxObject::Find( rName
, SbxClassType::Variable
);
3339 // If nothing were located the submodule isn't known yet
3342 // If it is already a class, ask for the field
3346 Reference
< XIdlField
> xField
= m_xClass
->getField( rName
);
3351 Any aAny
= xField
->get( {} ); //TODO: does this make sense?
3354 pRes
= new SbxVariable( SbxVARIANT
);
3355 pRes
->SetName( rName
);
3356 unoToSbxValue( pRes
, aAny
);
3358 catch( const Exception
& )
3360 implHandleAnyException( ::cppu::getCaughtException() );
3366 // expand fully qualified name
3367 OUString aNewName
= GetName()
3371 // get CoreReflection
3372 Reference
< XIdlReflection
> xCoreReflection
= getCoreReflection_Impl();
3373 if( xCoreReflection
.is() )
3375 // Is it a constant?
3376 Reference
< XHierarchicalNameAccess
> xHarryName( xCoreReflection
, UNO_QUERY
);
3377 if( xHarryName
.is() )
3381 Any aValue
= xHarryName
->getByHierarchicalName( aNewName
);
3382 TypeClass eType
= aValue
.getValueType().getTypeClass();
3384 // Interface located? Then it is a class
3385 if( eType
== TypeClass_INTERFACE
)
3387 Reference
< XIdlClass
> xClass( aValue
, UNO_QUERY
);
3390 pRes
= new SbxVariable( SbxVARIANT
);
3391 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(new SbUnoClass( aNewName
, xClass
));
3392 pRes
->PutObject( xWrapper
.get() );
3397 pRes
= new SbxVariable( SbxVARIANT
);
3398 unoToSbxValue( pRes
, aValue
);
3401 catch( const NoSuchElementException
& )
3406 // Otherwise take it again as class
3409 SbUnoClass
* pNewClass
= findUnoClass( aNewName
);
3412 pRes
= new SbxVariable( SbxVARIANT
);
3413 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(pNewClass
);
3414 pRes
->PutObject( xWrapper
.get() );
3421 SbUnoService
* pUnoService
= findUnoService( aNewName
);
3424 pRes
= new SbxVariable( SbxVARIANT
);
3425 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(pUnoService
);
3426 pRes
->PutObject( xWrapper
.get() );
3433 SbUnoSingleton
* pUnoSingleton
= findUnoSingleton( aNewName
);
3436 pRes
= new SbxVariable( SbxVARIANT
);
3437 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(pUnoSingleton
);
3438 pRes
->PutObject( xWrapper
.get() );
3446 pRes
->SetName( rName
);
3448 // Insert variable, so that it could be found later
3449 QuickInsert( pRes
);
3451 // Take us out as listener at once,
3452 // the values are all constant
3453 if( pRes
->IsBroadcaster() )
3454 EndListening( pRes
->GetBroadcaster(), true );
3461 SbUnoService
* findUnoService( const OUString
& rName
)
3463 SbUnoService
* pSbUnoService
= nullptr;
3465 const Reference
< XHierarchicalNameAccess
>& xTypeAccess
= getTypeProvider_Impl();
3466 if( xTypeAccess
->hasByHierarchicalName( rName
) )
3468 Any aRet
= xTypeAccess
->getByHierarchicalName( rName
);
3469 Reference
< XTypeDescription
> xTypeDesc
;
3472 if( xTypeDesc
.is() )
3474 TypeClass eTypeClass
= xTypeDesc
->getTypeClass();
3475 if( eTypeClass
== TypeClass_SERVICE
)
3477 Reference
< XServiceTypeDescription2
> xServiceTypeDesc( xTypeDesc
, UNO_QUERY
);
3478 if( xServiceTypeDesc
.is() )
3479 pSbUnoService
= new SbUnoService( rName
, xServiceTypeDesc
);
3483 return pSbUnoService
;
3486 SbxVariable
* SbUnoService::Find( const OUString
& rName
, SbxClassType
)
3488 SbxVariable
* pRes
= SbxObject::Find( rName
, SbxClassType::Method
);
3492 // If it is already a class ask for a field
3493 if( m_bNeedsInit
&& m_xServiceTypeDesc
.is() )
3495 m_bNeedsInit
= false;
3497 Sequence
< Reference
< XServiceConstructorDescription
> > aSCDSeq
= m_xServiceTypeDesc
->getConstructors();
3498 const Reference
< XServiceConstructorDescription
>* pCtorSeq
= aSCDSeq
.getConstArray();
3499 int nCtorCount
= aSCDSeq
.getLength();
3500 for( int i
= 0 ; i
< nCtorCount
; ++i
)
3502 Reference
< XServiceConstructorDescription
> xCtor
= pCtorSeq
[i
];
3504 OUString
aName( xCtor
->getName() );
3505 if( aName
.isEmpty() )
3507 if( xCtor
->isDefaultConstructor() )
3513 if( !aName
.isEmpty() )
3515 // Create and insert SbUnoServiceCtor
3516 SbxVariableRef xSbCtorRef
= new SbUnoServiceCtor( aName
, xCtor
);
3517 QuickInsert( xSbCtorRef
.get() );
3520 pRes
= SbxObject::Find( rName
, SbxClassType::Method
);
3527 void SbUnoService::Notify( SfxBroadcaster
& rBC
, const SfxHint
& rHint
)
3529 const SbxHint
* pHint
= dynamic_cast<const SbxHint
*>(&rHint
);
3533 SbxVariable
* pVar
= pHint
->GetVar();
3534 SbxArray
* pParams
= pVar
->GetParameters();
3535 SbUnoServiceCtor
* pUnoCtor
= dynamic_cast<SbUnoServiceCtor
*>( pVar
);
3536 if( pUnoCtor
&& pHint
->GetId() == SfxHintId::BasicDataWanted
)
3538 // Parameter count -1 because of Param0 == this
3539 sal_uInt32 nParamCount
= pParams
? (pParams
->Count() - 1) : 0;
3542 Reference
< XServiceConstructorDescription
> xCtor
= pUnoCtor
->getServiceCtorDesc();
3543 Sequence
< Reference
< XParameter
> > aParameterSeq
= xCtor
->getParameters();
3544 const Reference
< XParameter
>* pParameterSeq
= aParameterSeq
.getConstArray();
3545 sal_uInt32 nUnoParamCount
= aParameterSeq
.getLength();
3547 // Default: Ignore not needed parameters
3548 bool bParameterError
= false;
3550 // Is the last parameter a rest parameter?
3551 bool bRestParameterMode
= false;
3552 if( nUnoParamCount
> 0 )
3554 Reference
< XParameter
> xLastParam
= pParameterSeq
[ nUnoParamCount
- 1 ];
3555 if( xLastParam
.is() )
3557 if( xLastParam
->isRestParameter() )
3558 bRestParameterMode
= true;
3562 // Too many parameters with context as first parameter?
3563 sal_uInt32 nSbxParameterOffset
= 1;
3564 sal_uInt32 nParameterOffsetByContext
= 0;
3565 Reference
< XComponentContext
> xFirstParamContext
;
3566 if( nParamCount
> nUnoParamCount
)
3568 // Check if first parameter is a context and use it
3569 // then in createInstanceWithArgumentsAndContext
3570 Any aArg0
= sbxToUnoValue(pParams
->Get(nSbxParameterOffset
));
3571 if( (aArg0
>>= xFirstParamContext
) && xFirstParamContext
.is() )
3572 nParameterOffsetByContext
= 1;
3575 sal_uInt32 nEffectiveParamCount
= nParamCount
- nParameterOffsetByContext
;
3576 sal_uInt32 nAllocParamCount
= nEffectiveParamCount
;
3577 if( nEffectiveParamCount
> nUnoParamCount
)
3579 if( !bRestParameterMode
)
3581 nEffectiveParamCount
= nUnoParamCount
;
3582 nAllocParamCount
= nUnoParamCount
;
3585 // Not enough parameters?
3586 else if( nUnoParamCount
> nEffectiveParamCount
)
3588 // RestParameterMode only helps if one (the last) parameter is missing
3589 int nDiff
= nUnoParamCount
- nEffectiveParamCount
;
3590 if( !bRestParameterMode
|| nDiff
> 1 )
3592 bParameterError
= true;
3593 StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL
);
3597 if( !bParameterError
)
3599 bool bOutParams
= false;
3600 if( nAllocParamCount
> 0 )
3602 args
.realloc( nAllocParamCount
);
3603 Any
* pAnyArgs
= args
.getArray();
3604 for( sal_uInt32 i
= 0 ; i
< nEffectiveParamCount
; i
++ )
3606 sal_uInt32 iSbx
= i
+ nSbxParameterOffset
+ nParameterOffsetByContext
;
3608 // bRestParameterMode allows nEffectiveParamCount > nUnoParamCount
3609 Reference
< XParameter
> xParam
;
3610 if( i
< nUnoParamCount
)
3612 xParam
= pParameterSeq
[i
];
3616 Reference
< XTypeDescription
> xParamTypeDesc
= xParam
->getType();
3617 if( !xParamTypeDesc
.is() )
3619 css::uno::Type
aType( xParamTypeDesc
->getTypeClass(), xParamTypeDesc
->getName() );
3621 // sbx parameter needs offset 1
3622 pAnyArgs
[i
] = sbxToUnoValue(pParams
->Get(iSbx
), aType
);
3624 // Check for out parameter if not already done
3625 if( !bOutParams
&& xParam
->isOut() )
3630 pAnyArgs
[i
] = sbxToUnoValue(pParams
->Get(iSbx
));
3635 // "Call" ctor using createInstanceWithArgumentsAndContext
3636 Reference
< XComponentContext
> xContext(
3637 xFirstParamContext
.is()
3638 ? xFirstParamContext
3639 : comphelper::getProcessComponentContext() );
3640 Reference
< XMultiComponentFactory
> xServiceMgr( xContext
->getServiceManager() );
3643 OUString aServiceName
= GetName();
3644 Reference
< XInterface
> xRet
;
3647 xRet
= xServiceMgr
->createInstanceWithArgumentsAndContext( aServiceName
, args
, xContext
);
3649 catch( const Exception
& )
3651 implHandleAnyException( ::cppu::getCaughtException() );
3654 unoToSbxValue( pVar
, aRetAny
);
3656 // Copy back out parameters?
3659 const Any
* pAnyArgs
= args
.getConstArray();
3661 for( sal_uInt32 j
= 0 ; j
< nUnoParamCount
; j
++ )
3663 Reference
< XParameter
> xParam
= pParameterSeq
[j
];
3667 if( xParam
->isOut() )
3668 unoToSbxValue(pParams
->Get(j
+ 1), pAnyArgs
[j
]);
3674 SbxObject::Notify( rBC
, rHint
);
3678 SbUnoServiceCtor::SbUnoServiceCtor( const OUString
& aName_
, Reference
< XServiceConstructorDescription
> const & xServiceCtorDesc
)
3679 : SbxMethod( aName_
, SbxOBJECT
)
3680 , m_xServiceCtorDesc( xServiceCtorDesc
)
3684 SbUnoServiceCtor::~SbUnoServiceCtor()
3688 SbxInfo
* SbUnoServiceCtor::GetInfo()
3694 SbUnoSingleton
* findUnoSingleton( const OUString
& rName
)
3696 SbUnoSingleton
* pSbUnoSingleton
= nullptr;
3698 const Reference
< XHierarchicalNameAccess
>& xTypeAccess
= getTypeProvider_Impl();
3699 if( xTypeAccess
->hasByHierarchicalName( rName
) )
3701 Any aRet
= xTypeAccess
->getByHierarchicalName( rName
);
3702 Reference
< XTypeDescription
> xTypeDesc
;
3705 if( xTypeDesc
.is() )
3707 TypeClass eTypeClass
= xTypeDesc
->getTypeClass();
3708 if( eTypeClass
== TypeClass_SINGLETON
)
3710 Reference
< XSingletonTypeDescription
> xSingletonTypeDesc( xTypeDesc
, UNO_QUERY
);
3711 if( xSingletonTypeDesc
.is() )
3712 pSbUnoSingleton
= new SbUnoSingleton( rName
);
3716 return pSbUnoSingleton
;
3719 SbUnoSingleton::SbUnoSingleton( const OUString
& aName_
)
3720 : SbxObject( aName_
)
3722 SbxVariableRef xGetMethodRef
= new SbxMethod( "get", SbxOBJECT
);
3723 QuickInsert( xGetMethodRef
.get() );
3726 void SbUnoSingleton::Notify( SfxBroadcaster
& rBC
, const SfxHint
& rHint
)
3728 const SbxHint
* pHint
= dynamic_cast<const SbxHint
*>(&rHint
);
3731 SbxVariable
* pVar
= pHint
->GetVar();
3732 SbxArray
* pParams
= pVar
->GetParameters();
3733 sal_uInt32 nParamCount
= pParams
? (pParams
->Count() - 1) : 0;
3734 sal_uInt32 nAllowedParamCount
= 1;
3736 Reference
< XComponentContext
> xContextToUse
;
3737 if( nParamCount
> 0 )
3739 // Check if first parameter is a context and use it then
3740 Reference
< XComponentContext
> xFirstParamContext
;
3741 Any aArg1
= sbxToUnoValue(pParams
->Get(1));
3742 if( (aArg1
>>= xFirstParamContext
) && xFirstParamContext
.is() )
3743 xContextToUse
= xFirstParamContext
;
3746 if( !xContextToUse
.is() )
3748 xContextToUse
= comphelper::getProcessComponentContext();
3749 --nAllowedParamCount
;
3752 if( nParamCount
> nAllowedParamCount
)
3754 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3759 if( xContextToUse
.is() )
3761 OUString aSingletonName
= "/singletons/"
3763 Reference
< XInterface
> xRet
;
3764 xContextToUse
->getValueByName( aSingletonName
) >>= xRet
;
3767 unoToSbxValue( pVar
, aRetAny
);
3771 SbxObject::Notify( rBC
, rHint
);
3777 // Implementation of an EventAttacher-drawn AllListener, which
3778 // solely transmits several events to a general AllListener
3779 class BasicAllListener_Impl
: public WeakImplHelper
< XAllListener
>
3781 void firing_impl(const AllEventObject
& Event
, Any
* pRet
);
3784 SbxObjectRef xSbxObj
;
3785 OUString aPrefixName
;
3787 explicit BasicAllListener_Impl( const OUString
& aPrefixName
);
3789 // Methods of XAllListener
3790 virtual void SAL_CALL
firing(const AllEventObject
& Event
) override
;
3791 virtual Any SAL_CALL
approveFiring(const AllEventObject
& Event
) override
;
3793 // Methods of XEventListener
3794 virtual void SAL_CALL
disposing(const EventObject
& Source
) override
;
3799 BasicAllListener_Impl::BasicAllListener_Impl(const OUString
& aPrefixName_
)
3800 : aPrefixName( aPrefixName_
)
3804 void BasicAllListener_Impl::firing_impl( const AllEventObject
& Event
, Any
* pRet
)
3806 SolarMutexGuard guard
;
3811 OUString aMethodName
= aPrefixName
+ Event
.MethodName
;
3813 SbxVariable
* pP
= xSbxObj
.get();
3814 while( pP
->GetParent() )
3816 pP
= pP
->GetParent();
3817 StarBASIC
* pLib
= dynamic_cast<StarBASIC
*>( pP
);
3820 // Create in a Basic Array
3821 SbxArrayRef xSbxArray
= new SbxArray( SbxVARIANT
);
3822 const Any
* pArgs
= Event
.Arguments
.getConstArray();
3823 sal_Int32 nCount
= Event
.Arguments
.getLength();
3824 for( sal_Int32 i
= 0; i
< nCount
; i
++ )
3827 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
3828 unoToSbxValue( xVar
.get(), pArgs
[i
] );
3829 xSbxArray
->Put(xVar
.get(), i
+ 1);
3832 pLib
->Call( aMethodName
, xSbxArray
.get() );
3834 // get the return value from the Param-Array, if requested
3837 SbxVariable
* pVar
= xSbxArray
->Get(0);
3840 // #95792 Avoid a second call
3841 SbxFlagBits nFlags
= pVar
->GetFlags();
3842 pVar
->SetFlag( SbxFlagBits::NoBroadcast
);
3843 *pRet
= sbxToUnoValueImpl( pVar
);
3844 pVar
->SetFlags( nFlags
);
3853 // Methods of Listener
3854 void BasicAllListener_Impl::firing( const AllEventObject
& Event
)
3856 firing_impl( Event
, nullptr );
3859 Any
BasicAllListener_Impl::approveFiring( const AllEventObject
& Event
)
3862 firing_impl( Event
, &aRetAny
);
3867 // Methods of XEventListener
3868 void BasicAllListener_Impl ::disposing(const EventObject
& )
3870 SolarMutexGuard guard
;
3876 // class InvocationToAllListenerMapper
3877 // helper class to map XInvocation to XAllListener (also in project eventattacher!)
3881 class InvocationToAllListenerMapper
: public WeakImplHelper
< XInvocation
>
3884 InvocationToAllListenerMapper( const Reference
< XIdlClass
>& ListenerType
,
3885 const Reference
< XAllListener
>& AllListener
, const Any
& Helper
);
3888 virtual Reference
< XIntrospectionAccess
> SAL_CALL
getIntrospection() override
;
3889 virtual Any SAL_CALL
invoke(const OUString
& FunctionName
, const Sequence
< Any
>& Params
, Sequence
< sal_Int16
>& OutParamIndex
, Sequence
< Any
>& OutParam
) override
;
3890 virtual void SAL_CALL
setValue(const OUString
& PropertyName
, const Any
& Value
) override
;
3891 virtual Any SAL_CALL
getValue(const OUString
& PropertyName
) override
;
3892 virtual sal_Bool SAL_CALL
hasMethod(const OUString
& Name
) override
;
3893 virtual sal_Bool SAL_CALL
hasProperty(const OUString
& Name
) override
;
3896 Reference
< XAllListener
> m_xAllListener
;
3897 Reference
< XIdlClass
> m_xListenerType
;
3903 // Function to replace AllListenerAdapterService::createAllListerAdapter
3904 static Reference
< XInterface
> createAllListenerAdapter
3906 const Reference
< XInvocationAdapterFactory2
>& xInvocationAdapterFactory
,
3907 const Reference
< XIdlClass
>& xListenerType
,
3908 const Reference
< XAllListener
>& xListener
,
3912 Reference
< XInterface
> xAdapter
;
3913 if( xInvocationAdapterFactory
.is() && xListenerType
.is() && xListener
.is() )
3915 Reference
< XInvocation
> xInvocationToAllListenerMapper
=
3916 new InvocationToAllListenerMapper(xListenerType
, xListener
, Helper
);
3917 Type
aListenerType( xListenerType
->getTypeClass(), xListenerType
->getName() );
3918 xAdapter
= xInvocationAdapterFactory
->createAdapter( xInvocationToAllListenerMapper
, {aListenerType
} );
3924 // InvocationToAllListenerMapper
3925 InvocationToAllListenerMapper::InvocationToAllListenerMapper
3926 ( const Reference
< XIdlClass
>& ListenerType
, const Reference
< XAllListener
>& AllListener
, const Any
& Helper
)
3927 : m_xAllListener( AllListener
)
3928 , m_xListenerType( ListenerType
)
3929 , m_Helper( Helper
)
3934 Reference
< XIntrospectionAccess
> SAL_CALL
InvocationToAllListenerMapper::getIntrospection()
3936 return Reference
< XIntrospectionAccess
>();
3940 Any SAL_CALL
InvocationToAllListenerMapper::invoke(const OUString
& FunctionName
, const Sequence
< Any
>& Params
,
3941 Sequence
< sal_Int16
>&, Sequence
< Any
>&)
3945 // Check if to firing or approveFiring has to be called
3946 Reference
< XIdlMethod
> xMethod
= m_xListenerType
->getMethod( FunctionName
);
3947 bool bApproveFiring
= false;
3950 Reference
< XIdlClass
> xReturnType
= xMethod
->getReturnType();
3951 Sequence
< Reference
< XIdlClass
> > aExceptionSeq
= xMethod
->getExceptionTypes();
3952 if( ( xReturnType
.is() && xReturnType
->getTypeClass() != TypeClass_VOID
) ||
3953 aExceptionSeq
.hasElements() )
3955 bApproveFiring
= true;
3959 Sequence
< ParamInfo
> aParamSeq
= xMethod
->getParameterInfos();
3960 sal_uInt32 nParamCount
= aParamSeq
.getLength();
3961 if( nParamCount
> 1 )
3963 const ParamInfo
* pInfo
= aParamSeq
.getConstArray();
3964 for( sal_uInt32 i
= 0 ; i
< nParamCount
; i
++ )
3966 if( pInfo
[ i
].aMode
!= ParamMode_IN
)
3968 bApproveFiring
= true;
3975 AllEventObject aAllEvent
;
3976 aAllEvent
.Source
= static_cast<OWeakObject
*>(this);
3977 aAllEvent
.Helper
= m_Helper
;
3978 aAllEvent
.ListenerType
= Type(m_xListenerType
->getTypeClass(), m_xListenerType
->getName() );
3979 aAllEvent
.MethodName
= FunctionName
;
3980 aAllEvent
.Arguments
= Params
;
3981 if( bApproveFiring
)
3982 aRet
= m_xAllListener
->approveFiring( aAllEvent
);
3984 m_xAllListener
->firing( aAllEvent
);
3989 void SAL_CALL
InvocationToAllListenerMapper::setValue(const OUString
&, const Any
&)
3993 Any SAL_CALL
InvocationToAllListenerMapper::getValue(const OUString
&)
3999 sal_Bool SAL_CALL
InvocationToAllListenerMapper::hasMethod(const OUString
& Name
)
4001 Reference
< XIdlMethod
> xMethod
= m_xListenerType
->getMethod( Name
);
4002 return xMethod
.is();
4006 sal_Bool SAL_CALL
InvocationToAllListenerMapper::hasProperty(const OUString
& Name
)
4008 Reference
< XIdlField
> xField
= m_xListenerType
->getField( Name
);
4013 // create Uno-Service
4014 // 1. Parameter == Prefix-Name of the macro
4015 // 2. Parameter == fully qualified name of the listener
4016 void SbRtl_CreateUnoListener(StarBASIC
* pBasic
, SbxArray
& rPar
, bool)
4018 // We need 2 parameters
4019 if (rPar
.Count() != 3)
4021 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4025 // get the name of the class of the struct
4026 OUString aPrefixName
= rPar
.Get(1)->GetOUString();
4027 OUString aListenerClassName
= rPar
.Get(2)->GetOUString();
4029 // get the CoreReflection
4030 Reference
< XIdlReflection
> xCoreReflection
= getCoreReflection_Impl();
4031 if( !xCoreReflection
.is() )
4034 // get the AllListenerAdapterService
4035 Reference
< XComponentContext
> xContext( comphelper::getProcessComponentContext() );
4038 Reference
< XIdlClass
> xClass
= xCoreReflection
->forName( aListenerClassName
);
4042 // From 1999-11-30: get the InvocationAdapterFactory
4043 Reference
< XInvocationAdapterFactory2
> xInvocationAdapterFactory
=
4044 InvocationAdapterFactory::create( xContext
);
4046 rtl::Reference
<BasicAllListener_Impl
> xAllLst
= new BasicAllListener_Impl( aPrefixName
);
4048 Reference
< XInterface
> xLst
= createAllListenerAdapter( xInvocationAdapterFactory
, xClass
, xAllLst
, aTmp
);
4052 OUString aClassName
= xClass
->getName();
4053 Type
aClassType( xClass
->getTypeClass(), aClassName
);
4054 aTmp
= xLst
->queryInterface( aClassType
);
4055 if( !aTmp
.hasValue() )
4058 SbUnoObject
* pUnoObj
= new SbUnoObject( aListenerClassName
, aTmp
);
4059 xAllLst
->xSbxObj
= pUnoObj
;
4060 xAllLst
->xSbxObj
->SetParent( pBasic
);
4062 // #100326 Register listener object to set Parent NULL in Dtor
4063 SbxArrayRef xBasicUnoListeners
= pBasic
->getUnoListeners();
4064 xBasicUnoListeners
->Insert(pUnoObj
, xBasicUnoListeners
->Count());
4066 // return the object
4067 SbxVariableRef refVar
= rPar
.Get(0);
4068 refVar
->PutObject( xAllLst
->xSbxObj
.get() );
4072 // Represents the DefaultContext property of the ProcessServiceManager
4073 // in the Basic runtime system.
4074 void RTL_Impl_GetDefaultContext( SbxArray
& rPar
)
4076 SbxVariableRef refVar
= rPar
.Get(0);
4078 Any
aContextAny( comphelper::getProcessComponentContext() );
4080 SbUnoObjectRef xUnoObj
= new SbUnoObject( "DefaultContext", aContextAny
);
4081 refVar
->PutObject( xUnoObj
.get() );
4085 // Creates a Basic wrapper object for a strongly typed Uno value
4086 // 1. parameter: Uno type as full qualified type name, e.g. "byte[]"
4087 void RTL_Impl_CreateUnoValue( SbxArray
& rPar
)
4089 // 2 parameters needed
4090 if (rPar
.Count() != 3)
4092 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4096 // get the name of the class of the struct
4097 OUString aTypeName
= rPar
.Get(1)->GetOUString();
4098 SbxVariable
* pVal
= rPar
.Get(2);
4100 if( aTypeName
== "type" )
4102 SbxDataType eBaseType
= pVal
->SbxValue::GetType();
4103 OUString aValTypeName
;
4104 if( eBaseType
== SbxSTRING
)
4106 aValTypeName
= pVal
->GetOUString();
4108 else if( eBaseType
== SbxOBJECT
)
4111 Reference
< XIdlClass
> xIdlClass
;
4113 SbxBaseRef pObj
= pVal
->GetObject();
4114 if( auto obj
= dynamic_cast<SbUnoObject
*>( pObj
.get() ) )
4116 Any aUnoAny
= obj
->getUnoAny();
4117 aUnoAny
>>= xIdlClass
;
4120 if( xIdlClass
.is() )
4122 aValTypeName
= xIdlClass
->getName();
4126 bool bSuccess
= implGetTypeByName( aValTypeName
, aType
);
4129 Any
aTypeAny( aType
);
4130 SbxVariableRef refVar
= rPar
.Get(0);
4131 SbxObjectRef xUnoAnyObject
= new SbUnoAnyObject( aTypeAny
);
4132 refVar
->PutObject( xUnoAnyObject
.get() );
4138 const Reference
< XHierarchicalNameAccess
>& xTypeAccess
= getTypeProvider_Impl();
4142 aRet
= xTypeAccess
->getByHierarchicalName( aTypeName
);
4144 catch( const NoSuchElementException
& e1
)
4146 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION
,
4147 implGetExceptionMsg( e1
, u
"com.sun.star.container.NoSuchElementException" ) );
4150 Reference
< XTypeDescription
> xTypeDesc
;
4152 TypeClass eTypeClass
= xTypeDesc
->getTypeClass();
4153 Type
aDestType( eTypeClass
, aTypeName
);
4157 Any aVal
= sbxToUnoValueImpl( pVal
);
4158 Any aConvertedVal
= convertAny( aVal
, aDestType
);
4160 SbxVariableRef refVar
= rPar
.Get(0);
4161 SbxObjectRef xUnoAnyObject
= new SbUnoAnyObject( aConvertedVal
);
4162 refVar
->PutObject( xUnoAnyObject
.get() );
4167 class ModuleInvocationProxy
: public WeakImplHelper
< XInvocation
, XComponent
>
4169 ::osl::Mutex m_aMutex
;
4171 SbxObjectRef m_xScopeObj
;
4172 bool m_bProxyIsClassModuleObject
;
4174 ::comphelper::OInterfaceContainerHelper2 m_aListeners
;
4177 ModuleInvocationProxy( std::u16string_view aPrefix
, SbxObjectRef
const & xScopeObj
);
4180 virtual Reference
< XIntrospectionAccess
> SAL_CALL
getIntrospection() override
;
4181 virtual void SAL_CALL
setValue( const OUString
& rProperty
, const Any
& rValue
) override
;
4182 virtual Any SAL_CALL
getValue( const OUString
& rProperty
) override
;
4183 virtual sal_Bool SAL_CALL
hasMethod( const OUString
& rName
) override
;
4184 virtual sal_Bool SAL_CALL
hasProperty( const OUString
& rProp
) override
;
4186 virtual Any SAL_CALL
invoke( const OUString
& rFunction
,
4187 const Sequence
< Any
>& rParams
,
4188 Sequence
< sal_Int16
>& rOutParamIndex
,
4189 Sequence
< Any
>& rOutParam
) override
;
4192 virtual void SAL_CALL
dispose() override
;
4193 virtual void SAL_CALL
addEventListener( const Reference
< XEventListener
>& xListener
) override
;
4194 virtual void SAL_CALL
removeEventListener( const Reference
< XEventListener
>& aListener
) override
;
4199 ModuleInvocationProxy::ModuleInvocationProxy( std::u16string_view aPrefix
, SbxObjectRef
const & xScopeObj
)
4200 : m_aPrefix( OUString::Concat(aPrefix
) + "_" )
4201 , m_xScopeObj( xScopeObj
)
4202 , m_aListeners( m_aMutex
)
4204 m_bProxyIsClassModuleObject
= xScopeObj
.is() && dynamic_cast<const SbClassModuleObject
*>( xScopeObj
.get() ) != nullptr;
4207 Reference
< XIntrospectionAccess
> SAL_CALL
ModuleInvocationProxy::getIntrospection()
4209 return Reference
< XIntrospectionAccess
>();
4212 void SAL_CALL
ModuleInvocationProxy::setValue(const OUString
& rProperty
, const Any
& rValue
)
4214 if( !m_bProxyIsClassModuleObject
)
4215 throw UnknownPropertyException();
4217 SolarMutexGuard guard
;
4219 OUString aPropertyFunctionName
= "Property Set "
4223 SbxVariable
* p
= m_xScopeObj
->Find( aPropertyFunctionName
, SbxClassType::Method
);
4224 SbMethod
* pMeth
= dynamic_cast<SbMethod
*>( p
);
4225 if( pMeth
== nullptr )
4227 // TODO: Check vba behavior concerning missing function
4228 //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
4229 throw UnknownPropertyException(aPropertyFunctionName
);
4233 SbxArrayRef xArray
= new SbxArray
;
4234 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
4235 unoToSbxValue( xVar
.get(), rValue
);
4236 xArray
->Put(xVar
.get(), 1);
4238 // Call property method
4239 SbxVariableRef xValue
= new SbxVariable
;
4240 pMeth
->SetParameters( xArray
.get() );
4241 pMeth
->Call( xValue
.get() );
4242 pMeth
->SetParameters( nullptr );
4244 // TODO: OutParameter?
4249 Any SAL_CALL
ModuleInvocationProxy::getValue(const OUString
& rProperty
)
4251 if( !m_bProxyIsClassModuleObject
)
4253 throw UnknownPropertyException();
4255 SolarMutexGuard guard
;
4257 OUString aPropertyFunctionName
= "Property Get "
4261 SbxVariable
* p
= m_xScopeObj
->Find( aPropertyFunctionName
, SbxClassType::Method
);
4262 SbMethod
* pMeth
= dynamic_cast<SbMethod
*>( p
);
4263 if( pMeth
== nullptr )
4265 // TODO: Check vba behavior concerning missing function
4266 //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
4267 throw UnknownPropertyException(aPropertyFunctionName
);
4271 SbxVariableRef xValue
= new SbxVariable
;
4272 pMeth
->Call( xValue
.get() );
4273 Any aRet
= sbxToUnoValue( xValue
.get() );
4277 sal_Bool SAL_CALL
ModuleInvocationProxy::hasMethod( const OUString
& )
4282 sal_Bool SAL_CALL
ModuleInvocationProxy::hasProperty( const OUString
& )
4287 Any SAL_CALL
ModuleInvocationProxy::invoke( const OUString
& rFunction
,
4288 const Sequence
< Any
>& rParams
,
4289 Sequence
< sal_Int16
>&,
4292 SolarMutexGuard guard
;
4295 SbxObjectRef xScopeObj
= m_xScopeObj
;
4296 if( !xScopeObj
.is() )
4300 OUString aFunctionName
= m_aPrefix
4303 bool bSetRescheduleBack
= false;
4304 bool bOldReschedule
= true;
4305 SbiInstance
* pInst
= GetSbData()->pInst
;
4306 if( pInst
&& pInst
->IsCompatibility() )
4308 bOldReschedule
= pInst
->IsReschedule();
4309 if ( bOldReschedule
)
4311 pInst
->EnableReschedule( false );
4312 bSetRescheduleBack
= true;
4316 SbxVariable
* p
= xScopeObj
->Find( aFunctionName
, SbxClassType::Method
);
4317 SbMethod
* pMeth
= dynamic_cast<SbMethod
*>( p
);
4318 if( pMeth
== nullptr )
4320 // TODO: Check vba behavior concerning missing function
4321 //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
4327 sal_Int32 nParamCount
= rParams
.getLength();
4330 xArray
= new SbxArray
;
4331 const Any
*pArgs
= rParams
.getConstArray();
4332 for( sal_Int32 i
= 0 ; i
< nParamCount
; i
++ )
4334 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
4335 unoToSbxValue( xVar
.get(), pArgs
[i
] );
4336 xArray
->Put(xVar
.get(), sal::static_int_cast
<sal_uInt16
>(i
+ 1));
4341 SbxVariableRef xValue
= new SbxVariable
;
4343 pMeth
->SetParameters( xArray
.get() );
4344 pMeth
->Call( xValue
.get() );
4345 aRet
= sbxToUnoValue( xValue
.get() );
4346 pMeth
->SetParameters( nullptr );
4348 if( bSetRescheduleBack
)
4349 pInst
->EnableReschedule( bOldReschedule
);
4351 // TODO: OutParameter?
4356 void SAL_CALL
ModuleInvocationProxy::dispose()
4358 ::osl::MutexGuard
aGuard( m_aMutex
);
4360 EventObject
aEvent( static_cast<XComponent
*>(this) );
4361 m_aListeners
.disposeAndClear( aEvent
);
4363 m_xScopeObj
= nullptr;
4366 void SAL_CALL
ModuleInvocationProxy::addEventListener( const Reference
< XEventListener
>& xListener
)
4368 m_aListeners
.addInterface( xListener
);
4371 void SAL_CALL
ModuleInvocationProxy::removeEventListener( const Reference
< XEventListener
>& xListener
)
4373 m_aListeners
.removeInterface( xListener
);
4377 Reference
< XInterface
> createComListener( const Any
& aControlAny
, const OUString
& aVBAType
,
4378 std::u16string_view aPrefix
,
4379 const SbxObjectRef
& xScopeObj
)
4381 Reference
< XInterface
> xRet
;
4383 Reference
< XComponentContext
> xContext(
4384 comphelper::getProcessComponentContext() );
4385 Reference
< XMultiComponentFactory
> xServiceMgr( xContext
->getServiceManager() );
4387 Reference
< XInvocation
> xProxy
= new ModuleInvocationProxy( aPrefix
, xScopeObj
);
4389 Sequence
<Any
> args
{ aControlAny
, Any(aVBAType
), Any(xProxy
) };
4393 xRet
= xServiceMgr
->createInstanceWithArgumentsAndContext(
4394 "com.sun.star.custom.UnoComListener",
4397 catch( const Exception
& )
4399 implHandleAnyException( ::cppu::getCaughtException() );
4405 typedef std::vector
< WeakReference
< XComponent
> > ComponentRefVector
;
4409 struct StarBasicDisposeItem
4411 StarBASIC
* m_pBasic
;
4412 SbxArrayRef m_pRegisteredVariables
;
4413 ComponentRefVector m_vComImplementsObjects
;
4415 explicit StarBasicDisposeItem( StarBASIC
* pBasic
)
4416 : m_pBasic( pBasic
)
4417 , m_pRegisteredVariables(new SbxArray())
4424 typedef std::vector
< StarBasicDisposeItem
* > DisposeItemVector
;
4426 static DisposeItemVector GaDisposeItemVector
;
4428 static DisposeItemVector::iterator
lcl_findItemForBasic( StarBASIC
const * pBasic
)
4430 return std::find_if(GaDisposeItemVector
.begin(), GaDisposeItemVector
.end(),
4431 [&pBasic
](StarBasicDisposeItem
* pItem
) { return pItem
->m_pBasic
== pBasic
; });
4434 static StarBasicDisposeItem
* lcl_getOrCreateItemForBasic( StarBASIC
* pBasic
)
4436 DisposeItemVector::iterator it
= lcl_findItemForBasic( pBasic
);
4437 StarBasicDisposeItem
* pItem
= (it
!= GaDisposeItemVector
.end()) ? *it
: nullptr;
4438 if( pItem
== nullptr )
4440 pItem
= new StarBasicDisposeItem( pBasic
);
4441 GaDisposeItemVector
.push_back( pItem
);
4446 void registerComponentToBeDisposedForBasic
4447 ( const Reference
< XComponent
>& xComponent
, StarBASIC
* pBasic
)
4449 StarBasicDisposeItem
* pItem
= lcl_getOrCreateItemForBasic( pBasic
);
4450 pItem
->m_vComImplementsObjects
.emplace_back(xComponent
);
4453 void registerComListenerVariableForBasic( SbxVariable
* pVar
, StarBASIC
* pBasic
)
4455 StarBasicDisposeItem
* pItem
= lcl_getOrCreateItemForBasic( pBasic
);
4456 SbxArray
* pArray
= pItem
->m_pRegisteredVariables
.get();
4457 pArray
->Put(pVar
, pArray
->Count());
4460 void disposeComVariablesForBasic( StarBASIC
const * pBasic
)
4462 DisposeItemVector::iterator it
= lcl_findItemForBasic( pBasic
);
4463 if( it
== GaDisposeItemVector
.end() )
4466 StarBasicDisposeItem
* pItem
= *it
;
4468 SbxArray
* pArray
= pItem
->m_pRegisteredVariables
.get();
4469 sal_uInt32 nCount
= pArray
->Count();
4470 for( sal_uInt32 i
= 0 ; i
< nCount
; ++i
)
4472 SbxVariable
* pVar
= pArray
->Get(i
);
4473 pVar
->ClearComListener();
4476 ComponentRefVector
& rv
= pItem
->m_vComImplementsObjects
;
4477 for (auto const& elem
: rv
)
4479 Reference
< XComponent
> xComponent( elem
.get(), UNO_QUERY
);
4480 if (xComponent
.is())
4481 xComponent
->dispose();
4485 GaDisposeItemVector
.erase( it
);
4489 // Handle module implements mechanism for OLE types
4490 bool SbModule::createCOMWrapperForIface( Any
& o_rRetAny
, SbClassModuleObject
* pProxyClassModuleObject
)
4492 // For now: Take first interface that allows to instantiate COM wrapper
4493 // TODO: Check if support for multiple interfaces is needed
4495 Reference
< XComponentContext
> xContext(
4496 comphelper::getProcessComponentContext() );
4497 Reference
< XMultiComponentFactory
> xServiceMgr( xContext
->getServiceManager() );
4498 Reference
< XSingleServiceFactory
> xComImplementsFactory
4500 xServiceMgr
->createInstanceWithContext( "com.sun.star.custom.ComImplementsFactory", xContext
),
4503 if( !xComImplementsFactory
.is() )
4506 bool bSuccess
= false;
4508 SbxArray
* pModIfaces
= pClassData
->mxIfaces
.get();
4509 sal_uInt32 nCount
= pModIfaces
->Count();
4510 for( sal_uInt32 i
= 0 ; i
< nCount
; ++i
)
4512 SbxVariable
* pVar
= pModIfaces
->Get(i
);
4513 const OUString
& aIfaceName
= pVar
->GetName();
4515 if( !aIfaceName
.isEmpty() )
4517 OUString aPureIfaceName
= aIfaceName
;
4518 sal_Int32 indexLastDot
= aIfaceName
.lastIndexOf('.');
4519 if ( indexLastDot
> -1 )
4521 aPureIfaceName
= aIfaceName
.copy( indexLastDot
+ 1 );
4523 Reference
< XInvocation
> xProxy
= new ModuleInvocationProxy( aPureIfaceName
, pProxyClassModuleObject
);
4525 Sequence
<Any
> args
{ Any(aIfaceName
), Any(xProxy
) };
4527 Reference
< XInterface
> xRet
;
4530 xRet
= xComImplementsFactory
->createInstanceWithArguments( args
);
4533 catch( const Exception
& )
4535 implHandleAnyException( ::cppu::getCaughtException() );
4540 Reference
< XComponent
> xComponent( xProxy
, UNO_QUERY
);
4541 if( xComponent
.is() )
4543 StarBASIC
* pParentBasic
= nullptr;
4544 SbxObject
* pCurObject
= this;
4547 SbxObject
* pObjParent
= pCurObject
->GetParent();
4548 pParentBasic
= dynamic_cast<StarBASIC
*>( pObjParent
);
4549 pCurObject
= pObjParent
;
4551 while( pParentBasic
== nullptr && pCurObject
!= nullptr );
4553 assert( pParentBasic
!= nullptr );
4554 registerComponentToBeDisposedForBasic( xComponent
, pParentBasic
);
4567 // Due to an incorrect behavior IE returns an object instead of a string
4568 // in some scenarios. Calling toString at the object may correct this.
4569 // Helper function used in sbxvalue.cxx
4570 bool handleToStringForCOMObjects( SbxObject
* pObj
, SbxValue
* pVal
)
4572 bool bSuccess
= false;
4574 if( auto pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
) )
4576 // Only for native COM objects
4577 if( pUnoObj
->isNativeCOMObject() )
4579 SbxVariableRef pMeth
= pObj
->Find( "toString", SbxClassType::Method
);
4592 Any
StructRefInfo::getValue()
4596 &aRet
, reinterpret_cast< uno_ReleaseFunc
>(cpp_release
) );
4597 typelib_TypeDescription
* pTD
= nullptr;
4598 maType
.getDescription(&pTD
);
4600 &aRet
, getInst(), pTD
,
4601 reinterpret_cast< uno_AcquireFunc
>(cpp_acquire
) );
4602 typelib_typedescription_release(pTD
);
4606 void StructRefInfo::setValue( const Any
& rValue
)
4608 bool bSuccess
= uno_type_assignData( getInst(),
4609 maType
.getTypeLibType(),
4610 const_cast<void*>(rValue
.getValue()),
4611 rValue
.getValueTypeRef(),
4612 reinterpret_cast< uno_QueryInterfaceFunc
>(cpp_queryInterface
),
4613 reinterpret_cast< uno_AcquireFunc
>(cpp_acquire
),
4614 reinterpret_cast< uno_ReleaseFunc
>(cpp_release
) );
4615 OSL_ENSURE(bSuccess
,
4616 "StructRefInfo::setValue: ooops... the value could not be assigned!");
4619 OUString
StructRefInfo::getTypeName() const
4621 return maType
.getTypeName();
4624 void* StructRefInfo::getInst()
4626 return const_cast<char *>(static_cast<char const *>(maAny
.getValue()) + mnPos
);
4629 TypeClass
StructRefInfo::getTypeClass() const
4631 return maType
.getTypeClass();
4634 SbUnoStructRefObject::SbUnoStructRefObject( const OUString
& aName_
, const StructRefInfo
& rMemberInfo
) : SbxObject( aName_
), maMemberInfo( rMemberInfo
), mbMemberCacheInit( false )
4636 SetClassName( maMemberInfo
.getTypeName() );
4639 SbUnoStructRefObject::~SbUnoStructRefObject()
4643 void SbUnoStructRefObject::initMemberCache()
4645 if ( mbMemberCacheInit
)
4647 typelib_TypeDescription
* pTD
= nullptr;
4648 maMemberInfo
.getType().getDescription(&pTD
);
4649 for ( typelib_CompoundTypeDescription
* pCompTypeDescr
= reinterpret_cast<typelib_CompoundTypeDescription
*>(pTD
);
4651 pCompTypeDescr
= pCompTypeDescr
->pBaseTypeDescription
)
4653 typelib_TypeDescriptionReference
** ppTypeRefs
= pCompTypeDescr
->ppTypeRefs
;
4654 rtl_uString
** ppNames
= pCompTypeDescr
->ppMemberNames
;
4655 sal_Int32
* pMemberOffsets
= pCompTypeDescr
->pMemberOffsets
;
4656 for ( sal_Int32 nPos
= pCompTypeDescr
->nMembers
; nPos
--; )
4658 OUString
aName( ppNames
[nPos
] );
4659 maFields
[ aName
] = std::make_unique
<StructRefInfo
>( maMemberInfo
.getRootAnyRef(), ppTypeRefs
[nPos
], maMemberInfo
.getPos() + pMemberOffsets
[nPos
] );
4662 typelib_typedescription_release(pTD
);
4663 mbMemberCacheInit
= true;
4666 SbxVariable
* SbUnoStructRefObject::Find( const OUString
& rName
, SbxClassType t
)
4668 SbxVariable
* pRes
= SbxObject::Find( rName
, t
);
4671 if ( !mbMemberCacheInit
)
4673 StructFieldInfo::iterator it
= maFields
.find( rName
);
4674 if ( it
!= maFields
.end() )
4676 SbxDataType eSbxType
;
4677 eSbxType
= unoToSbxType( it
->second
->getTypeClass() );
4678 SbxDataType eRealSbxType
= eSbxType
;
4681 aProp
.Type
= css::uno::Type( it
->second
->getTypeClass(), it
->second
->getTypeName() );
4682 SbUnoProperty
* pProp
= new SbUnoProperty( rName
, eSbxType
, eRealSbxType
, aProp
, 0, false, ( aProp
.Type
.getTypeClass() == css::uno::TypeClass_STRUCT
) );
4683 SbxVariableRef xVarRef
= pProp
;
4684 QuickInsert( xVarRef
.get() );
4685 pRes
= xVarRef
.get();
4691 if( rName
.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES
) ||
4692 rName
.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES
) ||
4693 rName
.equalsIgnoreAsciiCase(ID_DBG_METHODS
) )
4696 implCreateDbgProperties();
4698 // Now they have to be found regular
4699 pRes
= SbxObject::Find( rName
, SbxClassType::DontCare
);
4706 // help method to create the dbg_-Properties
4707 void SbUnoStructRefObject::implCreateDbgProperties()
4711 // Id == -1: display the implemented interfaces corresponding the ClassProvider
4712 SbxVariableRef xVarRef
= new SbUnoProperty( ID_DBG_SUPPORTEDINTERFACES
, SbxSTRING
, SbxSTRING
, aProp
, -1, false, false );
4713 QuickInsert( xVarRef
.get() );
4715 // Id == -2: output the properties
4716 xVarRef
= new SbUnoProperty( ID_DBG_PROPERTIES
, SbxSTRING
, SbxSTRING
, aProp
, -2, false, false );
4717 QuickInsert( xVarRef
.get() );
4719 // Id == -3: output the Methods
4720 xVarRef
= new SbUnoProperty( ID_DBG_METHODS
, SbxSTRING
, SbxSTRING
, aProp
, -3, false, false );
4721 QuickInsert( xVarRef
.get() );
4724 void SbUnoStructRefObject::implCreateAll()
4726 // throw away all existing methods and properties
4727 pMethods
= new SbxArray
;
4728 pProps
= new SbxArray
;
4730 if (!mbMemberCacheInit
)
4733 for (auto const& field
: maFields
)
4735 const OUString
& rName
= field
.first
;
4736 SbxDataType eSbxType
;
4737 eSbxType
= unoToSbxType( field
.second
->getTypeClass() );
4738 SbxDataType eRealSbxType
= eSbxType
;
4741 aProp
.Type
= css::uno::Type( field
.second
->getTypeClass(), field
.second
->getTypeName() );
4742 SbUnoProperty
* pProp
= new SbUnoProperty( rName
, eSbxType
, eRealSbxType
, aProp
, 0, false, ( aProp
.Type
.getTypeClass() == css::uno::TypeClass_STRUCT
) );
4743 SbxVariableRef xVarRef
= pProp
;
4744 QuickInsert( xVarRef
.get() );
4747 // Create Dbg_-Properties
4748 implCreateDbgProperties();
4752 Any
SbUnoStructRefObject::getUnoAny()
4754 return maMemberInfo
.getValue();
4757 OUString
SbUnoStructRefObject::Impl_DumpProperties()
4759 OUStringBuffer aRet
;
4760 aRet
.append("Properties of object ");
4761 aRet
.append( getDbgObjectName() );
4763 sal_uInt32 nPropCount
= pProps
->Count();
4764 sal_uInt32 nPropsPerLine
= 1 + nPropCount
/ 30;
4765 for( sal_uInt32 i
= 0; i
< nPropCount
; i
++ )
4767 SbxVariable
* pVar
= pProps
->Get(i
);
4770 OUStringBuffer aPropStr
;
4771 if( (i
% nPropsPerLine
) == 0 )
4773 aPropStr
.append( "\n" );
4775 // output the type and name
4776 // Is it in Uno a sequence?
4777 SbxDataType eType
= pVar
->GetFullType();
4779 const OUString
& aName( pVar
->GetName() );
4780 StructFieldInfo::iterator it
= maFields
.find( aName
);
4782 if ( it
!= maFields
.end() )
4784 const StructRefInfo
& rPropInfo
= *it
->second
;
4786 if( eType
== SbxOBJECT
)
4788 if( rPropInfo
.getTypeClass() == TypeClass_SEQUENCE
)
4790 eType
= SbxDataType( SbxOBJECT
| SbxARRAY
);
4794 aPropStr
.append( Dbg_SbxDataType2String( eType
) );
4796 aPropStr
.append( " " );
4797 aPropStr
.append( pVar
->GetName() );
4799 if( i
== nPropCount
- 1 )
4801 aPropStr
.append( "\n" );
4805 aPropStr
.append( "; " );
4807 aRet
.append( aPropStr
);
4810 return aRet
.makeStringAndClear();
4813 void SbUnoStructRefObject::Notify( SfxBroadcaster
& rBC
, const SfxHint
& rHint
)
4815 if ( !mbMemberCacheInit
)
4817 const SbxHint
* pHint
= dynamic_cast<const SbxHint
*>(&rHint
);
4821 SbxVariable
* pVar
= pHint
->GetVar();
4822 SbUnoProperty
* pProp
= dynamic_cast<SbUnoProperty
*>( pVar
);
4825 StructFieldInfo::iterator it
= maFields
.find( pProp
->GetName() );
4826 // handle get/set of members of struct
4827 if( pHint
->GetId() == SfxHintId::BasicDataWanted
)
4830 sal_Int32 nId
= pProp
->nId
;
4833 // Id == -1: Display implemented interfaces according the ClassProvider
4834 if( nId
== -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
4836 OUString aRet
= OUString::Concat( ID_DBG_SUPPORTEDINTERFACES
)
4837 + " not available.\n(TypeClass is not TypeClass_INTERFACE)\n";
4839 pVar
->PutString( aRet
);
4841 // Id == -2: output properties
4842 else if( nId
== -2 ) // Property ID_DBG_PROPERTIES
4844 // by now all properties must be established
4846 OUString aRetStr
= Impl_DumpProperties();
4847 pVar
->PutString( aRetStr
);
4849 // Id == -3: output the methods
4850 else if( nId
== -3 ) // Property ID_DBG_METHODS
4852 // by now all properties must be established
4854 OUString aRet
= "Methods of object "
4855 + getDbgObjectName()
4856 + "\nNo methods found\n";
4857 pVar
->PutString( aRet
);
4862 if ( it
!= maFields
.end() )
4864 Any aRetAny
= it
->second
->getValue();
4865 unoToSbxValue( pVar
, aRetAny
);
4868 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND
);
4870 else if( pHint
->GetId() == SfxHintId::BasicDataChanged
)
4872 if ( it
!= maFields
.end() )
4874 // take over the value from Uno to Sbx
4875 Any aAnyValue
= sbxToUnoValue( pVar
, pProp
->aUnoProp
.Type
, &pProp
->aUnoProp
);
4876 it
->second
->setValue( aAnyValue
);
4879 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND
);
4883 SbxObject::Notify( rBC
, rHint
);
4886 StructRefInfo
SbUnoStructRefObject::getStructMember( const OUString
& rMemberName
)
4888 if (!mbMemberCacheInit
)
4892 StructFieldInfo::iterator it
= maFields
.find( rMemberName
);
4894 css::uno::Type aFoundType
;
4895 sal_Int32 nFoundPos
= -1;
4897 if ( it
!= maFields
.end() )
4899 aFoundType
= it
->second
->getType();
4900 nFoundPos
= it
->second
->getPos();
4902 StructRefInfo
aRet( maMemberInfo
.getRootAnyRef(), aFoundType
, nFoundPos
);
4906 OUString
SbUnoStructRefObject::getDbgObjectName() const
4908 OUString aName
= GetClassName();
4909 if( aName
.isEmpty() )
4913 OUStringBuffer aRet
;
4914 if( aName
.getLength() > 20 )
4916 aRet
.append( "\n" );
4918 aRet
.append( "\"" );
4919 aRet
.append( aName
);
4920 aRet
.append( "\":" );
4921 return aRet
.makeStringAndClear();
4924 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */