LanguageTool: don't crash if REST protocol isn't set
[LibreOffice.git] / basic / source / classes / sbunoobj.cxx
blob9e1d31fb4ac1cc169d65599bcc3a54275a29693d
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
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>
82 #include <algorithm>
83 #include <math.h>
84 #include <memory>
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;
98 using namespace cppu;
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() )
120 bResult = true;
122 return bResult;
125 SbxVariable* getDefaultProp( SbxVariable* pRef )
127 SbxVariable* pDefaultProp = nullptr;
128 if ( pRef->GetType() == SbxOBJECT )
130 SbxObject* pObj = dynamic_cast<SbxObject*>(pRef);
131 if (!pObj)
133 SbxBase* pObjVarObj = pRef->GetObject();
134 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
136 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
138 pDefaultProp = pUnoObj->GetDfltProperty();
141 return pDefaultProp;
144 void SetSbUnoObjectDfltPropName( SbxObject* pObj )
146 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
147 if ( pUnoObj )
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
188 if( !xAccess.is() )
190 Reference< XComponentContext > xContext(
191 comphelper::getProcessComponentContext() );
192 if( xContext.is() )
194 xContext->getValueByName(
195 "/singletons/com.sun.star.reflection.theTypeDescriptionManager" )
196 >>= xAccess;
197 OSL_ENSURE( xAccess.is(), "### TypeDescriptionManager singleton not accessible!?" );
199 if( !xAccess.is() )
201 throw DeploymentException(
202 "/singletons/com.sun.star.reflection.theTypeDescriptionManager singleton not accessible" );
205 return xAccess;
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() );
218 if( xContext.is() )
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() );
238 if( xContext.is() )
240 Reference<XMultiComponentFactory> xSMgr = xContext->getServiceManager();
241 xFactory.set(
242 xSMgr->createInstanceWithContext( "com.sun.star.bridge.OleObjectFactory", xContext ),
243 UNO_QUERY );
245 return xFactory;
246 }();
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 );
267 return pUnoObj;
271 namespace
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" );
290 else
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!" );
312 if ( !e )
314 return OUString();
316 return implGetExceptionMsg( *e, _rCaughtException.getValueTypeName() );
319 static Any convertAny( const Any& rVal, const Type& aDestType )
321 Any aConvertedVal;
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 );
390 aExamine.clear();
391 break;
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:" );
400 // next round
401 aExamine = aWrapped.TargetException;
402 ++nLevel;
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 );
427 else
429 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( _rCaughtException ) );
433 namespace {
435 // NativeObjectWrapper handling
436 struct ObjectItem
438 SbxObjectRef m_xNativeObj;
440 explicit ObjectItem( SbxObject* pNativeObj )
441 : m_xNativeObj( pNativeObj )
447 typedef std::vector< ObjectItem > NativeObjectWrapperVector;
449 namespace {
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 );
464 return nIndex;
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;
483 switch( eType )
485 case TypeClass_INTERFACE:
486 case TypeClass_TYPE:
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 );
493 break;
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;
509 default: break;
511 return eRetType;
514 static SbxDataType unoToSbxType( const Reference< XIdlClass >& xIdlClass )
516 SbxDataType eRetType = SbxVOID;
517 if( xIdlClass.is() )
519 TypeClass eType = xIdlClass->getTypeClass();
520 eRetType = unoToSbxType( eType );
522 return eRetType;
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 )
549 ++dimCopy;
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();
559 if ( bIsZeroIndex )
560 pindices[ dimCopy - 1 ] = index;
561 else
562 pindices[ dimCopy - 1] = index + 1;
564 implSequenceToMultiDimArray( pArray, indices, sizes, aElementAny, dimCopy, bIsZeroIndex, &aElementType );
568 else
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 );
577 return;
580 SbxDataType eSbxElementType = unoToSbxType( pType ? pType->getTypeClass() : aValue.getValueTypeClass() );
581 if ( !pArray )
583 pArray = new SbxDimArray( eSbxElementType );
584 sal_Int32 nIndexLen = indices.getLength();
586 // Dimension the array
587 for ( sal_Int32 index = 0; index < nIndexLen; ++index )
589 if ( bIsZeroIndex )
590 pArray->unoAddDim(0, sizes[index] - 1);
591 else
592 pArray->unoAddDim(1, sizes[index]);
597 if ( pArray )
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();
613 switch( eTypeClass )
615 case TypeClass_TYPE:
617 // Map Type to IdlClass
618 Type aType_;
619 aValue >>= aType_;
620 Reference<XIdlClass> xClass = TypeToIdlClass( aType_ );
621 Any aClassAny;
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 );
633 else
635 pVar->PutObject( xWrapper.get() );
638 break;
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 )
646 ArrayWrapper aWrap;
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 );
654 if ( pArray )
656 SbxDimArrayRef xArray = pArray;
657 SbxFlagBits nFlags = pVar->GetFlags();
658 pVar->ResetFlag( SbxFlagBits::Fixed );
659 pVar->PutObject( xArray.get() );
660 pVar->SetFlags( nFlags );
662 else
663 pVar->PutEmpty();
664 break;
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 );
674 else
675 pVar->PutEmpty();
676 break;
678 else
680 SbiInstance* pInst = GetSbData()->pInst;
681 if( pInst && pInst->IsCompatibility() )
683 oleautomation::Date aDate;
684 if( aValue >>= aDate )
686 pVar->PutDate( aDate.Value );
687 break;
689 else
691 oleautomation::Decimal aDecimal;
692 if( aValue >>= aDecimal )
694 pVar->PutDecimal( aDecimal );
695 break;
697 else
699 oleautomation::Currency aCurrency;
700 if( aValue >>= aCurrency )
702 pVar->PutCurrency( aCurrency.Value );
703 break;
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 );
732 else
734 pVar->PutObject( xWrapper.get() );
737 break;
740 case TypeClass_ENUM:
742 sal_Int32 nEnum = 0;
743 enum2int( nEnum, aValue );
744 pVar->PutLong( nEnum );
746 break;
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 );
764 if( nLen > 0 )
766 xArray->unoAddDim(0, nLen - 1);
768 // register the elements as variables
769 for( i = 0 ; i < nLen ; i++ )
771 // convert elements
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);
780 else
782 xArray->unoAddDim(0, -1);
785 // return the Array
786 SbxFlagBits nFlags = pVar->GetFlags();
787 pVar->ResetFlag( SbxFlagBits::Fixed );
788 pVar->PutObject( xArray.get() );
789 pVar->SetFlags( nFlags );
792 break;
795 case TypeClass_BOOLEAN: pVar->PutBool( *o3tl::forceAccess<bool>(aValue) ); break;
796 case TypeClass_CHAR:
798 pVar->PutChar( *o3tl::forceAccess<sal_Unicode>(aValue) );
799 break;
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();
819 switch( eType )
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;
828 case SbxDATE: {
829 SbiInstance* pInst = GetSbData()->pInst;
830 if( pInst && pInst->IsCompatibility() )
831 aRetType = cppu::UnoType<double>::get();
832 else
833 aRetType = cppu::UnoType<oleautomation::Date>::get();
835 break;
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;
846 default: break;
848 return aRetType;
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();
855 if( !pVal )
856 return aRetType;
858 // convert SbxType to Uno
859 SbxDataType eBaseType = pVal->SbxValue::GetType();
860 if( eBaseType == SbxOBJECT )
862 SbxBaseRef xObj = pVal->GetObject();
863 if( !xObj.is() )
865 aRetType = cppu::UnoType<XInterface>::get();
866 return aRetType;
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() );
889 if( bNeedsInit )
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();
896 break;
898 aElementType = aType;
899 bNeedsInit = false;
901 else if( aElementType != aType )
903 // different types -> AnySequence
904 aElementType = cppu::UnoType<Any>::get();
905 break;
910 OUString aSeqTypeName = aSeqLevelStr + aElementType.getTypeName();
911 aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName );
913 // #i33795 Map also multi dimensional arrays to corresponding sequences
914 else if( nDims > 1 )
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() );
926 if( bNeedsInit )
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();
933 break;
935 aElementType = aType;
936 bNeedsInit = false;
938 else if( aElementType != aType )
940 // different types -> AnySequence
941 aElementType = cppu::UnoType<Any>::get();
942 break;
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() );
956 // No array, but ...
957 else if( auto obj = dynamic_cast<SbUnoObject*>( xObj.get() ) )
959 aRetType = obj->getUnoAny().getValueType();
961 // SbUnoAnyObject?
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
969 else
971 aRetType = getUnoTypeForSbxBaseType( eBaseType );
973 return aRetType;
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();
983 if( xObj.is() )
985 if( auto obj = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
986 return obj->getValue();
987 if( auto pClassModuleObj = dynamic_cast<SbClassModuleObject*>( xObj.get() ) )
989 Any aRetAny;
990 SbModule* pClassModule = pClassModuleObj->getClassModule();
991 if( pClassModule->createCOMWrapperForIface( aRetAny, pClassModuleObj ) )
992 return aRetAny;
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;
1003 Any aRetAny;
1004 aRetAny <<= aNativeObjectWrapper;
1005 return aRetAny;
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
1018 switch( eType )
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();
1033 break;
1035 case TypeClass_SHORT:
1037 sal_Int16 n = pVar->GetInteger();
1038 if( n >= -128 && n <= 127 )
1039 aType = ::cppu::UnoType<sal_Int8>::get();
1040 break;
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();
1049 break;
1051 case TypeClass_UNSIGNED_SHORT:
1053 sal_uInt16 n = pVar->GetUShort();
1054 if( n <= 255 )
1055 aType = cppu::UnoType<sal_uInt8>::get();
1056 break;
1058 case TypeClass_UNSIGNED_LONG:
1060 sal_uInt32 n = pVar->GetLong();
1061 if( n <= 255 )
1062 aType = cppu::UnoType<sal_uInt8>::get();
1063 else if( n <= SbxMAXUINT )
1064 aType = cppu::UnoType<cppu::UnoUnsignedShortType>::get();
1065 break;
1067 // TODO: need to add hyper types ?
1068 default: break;
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;
1083 sal_Int32 i;
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
1092 Any aRetVal;
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++ )
1107 Any aElementVal;
1109 if( nActualDim < nMaxDimIndex )
1111 aElementVal = implRekMultiDimArrayToSequence( pArray, aElemType,
1112 nMaxDimIndex, nActualDim + 1, pActualIndices, pLowerBounds, pUpperBounds );
1114 else
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 );
1135 return aRetVal;
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;
1155 aRet >>= xTypeDesc;
1157 if( xTypeDesc.is() )
1159 rRetType = Type( xTypeDesc->getTypeClass(), xTypeDesc->getName() );
1160 bSuccess = true;
1163 return bSuccess;
1167 // converting of Sbx to Uno with known target class
1168 Any sbxToUnoValue( const SbxValue* pVar, const Type& rType, Property const * pUnoProperty )
1170 Any aRetVal;
1172 // #94560 No conversion of empty/void for MAYBE_VOID properties
1173 if( pUnoProperty && pUnoProperty->Attributes & PropertyAttribute::MAYBEVOID )
1175 if( pVar->IsEmpty() )
1176 return aRetVal;
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();
1190 switch( eType )
1192 case TypeClass_INTERFACE:
1193 case TypeClass_STRUCT:
1194 case TypeClass_EXCEPTION:
1196 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
1198 // null reference?
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 );
1206 else
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;
1219 break;
1221 else if( rType == cppu::UnoType<oleautomation::Currency>::get())
1223 // assumes per previous code that ole Currency is Int64
1224 aRetVal <<= pVar->GetInt64();
1225 break;
1227 else if( rType == cppu::UnoType<oleautomation::Date>::get())
1229 oleautomation::Date aDate;
1230 aDate.Value = pVar->GetDate();
1231 aRetVal <<= aDate;
1232 break;
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();
1246 else
1248 // null object -> null XInterface
1249 Reference<XInterface> xInt;
1250 aRetVal <<= xInt;
1254 break;
1256 case TypeClass_TYPE:
1258 if( eBaseType == SbxOBJECT )
1260 // XIdlClass?
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 );
1274 aRetVal <<= aType;
1277 else if( eBaseType == SbxSTRING )
1279 OUString aTypeName = pVar->GetOUString();
1280 Type aType;
1281 bool bSuccess = implGetTypeByName( aTypeName, aType );
1282 if( bSuccess )
1284 aRetVal <<= aType;
1288 break;
1291 case TypeClass_ENUM:
1293 aRetVal = int2enum( pVar->GetLong(), rType );
1295 break;
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 );
1316 // Element-Type
1317 OUString aClassName = xIdlTargetClass->getName();
1318 typelib_TypeDescription * pSeqTD = nullptr;
1319 typelib_typedescription_getByName( &pSeqTD, aClassName.pData );
1320 assert( pSeqTD );
1321 Type aElemType( reinterpret_cast<typelib_IndirectTypeDescription *>(pSeqTD)->pType );
1323 // convert all array member and register them
1324 sal_Int32 aIdx[1];
1325 aIdx[0] = nLower;
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 )
1352 // Element-Type
1353 typelib_TypeDescription * pSeqTD = nullptr;
1354 Type aCurType( rType );
1355 sal_Int32 nSeqLevel = 0;
1356 Type aElemType;
1359 OUString aTypeName = aCurType.getTypeName();
1360 typelib_typedescription_getByName( &pSeqTD, aTypeName.pData );
1361 assert( pSeqTD );
1362 if( pSeqTD->eTypeClass == typelib_TypeClass_SEQUENCE )
1364 aCurType = Type( reinterpret_cast<typelib_IndirectTypeDescription *>(pSeqTD)->pType );
1365 nSeqLevel++;
1367 else
1369 aElemType = aCurType;
1370 break;
1373 while( true );
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() );
1396 break;
1399 // for Any use the class independent converting routine
1400 case TypeClass_ANY:
1402 aRetVal = sbxToUnoValueImpl( pVar );
1404 break;
1406 case TypeClass_BOOLEAN:
1408 aRetVal <<= pVar->GetBool();
1409 break;
1411 case TypeClass_CHAR:
1413 aRetVal <<= pVar->GetChar();
1414 break;
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;
1424 if( nVal < -128 )
1426 bOverflow = true;
1427 nVal = -128;
1429 else if( nVal > 255 ) // 128..255 map to -128..-1
1431 bOverflow = true;
1432 nVal = 127;
1434 if( bOverflow )
1435 StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
1437 sal_Int8 nByteVal = static_cast<sal_Int8>(nVal);
1438 aRetVal <<= nByteVal;
1439 break;
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;
1447 default: break;
1450 return aRetVal;
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();
1460 sal_uInt32 i = 0;
1461 if( pArgNamesArray )
1463 Sequence< OUString >& rNameSeq = pArgNamesArray->getNames();
1464 OUString* pNames = rNameSeq.getArray();
1465 Any aValAny;
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;
1481 else
1483 pAnyArgs[i] = aValAny;
1487 else
1489 for( i = 0 ; i < nParamCount ; i++ )
1491 pAnyArgs[i] = sbxToUnoValueImpl(pParams->Get(i + 1),
1492 bBlockConversionToSmallestType );
1498 namespace {
1500 enum class INVOKETYPE
1502 GetProp = 0,
1503 Func
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;
1513 Any aRetAny;
1514 switch( invokeType )
1516 case INVOKETYPE::Func:
1517 aRetAny = rxInvocation->invoke( Name, args, OutParamIndex, OutParam );
1518 break;
1519 case INVOKETYPE::GetProp:
1521 Reference< XAutomationInvocation > xAutoInv( rxInvocation, UNO_QUERY );
1522 aRetAny = xAutoInv->invokeGetProperty( Name, args, OutParamIndex, OutParam );
1523 break;
1525 default:
1526 assert(false); break;
1529 const sal_Int16* pIndices = OutParamIndex.getConstArray();
1530 sal_uInt32 nLen = OutParamIndex.getLength();
1531 if( nLen )
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) )
1538 break;
1539 unoToSbxValue(pParams->Get(j + 1), pNewValues[j]);
1542 return aRetAny;
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?
1564 else
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);
1589 if( xObj.is() )
1591 Reference< XServiceInfo > xServiceInfo( xObj, UNO_QUERY );
1592 if( xServiceInfo.is() )
1593 aName = xServiceInfo->getImplementationName();
1596 return aName;
1599 static OUString getDbgObjectName(SbUnoObject& rUnoObj)
1601 OUString aName = getDbgObjectNameImpl(rUnoObj);
1602 if( aName.isEmpty() )
1603 aName += "Unknown";
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 )
1618 if (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();
1629 return OUString();
1632 namespace {
1634 bool matchesBasicTypeName(
1635 css::uno::Reference<css::reflection::XIdlClass> const & unoType, OUString const & basicTypeName)
1637 if (unoType->getName().endsWithIgnoreAsciiCase(basicTypeName)) {
1638 return true;
1640 auto const sups = unoType->getSuperclasses();
1641 return std::any_of(
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() )
1656 return true;
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() )
1673 aClassName = ".";
1674 sal_Int32 nClassNameDot = rClass.lastIndexOf( '.' );
1675 if( nClassNameDot >= 0 )
1677 aClassName += OUString::Concat(rClass.subView( 0, nClassNameDot + 1 )) + "X" + rClass.subView( nClassNameDot + 1 );
1679 else
1681 aClassName += "X" + rClass;
1684 else // assume extended type declaration support for basic ( can't get here
1685 // otherwise.
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 );
1696 if( !xClass.is() )
1698 OSL_FAIL("failed to get XIdlClass for type");
1699 break;
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
1705 // matches
1706 Reference< XInvocation > xInv( aToInspectObj, UNO_QUERY );
1707 if ( xInv.is() )
1709 OUString sTypeName;
1710 xInv->getValue( "$GetTypeName" ) >>= sTypeName;
1711 if ( sTypeName.isEmpty() || sTypeName == "IDispatch" )
1713 // can't check type, leave it pass
1714 bResult = true;
1716 else
1718 bResult = sTypeName == rClass;
1721 break; // finished checking automation object
1724 if ( matchesBasicTypeName(xClass, aClassName) )
1726 bResult = true;
1727 break;
1731 return bResult;
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);
1742 if( !x )
1744 aRet.append( ID_DBG_SUPPORTEDINTERFACES );
1745 aRet.append( " not available.\n(TypeClass is not TypeClass_INTERFACE)\n" );
1747 else
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 );
1765 if( xClass.is() )
1767 aRet.append( Impl_GetInterfaceInfo( *x, xClass, 1 ) );
1769 else
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;
1789 switch( +eType )
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();
1838 if( !xAccess.is() )
1840 Reference< XInvocation > xInvok = rUnoObj.getInvocation();
1841 if( xInvok.is() )
1842 xAccess = xInvok->getIntrospection();
1844 if( !xAccess.is() )
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);
1860 if( pVar )
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() );
1880 bMaybeVoid = true;
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 ) );
1890 if( bMaybeVoid )
1891 aPropStr.append( "/void" );
1892 aPropStr.append( " " );
1893 aPropStr.append( pVar->GetName() );
1895 if( i == nPropCount - 1 )
1896 aPropStr.append( "\n" );
1897 else
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();
1915 if( !xAccess.is() )
1917 Reference< XInvocation > xInvok = rUnoObj.getInvocation();
1918 if( xInvok.is() )
1919 xAccess = xInvok->getIntrospection();
1921 if( !xAccess.is() )
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();
1932 if( !nMethodCount )
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);
1941 if( pVar )
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 ) );
1959 aRet.append( " " );
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( ", " );
1977 else
1978 aRet.append( "void" );
1980 aRet.append( " ) " );
1982 if( i == nMethodCount - 1 )
1983 aRet.append( "\n" );
1984 else
1985 aRet.append( "; " );
1988 return aRet.makeStringAndClear();
1992 // Implementation SbUnoObject
1993 void SbUnoObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
1995 if( bNeedIntrospection )
1996 doIntrospection();
1998 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
1999 if( !pHint )
2000 return;
2002 SbxVariable* pVar = pHint->GetVar();
2003 SbxArray* pParams = pVar->GetParameters();
2004 SbUnoProperty* pProp = dynamic_cast<SbUnoProperty*>( pVar );
2005 SbUnoMethod* pMeth = dynamic_cast<SbUnoMethod*>( pVar );
2006 if( pProp )
2008 bool bInvocation = pProp->isInvocationBased();
2009 if( pHint->GetId() == SfxHintId::BasicDataWanted )
2011 // Test-Properties
2012 sal_Int32 nId = pProp->nId;
2013 if( nId < 0 )
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
2025 implCreateAll();
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
2033 implCreateAll();
2034 OUString aRetStr = Impl_DumpMethods(*this);
2035 pVar->PutString( aRetStr );
2037 return;
2040 if( !bInvocation && mxUnoAccess.is() )
2044 if ( maStructInfo )
2046 StructRefInfo aMember = maStructInfo->getStructMember( pProp->GetName() );
2047 if ( aMember.isEmpty() )
2049 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
2051 else
2053 if ( pProp->isUnoStruct() )
2055 SbUnoStructRefObject* pSbUnoObject = new SbUnoStructRefObject( pProp->GetName(), aMember );
2056 SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
2057 pVar->PutObject( xWrapper.get() );
2059 else
2061 Any aRetAny = aMember.getValue();
2062 // take over the value from Uno to Sbx
2063 unoToSbxValue( pVar, aRetAny );
2065 return;
2068 // get the value
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() );
2089 Any aRetAny;
2090 if ( bCanBeConsideredAMethod && nParamCount )
2092 // Automation properties have methods, so... we need to invoke this through
2093 // XInvocation
2094 Sequence<Any> args;
2095 processAutomationParams( pParams, args, nParamCount );
2096 aRetAny = invokeAutomationMethod( pProp->GetName(), args, pParams, nParamCount, mxInvocation, INVOKETYPE::GetProp );
2098 else
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 );
2119 return;
2121 if ( maStructInfo )
2123 StructRefInfo aMember = maStructInfo->getStructMember( pProp->GetName() );
2124 if ( aMember.isEmpty() )
2126 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
2128 else
2130 Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
2131 aMember.setValue( aAnyValue );
2133 return;
2135 // take over the value from Uno to Sbx
2136 Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
2139 // set the value
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 );
2157 // set the value
2158 mxInvocation->setValue( pProp->GetName(), aAnyValue );
2160 catch( const Exception& )
2162 implHandleAnyException( ::cppu::getCaughtException() );
2167 else if( pMeth )
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;
2174 Sequence<Any> args;
2175 bool bOutParams = false;
2177 if( !bInvocation && mxUnoAccess.is() )
2179 // get info
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() )
2196 // Check types
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 )
2204 bError = true;
2205 StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL );
2208 if( !bError )
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.
2228 if( !bOutParams )
2230 ParamMode aParamMode = rInfo.aMode;
2231 if( aParamMode != ParamMode_IN )
2232 bOutParams = true;
2237 else if( bInvocation && pParams && mxInvocation.is() )
2239 processAutomationParams( pParams, args, nParamCount );
2242 // call the method
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?
2254 if( bOutParams )
2256 const Any* pAnyArgs = args.getConstArray();
2258 // get info
2259 const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
2260 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2262 sal_uInt32 j;
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()
2279 // for arrays
2280 if( pParams )
2281 pVar->SetParameters( nullptr );
2283 catch( const Exception& )
2285 implHandleAnyException( ::cppu::getCaughtException() );
2287 GetSbData()->bBlockCompilerError = false; // #106433 Unblock compiler errors
2290 else
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
2310 aUnoObj_ >>= x;
2311 if( !x.is() )
2312 return;
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;
2331 return;
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 )
2352 // Struct is Ok
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;
2369 if( bSetClassName )
2370 SetClassName( aClassName_ );
2372 // Neither interface nor Struct -> FatalError
2373 if( bFatalError )
2375 StarBASIC::FatalError( ERRCODE_BASIC_EXCEPTION );
2376 return;
2379 // pass the introspection primal on demand
2382 SbUnoObject::~SbUnoObject()
2387 // pass the introspection on Demand
2388 void SbUnoObject::doIntrospection()
2390 if( !bNeedIntrospection )
2391 return;
2393 Reference<XComponentContext> xContext = comphelper::getProcessComponentContext();
2395 if (!xContext.is())
2396 return;
2399 // get the introspection service
2400 Reference<XIntrospection> xIntrospection;
2404 xIntrospection = theIntrospection::get(xContext);
2406 catch ( const css::uno::DeploymentException& )
2410 if (!xIntrospection.is())
2411 return;
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)
2428 return;
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;
2445 while( pMeth )
2447 SbxObject* pObject = pMeth->GetParent();
2448 if ( pObject )
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;
2463 if( 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
2473 pMeth = pFirst;
2475 else
2476 pMeth = pMeth->pNext;
2478 else
2479 pMeth = pMeth->pNext;
2483 void clearUnoMethods()
2485 SbUnoMethod* pMeth = pFirst;
2486 while( pMeth )
2488 pMeth->SbxValue::Clear();
2489 pMeth = pMeth->pNext;
2494 SbUnoMethod::SbUnoMethod
2496 const OUString& aName_,
2497 SbxDataType eSbxType,
2498 Reference< XIdlMethod > const & xUnoMethod_,
2499 bool bInvocation
2501 : SbxMethod( aName_, eSbxType )
2502 , mbInvocation( bInvocation )
2504 m_xUnoMethod = xUnoMethod_;
2505 pParamInfoSeq = nullptr;
2507 // enregister the method in a list
2508 pNext = pFirst;
2509 pPrev = nullptr;
2510 pFirst = this;
2511 if( pNext )
2512 pNext->pPrev = this;
2515 SbUnoMethod::~SbUnoMethod()
2517 pParamInfoSeq.reset();
2519 if( this == pFirst )
2520 pFirst = pNext;
2521 else if( pPrev )
2522 pPrev->pNext = pNext;
2523 if( 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 );
2549 return pInfo.get();
2552 const Sequence<ParamInfo>& SbUnoMethod::getParamInfos()
2554 if (!pParamInfoSeq)
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_,
2570 sal_Int32 nId_,
2571 bool bInvocation,
2572 bool bUnoStruct
2574 : SbxProperty( aName_, eSbxType )
2575 , aUnoProp( aUnoProp_ )
2576 , nId( nId_ )
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 )
2599 doIntrospection();
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
2603 if( !pRes )
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;
2625 else
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() );
2632 pRes = 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
2649 if( !pRes )
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
2677 if( !pRes )
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();
2711 else
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
2726 if( !pRes )
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
2736 if( !pRes )
2738 if( rName.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES) ||
2739 rName.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES) ||
2740 rName.equalsIgnoreAsciiCase(ID_DBG_METHODS) )
2742 // Create
2743 implCreateDbgProperties();
2745 // Now they have to be found regular
2746 pRes = SbxObject::Find( rName, SbxClassType::DontCare );
2749 return pRes;
2753 // help method to create the dbg_-Properties
2754 void SbUnoObject::implCreateDbgProperties()
2756 Property aProp;
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 )
2786 return;
2788 if( !xAccess.is() )
2789 return;
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();
2796 sal_uInt32 i;
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;
2805 else
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();
2817 // Create methods
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++ )
2824 // address method
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() );
2835 // output the value
2836 Any SbUnoObject::getUnoAny()
2838 Any aRetAny;
2839 if( bNeedIntrospection ) doIntrospection();
2840 if ( maStructInfo )
2841 aRetAny = maTmpUnoObj;
2842 else if( mxMaterialHolder.is() )
2843 aRetAny = mxMaterialHolder->getMaterial();
2844 else if( mxInvocation.is() )
2845 aRetAny <<= mxInvocation;
2846 return aRetAny;
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() )
2855 return nullptr;
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 );
2863 if( !xClass.is() )
2864 return nullptr;
2866 // Is it really a struct?
2867 TypeClass eType = xClass->getTypeClass();
2868 if ( ( eType != TypeClass_STRUCT ) && ( eType != TypeClass_EXCEPTION ) )
2869 return nullptr;
2871 // create an instance
2872 Any aNewAny;
2873 xClass->createObject( aNewAny );
2874 // make a SbUnoObject out of it
2875 SbUnoObjectRef pUnoObj = new SbUnoObject( aClassName, aNewAny );
2876 return pUnoObj;
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
2884 return nullptr;
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 )
2903 if( !pObj )
2904 return;
2906 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
2907 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( pObj );
2908 if( pUnoObj )
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 );
2925 return;
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 );
2933 if( !xUnoObj.is() )
2935 return;
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 );
2948 return;
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() );
2976 else
2978 refVar->PutObject( nullptr );
2981 else
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 );
2993 return;
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() );
3025 else
3027 refVar->PutObject( nullptr );
3030 else
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();
3052 if( nParCount < 3 )
3054 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3055 return;
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 )
3067 return;
3069 Any aAny = obj->getUnoAny();
3070 auto x = o3tl::tryAccess<Reference<XInterface>>(aAny);
3071 if( !x )
3073 return;
3076 // get CoreReflection
3077 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
3078 if( !xCoreReflection.is() )
3080 return;
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 );
3089 if( !xClass.is() )
3091 return;
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() )
3098 return;
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 );
3112 return;
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() )
3123 return;
3125 SbxBaseRef pObj = xParam->GetObject();
3126 auto obj = dynamic_cast<SbUnoObject*>( pObj.get() );
3127 if( obj == nullptr )
3129 return;
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 );
3145 return;
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() )
3156 return;
3158 SbxBaseRef pObj1 = xParam1->GetObject();
3159 auto obj1 = dynamic_cast<SbUnoObject*>( pObj1.get() );
3160 if( obj1 == nullptr )
3162 return;
3164 Any aAny1 = obj1->getUnoAny();
3165 TypeClass eType1 = aAny1.getValueType().getTypeClass();
3166 if( eType1 != TypeClass_INTERFACE )
3168 return;
3170 Reference< XInterface > x1;
3171 aAny1 >>= x1;
3173 SbxVariableRef xParam2 = rPar.Get(2);
3174 if( !xParam2->IsObject() )
3176 return;
3178 SbxBaseRef pObj2 = xParam2->GetObject();
3179 auto obj2 = dynamic_cast<SbUnoObject*>( pObj2.get() );
3180 if( obj2 == nullptr )
3182 return;
3184 Any aAny2 = obj2->getUnoAny();
3185 TypeClass eType2 = aAny2.getValueType().getTypeClass();
3186 if( eType2 != TypeClass_INTERFACE )
3188 return;
3190 Reference< XInterface > x2;
3191 aAny2 >>= x2;
3193 if( x1 == 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*/ ) {}
3221 return xEnum;
3224 VBAConstantHelper&
3225 VBAConstantHelper::instance()
3227 static VBAConstantHelper aHelper;
3228 return aHelper;
3231 void VBAConstantHelper::init()
3233 if ( isInited )
3234 return;
3236 Reference< XTypeDescriptionEnumeration > xEnum = getTypeDescriptorEnumeration( "ooo.vba", {TypeClass_CONSTANTS}, TypeDescriptionSearchDepth_INFINITE );
3238 if ( !xEnum.is())
3240 return; //NULL;
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();
3271 isInited = true;
3274 bool
3275 VBAConstantHelper::isVBAConstantType( const OUString& rName )
3277 init();
3278 bool bConstant = false;
3280 for (auto const& elem : aConstCache)
3282 if( rName.equalsIgnoreAsciiCase(elem) )
3284 bConstant = true;
3285 break;
3288 return bConstant;
3291 SbxVariable*
3292 VBAConstantHelper::getVBAConstant( const OUString& rName )
3294 SbxVariable* pConst = nullptr;
3295 init();
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 );
3306 return pConst;
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;
3321 aRet >>= xTypeDesc;
3323 if( xTypeDesc.is() )
3325 TypeClass eTypeClass = xTypeDesc->getTypeClass();
3326 if( eTypeClass == TypeClass_MODULE || eTypeClass == TypeClass_CONSTANTS )
3328 pUnoClass = new SbUnoClass( rName );
3332 return pUnoClass;
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
3340 if( !pRes )
3342 // If it is already a class, ask for the field
3343 if( m_xClass.is() )
3345 // Is it a field(?)
3346 Reference< XIdlField > xField = m_xClass->getField( rName );
3347 if( xField.is() )
3351 Any aAny = xField->get( {} ); //TODO: does this make sense?
3353 // Convert to Sbx
3354 pRes = new SbxVariable( SbxVARIANT );
3355 pRes->SetName( rName );
3356 unoToSbxValue( pRes, aAny );
3358 catch( const Exception& )
3360 implHandleAnyException( ::cppu::getCaughtException() );
3364 else
3366 // expand fully qualified name
3367 OUString aNewName = GetName()
3368 + "."
3369 + rName;
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 );
3388 if( xClass.is() )
3390 pRes = new SbxVariable( SbxVARIANT );
3391 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoClass( aNewName, xClass ));
3392 pRes->PutObject( xWrapper.get() );
3395 else
3397 pRes = new SbxVariable( SbxVARIANT );
3398 unoToSbxValue( pRes, aValue );
3401 catch( const NoSuchElementException& )
3406 // Otherwise take it again as class
3407 if( !pRes )
3409 SbUnoClass* pNewClass = findUnoClass( aNewName );
3410 if( pNewClass )
3412 pRes = new SbxVariable( SbxVARIANT );
3413 SbxObjectRef xWrapper = static_cast<SbxObject*>(pNewClass);
3414 pRes->PutObject( xWrapper.get() );
3418 // A UNO service?
3419 if( !pRes )
3421 SbUnoService* pUnoService = findUnoService( aNewName );
3422 if( pUnoService )
3424 pRes = new SbxVariable( SbxVARIANT );
3425 SbxObjectRef xWrapper = static_cast<SbxObject*>(pUnoService);
3426 pRes->PutObject( xWrapper.get() );
3430 // A UNO singleton?
3431 if( !pRes )
3433 SbUnoSingleton* pUnoSingleton = findUnoSingleton( aNewName );
3434 if( pUnoSingleton )
3436 pRes = new SbxVariable( SbxVARIANT );
3437 SbxObjectRef xWrapper = static_cast<SbxObject*>(pUnoSingleton);
3438 pRes->PutObject( xWrapper.get() );
3444 if( pRes )
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 );
3457 return pRes;
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;
3470 aRet >>= 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 );
3490 if( !pRes )
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() )
3509 aName = "create";
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 );
3524 return pRes;
3527 void SbUnoService::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
3529 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
3530 if( !pHint )
3531 return;
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;
3540 Sequence<Any> args;
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];
3613 if( !xParam.is() )
3614 continue;
3616 Reference< XTypeDescription > xParamTypeDesc = xParam->getType();
3617 if( !xParamTypeDesc.is() )
3618 continue;
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() )
3626 bOutParams = true;
3628 else
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() );
3642 Any aRetAny;
3643 OUString aServiceName = GetName();
3644 Reference < XInterface > xRet;
3647 xRet = xServiceMgr->createInstanceWithArgumentsAndContext( aServiceName, args, xContext );
3649 catch( const Exception& )
3651 implHandleAnyException( ::cppu::getCaughtException() );
3653 aRetAny <<= xRet;
3654 unoToSbxValue( pVar, aRetAny );
3656 // Copy back out parameters?
3657 if( bOutParams )
3659 const Any* pAnyArgs = args.getConstArray();
3661 for( sal_uInt32 j = 0 ; j < nUnoParamCount ; j++ )
3663 Reference< XParameter > xParam = pParameterSeq[j];
3664 if( !xParam.is() )
3665 continue;
3667 if( xParam->isOut() )
3668 unoToSbxValue(pParams->Get(j + 1), pAnyArgs[j]);
3673 else
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()
3690 return nullptr;
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;
3703 aRet >>= 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);
3729 if( pHint )
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 );
3755 return;
3758 Any aRetAny;
3759 if( xContextToUse.is() )
3761 OUString aSingletonName = "/singletons/"
3762 + GetName();
3763 Reference < XInterface > xRet;
3764 xContextToUse->getValueByName( aSingletonName ) >>= xRet;
3765 aRetAny <<= xRet;
3767 unoToSbxValue( pVar, aRetAny );
3769 else
3771 SbxObject::Notify( rBC, rHint );
3775 namespace {
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);
3783 public:
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;
3808 if( !xSbxObj.is() )
3809 return;
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 );
3818 if( pLib )
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++ )
3826 // Convert elements
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
3835 if( pRet )
3837 SbxVariable* pVar = xSbxArray->Get(0);
3838 if( pVar )
3840 // #95792 Avoid a second call
3841 SbxFlagBits nFlags = pVar->GetFlags();
3842 pVar->SetFlag( SbxFlagBits::NoBroadcast );
3843 *pRet = sbxToUnoValueImpl( pVar );
3844 pVar->SetFlags( nFlags );
3847 break;
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 )
3861 Any aRetAny;
3862 firing_impl( Event, &aRetAny );
3863 return aRetAny;
3867 // Methods of XEventListener
3868 void BasicAllListener_Impl ::disposing(const EventObject& )
3870 SolarMutexGuard guard;
3872 xSbxObj.clear();
3876 // class InvocationToAllListenerMapper
3877 // helper class to map XInvocation to XAllListener (also in project eventattacher!)
3879 namespace {
3881 class InvocationToAllListenerMapper : public WeakImplHelper< XInvocation >
3883 public:
3884 InvocationToAllListenerMapper( const Reference< XIdlClass >& ListenerType,
3885 const Reference< XAllListener >& AllListener, const Any& Helper );
3887 // XInvocation
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;
3895 private:
3896 Reference< XAllListener > m_xAllListener;
3897 Reference< XIdlClass > m_xListenerType;
3898 Any m_Helper;
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,
3909 const Any& Helper
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} );
3920 return xAdapter;
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 >&)
3943 Any aRet;
3945 // Check if to firing or approveFiring has to be called
3946 Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( FunctionName );
3947 bool bApproveFiring = false;
3948 if( !xMethod.is() )
3949 return aRet;
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;
3957 else
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;
3969 break;
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 );
3983 else
3984 m_xAllListener->firing( aAllEvent );
3985 return aRet;
3989 void SAL_CALL InvocationToAllListenerMapper::setValue(const OUString&, const Any&)
3993 Any SAL_CALL InvocationToAllListenerMapper::getValue(const OUString&)
3995 return Any();
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 );
4009 return xField.is();
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 );
4022 return;
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() )
4032 return;
4034 // get the AllListenerAdapterService
4035 Reference< XComponentContext > xContext( comphelper::getProcessComponentContext() );
4037 // search the class
4038 Reference< XIdlClass > xClass = xCoreReflection->forName( aListenerClassName );
4039 if( !xClass.is() )
4040 return;
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 );
4047 Any aTmp;
4048 Reference< XInterface > xLst = createAllListenerAdapter( xInvocationAdapterFactory, xClass, xAllLst, aTmp );
4049 if( !xLst.is() )
4050 return;
4052 OUString aClassName = xClass->getName();
4053 Type aClassType( xClass->getTypeClass(), aClassName );
4054 aTmp = xLst->queryInterface( aClassType );
4055 if( !aTmp.hasValue() )
4056 return;
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 );
4093 return;
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 )
4110 // XIdlClass?
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();
4125 Type aType;
4126 bool bSuccess = implGetTypeByName( aValTypeName, aType );
4127 if( bSuccess )
4129 Any aTypeAny( aType );
4130 SbxVariableRef refVar = rPar.Get(0);
4131 SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aTypeAny );
4132 refVar->PutObject( xUnoAnyObject.get() );
4134 return;
4137 // Check the type
4138 const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
4139 Any aRet;
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" ) );
4148 return;
4150 Reference< XTypeDescription > xTypeDesc;
4151 aRet >>= xTypeDesc;
4152 TypeClass eTypeClass = xTypeDesc->getTypeClass();
4153 Type aDestType( eTypeClass, aTypeName );
4156 // Preconvert value
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() );
4165 namespace {
4167 class ModuleInvocationProxy : public WeakImplHelper< XInvocation, XComponent >
4169 ::osl::Mutex m_aMutex;
4170 OUString m_aPrefix;
4171 SbxObjectRef m_xScopeObj;
4172 bool m_bProxyIsClassModuleObject;
4174 ::comphelper::OInterfaceContainerHelper2 m_aListeners;
4176 public:
4177 ModuleInvocationProxy( std::u16string_view aPrefix, SbxObjectRef const & xScopeObj );
4179 // XInvocation
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;
4191 // XComponent
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 "
4220 + m_aPrefix
4221 + rProperty;
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);
4232 // Setup parameter
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 "
4258 + m_aPrefix
4259 + rProperty;
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);
4270 // Call method
4271 SbxVariableRef xValue = new SbxVariable;
4272 pMeth->Call( xValue.get() );
4273 Any aRet = sbxToUnoValue( xValue.get() );
4274 return aRet;
4277 sal_Bool SAL_CALL ModuleInvocationProxy::hasMethod( const OUString& )
4279 return false;
4282 sal_Bool SAL_CALL ModuleInvocationProxy::hasProperty( const OUString& )
4284 return false;
4287 Any SAL_CALL ModuleInvocationProxy::invoke( const OUString& rFunction,
4288 const Sequence< Any >& rParams,
4289 Sequence< sal_Int16 >&,
4290 Sequence< Any >& )
4292 SolarMutexGuard guard;
4294 Any aRet;
4295 SbxObjectRef xScopeObj = m_xScopeObj;
4296 if( !xScopeObj.is() )
4298 return aRet;
4300 OUString aFunctionName = m_aPrefix
4301 + rFunction;
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 );
4322 return aRet;
4325 // Setup parameters
4326 SbxArrayRef xArray;
4327 sal_Int32 nParamCount = rParams.getLength();
4328 if( nParamCount )
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));
4340 // Call method
4341 SbxVariableRef xValue = new SbxVariable;
4342 if( xArray.is() )
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?
4353 return aRet;
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",
4395 args, xContext );
4397 catch( const Exception& )
4399 implHandleAnyException( ::cppu::getCaughtException() );
4402 return xRet;
4405 typedef std::vector< WeakReference< XComponent > > ComponentRefVector;
4407 namespace {
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 );
4443 return 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() )
4464 return;
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();
4484 delete pItem;
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 ),
4501 UNO_QUERY
4503 if( !xComImplementsFactory.is() )
4504 return false;
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 );
4531 bSuccess = true;
4533 catch( const Exception& )
4535 implHandleAnyException( ::cppu::getCaughtException() );
4538 if( bSuccess )
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 );
4557 o_rRetAny <<= xRet;
4558 break;
4563 return bSuccess;
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 );
4580 if ( pMeth.is() )
4582 SbxValues aRes;
4583 pMeth->Get( aRes );
4584 pVal->Put( aRes );
4585 bSuccess = true;
4589 return bSuccess;
4592 Any StructRefInfo::getValue()
4594 Any aRet;
4595 uno_any_destruct(
4596 &aRet, reinterpret_cast< uno_ReleaseFunc >(cpp_release) );
4597 typelib_TypeDescription * pTD = nullptr;
4598 maType.getDescription(&pTD);
4599 uno_any_construct(
4600 &aRet, getInst(), pTD,
4601 reinterpret_cast< uno_AcquireFunc >(cpp_acquire) );
4602 typelib_typedescription_release(pTD);
4603 return aRet;
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 )
4646 return;
4647 typelib_TypeDescription * pTD = nullptr;
4648 maMemberInfo.getType().getDescription(&pTD);
4649 for ( typelib_CompoundTypeDescription * pCompTypeDescr = reinterpret_cast<typelib_CompoundTypeDescription *>(pTD);
4650 pCompTypeDescr;
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 );
4669 if ( !pRes )
4671 if ( !mbMemberCacheInit )
4672 initMemberCache();
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;
4679 Property aProp;
4680 aProp.Name = rName;
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();
4689 if( !pRes )
4691 if( rName.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES) ||
4692 rName.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES) ||
4693 rName.equalsIgnoreAsciiCase(ID_DBG_METHODS) )
4695 // Create
4696 implCreateDbgProperties();
4698 // Now they have to be found regular
4699 pRes = SbxObject::Find( rName, SbxClassType::DontCare );
4703 return pRes;
4706 // help method to create the dbg_-Properties
4707 void SbUnoStructRefObject::implCreateDbgProperties()
4709 Property aProp;
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)
4731 initMemberCache();
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;
4739 Property aProp;
4740 aProp.Name = rName;
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();
4751 // output the value
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);
4768 if( pVar )
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" );
4803 else
4805 aPropStr.append( "; " );
4807 aRet.append( aPropStr );
4810 return aRet.makeStringAndClear();
4813 void SbUnoStructRefObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
4815 if ( !mbMemberCacheInit )
4816 initMemberCache();
4817 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
4818 if( !pHint )
4819 return;
4821 SbxVariable* pVar = pHint->GetVar();
4822 SbUnoProperty* pProp = dynamic_cast<SbUnoProperty*>( pVar );
4823 if( pProp )
4825 StructFieldInfo::iterator it = maFields.find( pProp->GetName() );
4826 // handle get/set of members of struct
4827 if( pHint->GetId() == SfxHintId::BasicDataWanted )
4829 // Test-Properties
4830 sal_Int32 nId = pProp->nId;
4831 if( nId < 0 )
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
4845 implCreateAll();
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
4853 implCreateAll();
4854 OUString aRet = "Methods of object "
4855 + getDbgObjectName()
4856 + "\nNo methods found\n";
4857 pVar->PutString( aRet );
4859 return;
4862 if ( it != maFields.end() )
4864 Any aRetAny = it->second->getValue();
4865 unoToSbxValue( pVar, aRetAny );
4867 else
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 );
4878 else
4879 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
4882 else
4883 SbxObject::Notify( rBC, rHint );
4886 StructRefInfo SbUnoStructRefObject::getStructMember( const OUString& rMemberName )
4888 if (!mbMemberCacheInit)
4890 initMemberCache();
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 );
4903 return aRet;
4906 OUString SbUnoStructRefObject::getDbgObjectName() const
4908 OUString aName = GetClassName();
4909 if( aName.isEmpty() )
4911 aName += "Unknown";
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: */