xref: /aoo41x/main/basic/source/classes/sbunoobj.cxx (revision cdf0e10c)
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