?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Version 6.4.0.3, tag libreoffice-6.4.0.3
[LibreOffice.git] / basic / source / classes / sbunoobj.cxx
blob26aedddd3a40048fb3b8a40daa59de2233de52e3
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
3 * This file is part of the LibreOffice project.
4 *
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/.
8 *
9 * This file incorporates work covered by the following license notice:
10 *
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 .
18 */
19
20 #include <sal/config.h>
21
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>
27
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>
34
35 #include <rtl/instance.hxx>
36 #include <rtl/ustrbuf.hxx>
37
38 #include <com/sun/star/script/ArrayWrapper.hpp>
39 #include <com/sun/star/script/CannotConvertException.hpp>
40 #include <com/sun/star/script/NativeObjectWrapper.hpp>
41
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>
72
73 #include <rtlproto.hxx>
74
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>
81
82 #include <algorithm>
83 #include <math.h>
84 #include <memory>
85 #include <unordered_map>
86 #include <com/sun/star/reflection/XTypeDescriptionEnumerationAccess.hpp>
87 #include <com/sun/star/reflection/XConstantsTypeDescription.hpp>
88
89 using com::sun::star::uno::Reference;
90 using namespace com::sun::star::uno;
91 using namespace com::sun::star::lang;
92 using namespace com::sun::star::reflection;
93 using namespace com::sun::star::beans;
94 using namespace com::sun::star::script;
95 using namespace com::sun::star::container;
96 using namespace com::sun::star::bridge;
97 using namespace cppu;
98
99
100 // Identifiers for creating the strings for dbg_Properties
101 static char const ID_DBG_SUPPORTEDINTERFACES[] = "Dbg_SupportedInterfaces";
102 static char const ID_DBG_PROPERTIES[] = "Dbg_Properties";
103 static char const ID_DBG_METHODS[] = "Dbg_Methods";
104
105 static char const aSeqLevelStr[] = "[]";
106
107 // Gets the default property for a uno object. Note: There is some
108 // redirection built in. The property name specifies the name
109 // of the default property.
110
111 bool SbUnoObject::getDefaultPropName( SbUnoObject const * pUnoObj, OUString& sDfltProp )
112 {
113 bool bResult = false;
114 Reference< XDefaultProperty> xDefaultProp( pUnoObj->maTmpUnoObj, UNO_QUERY );
115 if ( xDefaultProp.is() )
116 {
117 sDfltProp = xDefaultProp->getDefaultPropertyName();
118 if ( !sDfltProp.isEmpty() )
119 bResult = true;
120 }
121 return bResult;
122 }
123
124 SbxVariable* getDefaultProp( SbxVariable* pRef )
125 {
126 SbxVariable* pDefaultProp = nullptr;
127 if ( pRef->GetType() == SbxOBJECT )
128 {
129 SbxObject* pObj = dynamic_cast<SbxObject*>(pRef);
130 if (!pObj)
131 {
132 SbxBase* pObjVarObj = pRef->GetObject();
133 pObj = dynamic_cast<SbxObject*>( pObjVarObj );
134 }
135 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
136 {
137 pDefaultProp = pUnoObj->GetDfltProperty();
138 }
139 }
140 return pDefaultProp;
141 }
142
143 void SetSbUnoObjectDfltPropName( SbxObject* pObj )
144 {
145 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
146 if ( pUnoObj )
147 {
148 OUString sDfltPropName;
149
150 if ( SbUnoObject::getDefaultPropName( pUnoObj, sDfltPropName ) )
151 {
152 pUnoObj->SetDfltProperty( sDfltPropName );
153 }
154 }
155 }
156
157 // save CoreReflection statically
158 static Reference< XIdlReflection > getCoreReflection_Impl()
159 {
160 return css::reflection::theCoreReflection::get(
161 comphelper::getProcessComponentContext());
162 }
163
164 // save CoreReflection statically
165 static Reference< XHierarchicalNameAccess > const & getCoreReflection_HierarchicalNameAccess_Impl()
166 {
167 static Reference< XHierarchicalNameAccess > xCoreReflection_HierarchicalNameAccess;
168
169 if( !xCoreReflection_HierarchicalNameAccess.is() )
170 {
171 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
172 if( xCoreReflection.is() )
173 {
174 xCoreReflection_HierarchicalNameAccess =
175 Reference< XHierarchicalNameAccess >( xCoreReflection, UNO_QUERY );
176 }
177 }
178 return xCoreReflection_HierarchicalNameAccess;
179 }
180
181 // Hold TypeProvider statically
182 static Reference< XHierarchicalNameAccess > const & getTypeProvider_Impl()
183 {
184 static Reference< XHierarchicalNameAccess > xAccess;
185
186 // Do we have already CoreReflection; if not obtain it
187 if( !xAccess.is() )
188 {
189 Reference< XComponentContext > xContext(
190 comphelper::getProcessComponentContext() );
191 if( xContext.is() )
192 {
193 xContext->getValueByName(
194 "/singletons/com.sun.star.reflection.theTypeDescriptionManager" )
195 >>= xAccess;
196 OSL_ENSURE( xAccess.is(), "### TypeDescriptionManager singleton not accessible!?" );
197 }
198 if( !xAccess.is() )
199 {
200 throw DeploymentException(
201 "/singletons/com.sun.star.reflection.theTypeDescriptionManager singleton not accessible" );
202 }
203 }
204 return xAccess;
205 }
206
207 // Hold TypeConverter statically
208 static Reference< XTypeConverter > const & getTypeConverter_Impl()
209 {
210 static Reference< XTypeConverter > xTypeConverter;
211
212 // Do we have already CoreReflection; if not obtain it
213 if( !xTypeConverter.is() )
214 {
215 Reference< XComponentContext > xContext(
216 comphelper::getProcessComponentContext() );
217 if( xContext.is() )
218 {
219 xTypeConverter = Converter::create(xContext);
220 }
221 if( !xTypeConverter.is() )
222 {
223 throw DeploymentException(
224 "com.sun.star.script.Converter service not accessible" );
225 }
226 }
227 return xTypeConverter;
228 }
229
230
231 // #111851 factory function to create an OLE object
232 SbUnoObject* createOLEObject_Impl( const OUString& aType )
233 {
234 static Reference< XMultiServiceFactory > xOLEFactory;
235 static bool bNeedsInit = true;
236
237 if( bNeedsInit )
238 {
239 bNeedsInit = false;
240
241 Reference< XComponentContext > xContext( comphelper::getProcessComponentContext() );
242 if( xContext.is() )
243 {
244 Reference<XMultiComponentFactory> xSMgr = xContext->getServiceManager();
245 xOLEFactory.set(
246 xSMgr->createInstanceWithContext( "com.sun.star.bridge.OleObjectFactory", xContext ),
247 UNO_QUERY );
248 }
249 }
250
251 SbUnoObject* pUnoObj = nullptr;
252 if( xOLEFactory.is() )
253 {
254 // some type names available in VBA can not be directly used in COM
255 OUString aOLEType = aType;
256 if ( aOLEType == "SAXXMLReader30" )
257 {
258 aOLEType = "Msxml2.SAXXMLReader.3.0";
259 }
260 Reference< XInterface > xOLEObject = xOLEFactory->createInstance( aOLEType );
261 if( xOLEObject.is() )
262 {
263 pUnoObj = new SbUnoObject( aType, Any(xOLEObject) );
264 OUString sDfltPropName;
265
266 if ( SbUnoObject::getDefaultPropName( pUnoObj, sDfltPropName ) )
267 pUnoObj->SetDfltProperty( sDfltPropName );
268 }
269 }
270 return pUnoObj;
271 }
272
273
274 namespace
275 {
276 void lcl_indent( OUStringBuffer& _inout_rBuffer, sal_Int32 _nLevel )
277 {
278 while ( _nLevel-- > 0 )
279 {
280 _inout_rBuffer.append( " " );
281 }
282 }
283 }
284
285 static void implAppendExceptionMsg( OUStringBuffer& _inout_rBuffer, const Exception& _e, const OUString& _rExceptionType, sal_Int32 _nLevel )
286 {
287 _inout_rBuffer.append( "\n" );
288 lcl_indent( _inout_rBuffer, _nLevel );
289 _inout_rBuffer.append( "Type: " );
290
291 if ( _rExceptionType.isEmpty() )
292 _inout_rBuffer.append( "Unknown" );
293 else
294 _inout_rBuffer.append( _rExceptionType );
295
296 _inout_rBuffer.append( "\n" );
297 lcl_indent( _inout_rBuffer, _nLevel );
298 _inout_rBuffer.append( "Message: " );
299 _inout_rBuffer.append( _e.Message );
300
301 }
302
303 // construct an error message for the exception
304 static OUString implGetExceptionMsg( const Exception& e, const OUString& aExceptionType_ )
305 {
306 OUStringBuffer aMessageBuf;
307 implAppendExceptionMsg( aMessageBuf, e, aExceptionType_, 0 );
308 return aMessageBuf.makeStringAndClear();
309 }
310
311 static OUString implGetExceptionMsg( const Any& _rCaughtException )
312 {
313 auto e = o3tl::tryAccess<Exception>(_rCaughtException);
314 OSL_PRECOND( e, "implGetExceptionMsg: illegal argument!" );
315 if ( !e )
316 {
317 return OUString();
318 }
319 return implGetExceptionMsg( *e, _rCaughtException.getValueTypeName() );
320 }
321
322 static Any convertAny( const Any& rVal, const Type& aDestType )
323 {
324 Any aConvertedVal;
325 const Reference< XTypeConverter >& xConverter = getTypeConverter_Impl();
326 try
327 {
328 aConvertedVal = xConverter->convertTo( rVal, aDestType );
329 }
330 catch( const IllegalArgumentException& )
331 {
332 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
333 implGetExceptionMsg( ::cppu::getCaughtException() ) );
334 return aConvertedVal;
335 }
336 catch( const CannotConvertException& e2 )
337 {
338 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
339 implGetExceptionMsg( e2, "com.sun.star.lang.IllegalArgumentException" ) );
340 return aConvertedVal;
341 }
342 return aConvertedVal;
343 }
344
345
346 // #105565 Special Object to wrap a strongly typed Uno Any
347
348
349 // TODO: source out later
350 static Reference<XIdlClass> TypeToIdlClass( const Type& rType )
351 {
352 return getCoreReflection_Impl()->forName(rType.getTypeName());
353 }
354
355 // Exception type unknown
356 template< class EXCEPTION >
357 static OUString implGetExceptionMsg( const EXCEPTION& e )
358 {
359 return implGetExceptionMsg( e, cppu::UnoType<decltype(e)>::get().getTypeName() );
360 }
361
362 static void implHandleBasicErrorException( BasicErrorException const & e )
363 {
364 ErrCode nError = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(e.ErrorCode) );
365 StarBASIC::Error( nError, e.ErrorMessageArgument );
366 }
367
368 static void implHandleWrappedTargetException( const Any& _rWrappedTargetException )
369 {
370 Any aExamine( _rWrappedTargetException );
371
372 // completely strip the first InvocationTargetException, its error message isn't of any
373 // interest to the user, it just says something like "invoking the UNO method went wrong.".
374 InvocationTargetException aInvocationError;
375 if ( aExamine >>= aInvocationError )
376 aExamine = aInvocationError.TargetException;
377
378 BasicErrorException aBasicError;
379
380 ErrCode nError( ERRCODE_BASIC_EXCEPTION );
381 OUStringBuffer aMessageBuf;
382
383 // strip any other WrappedTargetException instances, but this time preserve the error messages.
384 WrappedTargetException aWrapped;
385 sal_Int32 nLevel = 0;
386 while ( aExamine >>= aWrapped )
387 {
388 // special handling for BasicErrorException errors
389 if ( aWrapped.TargetException >>= aBasicError )
390 {
391 nError = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(aBasicError.ErrorCode) );
392 aMessageBuf.append( aBasicError.ErrorMessageArgument );
393 aExamine.clear();
394 break;
395 }
396
397 // append this round's message
398 implAppendExceptionMsg( aMessageBuf, aWrapped, aExamine.getValueTypeName(), nLevel );
399 if ( aWrapped.TargetException.getValueTypeClass() == TypeClass_EXCEPTION )
400 // there is a next chain element
401 aMessageBuf.append( "\nTargetException:" );
402
403 // next round
404 aExamine = aWrapped.TargetException;
405 ++nLevel;
406 }
407
408 if ( auto e = o3tl::tryAccess<Exception>(aExamine) )
409 {
410 // the last element in the chain is still an exception, but no WrappedTargetException
411 implAppendExceptionMsg( aMessageBuf, *e, aExamine.getValueTypeName(), nLevel );
412 }
413
414 StarBASIC::Error( nError, aMessageBuf.makeStringAndClear() );
415 }
416
417 static void implHandleAnyException( const Any& _rCaughtException )
418 {
419 BasicErrorException aBasicError;
420 WrappedTargetException aWrappedError;
421
422 if ( _rCaughtException >>= aBasicError )
423 {
424 implHandleBasicErrorException( aBasicError );
425 }
426 else if ( _rCaughtException >>= aWrappedError )
427 {
428 implHandleWrappedTargetException( _rCaughtException );
429 }
430 else
431 {
432 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( _rCaughtException ) );
433 }
434 }
435
436 // NativeObjectWrapper handling
437 struct ObjectItem
438 {
439 SbxObjectRef m_xNativeObj;
440
441 explicit ObjectItem( SbxObject* pNativeObj )
442 : m_xNativeObj( pNativeObj )
443 {}
444 };
445
446 typedef std::vector< ObjectItem > NativeObjectWrapperVector;
447 class GaNativeObjectWrapperVector : public rtl::Static<NativeObjectWrapperVector, GaNativeObjectWrapperVector> {};
448
449 void clearNativeObjectWrapperVector()
450 {
451 GaNativeObjectWrapperVector::get().clear();
452 }
453
454 static sal_uInt32 lcl_registerNativeObjectWrapper( SbxObject* pNativeObj )
455 {
456 NativeObjectWrapperVector &rNativeObjectWrapperVector = GaNativeObjectWrapperVector::get();
457 sal_uInt32 nIndex = rNativeObjectWrapperVector.size();
458 rNativeObjectWrapperVector.emplace_back( pNativeObj );
459 return nIndex;
460 }
461
462 static SbxObject* lcl_getNativeObject( sal_uInt32 nIndex )
463 {
464 SbxObjectRef xRetObj;
465 NativeObjectWrapperVector &rNativeObjectWrapperVector = GaNativeObjectWrapperVector::get();
466 if( nIndex < rNativeObjectWrapperVector.size() )
467 {
468 ObjectItem& rItem = rNativeObjectWrapperVector[ nIndex ];
469 xRetObj = rItem.m_xNativeObj;
470 }
471 return xRetObj.get();
472 }
473
474 // convert from Uno to Sbx
475 static SbxDataType unoToSbxType( TypeClass eType )
476 {
477 SbxDataType eRetType = SbxVOID;
478
479 switch( eType )
480 {
481 case TypeClass_INTERFACE:
482 case TypeClass_TYPE:
483 case TypeClass_STRUCT:
484 case TypeClass_EXCEPTION: eRetType = SbxOBJECT; break;
485
486 case TypeClass_ENUM: eRetType = SbxLONG; break;
487 case TypeClass_SEQUENCE:
488 eRetType = SbxDataType( SbxOBJECT | SbxARRAY );
489 break;
490
491
492 case TypeClass_ANY: eRetType = SbxVARIANT; break;
493 case TypeClass_BOOLEAN: eRetType = SbxBOOL; break;
494 case TypeClass_CHAR: eRetType = SbxCHAR; break;
495 case TypeClass_STRING: eRetType = SbxSTRING; break;
496 case TypeClass_FLOAT: eRetType = SbxSINGLE; break;
497 case TypeClass_DOUBLE: eRetType = SbxDOUBLE; break;
498 case TypeClass_BYTE: eRetType = SbxINTEGER; break;
499 case TypeClass_SHORT: eRetType = SbxINTEGER; break;
500 case TypeClass_LONG: eRetType = SbxLONG; break;
501 case TypeClass_HYPER: eRetType = SbxSALINT64; break;
502 case TypeClass_UNSIGNED_SHORT: eRetType = SbxUSHORT; break;
503 case TypeClass_UNSIGNED_LONG: eRetType = SbxULONG; break;
504 case TypeClass_UNSIGNED_HYPER: eRetType = SbxSALUINT64;break;
505 default: break;
506 }
507 return eRetType;
508 }
509
510 static SbxDataType unoToSbxType( const Reference< XIdlClass >& xIdlClass )
511 {
512 SbxDataType eRetType = SbxVOID;
513 if( xIdlClass.is() )
514 {
515 TypeClass eType = xIdlClass->getTypeClass();
516 eRetType = unoToSbxType( eType );
517 }
518 return eRetType;
519 }
520
521 static void implSequenceToMultiDimArray( SbxDimArray*& pArray, Sequence< sal_Int32 >& indices, Sequence< sal_Int32 >& sizes, const Any& aValue, sal_Int32 dimension, bool bIsZeroIndex, Type const * pType )
522 {
523 const Type& aType = aValue.getValueType();
524 TypeClass eTypeClass = aType.getTypeClass();
525
526 sal_Int32 dimCopy = dimension;
527
528 if ( eTypeClass == TypeClass_SEQUENCE )
529 {
530 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aType );
531 Reference< XIdlArray > xIdlArray = xIdlTargetClass->getArray();
532 typelib_TypeDescription * pTD = nullptr;
533 aType.getDescription( &pTD );
534 Type aElementType( reinterpret_cast<typelib_IndirectTypeDescription *>(pTD)->pType );
535 ::typelib_typedescription_release( pTD );
536
537 sal_Int32 nLen = xIdlArray->getLen( aValue );
538 for ( sal_Int32 index = 0; index < nLen; ++index )
539 {
540 Any aElementAny = xIdlArray->get( aValue, static_cast<sal_uInt32>(index) );
541 // This detects the dimension were currently processing
542 if ( dimCopy == dimension )
543 {
544 ++dimCopy;
545 if ( sizes.getLength() < dimCopy )
546 {
547 sizes.realloc( sizes.getLength() + 1 );
548 sizes[ sizes.getLength() - 1 ] = nLen;
549 indices.realloc( indices.getLength() + 1 );
550 }
551 }
552
553 if ( bIsZeroIndex )
554 indices[ dimCopy - 1 ] = index;
555 else
556 indices[ dimCopy - 1] = index + 1;
557
558 implSequenceToMultiDimArray( pArray, indices, sizes, aElementAny, dimCopy, bIsZeroIndex, &aElementType );
559 }
560
561 }
562 else
563 {
564 if ( !indices.hasElements() )
565 {
566 // Should never ever get here ( indices.getLength()
567 // should equal number of dimensions in the array )
568 // And that should at least be 1 !
569 // #QUESTION is there a better error?
570 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT );
571 return;
572 }
573
574 SbxDataType eSbxElementType = unoToSbxType( pType ? pType->getTypeClass() : aValue.getValueTypeClass() );
575 if ( !pArray )
576 {
577 pArray = new SbxDimArray( eSbxElementType );
578 sal_Int32 nIndexLen = indices.getLength();
579
580 // Dimension the array
581 for ( sal_Int32 index = 0; index < nIndexLen; ++index )
582 {
583 if ( bIsZeroIndex )
584 pArray->unoAddDim32( 0, sizes[ index ] - 1);
585 else
586 pArray->unoAddDim32( 1, sizes[ index ] );
587
588 }
589 }
590
591 if ( pArray )
592 {
593 auto xVar = tools::make_ref<SbxVariable>( eSbxElementType );
594 unoToSbxValue( xVar.get(), aValue );
595
596 sal_Int32* pIndices = indices.getArray();
597 pArray->Put32( xVar.get(), pIndices );
598
599 }
600 }
601 }
602
603 void unoToSbxValue( SbxVariable* pVar, const Any& aValue )
604 {
605 const Type& aType = aValue.getValueType();
606 TypeClass eTypeClass = aType.getTypeClass();
607 switch( eTypeClass )
608 {
609 case TypeClass_TYPE:
610 {
611 // Map Type to IdlClass
612 Type aType_;
613 aValue >>= aType_;
614 Reference<XIdlClass> xClass = TypeToIdlClass( aType_ );
615 Any aClassAny;
616 aClassAny <<= xClass;
617
618 // instantiate SbUnoObject
619 SbUnoObject* pSbUnoObject = new SbUnoObject( OUString(), aClassAny );
620 SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
621
622 // If the object is invalid deliver null
623 if( !pSbUnoObject->getUnoAny().hasValue() )
624 {
625 pVar->PutObject( nullptr );
626 }
627 else
628 {
629 pVar->PutObject( xWrapper.get() );
630 }
631 }
632 break;
633 // Interfaces and Structs must be wrapped in a SbUnoObject
634 case TypeClass_INTERFACE:
635 case TypeClass_STRUCT:
636 case TypeClass_EXCEPTION:
637 {
638 if( eTypeClass == TypeClass_STRUCT )
639 {
640 ArrayWrapper aWrap;
641 NativeObjectWrapper aNativeObjectWrapper;
642 if ( aValue >>= aWrap )
643 {
644 SbxDimArray* pArray = nullptr;
645 Sequence< sal_Int32 > indices;
646 Sequence< sal_Int32 > sizes;
647 implSequenceToMultiDimArray( pArray, indices, sizes, aWrap.Array, /*dimension*/0, aWrap.IsZeroIndex, nullptr );
648 if ( pArray )
649 {
650 SbxDimArrayRef xArray = pArray;
651 SbxFlagBits nFlags = pVar->GetFlags();
652 pVar->ResetFlag( SbxFlagBits::Fixed );
653 pVar->PutObject( xArray.get() );
654 pVar->SetFlags( nFlags );
655 }
656 else
657 pVar->PutEmpty();
658 break;
659 }
660 else if ( aValue >>= aNativeObjectWrapper )
661 {
662 sal_uInt32 nIndex = 0;
663 if( aNativeObjectWrapper.ObjectId >>= nIndex )
664 {
665 SbxObject* pObj = lcl_getNativeObject( nIndex );
666 pVar->PutObject( pObj );
667 }
668 else
669 pVar->PutEmpty();
670 break;
671 }
672 else
673 {
674 SbiInstance* pInst = GetSbData()->pInst;
675 if( pInst && pInst->IsCompatibility() )
676 {
677 oleautomation::Date aDate;
678 if( aValue >>= aDate )
679 {
680 pVar->PutDate( aDate.Value );
681 break;
682 }
683 else
684 {
685 oleautomation::Decimal aDecimal;
686 if( aValue >>= aDecimal )
687 {
688 pVar->PutDecimal( aDecimal );
689 break;
690 }
691 else
692 {
693 oleautomation::Currency aCurrency;
694 if( aValue >>= aCurrency )
695 {
696 pVar->PutCurrency( aCurrency.Value );
697 break;
698 }
699 }
700 }
701 }
702 }
703 }
704 // instantiate a SbUnoObject
705 SbUnoObject* pSbUnoObject = new SbUnoObject( OUString(), aValue );
706 //If this is called externally e.g. from the scripting
707 //framework then there is no 'active' runtime the default property will not be set up
708 //only a vba object will have XDefaultProp set anyway so... this
709 //test seems a bit of overkill
710 //if ( SbiRuntime::isVBAEnabled() )
711 {
712 OUString sDfltPropName;
713
714 if ( SbUnoObject::getDefaultPropName( pSbUnoObject, sDfltPropName ) )
715 {
716 pSbUnoObject->SetDfltProperty( sDfltPropName );
717 }
718 }
719 SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
720
721 // If the object is invalid deliver null
722 if( !pSbUnoObject->getUnoAny().hasValue() )
723 {
724 pVar->PutObject( nullptr );
725 }
726 else
727 {
728 pVar->PutObject( xWrapper.get() );
729 }
730 }
731 break;
732
733
734 case TypeClass_ENUM:
735 {
736 sal_Int32 nEnum = 0;
737 enum2int( nEnum, aValue );
738 pVar->PutLong( nEnum );
739 }
740 break;
741
742 case TypeClass_SEQUENCE:
743 {
744 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aType );
745 Reference< XIdlArray > xIdlArray = xIdlTargetClass->getArray();
746 sal_Int32 i, nLen = xIdlArray->getLen( aValue );
747
748 typelib_TypeDescription * pTD = nullptr;
749 aType.getDescription( &pTD );
750 OSL_ASSERT( pTD && pTD->eTypeClass == typelib_TypeClass_SEQUENCE );
751 Type aElementType( reinterpret_cast<typelib_IndirectTypeDescription *>(pTD)->pType );
752 ::typelib_typedescription_release( pTD );
753
754 // build an Array in Basic
755 SbxDimArrayRef xArray;
756 SbxDataType eSbxElementType = unoToSbxType( aElementType.getTypeClass() );
757 xArray = new SbxDimArray( eSbxElementType );
758 if( nLen > 0 )
759 {
760 xArray->unoAddDim32( 0, nLen - 1 );
761
762 // register the elements as variables
763 for( i = 0 ; i < nLen ; i++ )
764 {
765 // convert elements
766 Any aElementAny = xIdlArray->get( aValue, static_cast<sal_uInt32>(i) );
767 auto xVar = tools::make_ref<SbxVariable>( eSbxElementType );
768 unoToSbxValue( xVar.get(), aElementAny );
769
770 // put into the Array
771 xArray->Put32( xVar.get(), &i );
772 }
773 }
774 else
775 {
776 xArray->unoAddDim( 0, -1 );
777 }
778
779 // return the Array
780 SbxFlagBits nFlags = pVar->GetFlags();
781 pVar->ResetFlag( SbxFlagBits::Fixed );
782 pVar->PutObject( xArray.get() );
783 pVar->SetFlags( nFlags );
784
785 }
786 break;
787
788
789 case TypeClass_BOOLEAN: pVar->PutBool( *o3tl::forceAccess<bool>(aValue) ); break;
790 case TypeClass_CHAR:
791 {
792 pVar->PutChar( *o3tl::forceAccess<sal_Unicode>(aValue) );
793 break;
794 }
795 case TypeClass_STRING: { OUString val; aValue >>= val; pVar->PutString( val ); } break;
796 case TypeClass_FLOAT: { float val = 0; aValue >>= val; pVar->PutSingle( val ); } break;
797 case TypeClass_DOUBLE: { double val = 0; aValue >>= val; pVar->PutDouble( val ); } break;
798 case TypeClass_BYTE: { sal_Int8 val = 0; aValue >>= val; pVar->PutInteger( val ); } break;
799 case TypeClass_SHORT: { sal_Int16 val = 0; aValue >>= val; pVar->PutInteger( val ); } break;
800 case TypeClass_LONG: { sal_Int32 val = 0; aValue >>= val; pVar->PutLong( val ); } break;
801 case TypeClass_HYPER: { sal_Int64 val = 0; aValue >>= val; pVar->PutInt64( val ); } break;
802 case TypeClass_UNSIGNED_SHORT: { sal_uInt16 val = 0; aValue >>= val; pVar->PutUShort( val ); } break;
803 case TypeClass_UNSIGNED_LONG: { sal_uInt32 val = 0; aValue >>= val; pVar->PutULong( val ); } break;
804 case TypeClass_UNSIGNED_HYPER: { sal_uInt64 val = 0; aValue >>= val; pVar->PutUInt64( val ); } break;
805 default: pVar->PutEmpty(); break;
806 }
807 }
808
809 // Deliver the reflection for Sbx types
810 static Type getUnoTypeForSbxBaseType( SbxDataType eType )
811 {
812 Type aRetType = cppu::UnoType<void>::get();
813 switch( eType )
814 {
815 case SbxNULL: aRetType = cppu::UnoType<XInterface>::get(); break;
816 case SbxINTEGER: aRetType = cppu::UnoType<sal_Int16>::get(); break;
817 case SbxLONG: aRetType = cppu::UnoType<sal_Int32>::get(); break;
818 case SbxSINGLE: aRetType = cppu::UnoType<float>::get(); break;
819 case SbxDOUBLE: aRetType = cppu::UnoType<double>::get(); break;
820 case SbxCURRENCY: aRetType = cppu::UnoType<oleautomation::Currency>::get(); break;
821 case SbxDECIMAL: aRetType = cppu::UnoType<oleautomation::Decimal>::get(); break;
822 case SbxDATE: {
823 SbiInstance* pInst = GetSbData()->pInst;
824 if( pInst && pInst->IsCompatibility() )
825 aRetType = cppu::UnoType<double>::get();
826 else
827 aRetType = cppu::UnoType<oleautomation::Date>::get();
828 }
829 break;
830 case SbxSTRING: aRetType = cppu::UnoType<OUString>::get(); break;
831 case SbxBOOL: aRetType = cppu::UnoType<sal_Bool>::get(); break;
832 case SbxVARIANT: aRetType = cppu::UnoType<Any>::get(); break;
833 case SbxCHAR: aRetType = cppu::UnoType<cppu::UnoCharType>::get(); break;
834 case SbxBYTE: aRetType = cppu::UnoType<sal_Int8>::get(); break;
835 case SbxUSHORT: aRetType = cppu::UnoType<cppu::UnoUnsignedShortType>::get(); break;
836 case SbxULONG: aRetType = ::cppu::UnoType<sal_uInt32>::get(); break;
837 // map machine-dependent ones to long for consistency
838 case SbxINT: aRetType = ::cppu::UnoType<sal_Int32>::get(); break;
839 case SbxUINT: aRetType = ::cppu::UnoType<sal_uInt32>::get(); break;
840 default: break;
841 }
842 return aRetType;
843 }
844
845 // Converting of Sbx to Uno without a know target class for TypeClass_ANY
846 static Type getUnoTypeForSbxValue( const SbxValue* pVal )
847 {
848 Type aRetType = cppu::UnoType<void>::get();
849 if( !pVal )
850 return aRetType;
851
852 // convert SbxType to Uno
853 SbxDataType eBaseType = pVal->SbxValue::GetType();
854 if( eBaseType == SbxOBJECT )
855 {
856 SbxBaseRef xObj = pVal->GetObject();
857 if( !xObj.is() )
858 {
859 aRetType = cppu::UnoType<XInterface>::get();
860 return aRetType;
861 }
862
863 if( auto pArray = dynamic_cast<SbxDimArray*>( xObj.get() ) )
864 {
865 short nDims = pArray->GetDims();
866 Type aElementType = getUnoTypeForSbxBaseType( static_cast<SbxDataType>(pArray->GetType() & 0xfff) );
867 TypeClass eElementTypeClass = aElementType.getTypeClass();
868
869 // Normal case: One dimensional array
870 sal_Int32 nLower, nUpper;
871 if( nDims == 1 && pArray->GetDim32( 1, nLower, nUpper ) )
872 {
873 if( eElementTypeClass == TypeClass_VOID || eElementTypeClass == TypeClass_ANY )
874 {
875 // If all elements of the arrays are from the same type, take
876 // this one - otherwise the whole will be considered as Any-Sequence
877 bool bNeedsInit = true;
878
879 for (sal_Int32 aIdx[1] = { nLower }; aIdx[0] <= nUpper; ++aIdx[0])
880 {
881 SbxVariableRef xVar = pArray->Get32(aIdx);
882 Type aType = getUnoTypeForSbxValue( xVar.get() );
883 if( bNeedsInit )
884 {
885 if( aType.getTypeClass() == TypeClass_VOID )
886 {
887 // if only first element is void: different types -> []any
888 // if all elements are void: []void is not allowed -> []any
889 aElementType = cppu::UnoType<Any>::get();
890 break;
891 }
892 aElementType = aType;
893 bNeedsInit = false;
894 }
895 else if( aElementType != aType )
896 {
897 // different types -> AnySequence
898 aElementType = cppu::UnoType<Any>::get();
899 break;
900 }
901 }
902 }
903
904 OUString aSeqTypeName = aSeqLevelStr + aElementType.getTypeName();
905 aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName );
906 }
907 // #i33795 Map also multi dimensional arrays to corresponding sequences
908 else if( nDims > 1 )
909 {
910 if( eElementTypeClass == TypeClass_VOID || eElementTypeClass == TypeClass_ANY )
911 {
912 // For this check the array's dim structure does not matter
913 sal_uInt32 nFlatArraySize = pArray->Count32();
914
915 bool bNeedsInit = true;
916 for( sal_uInt32 i = 0 ; i < nFlatArraySize ; i++ )
917 {
918 SbxVariableRef xVar = pArray->SbxArray::Get32( i );
919 Type aType = getUnoTypeForSbxValue( xVar.get() );
920 if( bNeedsInit )
921 {
922 if( aType.getTypeClass() == TypeClass_VOID )
923 {
924 // if only first element is void: different types -> []any
925 // if all elements are void: []void is not allowed -> []any
926 aElementType = cppu::UnoType<Any>::get();
927 break;
928 }
929 aElementType = aType;
930 bNeedsInit = false;
931 }
932 else if( aElementType != aType )
933 {
934 // different types -> AnySequence
935 aElementType = cppu::UnoType<Any>::get();
936 break;
937 }
938 }
939 }
940
941 OUStringBuffer aSeqTypeName;
942 for( short iDim = 0 ; iDim < nDims ; iDim++ )
943 {
944 aSeqTypeName.append(aSeqLevelStr);
945 }
946 aSeqTypeName.append(aElementType.getTypeName());
947 aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName.makeStringAndClear() );
948 }
949 }
950 // No array, but ...
951 else if( auto obj = dynamic_cast<SbUnoObject*>( xObj.get() ) )
952 {
953 aRetType = obj->getUnoAny().getValueType();
954 }
955 // SbUnoAnyObject?
956 else if( auto any = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
957 {
958 aRetType = any->getValue().getValueType();
959 }
960 // Otherwise it is a No-Uno-Basic-Object -> default==deliver void
961 }
962 // No object, convert basic type
963 else
964 {
965 aRetType = getUnoTypeForSbxBaseType( eBaseType );
966 }
967 return aRetType;
968 }
969
970 // converting of Sbx to Uno without known target class for TypeClass_ANY
971 static Any sbxToUnoValueImpl( const SbxValue* pVar, bool bBlockConversionToSmallestType = false )
972 {
973 SbxDataType eBaseType = pVar->SbxValue::GetType();
974 if( eBaseType == SbxOBJECT )
975 {
976 SbxBaseRef xObj = pVar->GetObject();
977 if( xObj.is() )
978 {
979 if( auto obj = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
980 return obj->getValue();
981 if( auto pClassModuleObj = dynamic_cast<SbClassModuleObject*>( xObj.get() ) )
982 {
983 Any aRetAny;
984 SbModule* pClassModule = pClassModuleObj->getClassModule();
985 if( pClassModule->createCOMWrapperForIface( aRetAny, pClassModuleObj ) )
986 return aRetAny;
987 }
988 if( dynamic_cast<const SbUnoObject*>( xObj.get() ) == nullptr )
989 {
990 // Create NativeObjectWrapper to identify object in case of callbacks
991 SbxObject* pObj = dynamic_cast<SbxObject*>( pVar->GetObject() );
992 if( pObj != nullptr )
993 {
994 NativeObjectWrapper aNativeObjectWrapper;
995 sal_uInt32 nIndex = lcl_registerNativeObjectWrapper( pObj );
996 aNativeObjectWrapper.ObjectId <<= nIndex;
997 Any aRetAny;
998 aRetAny <<= aNativeObjectWrapper;
999 return aRetAny;
1000 }
1001 }
1002 }
1003 }
1004
1005 Type aType = getUnoTypeForSbxValue( pVar );
1006 TypeClass eType = aType.getTypeClass();
1007
1008 if( !bBlockConversionToSmallestType )
1009 {
1010 // #79615 Choose "smallest" representation for int values
1011 // because up cast is allowed, downcast not
1012 switch( eType )
1013 {
1014 case TypeClass_FLOAT:
1015 case TypeClass_DOUBLE:
1016 {
1017 double d = pVar->GetDouble();
1018 if( rtl::math::approxEqual(d, floor( d )) )
1019 {
1020 if( d >= -128 && d <= 127 )
1021 aType = ::cppu::UnoType<sal_Int8>::get();
1022 else if( d >= SbxMININT && d <= SbxMAXINT )
1023 aType = ::cppu::UnoType<sal_Int16>::get();
1024 else if( d >= -SbxMAXLNG && d <= SbxMAXLNG )
1025 aType = ::cppu::UnoType<sal_Int32>::get();
1026 }
1027 break;
1028 }
1029 case TypeClass_SHORT:
1030 {
1031 sal_Int16 n = pVar->GetInteger();
1032 if( n >= -128 && n <= 127 )
1033 aType = ::cppu::UnoType<sal_Int8>::get();
1034 break;
1035 }
1036 case TypeClass_LONG:
1037 {
1038 sal_Int32 n = pVar->GetLong();
1039 if( n >= -128 && n <= 127 )
1040 aType = ::cppu::UnoType<sal_Int8>::get();
1041 else if( n >= SbxMININT && n <= SbxMAXINT )
1042 aType = ::cppu::UnoType<sal_Int16>::get();
1043 break;
1044 }
1045 case TypeClass_UNSIGNED_SHORT:
1046 {
1047 sal_uInt16 n = pVar->GetUShort();
1048 if( n <= 255 )
1049 aType = cppu::UnoType<sal_uInt8>::get();
1050 break;
1051 }
1052 case TypeClass_UNSIGNED_LONG:
1053 {
1054 sal_uInt32 n = pVar->GetLong();
1055 if( n <= 255 )
1056 aType = cppu::UnoType<sal_uInt8>::get();
1057 else if( n <= SbxMAXUINT )
1058 aType = cppu::UnoType<cppu::UnoUnsignedShortType>::get();
1059 break;
1060 }
1061 // TODO: need to add hyper types ?
1062 default: break;
1063 }
1064 }
1065
1066 return sbxToUnoValue( pVar, aType );
1067 }
1068
1069
1070 // Helper function for StepREDIMP
1071 static Any implRekMultiDimArrayToSequence( SbxDimArray* pArray,
1072 const Type& aElemType, short nMaxDimIndex, short nActualDim,
1073 sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
1074 {
1075 sal_Int32 nSeqLevel = nMaxDimIndex - nActualDim + 1;
1076 OUStringBuffer aSeqTypeName;
1077 sal_Int32 i;
1078 for( i = 0 ; i < nSeqLevel ; i++ )
1079 {
1080 aSeqTypeName.append(aSeqLevelStr);
1081 }
1082 aSeqTypeName.append(aElemType.getTypeName());
1083 Type aSeqType( TypeClass_SEQUENCE, aSeqTypeName.makeStringAndClear() );
1084
1085 // Create Sequence instance
1086 Any aRetVal;
1087 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aSeqType );
1088 xIdlTargetClass->createObject( aRetVal );
1089
1090 // Alloc sequence according to array bounds
1091 sal_Int32 nUpper = pUpperBounds[nActualDim];
1092 sal_Int32 nLower = pLowerBounds[nActualDim];
1093 sal_Int32 nSeqSize = nUpper - nLower + 1;
1094 Reference< XIdlArray > xArray = xIdlTargetClass->getArray();
1095 xArray->realloc( aRetVal, nSeqSize );
1096
1097 sal_Int32& ri = pActualIndices[nActualDim];
1098
1099 for( ri = nLower,i = 0 ; ri <= nUpper ; ri++,i++ )
1100 {
1101 Any aElementVal;
1102
1103 if( nActualDim < nMaxDimIndex )
1104 {
1105 aElementVal = implRekMultiDimArrayToSequence( pArray, aElemType,
1106 nMaxDimIndex, nActualDim + 1, pActualIndices, pLowerBounds, pUpperBounds );
1107 }
1108 else
1109 {
1110 SbxVariable* pSource = pArray->Get32( pActualIndices );
1111 aElementVal = sbxToUnoValue( pSource, aElemType );
1112 }
1113
1114 try
1115 {
1116 // transfer to the sequence
1117 xArray->set( aRetVal, i, aElementVal );
1118 }
1119 catch( const IllegalArgumentException& )
1120 {
1121 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
1122 implGetExceptionMsg( ::cppu::getCaughtException() ) );
1123 }
1124 catch (const IndexOutOfBoundsException&)
1125 {
1126 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
1127 }
1128 }
1129 return aRetVal;
1130 }
1131
1132 // Map old interface
1133 Any sbxToUnoValue( const SbxValue* pVar )
1134 {
1135 return sbxToUnoValueImpl( pVar );
1136 }
1137
1138 // function to find a global identifier in
1139 // the UnoScope and to wrap it for Sbx
1140 static bool implGetTypeByName( const OUString& rName, Type& rRetType )
1141 {
1142 bool bSuccess = false;
1143
1144 const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
1145 if( xTypeAccess->hasByHierarchicalName( rName ) )
1146 {
1147 Any aRet = xTypeAccess->getByHierarchicalName( rName );
1148 Reference< XTypeDescription > xTypeDesc;
1149 aRet >>= xTypeDesc;
1150
1151 if( xTypeDesc.is() )
1152 {
1153 rRetType = Type( xTypeDesc->getTypeClass(), xTypeDesc->getName() );
1154 bSuccess = true;
1155 }
1156 }
1157 return bSuccess;
1158 }
1159
1160
1161 // converting of Sbx to Uno with known target class
1162 Any sbxToUnoValue( const SbxValue* pVar, const Type& rType, Property const * pUnoProperty )
1163 {
1164 Any aRetVal;
1165
1166 // #94560 No conversion of empty/void for MAYBE_VOID properties
1167 if( pUnoProperty && pUnoProperty->Attributes & PropertyAttribute::MAYBEVOID )
1168 {
1169 if( pVar->IsEmpty() )
1170 return aRetVal;
1171 }
1172
1173 SbxDataType eBaseType = pVar->SbxValue::GetType();
1174 if( eBaseType == SbxOBJECT )
1175 {
1176 SbxBaseRef xObj = pVar->GetObject();
1177 if ( auto obj = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
1178 {
1179 return obj->getValue();
1180 }
1181 }
1182
1183 TypeClass eType = rType.getTypeClass();
1184 switch( eType )
1185 {
1186 case TypeClass_INTERFACE:
1187 case TypeClass_STRUCT:
1188 case TypeClass_EXCEPTION:
1189 {
1190 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
1191
1192 // null reference?
1193 if( pVar->IsNull() && eType == TypeClass_INTERFACE )
1194 {
1195 Reference< XInterface > xRef;
1196 OUString aClassName = xIdlTargetClass->getName();
1197 Type aClassType( xIdlTargetClass->getTypeClass(), aClassName );
1198 aRetVal.setValue( &xRef, aClassType );
1199 }
1200 else
1201 {
1202 // #112368 Special conversion for Decimal, Currency and Date
1203 if( eType == TypeClass_STRUCT )
1204 {
1205 SbiInstance* pInst = GetSbData()->pInst;
1206 if( pInst && pInst->IsCompatibility() )
1207 {
1208 if( rType == cppu::UnoType<oleautomation::Decimal>::get())
1209 {
1210 oleautomation::Decimal aDecimal;
1211 pVar->fillAutomationDecimal( aDecimal );
1212 aRetVal <<= aDecimal;
1213 break;
1214 }
1215 else if( rType == cppu::UnoType<oleautomation::Currency>::get())
1216 {
1217 // assumes per previous code that ole Currency is Int64
1218 aRetVal <<= pVar->GetInt64();
1219 break;
1220 }
1221 else if( rType == cppu::UnoType<oleautomation::Date>::get())
1222 {
1223 oleautomation::Date aDate;
1224 aDate.Value = pVar->GetDate();
1225 aRetVal <<= aDate;
1226 break;
1227 }
1228 }
1229 }
1230
1231 SbxBaseRef pObj = pVar->GetObject();
1232 if( auto obj = dynamic_cast<SbUnoObject*>( pObj.get() ) )
1233 {
1234 aRetVal = obj->getUnoAny();
1235 }
1236 else if( auto structRef = dynamic_cast<SbUnoStructRefObject*>( pObj.get() ) )
1237 {
1238 aRetVal = structRef->getUnoAny();
1239 }
1240 else
1241 {
1242 // null object -> null XInterface
1243 Reference<XInterface> xInt;
1244 aRetVal <<= xInt;
1245 }
1246 }
1247 }
1248 break;
1249
1250 case TypeClass_TYPE:
1251 {
1252 if( eBaseType == SbxOBJECT )
1253 {
1254 // XIdlClass?
1255 Reference< XIdlClass > xIdlClass;
1256
1257 SbxBaseRef pObj = pVar->GetObject();
1258 if( auto obj = dynamic_cast<SbUnoObject*>( pObj.get() ) )
1259 {
1260 Any aUnoAny = obj->getUnoAny();
1261 aUnoAny >>= xIdlClass;
1262 }
1263
1264 if( xIdlClass.is() )
1265 {
1266 OUString aClassName = xIdlClass->getName();
1267 Type aType( xIdlClass->getTypeClass(), aClassName );
1268 aRetVal <<= aType;
1269 }
1270 }
1271 else if( eBaseType == SbxSTRING )
1272 {
1273 OUString aTypeName = pVar->GetOUString();
1274 Type aType;
1275 bool bSuccess = implGetTypeByName( aTypeName, aType );
1276 if( bSuccess )
1277 {
1278 aRetVal <<= aType;
1279 }
1280 }
1281 }
1282 break;
1283
1284
1285 case TypeClass_ENUM:
1286 {
1287 aRetVal = int2enum( pVar->GetLong(), rType );
1288 }
1289 break;
1290
1291 case TypeClass_SEQUENCE:
1292 {
1293 SbxBaseRef xObj = pVar->GetObject();
1294 if( auto pArray = dynamic_cast<SbxDimArray*>( xObj.get() ) )
1295 {
1296 short nDims = pArray->GetDims();
1297
1298 // Normal case: One dimensional array
1299 sal_Int32 nLower, nUpper;
1300 if( nDims == 1 && pArray->GetDim32( 1, nLower, nUpper ) )
1301 {
1302 sal_Int32 nSeqSize = nUpper - nLower + 1;
1303
1304 // create the instance of the required sequence
1305 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
1306 xIdlTargetClass->createObject( aRetVal );
1307 Reference< XIdlArray > xArray = xIdlTargetClass->getArray();
1308 xArray->realloc( aRetVal, nSeqSize );
1309
1310 // Element-Type
1311 OUString aClassName = xIdlTargetClass->getName();
1312 typelib_TypeDescription * pSeqTD = nullptr;
1313 typelib_typedescription_getByName( &pSeqTD, aClassName.pData );
1314 OSL_ASSERT( pSeqTD );
1315 Type aElemType( reinterpret_cast<typelib_IndirectTypeDescription *>(pSeqTD)->pType );
1316
1317 // convert all array member and register them
1318 sal_Int32 aIdx[1];
1319 aIdx[0] = nLower;
1320 for (sal_Int32 i = 0 ; i < nSeqSize; ++i, ++aIdx[0])
1321 {
1322 SbxVariableRef xVar = pArray->Get32(aIdx);
1323
1324 // Convert the value of Sbx to Uno
1325 Any aAnyValue = sbxToUnoValue( xVar.get(), aElemType );
1326
1327 try
1328 {
1329 // insert in the sequence
1330 xArray->set( aRetVal, i, aAnyValue );
1331 }
1332 catch( const IllegalArgumentException& )
1333 {
1334 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
1335 implGetExceptionMsg( ::cppu::getCaughtException() ) );
1336 }
1337 catch (const IndexOutOfBoundsException&)
1338 {
1339 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
1340 }
1341 }
1342 }
1343 // #i33795 Map also multi dimensional arrays to corresponding sequences
1344 else if( nDims > 1 )
1345 {
1346 // Element-Type
1347 typelib_TypeDescription * pSeqTD = nullptr;
1348 Type aCurType( rType );
1349 sal_Int32 nSeqLevel = 0;
1350 Type aElemType;
1351 do
1352 {
1353 OUString aTypeName = aCurType.getTypeName();
1354 typelib_typedescription_getByName( &pSeqTD, aTypeName.pData );
1355 OSL_ASSERT( pSeqTD );
1356 if( pSeqTD->eTypeClass == typelib_TypeClass_SEQUENCE )
1357 {
1358 aCurType = Type( reinterpret_cast<typelib_IndirectTypeDescription *>(pSeqTD)->pType );
1359 nSeqLevel++;
1360 }
1361 else
1362 {
1363 aElemType = aCurType;
1364 break;
1365 }
1366 }
1367 while( true );
1368
1369 if( nSeqLevel == nDims )
1370 {
1371 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDims]);
1372 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDims]);
1373 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDims]);
1374 for( short i = 1 ; i <= nDims ; i++ )
1375 {
1376 sal_Int32 lBound, uBound;
1377 pArray->GetDim32( i, lBound, uBound );
1378
1379 short j = i - 1;
1380 pActualIndices[j] = pLowerBounds[j] = lBound;
1381 pUpperBounds[j] = uBound;
1382 }
1383
1384 aRetVal = implRekMultiDimArrayToSequence( pArray, aElemType,
1385 nDims - 1, 0, pActualIndices.get(), pLowerBounds.get(), pUpperBounds.get() );
1386 }
1387 }
1388 }
1389 }
1390 break;
1391
1392
1393 // for Any use the class independent converting routine
1394 case TypeClass_ANY:
1395 {
1396 aRetVal = sbxToUnoValueImpl( pVar );
1397 }
1398 break;
1399
1400 case TypeClass_BOOLEAN:
1401 {
1402 aRetVal <<= pVar->GetBool();
1403 break;
1404 }
1405 case TypeClass_CHAR:
1406 {
1407 aRetVal <<= pVar->GetChar();
1408 break;
1409 }
1410 case TypeClass_STRING: aRetVal <<= pVar->GetOUString(); break;
1411 case TypeClass_FLOAT: aRetVal <<= pVar->GetSingle(); break;
1412 case TypeClass_DOUBLE: aRetVal <<= pVar->GetDouble(); break;
1413
1414 case TypeClass_BYTE:
1415 {
1416 sal_Int16 nVal = pVar->GetInteger();
1417 bool bOverflow = false;
1418 if( nVal < -128 )
1419 {
1420 bOverflow = true;
1421 nVal = -128;
1422 }
1423 else if( nVal > 255 ) // 128..255 map to -128..-1
1424 {
1425 bOverflow = true;
1426 nVal = 127;
1427 }
1428 if( bOverflow )
1429 StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
1430
1431 sal_Int8 nByteVal = static_cast<sal_Int8>(nVal);
1432 aRetVal <<= nByteVal;
1433 break;
1434 }
1435 case TypeClass_SHORT: aRetVal <<= pVar->GetInteger(); break;
1436 case TypeClass_LONG: aRetVal <<= pVar->GetLong(); break;
1437 case TypeClass_HYPER: aRetVal <<= pVar->GetInt64(); break;
1438 case TypeClass_UNSIGNED_SHORT: aRetVal <<= pVar->GetUShort(); break;
1439 case TypeClass_UNSIGNED_LONG: aRetVal <<= pVar->GetULong(); break;
1440 case TypeClass_UNSIGNED_HYPER: aRetVal <<= pVar->GetUInt64(); break;
1441 default: break;
1442 }
1443
1444 return aRetVal;
1445 }
1446
1447 static void processAutomationParams( SbxArray* pParams, Sequence< Any >& args, sal_uInt32 nParamCount )
1448 {
1449 AutomationNamedArgsSbxArray* pArgNamesArray = dynamic_cast<AutomationNamedArgsSbxArray*>( pParams );
1450
1451 args.realloc( nParamCount );
1452 Any* pAnyArgs = args.getArray();
1453 bool bBlockConversionToSmallestType = GetSbData()->pInst->IsCompatibility();
1454 sal_uInt32 i = 0;
1455 if( pArgNamesArray )
1456 {
1457 Sequence< OUString >& rNameSeq = pArgNamesArray->getNames();
1458 OUString* pNames = rNameSeq.getArray();
1459 Any aValAny;
1460 for( i = 0 ; i < nParamCount ; i++ )
1461 {
1462 sal_uInt16 iSbx = static_cast<sal_uInt16>(i+1);
1463
1464 aValAny = sbxToUnoValueImpl( pParams->Get( iSbx ),
1465 bBlockConversionToSmallestType );
1466
1467 OUString aParamName = pNames[iSbx];
1468 if( !aParamName.isEmpty() )
1469 {
1470 oleautomation::NamedArgument aNamedArgument;
1471 aNamedArgument.Name = aParamName;
1472 aNamedArgument.Value = aValAny;
1473 pAnyArgs[i] <<= aNamedArgument;
1474 }
1475 else
1476 {
1477 pAnyArgs[i] = aValAny;
1478 }
1479 }
1480 }
1481 else
1482 {
1483 for( i = 0 ; i < nParamCount ; i++ )
1484 {
1485 pAnyArgs[i] = sbxToUnoValueImpl( pParams->Get( static_cast<sal_uInt16>(i+1) ),
1486 bBlockConversionToSmallestType );
1487 }
1488 }
1489
1490 }
1491 enum class INVOKETYPE
1492 {
1493 GetProp = 0,
1494 Func
1495 };
1496 static Any invokeAutomationMethod( const OUString& Name, Sequence< Any > const & args, SbxArray* pParams, sal_uInt32 nParamCount, Reference< XInvocation > const & rxInvocation, INVOKETYPE invokeType )
1497 {
1498 Sequence< sal_Int16 > OutParamIndex;
1499 Sequence< Any > OutParam;
1500
1501 Any aRetAny;
1502 switch( invokeType )
1503 {
1504 case INVOKETYPE::Func:
1505 aRetAny = rxInvocation->invoke( Name, args, OutParamIndex, OutParam );
1506 break;
1507 case INVOKETYPE::GetProp:
1508 {
1509 Reference< XAutomationInvocation > xAutoInv( rxInvocation, UNO_QUERY );
1510 aRetAny = xAutoInv->invokeGetProperty( Name, args, OutParamIndex, OutParam );
1511 break;
1512 }
1513 default:
1514 assert(false); break;
1515
1516 }
1517 const sal_Int16* pIndices = OutParamIndex.getConstArray();
1518 sal_uInt32 nLen = OutParamIndex.getLength();
1519 if( nLen )
1520 {
1521 const Any* pNewValues = OutParam.getConstArray();
1522 for( sal_uInt32 j = 0 ; j < nLen ; j++ )
1523 {
1524 sal_Int16 iTarget = pIndices[ j ];
1525 if( iTarget >= static_cast<sal_Int16>(nParamCount) )
1526 break;
1527 unoToSbxValue( pParams->Get( static_cast<sal_uInt16>(j+1) ), pNewValues[ j ] );
1528 }
1529 }
1530 return aRetAny;
1531 }
1532
1533 // Debugging help method to readout the imlemented interfaces of an object
1534 static OUString Impl_GetInterfaceInfo( const Reference< XInterface >& x, const Reference< XIdlClass >& xClass, sal_uInt16 nRekLevel )
1535 {
1536 Type aIfaceType = cppu::UnoType<XInterface>::get();
1537 static Reference< XIdlClass > xIfaceClass = TypeToIdlClass( aIfaceType );
1538
1539 OUStringBuffer aRetStr;
1540 for( sal_uInt16 i = 0 ; i < nRekLevel ; i++ )
1541 aRetStr.append( " " );
1542 aRetStr.append( xClass->getName() );
1543 OUString aClassName = xClass->getName();
1544 Type aClassType( xClass->getTypeClass(), aClassName );
1545
1546 // checking if the interface is really supported
1547 if( !x->queryInterface( aClassType ).hasValue() )
1548 {
1549 aRetStr.append( " (ERROR: Not really supported!)\n" );
1550 }
1551 // Are there super interfaces?
1552 else
1553 {
1554 aRetStr.append( "\n" );
1555
1556 // get the super interfaces
1557 Sequence< Reference< XIdlClass > > aSuperClassSeq = xClass->getSuperclasses();
1558 const Reference< XIdlClass >* pClasses = aSuperClassSeq.getConstArray();
1559 sal_uInt32 nSuperIfaceCount = aSuperClassSeq.getLength();
1560 for( sal_uInt32 j = 0 ; j < nSuperIfaceCount ; j++ )
1561 {
1562 const Reference< XIdlClass >& rxIfaceClass = pClasses[j];
1563 if( !rxIfaceClass->equals( xIfaceClass ) )
1564 aRetStr.append( Impl_GetInterfaceInfo( x, rxIfaceClass, nRekLevel + 1 ) );
1565 }
1566 }
1567 return aRetStr.makeStringAndClear();
1568 }
1569
1570 static OUString getDbgObjectNameImpl(SbUnoObject& rUnoObj)
1571 {
1572 OUString aName = rUnoObj.GetClassName();
1573 if( aName.isEmpty() )
1574 {
1575 Any aToInspectObj = rUnoObj.getUnoAny();
1576 Reference< XInterface > xObj(aToInspectObj, css::uno::UNO_QUERY);
1577 if( xObj.is() )
1578 {
1579 Reference< XServiceInfo > xServiceInfo( xObj, UNO_QUERY );
1580 if( xServiceInfo.is() )
1581 aName = xServiceInfo->getImplementationName();
1582 }
1583 }
1584 return aName;
1585 }
1586
1587 static OUString getDbgObjectName(SbUnoObject& rUnoObj)
1588 {
1589 OUString aName = getDbgObjectNameImpl(rUnoObj);
1590 if( aName.isEmpty() )
1591 aName += "Unknown";
1592
1593 OUStringBuffer aRet;
1594 if( aName.getLength() > 20 )
1595 {
1596 aRet.append( "\n" );
1597 }
1598 aRet.append( "\"" );
1599 aRet.append( aName );
1600 aRet.append( "\":" );
1601 return aRet.makeStringAndClear();
1602 }
1603
1604 OUString getBasicObjectTypeName( SbxObject* pObj )
1605 {
1606 if (pObj)
1607 {
1608 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
1609 {
1610 return getDbgObjectNameImpl(*pUnoObj);
1611 }
1612 else if (SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>(pObj))
1613 {
1614 return pUnoStructObj->GetClassName();
1615 }
1616 }
1617 return OUString();
1618 }
1619
1620 namespace {
1621
1622 bool matchesBasicTypeName(
1623 css::uno::Reference<css::reflection::XIdlClass> const & unoType, OUString const & basicTypeName)
1624 {
1625 if (unoType->getName().endsWithIgnoreAsciiCase(basicTypeName)) {
1626 return true;
1627 }
1628 auto const sups = unoType->getSuperclasses();
1629 return std::any_of(
1630 sups.begin(), sups.end(),
1631 [&basicTypeName](auto const & t) { return matchesBasicTypeName(t, basicTypeName); });
1632 }
1633
1634 }
1635
1636 bool checkUnoObjectType(SbUnoObject& rUnoObj, const OUString& rClass)
1637 {
1638 Any aToInspectObj = rUnoObj.getUnoAny();
1639
1640 // Return true for XInvocation based objects as interface type names don't count then
1641 Reference< XInvocation > xInvocation( aToInspectObj, UNO_QUERY );
1642 if( xInvocation.is() )
1643 {
1644 return true;
1645 }
1646 bool bResult = false;
1647 Reference< XTypeProvider > xTypeProvider( aToInspectObj, UNO_QUERY );
1648 if( xTypeProvider.is() )
1649 {
1650 /* Although interfaces in the ooo.vba namespace obey the IDL rules and
1651 have a leading 'X', in Basic we want to be able to do something
1652 like 'Dim wb As Workbooks' or 'Dim lb As MSForms.Label'. Here we
1653 add a leading 'X' to the class name and a leading dot to the entire
1654 type name. This results e.g. in '.XWorkbooks' or '.MSForms.XLabel'
1655 which matches the interface names 'ooo.vba.excel.XWorkbooks' or
1656 'ooo.vba.msforms.XLabel'.
1657 */
1658 OUString aClassName;
1659 if ( SbiRuntime::isVBAEnabled() )
1660 {
1661 aClassName = ".";
1662 sal_Int32 nClassNameDot = rClass.lastIndexOf( '.' );
1663 if( nClassNameDot >= 0 )
1664 {
1665 aClassName += rClass.copy( 0, nClassNameDot + 1 ) + "X" + rClass.copy( nClassNameDot + 1 );
1666 }
1667 else
1668 {
1669 aClassName += "X" + rClass;
1670 }
1671 }
1672 else // assume extended type declaration support for basic ( can't get here
1673 // otherwise.
1674 aClassName = rClass;
1675
1676 Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
1677 const Type* pTypeArray = aTypeSeq.getConstArray();
1678 sal_uInt32 nIfaceCount = aTypeSeq.getLength();
1679 for( sal_uInt32 j = 0 ; j < nIfaceCount ; j++ )
1680 {
1681 const Type& rType = pTypeArray[j];
1682
1683 Reference<XIdlClass> xClass = TypeToIdlClass( rType );
1684 if( !xClass.is() )
1685 {
1686 OSL_FAIL("failed to get XIdlClass for type");
1687 break;
1688 }
1689 OUString aInterfaceName = xClass->getName();
1690 if ( aInterfaceName == "com.sun.star.bridge.oleautomation.XAutomationObject" )
1691 {
1692 // there is a hack in the extensions/source/ole/oleobj.cxx to return the typename of the automation object, lets check if it
1693 // matches
1694 Reference< XInvocation > xInv( aToInspectObj, UNO_QUERY );
1695 if ( xInv.is() )
1696 {
1697 OUString sTypeName;
1698 xInv->getValue( "$GetTypeName" ) >>= sTypeName;
1699 if ( sTypeName.isEmpty() || sTypeName == "IDispatch" )
1700 {
1701 // can't check type, leave it pass
1702 bResult = true;
1703 }
1704 else
1705 {
1706 bResult = sTypeName == rClass;
1707 }
1708 }
1709 break; // finished checking automation object
1710 }
1711
1712 if ( matchesBasicTypeName(xClass, aClassName) )
1713 {
1714 bResult = true;
1715 break;
1716 }
1717 }
1718 }
1719 return bResult;
1720 }
1721
1722 // Debugging help method to readout the imlemented interfaces of an object
1723 static OUString Impl_GetSupportedInterfaces(SbUnoObject& rUnoObj)
1724 {
1725 Any aToInspectObj = rUnoObj.getUnoAny();
1726
1727 // allow only TypeClass interface
1728 OUStringBuffer aRet;
1729 auto x = o3tl::tryAccess<Reference<XInterface>>(aToInspectObj);
1730 if( !x )
1731 {
1732 aRet.append( ID_DBG_SUPPORTEDINTERFACES );
1733 aRet.append( " not available.\n(TypeClass is not TypeClass_INTERFACE)\n" );
1734 }
1735 else
1736 {
1737 Reference< XTypeProvider > xTypeProvider( *x, UNO_QUERY );
1738
1739 aRet.append( "Supported interfaces by object " );
1740 aRet.append(getDbgObjectName(rUnoObj));
1741 aRet.append( "\n" );
1742 if( xTypeProvider.is() )
1743 {
1744 // get the interfaces of the implementation
1745 Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
1746 const Type* pTypeArray = aTypeSeq.getConstArray();
1747 sal_uInt32 nIfaceCount = aTypeSeq.getLength();
1748 for( sal_uInt32 j = 0 ; j < nIfaceCount ; j++ )
1749 {
1750 const Type& rType = pTypeArray[j];
1751
1752 Reference<XIdlClass> xClass = TypeToIdlClass( rType );
1753 if( xClass.is() )
1754 {
1755 aRet.append( Impl_GetInterfaceInfo( *x, xClass, 1 ) );
1756 }
1757 else
1758 {
1759 typelib_TypeDescription * pTD = nullptr;
1760 rType.getDescription( &pTD );
1761
1762 aRet.append( "*** ERROR: No IdlClass for type \"" );
1763 aRet.append( pTD->pTypeName );
1764 aRet.append( "\"\n*** Please check type library\n" );
1765 }
1766 }
1767 }
1768 }
1769 return aRet.makeStringAndClear();
1770 }
1771
1772
1773 // Debugging help method SbxDataType -> String
1774 static OUString Dbg_SbxDataType2String( SbxDataType eType )
1775 {
1776 OUStringBuffer aRet;
1777 switch( +eType )
1778 {
1779 case SbxEMPTY: aRet.append("SbxEMPTY"); break;
1780 case SbxNULL: aRet.append("SbxNULL"); break;
1781 case SbxINTEGER: aRet.append("SbxINTEGER"); break;
1782 case SbxLONG: aRet.append("SbxLONG"); break;
1783 case SbxSINGLE: aRet.append("SbxSINGLE"); break;
1784 case SbxDOUBLE: aRet.append("SbxDOUBLE"); break;
1785 case SbxCURRENCY: aRet.append("SbxCURRENCY"); break;
1786 case SbxDECIMAL: aRet.append("SbxDECIMAL"); break;
1787 case SbxDATE: aRet.append("SbxDATE"); break;
1788 case SbxSTRING: aRet.append("SbxSTRING"); break;
1789 case SbxOBJECT: aRet.append("SbxOBJECT"); break;
1790 case SbxERROR: aRet.append("SbxERROR"); break;
1791 case SbxBOOL: aRet.append("SbxBOOL"); break;
1792 case SbxVARIANT: aRet.append("SbxVARIANT"); break;
1793 case SbxDATAOBJECT: aRet.append("SbxDATAOBJECT"); break;
1794 case SbxCHAR: aRet.append("SbxCHAR"); break;
1795 case SbxBYTE: aRet.append("SbxBYTE"); break;
1796 case SbxUSHORT: aRet.append("SbxUSHORT"); break;
1797 case SbxULONG: aRet.append("SbxULONG"); break;
1798 case SbxSALINT64: aRet.append("SbxINT64"); break;
1799 case SbxSALUINT64: aRet.append("SbxUINT64"); break;
1800 case SbxINT: aRet.append("SbxINT"); break;
1801 case SbxUINT: aRet.append("SbxUINT"); break;
1802 case SbxVOID: aRet.append("SbxVOID"); break;
1803 case SbxHRESULT: aRet.append("SbxHRESULT"); break;
1804 case SbxPOINTER: aRet.append("SbxPOINTER"); break;
1805 case SbxDIMARRAY: aRet.append("SbxDIMARRAY"); break;
1806 case SbxCARRAY: aRet.append("SbxCARRAY"); break;
1807 case SbxUSERDEF: aRet.append("SbxUSERDEF"); break;
1808 case SbxLPSTR: aRet.append("SbxLPSTR"); break;
1809 case SbxLPWSTR: aRet.append("SbxLPWSTR"); break;
1810 case SbxCoreSTRING: aRet.append("SbxCoreSTRING"); break;
1811 case SbxOBJECT | SbxARRAY: aRet.append("SbxARRAY"); break;
1812 default: aRet.append("Unknown Sbx-Type!");break;
1813 }
1814 return aRet.makeStringAndClear();
1815 }
1816
1817 // Debugging help method to display the properties of a SbUnoObjects
1818 static OUString Impl_DumpProperties(SbUnoObject& rUnoObj)
1819 {
1820 OUStringBuffer aRet;
1821 aRet.append("Properties of object ");
1822 aRet.append(getDbgObjectName(rUnoObj));
1823
1824 // analyse the Uno-Infos to recognise the arrays
1825 Reference< XIntrospectionAccess > xAccess = rUnoObj.getIntrospectionAccess();
1826 if( !xAccess.is() )
1827 {
1828 Reference< XInvocation > xInvok = rUnoObj.getInvocation();
1829 if( xInvok.is() )
1830 xAccess = xInvok->getIntrospection();
1831 }
1832 if( !xAccess.is() )
1833 {
1834 aRet.append( "\nUnknown, no introspection available\n" );
1835 return aRet.makeStringAndClear();
1836 }
1837
1838 Sequence<Property> props = xAccess->getProperties( PropertyConcept::ALL - PropertyConcept::DANGEROUS );
1839 sal_uInt32 nUnoPropCount = props.getLength();
1840 const Property* pUnoProps = props.getConstArray();
1841
1842 SbxArray* pProps = rUnoObj.GetProperties();
1843 sal_uInt16 nPropCount = pProps->Count();
1844 sal_uInt16 nPropsPerLine = 1 + nPropCount / 30;
1845 for( sal_uInt16 i = 0; i < nPropCount; i++ )
1846 {
1847 SbxVariable* pVar = pProps->Get( i );
1848 if( pVar )
1849 {
1850 OUStringBuffer aPropStr;
1851 if( (i % nPropsPerLine) == 0 )
1852 aPropStr.append( "\n" );
1853
1854 // output the type and name
1855 // Is it in Uno a sequence?
1856 SbxDataType eType = pVar->GetFullType();
1857
1858 bool bMaybeVoid = false;
1859 if( i < nUnoPropCount )
1860 {
1861 const Property& rProp = pUnoProps[ i ];
1862
1863 // For MAYBEVOID freshly convert the type from Uno,
1864 // so not just SbxEMPTY is returned.
1865 if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
1866 {
1867 eType = unoToSbxType( rProp.Type.getTypeClass() );
1868 bMaybeVoid = true;
1869 }
1870 if( eType == SbxOBJECT )
1871 {
1872 Type aType = rProp.Type;
1873 if( aType.getTypeClass() == TypeClass_SEQUENCE )
1874 eType = SbxDataType( SbxOBJECT | SbxARRAY );
1875 }
1876 }
1877 aPropStr.append( Dbg_SbxDataType2String( eType ) );
1878 if( bMaybeVoid )
1879 aPropStr.append( "/void" );
1880 aPropStr.append( " " );
1881 aPropStr.append( pVar->GetName() );
1882
1883 if( i == nPropCount - 1 )
1884 aPropStr.append( "\n" );
1885 else
1886 aPropStr.append( "; " );
1887
1888 aRet.append( aPropStr.makeStringAndClear() );
1889 }
1890 }
1891 return aRet.makeStringAndClear();
1892 }
1893
1894 // Debugging help method to display the methods of an SbUnoObjects
1895 static OUString Impl_DumpMethods(SbUnoObject& rUnoObj)
1896 {
1897 OUStringBuffer aRet;
1898 aRet.append("Methods of object ");
1899 aRet.append(getDbgObjectName(rUnoObj));
1900
1901 // XIntrospectionAccess, so that the types of the parameter could be outputted
1902 Reference< XIntrospectionAccess > xAccess = rUnoObj.getIntrospectionAccess();
1903 if( !xAccess.is() )
1904 {
1905 Reference< XInvocation > xInvok = rUnoObj.getInvocation();
1906 if( xInvok.is() )
1907 xAccess = xInvok->getIntrospection();
1908 }
1909 if( !xAccess.is() )
1910 {
1911 aRet.append( "\nUnknown, no introspection available\n" );
1912 return aRet.makeStringAndClear();
1913 }
1914 Sequence< Reference< XIdlMethod > > methods = xAccess->getMethods
1915 ( MethodConcept::ALL - MethodConcept::DANGEROUS );
1916 const Reference< XIdlMethod >* pUnoMethods = methods.getConstArray();
1917
1918 SbxArray* pMethods = rUnoObj.GetMethods();
1919 sal_uInt16 nMethodCount = pMethods->Count();
1920 if( !nMethodCount )
1921 {
1922 aRet.append( "\nNo methods found\n" );
1923 return aRet.makeStringAndClear();
1924 }
1925 sal_uInt16 nPropsPerLine = 1 + nMethodCount / 30;
1926 for( sal_uInt16 i = 0; i < nMethodCount; i++ )
1927 {
1928 SbxVariable* pVar = pMethods->Get( i );
1929 if( pVar )
1930 {
1931 if( (i % nPropsPerLine) == 0 )
1932 aRet.append( "\n" );
1933
1934 // address the method
1935 const Reference< XIdlMethod >& rxMethod = pUnoMethods[i];
1936
1937 // Is it in Uno a sequence?
1938 SbxDataType eType = pVar->GetFullType();
1939 if( eType == SbxOBJECT )
1940 {
1941 Reference< XIdlClass > xClass = rxMethod->getReturnType();
1942 if( xClass.is() && xClass->getTypeClass() == TypeClass_SEQUENCE )
1943 eType = SbxDataType( SbxOBJECT | SbxARRAY );
1944 }
1945 // output the name and the type
1946 aRet.append( Dbg_SbxDataType2String( eType ) );
1947 aRet.append( " " );
1948 aRet.append ( pVar->GetName() );
1949 aRet.append( " ( " );
1950
1951 // the get-method mustn't have a parameter
1952 Sequence< Reference< XIdlClass > > aParamsSeq = rxMethod->getParameterTypes();
1953 sal_uInt32 nParamCount = aParamsSeq.getLength();
1954 const Reference< XIdlClass >* pParams = aParamsSeq.getConstArray();
1955
1956 if( nParamCount > 0 )
1957 {
1958 for( sal_uInt32 j = 0; j < nParamCount; j++ )
1959 {
1960 aRet.append ( Dbg_SbxDataType2String( unoToSbxType( pParams[ j ] ) ) );
1961 if( j < nParamCount - 1 )
1962 aRet.append( ", " );
1963 }
1964 }
1965 else
1966 aRet.append( "void" );
1967
1968 aRet.append( " ) " );
1969
1970 if( i == nMethodCount - 1 )
1971 aRet.append( "\n" );
1972 else
1973 aRet.append( "; " );
1974 }
1975 }
1976 return aRet.makeStringAndClear();
1977 }
1978
1979
1980 // Implementation SbUnoObject
1981 void SbUnoObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
1982 {
1983 if( bNeedIntrospection )
1984 doIntrospection();
1985
1986 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
1987 if( pHint )
1988 {
1989 SbxVariable* pVar = pHint->GetVar();
1990 SbxArray* pParams = pVar->GetParameters();
1991 SbUnoProperty* pProp = dynamic_cast<SbUnoProperty*>( pVar );
1992 SbUnoMethod* pMeth = dynamic_cast<SbUnoMethod*>( pVar );
1993 if( pProp )
1994 {
1995 bool bInvocation = pProp->isInvocationBased();
1996 if( pHint->GetId() == SfxHintId::BasicDataWanted )
1997 {
1998 // Test-Properties
1999 sal_Int32 nId = pProp->nId;
2000 if( nId < 0 )
2001 {
2002 // Id == -1: Display implemented interfaces according the ClassProvider
2003 if( nId == -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
2004 {
2005 OUString aRetStr = Impl_GetSupportedInterfaces(*this);
2006 pVar->PutString( aRetStr );
2007 }
2008 // Id == -2: output properties
2009 else if( nId == -2 ) // Property ID_DBG_PROPERTIES
2010 {
2011 // now all properties must be created
2012 implCreateAll();
2013 OUString aRetStr = Impl_DumpProperties(*this);
2014 pVar->PutString( aRetStr );
2015 }
2016 // Id == -3: output the methods
2017 else if( nId == -3 ) // Property ID_DBG_METHODS
2018 {
2019 // now all properties must be created
2020 implCreateAll();
2021 OUString aRetStr = Impl_DumpMethods(*this);
2022 pVar->PutString( aRetStr );
2023 }
2024 return;
2025 }
2026
2027 if( !bInvocation && mxUnoAccess.is() )
2028 {
2029 try
2030 {
2031 if ( maStructInfo.get() )
2032 {
2033 StructRefInfo aMember = maStructInfo->getStructMember( pProp->GetName() );
2034 if ( aMember.isEmpty() )
2035 {
2036 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
2037 }
2038 else
2039 {
2040 if ( pProp->isUnoStruct() )
2041 {
2042 SbUnoStructRefObject* pSbUnoObject = new SbUnoStructRefObject( pProp->GetName(), aMember );
2043 SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
2044 pVar->PutObject( xWrapper.get() );
2045 }
2046 else
2047 {
2048 Any aRetAny = aMember.getValue();
2049 // take over the value from Uno to Sbx
2050 unoToSbxValue( pVar, aRetAny );
2051 }
2052 return;
2053 }
2054 }
2055 // get the value
2056 Reference< XPropertySet > xPropSet( mxUnoAccess->queryAdapter( cppu::UnoType<XPropertySet>::get()), UNO_QUERY );
2057 Any aRetAny = xPropSet->getPropertyValue( pProp->GetName() );
2058 // The use of getPropertyValue (instead of using the index) is
2059 // suboptimal, but the refactoring to XInvocation is already pending
2060 // Otherwise it is possible to use FastPropertySet
2061
2062 // take over the value from Uno to Sbx
2063 unoToSbxValue( pVar, aRetAny );
2064 }
2065 catch( const Exception& )
2066 {
2067 implHandleAnyException( ::cppu::getCaughtException() );
2068 }
2069 }
2070 else if( bInvocation && mxInvocation.is() )
2071 {
2072 try
2073 {
2074 sal_uInt32 nParamCount = pParams ? (static_cast<sal_uInt32>(pParams->Count()) - 1) : 0;
2075 bool bCanBeConsideredAMethod = mxInvocation->hasMethod( pProp->GetName() );
2076 Any aRetAny;
2077 if ( bCanBeConsideredAMethod && nParamCount )
2078 {
2079 // Automation properties have methods, so... we need to invoke this through
2080 // XInvocation
2081 Sequence<Any> args;
2082 processAutomationParams( pParams, args, nParamCount );
2083 aRetAny = invokeAutomationMethod( pProp->GetName(), args, pParams, nParamCount, mxInvocation, INVOKETYPE::GetProp );
2084 }
2085 else
2086 aRetAny = mxInvocation->getValue( pProp->GetName() );
2087 // take over the value from Uno to Sbx
2088 unoToSbxValue( pVar, aRetAny );
2089 if( pParams && bCanBeConsideredAMethod )
2090 pVar->SetParameters( nullptr );
2091
2092 }
2093 catch( const Exception& )
2094 {
2095 implHandleAnyException( ::cppu::getCaughtException() );
2096 }
2097 }
2098 }
2099 else if( pHint->GetId() == SfxHintId::BasicDataChanged )
2100 {
2101 if( !bInvocation && mxUnoAccess.is() )
2102 {
2103 if( pProp->aUnoProp.Attributes & PropertyAttribute::READONLY )
2104 {
2105 StarBASIC::Error( ERRCODE_BASIC_PROP_READONLY );
2106 return;
2107 }
2108 if ( maStructInfo.get() )
2109 {
2110 StructRefInfo aMember = maStructInfo->getStructMember( pProp->GetName() );
2111 if ( aMember.isEmpty() )
2112 {
2113 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
2114 }
2115 else
2116 {
2117 Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
2118 aMember.setValue( aAnyValue );
2119 }
2120 return;
2121 }
2122 // take over the value from Uno to Sbx
2123 Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
2124 try
2125 {
2126 // set the value
2127 Reference< XPropertySet > xPropSet( mxUnoAccess->queryAdapter( cppu::UnoType<XPropertySet>::get()), UNO_QUERY );
2128 xPropSet->setPropertyValue( pProp->GetName(), aAnyValue );
2129 // The use of getPropertyValue (instead of using the index) is
2130 // suboptimal, but the refactoring to XInvocation is already pending
2131 // Otherwise it is possible to use FastPropertySet
2132 }
2133 catch( const Exception& )
2134 {
2135 implHandleAnyException( ::cppu::getCaughtException() );
2136 }
2137 }
2138 else if( bInvocation && mxInvocation.is() )
2139 {
2140 // take over the value from Uno to Sbx
2141 Any aAnyValue = sbxToUnoValueImpl( pVar );
2142 try
2143 {
2144 // set the value
2145 mxInvocation->setValue( pProp->GetName(), aAnyValue );
2146 }
2147 catch( const Exception& )
2148 {
2149 implHandleAnyException( ::cppu::getCaughtException() );
2150 }
2151 }
2152 }
2153 }
2154 else if( pMeth )
2155 {
2156 bool bInvocation = pMeth->isInvocationBased();
2157 if( pHint->GetId() == SfxHintId::BasicDataWanted )
2158 {
2159 // number of Parameter -1 because of Param0 == this
2160 sal_uInt32 nParamCount = pParams ? (static_cast<sal_uInt32>(pParams->Count()) - 1) : 0;
2161 Sequence<Any> args;
2162 bool bOutParams = false;
2163
2164 if( !bInvocation && mxUnoAccess.is() )
2165 {
2166 // get info
2167 const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
2168 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2169 sal_uInt32 nUnoParamCount = rInfoSeq.getLength();
2170 sal_uInt32 nAllocParamCount = nParamCount;
2171
2172 // ignore surplus parameter; alternative: throw an error
2173 if( nParamCount > nUnoParamCount )
2174 {
2175 nParamCount = nUnoParamCount;
2176 nAllocParamCount = nParamCount;
2177 }
2178 else if( nParamCount < nUnoParamCount )
2179 {
2180 SbiInstance* pInst = GetSbData()->pInst;
2181 if( pInst && pInst->IsCompatibility() )
2182 {
2183 // Check types
2184 bool bError = false;
2185 for( sal_uInt32 i = nParamCount ; i < nUnoParamCount ; i++ )
2186 {
2187 const ParamInfo& rInfo = pParamInfos[i];
2188 const Reference< XIdlClass >& rxClass = rInfo.aType;
2189 if( rxClass->getTypeClass() != TypeClass_ANY )
2190 {
2191 bError = true;
2192 StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL );
2193 }
2194 }
2195 if( !bError )
2196 nAllocParamCount = nUnoParamCount;
2197 }
2198 }
2199
2200 if( nAllocParamCount > 0 )
2201 {
2202 args.realloc( nAllocParamCount );
2203 Any* pAnyArgs = args.getArray();
2204 for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
2205 {
2206 const ParamInfo& rInfo = pParamInfos[i];
2207 const Reference< XIdlClass >& rxClass = rInfo.aType;
2208
2209 css::uno::Type aType( rxClass->getTypeClass(), rxClass->getName() );
2210
2211 // ATTENTION: Don't forget for Sbx-Parameter the offset!
2212 pAnyArgs[i] = sbxToUnoValue( pParams->Get( static_cast<sal_uInt16>(i+1) ), aType );
2213
2214 // If it is not certain check whether the out-parameter are available.
2215 if( !bOutParams )
2216 {
2217 ParamMode aParamMode = rInfo.aMode;
2218 if( aParamMode != ParamMode_IN )
2219 bOutParams = true;
2220 }
2221 }
2222 }
2223 }
2224 else if( bInvocation && pParams && mxInvocation.is() )
2225 {
2226 processAutomationParams( pParams, args, nParamCount );
2227 }
2228
2229 // call the method
2230 GetSbData()->bBlockCompilerError = true; // #106433 Block compiler errors for API calls
2231 try
2232 {
2233 if( !bInvocation && mxUnoAccess.is() )
2234 {
2235 Any aRetAny = pMeth->m_xUnoMethod->invoke( getUnoAny(), args );
2236
2237 // take over the value from Uno to Sbx
2238 unoToSbxValue( pVar, aRetAny );
2239
2240 // Did we to copy back the Out-Parameter?
2241 if( bOutParams )
2242 {
2243 const Any* pAnyArgs = args.getConstArray();
2244
2245 // get info
2246 const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
2247 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2248
2249 sal_uInt32 j;
2250 for( j = 0 ; j < nParamCount ; j++ )
2251 {
2252 const ParamInfo& rInfo = pParamInfos[j];
2253 ParamMode aParamMode = rInfo.aMode;
2254 if( aParamMode != ParamMode_IN )
2255 unoToSbxValue( pParams->Get( static_cast<sal_uInt16>(j+1) ), pAnyArgs[ j ] );
2256 }
2257 }
2258 }
2259 else if( bInvocation && mxInvocation.is() )
2260 {
2261 Any aRetAny = invokeAutomationMethod( pMeth->GetName(), args, pParams, nParamCount, mxInvocation, INVOKETYPE::Func );
2262 unoToSbxValue( pVar, aRetAny );
2263 }
2264
2265 // remove parameter here, because this was not done anymore in unoToSbxValue()
2266 // for arrays
2267 if( pParams )
2268 pVar->SetParameters( nullptr );
2269 }
2270 catch( const Exception& )
2271 {
2272 implHandleAnyException( ::cppu::getCaughtException() );
2273 }
2274 GetSbData()->bBlockCompilerError = false; // #106433 Unblock compiler errors
2275 }
2276 }
2277 else
2278 SbxObject::Notify( rBC, rHint );
2279 }
2280 }
2281
2282
2283 SbUnoObject::SbUnoObject( const OUString& aName_, const Any& aUnoObj_ )
2284 : SbxObject( aName_ )
2285 , bNeedIntrospection( true )
2286 , bNativeCOMObject( false )
2287 {
2288 // beat out again the default properties of Sbx
2289 Remove( "Name", SbxClassType::DontCare );
2290 Remove( "Parent", SbxClassType::DontCare );
2291
2292 // check the type of the objects
2293 TypeClass eType = aUnoObj_.getValueType().getTypeClass();
2294 Reference< XInterface > x;
2295 if( eType == TypeClass_INTERFACE )
2296 {
2297 // get the interface from the Any
2298 aUnoObj_ >>= x;
2299 if( !x.is() )
2300 return;
2301 }
2302
2303 Reference< XTypeProvider > xTypeProvider;
2304 // Did the object have an invocation itself?
2305 mxInvocation.set( x, UNO_QUERY );
2306
2307 xTypeProvider.set( x, UNO_QUERY );
2308
2309 if( mxInvocation.is() )
2310 {
2311
2312 // get the ExactName
2313 mxExactNameInvocation.set( mxInvocation, UNO_QUERY );
2314
2315 // The remainder refers only to the introspection
2316 if( !xTypeProvider.is() )
2317 {
2318 bNeedIntrospection = false;
2319 return;
2320 }
2321
2322 // Ignore introspection based members for COM objects to avoid
2323 // hiding of equally named COM symbols, e.g. XInvocation::getValue
2324 Reference< oleautomation::XAutomationObject > xAutomationObject( aUnoObj_, UNO_QUERY );
2325 if( xAutomationObject.is() )
2326 bNativeCOMObject = true;
2327 }
2328
2329 maTmpUnoObj = aUnoObj_;
2330
2331
2332 //*** Define the name ***
2333 bool bFatalError = true;
2334
2335 // Is it an interface or a struct?
2336 bool bSetClassName = false;
2337 OUString aClassName_;
2338 if( eType == TypeClass_STRUCT || eType == TypeClass_EXCEPTION )
2339 {
2340 // Struct is Ok
2341 bFatalError = false;
2342
2343 // insert the real name of the class
2344 if( aName_.isEmpty() )
2345 {
2346 aClassName_ = aUnoObj_.getValueType().getTypeName();
2347 bSetClassName = true;
2348 }
2349 StructRefInfo aThisStruct( maTmpUnoObj, maTmpUnoObj.getValueType(), 0 );
2350 maStructInfo.reset( new SbUnoStructRefObject( GetName(), aThisStruct ) );
2351 }
2352 else if( eType == TypeClass_INTERFACE )
2353 {
2354 // Interface works always through the type in the Any
2355 bFatalError = false;
2356 }
2357 if( bSetClassName )
2358 SetClassName( aClassName_ );
2359
2360 // Neither interface nor Struct -> FatalError
2361 if( bFatalError )
2362 {
2363 StarBASIC::FatalError( ERRCODE_BASIC_EXCEPTION );
2364 return;
2365 }
2366
2367 // pass the introspection primal on demand
2368 }
2369
2370 SbUnoObject::~SbUnoObject()
2371 {
2372 }
2373
2374
2375 // pass the introspection on Demand
2376 void SbUnoObject::doIntrospection()
2377 {
2378 if( !bNeedIntrospection )
2379 return;
2380
2381 Reference<XComponentContext> xContext = comphelper::getProcessComponentContext();
2382
2383 if (!xContext.is())
2384 return;
2385
2386
2387 // get the introspection service
2388 Reference<XIntrospection> xIntrospection;
2389
2390 try
2391 {
2392 xIntrospection = theIntrospection::get(xContext);
2393 }
2394 catch ( const css::uno::DeploymentException& )
2395 {
2396 }
2397
2398 if (!xIntrospection.is())
2399 return;
2400
2401 bNeedIntrospection = false;
2402
2403 // pass the introspection
2404 try
2405 {
2406 mxUnoAccess = xIntrospection->inspect( maTmpUnoObj );
2407 }
2408 catch( const RuntimeException& e )
2409 {
2410 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
2411 }
2412
2413 if( !mxUnoAccess.is() )
2414 {
2415 // #51475 mark to indicate an invalid object (no mxMaterialHolder)
2416 return;
2417 }
2418
2419 // get MaterialHolder from access
2420 mxMaterialHolder.set( mxUnoAccess, UNO_QUERY );
2421
2422 // get ExactName from access
2423 mxExactName.set( mxUnoAccess, UNO_QUERY );
2424 }
2425
2426
2427 // Start of a list of all SbUnoMethod-Instances
2428 static SbUnoMethod* pFirst = nullptr;
2429
2430 void clearUnoMethodsForBasic( StarBASIC const * pBasic )
2431 {
2432 SbUnoMethod* pMeth = pFirst;
2433 while( pMeth )
2434 {
2435 SbxObject* pObject = pMeth->GetParent();
2436 if ( pObject )
2437 {
2438 StarBASIC* pModBasic = dynamic_cast< StarBASIC* >( pObject->GetParent() );
2439 if ( pModBasic == pBasic )
2440 {
2441 // for now the solution is to remove the method from the list and to clear it,
2442 // but in case the element should be correctly transferred to another StarBASIC,
2443 // we should either set module parent to NULL without clearing it, or even
2444 // set the new StarBASIC as the parent of the module
2445 // pObject->SetParent( NULL );
2446
2447 if( pMeth == pFirst )
2448 pFirst = pMeth->pNext;
2449 else if( pMeth->pPrev )
2450 pMeth->pPrev->pNext = pMeth->pNext;
2451 if( pMeth->pNext )
2452 pMeth->pNext->pPrev = pMeth->pPrev;
2453
2454 pMeth->pPrev = nullptr;
2455 pMeth->pNext = nullptr;
2456
2457 pMeth->SbxValue::Clear();
2458 pObject->SbxValue::Clear();
2459
2460 // start from the beginning after object clearing, the cycle will end since the method is removed each time
2461 pMeth = pFirst;
2462 }
2463 else
2464 pMeth = pMeth->pNext;
2465 }
2466 else
2467 pMeth = pMeth->pNext;
2468 }
2469 }
2470
2471 void clearUnoMethods()
2472 {
2473 SbUnoMethod* pMeth = pFirst;
2474 while( pMeth )
2475 {
2476 pMeth->SbxValue::Clear();
2477 pMeth = pMeth->pNext;
2478 }
2479 }
2480
2481
2482 SbUnoMethod::SbUnoMethod
2483 (
2484 const OUString& aName_,
2485 SbxDataType eSbxType,
2486 Reference< XIdlMethod > const & xUnoMethod_,
2487 bool bInvocation
2488 )
2489 : SbxMethod( aName_, eSbxType )
2490 , mbInvocation( bInvocation )
2491 {
2492 m_xUnoMethod = xUnoMethod_;
2493 pParamInfoSeq = nullptr;
2494
2495 // enregister the method in a list
2496 pNext = pFirst;
2497 pPrev = nullptr;
2498 pFirst = this;
2499 if( pNext )
2500 pNext->pPrev = this;
2501 }
2502
2503 SbUnoMethod::~SbUnoMethod()
2504 {
2505 pParamInfoSeq.reset();
2506
2507 if( this == pFirst )
2508 pFirst = pNext;
2509 else if( pPrev )
2510 pPrev->pNext = pNext;
2511 if( pNext )
2512 pNext->pPrev = pPrev;
2513 }
2514
2515 SbxInfo* SbUnoMethod::GetInfo()
2516 {
2517 if( !pInfo.is() && m_xUnoMethod.is() )
2518 {
2519 SbiInstance* pInst = GetSbData()->pInst;
2520 if( pInst && pInst->IsCompatibility() )
2521 {
2522 pInfo = new SbxInfo();
2523
2524 const Sequence<ParamInfo>& rInfoSeq = getParamInfos();
2525 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2526 sal_uInt32 nParamCount = rInfoSeq.getLength();
2527
2528 for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
2529 {
2530 const ParamInfo& rInfo = pParamInfos[i];
2531 OUString aParamName = rInfo.aName;
2532
2533 pInfo->AddParam( aParamName, SbxVARIANT, SbxFlagBits::Read );
2534 }
2535 }
2536 }
2537 return pInfo.get();
2538 }
2539
2540 const Sequence<ParamInfo>& SbUnoMethod::getParamInfos()
2541 {
2542 if (!pParamInfoSeq)
2543 {
2544 Sequence<ParamInfo> aTmp;
2545 if (m_xUnoMethod.is())
2546 aTmp = m_xUnoMethod->getParameterInfos();
2547 pParamInfoSeq.reset( new Sequence<ParamInfo>(aTmp) );
2548 }
2549 return *pParamInfoSeq;
2550 }
2551
2552 SbUnoProperty::SbUnoProperty
2553 (
2554 const OUString& aName_,
2555 SbxDataType eSbxType,
2556 SbxDataType eRealSbxType,
2557 const Property& aUnoProp_,
2558 sal_Int32 nId_,
2559 bool bInvocation,
2560 bool bUnoStruct
2561 )
2562 : SbxProperty( aName_, eSbxType )
2563 , aUnoProp( aUnoProp_ )
2564 , nId( nId_ )
2565 , mbInvocation( bInvocation )
2566 , mRealType( eRealSbxType )
2567 , mbUnoStruct( bUnoStruct )
2568 {
2569 // as needed establish a dummy array so that SbiRuntime::CheckArray() works
2570 static SbxArrayRef xDummyArray = new SbxArray( SbxVARIANT );
2571 if( eSbxType & SbxARRAY )
2572 PutObject( xDummyArray.get() );
2573 }
2574
2575 SbUnoProperty::~SbUnoProperty()
2576 {}
2577
2578
2579 SbxVariable* SbUnoObject::Find( const OUString& rName, SbxClassType t )
2580 {
2581 static Reference< XIdlMethod > xDummyMethod;
2582 static Property aDummyProp;
2583
2584 SbxVariable* pRes = SbxObject::Find( rName, t );
2585
2586 if( bNeedIntrospection )
2587 doIntrospection();
2588
2589 // New 1999-03-04: Create properties on demand. Therefore search now via
2590 // IntrospectionAccess if a property or a method of the required name exist
2591 if( !pRes )
2592 {
2593 OUString aUName( rName );
2594 if( mxUnoAccess.is() && !bNativeCOMObject )
2595 {
2596 if( mxExactName.is() )
2597 {
2598 OUString aUExactName = mxExactName->getExactName( aUName );
2599 if( !aUExactName.isEmpty() )
2600 {
2601 aUName = aUExactName;
2602 }
2603 }
2604 if( mxUnoAccess->hasProperty( aUName, PropertyConcept::ALL - PropertyConcept::DANGEROUS ) )
2605 {
2606 const Property& rProp = mxUnoAccess->
2607 getProperty( aUName, PropertyConcept::ALL - PropertyConcept::DANGEROUS );
2608
2609 // If the property could be void the type had to be set to Variant
2610 SbxDataType eSbxType;
2611 if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
2612 eSbxType = SbxVARIANT;
2613 else
2614 eSbxType = unoToSbxType( rProp.Type.getTypeClass() );
2615
2616 SbxDataType eRealSbxType = ( ( rProp.Attributes & PropertyAttribute::MAYBEVOID ) ? unoToSbxType( rProp.Type.getTypeClass() ) : eSbxType );
2617 // create the property and superimpose it
2618 auto pProp = tools::make_ref<SbUnoProperty>( rProp.Name, eSbxType, eRealSbxType, rProp, 0, false, ( rProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT ) );
2619 QuickInsert( pProp.get() );
2620 pRes = pProp.get();
2621 }
2622 else if( mxUnoAccess->hasMethod( aUName,
2623 MethodConcept::ALL - MethodConcept::DANGEROUS ) )
2624 {
2625 // address the method
2626 const Reference< XIdlMethod >& rxMethod = mxUnoAccess->
2627 getMethod( aUName, MethodConcept::ALL - MethodConcept::DANGEROUS );
2628
2629 // create SbUnoMethod and superimpose it
2630 auto xMethRef = tools::make_ref<SbUnoMethod>( rxMethod->getName(),
2631 unoToSbxType( rxMethod->getReturnType() ), rxMethod, false );
2632 QuickInsert( xMethRef.get() );
2633 pRes = xMethRef.get();
2634 }
2635
2636 // If nothing was found check via XNameAccess
2637 if( !pRes )
2638 {
2639 try
2640 {
2641 Reference< XNameAccess > xNameAccess( mxUnoAccess->queryAdapter( cppu::UnoType<XPropertySet>::get()), UNO_QUERY );
2642
2643 if( xNameAccess.is() && xNameAccess->hasByName( rName ) )
2644 {
2645 Any aAny = xNameAccess->getByName( rName );
2646
2647 // ATTENTION: Because of XNameAccess, the variable generated here
2648 // may not be included as a fixed property in the object and therefore
2649 // won't be stored anywhere.
2650 // If this leads to problems, it has to be created
2651 // synthetically or a class SbUnoNameAccessProperty,
2652 // which checks the existence on access and which
2653 // is disposed if the name is not found anymore.
2654 pRes = new SbxVariable( SbxVARIANT );
2655 unoToSbxValue( pRes, aAny );
2656 }
2657 }
2658 catch( const NoSuchElementException& e )
2659 {
2660 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
2661 }
2662 catch( const Exception& )
2663 {
2664 // Establish so that the exception error will not be overwritten
2665 if( !pRes )
2666 pRes = new SbxVariable( SbxVARIANT );
2667
2668 implHandleAnyException( ::cppu::getCaughtException() );
2669 }
2670 }
2671 }
2672 if( !pRes && mxInvocation.is() )
2673 {
2674 if( mxExactNameInvocation.is() )
2675 {
2676 OUString aUExactName = mxExactNameInvocation->getExactName( aUName );
2677 if( !aUExactName.isEmpty() )
2678 {
2679 aUName = aUExactName;
2680 }
2681 }
2682
2683 try
2684 {
2685 if( mxInvocation->hasProperty( aUName ) )
2686 {
2687 // create a property and superimpose it
2688 auto xVarRef = tools::make_ref<SbUnoProperty>( aUName, SbxVARIANT, SbxVARIANT, aDummyProp, 0, true, false );
2689 QuickInsert( xVarRef.get() );
2690 pRes = xVarRef.get();
2691 }
2692 else if( mxInvocation->hasMethod( aUName ) )
2693 {
2694 // create SbUnoMethode and superimpose it
2695 auto xMethRef = tools::make_ref<SbUnoMethod>( aUName, SbxVARIANT, xDummyMethod, true );
2696 QuickInsert( xMethRef.get() );
2697 pRes = xMethRef.get();
2698 }
2699 else
2700 {
2701 Reference< XDirectInvocation > xDirectInvoke( mxInvocation, UNO_QUERY );
2702 if ( xDirectInvoke.is() && xDirectInvoke->hasMember( aUName ) )
2703 {
2704 auto xMethRef = tools::make_ref<SbUnoMethod>( aUName, SbxVARIANT, xDummyMethod, true );
2705 QuickInsert( xMethRef.get() );
2706 pRes = xMethRef.get();
2707 }
2708
2709 }
2710 }
2711 catch( const RuntimeException& e )
2712 {
2713 // Establish so that the exception error will not be overwritten
2714 if( !pRes )
2715 pRes = new SbxVariable( SbxVARIANT );
2716
2717 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
2718 }
2719 }
2720 }
2721
2722 // At the very end checking if the Dbg_-Properties are meant
2723
2724 if( !pRes )
2725 {
2726 if( rName.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES) ||
2727 rName.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES) ||
2728 rName.equalsIgnoreAsciiCase(ID_DBG_METHODS) )
2729 {
2730 // Create
2731 implCreateDbgProperties();
2732
2733 // Now they have to be found regular
2734 pRes = SbxObject::Find( rName, SbxClassType::DontCare );
2735 }
2736 }
2737 return pRes;
2738 }
2739
2740
2741 // help method to create the dbg_-Properties
2742 void SbUnoObject::implCreateDbgProperties()
2743 {
2744 Property aProp;
2745
2746 // Id == -1: display the implemented interfaces corresponding the ClassProvider
2747 auto xVarRef = tools::make_ref<SbUnoProperty>( OUString(ID_DBG_SUPPORTEDINTERFACES), SbxSTRING, SbxSTRING, aProp, -1, false, false );
2748 QuickInsert( xVarRef.get() );
2749
2750 // Id == -2: output the properties
2751 xVarRef = tools::make_ref<SbUnoProperty>( OUString(ID_DBG_PROPERTIES), SbxSTRING, SbxSTRING, aProp, -2, false, false );
2752 QuickInsert( xVarRef.get() );
2753
2754 // Id == -3: output the Methods
2755 xVarRef = tools::make_ref<SbUnoProperty>( OUString(ID_DBG_METHODS), SbxSTRING, SbxSTRING, aProp, -3, false, false );
2756 QuickInsert( xVarRef.get() );
2757 }
2758
2759 void SbUnoObject::implCreateAll()
2760 {
2761 // throw away all existing methods and properties
2762 pMethods = tools::make_ref<SbxArray>();
2763 pProps = tools::make_ref<SbxArray>();
2764
2765 if( bNeedIntrospection ) doIntrospection();
2766
2767 // get introspection
2768 Reference< XIntrospectionAccess > xAccess = mxUnoAccess;
2769 if( !xAccess.is() || bNativeCOMObject )
2770 {
2771 if( mxInvocation.is() )
2772 xAccess = mxInvocation->getIntrospection();
2773 else if( bNativeCOMObject )
2774 return;
2775 }
2776 if( !xAccess.is() )
2777 return;
2778
2779 // Establish properties
2780 Sequence<Property> props = xAccess->getProperties( PropertyConcept::ALL - PropertyConcept::DANGEROUS );
2781 sal_uInt32 nPropCount = props.getLength();
2782 const Property* pProps_ = props.getConstArray();
2783
2784 sal_uInt32 i;
2785 for( i = 0 ; i < nPropCount ; i++ )
2786 {
2787 const Property& rProp = pProps_[ i ];
2788
2789 // If the property could be void the type had to be set to Variant
2790 SbxDataType eSbxType;
2791 if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
2792 eSbxType = SbxVARIANT;
2793 else
2794 eSbxType = unoToSbxType( rProp.Type.getTypeClass() );
2795
2796 SbxDataType eRealSbxType = ( ( rProp.Attributes & PropertyAttribute::MAYBEVOID ) ? unoToSbxType( rProp.Type.getTypeClass() ) : eSbxType );
2797 // Create property and superimpose it
2798 auto xVarRef = tools::make_ref<SbUnoProperty>( rProp.Name, eSbxType, eRealSbxType, rProp, i, false, ( rProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT ) );
2799 QuickInsert( xVarRef.get() );
2800 }
2801
2802 // Create Dbg_-Properties
2803 implCreateDbgProperties();
2804
2805 // Create methods
2806 Sequence< Reference< XIdlMethod > > aMethodSeq = xAccess->getMethods
2807 ( MethodConcept::ALL - MethodConcept::DANGEROUS );
2808 sal_uInt32 nMethCount = aMethodSeq.getLength();
2809 const Reference< XIdlMethod >* pMethods_ = aMethodSeq.getConstArray();
2810 for( i = 0 ; i < nMethCount ; i++ )
2811 {
2812 // address method
2813 const Reference< XIdlMethod >& rxMethod = pMethods_[i];
2814
2815 // Create SbUnoMethod and superimpose it
2816 auto xMethRef = tools::make_ref<SbUnoMethod>
2817 ( rxMethod->getName(), unoToSbxType( rxMethod->getReturnType() ), rxMethod, false );
2818 QuickInsert( xMethRef.get() );
2819 }
2820 }
2821
2822
2823 // output the value
2824 Any SbUnoObject::getUnoAny()
2825 {
2826 Any aRetAny;
2827 if( bNeedIntrospection ) doIntrospection();
2828 if ( maStructInfo.get() )
2829 aRetAny = maTmpUnoObj;
2830 else if( mxMaterialHolder.is() )
2831 aRetAny = mxMaterialHolder->getMaterial();
2832 else if( mxInvocation.is() )
2833 aRetAny <<= mxInvocation;
2834 return aRetAny;
2835 }
2836
2837 // help method to create a Uno-Struct per CoreReflection
2838 static SbUnoObject* Impl_CreateUnoStruct( const OUString& aClassName )
2839 {
2840 // get CoreReflection
2841 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
2842 if( !xCoreReflection.is() )
2843 return nullptr;
2844
2845 // search for the class
2846 Reference< XIdlClass > xClass;
2847 const Reference< XHierarchicalNameAccess >& xHarryName =
2848 getCoreReflection_HierarchicalNameAccess_Impl();
2849 if( xHarryName.is() && xHarryName->hasByHierarchicalName( aClassName ) )
2850 xClass = xCoreReflection->forName( aClassName );
2851 if( !xClass.is() )
2852 return nullptr;
2853
2854 // Is it really a struct?
2855 TypeClass eType = xClass->getTypeClass();
2856 if ( ( eType != TypeClass_STRUCT ) && ( eType != TypeClass_EXCEPTION ) )
2857 return nullptr;
2858
2859 // create an instance
2860 Any aNewAny;
2861 xClass->createObject( aNewAny );
2862 // make a SbUnoObject out of it
2863 SbUnoObject* pUnoObj = new SbUnoObject( aClassName, aNewAny );
2864 return pUnoObj;
2865 }
2866
2867
2868 // Factory-Class to create Uno-Structs per DIM AS NEW
2869 SbxBase* SbUnoFactory::Create( sal_uInt16, sal_uInt32 )
2870 {
2871 // Via SbxId nothing works in Uno
2872 return nullptr;
2873 }
2874
2875 SbxObject* SbUnoFactory::CreateObject( const OUString& rClassName )
2876 {
2877 return Impl_CreateUnoStruct( rClassName );
2878 }
2879
2880
2881 // Provisional interface for the UNO-Connection
2882 // Deliver a SbxObject, that wrap a Uno-Interface
2883 SbxObjectRef GetSbUnoObject( const OUString& aName, const Any& aUnoObj_ )
2884 {
2885 return new SbUnoObject( aName, aUnoObj_ );
2886 }
2887
2888 // Force creation of all properties for debugging
2889 void createAllObjectProperties( SbxObject* pObj )
2890 {
2891 if( !pObj )
2892 return;
2893
2894 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
2895 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( pObj );
2896 if( pUnoObj )
2897 {
2898 pUnoObj->createAllProperties();
2899 }
2900 else if ( pUnoStructObj )
2901 {
2902 pUnoStructObj->createAllProperties();
2903 }
2904 }
2905
2906
2907 void RTL_Impl_CreateUnoStruct( SbxArray& rPar )
2908 {
2909 // We need 1 parameter minimum
2910 if ( rPar.Count() < 2 )
2911 {
2912 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2913 return;
2914 }
2915
2916 // get the name of the class of the struct
2917 OUString aClassName = rPar.Get(1)->GetOUString();
2918
2919 // try to create Struct with the same name
2920 SbUnoObjectRef xUnoObj = Impl_CreateUnoStruct( aClassName );
2921 if( !xUnoObj.is() )
2922 {
2923 return;
2924 }
2925 // return the object
2926 SbxVariableRef refVar = rPar.Get(0);
2927 refVar->PutObject( xUnoObj.get() );
2928 }
2929
2930 void RTL_Impl_CreateUnoService( SbxArray& rPar )
2931 {
2932 // We need 1 Parameter minimum
2933 if ( rPar.Count() < 2 )
2934 {
2935 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2936 return;
2937 }
2938
2939 // get the name of the class of the struct
2940 OUString aServiceName = rPar.Get(1)->GetOUString();
2941
2942 // search for the service and instantiate it
2943 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
2944 Reference< XInterface > xInterface;
2945 try
2946 {
2947 xInterface = xFactory->createInstance( aServiceName );
2948 }
2949 catch( const Exception& )
2950 {
2951 implHandleAnyException( ::cppu::getCaughtException() );
2952 }
2953
2954 SbxVariableRef refVar = rPar.Get(0);
2955 if( xInterface.is() )
2956 {
2957 // Create a SbUnoObject out of it and return it
2958 SbUnoObjectRef xUnoObj = new SbUnoObject( aServiceName, Any(xInterface) );
2959 if( xUnoObj->getUnoAny().hasValue() )
2960 {
2961 // return the object
2962 refVar->PutObject( xUnoObj.get() );
2963 }
2964 else
2965 {
2966 refVar->PutObject( nullptr );
2967 }
2968 }
2969 else
2970 {
2971 refVar->PutObject( nullptr );
2972 }
2973 }
2974
2975 void RTL_Impl_CreateUnoServiceWithArguments( SbxArray& rPar )
2976 {
2977 // We need 2 parameter minimum
2978 if ( rPar.Count() < 3 )
2979 {
2980 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2981 return;
2982 }
2983
2984 // get the name of the class of the struct
2985 OUString aServiceName = rPar.Get(1)->GetOUString();
2986 Any aArgAsAny = sbxToUnoValue( rPar.Get(2),
2987 cppu::UnoType<Sequence<Any>>::get() );
2988 Sequence< Any > aArgs;
2989 aArgAsAny >>= aArgs;
2990
2991 // search for the service and instantiate it
2992 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
2993 Reference< XInterface > xInterface;
2994 try
2995 {
2996 xInterface = xFactory->createInstanceWithArguments( aServiceName, aArgs );
2997 }
2998 catch( const Exception& )
2999 {
3000 implHandleAnyException( ::cppu::getCaughtException() );
3001 }
3002
3003 SbxVariableRef refVar = rPar.Get(0);
3004 if( xInterface.is() )
3005 {
3006 // Create a SbUnoObject out of it and return it
3007 SbUnoObjectRef xUnoObj = new SbUnoObject( aServiceName, Any(xInterface) );
3008 if( xUnoObj->getUnoAny().hasValue() )
3009 {
3010 // return the object
3011 refVar->PutObject( xUnoObj.get() );
3012 }
3013 else
3014 {
3015 refVar->PutObject( nullptr );
3016 }
3017 }
3018 else
3019 {
3020 refVar->PutObject( nullptr );
3021 }
3022 }
3023
3024 void RTL_Impl_GetProcessServiceManager( SbxArray& rPar )
3025 {
3026 SbxVariableRef refVar = rPar.Get(0);
3027
3028 // get the global service manager
3029 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
3030
3031 // Create a SbUnoObject out of it and return it
3032 SbUnoObjectRef xUnoObj = new SbUnoObject( "ProcessServiceManager", Any(xFactory) );
3033 refVar->PutObject( xUnoObj.get() );
3034 }
3035
3036 void RTL_Impl_HasInterfaces( SbxArray& rPar )
3037 {
3038 // We need 2 parameter minimum
3039 sal_uInt16 nParCount = rPar.Count();
3040 if( nParCount < 3 )
3041 {
3042 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3043 return;
3044 }
3045
3046 // variable for the return value
3047 SbxVariableRef refVar = rPar.Get(0);
3048 refVar->PutBool( false );
3049
3050 // get the Uno-Object
3051 SbxBaseRef pObj = rPar.Get( 1 )->GetObject();
3052 auto obj = dynamic_cast<SbUnoObject*>( pObj.get() );
3053 if( obj == nullptr )
3054 {
3055 return;
3056 }
3057 Any aAny = obj->getUnoAny();
3058 auto x = o3tl::tryAccess<Reference<XInterface>>(aAny);
3059 if( !x )
3060 {
3061 return;
3062 }
3063
3064 // get CoreReflection
3065 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
3066 if( !xCoreReflection.is() )
3067 {
3068 return;
3069 }
3070 for( sal_uInt16 i = 2 ; i < nParCount ; i++ )
3071 {
3072 // get the name of the interface of the struct
3073 OUString aIfaceName = rPar.Get( i )->GetOUString();
3074
3075 // search for the class
3076 Reference< XIdlClass > xClass = xCoreReflection->forName( aIfaceName );
3077 if( !xClass.is() )
3078 {
3079 return;
3080 }
3081 // check if the interface will be supported
3082 OUString aClassName = xClass->getName();
3083 Type aClassType( xClass->getTypeClass(), aClassName );
3084 if( !(*x)->queryInterface( aClassType ).hasValue() )
3085 {
3086 return;
3087 }
3088 }
3089
3090 // Everything works; then return TRUE
3091 refVar->PutBool( true );
3092 }
3093
3094 void RTL_Impl_IsUnoStruct( SbxArray& rPar )
3095 {
3096 // We need 1 parameter minimum
3097 if ( rPar.Count() < 2 )
3098 {
3099 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3100 return;
3101 }
3102
3103 // variable for the return value
3104 SbxVariableRef refVar = rPar.Get(0);
3105 refVar->PutBool( false );
3106
3107 // get the Uno-Object
3108 SbxVariableRef xParam = rPar.Get( 1 );
3109 if( !xParam->IsObject() )
3110 {
3111 return;
3112 }
3113 SbxBaseRef pObj = rPar.Get( 1 )->GetObject();
3114 auto obj = dynamic_cast<SbUnoObject*>( pObj.get() );
3115 if( obj == nullptr )
3116 {
3117 return;
3118 }
3119 Any aAny = obj->getUnoAny();
3120 TypeClass eType = aAny.getValueType().getTypeClass();
3121 if( eType == TypeClass_STRUCT )
3122 {
3123 refVar->PutBool( true );
3124 }
3125 }
3126
3127
3128 void RTL_Impl_EqualUnoObjects( SbxArray& rPar )
3129 {
3130 if ( rPar.Count() < 3 )
3131 {
3132 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3133 return;
3134 }
3135
3136 // variable for the return value
3137 SbxVariableRef refVar = rPar.Get(0);
3138 refVar->PutBool( false );
3139
3140 // get the Uno-Objects
3141 SbxVariableRef xParam1 = rPar.Get( 1 );
3142 if( !xParam1->IsObject() )
3143 {
3144 return;
3145 }
3146 SbxBaseRef pObj1 = xParam1->GetObject();
3147 auto obj1 = dynamic_cast<SbUnoObject*>( pObj1.get() );
3148 if( obj1 == nullptr )
3149 {
3150 return;
3151 }
3152 Any aAny1 = obj1->getUnoAny();
3153 TypeClass eType1 = aAny1.getValueType().getTypeClass();
3154 if( eType1 != TypeClass_INTERFACE )
3155 {
3156 return;
3157 }
3158 Reference< XInterface > x1;
3159 aAny1 >>= x1;
3160
3161 SbxVariableRef xParam2 = rPar.Get( 2 );
3162 if( !xParam2->IsObject() )
3163 {
3164 return;
3165 }
3166 SbxBaseRef pObj2 = xParam2->GetObject();
3167 auto obj2 = dynamic_cast<SbUnoObject*>( pObj2.get() );
3168 if( obj2 == nullptr )
3169 {
3170 return;
3171 }
3172 Any aAny2 = obj2->getUnoAny();
3173 TypeClass eType2 = aAny2.getValueType().getTypeClass();
3174 if( eType2 != TypeClass_INTERFACE )
3175 {
3176 return;
3177 }
3178 Reference< XInterface > x2;
3179 aAny2 >>= x2;
3180
3181 if( x1 == x2 )
3182 {
3183 refVar->PutBool( true );
3184 }
3185 }
3186
3187
3188 // helper wrapper function to interact with TypeProvider and
3189 // XTypeDescriptionEnumerationAccess.
3190 // if it fails for whatever reason
3191 // returned Reference<> be null e.g. .is() will be false
3192
3193 static Reference< XTypeDescriptionEnumeration > getTypeDescriptorEnumeration( const OUString& sSearchRoot,
3194 const Sequence< TypeClass >& types,
3195 TypeDescriptionSearchDepth depth )
3196 {
3197 Reference< XTypeDescriptionEnumeration > xEnum;
3198 Reference< XTypeDescriptionEnumerationAccess> xTypeEnumAccess( getTypeProvider_Impl(), UNO_QUERY );
3199 if ( xTypeEnumAccess.is() )
3200 {
3201 try
3202 {
3203 xEnum = xTypeEnumAccess->createTypeDescriptionEnumeration(
3204 sSearchRoot, types, depth );
3205 }
3206 catch(const NoSuchTypeNameException& /*nstne*/ ) {}
3207 catch(const InvalidTypeNameException& /*nstne*/ ) {}
3208 }
3209 return xEnum;
3210 }
3211
3212 VBAConstantHelper&
3213 VBAConstantHelper::instance()
3214 {
3215 static VBAConstantHelper aHelper;
3216 return aHelper;
3217 }
3218
3219 void VBAConstantHelper::init()
3220 {
3221 if ( !isInited )
3222 {
3223 Sequence< TypeClass > types(1);
3224 types[ 0 ] = TypeClass_CONSTANTS;
3225 Reference< XTypeDescriptionEnumeration > xEnum = getTypeDescriptorEnumeration( "ooo.vba", types, TypeDescriptionSearchDepth_INFINITE );
3226
3227 if ( !xEnum.is())
3228 {
3229 return; //NULL;
3230 }
3231 while ( xEnum->hasMoreElements() )
3232 {
3233 Reference< XConstantsTypeDescription > xConstants( xEnum->nextElement(), UNO_QUERY );
3234 if ( xConstants.is() )
3235 {
3236 // store constant group name
3237 OUString sFullName = xConstants->getName();
3238 sal_Int32 indexLastDot = sFullName.lastIndexOf('.');
3239 OUString sLeafName( sFullName );
3240 if ( indexLastDot > -1 )
3241 {
3242 sLeafName = sFullName.copy( indexLastDot + 1);
3243 }
3244 aConstCache.push_back( sLeafName ); // assume constant group names are unique
3245 Sequence< Reference< XConstantTypeDescription > > aConsts = xConstants->getConstants();
3246 for (sal_Int32 i = 0; i != aConsts.getLength(); ++i)
3247 {
3248 // store constant member name
3249 sFullName = aConsts[i]->getName();
3250 indexLastDot = sFullName.lastIndexOf('.');
3251 sLeafName = sFullName;
3252 if ( indexLastDot > -1 )
3253 {
3254 sLeafName = sFullName.copy( indexLastDot + 1);
3255 }
3256 aConstHash[ sLeafName.toAsciiLowerCase() ] = aConsts[i]->getConstantValue();
3257 }
3258 }
3259 }
3260 isInited = true;
3261 }
3262 }
3263
3264 bool
3265 VBAConstantHelper::isVBAConstantType( const OUString& rName )
3266 {
3267 init();
3268 bool bConstant = false;
3269
3270 for (auto const& elem : aConstCache)
3271 {
3272 if( rName.equalsIgnoreAsciiCase(elem) )
3273 {
3274 bConstant = true;
3275 break;
3276 }
3277 }
3278 return bConstant;
3279 }
3280
3281 SbxVariable*
3282 VBAConstantHelper::getVBAConstant( const OUString& rName )
3283 {
3284 SbxVariable* pConst = nullptr;
3285 init();
3286
3287 auto it = aConstHash.find( rName.toAsciiLowerCase() );
3288
3289 if ( it != aConstHash.end() )
3290 {
3291 pConst = new SbxVariable( SbxVARIANT );
3292 pConst->SetName( rName );
3293 unoToSbxValue( pConst, it->second );
3294 }
3295
3296 return pConst;
3297 }
3298
3299 // Function to search for a global identifier in the
3300 // UnoScope and to wrap it for Sbx
3301 SbUnoClass* findUnoClass( const OUString& rName )
3302 {
3303 // #105550 Check if module exists
3304 SbUnoClass* pUnoClass = nullptr;
3305
3306 const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
3307 if( xTypeAccess->hasByHierarchicalName( rName ) )
3308 {
3309 Any aRet = xTypeAccess->getByHierarchicalName( rName );
3310 Reference< XTypeDescription > xTypeDesc;
3311 aRet >>= xTypeDesc;
3312
3313 if( xTypeDesc.is() )
3314 {
3315 TypeClass eTypeClass = xTypeDesc->getTypeClass();
3316 if( eTypeClass == TypeClass_MODULE || eTypeClass == TypeClass_CONSTANTS )
3317 {
3318 pUnoClass = new SbUnoClass( rName );
3319 }
3320 }
3321 }
3322 return pUnoClass;
3323 }
3324
3325 SbxVariable* SbUnoClass::Find( const OUString& rName, SbxClassType )
3326 {
3327 SbxVariable* pRes = SbxObject::Find( rName, SbxClassType::Variable );
3328
3329 // If nothing were located the submodule isn't known yet
3330 if( !pRes )
3331 {
3332 // If it is already a class, ask for the field
3333 if( m_xClass.is() )
3334 {
3335 // Is it a field(?)
3336 Reference< XIdlField > xField = m_xClass->getField( rName );
3337 if( xField.is() )
3338 {
3339 try
3340 {
3341 Any aAny = xField->get( {} ); //TODO: does this make sense?
3342
3343 // Convert to Sbx
3344 pRes = new SbxVariable( SbxVARIANT );
3345 pRes->SetName( rName );
3346 unoToSbxValue( pRes, aAny );
3347 }
3348 catch( const Exception& )
3349 {
3350 implHandleAnyException( ::cppu::getCaughtException() );
3351 }
3352 }
3353 }
3354 else
3355 {
3356 // expand fully qualified name
3357 OUString aNewName = GetName()
3358 + "."
3359 + rName;
3360
3361 // get CoreReflection
3362 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
3363 if( xCoreReflection.is() )
3364 {
3365 // Is it a constant?
3366 Reference< XHierarchicalNameAccess > xHarryName( xCoreReflection, UNO_QUERY );
3367 if( xHarryName.is() )
3368 {
3369 try
3370 {
3371 Any aValue = xHarryName->getByHierarchicalName( aNewName );
3372 TypeClass eType = aValue.getValueType().getTypeClass();
3373
3374 // Interface located? Then it is a class
3375 if( eType == TypeClass_INTERFACE )
3376 {
3377 Reference< XIdlClass > xClass( aValue, UNO_QUERY );
3378 if( xClass.is() )
3379 {
3380 pRes = new SbxVariable( SbxVARIANT );
3381 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoClass( aNewName, xClass ));
3382 pRes->PutObject( xWrapper.get() );
3383 }
3384 }
3385 else
3386 {
3387 pRes = new SbxVariable( SbxVARIANT );
3388 unoToSbxValue( pRes, aValue );
3389 }
3390 }
3391 catch( const NoSuchElementException& )
3392 {
3393 }
3394 }
3395
3396 // Otherwise take it again as class
3397 if( !pRes )
3398 {
3399 SbUnoClass* pNewClass = findUnoClass( aNewName );
3400 if( pNewClass )
3401 {
3402 pRes = new SbxVariable( SbxVARIANT );
3403 SbxObjectRef xWrapper = static_cast<SbxObject*>(pNewClass);
3404 pRes->PutObject( xWrapper.get() );
3405 }
3406 }
3407
3408 // A UNO service?
3409 if( !pRes )
3410 {
3411 SbUnoService* pUnoService = findUnoService( aNewName );
3412 if( pUnoService )
3413 {
3414 pRes = new SbxVariable( SbxVARIANT );
3415 SbxObjectRef xWrapper = static_cast<SbxObject*>(pUnoService);
3416 pRes->PutObject( xWrapper.get() );
3417 }
3418 }
3419
3420 // A UNO singleton?
3421 if( !pRes )
3422 {
3423 SbUnoSingleton* pUnoSingleton = findUnoSingleton( aNewName );
3424 if( pUnoSingleton )
3425 {
3426 pRes = new SbxVariable( SbxVARIANT );
3427 SbxObjectRef xWrapper = static_cast<SbxObject*>(pUnoSingleton);
3428 pRes->PutObject( xWrapper.get() );
3429 }
3430 }
3431 }
3432 }
3433
3434 if( pRes )
3435 {
3436 pRes->SetName( rName );
3437
3438 // Insert variable, so that it could be found later
3439 QuickInsert( pRes );
3440
3441 // Take us out as listener at once,
3442 // the values are all constant
3443 if( pRes->IsBroadcaster() )
3444 EndListening( pRes->GetBroadcaster(), true );
3445 }
3446 }
3447 return pRes;
3448 }
3449
3450
3451 SbUnoService* findUnoService( const OUString& rName )
3452 {
3453 SbUnoService* pSbUnoService = nullptr;
3454
3455 const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
3456 if( xTypeAccess->hasByHierarchicalName( rName ) )
3457 {
3458 Any aRet = xTypeAccess->getByHierarchicalName( rName );
3459 Reference< XTypeDescription > xTypeDesc;
3460 aRet >>= xTypeDesc;
3461
3462 if( xTypeDesc.is() )
3463 {
3464 TypeClass eTypeClass = xTypeDesc->getTypeClass();
3465 if( eTypeClass == TypeClass_SERVICE )
3466 {
3467 Reference< XServiceTypeDescription2 > xServiceTypeDesc( xTypeDesc, UNO_QUERY );
3468 if( xServiceTypeDesc.is() )
3469 pSbUnoService = new SbUnoService( rName, xServiceTypeDesc );
3470 }
3471 }
3472 }
3473 return pSbUnoService;
3474 }
3475
3476 SbxVariable* SbUnoService::Find( const OUString& rName, SbxClassType )
3477 {
3478 SbxVariable* pRes = SbxObject::Find( rName, SbxClassType::Method );
3479
3480 if( !pRes )
3481 {
3482 // If it is already a class ask for a field
3483 if( m_bNeedsInit && m_xServiceTypeDesc.is() )
3484 {
3485 m_bNeedsInit = false;
3486
3487 Sequence< Reference< XServiceConstructorDescription > > aSCDSeq = m_xServiceTypeDesc->getConstructors();
3488 const Reference< XServiceConstructorDescription >* pCtorSeq = aSCDSeq.getConstArray();
3489 int nCtorCount = aSCDSeq.getLength();
3490 for( int i = 0 ; i < nCtorCount ; ++i )
3491 {
3492 Reference< XServiceConstructorDescription > xCtor = pCtorSeq[i];
3493
3494 OUString aName( xCtor->getName() );
3495 if( aName.isEmpty() )
3496 {
3497 if( xCtor->isDefaultConstructor() )
3498 {
3499 aName = "create";
3500 }
3501 }
3502
3503 if( !aName.isEmpty() )
3504 {
3505 // Create and insert SbUnoServiceCtor
3506 SbxVariableRef xSbCtorRef = new SbUnoServiceCtor( aName, xCtor );
3507 QuickInsert( xSbCtorRef.get() );
3508 }
3509 }
3510 pRes = SbxObject::Find( rName, SbxClassType::Method );
3511 }
3512 }
3513
3514 return pRes;
3515 }
3516
3517 void SbUnoService::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
3518 {
3519 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
3520 if( pHint )
3521 {
3522 SbxVariable* pVar = pHint->GetVar();
3523 SbxArray* pParams = pVar->GetParameters();
3524 SbUnoServiceCtor* pUnoCtor = dynamic_cast<SbUnoServiceCtor*>( pVar );
3525 if( pUnoCtor && pHint->GetId() == SfxHintId::BasicDataWanted )
3526 {
3527 // Parameter count -1 because of Param0 == this
3528 sal_uInt32 nParamCount = pParams ? (static_cast<sal_uInt32>(pParams->Count()) - 1) : 0;
3529 Sequence<Any> args;
3530
3531 Reference< XServiceConstructorDescription > xCtor = pUnoCtor->getServiceCtorDesc();
3532 Sequence< Reference< XParameter > > aParameterSeq = xCtor->getParameters();
3533 const Reference< XParameter >* pParameterSeq = aParameterSeq.getConstArray();
3534 sal_uInt32 nUnoParamCount = aParameterSeq.getLength();
3535
3536 // Default: Ignore not needed parameters
3537 bool bParameterError = false;
3538
3539 // Is the last parameter a rest parameter?
3540 bool bRestParameterMode = false;
3541 if( nUnoParamCount > 0 )
3542 {
3543 Reference< XParameter > xLastParam = pParameterSeq[ nUnoParamCount - 1 ];
3544 if( xLastParam.is() )
3545 {
3546 if( xLastParam->isRestParameter() )
3547 bRestParameterMode = true;
3548 }
3549 }
3550
3551 // Too many parameters with context as first parameter?
3552 sal_uInt16 nSbxParameterOffset = 1;
3553 sal_uInt16 nParameterOffsetByContext = 0;
3554 Reference < XComponentContext > xFirstParamContext;
3555 if( nParamCount > nUnoParamCount )
3556 {
3557 // Check if first parameter is a context and use it
3558 // then in createInstanceWithArgumentsAndContext
3559 Any aArg0 = sbxToUnoValue( pParams->Get( nSbxParameterOffset ) );
3560 if( (aArg0 >>= xFirstParamContext) && xFirstParamContext.is() )
3561 nParameterOffsetByContext = 1;
3562 }
3563
3564 sal_uInt32 nEffectiveParamCount = nParamCount - nParameterOffsetByContext;
3565 sal_uInt32 nAllocParamCount = nEffectiveParamCount;
3566 if( nEffectiveParamCount > nUnoParamCount )
3567 {
3568 if( !bRestParameterMode )
3569 {
3570 nEffectiveParamCount = nUnoParamCount;
3571 nAllocParamCount = nUnoParamCount;
3572 }
3573 }
3574 // Not enough parameters?
3575 else if( nUnoParamCount > nEffectiveParamCount )
3576 {
3577 // RestParameterMode only helps if one (the last) parameter is missing
3578 int nDiff = nUnoParamCount - nEffectiveParamCount;
3579 if( !bRestParameterMode || nDiff > 1 )
3580 {
3581 bParameterError = true;
3582 StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL );
3583 }
3584 }
3585
3586 if( !bParameterError )
3587 {
3588 bool bOutParams = false;
3589 if( nAllocParamCount > 0 )
3590 {
3591 args.realloc( nAllocParamCount );
3592 Any* pAnyArgs = args.getArray();
3593 for( sal_uInt32 i = 0 ; i < nEffectiveParamCount ; i++ )
3594 {
3595 sal_uInt16 iSbx = static_cast<sal_uInt16>(i + nSbxParameterOffset + nParameterOffsetByContext);
3596
3597 // bRestParameterMode allows nEffectiveParamCount > nUnoParamCount
3598 Reference< XParameter > xParam;
3599 if( i < nUnoParamCount )
3600 {
3601 xParam = pParameterSeq[i];
3602 if( !xParam.is() )
3603 continue;
3604
3605 Reference< XTypeDescription > xParamTypeDesc = xParam->getType();
3606 if( !xParamTypeDesc.is() )
3607 continue;
3608 css::uno::Type aType( xParamTypeDesc->getTypeClass(), xParamTypeDesc->getName() );
3609
3610 // sbx parameter needs offset 1
3611 pAnyArgs[i] = sbxToUnoValue( pParams->Get( iSbx ), aType );
3612
3613 // Check for out parameter if not already done
3614 if( !bOutParams && xParam->isOut() )
3615 bOutParams = true;
3616 }
3617 else
3618 {
3619 pAnyArgs[i] = sbxToUnoValue( pParams->Get( iSbx ) );
3620 }
3621 }
3622 }
3623
3624 // "Call" ctor using createInstanceWithArgumentsAndContext
3625 Reference < XComponentContext > xContext(
3626 xFirstParamContext.is()
3627 ? xFirstParamContext
3628 : comphelper::getProcessComponentContext() );
3629 Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
3630
3631 Any aRetAny;
3632 OUString aServiceName = GetName();
3633 Reference < XInterface > xRet;
3634 try
3635 {
3636 xRet = xServiceMgr->createInstanceWithArgumentsAndContext( aServiceName, args, xContext );
3637 }
3638 catch( const Exception& )
3639 {
3640 implHandleAnyException( ::cppu::getCaughtException() );
3641 }
3642 aRetAny <<= xRet;
3643 unoToSbxValue( pVar, aRetAny );
3644
3645 // Copy back out parameters?
3646 if( bOutParams )
3647 {
3648 const Any* pAnyArgs = args.getConstArray();
3649
3650 for( sal_uInt32 j = 0 ; j < nUnoParamCount ; j++ )
3651 {
3652 Reference< XParameter > xParam = pParameterSeq[j];
3653 if( !xParam.is() )
3654 continue;
3655
3656 if( xParam->isOut() )
3657 unoToSbxValue( pParams->Get( static_cast<sal_uInt16>(j+1) ), pAnyArgs[ j ] );
3658 }
3659 }
3660 }
3661 }
3662 else
3663 SbxObject::Notify( rBC, rHint );
3664 }
3665 }
3666
3667
3668 SbUnoServiceCtor::SbUnoServiceCtor( const OUString& aName_, Reference< XServiceConstructorDescription > const & xServiceCtorDesc )
3669 : SbxMethod( aName_, SbxOBJECT )
3670 , m_xServiceCtorDesc( xServiceCtorDesc )
3671 {
3672 }
3673
3674 SbUnoServiceCtor::~SbUnoServiceCtor()
3675 {
3676 }
3677
3678 SbxInfo* SbUnoServiceCtor::GetInfo()
3679 {
3680 SbxInfo* pRet = nullptr;
3681
3682 return pRet;
3683 }
3684
3685
3686 SbUnoSingleton* findUnoSingleton( const OUString& rName )
3687 {
3688 SbUnoSingleton* pSbUnoSingleton = nullptr;
3689
3690 const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
3691 if( xTypeAccess->hasByHierarchicalName( rName ) )
3692 {
3693 Any aRet = xTypeAccess->getByHierarchicalName( rName );
3694 Reference< XTypeDescription > xTypeDesc;
3695 aRet >>= xTypeDesc;
3696
3697 if( xTypeDesc.is() )
3698 {
3699 TypeClass eTypeClass = xTypeDesc->getTypeClass();
3700 if( eTypeClass == TypeClass_SINGLETON )
3701 {
3702 Reference< XSingletonTypeDescription > xSingletonTypeDesc( xTypeDesc, UNO_QUERY );
3703 if( xSingletonTypeDesc.is() )
3704 pSbUnoSingleton = new SbUnoSingleton( rName );
3705 }
3706 }
3707 }
3708 return pSbUnoSingleton;
3709 }
3710
3711 SbUnoSingleton::SbUnoSingleton( const OUString& aName_ )
3712 : SbxObject( aName_ )
3713 {
3714 SbxVariableRef xGetMethodRef = new SbxMethod( "get", SbxOBJECT );
3715 QuickInsert( xGetMethodRef.get() );
3716 }
3717
3718 void SbUnoSingleton::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
3719 {
3720 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
3721 if( pHint )
3722 {
3723 SbxVariable* pVar = pHint->GetVar();
3724 SbxArray* pParams = pVar->GetParameters();
3725 sal_uInt32 nParamCount = pParams ? (static_cast<sal_uInt32>(pParams->Count()) - 1) : 0;
3726 sal_uInt32 nAllowedParamCount = 1;
3727
3728 Reference < XComponentContext > xContextToUse;
3729 if( nParamCount > 0 )
3730 {
3731 // Check if first parameter is a context and use it then
3732 Reference < XComponentContext > xFirstParamContext;
3733 Any aArg1 = sbxToUnoValue( pParams->Get( 1 ) );
3734 if( (aArg1 >>= xFirstParamContext) && xFirstParamContext.is() )
3735 xContextToUse = xFirstParamContext;
3736 }
3737
3738 if( !xContextToUse.is() )
3739 {
3740 xContextToUse = comphelper::getProcessComponentContext();
3741 --nAllowedParamCount;
3742 }
3743
3744 if( nParamCount > nAllowedParamCount )
3745 {
3746 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3747 return;
3748 }
3749
3750 Any aRetAny;
3751 if( xContextToUse.is() )
3752 {
3753 OUString aSingletonName = "/singletons/"
3754 + GetName();
3755 Reference < XInterface > xRet;
3756 xContextToUse->getValueByName( aSingletonName ) >>= xRet;
3757 aRetAny <<= xRet;
3758 }
3759 unoToSbxValue( pVar, aRetAny );
3760 }
3761 else
3762 {
3763 SbxObject::Notify( rBC, rHint );
3764 }
3765 }
3766
3767
3768 // Implementation of an EventAttacher-drawn AllListener, which
3769 // solely transmits several events to a general AllListener
3770 class BasicAllListener_Impl : public WeakImplHelper< XAllListener >
3771 {
3772 void firing_impl(const AllEventObject& Event, Any* pRet);
3773
3774 public:
3775 SbxObjectRef xSbxObj;
3776 OUString aPrefixName;
3777
3778 explicit BasicAllListener_Impl( const OUString& aPrefixName );
3779
3780 // Methods of XAllListener
3781 virtual void SAL_CALL firing(const AllEventObject& Event) override;
3782 virtual Any SAL_CALL approveFiring(const AllEventObject& Event) override;
3783
3784 // Methods of XEventListener
3785 virtual void SAL_CALL disposing(const EventObject& Source) override;
3786 };
3787
3788
3789 BasicAllListener_Impl::BasicAllListener_Impl(const OUString& aPrefixName_)
3790 : aPrefixName( aPrefixName_ )
3791 {
3792 }
3793
3794 void BasicAllListener_Impl::firing_impl( const AllEventObject& Event, Any* pRet )
3795 {
3796 SolarMutexGuard guard;
3797
3798 if( xSbxObj.is() )
3799 {
3800 OUString aMethodName = aPrefixName + Event.MethodName;
3801
3802 SbxVariable * pP = xSbxObj.get();
3803 while( pP->GetParent() )
3804 {
3805 pP = pP->GetParent();
3806 StarBASIC * pLib = dynamic_cast<StarBASIC*>( pP );
3807 if( pLib )
3808 {
3809 // Create in a Basic Array
3810 SbxArrayRef xSbxArray = new SbxArray( SbxVARIANT );
3811 const Any * pArgs = Event.Arguments.getConstArray();
3812 sal_Int32 nCount = Event.Arguments.getLength();
3813 for( sal_Int32 i = 0; i < nCount; i++ )
3814 {
3815 // Convert elements
3816 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
3817 unoToSbxValue( xVar.get(), pArgs[i] );
3818 xSbxArray->Put( xVar.get(), sal::static_int_cast< sal_uInt16 >(i+1) );
3819 }
3820
3821 pLib->Call( aMethodName, xSbxArray.get() );
3822
3823 // get the return value from the Param-Array, if requested
3824 if( pRet )
3825 {
3826 SbxVariable* pVar = xSbxArray->Get( 0 );
3827 if( pVar )
3828 {
3829 // #95792 Avoid a second call
3830 SbxFlagBits nFlags = pVar->GetFlags();
3831 pVar->SetFlag( SbxFlagBits::NoBroadcast );
3832 *pRet = sbxToUnoValueImpl( pVar );
3833 pVar->SetFlags( nFlags );
3834 }
3835 }
3836 break;
3837 }
3838 }
3839 }
3840 }
3841
3842
3843 // Methods of Listener
3844 void BasicAllListener_Impl::firing( const AllEventObject& Event )
3845 {
3846 firing_impl( Event, nullptr );
3847 }
3848
3849 Any BasicAllListener_Impl::approveFiring( const AllEventObject& Event )
3850 {
3851 Any aRetAny;
3852 firing_impl( Event, &aRetAny );
3853 return aRetAny;
3854 }
3855
3856
3857 // Methods of XEventListener
3858 void BasicAllListener_Impl ::disposing(const EventObject& )
3859 {
3860 SolarMutexGuard guard;
3861
3862 xSbxObj.clear();
3863 }
3864
3865
3866 // class InvocationToAllListenerMapper
3867 // helper class to map XInvocation to XAllListener (also in project eventattacher!)
3868
3869 class InvocationToAllListenerMapper : public WeakImplHelper< XInvocation >
3870 {
3871 public:
3872 InvocationToAllListenerMapper( const Reference< XIdlClass >& ListenerType,
3873 const Reference< XAllListener >& AllListener, const Any& Helper );
3874
3875 // XInvocation
3876 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection() override;
3877 virtual Any SAL_CALL invoke(const OUString& FunctionName, const Sequence< Any >& Params, Sequence< sal_Int16 >& OutParamIndex, Sequence< Any >& OutParam) override;
3878 virtual void SAL_CALL setValue(const OUString& PropertyName, const Any& Value) override;
3879 virtual Any SAL_CALL getValue(const OUString& PropertyName) override;
3880 virtual sal_Bool SAL_CALL hasMethod(const OUString& Name) override;
3881 virtual sal_Bool SAL_CALL hasProperty(const OUString& Name) override;
3882
3883 private:
3884 Reference< XAllListener > m_xAllListener;
3885 Reference< XIdlClass > m_xListenerType;
3886 Any m_Helper;
3887 };
3888
3889
3890 // Function to replace AllListenerAdapterService::createAllListerAdapter
3891 static Reference< XInterface > createAllListenerAdapter
3892 (
3893 const Reference< XInvocationAdapterFactory2 >& xInvocationAdapterFactory,
3894 const Reference< XIdlClass >& xListenerType,
3895 const Reference< XAllListener >& xListener,
3896 const Any& Helper
3897 )
3898 {
3899 Reference< XInterface > xAdapter;
3900 if( xInvocationAdapterFactory.is() && xListenerType.is() && xListener.is() )
3901 {
3902 Reference< XInvocation > xInvocationToAllListenerMapper =
3903 new InvocationToAllListenerMapper(xListenerType, xListener, Helper);
3904 Type aListenerType( xListenerType->getTypeClass(), xListenerType->getName() );
3905 Sequence<Type> arg2(1);
3906 arg2[0] = aListenerType;
3907 xAdapter = xInvocationAdapterFactory->createAdapter( xInvocationToAllListenerMapper, arg2 );
3908 }
3909 return xAdapter;
3910 }
3911
3912
3913 // InvocationToAllListenerMapper
3914 InvocationToAllListenerMapper::InvocationToAllListenerMapper
3915 ( const Reference< XIdlClass >& ListenerType, const Reference< XAllListener >& AllListener, const Any& Helper )
3916 : m_xAllListener( AllListener )
3917 , m_xListenerType( ListenerType )
3918 , m_Helper( Helper )
3919 {
3920 }
3921
3922
3923 Reference< XIntrospectionAccess > SAL_CALL InvocationToAllListenerMapper::getIntrospection()
3924 {
3925 return Reference< XIntrospectionAccess >();
3926 }
3927
3928
3929 Any SAL_CALL InvocationToAllListenerMapper::invoke(const OUString& FunctionName, const Sequence< Any >& Params,
3930 Sequence< sal_Int16 >&, Sequence< Any >&)
3931 {
3932 Any aRet;
3933
3934 // Check if to firing or approveFiring has to be called
3935 Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( FunctionName );
3936 bool bApproveFiring = false;
3937 if( !xMethod.is() )
3938 return aRet;
3939 Reference< XIdlClass > xReturnType = xMethod->getReturnType();
3940 Sequence< Reference< XIdlClass > > aExceptionSeq = xMethod->getExceptionTypes();
3941 if( ( xReturnType.is() && xReturnType->getTypeClass() != TypeClass_VOID ) ||
3942 aExceptionSeq.hasElements() )
3943 {
3944 bApproveFiring = true;
3945 }
3946 else
3947 {
3948 Sequence< ParamInfo > aParamSeq = xMethod->getParameterInfos();
3949 sal_uInt32 nParamCount = aParamSeq.getLength();
3950 if( nParamCount > 1 )
3951 {
3952 const ParamInfo* pInfo = aParamSeq.getConstArray();
3953 for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
3954 {
3955 if( pInfo[ i ].aMode != ParamMode_IN )
3956 {
3957 bApproveFiring = true;
3958 break;
3959 }
3960 }
3961 }
3962 }
3963
3964 AllEventObject aAllEvent;
3965 aAllEvent.Source = static_cast<OWeakObject*>(this);
3966 aAllEvent.Helper = m_Helper;
3967 aAllEvent.ListenerType = Type(m_xListenerType->getTypeClass(), m_xListenerType->getName() );
3968 aAllEvent.MethodName = FunctionName;
3969 aAllEvent.Arguments = Params;
3970 if( bApproveFiring )
3971 aRet = m_xAllListener->approveFiring( aAllEvent );
3972 else
3973 m_xAllListener->firing( aAllEvent );
3974 return aRet;
3975 }
3976
3977
3978 void SAL_CALL InvocationToAllListenerMapper::setValue(const OUString&, const Any&)
3979 {}
3980
3981
3982 Any SAL_CALL InvocationToAllListenerMapper::getValue(const OUString&)
3983 {
3984 return Any();
3985 }
3986
3987
3988 sal_Bool SAL_CALL InvocationToAllListenerMapper::hasMethod(const OUString& Name)
3989 {
3990 Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( Name );
3991 return xMethod.is();
3992 }
3993
3994
3995 sal_Bool SAL_CALL InvocationToAllListenerMapper::hasProperty(const OUString& Name)
3996 {
3997 Reference< XIdlField > xField = m_xListenerType->getField( Name );
3998 return xField.is();
3999 }
4000
4001
4002 // create Uno-Service
4003 // 1. Parameter == Prefix-Name of the macro
4004 // 2. Parameter == fully qualified name of the listener
4005 void SbRtl_CreateUnoListener(StarBASIC * pBasic, SbxArray & rPar, bool)
4006 {
4007 // We need 2 parameters
4008 if ( rPar.Count() != 3 )
4009 {
4010 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4011 return;
4012 }
4013
4014 // get the name of the class of the struct
4015 OUString aPrefixName = rPar.Get(1)->GetOUString();
4016 OUString aListenerClassName = rPar.Get(2)->GetOUString();
4017
4018 // get the CoreReflection
4019 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
4020 if( !xCoreReflection.is() )
4021 return;
4022
4023 // get the AllListenerAdapterService
4024 Reference< XComponentContext > xContext( comphelper::getProcessComponentContext() );
4025
4026 // search the class
4027 Reference< XIdlClass > xClass = xCoreReflection->forName( aListenerClassName );
4028 if( !xClass.is() )
4029 return;
4030
4031 // From 1999-11-30: get the InvocationAdapterFactory
4032 Reference< XInvocationAdapterFactory2 > xInvocationAdapterFactory =
4033 InvocationAdapterFactory::create( xContext );
4034
4035 BasicAllListener_Impl * p;
4036 Reference< XAllListener > xAllLst = p = new BasicAllListener_Impl( aPrefixName );
4037 Any aTmp;
4038 Reference< XInterface > xLst = createAllListenerAdapter( xInvocationAdapterFactory, xClass, xAllLst, aTmp );
4039 if( !xLst.is() )
4040 return;
4041
4042 OUString aClassName = xClass->getName();
4043 Type aClassType( xClass->getTypeClass(), aClassName );
4044 aTmp = xLst->queryInterface( aClassType );
4045 if( !aTmp.hasValue() )
4046 return;
4047
4048 SbUnoObject* pUnoObj = new SbUnoObject( aListenerClassName, aTmp );
4049 p->xSbxObj = pUnoObj;
4050 p->xSbxObj->SetParent( pBasic );
4051
4052 // #100326 Register listener object to set Parent NULL in Dtor
4053 SbxArrayRef xBasicUnoListeners = pBasic->getUnoListeners();
4054 xBasicUnoListeners->Insert( pUnoObj, xBasicUnoListeners->Count() );
4055
4056 // return the object
4057 SbxVariableRef refVar = rPar.Get(0);
4058 refVar->PutObject( p->xSbxObj.get() );
4059 }
4060
4061
4062 // Represents the DefaultContext property of the ProcessServiceManager
4063 // in the Basic runtime system.
4064 void RTL_Impl_GetDefaultContext( SbxArray& rPar )
4065 {
4066 SbxVariableRef refVar = rPar.Get(0);
4067
4068 Any aContextAny( comphelper::getProcessComponentContext() );
4069
4070 SbUnoObjectRef xUnoObj = new SbUnoObject( "DefaultContext", aContextAny );
4071 refVar->PutObject( xUnoObj.get() );
4072 }
4073
4074
4075 // Creates a Basic wrapper object for a strongly typed Uno value
4076 // 1. parameter: Uno type as full qualified type name, e.g. "byte[]"
4077 void RTL_Impl_CreateUnoValue( SbxArray& rPar )
4078 {
4079 // 2 parameters needed
4080 if ( rPar.Count() != 3 )
4081 {
4082 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4083 return;
4084 }
4085
4086 // get the name of the class of the struct
4087 OUString aTypeName = rPar.Get(1)->GetOUString();
4088 SbxVariable* pVal = rPar.Get(2);
4089
4090 if( aTypeName == "type" )
4091 {
4092 SbxDataType eBaseType = pVal->SbxValue::GetType();
4093 OUString aValTypeName;
4094 if( eBaseType == SbxSTRING )
4095 {
4096 aValTypeName = pVal->GetOUString();
4097 }
4098 else if( eBaseType == SbxOBJECT )
4099 {
4100 // XIdlClass?
4101 Reference< XIdlClass > xIdlClass;
4102
4103 SbxBaseRef pObj = pVal->GetObject();
4104 if( auto obj = dynamic_cast<SbUnoObject*>( pObj.get() ) )
4105 {
4106 Any aUnoAny = obj->getUnoAny();
4107 aUnoAny >>= xIdlClass;
4108 }
4109
4110 if( xIdlClass.is() )
4111 {
4112 aValTypeName = xIdlClass->getName();
4113 }
4114 }
4115 Type aType;
4116 bool bSuccess = implGetTypeByName( aValTypeName, aType );
4117 if( bSuccess )
4118 {
4119 Any aTypeAny( aType );
4120 SbxVariableRef refVar = rPar.Get(0);
4121 SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aTypeAny );
4122 refVar->PutObject( xUnoAnyObject.get() );
4123 }
4124 return;
4125 }
4126
4127 // Check the type
4128 const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
4129 Any aRet;
4130 try
4131 {
4132 aRet = xTypeAccess->getByHierarchicalName( aTypeName );
4133 }
4134 catch( const NoSuchElementException& e1 )
4135 {
4136 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
4137 implGetExceptionMsg( e1, "com.sun.star.container.NoSuchElementException" ) );
4138 return;
4139 }
4140 Reference< XTypeDescription > xTypeDesc;
4141 aRet >>= xTypeDesc;
4142 TypeClass eTypeClass = xTypeDesc->getTypeClass();
4143 Type aDestType( eTypeClass, aTypeName );
4144
4145
4146 // Preconvert value
4147 Any aVal = sbxToUnoValueImpl( pVal );
4148 Any aConvertedVal = convertAny( aVal, aDestType );
4149
4150 SbxVariableRef refVar = rPar.Get(0);
4151 SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aConvertedVal );
4152 refVar->PutObject( xUnoAnyObject.get() );
4153 }
4154
4155
4156 class ModuleInvocationProxy : public WeakImplHelper< XInvocation, XComponent >
4157 {
4158 ::osl::Mutex m_aMutex;
4159 OUString m_aPrefix;
4160 SbxObjectRef m_xScopeObj;
4161 bool m_bProxyIsClassModuleObject;
4162
4163 ::comphelper::OInterfaceContainerHelper2 m_aListeners;
4164
4165 public:
4166 ModuleInvocationProxy( OUString const & aPrefix, SbxObjectRef const & xScopeObj );
4167
4168 // XInvocation
4169 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection() override;
4170 virtual void SAL_CALL setValue( const OUString& rProperty, const Any& rValue ) override;
4171 virtual Any SAL_CALL getValue( const OUString& rProperty ) override;
4172 virtual sal_Bool SAL_CALL hasMethod( const OUString& rName ) override;
4173 virtual sal_Bool SAL_CALL hasProperty( const OUString& rProp ) override;
4174
4175 virtual Any SAL_CALL invoke( const OUString& rFunction,
4176 const Sequence< Any >& rParams,
4177 Sequence< sal_Int16 >& rOutParamIndex,
4178 Sequence< Any >& rOutParam ) override;
4179
4180 // XComponent
4181 virtual void SAL_CALL dispose() override;
4182 virtual void SAL_CALL addEventListener( const Reference< XEventListener >& xListener ) override;
4183 virtual void SAL_CALL removeEventListener( const Reference< XEventListener >& aListener ) override;
4184 };
4185
4186 ModuleInvocationProxy::ModuleInvocationProxy( OUString const & aPrefix, SbxObjectRef const & xScopeObj )
4187 : m_aMutex()
4188 , m_aPrefix( aPrefix + "_" )
4189 , m_xScopeObj( xScopeObj )
4190 , m_aListeners( m_aMutex )
4191 {
4192 m_bProxyIsClassModuleObject = xScopeObj.is() && dynamic_cast<const SbClassModuleObject*>( xScopeObj.get() ) != nullptr;
4193 }
4194
4195 Reference< XIntrospectionAccess > SAL_CALL ModuleInvocationProxy::getIntrospection()
4196 {
4197 return Reference< XIntrospectionAccess >();
4198 }
4199
4200 void SAL_CALL ModuleInvocationProxy::setValue(const OUString& rProperty, const Any& rValue)
4201 {
4202 if( !m_bProxyIsClassModuleObject )
4203 throw UnknownPropertyException();
4204
4205 SolarMutexGuard guard;
4206
4207 OUString aPropertyFunctionName = "Property Set "
4208 + m_aPrefix
4209 + rProperty;
4210
4211 SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxClassType::Method );
4212 SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
4213 if( pMeth == nullptr )
4214 {
4215 // TODO: Check vba behavior concerning missing function
4216 //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
4217 throw UnknownPropertyException(aPropertyFunctionName);
4218 }
4219
4220 // Setup parameter
4221 SbxArrayRef xArray = new SbxArray;
4222 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
4223 unoToSbxValue( xVar.get(), rValue );
4224 xArray->Put( xVar.get(), 1 );
4225
4226 // Call property method
4227 SbxVariableRef xValue = new SbxVariable;
4228 pMeth->SetParameters( xArray.get() );
4229 pMeth->Call( xValue.get() );
4230 pMeth->SetParameters( nullptr );
4231
4232 // TODO: OutParameter?
4233
4234
4235 }
4236
4237 Any SAL_CALL ModuleInvocationProxy::getValue(const OUString& rProperty)
4238 {
4239 if( !m_bProxyIsClassModuleObject )
4240 {
4241 throw UnknownPropertyException();
4242 }
4243 SolarMutexGuard guard;
4244
4245 OUString aPropertyFunctionName = "Property Get "
4246 + m_aPrefix
4247 + rProperty;
4248
4249 SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxClassType::Method );
4250 SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
4251 if( pMeth == nullptr )
4252 {
4253 // TODO: Check vba behavior concerning missing function
4254 //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
4255 throw UnknownPropertyException(aPropertyFunctionName);
4256 }
4257
4258 // Call method
4259 SbxVariableRef xValue = new SbxVariable;
4260 pMeth->Call( xValue.get() );
4261 Any aRet = sbxToUnoValue( xValue.get() );
4262 return aRet;
4263 }
4264
4265 sal_Bool SAL_CALL ModuleInvocationProxy::hasMethod( const OUString& )
4266 {
4267 return false;
4268 }
4269
4270 sal_Bool SAL_CALL ModuleInvocationProxy::hasProperty( const OUString& )
4271 {
4272 return false;
4273 }
4274
4275 Any SAL_CALL ModuleInvocationProxy::invoke( const OUString& rFunction,
4276 const Sequence< Any >& rParams,
4277 Sequence< sal_Int16 >&,
4278 Sequence< Any >& )
4279 {
4280 SolarMutexGuard guard;
4281
4282 Any aRet;
4283 SbxObjectRef xScopeObj = m_xScopeObj;
4284 if( !xScopeObj.is() )
4285 {
4286 return aRet;
4287 }
4288 OUString aFunctionName = m_aPrefix
4289 + rFunction;
4290
4291 bool bSetRescheduleBack = false;
4292 bool bOldReschedule = true;
4293 SbiInstance* pInst = GetSbData()->pInst;
4294 if( pInst && pInst->IsCompatibility() )
4295 {
4296 bOldReschedule = pInst->IsReschedule();
4297 if ( bOldReschedule )
4298 {
4299 pInst->EnableReschedule( false );
4300 bSetRescheduleBack = true;
4301 }
4302 }
4303
4304 SbxVariable* p = xScopeObj->Find( aFunctionName, SbxClassType::Method );
4305 SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
4306 if( pMeth == nullptr )
4307 {
4308 // TODO: Check vba behavior concerning missing function
4309 //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
4310 return aRet;
4311 }
4312
4313 // Setup parameters
4314 SbxArrayRef xArray;
4315 sal_Int32 nParamCount = rParams.getLength();
4316 if( nParamCount )
4317 {
4318 xArray = new SbxArray;
4319 const Any *pArgs = rParams.getConstArray();
4320 for( sal_Int32 i = 0 ; i < nParamCount ; i++ )
4321 {
4322 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
4323 unoToSbxValue( xVar.get(), pArgs[i] );
4324 xArray->Put( xVar.get(), sal::static_int_cast< sal_uInt16 >(i+1) );
4325 }
4326 }
4327
4328 // Call method
4329 SbxVariableRef xValue = new SbxVariable;
4330 if( xArray.is() )
4331 pMeth->SetParameters( xArray.get() );
4332 pMeth->Call( xValue.get() );
4333 aRet = sbxToUnoValue( xValue.get() );
4334 pMeth->SetParameters( nullptr );
4335
4336 if( bSetRescheduleBack )
4337 pInst->EnableReschedule( bOldReschedule );
4338
4339 // TODO: OutParameter?
4340
4341 return aRet;
4342 }
4343
4344 void SAL_CALL ModuleInvocationProxy::dispose()
4345 {
4346 ::osl::MutexGuard aGuard( m_aMutex );
4347
4348 EventObject aEvent( static_cast<XComponent*>(this) );
4349 m_aListeners.disposeAndClear( aEvent );
4350
4351 m_xScopeObj = nullptr;
4352 }
4353
4354 void SAL_CALL ModuleInvocationProxy::addEventListener( const Reference< XEventListener >& xListener )
4355 {
4356 m_aListeners.addInterface( xListener );
4357 }
4358
4359 void SAL_CALL ModuleInvocationProxy::removeEventListener( const Reference< XEventListener >& xListener )
4360 {
4361 m_aListeners.removeInterface( xListener );
4362 }
4363
4364
4365 Reference< XInterface > createComListener( const Any& aControlAny, const OUString& aVBAType,
4366 const OUString& aPrefix, const SbxObjectRef& xScopeObj )
4367 {
4368 Reference< XInterface > xRet;
4369
4370 Reference< XComponentContext > xContext(
4371 comphelper::getProcessComponentContext() );
4372 Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
4373
4374 Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPrefix, xScopeObj );
4375
4376 Sequence<Any> args( 3 );
4377 args[0] = aControlAny;
4378 args[1] <<= aVBAType;
4379 args[2] <<= xProxy;
4380
4381 try
4382 {
4383 xRet = xServiceMgr->createInstanceWithArgumentsAndContext(
4384 "com.sun.star.custom.UnoComListener",
4385 args, xContext );
4386 }
4387 catch( const Exception& )
4388 {
4389 implHandleAnyException( ::cppu::getCaughtException() );
4390 }
4391
4392 return xRet;
4393 }
4394
4395 typedef std::vector< WeakReference< XComponent > > ComponentRefVector;
4396
4397 struct StarBasicDisposeItem
4398 {
4399 StarBASIC* m_pBasic;
4400 SbxArrayRef m_pRegisteredVariables;
4401 ComponentRefVector m_vComImplementsObjects;
4402
4403 explicit StarBasicDisposeItem( StarBASIC* pBasic )
4404 : m_pBasic( pBasic )
4405 , m_pRegisteredVariables(new SbxArray())
4406 {
4407 }
4408 };
4409
4410 typedef std::vector< StarBasicDisposeItem* > DisposeItemVector;
4411
4412 static DisposeItemVector GaDisposeItemVector;
4413
4414 static DisposeItemVector::iterator lcl_findItemForBasic( StarBASIC const * pBasic )
4415 {
4416 return std::find_if(GaDisposeItemVector.begin(), GaDisposeItemVector.end(),
4417 [&pBasic](StarBasicDisposeItem* pItem) { return pItem->m_pBasic == pBasic; });
4418 }
4419
4420 static StarBasicDisposeItem* lcl_getOrCreateItemForBasic( StarBASIC* pBasic )
4421 {
4422 DisposeItemVector::iterator it = lcl_findItemForBasic( pBasic );
4423 StarBasicDisposeItem* pItem = (it != GaDisposeItemVector.end()) ? *it : nullptr;
4424 if( pItem == nullptr )
4425 {
4426 pItem = new StarBasicDisposeItem( pBasic );
4427 GaDisposeItemVector.push_back( pItem );
4428 }
4429 return pItem;
4430 }
4431
4432 void registerComponentToBeDisposedForBasic
4433 ( const Reference< XComponent >& xComponent, StarBASIC* pBasic )
4434 {
4435 StarBasicDisposeItem* pItem = lcl_getOrCreateItemForBasic( pBasic );
4436 pItem->m_vComImplementsObjects.emplace_back(xComponent );
4437 }
4438
4439 void registerComListenerVariableForBasic( SbxVariable* pVar, StarBASIC* pBasic )
4440 {
4441 StarBasicDisposeItem* pItem = lcl_getOrCreateItemForBasic( pBasic );
4442 SbxArray* pArray = pItem->m_pRegisteredVariables.get();
4443 pArray->Put( pVar, pArray->Count() );
4444 }
4445
4446 void disposeComVariablesForBasic( StarBASIC const * pBasic )
4447 {
4448 DisposeItemVector::iterator it = lcl_findItemForBasic( pBasic );
4449 if( it != GaDisposeItemVector.end() )
4450 {
4451 StarBasicDisposeItem* pItem = *it;
4452
4453 SbxArray* pArray = pItem->m_pRegisteredVariables.get();
4454 sal_uInt16 nCount = pArray->Count();
4455 for( sal_uInt16 i = 0 ; i < nCount ; ++i )
4456 {
4457 SbxVariable* pVar = pArray->Get( i );
4458 pVar->ClearComListener();
4459 }
4460
4461 ComponentRefVector& rv = pItem->m_vComImplementsObjects;
4462 for (auto const& elem : rv)
4463 {
4464 Reference< XComponent > xComponent( elem.get(), UNO_QUERY );
4465 if (xComponent.is())
4466 xComponent->dispose();
4467 }
4468
4469 delete pItem;
4470 GaDisposeItemVector.erase( it );
4471 }
4472 }
4473
4474
4475 // Handle module implements mechanism for OLE types
4476 bool SbModule::createCOMWrapperForIface( Any& o_rRetAny, SbClassModuleObject* pProxyClassModuleObject )
4477 {
4478 // For now: Take first interface that allows to instantiate COM wrapper
4479 // TODO: Check if support for multiple interfaces is needed
4480
4481 Reference< XComponentContext > xContext(
4482 comphelper::getProcessComponentContext() );
4483 Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
4484 Reference< XSingleServiceFactory > xComImplementsFactory
4485 (
4486 xServiceMgr->createInstanceWithContext( "com.sun.star.custom.ComImplementsFactory", xContext ),
4487 UNO_QUERY
4488 );
4489 if( !xComImplementsFactory.is() )
4490 return false;
4491
4492 bool bSuccess = false;
4493
4494 SbxArray* pModIfaces = pClassData->mxIfaces.get();
4495 sal_uInt16 nCount = pModIfaces->Count();
4496 for( sal_uInt16 i = 0 ; i < nCount ; ++i )
4497 {
4498 SbxVariable* pVar = pModIfaces->Get( i );
4499 const OUString& aIfaceName = pVar->GetName();
4500
4501 if( !aIfaceName.isEmpty() )
4502 {
4503 OUString aPureIfaceName = aIfaceName;
4504 sal_Int32 indexLastDot = aIfaceName.lastIndexOf('.');
4505 if ( indexLastDot > -1 )
4506 {
4507 aPureIfaceName = aIfaceName.copy( indexLastDot + 1 );
4508 }
4509 Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPureIfaceName, pProxyClassModuleObject );
4510
4511 Sequence<Any> args( 2 );
4512 args[0] <<= aIfaceName;
4513 args[1] <<= xProxy;
4514
4515 Reference< XInterface > xRet;
4516 try
4517 {
4518 xRet = xComImplementsFactory->createInstanceWithArguments( args );
4519 bSuccess = true;
4520 }
4521 catch( const Exception& )
4522 {
4523 implHandleAnyException( ::cppu::getCaughtException() );
4524 }
4525
4526 if( bSuccess )
4527 {
4528 Reference< XComponent > xComponent( xProxy, UNO_QUERY );
4529 if( xComponent.is() )
4530 {
4531 StarBASIC* pParentBasic = nullptr;
4532 SbxObject* pCurObject = this;
4533 do
4534 {
4535 SbxObject* pObjParent = pCurObject->GetParent();
4536 pParentBasic = dynamic_cast<StarBASIC*>( pObjParent );
4537 pCurObject = pObjParent;
4538 }
4539 while( pParentBasic == nullptr && pCurObject != nullptr );
4540
4541 OSL_ASSERT( pParentBasic != nullptr );
4542 registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
4543 }
4544
4545 o_rRetAny <<= xRet;
4546 break;
4547 }
4548 }
4549 }
4550
4551 return bSuccess;
4552 }
4553
4554
4555 // Due to an incorrect behavior IE returns an object instead of a string
4556 // in some scenarios. Calling toString at the object may correct this.
4557 // Helper function used in sbxvalue.cxx
4558 bool handleToStringForCOMObjects( SbxObject* pObj, SbxValue* pVal )
4559 {
4560 bool bSuccess = false;
4561
4562 if( auto pUnoObj = dynamic_cast<SbUnoObject*>( pObj) )
4563 {
4564 // Only for native COM objects
4565 if( pUnoObj->isNativeCOMObject() )
4566 {
4567 SbxVariableRef pMeth = pObj->Find( "toString", SbxClassType::Method );
4568 if ( pMeth.is() )
4569 {
4570 SbxValues aRes;
4571 pMeth->Get( aRes );
4572 pVal->Put( aRes );
4573 bSuccess = true;
4574 }
4575 }
4576 }
4577 return bSuccess;
4578 }
4579
4580 Any StructRefInfo::getValue()
4581 {
4582 Any aRet;
4583 uno_any_destruct(
4584 &aRet, reinterpret_cast< uno_ReleaseFunc >(cpp_release) );
4585 typelib_TypeDescription * pTD = nullptr;
4586 maType.getDescription(&pTD);
4587 uno_any_construct(
4588 &aRet, getInst(), pTD,
4589 reinterpret_cast< uno_AcquireFunc >(cpp_acquire) );
4590 typelib_typedescription_release(pTD);
4591 return aRet;
4592 }
4593
4594 void StructRefInfo::setValue( const Any& rValue )
4595 {
4596 bool bSuccess = uno_type_assignData( getInst(),
4597 maType.getTypeLibType(),
4598 const_cast<void*>(rValue.getValue()),
4599 rValue.getValueTypeRef(),
4600 reinterpret_cast< uno_QueryInterfaceFunc >(cpp_queryInterface),
4601 reinterpret_cast< uno_AcquireFunc >(cpp_acquire),
4602 reinterpret_cast< uno_ReleaseFunc >(cpp_release) );
4603 OSL_ENSURE(bSuccess,
4604 "StructRefInfo::setValue: ooops... the value could not be assigned!");
4605 }
4606
4607 OUString StructRefInfo::getTypeName() const
4608 {
4609 return maType.getTypeName();
4610 }
4611
4612 void* StructRefInfo::getInst()
4613 {
4614 return const_cast<char *>(static_cast<char const *>(maAny.getValue()) + mnPos);
4615 }
4616
4617 TypeClass StructRefInfo::getTypeClass() const
4618 {
4619 return maType.getTypeClass();
4620 }
4621
4622 SbUnoStructRefObject::SbUnoStructRefObject( const OUString& aName_, const StructRefInfo& rMemberInfo ) : SbxObject( aName_ ), maMemberInfo( rMemberInfo ), mbMemberCacheInit( false )
4623 {
4624 SetClassName( maMemberInfo.getTypeName() );
4625 }
4626
4627 SbUnoStructRefObject::~SbUnoStructRefObject()
4628 {
4629 }
4630
4631 void SbUnoStructRefObject::initMemberCache()
4632 {
4633 if ( mbMemberCacheInit )
4634 return;
4635 typelib_TypeDescription * pTD = nullptr;
4636 maMemberInfo.getType().getDescription(&pTD);
4637 typelib_CompoundTypeDescription * pCompTypeDescr = reinterpret_cast<typelib_CompoundTypeDescription *>(pTD);
4638 for ( pCompTypeDescr = reinterpret_cast<typelib_CompoundTypeDescription *>(pTD); pCompTypeDescr;
4639 pCompTypeDescr = pCompTypeDescr->pBaseTypeDescription )
4640 {
4641 typelib_TypeDescriptionReference ** ppTypeRefs = pCompTypeDescr->ppTypeRefs;
4642 rtl_uString ** ppNames = pCompTypeDescr->ppMemberNames;
4643 sal_Int32 * pMemberOffsets = pCompTypeDescr->pMemberOffsets;
4644 for ( sal_Int32 nPos = pCompTypeDescr->nMembers; nPos--; )
4645 {
4646 OUString aName( ppNames[nPos] );
4647 maFields[ aName ] = std::make_unique<StructRefInfo>( maMemberInfo.getRootAnyRef(), ppTypeRefs[nPos], maMemberInfo.getPos() + pMemberOffsets[nPos] );
4648 }
4649 }
4650 typelib_typedescription_release(pTD);
4651 mbMemberCacheInit = true;
4652 }
4653
4654 SbxVariable* SbUnoStructRefObject::Find( const OUString& rName, SbxClassType t )
4655 {
4656 SbxVariable* pRes = SbxObject::Find( rName, t );
4657 if ( !pRes )
4658 {
4659 if ( !mbMemberCacheInit )
4660 initMemberCache();
4661 StructFieldInfo::iterator it = maFields.find( rName );
4662 if ( it != maFields.end() )
4663 {
4664 SbxDataType eSbxType;
4665 eSbxType = unoToSbxType( it->second->getTypeClass() );
4666 SbxDataType eRealSbxType = eSbxType;
4667 Property aProp;
4668 aProp.Name = rName;
4669 aProp.Type = css::uno::Type( it->second->getTypeClass(), it->second->getTypeName() );
4670 SbUnoProperty* pProp = new SbUnoProperty( rName, eSbxType, eRealSbxType, aProp, 0, false, ( aProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT) );
4671 SbxVariableRef xVarRef = pProp;
4672 QuickInsert( xVarRef.get() );
4673 pRes = xVarRef.get();
4674 }
4675 }
4676
4677 if( !pRes )
4678 {
4679 if( rName.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES) ||
4680 rName.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES) ||
4681 rName.equalsIgnoreAsciiCase(ID_DBG_METHODS) )
4682 {
4683 // Create
4684 implCreateDbgProperties();
4685
4686 // Now they have to be found regular
4687 pRes = SbxObject::Find( rName, SbxClassType::DontCare );
4688 }
4689 }
4690
4691 return pRes;
4692 }
4693
4694 // help method to create the dbg_-Properties
4695 void SbUnoStructRefObject::implCreateDbgProperties()
4696 {
4697 Property aProp;
4698
4699 // Id == -1: display the implemented interfaces corresponding the ClassProvider
4700 SbxVariableRef xVarRef = new SbUnoProperty( ID_DBG_SUPPORTEDINTERFACES, SbxSTRING, SbxSTRING, aProp, -1, false, false );
4701 QuickInsert( xVarRef.get() );
4702
4703 // Id == -2: output the properties
4704 xVarRef = new SbUnoProperty( ID_DBG_PROPERTIES, SbxSTRING, SbxSTRING, aProp, -2, false, false );
4705 QuickInsert( xVarRef.get() );
4706
4707 // Id == -3: output the Methods
4708 xVarRef = new SbUnoProperty( ID_DBG_METHODS, SbxSTRING, SbxSTRING, aProp, -3, false, false );
4709 QuickInsert( xVarRef.get() );
4710 }
4711
4712 void SbUnoStructRefObject::implCreateAll()
4713 {
4714 // throw away all existing methods and properties
4715 pMethods = new SbxArray;
4716 pProps = new SbxArray;
4717
4718 if (!mbMemberCacheInit)
4719 initMemberCache();
4720
4721 for (auto const& field : maFields)
4722 {
4723 const OUString& rName = field.first;
4724 SbxDataType eSbxType;
4725 eSbxType = unoToSbxType( field.second->getTypeClass() );
4726 SbxDataType eRealSbxType = eSbxType;
4727 Property aProp;
4728 aProp.Name = rName;
4729 aProp.Type = css::uno::Type( field.second->getTypeClass(), field.second->getTypeName() );
4730 SbUnoProperty* pProp = new SbUnoProperty( rName, eSbxType, eRealSbxType, aProp, 0, false, ( aProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT) );
4731 SbxVariableRef xVarRef = pProp;
4732 QuickInsert( xVarRef.get() );
4733 }
4734
4735 // Create Dbg_-Properties
4736 implCreateDbgProperties();
4737 }
4738
4739 // output the value
4740 Any SbUnoStructRefObject::getUnoAny()
4741 {
4742 return maMemberInfo.getValue();
4743 }
4744
4745 OUString SbUnoStructRefObject::Impl_DumpProperties()
4746 {
4747 OUStringBuffer aRet;
4748 aRet.append("Properties of object ");
4749 aRet.append( getDbgObjectName() );
4750
4751 sal_uInt16 nPropCount = pProps->Count();
4752 sal_uInt16 nPropsPerLine = 1 + nPropCount / 30;
4753 for( sal_uInt16 i = 0; i < nPropCount; i++ )
4754 {
4755 SbxVariable* pVar = pProps->Get( i );
4756 if( pVar )
4757 {
4758 OUStringBuffer aPropStr;
4759 if( (i % nPropsPerLine) == 0 )
4760 {
4761 aPropStr.append( "\n" );
4762 }
4763 // output the type and name
4764 // Is it in Uno a sequence?
4765 SbxDataType eType = pVar->GetFullType();
4766
4767 const OUString& aName( pVar->GetName() );
4768 StructFieldInfo::iterator it = maFields.find( aName );
4769
4770 if ( it != maFields.end() )
4771 {
4772 const StructRefInfo& rPropInfo = *it->second;
4773
4774 if( eType == SbxOBJECT )
4775 {
4776 if( rPropInfo.getTypeClass() == TypeClass_SEQUENCE )
4777 {
4778 eType = SbxDataType( SbxOBJECT | SbxARRAY );
4779 }
4780 }
4781 }
4782 aPropStr.append( Dbg_SbxDataType2String( eType ) );
4783
4784 aPropStr.append( " " );
4785 aPropStr.append( pVar->GetName() );
4786
4787 if( i == nPropCount - 1 )
4788 {
4789 aPropStr.append( "\n" );
4790 }
4791 else
4792 {
4793 aPropStr.append( "; " );
4794 }
4795 aRet.append( aPropStr.makeStringAndClear() );
4796 }
4797 }
4798 return aRet.makeStringAndClear();
4799 }
4800
4801 void SbUnoStructRefObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
4802 {
4803 if ( !mbMemberCacheInit )
4804 initMemberCache();
4805 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
4806 if( pHint )
4807 {
4808 SbxVariable* pVar = pHint->GetVar();
4809 SbUnoProperty* pProp = dynamic_cast<SbUnoProperty*>( pVar );
4810 if( pProp )
4811 {
4812 StructFieldInfo::iterator it = maFields.find( pProp->GetName() );
4813 // handle get/set of members of struct
4814 if( pHint->GetId() == SfxHintId::BasicDataWanted )
4815 {
4816 // Test-Properties
4817 sal_Int32 nId = pProp->nId;
4818 if( nId < 0 )
4819 {
4820 // Id == -1: Display implemented interfaces according the ClassProvider
4821 if( nId == -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
4822 {
4823 OUString aRet = OUStringLiteral( ID_DBG_SUPPORTEDINTERFACES )
4824 + " not available.\n(TypeClass is not TypeClass_INTERFACE)\n";
4825
4826 pVar->PutString( aRet );
4827 }
4828 // Id == -2: output properties
4829 else if( nId == -2 ) // Property ID_DBG_PROPERTIES
4830 {
4831 // by now all properties must be established
4832 implCreateAll();
4833 OUString aRetStr = Impl_DumpProperties();
4834 pVar->PutString( aRetStr );
4835 }
4836 // Id == -3: output the methods
4837 else if( nId == -3 ) // Property ID_DBG_METHODS
4838 {
4839 // by now all properties must be established
4840 implCreateAll();
4841 OUString aRet = "Methods of object "
4842 + getDbgObjectName()
4843 + "\nNo methods found\n";
4844 pVar->PutString( aRet );
4845 }
4846 return;
4847 }
4848
4849 if ( it != maFields.end() )
4850 {
4851 Any aRetAny = it->second->getValue();
4852 unoToSbxValue( pVar, aRetAny );
4853 }
4854 else
4855 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
4856 }
4857 else if( pHint->GetId() == SfxHintId::BasicDataChanged )
4858 {
4859 if ( it != maFields.end() )
4860 {
4861 // take over the value from Uno to Sbx
4862 Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
4863 it->second->setValue( aAnyValue );
4864 }
4865 else
4866 StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
4867 }
4868 }
4869 else
4870 SbxObject::Notify( rBC, rHint );
4871 }
4872 }
4873
4874 StructRefInfo SbUnoStructRefObject::getStructMember( const OUString& rMemberName )
4875 {
4876 if (!mbMemberCacheInit)
4877 {
4878 initMemberCache();
4879 }
4880 StructFieldInfo::iterator it = maFields.find( rMemberName );
4881
4882 css::uno::Type aFoundType;
4883 sal_Int32 nFoundPos = -1;
4884
4885 if ( it != maFields.end() )
4886 {
4887 aFoundType = it->second->getType();
4888 nFoundPos = it->second->getPos();
4889 }
4890 StructRefInfo aRet( maMemberInfo.getRootAnyRef(), aFoundType, nFoundPos );
4891 return aRet;
4892 }
4893
4894 OUString SbUnoStructRefObject::getDbgObjectName() const
4895 {
4896 OUString aName = GetClassName();
4897 if( aName.isEmpty() )
4898 {
4899 aName += "Unknown";
4900 }
4901 OUStringBuffer aRet;
4902 if( aName.getLength() > 20 )
4903 {
4904 aRet.append( "\n" );
4905 }
4906 aRet.append( "\"" );
4907 aRet.append( aName );
4908 aRet.append( "\":" );
4909 return aRet.makeStringAndClear();
4910 }
4911
4912 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
FREE OFFICE SUITE