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