update dev300-m58
[ooovba.git] / basic / source / classes / sbunoobj.cxx
blob06ae6a5f8d140bad6c2cb6818d3dab9599b8af19
1 /*************************************************************************
3 * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
5 * Copyright 2008 by Sun Microsystems, Inc.
7 * OpenOffice.org - a multi-platform office productivity suite
9 * $RCSfile: sbunoobj.cxx,v $
10 * $Revision: 1.54 $
12 * This file is part of OpenOffice.org.
14 * OpenOffice.org is free software: you can redistribute it and/or modify
15 * it under the terms of the GNU Lesser General Public License version 3
16 * only, as published by the Free Software Foundation.
18 * OpenOffice.org is distributed in the hope that it will be useful,
19 * but WITHOUT ANY WARRANTY; without even the implied warranty of
20 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 * GNU Lesser General Public License version 3 for more details
22 * (a copy is included in the LICENSE file that accompanied this code).
24 * You should have received a copy of the GNU Lesser General Public License
25 * version 3 along with OpenOffice.org. If not, see
26 * <http://www.openoffice.org/license.html>
27 * for a copy of the LGPLv3 License.
29 ************************************************************************/
31 // MARKER(update_precomp.py): autogen include statement, do not remove
32 #include "precompiled_basic.hxx"
33 //#include <stl_queue.h>
34 #include <vos/mutex.hxx>
35 #include <vcl/svapp.hxx>
36 #ifndef _TOOLERR_HXX //autogen
37 #include <tools/errcode.hxx>
38 #endif
39 #include <svtools/hint.hxx>
41 #include <cppuhelper/implbase1.hxx>
42 #include <cppuhelper/exc_hlp.hxx>
43 #include <cppuhelper/typeprovider.hxx>
44 #include <cppuhelper/extract.hxx>
45 #include <comphelper/processfactory.hxx>
47 #include <rtl/ustrbuf.hxx>
48 #include <rtl/strbuf.hxx>
50 #include <com/sun/star/script/ArrayWrapper.hpp>
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/XMultiServiceFactory.hpp>
56 #include <com/sun/star/lang/XServiceInfo.hpp>
57 #include <com/sun/star/beans/PropertyAttribute.hpp>
58 #include <com/sun/star/beans/PropertyConcept.hpp>
59 #include <com/sun/star/beans/MethodConcept.hpp>
60 #include <com/sun/star/beans/XPropertySet.hpp>
61 #include <com/sun/star/script/BasicErrorException.hpp>
62 #include <com/sun/star/script/XAllListener.hpp>
63 #include <com/sun/star/script/XInvocationAdapterFactory.hpp>
64 #include <com/sun/star/script/XTypeConverter.hpp>
65 #include <com/sun/star/script/XDefaultProperty.hpp>
66 #include <com/sun/star/script/XDefaultMethod.hpp>
67 #include <com/sun/star/container/XNameAccess.hpp>
68 #include <com/sun/star/container/XHierarchicalNameAccess.hpp>
69 #include <com/sun/star/reflection/XIdlArray.hpp>
70 #include <com/sun/star/reflection/XIdlReflection.hpp>
71 #include <com/sun/star/reflection/XIdlClassProvider.hpp>
72 #include <com/sun/star/reflection/XServiceConstructorDescription.hpp>
73 #include <com/sun/star/bridge/oleautomation/NamedArgument.hpp>
74 #include <com/sun/star/bridge/oleautomation/Date.hpp>
75 #include <com/sun/star/bridge/oleautomation/Decimal.hpp>
76 #include <com/sun/star/bridge/oleautomation/Currency.hpp>
77 #include <com/sun/star/script/XAutomationInvocation.hpp>
79 using com::sun::star::uno::Reference;
80 using namespace com::sun::star::uno;
81 using namespace com::sun::star::lang;
82 using namespace com::sun::star::reflection;
83 using namespace com::sun::star::beans;
84 using namespace com::sun::star::script;
85 using namespace com::sun::star::container;
86 using namespace com::sun::star::bridge;
87 using namespace cppu;
90 #include<basic/sbstar.hxx>
91 #include<basic/sbuno.hxx>
92 #include<basic/sberrors.hxx>
93 #include<sbunoobj.hxx>
94 #include"sbjsmod.hxx"
95 #include<basic/basmgr.hxx>
96 #include<sbintern.hxx>
97 #include<runtime.hxx>
99 #include<math.h>
100 #include <hash_map>
101 #include <com/sun/star/reflection/XTypeDescriptionEnumerationAccess.hpp>
102 #include <com/sun/star/reflection/XConstantsTypeDescription.hpp>
104 TYPEINIT1(SbUnoMethod,SbxMethod)
105 TYPEINIT1(SbUnoProperty,SbxProperty)
106 TYPEINIT1(SbUnoObject,SbxObject)
107 TYPEINIT1(SbUnoClass,SbxObject)
108 TYPEINIT1(SbUnoService,SbxObject)
109 TYPEINIT1(SbUnoServiceCtor,SbxMethod)
111 typedef WeakImplHelper1< XAllListener > BasicAllListenerHelper;
113 // Flag, um immer ueber Invocation zu gehen
114 //#define INVOCATION_ONLY
117 // Identifier fuer die dbg_-Properies als Strings anlegen
118 static String ID_DBG_SUPPORTEDINTERFACES( RTL_CONSTASCII_USTRINGPARAM("Dbg_SupportedInterfaces") );
119 static String ID_DBG_PROPERTIES( RTL_CONSTASCII_USTRINGPARAM("Dbg_Properties") );
120 static String ID_DBG_METHODS( RTL_CONSTASCII_USTRINGPARAM("Dbg_Methods") );
122 static ::rtl::OUString aSeqLevelStr( RTL_CONSTASCII_USTRINGPARAM("[]") );
123 static ::rtl::OUString defaultNameSpace( RTL_CONSTASCII_USTRINGPARAM("ooo.vba") );
125 // Gets the default property for an uno object. Note: There is some
126 // redirection built in. The property name specifies the name
127 // of the default property.
129 bool SbUnoObject::getDefaultPropName( SbUnoObject* pUnoObj, String& sDfltProp )
131 bool result = false;
132 Reference< XDefaultProperty> xDefaultProp( pUnoObj->maTmpUnoObj, UNO_QUERY );
133 if ( xDefaultProp.is() )
135 sDfltProp = xDefaultProp->getDefaultPropertyName();
136 if ( sDfltProp.Len() )
137 result = true;
139 return result;
142 SbxVariable* getDefaultProp( SbxVariable* pRef )
144 SbxVariable* pDefaultProp = NULL;
145 if ( pRef->GetType() == SbxOBJECT )
147 SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pRef);
148 if ( !pObj )
150 SbxBase* pObjVarObj = pRef->GetObject();
151 pObj = PTR_CAST(SbxObject,pObjVarObj);
153 if ( pObj && pObj->ISA(SbUnoObject) )
155 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxObject*)pObj);
156 pDefaultProp = pUnoObj->GetDfltProperty();
159 return pDefaultProp;
162 void SetSbUnoObjectDfltPropName( SbxObject* pObj )
164 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxObject*) pObj);
165 if ( pUnoObj )
167 String sDfltPropName;
169 if ( SbUnoObject::getDefaultPropName( pUnoObj, sDfltPropName ) )
171 OSL_TRACE("SetSbUnoObjectDfltPropName setting dflt prop for %s", rtl::OUStringToOString( pObj->GetName(), RTL_TEXTENCODING_UTF8 ).getStr() );
172 pUnoObj->SetDfltProperty( sDfltPropName );
177 Reference< XComponentContext > getComponentContext_Impl( void )
179 static Reference< XComponentContext > xContext;
181 // Haben wir schon CoreReflection, sonst besorgen
182 if( !xContext.is() )
184 Reference< XMultiServiceFactory > xFactory = comphelper::getProcessServiceFactory();
185 Reference< XPropertySet > xProps( xFactory, UNO_QUERY );
186 OSL_ASSERT( xProps.is() );
187 if (xProps.is())
189 xProps->getPropertyValue(
190 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("DefaultContext") ) ) >>= xContext;
191 OSL_ASSERT( xContext.is() );
194 return xContext;
197 // CoreReflection statisch speichern
198 Reference< XIdlReflection > getCoreReflection_Impl( void )
200 static Reference< XIdlReflection > xCoreReflection;
202 // Haben wir schon CoreReflection, sonst besorgen
203 if( !xCoreReflection.is() )
205 Reference< XComponentContext > xContext = getComponentContext_Impl();
206 if( xContext.is() )
208 xContext->getValueByName(
209 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("/singletons/com.sun.star.reflection.theCoreReflection") ) )
210 >>= xCoreReflection;
211 OSL_ENSURE( xCoreReflection.is(), "### CoreReflection singleton not accessable!?" );
213 if( !xCoreReflection.is() )
215 throw DeploymentException(
216 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("/singletons/com.sun.star.reflection.theCoreReflection singleton not accessable") ),
217 Reference< XInterface >() );
220 return xCoreReflection;
223 // CoreReflection statisch speichern
224 Reference< XHierarchicalNameAccess > getCoreReflection_HierarchicalNameAccess_Impl( void )
226 static Reference< XHierarchicalNameAccess > xCoreReflection_HierarchicalNameAccess;
228 if( !xCoreReflection_HierarchicalNameAccess.is() )
230 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
231 if( xCoreReflection.is() )
233 xCoreReflection_HierarchicalNameAccess =
234 Reference< XHierarchicalNameAccess >( xCoreReflection, UNO_QUERY );
237 return xCoreReflection_HierarchicalNameAccess;
240 // Hold TypeProvider statically
241 Reference< XHierarchicalNameAccess > getTypeProvider_Impl( void )
243 static Reference< XHierarchicalNameAccess > xAccess;
245 // Haben wir schon CoreReflection, sonst besorgen
246 if( !xAccess.is() )
248 Reference< XComponentContext > xContext = getComponentContext_Impl();
249 if( xContext.is() )
251 xContext->getValueByName(
252 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("/singletons/com.sun.star.reflection.theTypeDescriptionManager") ) )
253 >>= xAccess;
254 OSL_ENSURE( xAccess.is(), "### TypeDescriptionManager singleton not accessable!?" );
256 if( !xAccess.is() )
258 throw DeploymentException(
259 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM
260 ("/singletons/com.sun.star.reflection.theTypeDescriptionManager singleton not accessable") ),
261 Reference< XInterface >() );
264 return xAccess;
267 // Hold TypeConverter statically
268 Reference< XTypeConverter > getTypeConverter_Impl( void )
270 static Reference< XTypeConverter > xTypeConverter;
272 // Haben wir schon CoreReflection, sonst besorgen
273 if( !xTypeConverter.is() )
275 Reference< XComponentContext > xContext = getComponentContext_Impl();
276 if( xContext.is() )
278 Reference<XMultiComponentFactory> xSMgr = xContext->getServiceManager();
279 xTypeConverter = Reference<XTypeConverter>(
280 xSMgr->createInstanceWithContext(
281 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.script.Converter")),
282 xContext ), UNO_QUERY );
284 if( !xTypeConverter.is() )
286 throw DeploymentException(
287 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM
288 ("com.sun.star.script.Converter service not accessable") ),
289 Reference< XInterface >() );
292 return xTypeConverter;
296 // #111851 factory function to create an OLE object
297 SbUnoObject* createOLEObject_Impl( const String& aType )
299 static Reference< XMultiServiceFactory > xOLEFactory;
300 static bool bNeedsInit = true;
302 if( bNeedsInit )
304 bNeedsInit = false;
306 Reference< XComponentContext > xContext = getComponentContext_Impl();
307 if( xContext.is() )
309 Reference<XMultiComponentFactory> xSMgr = xContext->getServiceManager();
310 xOLEFactory = Reference<XMultiServiceFactory>(
311 xSMgr->createInstanceWithContext(
312 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.bridge.OleObjectFactory")),
313 xContext ), UNO_QUERY );
317 SbUnoObject* pUnoObj = NULL;
318 if( xOLEFactory.is() )
320 Reference< XInterface > xOLEObject = xOLEFactory->createInstance( aType );
321 if( xOLEObject.is() )
323 Any aAny;
324 aAny <<= xOLEObject;
325 pUnoObj = new SbUnoObject( aType, aAny );
328 return pUnoObj;
332 namespace
334 void lcl_indent( ::rtl::OUStringBuffer& _inout_rBuffer, sal_Int32 _nLevel )
336 while ( _nLevel-- > 0 )
337 _inout_rBuffer.appendAscii( " " );
341 void implAppendExceptionMsg( ::rtl::OUStringBuffer& _inout_rBuffer, const Exception& _e, const ::rtl::OUString& _rExceptionType, sal_Int32 _nLevel )
343 _inout_rBuffer.appendAscii( "\n" );
344 lcl_indent( _inout_rBuffer, _nLevel );
345 _inout_rBuffer.appendAscii( "Type: " );
347 if ( _rExceptionType.getLength() == 0 )
348 _inout_rBuffer.appendAscii( "Unknown" );
349 else
350 _inout_rBuffer.append( _rExceptionType );
352 _inout_rBuffer.appendAscii( "\n" );
353 lcl_indent( _inout_rBuffer, _nLevel );
354 _inout_rBuffer.appendAscii( "Message: " );
355 _inout_rBuffer.append( _e.Message );
359 // Fehlermeldungs-Message bei Exception zusammenbauen
360 ::rtl::OUString implGetExceptionMsg( const Exception& e, const ::rtl::OUString& aExceptionType_ )
362 ::rtl::OUStringBuffer aMessageBuf;
363 implAppendExceptionMsg( aMessageBuf, e, aExceptionType_, 0 );
364 return aMessageBuf.makeStringAndClear();
367 String implGetExceptionMsg( const Any& _rCaughtException )
369 OSL_PRECOND( _rCaughtException.getValueTypeClass() == TypeClass_EXCEPTION, "implGetExceptionMsg: illegal argument!" );
370 if ( _rCaughtException.getValueTypeClass() != TypeClass_EXCEPTION )
371 return String();
373 return implGetExceptionMsg( *static_cast< const Exception* >( _rCaughtException.getValue() ), _rCaughtException.getValueTypeName() );
376 Any convertAny( const Any& rVal, const Type& aDestType )
378 Any aConvertedVal;
379 Reference< XTypeConverter > xConverter = getTypeConverter_Impl();
382 aConvertedVal = xConverter->convertTo( rVal, aDestType );
384 catch( const IllegalArgumentException& )
386 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
387 implGetExceptionMsg( ::cppu::getCaughtException() ) );
388 return aConvertedVal;
390 catch( CannotConvertException& e2 )
392 String aCannotConvertExceptionName
393 ( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.lang.IllegalArgumentException" ) );
394 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
395 implGetExceptionMsg( e2, aCannotConvertExceptionName ) );
396 return aConvertedVal;
398 return aConvertedVal;
402 // #105565 Special Object to wrap a strongly typed Uno Any
403 TYPEINIT1(SbUnoAnyObject,SbxObject)
406 // TODO: Spaeter auslagern
407 Reference<XIdlClass> TypeToIdlClass( const Type& rType )
409 // void als Default-Klasse eintragen
410 Reference<XIdlClass> xRetClass;
411 typelib_TypeDescription * pTD = 0;
412 rType.getDescription( &pTD );
414 if( pTD )
416 ::rtl::OUString sOWName( pTD->pTypeName );
417 Reference< XIdlReflection > xRefl = getCoreReflection_Impl();
418 xRetClass = xRefl->forName( sOWName );
420 return xRetClass;
423 // Exception type unknown
424 template< class EXCEPTION >
425 String implGetExceptionMsg( const EXCEPTION& e )
427 return implGetExceptionMsg( e, ::getCppuType( &e ).getTypeName() );
430 // Error-Message fuer WrappedTargetExceptions
431 String implGetWrappedMsg( const WrappedTargetException& e )
433 String aMsg;
434 Any aWrappedAny = e.TargetException;
435 Type aExceptionType = aWrappedAny.getValueType();
437 // Really an Exception?
438 if( aExceptionType.getTypeClass() == TypeClass_EXCEPTION )
440 Exception& e_ = *( (Exception*)aWrappedAny.getValue() );
441 aMsg = implGetExceptionMsg( e_, String( aExceptionType.getTypeName() ) );
443 // Otherwise use WrappedTargetException itself
444 else
446 aMsg = implGetExceptionMsg( e );
449 return aMsg;
452 void implHandleBasicErrorException( BasicErrorException& e )
454 SbError nError = StarBASIC::GetSfxFromVBError( (USHORT)e.ErrorCode );
455 StarBASIC::Error( nError, e.ErrorMessageArgument );
458 void implHandleWrappedTargetException( const Any& _rWrappedTargetException )
460 Any aExamine( _rWrappedTargetException );
462 // completely strip the first InvocationTargetException, its error message isn't of any
463 // interest to the user, it just says something like "invoking the UNO method went wrong.".
464 InvocationTargetException aInvocationError;
465 if ( aExamine >>= aInvocationError )
466 aExamine = aInvocationError.TargetException;
468 BasicErrorException aBasicError;
470 SbError nError( ERRCODE_BASIC_EXCEPTION );
471 ::rtl::OUStringBuffer aMessageBuf;
473 // strip any other WrappedTargetException instances, but this time preserve the error messages.
474 WrappedTargetException aWrapped;
475 sal_Int32 nLevel = 0;
476 while ( aExamine >>= aWrapped )
478 // special handling for BasicErrorException errors
479 if ( aWrapped.TargetException >>= aBasicError )
481 nError = StarBASIC::GetSfxFromVBError( (USHORT)aBasicError.ErrorCode );
482 aMessageBuf.append( aBasicError.ErrorMessageArgument );
483 aExamine.clear();
484 break;
487 // append this round's message
488 implAppendExceptionMsg( aMessageBuf, aWrapped, aExamine.getValueTypeName(), nLevel );
489 if ( aWrapped.TargetException.getValueTypeClass() == TypeClass_EXCEPTION )
490 // there is a next chain element
491 aMessageBuf.appendAscii( "\nTargetException:" );
493 // next round
494 aExamine = aWrapped.TargetException;
495 ++nLevel;
498 if ( aExamine.getValueTypeClass() == TypeClass_EXCEPTION )
500 // the last element in the chain is still an exception, but no WrappedTargetException
501 implAppendExceptionMsg( aMessageBuf, *static_cast< const Exception* >( aExamine.getValue() ), aExamine.getValueTypeName(), nLevel );
504 StarBASIC::Error( nError, aMessageBuf.makeStringAndClear() );
507 static void implHandleAnyException( const Any& _rCaughtException )
509 BasicErrorException aBasicError;
510 WrappedTargetException aWrappedError;
512 if ( _rCaughtException >>= aBasicError )
514 implHandleBasicErrorException( aBasicError );
516 else if ( _rCaughtException >>= aWrappedError )
518 implHandleWrappedTargetException( _rCaughtException );
520 else
522 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( _rCaughtException ) );
526 // Von Uno nach Sbx wandeln
527 SbxDataType unoToSbxType( TypeClass eType )
529 SbxDataType eRetType = SbxVOID;
531 switch( eType )
533 case TypeClass_INTERFACE:
534 case TypeClass_TYPE:
535 case TypeClass_STRUCT:
536 case TypeClass_EXCEPTION: eRetType = SbxOBJECT; break;
538 /* folgende Typen lassen wir erstmal weg
539 case TypeClass_SERVICE: break;
540 case TypeClass_CLASS: break;
541 case TypeClass_TYPEDEF: break;
542 case TypeClass_UNION: break;
543 case TypeClass_ARRAY: break;
545 case TypeClass_ENUM: eRetType = SbxLONG; break;
546 case TypeClass_SEQUENCE:
547 eRetType = (SbxDataType) ( SbxOBJECT | SbxARRAY );
548 break;
551 case TypeClass_VOID: break;
552 case TypeClass_UNKNOWN: break;
555 case TypeClass_ANY: eRetType = SbxVARIANT; break;
556 case TypeClass_BOOLEAN: eRetType = SbxBOOL; break;
557 case TypeClass_CHAR: eRetType = SbxCHAR; break;
558 case TypeClass_STRING: eRetType = SbxSTRING; break;
559 case TypeClass_FLOAT: eRetType = SbxSINGLE; break;
560 case TypeClass_DOUBLE: eRetType = SbxDOUBLE; break;
561 //case TypeClass_OCTET: break;
562 case TypeClass_BYTE: eRetType = SbxINTEGER; break;
563 //case TypeClass_INT: eRetType = SbxINT; break;
564 case TypeClass_SHORT: eRetType = SbxINTEGER; break;
565 case TypeClass_LONG: eRetType = SbxLONG; break;
566 case TypeClass_HYPER: eRetType = SbxSALINT64; break;
567 //case TypeClass_UNSIGNED_OCTET: break;
568 case TypeClass_UNSIGNED_SHORT: eRetType = SbxUSHORT; break;
569 case TypeClass_UNSIGNED_LONG: eRetType = SbxULONG; break;
570 case TypeClass_UNSIGNED_HYPER: eRetType = SbxSALUINT64;break;
571 //case TypeClass_UNSIGNED_INT: eRetType = SbxUINT; break;
572 //case TypeClass_UNSIGNED_BYTE: eRetType = SbxUSHORT; break;
573 default: break;
575 return eRetType;
578 SbxDataType unoToSbxType( const Reference< XIdlClass >& xIdlClass )
580 SbxDataType eRetType = SbxVOID;
581 if( xIdlClass.is() )
583 TypeClass eType = xIdlClass->getTypeClass();
584 eRetType = unoToSbxType( eType );
586 return eRetType;
588 void unoToSbxValue( SbxVariable* pVar, const Any& aValue );
589 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 )
591 Type aType = aValue.getValueType();
592 TypeClass eTypeClass = aType.getTypeClass();
594 sal_Int32 indicesIndex = indices.getLength() -1;
595 sal_Int32 dimCopy = dimension;
597 if ( eTypeClass == TypeClass_SEQUENCE )
599 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aType );
600 Reference< XIdlArray > xIdlArray = xIdlTargetClass->getArray();
601 typelib_TypeDescription * pTD = 0;
602 aType.getDescription( &pTD );
603 Type aElementType( ((typelib_IndirectTypeDescription *)pTD)->pType );
604 ::typelib_typedescription_release( pTD );
606 sal_Int32 nLen = xIdlArray->getLen( aValue );
607 for ( sal_Int32 index = 0; index < nLen; ++index )
609 Any aElementAny = xIdlArray->get( aValue, (UINT32)index );
610 // This detects the dimension were currently processing
611 if ( dimCopy == dimension )
613 ++dimCopy;
614 if ( sizes.getLength() < dimCopy )
616 sizes.realloc( sizes.getLength() + 1 );
617 sizes[ sizes.getLength() - 1 ] = nLen;
618 indices.realloc( indices.getLength() + 1 );
619 indicesIndex = indices.getLength() - 1;
623 if ( bIsZeroIndex )
624 indices[ dimCopy - 1 ] = index;
625 else
626 indices[ dimCopy - 1] = index + 1;
628 implSequenceToMultiDimArray( pArray, indices, sizes, aElementAny, dimCopy, bIsZeroIndex, &aElementType );
632 else
634 if ( indices.getLength() < 1 )
636 // Should never ever get here ( indices.getLength()
637 // should equal number of dimensions in the array )
638 // And that should at least be 1 !
639 // #QUESTION is there a better error?
640 StarBASIC::Error( SbERR_INVALID_OBJECT );
641 return;
644 SbxDataType eSbxElementType = unoToSbxType( pType ? pType->getTypeClass() : aValue.getValueTypeClass() );
645 if ( !pArray )
647 pArray = new SbxDimArray( eSbxElementType );
648 sal_Int32 nIndexLen = indices.getLength();
650 // Dimension the array
651 for ( sal_Int32 index = 0; index < nIndexLen; ++index )
653 if ( bIsZeroIndex )
654 pArray->unoAddDim32( 0, sizes[ index ] - 1);
655 else
656 pArray->unoAddDim32( 1, sizes[ index ] );
661 if ( pArray )
663 SbxVariableRef xVar = new SbxVariable( eSbxElementType );
664 unoToSbxValue( (SbxVariable*)xVar, aValue );
666 sal_Int32* pIndices = indices.getArray();
667 pArray->Put32( (SbxVariable*)xVar, pIndices );
673 void unoToSbxValue( SbxVariable* pVar, const Any& aValue )
675 Type aType = aValue.getValueType();
676 TypeClass eTypeClass = aType.getTypeClass();
677 switch( eTypeClass )
679 case TypeClass_TYPE:
681 // Map Type to IdlClass
682 Type aType_;
683 aValue >>= aType_;
684 Reference<XIdlClass> xClass = TypeToIdlClass( aType_ );
685 Any aClassAny;
686 aClassAny <<= xClass;
688 // SbUnoObject instanzieren
689 String aName;
690 SbUnoObject* pSbUnoObject = new SbUnoObject( aName, aClassAny );
691 SbxObjectRef xWrapper = (SbxObject*)pSbUnoObject;
693 // #51475 Wenn das Objekt ungueltig ist null liefern
694 if( pSbUnoObject->getUnoAny().getValueType().getTypeClass() == TypeClass_VOID )
696 pVar->PutObject( NULL );
698 else
700 pVar->PutObject( xWrapper );
703 break;
704 // Interfaces und Structs muessen in ein SbUnoObject gewrappt werden
705 case TypeClass_INTERFACE:
706 case TypeClass_STRUCT:
707 case TypeClass_EXCEPTION:
709 if( eTypeClass == TypeClass_STRUCT )
711 ArrayWrapper aWrap;
712 if ( (aValue >>= aWrap) )
714 SbxDimArray* pArray = NULL;
715 Sequence< sal_Int32 > indices;
716 Sequence< sal_Int32 > sizes;
717 sal_Int32 dimension = 0;
718 implSequenceToMultiDimArray( pArray, indices, sizes, aWrap.Array, dimension, aWrap.IsZeroIndex );
719 if ( pArray )
721 SbxDimArrayRef xArray = pArray;
722 USHORT nFlags = pVar->GetFlags();
723 pVar->ResetFlag( SBX_FIXED );
724 pVar->PutObject( (SbxDimArray*)xArray );
725 pVar->SetFlags( nFlags );
727 else
728 pVar->PutEmpty();
729 break;
731 else
733 SbiInstance* pInst = pINST;
734 if( pInst && pInst->IsCompatibility() )
736 oleautomation::Date aDate;
737 if( (aValue >>= aDate) )
739 pVar->PutDate( aDate.Value );
740 break;
742 else
744 oleautomation::Decimal aDecimal;
745 if( (aValue >>= aDecimal) )
747 pVar->PutDecimal( aDecimal );
748 break;
750 else
752 oleautomation::Currency aCurrency;
753 if( (aValue >>= aCurrency) )
755 sal_Int64 nValue64 = aCurrency.Value;
756 SbxINT64 aInt64;
757 aInt64.nHigh =
758 sal::static_int_cast< INT32 >(
759 nValue64 >> 32);
760 aInt64.nLow = (UINT32)( nValue64 & 0xffffffff );
761 pVar->PutCurrency( aInt64 );
762 break;
769 // SbUnoObject instanzieren
770 String aName;
771 SbUnoObject* pSbUnoObject = new SbUnoObject( aName, aValue );
772 // If this is called externally e.g. from the scripting
773 // framework then there is no 'active' runtime the default property will not be set up
774 // only a vba object will have XDefaultProp set anyway so... this
775 // test seems a bit of overkill
776 // if ( SbiRuntime::isVBAEnabled() )
778 String sDfltPropName;
780 if ( SbUnoObject::getDefaultPropName( pSbUnoObject, sDfltPropName ) )
781 pSbUnoObject->SetDfltProperty( sDfltPropName );
783 SbxObjectRef xWrapper = (SbxObject*)pSbUnoObject;
785 // #51475 Wenn das Objekt ungueltig ist null liefern
786 if( pSbUnoObject->getUnoAny().getValueType().getTypeClass() == TypeClass_VOID )
788 pVar->PutObject( NULL );
790 else
792 pVar->PutObject( xWrapper );
795 break;
797 /* folgende Typen lassen wir erstmal weg
798 case TypeClass_SERVICE: break;
799 case TypeClass_CLASS: break;
800 case TypeClass_TYPEDEF: break;
801 case TypeClass_UNION: break;
802 case TypeClass_ENUM: break;
803 case TypeClass_ARRAY: break;
806 case TypeClass_ENUM:
808 sal_Int32 nEnum = 0;
809 enum2int( nEnum, aValue );
810 pVar->PutLong( nEnum );
812 break;
814 case TypeClass_SEQUENCE:
816 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aType );
817 Reference< XIdlArray > xIdlArray = xIdlTargetClass->getArray();
818 sal_Int32 i, nLen = xIdlArray->getLen( aValue );
820 typelib_TypeDescription * pTD = 0;
821 aType.getDescription( &pTD );
822 OSL_ASSERT( pTD && pTD->eTypeClass == typelib_TypeClass_SEQUENCE );
823 Type aElementType( ((typelib_IndirectTypeDescription *)pTD)->pType );
824 ::typelib_typedescription_release( pTD );
826 // In Basic Array anlegen
827 SbxDimArrayRef xArray;
828 SbxDataType eSbxElementType = unoToSbxType( aElementType.getTypeClass() );
829 xArray = new SbxDimArray( eSbxElementType );
830 if( nLen > 0 )
832 xArray->unoAddDim32( 0, nLen - 1 );
834 // Elemente als Variablen eintragen
835 for( i = 0 ; i < nLen ; i++ )
837 // Elemente wandeln
838 Any aElementAny = xIdlArray->get( aValue, (UINT32)i );
839 SbxVariableRef xVar = new SbxVariable( eSbxElementType );
840 unoToSbxValue( (SbxVariable*)xVar, aElementAny );
842 // Ins Array braten
843 xArray->Put32( (SbxVariable*)xVar, &i );
846 else
848 xArray->unoAddDim( 0, -1 );
851 // Array zurueckliefern
852 USHORT nFlags = pVar->GetFlags();
853 pVar->ResetFlag( SBX_FIXED );
854 pVar->PutObject( (SbxDimArray*)xArray );
855 pVar->SetFlags( nFlags );
857 // #54548, Die Parameter duerfen hier nicht weggehauen werden
858 //pVar->SetParameters( NULL );
860 break;
863 case TypeClass_VOID: break;
864 case TypeClass_UNKNOWN: break;
866 case TypeClass_ANY:
868 // Any rausholen und konvertieren
869 //Any* pAny = (Any*)aValue.get();
870 //if( pAny )
871 //unoToSbxValue( pVar, *pAny );
873 break;
876 case TypeClass_BOOLEAN: pVar->PutBool( *(sal_Bool*)aValue.getValue() ); break;
877 case TypeClass_CHAR:
879 pVar->PutChar( *(sal_Unicode*)aValue.getValue() );
880 break;
882 case TypeClass_STRING: { ::rtl::OUString val; aValue >>= val; pVar->PutString( String( val ) ); } break;
883 case TypeClass_FLOAT: { float val = 0; aValue >>= val; pVar->PutSingle( val ); } break;
884 case TypeClass_DOUBLE: { double val = 0; aValue >>= val; pVar->PutDouble( val ); } break;
885 //case TypeClass_OCTET: break;
886 case TypeClass_BYTE: { sal_Int8 val = 0; aValue >>= val; pVar->PutInteger( val ); } break;
887 //case TypeClass_INT: break;
888 case TypeClass_SHORT: { sal_Int16 val = 0; aValue >>= val; pVar->PutInteger( val ); } break;
889 case TypeClass_LONG: { sal_Int32 val = 0; aValue >>= val; pVar->PutLong( val ); } break;
890 case TypeClass_HYPER: { sal_Int64 val = 0; aValue >>= val; pVar->PutInt64( val ); } break;
891 //case TypeClass_UNSIGNED_OCTET:break;
892 case TypeClass_UNSIGNED_SHORT: { sal_uInt16 val = 0; aValue >>= val; pVar->PutUShort( val ); } break;
893 case TypeClass_UNSIGNED_LONG: { sal_uInt32 val = 0; aValue >>= val; pVar->PutULong( val ); } break;
894 case TypeClass_UNSIGNED_HYPER: { sal_uInt64 val = 0; aValue >>= val; pVar->PutUInt64( val ); } break;
895 //case TypeClass_UNSIGNED_INT: break;
896 //case TypeClass_UNSIGNED_BYTE: break;
897 default: pVar->PutEmpty(); break;
901 // Reflection fuer Sbx-Typen liefern
902 Type getUnoTypeForSbxBaseType( SbxDataType eType )
904 Type aRetType = getCppuVoidType();
905 switch( eType )
907 //case SbxEMPTY: eRet = TypeClass_VOID; break;
908 case SbxNULL: aRetType = ::getCppuType( (const Reference< XInterface > *)0 ); break;
909 case SbxINTEGER: aRetType = ::getCppuType( (sal_Int16*)0 ); break;
910 case SbxLONG: aRetType = ::getCppuType( (sal_Int32*)0 ); break;
911 case SbxSINGLE: aRetType = ::getCppuType( (float*)0 ); break;
912 case SbxDOUBLE: aRetType = ::getCppuType( (double*)0 ); break;
913 case SbxCURRENCY: aRetType = ::getCppuType( (oleautomation::Currency*)0 ); break;
914 case SbxDECIMAL: aRetType = ::getCppuType( (oleautomation::Decimal*)0 ); break;
915 case SbxDATE: {
916 SbiInstance* pInst = pINST;
917 if( pInst && pInst->IsCompatibility() )
918 aRetType = ::getCppuType( (double*)0 );
919 else
920 aRetType = ::getCppuType( (oleautomation::Date*)0 );
922 break;
923 // case SbxDATE: aRetType = ::getCppuType( (double*)0 ); break;
924 case SbxSTRING: aRetType = ::getCppuType( (::rtl::OUString*)0 ); break;
925 //case SbxOBJECT: break;
926 //case SbxERROR: break;
927 case SbxBOOL: aRetType = ::getCppuType( (sal_Bool*)0 ); break;
928 case SbxVARIANT: aRetType = ::getCppuType( (Any*)0 ); break;
929 //case SbxDATAOBJECT: break;
930 case SbxCHAR: aRetType = ::getCppuType( (sal_Unicode*)0 ); break;
931 case SbxBYTE: aRetType = ::getCppuType( (sal_Int16*)0 ); break;
932 case SbxUSHORT: aRetType = ::getCppuType( (sal_uInt16*)0 ); break;
933 case SbxULONG: aRetType = ::getCppuType( (sal_uInt32*)0 ); break;
934 //case SbxLONG64: break;
935 //case SbxULONG64: break;
936 // Maschinenabhaengige zur Sicherheit auf Hyper abbilden
937 case SbxINT: aRetType = ::getCppuType( (sal_Int32*)0 ); break;
938 case SbxUINT: aRetType = ::getCppuType( (sal_uInt32*)0 ); break;
939 //case SbxVOID: break;
940 //case SbxHRESULT: break;
941 //case SbxPOINTER: break;
942 //case SbxDIMARRAY: break;
943 //case SbxCARRAY: break;
944 //case SbxUSERDEF: break;
945 //case SbxLPSTR: break;
946 //case SbxLPWSTR: break;
947 //case SbxCoreSTRING: break;
948 default: break;
950 return aRetType;
953 // Konvertierung von Sbx nach Uno ohne bekannte Zielklasse fuer TypeClass_ANY
954 Type getUnoTypeForSbxValue( SbxValue* pVal )
956 Type aRetType = getCppuVoidType();
957 if( !pVal )
958 return aRetType;
960 // SbxType nach Uno wandeln
961 SbxDataType eBaseType = pVal->SbxValue::GetType();
962 if( eBaseType == SbxOBJECT )
964 SbxBaseRef xObj = (SbxBase*)pVal->GetObject();
965 if( !xObj )
967 // #109936 No error any more
968 // StarBASIC::Error( SbERR_INVALID_OBJECT );
969 aRetType = getCppuType( static_cast<Reference<XInterface> *>(0) );
970 return aRetType;
973 if( xObj->ISA(SbxDimArray) )
975 SbxBase* pObj = (SbxBase*)xObj;
976 SbxDimArray* pArray = (SbxDimArray*)pObj;
978 short nDims = pArray->GetDims();
979 Type aElementType = getUnoTypeForSbxBaseType( (SbxDataType)(pArray->GetType() & 0xfff) );
980 TypeClass eElementTypeClass = aElementType.getTypeClass();
982 // Normal case: One dimensional array
983 sal_Int32 nLower, nUpper;
984 if( nDims == 1 && pArray->GetDim32( 1, nLower, nUpper ) )
986 if( eElementTypeClass == TypeClass_VOID || eElementTypeClass == TypeClass_ANY )
988 // Wenn alle Elemente des Arrays vom gleichen Typ sind, wird
989 // der genommen, sonst wird das ganze als Any-Sequence betrachtet
990 sal_Bool bNeedsInit = sal_True;
992 INT32 nSize = nUpper - nLower + 1;
993 INT32 nIdx = nLower;
994 for( INT32 i = 0 ; i < nSize ; i++,nIdx++ )
996 SbxVariableRef xVar = pArray->Get32( &nIdx );
997 Type aType = getUnoTypeForSbxValue( (SbxVariable*)xVar );
998 if( bNeedsInit )
1000 if( aType.getTypeClass() == TypeClass_VOID )
1002 // #88522
1003 // if only first element is void: different types -> []any
1004 // if all elements are void: []void is not allowed -> []any
1005 aElementType = getCppuType( (Any*)0 );
1006 break;
1008 aElementType = aType;
1009 bNeedsInit = sal_False;
1011 else if( aElementType != aType )
1013 // Verschiedene Typen -> AnySequence
1014 aElementType = getCppuType( (Any*)0 );
1015 break;
1020 ::rtl::OUString aSeqTypeName( aSeqLevelStr );
1021 aSeqTypeName += aElementType.getTypeName();
1022 aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName );
1024 // #i33795 Map also multi dimensional arrays to corresponding sequences
1025 else if( nDims > 1 )
1027 if( eElementTypeClass == TypeClass_VOID || eElementTypeClass == TypeClass_ANY )
1029 // For this check the array's dim structure does not matter
1030 UINT32 nFlatArraySize = pArray->Count32();
1032 sal_Bool bNeedsInit = sal_True;
1033 for( UINT32 i = 0 ; i < nFlatArraySize ; i++ )
1035 SbxVariableRef xVar = pArray->SbxArray::Get32( i );
1036 Type aType = getUnoTypeForSbxValue( (SbxVariable*)xVar );
1037 if( bNeedsInit )
1039 if( aType.getTypeClass() == TypeClass_VOID )
1041 // if only first element is void: different types -> []any
1042 // if all elements are void: []void is not allowed -> []any
1043 aElementType = getCppuType( (Any*)0 );
1044 break;
1046 aElementType = aType;
1047 bNeedsInit = sal_False;
1049 else if( aElementType != aType )
1051 // Verschiedene Typen -> AnySequence
1052 aElementType = getCppuType( (Any*)0 );
1053 break;
1058 ::rtl::OUString aSeqTypeName;
1059 for( short iDim = 0 ; iDim < nDims ; iDim++ )
1060 aSeqTypeName += aSeqLevelStr;
1061 aSeqTypeName += aElementType.getTypeName();
1062 aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName );
1065 // Kein Array, sondern...
1066 else if( xObj->ISA(SbUnoObject) )
1068 aRetType = ((SbUnoObject*)(SbxBase*)xObj)->getUnoAny().getValueType();
1070 // SbUnoAnyObject?
1071 else if( xObj->ISA(SbUnoAnyObject) )
1073 aRetType = ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue().getValueType();
1075 // Sonst ist es ein Nicht-Uno-Basic-Objekt -> default==void liefern
1077 // Kein Objekt, Basistyp konvertieren
1078 else
1080 aRetType = getUnoTypeForSbxBaseType( eBaseType );
1082 return aRetType;
1085 // Deklaration Konvertierung von Sbx nach Uno mit bekannter Zielklasse
1086 Any sbxToUnoValue( SbxVariable* pVar, const Type& rType, Property* pUnoProperty = NULL );
1088 // Konvertierung von Sbx nach Uno ohne bekannte Zielklasse fuer TypeClass_ANY
1089 Any sbxToUnoValueImpl( SbxVariable* pVar, bool bBlockConversionToSmallestType = false )
1091 SbxDataType eBaseType = pVar->SbxValue::GetType();
1092 if( eBaseType == SbxOBJECT )
1094 SbxBaseRef xObj = (SbxBase*)pVar->GetObject();
1095 if( xObj.Is() && xObj->ISA(SbUnoAnyObject) )
1096 return ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue();
1099 Type aType = getUnoTypeForSbxValue( pVar );
1100 TypeClass eType = aType.getTypeClass();
1102 if( !bBlockConversionToSmallestType )
1104 // #79615 Choose "smallest" represention for int values
1105 // because up cast is allowed, downcast not
1106 switch( eType )
1108 case TypeClass_FLOAT:
1109 case TypeClass_DOUBLE:
1111 double d = pVar->GetDouble();
1112 if( d == floor( d ) )
1114 if( d >= -128 && d <= 127 )
1115 aType = ::getCppuType( (sal_Int8*)0 );
1116 else if( d >= SbxMININT && d <= SbxMAXINT )
1117 aType = ::getCppuType( (sal_Int16*)0 );
1118 else if( d >= -SbxMAXLNG && d <= SbxMAXLNG )
1119 aType = ::getCppuType( (sal_Int32*)0 );
1121 break;
1123 case TypeClass_SHORT:
1125 sal_Int16 n = pVar->GetInteger();
1126 if( n >= -128 && n <= 127 )
1127 aType = ::getCppuType( (sal_Int8*)0 );
1128 break;
1130 case TypeClass_LONG:
1132 sal_Int32 n = pVar->GetLong();
1133 if( n >= -128 && n <= 127 )
1134 aType = ::getCppuType( (sal_Int8*)0 );
1135 else if( n >= SbxMININT && n <= SbxMAXINT )
1136 aType = ::getCppuType( (sal_Int16*)0 );
1137 break;
1139 case TypeClass_UNSIGNED_SHORT:
1141 sal_uInt16 n = pVar->GetUShort();
1142 if( n <= 255 )
1143 aType = ::getCppuType( (sal_uInt8*)0 );
1144 break;
1146 case TypeClass_UNSIGNED_LONG:
1148 sal_uInt32 n = pVar->GetLong();
1149 if( n <= 255 )
1150 aType = ::getCppuType( (sal_uInt8*)0 );
1151 else if( n <= SbxMAXUINT )
1152 aType = ::getCppuType( (sal_uInt16*)0 );
1153 break;
1155 default: break;
1159 return sbxToUnoValue( pVar, aType );
1164 // Helper function for StepREDIMP
1165 static Any implRekMultiDimArrayToSequence( SbxDimArray* pArray,
1166 const Type& aElemType, short nMaxDimIndex, short nActualDim,
1167 sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
1169 sal_Int32 nSeqLevel = nMaxDimIndex - nActualDim + 1;
1170 ::rtl::OUString aSeqTypeName;
1171 sal_Int32 i;
1172 for( i = 0 ; i < nSeqLevel ; i++ )
1173 aSeqTypeName += aSeqLevelStr;
1175 aSeqTypeName += aElemType.getTypeName();
1176 Type aSeqType( TypeClass_SEQUENCE, aSeqTypeName );
1178 // Create Sequence instance
1179 Any aRetVal;
1180 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aSeqType );
1181 xIdlTargetClass->createObject( aRetVal );
1183 // Alloc sequence according to array bounds
1184 sal_Int32 nUpper = pUpperBounds[nActualDim];
1185 sal_Int32 nLower = pLowerBounds[nActualDim];
1186 sal_Int32 nSeqSize = nUpper - nLower + 1;
1187 Reference< XIdlArray > xArray = xIdlTargetClass->getArray();
1188 xArray->realloc( aRetVal, nSeqSize );
1190 sal_Int32& ri = pActualIndices[nActualDim];
1192 for( ri = nLower,i = 0 ; ri <= nUpper ; ri++,i++ )
1194 Any aElementVal;
1196 if( nActualDim < nMaxDimIndex )
1198 aElementVal = implRekMultiDimArrayToSequence( pArray, aElemType,
1199 nMaxDimIndex, nActualDim + 1, pActualIndices, pLowerBounds, pUpperBounds );
1201 else
1203 SbxVariable* pSource = pArray->Get32( pActualIndices );
1204 aElementVal = sbxToUnoValue( pSource, aElemType );
1209 // In die Sequence uebernehmen
1210 xArray->set( aRetVal, i, aElementVal );
1212 catch( const IllegalArgumentException& )
1214 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
1215 implGetExceptionMsg( ::cppu::getCaughtException() ) );
1217 catch (IndexOutOfBoundsException&)
1219 StarBASIC::Error( SbERR_OUT_OF_RANGE );
1222 return aRetVal;
1225 // Map old interface
1226 Any sbxToUnoValue( SbxVariable* pVar )
1228 return sbxToUnoValueImpl( pVar );
1231 // Konvertierung von Sbx nach Uno mit bekannter Zielklasse
1232 Any sbxToUnoValue( SbxVariable* pVar, const Type& rType, Property* pUnoProperty )
1234 Any aRetVal;
1236 // #94560 No conversion of empty/void for MAYBE_VOID properties
1237 if( pUnoProperty && pUnoProperty->Attributes & PropertyAttribute::MAYBEVOID )
1239 if( pVar->IsEmpty() )
1240 return aRetVal;
1243 SbxDataType eBaseType = pVar->SbxValue::GetType();
1244 if( eBaseType == SbxOBJECT )
1246 SbxBaseRef xObj = (SbxBase*)pVar->GetObject();
1247 if( xObj.Is() && xObj->ISA(SbUnoAnyObject) )
1249 return ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue();
1253 TypeClass eType = rType.getTypeClass();
1254 switch( eType )
1256 case TypeClass_INTERFACE:
1257 case TypeClass_STRUCT:
1258 case TypeClass_EXCEPTION:
1260 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
1262 // Null-Referenz?
1263 if( pVar->IsNull() && eType == TypeClass_INTERFACE )
1265 Reference< XInterface > xRef;
1266 ::rtl::OUString aClassName = xIdlTargetClass->getName();
1267 Type aClassType( xIdlTargetClass->getTypeClass(), aClassName.getStr() );
1268 aRetVal.setValue( &xRef, aClassType );
1270 else
1272 // #112368 Special conversion for Decimal, Currency and Date
1273 if( eType == TypeClass_STRUCT )
1275 SbiInstance* pInst = pINST;
1276 if( pInst && pInst->IsCompatibility() )
1278 if( rType == ::getCppuType( (oleautomation::Decimal*)0 ) )
1280 oleautomation::Decimal aDecimal;
1281 pVar->fillAutomationDecimal( aDecimal );
1282 aRetVal <<= aDecimal;
1283 break;
1285 else if( rType == ::getCppuType( (oleautomation::Currency*)0 ) )
1287 SbxINT64 aInt64 = pVar->GetCurrency();
1288 oleautomation::Currency aCurrency;
1289 sal_Int64& rnValue64 = aCurrency.Value;
1290 rnValue64 = aInt64.nHigh;
1291 rnValue64 <<= 32;
1292 rnValue64 |= aInt64.nLow;
1293 aRetVal <<= aCurrency;
1294 break;
1296 else if( rType == ::getCppuType( (oleautomation::Date*)0 ) )
1298 oleautomation::Date aDate;
1299 aDate.Value = pVar->GetDate();
1300 aRetVal <<= aDate;
1301 break;
1306 SbxBaseRef pObj = (SbxBase*)pVar->GetObject();
1307 if( pObj && pObj->ISA(SbUnoObject) )
1309 aRetVal = ((SbUnoObject*)(SbxBase*)pObj)->getUnoAny();
1311 else
1313 // #109936 NULL object -> NULL XInterface
1314 Reference<XInterface> xInt;
1315 aRetVal <<= xInt;
1319 break;
1321 /* folgende Typen lassen wir erstmal weg
1322 case TypeClass_SERVICE: break;
1323 case TypeClass_CLASS: break;
1324 case TypeClass_TYPEDEF: break;
1325 case TypeClass_UNION: break;
1326 case TypeClass_ENUM: break;
1327 case TypeClass_ARRAY: break;
1330 // Array -> Sequence
1331 case TypeClass_ENUM:
1333 aRetVal = int2enum( pVar->GetLong(), rType );
1335 break;
1337 case TypeClass_SEQUENCE:
1339 SbxBaseRef xObj = (SbxBase*)pVar->GetObject();
1340 if( xObj && xObj->ISA(SbxDimArray) )
1342 SbxBase* pObj = (SbxBase*)xObj;
1343 SbxDimArray* pArray = (SbxDimArray*)pObj;
1345 short nDims = pArray->GetDims();
1347 // Normal case: One dimensional array
1348 sal_Int32 nLower, nUpper;
1349 if( nDims == 1 && pArray->GetDim32( 1, nLower, nUpper ) )
1351 sal_Int32 nSeqSize = nUpper - nLower + 1;
1353 // Instanz der geforderten Sequence erzeugen
1354 Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
1355 xIdlTargetClass->createObject( aRetVal );
1356 Reference< XIdlArray > xArray = xIdlTargetClass->getArray();
1357 xArray->realloc( aRetVal, nSeqSize );
1359 // Element-Type
1360 ::rtl::OUString aClassName = xIdlTargetClass->getName();
1361 typelib_TypeDescription * pSeqTD = 0;
1362 typelib_typedescription_getByName( &pSeqTD, aClassName.pData );
1363 OSL_ASSERT( pSeqTD );
1364 Type aElemType( ((typelib_IndirectTypeDescription *)pSeqTD)->pType );
1365 // Reference< XIdlClass > xElementClass = TypeToIdlClass( aElemType );
1367 // Alle Array-Member umwandeln und eintragen
1368 sal_Int32 nIdx = nLower;
1369 for( sal_Int32 i = 0 ; i < nSeqSize ; i++,nIdx++ )
1371 SbxVariableRef xVar = pArray->Get32( &nIdx );
1373 // Wert von Sbx nach Uno wandeln
1374 Any aAnyValue = sbxToUnoValue( (SbxVariable*)xVar, aElemType );
1378 // In die Sequence uebernehmen
1379 xArray->set( aRetVal, i, aAnyValue );
1381 catch( const IllegalArgumentException& )
1383 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
1384 implGetExceptionMsg( ::cppu::getCaughtException() ) );
1386 catch (IndexOutOfBoundsException&)
1388 StarBASIC::Error( SbERR_OUT_OF_RANGE );
1392 // #i33795 Map also multi dimensional arrays to corresponding sequences
1393 else if( nDims > 1 )
1395 // Element-Type
1396 typelib_TypeDescription * pSeqTD = 0;
1397 Type aCurType( rType );
1398 sal_Int32 nSeqLevel = 0;
1399 Type aElemType;
1402 ::rtl::OUString aTypeName = aCurType.getTypeName();
1403 typelib_typedescription_getByName( &pSeqTD, aTypeName.pData );
1404 OSL_ASSERT( pSeqTD );
1405 if( pSeqTD->eTypeClass == typelib_TypeClass_SEQUENCE )
1407 aCurType = Type( ((typelib_IndirectTypeDescription *)pSeqTD)->pType );
1408 nSeqLevel++;
1410 else
1412 aElemType = aCurType;
1413 break;
1416 while( true );
1418 if( nSeqLevel == nDims )
1420 sal_Int32* pLowerBounds = new sal_Int32[nDims];
1421 sal_Int32* pUpperBounds = new sal_Int32[nDims];
1422 sal_Int32* pActualIndices = new sal_Int32[nDims];
1423 for( short i = 1 ; i <= nDims ; i++ )
1425 sal_Int32 lBound, uBound;
1426 pArray->GetDim32( i, lBound, uBound );
1428 short j = i - 1;
1429 pActualIndices[j] = pLowerBounds[j] = lBound;
1430 pUpperBounds[j] = uBound;
1433 aRetVal = implRekMultiDimArrayToSequence( pArray, aElemType,
1434 nDims - 1, 0, pActualIndices, pLowerBounds, pUpperBounds );
1436 delete[] pUpperBounds;
1437 delete[] pLowerBounds;
1438 delete[] pActualIndices;
1443 break;
1446 case TypeClass_VOID: break;
1447 case TypeClass_UNKNOWN: break;
1450 // Bei Any die Klassen-unabhaengige Konvertierungs-Routine nutzen
1451 case TypeClass_ANY:
1453 aRetVal = sbxToUnoValueImpl( pVar );
1455 break;
1457 case TypeClass_BOOLEAN:
1459 sal_Bool b = pVar->GetBool();
1460 aRetVal.setValue( &b, getBooleanCppuType() );
1461 break;
1463 case TypeClass_CHAR:
1465 sal_Unicode c = pVar->GetChar();
1466 aRetVal.setValue( &c , getCharCppuType() );
1467 break;
1469 case TypeClass_STRING: aRetVal <<= ::rtl::OUString( pVar->GetString() ); break;
1470 case TypeClass_FLOAT: aRetVal <<= pVar->GetSingle(); break;
1471 case TypeClass_DOUBLE: aRetVal <<= pVar->GetDouble(); break;
1472 //case TypeClass_OCTET: break;
1474 case TypeClass_BYTE:
1476 sal_Int16 nVal = pVar->GetInteger();
1477 sal_Bool bOverflow = sal_False;
1478 if( nVal < -128 )
1480 bOverflow = sal_True;
1481 nVal = -128;
1483 else if( nVal > 127 )
1485 bOverflow = sal_True;
1486 nVal = 127;
1488 if( bOverflow )
1489 StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
1491 sal_Int8 nByteVal = (sal_Int8)nVal;
1492 aRetVal <<= nByteVal;
1493 break;
1495 //case TypeClass_INT: break;
1496 case TypeClass_SHORT: aRetVal <<= (sal_Int16)( pVar->GetInteger() ); break;
1497 case TypeClass_LONG: aRetVal <<= (sal_Int32)( pVar->GetLong() ); break;
1498 case TypeClass_HYPER: aRetVal <<= (sal_Int64)( pVar->GetInt64() ); break;
1499 //case TypeClass_UNSIGNED_OCTET:break;
1500 case TypeClass_UNSIGNED_SHORT: aRetVal <<= (sal_uInt16)( pVar->GetUShort() ); break;
1501 case TypeClass_UNSIGNED_LONG: aRetVal <<= (sal_uInt32)( pVar->GetULong() ); break;
1502 case TypeClass_UNSIGNED_HYPER: aRetVal <<= (sal_uInt64)( pVar->GetUInt64() ); break;
1503 //case TypeClass_UNSIGNED_INT: break;
1504 //case TypeClass_UNSIGNED_BYTE: break;
1505 default: break;
1508 return aRetVal;
1511 void processAutomationParams( SbxArray* pParams, Sequence< Any >& args, bool bOLEAutomation, UINT32 nParamCount )
1513 AutomationNamedArgsSbxArray* pArgNamesArray = NULL;
1514 if( bOLEAutomation )
1515 pArgNamesArray = PTR_CAST(AutomationNamedArgsSbxArray,pParams);
1517 args.realloc( nParamCount );
1518 Any* pAnyArgs = args.getArray();
1519 bool bBlockConversionToSmallestType = pINST->IsCompatibility();
1520 UINT32 i = 0;
1521 if( pArgNamesArray )
1523 Sequence< ::rtl::OUString >& rNameSeq = pArgNamesArray->getNames();
1524 ::rtl::OUString* pNames = rNameSeq.getArray();
1525 Any aValAny;
1526 for( i = 0 ; i < nParamCount ; i++ )
1528 USHORT iSbx = (USHORT)(i+1);
1530 // ACHTUNG: Bei den Sbx-Parametern den Offset nicht vergessen!
1531 aValAny = sbxToUnoValueImpl( pParams->Get( iSbx ),
1532 bBlockConversionToSmallestType );
1534 ::rtl::OUString aParamName = pNames[iSbx];
1535 if( aParamName.getLength() )
1537 oleautomation::NamedArgument aNamedArgument;
1538 aNamedArgument.Name = aParamName;
1539 aNamedArgument.Value = aValAny;
1540 pAnyArgs[i] <<= aNamedArgument;
1542 else
1544 pAnyArgs[i] = aValAny;
1548 else
1550 for( i = 0 ; i < nParamCount ; i++ )
1552 // ACHTUNG: Bei den Sbx-Parametern den Offset nicht vergessen!
1553 pAnyArgs[i] = sbxToUnoValueImpl( pParams->Get( (USHORT)(i+1) ),
1554 bBlockConversionToSmallestType );
1559 enum INVOKETYPE
1561 GetProp = 0,
1562 SetProp,
1563 Func
1565 Any invokeAutomationMethod( const String& Name, Sequence< Any >& args, SbxArray* pParams, UINT32 nParamCount, Reference< XInvocation >& rxInvocation, INVOKETYPE invokeType = Func )
1567 Sequence< INT16 > OutParamIndex;
1568 Sequence< Any > OutParam;
1570 Any aRetAny;
1571 switch( invokeType )
1573 case Func:
1574 aRetAny = rxInvocation->invoke( Name, args, OutParamIndex, OutParam );
1575 break;
1576 case GetProp:
1578 Reference< XAutomationInvocation > xAutoInv( rxInvocation, UNO_QUERY_THROW );
1579 aRetAny = xAutoInv->invokeGetProperty( Name, args, OutParamIndex, OutParam );
1580 break;
1582 case SetProp:
1584 Reference< XAutomationInvocation > xAutoInv( rxInvocation, UNO_QUERY_THROW );
1585 aRetAny = xAutoInv->invokePutProperty( Name, args, OutParamIndex, OutParam );
1586 break;
1588 default:
1589 break; // should introduce an error here
1592 const INT16* pIndices = OutParamIndex.getConstArray();
1593 UINT32 nLen = OutParamIndex.getLength();
1594 if( nLen )
1596 const Any* pNewValues = OutParam.getConstArray();
1597 for( UINT32 j = 0 ; j < nLen ; j++ )
1599 INT16 iTarget = pIndices[ j ];
1600 if( iTarget >= (INT16)nParamCount )
1601 break;
1602 unoToSbxValue( (SbxVariable*)pParams->Get( (USHORT)(j+1) ), pNewValues[ j ] );
1605 return aRetAny;
1608 // Dbg-Hilfsmethode zum Auslesen der in einem Object implementierten Interfaces
1609 String Impl_GetInterfaceInfo( const Reference< XInterface >& x, const Reference< XIdlClass >& xClass, USHORT nRekLevel )
1611 Type aIfaceType = ::getCppuType( (const Reference< XInterface > *)0 );
1612 static Reference< XIdlClass > xIfaceClass = TypeToIdlClass( aIfaceType );
1614 String aRetStr;
1615 for( USHORT i = 0 ; i < nRekLevel ; i++ )
1616 aRetStr.AppendAscii( " " );
1617 aRetStr += String( xClass->getName() );
1618 ::rtl::OUString aClassName = xClass->getName();
1619 Type aClassType( xClass->getTypeClass(), aClassName.getStr() );
1621 // Pruefen, ob das Interface wirklich unterstuetzt wird
1622 if( !x->queryInterface( aClassType ).hasValue() )
1624 aRetStr.AppendAscii( " (ERROR: Not really supported!)\n" );
1626 // Gibt es Super-Interfaces
1627 else
1629 aRetStr.AppendAscii( "\n" );
1631 // Super-Interfaces holen
1632 Sequence< Reference< XIdlClass > > aSuperClassSeq = xClass->getSuperclasses();
1633 const Reference< XIdlClass >* pClasses = aSuperClassSeq.getConstArray();
1634 UINT32 nSuperIfaceCount = aSuperClassSeq.getLength();
1635 for( UINT32 j = 0 ; j < nSuperIfaceCount ; j++ )
1637 const Reference< XIdlClass >& rxIfaceClass = pClasses[j];
1638 if( !rxIfaceClass->equals( xIfaceClass ) )
1639 aRetStr += Impl_GetInterfaceInfo( x, rxIfaceClass, nRekLevel + 1 );
1642 return aRetStr;
1645 String getDbgObjectNameImpl( SbUnoObject* pUnoObj )
1647 String aName;
1648 if( pUnoObj )
1650 aName = pUnoObj->GetClassName();
1651 if( !aName.Len() )
1653 Any aToInspectObj = pUnoObj->getUnoAny();
1654 TypeClass eType = aToInspectObj.getValueType().getTypeClass();
1655 Reference< XInterface > xObj;
1656 if( eType == TypeClass_INTERFACE )
1657 xObj = *(Reference< XInterface >*)aToInspectObj.getValue();
1658 if( xObj.is() )
1660 Reference< XServiceInfo > xServiceInfo( xObj, UNO_QUERY );
1661 if( xServiceInfo.is() )
1662 aName = xServiceInfo->getImplementationName();
1666 return aName;
1669 String getDbgObjectName( SbUnoObject* pUnoObj )
1671 String aName = getDbgObjectNameImpl( pUnoObj );
1672 if( !aName.Len() )
1673 aName.AppendAscii( "Unknown" );
1675 String aRet;
1676 if( aName.Len() > 20 )
1677 aRet.AppendAscii( "\n" );
1678 aRet.AppendAscii( "\"" );
1679 aRet += aName;
1680 aRet.AppendAscii( "\":" );
1681 return aRet;
1684 String getBasicObjectTypeName( SbxObject* pObj )
1686 String aName;
1687 if( pObj )
1689 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
1690 if( pUnoObj )
1691 aName = getDbgObjectNameImpl( pUnoObj );
1693 return aName;
1696 bool checkUnoObjectType( SbUnoObject* pUnoObj,
1697 const String& aClass )
1699 bool result = false;
1700 Any aToInspectObj = pUnoObj->getUnoAny();
1701 TypeClass eType = aToInspectObj.getValueType().getTypeClass();
1702 if( eType != TypeClass_INTERFACE )
1703 return false;
1704 const Reference< XInterface > x = *(Reference< XInterface >*)aToInspectObj.getValue();
1705 Reference< XTypeProvider > xTypeProvider( x, UNO_QUERY );
1706 if( xTypeProvider.is() )
1708 Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
1709 const Type* pTypeArray = aTypeSeq.getConstArray();
1710 UINT32 nIfaceCount = aTypeSeq.getLength();
1711 for( UINT32 j = 0 ; j < nIfaceCount ; j++ )
1713 const Type& rType = pTypeArray[j];
1715 Reference<XIdlClass> xClass = TypeToIdlClass( rType );
1716 if( !xClass.is() )
1718 DBG_ERROR("failed to get XIdlClass for type");
1719 break;
1721 ::rtl::OUString sClassName = xClass->getName();
1722 if ( sClassName.equals( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.bridge.oleautomation.XAutomationObject" ) ) ) )
1724 // there is a hack in the extensions/source/ole/oleobj.cxx to return the typename of the automation object, lets check if it
1725 // matches
1726 Reference< XInvocation > xInv( aToInspectObj, UNO_QUERY );
1727 if ( xInv.is() )
1729 rtl::OUString sTypeName;
1730 xInv->getValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("$GetTypeName") ) ) >>= sTypeName;
1731 if ( sTypeName.getLength() == 0 || sTypeName.equals( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("IDispatch") ) ) )
1732 // can't check type, leave it pass
1733 result = true;
1734 else
1735 result = sTypeName.equals( aClass );
1737 break; // finished checking automation object
1739 OSL_TRACE("Checking if object implements %s",
1740 OUStringToOString( defaultNameSpace + aClass,
1741 RTL_TEXTENCODING_UTF8 ).getStr() );
1742 // although interfaces in the ooo.vba.vba namespace
1743 // obey the idl rules and have a leading X, in basic we
1744 // want to be able to do something like
1745 // 'dim wrkbooks as WorkBooks'
1746 // so test assumes the 'X' has been dropped
1747 sal_Int32 indexLastDot = sClassName.lastIndexOf('.');
1748 if ( indexLastDot > -1 && sClassName.copy( indexLastDot + 1).equalsIgnoreAsciiCase( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("X") ) + aClass ) )
1750 result = true;
1751 break;
1755 return result;
1758 // Dbg-Hilfsmethode zum Auslesen der in einem Object implementierten Interfaces
1759 String Impl_GetSupportedInterfaces( SbUnoObject* pUnoObj )
1761 Any aToInspectObj = pUnoObj->getUnoAny();
1763 // #54898: Nur TypeClass Interface zulasssen
1764 TypeClass eType = aToInspectObj.getValueType().getTypeClass();
1765 String aRet;
1766 if( eType != TypeClass_INTERFACE )
1768 aRet += ID_DBG_SUPPORTEDINTERFACES;
1769 aRet.AppendAscii( " not available.\n(TypeClass is not TypeClass_INTERFACE)\n" );
1771 else
1773 // Interface aus dem Any besorgen
1774 const Reference< XInterface > x = *(Reference< XInterface >*)aToInspectObj.getValue();
1776 // XIdlClassProvider-Interface ansprechen
1777 Reference< XIdlClassProvider > xClassProvider( x, UNO_QUERY );
1778 Reference< XTypeProvider > xTypeProvider( x, UNO_QUERY );
1780 aRet.AssignAscii( "Supported interfaces by object " );
1781 String aObjName = getDbgObjectName( pUnoObj );
1782 aRet += aObjName;
1783 aRet.AppendAscii( "\n" );
1784 if( xTypeProvider.is() )
1786 // Interfaces der Implementation holen
1787 Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
1788 const Type* pTypeArray = aTypeSeq.getConstArray();
1789 UINT32 nIfaceCount = aTypeSeq.getLength();
1790 for( UINT32 j = 0 ; j < nIfaceCount ; j++ )
1792 const Type& rType = pTypeArray[j];
1794 Reference<XIdlClass> xClass = TypeToIdlClass( rType );
1795 if( xClass.is() )
1797 aRet += Impl_GetInterfaceInfo( x, xClass, 1 );
1799 else
1801 typelib_TypeDescription * pTD = 0;
1802 rType.getDescription( &pTD );
1803 String TypeName( ::rtl::OUString( pTD->pTypeName ) );
1805 aRet.AppendAscii( "*** ERROR: No IdlClass for type \"" );
1806 aRet += TypeName;
1807 aRet.AppendAscii( "\"\n*** Please check type library\n" );
1811 else if( xClassProvider.is() )
1814 DBG_ERROR( "XClassProvider not supported in UNO3" );
1817 return aRet;
1822 // Dbg-Hilfsmethode SbxDataType -> String
1823 String Dbg_SbxDataType2String( SbxDataType eType )
1825 String aRet( RTL_CONSTASCII_USTRINGPARAM("Unknown Sbx-Type!") );
1826 switch( +eType )
1828 case SbxEMPTY: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxEMPTY") ); break;
1829 case SbxNULL: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxNULL") ); break;
1830 case SbxINTEGER: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxINTEGER") ); break;
1831 case SbxLONG: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxLONG") ); break;
1832 case SbxSINGLE: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxSINGLE") ); break;
1833 case SbxDOUBLE: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxDOUBLE") ); break;
1834 case SbxCURRENCY: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxCURRENCY") ); break;
1835 case SbxDECIMAL: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxDECIMAL") ); break;
1836 case SbxDATE: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxDATE") ); break;
1837 case SbxSTRING: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxSTRING") ); break;
1838 case SbxOBJECT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxOBJECT") ); break;
1839 case SbxERROR: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxERROR") ); break;
1840 case SbxBOOL: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxBOOL") ); break;
1841 case SbxVARIANT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxVARIANT") ); break;
1842 case SbxDATAOBJECT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxDATAOBJECT") ); break;
1843 case SbxCHAR: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxCHAR") ); break;
1844 case SbxBYTE: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxBYTE") ); break;
1845 case SbxUSHORT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxUSHORT") ); break;
1846 case SbxULONG: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxULONG") ); break;
1847 case SbxLONG64: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxLONG64") ); break;
1848 case SbxULONG64: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxULONG64") ); break;
1849 case SbxSALINT64: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxINT64") ); break;
1850 case SbxSALUINT64: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxUINT64") ); break;
1851 case SbxINT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxINT") ); break;
1852 case SbxUINT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxUINT") ); break;
1853 case SbxVOID: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxVOID") ); break;
1854 case SbxHRESULT: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxHRESULT") ); break;
1855 case SbxPOINTER: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxPOINTER") ); break;
1856 case SbxDIMARRAY: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxDIMARRAY") ); break;
1857 case SbxCARRAY: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxCARRAY") ); break;
1858 case SbxUSERDEF: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxUSERDEF") ); break;
1859 case SbxLPSTR: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxLPSTR") ); break;
1860 case SbxLPWSTR: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxLPWSTR") ); break;
1861 case SbxCoreSTRING: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxCoreSTRING" ) ); break;
1862 case SbxOBJECT | SbxARRAY: aRet = String( RTL_CONSTASCII_USTRINGPARAM("SbxARRAY") ); break;
1863 default: break;
1865 return aRet;
1868 // Dbg-Hilfsmethode zum Anzeigen der Properties eines SbUnoObjects
1869 String Impl_DumpProperties( SbUnoObject* pUnoObj )
1871 String aRet( RTL_CONSTASCII_USTRINGPARAM("Properties of object ") );
1872 String aObjName = getDbgObjectName( pUnoObj );
1873 aRet += aObjName;
1875 // Uno-Infos auswerten, um Arrays zu erkennen
1876 Reference< XIntrospectionAccess > xAccess = pUnoObj->getIntrospectionAccess();
1877 if( !xAccess.is() )
1879 Reference< XInvocation > xInvok = pUnoObj->getInvocation();
1880 if( xInvok.is() )
1881 xAccess = xInvok->getIntrospection();
1883 if( !xAccess.is() )
1885 aRet.AppendAscii( "\nUnknown, no introspection available\n" );
1886 return aRet;
1889 Sequence<Property> props = xAccess->getProperties( PropertyConcept::ALL - PropertyConcept::DANGEROUS );
1890 UINT32 nUnoPropCount = props.getLength();
1891 const Property* pUnoProps = props.getConstArray();
1893 SbxArray* pProps = pUnoObj->GetProperties();
1894 USHORT nPropCount = pProps->Count();
1895 USHORT nPropsPerLine = 1 + nPropCount / 30;
1896 for( USHORT i = 0; i < nPropCount; i++ )
1898 SbxVariable* pVar = pProps->Get( i );
1899 if( pVar )
1901 String aPropStr;
1902 if( (i % nPropsPerLine) == 0 )
1903 aPropStr.AppendAscii( "\n" );
1905 // Typ und Namen ausgeben
1906 // Ist es in Uno eine Sequence?
1907 SbxDataType eType = pVar->GetFullType();
1909 BOOL bMaybeVoid = FALSE;
1910 if( i < nUnoPropCount )
1912 const Property& rProp = pUnoProps[ i ];
1914 // #63133: Bei MAYBEVOID Typ aus Uno neu konvertieren,
1915 // damit nicht immer nur SbxEMPTY ausgegben wird.
1916 if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
1918 eType = unoToSbxType( rProp.Type.getTypeClass() );
1919 bMaybeVoid = TRUE;
1921 if( eType == SbxOBJECT )
1923 Type aType = rProp.Type;
1924 if( aType.getTypeClass() == TypeClass_SEQUENCE )
1925 eType = (SbxDataType) ( SbxOBJECT | SbxARRAY );
1928 aPropStr += Dbg_SbxDataType2String( eType );
1929 if( bMaybeVoid )
1930 aPropStr.AppendAscii( "/void" );
1931 aPropStr.AppendAscii( " " );
1932 aPropStr += pVar->GetName();
1934 if( i == nPropCount - 1 )
1935 aPropStr.AppendAscii( "\n" );
1936 else
1937 aPropStr.AppendAscii( "; " );
1939 aRet += aPropStr;
1942 return aRet;
1945 // Dbg-Hilfsmethode zum Anzeigen der Methoden eines SbUnoObjects
1946 String Impl_DumpMethods( SbUnoObject* pUnoObj )
1948 String aRet( RTL_CONSTASCII_USTRINGPARAM("Methods of object ") );
1949 String aObjName = getDbgObjectName( pUnoObj );
1950 aRet += aObjName;
1952 // XIntrospectionAccess, um die Typen der Parameter auch ausgeben zu koennen
1953 Reference< XIntrospectionAccess > xAccess = pUnoObj->getIntrospectionAccess();
1954 if( !xAccess.is() )
1956 Reference< XInvocation > xInvok = pUnoObj->getInvocation();
1957 if( xInvok.is() )
1958 xAccess = xInvok->getIntrospection();
1960 if( !xAccess.is() )
1962 aRet.AppendAscii( "\nUnknown, no introspection available\n" );
1963 return aRet;
1965 Sequence< Reference< XIdlMethod > > methods = xAccess->getMethods
1966 ( MethodConcept::ALL - MethodConcept::DANGEROUS );
1967 const Reference< XIdlMethod >* pUnoMethods = methods.getConstArray();
1969 SbxArray* pMethods = pUnoObj->GetMethods();
1970 USHORT nMethodCount = pMethods->Count();
1971 if( !nMethodCount )
1973 aRet.AppendAscii( "\nNo methods found\n" );
1974 return aRet;
1976 USHORT nPropsPerLine = 1 + nMethodCount / 30;
1977 for( USHORT i = 0; i < nMethodCount; i++ )
1979 SbxVariable* pVar = pMethods->Get( i );
1980 if( pVar )
1982 String aPropStr;
1983 if( (i % nPropsPerLine) == 0 )
1984 aPropStr.AppendAscii( "\n" );
1986 // Methode ansprechen
1987 const Reference< XIdlMethod >& rxMethod = pUnoMethods[i];
1989 // Ist es in Uno eine Sequence?
1990 SbxDataType eType = pVar->GetFullType();
1991 if( eType == SbxOBJECT )
1993 Reference< XIdlClass > xClass = rxMethod->getReturnType();
1994 if( xClass.is() && xClass->getTypeClass() == TypeClass_SEQUENCE )
1995 eType = (SbxDataType) ( SbxOBJECT | SbxARRAY );
1997 // Name und Typ ausgeben
1998 aPropStr += Dbg_SbxDataType2String( eType );
1999 aPropStr.AppendAscii( " " );
2000 aPropStr += pVar->GetName();
2001 aPropStr.AppendAscii( " ( " );
2003 // get-Methode darf keinen Parameter haben
2004 Sequence< Reference< XIdlClass > > aParamsSeq = rxMethod->getParameterTypes();
2005 UINT32 nParamCount = aParamsSeq.getLength();
2006 const Reference< XIdlClass >* pParams = aParamsSeq.getConstArray();
2008 if( nParamCount > 0 )
2010 for( USHORT j = 0; j < nParamCount; j++ )
2012 String aTypeStr = Dbg_SbxDataType2String( unoToSbxType( pParams[ j ] ) );
2013 aPropStr += aTypeStr;
2015 if( j < nParamCount - 1 )
2016 aPropStr.AppendAscii( ", " );
2019 else
2020 aPropStr.AppendAscii( "void" );
2022 aPropStr.AppendAscii( " ) " );
2024 if( i == nMethodCount - 1 )
2025 aPropStr.AppendAscii( "\n" );
2026 else
2027 aPropStr.AppendAscii( "; " );
2029 aRet += aPropStr;
2032 return aRet;
2035 TYPEINIT1(AutomationNamedArgsSbxArray,SbxArray)
2037 // Implementation SbUnoObject
2038 void SbUnoObject::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
2039 const SfxHint& rHint, const TypeId& rHintType )
2041 if( bNeedIntrospection )
2042 doIntrospection();
2044 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
2045 if( pHint )
2047 SbxVariable* pVar = pHint->GetVar();
2048 SbxArray* pParams = pVar->GetParameters();
2049 SbUnoProperty* pProp = PTR_CAST(SbUnoProperty,pVar);
2050 SbUnoMethod* pMeth = PTR_CAST(SbUnoMethod,pVar);
2051 if( pProp )
2053 bool bInvocation = pProp->isInvocationBased();
2054 if( pHint->GetId() == SBX_HINT_DATAWANTED )
2056 // Test-Properties
2057 INT32 nId = pProp->nId;
2058 if( nId < 0 )
2060 // Id == -1: Implementierte Interfaces gemaess ClassProvider anzeigen
2061 if( nId == -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
2063 String aRetStr = Impl_GetSupportedInterfaces( this );
2064 pVar->PutString( aRetStr );
2066 // Id == -2: Properties ausgeben
2067 else if( nId == -2 ) // Property ID_DBG_PROPERTIES
2069 // Jetzt muessen alle Properties angelegt werden
2070 implCreateAll();
2071 String aRetStr = Impl_DumpProperties( this );
2072 pVar->PutString( aRetStr );
2074 // Id == -3: Methoden ausgeben
2075 else if( nId == -3 ) // Property ID_DBG_METHODS
2077 // Jetzt muessen alle Properties angelegt werden
2078 implCreateAll();
2079 String aRetStr = Impl_DumpMethods( this );
2080 pVar->PutString( aRetStr );
2082 return;
2085 if( !bInvocation && mxUnoAccess.is() )
2089 // Wert holen
2090 Reference< XPropertySet > xPropSet( mxUnoAccess->queryAdapter( ::getCppuType( (const Reference< XPropertySet > *)0 ) ), UNO_QUERY );
2091 Any aRetAny = xPropSet->getPropertyValue( pProp->GetName() );
2092 // Die Nutzung von getPropertyValue (statt ueber den Index zu gehen) ist
2093 // nicht optimal, aber die Umstellung auf XInvocation steht ja ohnehin an
2094 // Ansonsten kann auch FastPropertySet genutzt werden
2096 // Wert von Uno nach Sbx uebernehmen
2097 unoToSbxValue( pVar, aRetAny );
2099 catch( const Exception& )
2101 implHandleAnyException( ::cppu::getCaughtException() );
2104 else if( bInvocation && mxInvocation.is() )
2108 UINT32 nParamCount = pParams ? ((UINT32)pParams->Count() - 1) : 0;
2109 sal_Bool bCanBeConsideredAMethod = mxInvocation->hasMethod( pProp->GetName() );
2110 Any aRetAny;
2111 if ( bCanBeConsideredAMethod && nParamCount )
2113 // Automation properties have methods, so.. we need to invoke this through
2114 // XInvocation
2115 Sequence<Any> args;
2116 processAutomationParams( pParams, args, true, nParamCount );
2117 aRetAny = invokeAutomationMethod( pProp->GetName(), args, pParams, nParamCount, mxInvocation, GetProp );
2119 else
2120 // Wert holen
2121 aRetAny = mxInvocation->getValue( pProp->GetName() );
2123 // Wert von Uno nach Sbx uebernehmen
2124 unoToSbxValue( pVar, aRetAny );
2125 if( pParams && bCanBeConsideredAMethod )
2126 pVar->SetParameters( NULL );
2129 catch( const Exception& )
2131 implHandleAnyException( ::cppu::getCaughtException() );
2135 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
2137 if( !bInvocation && mxUnoAccess.is() )
2139 if( pProp->aUnoProp.Attributes & PropertyAttribute::READONLY )
2141 StarBASIC::Error( SbERR_PROP_READONLY );
2142 return;
2145 // Wert von Uno nach Sbx uebernehmen
2146 Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
2149 // Wert setzen
2150 Reference< XPropertySet > xPropSet( mxUnoAccess->queryAdapter( ::getCppuType( (const Reference< XPropertySet > *)0 ) ), UNO_QUERY );
2151 xPropSet->setPropertyValue( pProp->GetName(), aAnyValue );
2152 // Die Nutzung von getPropertyValue (statt ueber den Index zu gehen) ist
2153 // nicht optimal, aber die Umstellung auf XInvocation steht ja ohnehin an
2154 // Ansonsten kann auch FastPropertySet genutzt werden
2156 catch( const Exception& )
2158 implHandleAnyException( ::cppu::getCaughtException() );
2161 else if( bInvocation && mxInvocation.is() )
2163 // Wert von Uno nach Sbx uebernehmen
2164 Any aAnyValue = sbxToUnoValueImpl( pVar );
2167 // Wert setzen
2168 mxInvocation->setValue( pProp->GetName(), aAnyValue );
2170 catch( const Exception& )
2172 implHandleAnyException( ::cppu::getCaughtException() );
2177 else if( pMeth )
2179 bool bInvocation = pMeth->isInvocationBased();
2180 if( pHint->GetId() == SBX_HINT_DATAWANTED )
2182 // Anzahl Parameter -1 wegen Param0 == this
2183 UINT32 nParamCount = pParams ? ((UINT32)pParams->Count() - 1) : 0;
2184 Sequence<Any> args;
2185 BOOL bOutParams = FALSE;
2186 UINT32 i;
2188 if( !bInvocation && mxUnoAccess.is() )
2190 // Infos holen
2191 const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
2192 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2193 UINT32 nUnoParamCount = rInfoSeq.getLength();
2194 UINT32 nAllocParamCount = nParamCount;
2196 // Ueberschuessige Parameter ignorieren, Alternative: Error schmeissen
2197 if( nParamCount > nUnoParamCount )
2199 nParamCount = nUnoParamCount;
2200 nAllocParamCount = nParamCount;
2202 else if( nParamCount < nUnoParamCount )
2204 SbiInstance* pInst = pINST;
2205 if( pInst && pInst->IsCompatibility() )
2207 // Check types
2208 bool bError = false;
2209 for( i = nParamCount ; i < nUnoParamCount ; i++ )
2211 const ParamInfo& rInfo = pParamInfos[i];
2212 const Reference< XIdlClass >& rxClass = rInfo.aType;
2213 if( rxClass->getTypeClass() != TypeClass_ANY )
2215 bError = true;
2216 StarBASIC::Error( SbERR_NOT_OPTIONAL );
2219 if( !bError )
2220 nAllocParamCount = nUnoParamCount;
2224 if( nAllocParamCount > 0 )
2226 args.realloc( nAllocParamCount );
2227 Any* pAnyArgs = args.getArray();
2228 for( i = 0 ; i < nParamCount ; i++ )
2230 const ParamInfo& rInfo = pParamInfos[i];
2231 const Reference< XIdlClass >& rxClass = rInfo.aType;
2232 //const XIdlClassRef& rxClass = pUnoParams[i];
2234 com::sun::star::uno::Type aType( rxClass->getTypeClass(), rxClass->getName() );
2236 // ACHTUNG: Bei den Sbx-Parametern den Offset nicht vergessen!
2237 pAnyArgs[i] = sbxToUnoValue( pParams->Get( (USHORT)(i+1) ), aType );
2239 // Wenn es nicht schon feststeht pruefen, ob Out-Parameter vorliegen
2240 if( !bOutParams )
2242 ParamMode aParamMode = rInfo.aMode;
2243 if( aParamMode != ParamMode_IN )
2244 bOutParams = TRUE;
2249 else if( bInvocation && pParams && mxInvocation.is() )
2251 bool bOLEAutomation = true;
2252 processAutomationParams( pParams, args, bOLEAutomation, nParamCount );
2255 // Methode callen
2256 GetSbData()->bBlockCompilerError = TRUE; // #106433 Block compiler errors for API calls
2259 if( !bInvocation && mxUnoAccess.is() )
2261 Any aRetAny = pMeth->m_xUnoMethod->invoke( getUnoAny(), args );
2263 // Wert von Uno nach Sbx uebernehmen
2264 unoToSbxValue( pVar, aRetAny );
2266 // Muessen wir Out-Parameter zurueckkopieren?
2267 if( bOutParams )
2269 const Any* pAnyArgs = args.getConstArray();
2271 // Infos holen
2272 const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
2273 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2275 UINT32 j;
2276 for( j = 0 ; j < nParamCount ; j++ )
2278 const ParamInfo& rInfo = pParamInfos[j];
2279 ParamMode aParamMode = rInfo.aMode;
2280 if( aParamMode != ParamMode_IN )
2281 unoToSbxValue( (SbxVariable*)pParams->Get( (USHORT)(j+1) ), pAnyArgs[ j ] );
2285 else if( bInvocation && mxInvocation.is() )
2287 Any aRetAny = invokeAutomationMethod( pMeth->GetName(), args, pParams, nParamCount, mxInvocation );
2288 unoToSbxValue( pVar, aRetAny );
2291 // #55460, Parameter hier weghauen, da das in unoToSbxValue()
2292 // bei Arrays wegen #54548 nicht mehr gemacht wird
2293 if( pParams )
2294 pVar->SetParameters( NULL );
2296 catch( const Exception& )
2298 implHandleAnyException( ::cppu::getCaughtException() );
2300 GetSbData()->bBlockCompilerError = FALSE; // #106433 Unblock compiler errors
2303 else
2304 SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
2309 #ifdef INVOCATION_ONLY
2310 // Aus USR
2311 Reference< XInvocation > createDynamicInvocationFor( const Any& aAny );
2312 #endif
2314 SbUnoObject::SbUnoObject( const String& aName_, const Any& aUnoObj_ )
2315 : SbxObject( aName_ )
2316 , bNeedIntrospection( TRUE )
2318 static Reference< XIntrospection > xIntrospection;
2320 // Default-Properties von Sbx wieder rauspruegeln
2321 Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_DONTCARE );
2322 Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Parent") ), SbxCLASS_DONTCARE );
2324 // Typ des Objekts pruefen
2325 TypeClass eType = aUnoObj_.getValueType().getTypeClass();
2326 Reference< XInterface > x;
2327 if( eType == TypeClass_INTERFACE )
2329 // Interface aus dem Any besorgen
2330 x = *(Reference< XInterface >*)aUnoObj_.getValue();
2331 if( !x.is() )
2332 return;
2335 Reference< XTypeProvider > xTypeProvider;
2336 #ifdef INVOCATION_ONLY
2337 // Invocation besorgen
2338 mxInvocation = createDynamicInvocationFor( aUnoObj_ );
2339 #else
2340 // Hat das Object selbst eine Invocation?
2341 mxInvocation = Reference< XInvocation >( x, UNO_QUERY );
2343 xTypeProvider = Reference< XTypeProvider >( x, UNO_QUERY );
2344 #endif
2346 if( mxInvocation.is() )
2348 // #94670: This is WRONG because then the MaterialHolder doesn't refer
2349 // to the object implementing XInvocation but to the object passed to
2350 // the invocation service!!!
2351 // mxMaterialHolder = Reference< XMaterialHolder >::query( mxInvocation );
2353 // ExactName holen
2354 mxExactNameInvocation = Reference< XExactName >::query( mxInvocation );
2356 // Rest bezieht sich nur auf Introspection
2357 if( !xTypeProvider.is() )
2359 bNeedIntrospection = FALSE;
2360 return;
2364 maTmpUnoObj = aUnoObj_;
2367 //*** Namen bestimmen ***
2368 BOOL bFatalError = TRUE;
2370 // Ist es ein Interface oder eine struct?
2371 BOOL bSetClassName = FALSE;
2372 String aClassName_;
2373 if( eType == TypeClass_STRUCT || eType == TypeClass_EXCEPTION )
2375 // Struct ist Ok
2376 bFatalError = FALSE;
2378 // #67173 Echten Klassen-Namen eintragen
2379 if( aName_.Len() == 0 )
2381 aClassName_ = String( aUnoObj_.getValueType().getTypeName() );
2382 bSetClassName = TRUE;
2385 else if( eType == TypeClass_INTERFACE )
2387 // #70197 Interface geht immer durch Typ im Any
2388 bFatalError = FALSE;
2390 // Nach XIdlClassProvider-Interface fragen
2391 Reference< XIdlClassProvider > xClassProvider( x, UNO_QUERY );
2392 if( xClassProvider.is() )
2394 // #67173 Echten Klassen-Namen eintragen
2395 if( aName_.Len() == 0 )
2397 Sequence< Reference< XIdlClass > > szClasses = xClassProvider->getIdlClasses();
2398 UINT32 nLen = szClasses.getLength();
2399 if( nLen )
2401 const Reference< XIdlClass > xImplClass = szClasses.getConstArray()[ 0 ];
2402 if( xImplClass.is() )
2404 aClassName_ = String( xImplClass->getName() );
2405 bSetClassName = TRUE;
2411 if( bSetClassName )
2412 SetClassName( aClassName_ );
2414 // Weder Interface noch Struct -> FatalError
2415 if( bFatalError )
2417 StarBASIC::FatalError( ERRCODE_BASIC_EXCEPTION );
2418 return;
2421 // #67781 Introspection erst on demand durchfuehren
2424 SbUnoObject::~SbUnoObject()
2429 // #76470 Introspection on Demand durchfuehren
2430 void SbUnoObject::doIntrospection( void )
2432 static Reference< XIntrospection > xIntrospection;
2434 if( !bNeedIntrospection )
2435 return;
2436 bNeedIntrospection = FALSE;
2438 if( !xIntrospection.is() )
2440 // Introspection-Service holen
2441 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
2442 if ( xFactory.is() )
2444 Reference< XInterface > xI = xFactory->createInstance( rtl::OUString::createFromAscii("com.sun.star.beans.Introspection") );
2445 if (xI.is())
2446 xIntrospection = Reference< XIntrospection >::query( xI );
2447 //xI->queryInterface( ::getCppuType( (const Reference< XIntrospection > *)0 ), xIntrospection );
2450 if( !xIntrospection.is() )
2452 StarBASIC::FatalError( ERRCODE_BASIC_EXCEPTION );
2453 return;
2456 // Introspection durchfuehren
2459 mxUnoAccess = xIntrospection->inspect( maTmpUnoObj );
2461 catch( RuntimeException& e )
2463 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
2466 if( !mxUnoAccess.is() )
2468 // #51475 Ungueltiges Objekt kennzeichnen (kein mxMaterialHolder)
2469 return;
2472 // MaterialHolder vom Access holen
2473 mxMaterialHolder = Reference< XMaterialHolder >::query( mxUnoAccess );
2475 // ExactName vom Access holen
2476 mxExactName = Reference< XExactName >::query( mxUnoAccess );
2482 // #67781 Start einer Liste aller SbUnoMethod-Instanzen
2483 static SbUnoMethod* pFirst = NULL;
2485 void clearUnoMethods( void )
2487 SbUnoMethod* pMeth = pFirst;
2488 while( pMeth )
2490 pMeth->SbxValue::Clear();
2491 pMeth = pMeth->pNext;
2496 SbUnoMethod::SbUnoMethod
2498 const String& aName_,
2499 SbxDataType eSbxType,
2500 Reference< XIdlMethod > xUnoMethod_,
2501 bool bInvocation
2503 : SbxMethod( aName_, eSbxType )
2504 , mbInvocation( bInvocation )
2506 m_xUnoMethod = xUnoMethod_;
2507 pParamInfoSeq = NULL;
2509 // #67781 Methode in Liste eintragen
2510 pNext = pFirst;
2511 pPrev = NULL;
2512 pFirst = this;
2513 if( pNext )
2514 pNext->pPrev = this;
2517 SbUnoMethod::~SbUnoMethod()
2519 delete pParamInfoSeq;
2521 if( this == pFirst )
2522 pFirst = pNext;
2523 else if( pPrev )
2524 pPrev->pNext = pNext;
2525 if( pNext )
2526 pNext->pPrev = pPrev;
2529 SbxInfo* SbUnoMethod::GetInfo()
2531 if( !pInfo && m_xUnoMethod.is() )
2533 SbiInstance* pInst = pINST;
2534 if( pInst && pInst->IsCompatibility() )
2536 pInfo = new SbxInfo();
2538 const Sequence<ParamInfo>& rInfoSeq = getParamInfos();
2539 const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
2540 UINT32 nParamCount = rInfoSeq.getLength();
2542 for( UINT32 i = 0 ; i < nParamCount ; i++ )
2544 const ParamInfo& rInfo = pParamInfos[i];
2545 ::rtl::OUString aParamName = rInfo.aName;
2547 // const Reference< XIdlClass >& rxClass = rInfo.aType;
2548 SbxDataType t = SbxVARIANT;
2549 USHORT nFlags_ = SBX_READ;
2550 pInfo->AddParam( aParamName, t, nFlags_ );
2554 return pInfo;
2557 const Sequence<ParamInfo>& SbUnoMethod::getParamInfos( void )
2559 if( !pParamInfoSeq && m_xUnoMethod.is() )
2561 Sequence<ParamInfo> aTmp = m_xUnoMethod->getParameterInfos() ;
2562 pParamInfoSeq = new Sequence<ParamInfo>( aTmp );
2564 return *pParamInfoSeq;
2567 SbUnoProperty::SbUnoProperty
2569 const String& aName_,
2570 SbxDataType eSbxType,
2571 const Property& aUnoProp_,
2572 INT32 nId_,
2573 bool bInvocation
2575 : SbxProperty( aName_, eSbxType )
2576 , aUnoProp( aUnoProp_ )
2577 , nId( nId_ )
2578 , mbInvocation( bInvocation )
2580 // #54548, bei bedarf Dummy-Array einsetzen, damit SbiRuntime::CheckArray() geht
2581 static SbxArrayRef xDummyArray = new SbxArray( SbxVARIANT );
2582 if( eSbxType & SbxARRAY )
2583 PutObject( xDummyArray );
2586 SbUnoProperty::~SbUnoProperty()
2590 SbxVariable* SbUnoObject::Find( const String& rName, SbxClassType t )
2592 static Reference< XIdlMethod > xDummyMethod;
2593 static Property aDummyProp;
2595 SbxVariable* pRes = SbxObject::Find( rName, t );
2597 if( bNeedIntrospection )
2598 doIntrospection();
2600 // Neu 4.3.1999: Properties on Demand anlegen, daher jetzt perIntrospectionAccess
2601 // suchen, ob doch eine Property oder Methode des geforderten Namens existiert
2602 if( !pRes )
2604 ::rtl::OUString aUName( rName );
2605 if( mxUnoAccess.is() )
2607 if( mxExactName.is() )
2609 ::rtl::OUString aUExactName = mxExactName->getExactName( aUName );
2610 if( aUExactName.getLength() )
2611 aUName = aUExactName;
2613 if( mxUnoAccess->hasProperty( aUName, PropertyConcept::ALL - PropertyConcept::DANGEROUS ) )
2615 const Property& rProp = mxUnoAccess->
2616 getProperty( aUName, PropertyConcept::ALL - PropertyConcept::DANGEROUS );
2618 // #58455 Wenn die Property void sein kann, muss als Typ Variant gesetzt werden
2619 SbxDataType eSbxType;
2620 if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
2621 eSbxType = SbxVARIANT;
2622 else
2623 eSbxType = unoToSbxType( rProp.Type.getTypeClass() );
2625 // Property anlegen und reinbraten
2626 SbxVariableRef xVarRef = new SbUnoProperty( rProp.Name, eSbxType, rProp, 0, false );
2627 QuickInsert( (SbxVariable*)xVarRef );
2628 pRes = xVarRef;
2630 else if( mxUnoAccess->hasMethod( aUName,
2631 MethodConcept::ALL - MethodConcept::DANGEROUS ) )
2633 // Methode ansprechen
2634 const Reference< XIdlMethod >& rxMethod = mxUnoAccess->
2635 getMethod( aUName, MethodConcept::ALL - MethodConcept::DANGEROUS );
2637 // SbUnoMethode anlegen und reinbraten
2638 SbxVariableRef xMethRef = new SbUnoMethod( rxMethod->getName(),
2639 unoToSbxType( rxMethod->getReturnType() ), rxMethod, false );
2640 QuickInsert( (SbxVariable*)xMethRef );
2641 pRes = xMethRef;
2644 // Wenn immer noch nichts gefunden wurde, muss geprueft werden, ob NameAccess vorliegt
2645 if( !pRes )
2649 Reference< XNameAccess > xNameAccess( mxUnoAccess->queryAdapter( ::getCppuType( (const Reference< XPropertySet > *)0 ) ), UNO_QUERY );
2650 ::rtl::OUString aUName2( rName );
2652 if( xNameAccess.is() && xNameAccess->hasByName( aUName2 ) )
2654 Any aAny = xNameAccess->getByName( aUName2 );
2656 // ACHTUNG: Die hier erzeugte Variable darf wegen bei XNameAccess
2657 // nicht als feste Property in das Object aufgenommen werden und
2658 // wird daher nirgendwo gehalten.
2659 // Wenn das Probleme gibt, muss das kuenstlich gemacht werden oder
2660 // es muss eine Klasse SbUnoNameAccessProperty geschaffen werden,
2661 // bei der die Existenz staendig neu ueberprueft und die ggf. weg-
2662 // geworfen wird, wenn der Name nicht mehr gefunden wird.
2663 pRes = new SbxVariable( SbxVARIANT );
2664 unoToSbxValue( pRes, aAny );
2667 catch( NoSuchElementException& e )
2669 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
2671 catch( const Exception& )
2673 // Anlegen, damit der Exception-Fehler nicht ueberschrieben wird
2674 if( !pRes )
2675 pRes = new SbxVariable( SbxVARIANT );
2677 implHandleAnyException( ::cppu::getCaughtException() );
2681 if( !pRes && mxInvocation.is() )
2683 if( mxExactNameInvocation.is() )
2685 ::rtl::OUString aUExactName = mxExactNameInvocation->getExactName( aUName );
2686 if( aUExactName.getLength() )
2687 aUName = aUExactName;
2692 if( mxInvocation->hasProperty( aUName ) )
2694 // Property anlegen und reinbraten
2695 SbxVariableRef xVarRef = new SbUnoProperty( aUName, SbxVARIANT, aDummyProp, 0, true );
2696 QuickInsert( (SbxVariable*)xVarRef );
2697 pRes = xVarRef;
2699 else if( mxInvocation->hasMethod( aUName ) )
2701 // SbUnoMethode anlegen und reinbraten
2702 SbxVariableRef xMethRef = new SbUnoMethod( aUName, SbxVARIANT, xDummyMethod, true );
2703 QuickInsert( (SbxVariable*)xMethRef );
2704 pRes = xMethRef;
2707 catch( RuntimeException& e )
2709 // Anlegen, damit der Exception-Fehler nicht ueberschrieben wird
2710 if( !pRes )
2711 pRes = new SbxVariable( SbxVARIANT );
2713 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
2718 // Ganz am Schluss noch pruefen, ob die Dbg_-Properties gemeint sind
2720 if( !pRes )
2722 if( rName.EqualsIgnoreCaseAscii( ID_DBG_SUPPORTEDINTERFACES ) ||
2723 rName.EqualsIgnoreCaseAscii( ID_DBG_PROPERTIES ) ||
2724 rName.EqualsIgnoreCaseAscii( ID_DBG_METHODS ) )
2726 // Anlegen
2727 implCreateDbgProperties();
2729 // Jetzt muessen sie regulaer gefunden werden
2730 pRes = SbxObject::Find( rName, SbxCLASS_DONTCARE );
2733 return pRes;
2737 // Hilfs-Methode zum Anlegen der dbg_-Properties
2738 void SbUnoObject::implCreateDbgProperties( void )
2740 Property aProp;
2742 // Id == -1: Implementierte Interfaces gemaess ClassProvider anzeigen
2743 SbxVariableRef xVarRef = new SbUnoProperty( ID_DBG_SUPPORTEDINTERFACES, SbxSTRING, aProp, -1, false );
2744 QuickInsert( (SbxVariable*)xVarRef );
2746 // Id == -2: Properties ausgeben
2747 xVarRef = new SbUnoProperty( ID_DBG_PROPERTIES, SbxSTRING, aProp, -2, false );
2748 QuickInsert( (SbxVariable*)xVarRef );
2750 // Id == -3: Methoden ausgeben
2751 xVarRef = new SbUnoProperty( ID_DBG_METHODS, SbxSTRING, aProp, -3, false );
2752 QuickInsert( (SbxVariable*)xVarRef );
2755 void SbUnoObject::implCreateAll( void )
2757 // Bestehende Methoden und Properties alle wieder wegwerfen
2758 pMethods = new SbxArray;
2759 pProps = new SbxArray;
2761 if( bNeedIntrospection ) doIntrospection();
2763 // Instrospection besorgen
2764 Reference< XIntrospectionAccess > xAccess = mxUnoAccess;
2765 if( !xAccess.is() )
2767 if( mxInvocation.is() )
2768 xAccess = mxInvocation->getIntrospection();
2770 if( !xAccess.is() )
2771 return;
2773 // Properties anlegen
2774 Sequence<Property> props = xAccess->getProperties( PropertyConcept::ALL - PropertyConcept::DANGEROUS );
2775 UINT32 nPropCount = props.getLength();
2776 const Property* pProps_ = props.getConstArray();
2778 UINT32 i;
2779 for( i = 0 ; i < nPropCount ; i++ )
2781 const Property& rProp = pProps_[ i ];
2783 // #58455 Wenn die Property void sein kann, muss als Typ Variant gesetzt werden
2784 SbxDataType eSbxType;
2785 if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
2786 eSbxType = SbxVARIANT;
2787 else
2788 eSbxType = unoToSbxType( rProp.Type.getTypeClass() );
2790 // Property anlegen und reinbraten
2791 SbxVariableRef xVarRef = new SbUnoProperty( rProp.Name, eSbxType, rProp, i, false );
2792 QuickInsert( (SbxVariable*)xVarRef );
2795 // Dbg_-Properties anlegen
2796 implCreateDbgProperties();
2798 // Methoden anlegen
2799 Sequence< Reference< XIdlMethod > > aMethodSeq = xAccess->getMethods
2800 ( MethodConcept::ALL - MethodConcept::DANGEROUS );
2801 UINT32 nMethCount = aMethodSeq.getLength();
2802 const Reference< XIdlMethod >* pMethods_ = aMethodSeq.getConstArray();
2803 for( i = 0 ; i < nMethCount ; i++ )
2805 // Methode ansprechen
2806 const Reference< XIdlMethod >& rxMethod = pMethods_[i];
2808 // SbUnoMethode anlegen und reinbraten
2809 SbxVariableRef xMethRef = new SbUnoMethod
2810 ( rxMethod->getName(), unoToSbxType( rxMethod->getReturnType() ), rxMethod, false );
2811 QuickInsert( (SbxVariable*)xMethRef );
2816 // Wert rausgeben
2817 Any SbUnoObject::getUnoAny( void )
2819 Any aRetAny;
2820 if( bNeedIntrospection ) doIntrospection();
2821 if( mxMaterialHolder.is() )
2822 aRetAny = mxMaterialHolder->getMaterial();
2823 else if( mxInvocation.is() )
2824 aRetAny <<= mxInvocation;
2825 return aRetAny;
2828 // Hilfsmethode zum Anlegen einer Uno-Struct per CoreReflection
2829 SbUnoObject* Impl_CreateUnoStruct( const String& aClassName )
2831 // CoreReflection holen
2832 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
2833 if( !xCoreReflection.is() )
2834 return NULL;
2836 // Klasse suchen
2837 Reference< XIdlClass > xClass;
2838 Reference< XHierarchicalNameAccess > xHarryName =
2839 getCoreReflection_HierarchicalNameAccess_Impl();
2840 if( xHarryName.is() && xHarryName->hasByHierarchicalName( aClassName ) )
2841 xClass = xCoreReflection->forName( aClassName );
2842 if( !xClass.is() )
2843 return NULL;
2845 // Ist es ueberhaupt ein struct?
2846 TypeClass eType = xClass->getTypeClass();
2847 if ( ( eType != TypeClass_STRUCT ) && ( eType != TypeClass_EXCEPTION ) )
2848 return NULL;
2850 // Instanz erzeugen
2851 Any aNewAny;
2852 xClass->createObject( aNewAny );
2854 // SbUnoObject daraus basteln
2855 SbUnoObject* pUnoObj = new SbUnoObject( aClassName, aNewAny );
2856 return pUnoObj;
2860 // Factory-Klasse fuer das Anlegen von Uno-Structs per DIM AS NEW
2861 SbxBase* SbUnoFactory::Create( UINT16, UINT32 )
2863 // Ueber SbxId laeuft in Uno nix
2864 return NULL;
2867 SbxObject* SbUnoFactory::CreateObject( const String& rClassName )
2869 return Impl_CreateUnoStruct( rClassName );
2873 // Provisorische Schnittstelle fuer UNO-Anbindung
2874 // Liefert ein SbxObject, das ein Uno-Interface wrappt
2875 SbxObjectRef GetSbUnoObject( const String& aName, const Any& aUnoObj_ )
2877 return new SbUnoObject( aName, aUnoObj_ );
2880 // Force creation of all properties for debugging
2881 void createAllObjectProperties( SbxObject* pObj )
2883 if( !pObj )
2884 return;
2886 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pObj);
2887 if( pUnoObj )
2888 pUnoObj->createAllProperties();
2889 else
2890 pObj->GetAll( SbxCLASS_DONTCARE );
2894 void RTL_Impl_CreateUnoStruct( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
2896 (void)pBasic;
2897 (void)bWrite;
2899 // Wir brauchen mindestens 1 Parameter
2900 if ( rPar.Count() < 2 )
2902 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2903 return;
2906 // Klassen-Name der struct holen
2907 String aClassName = rPar.Get(1)->GetString();
2909 // Versuchen, gleichnamige Struct zu erzeugen
2910 SbUnoObjectRef xUnoObj = Impl_CreateUnoStruct( aClassName );
2911 if( !xUnoObj )
2912 return;
2914 // Objekt zurueckliefern
2915 SbxVariableRef refVar = rPar.Get(0);
2916 refVar->PutObject( (SbUnoObject*)xUnoObj );
2919 void RTL_Impl_CreateUnoService( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
2921 (void)pBasic;
2922 (void)bWrite;
2924 // Wir brauchen mindestens 1 Parameter
2925 if ( rPar.Count() < 2 )
2927 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2928 return;
2931 // Klassen-Name der struct holen
2932 String aServiceName = rPar.Get(1)->GetString();
2934 // Service suchen und instanzieren
2935 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
2936 Reference< XInterface > xInterface;
2937 if ( xFactory.is() )
2941 xInterface = xFactory->createInstance( aServiceName );
2943 catch( const Exception& )
2945 implHandleAnyException( ::cppu::getCaughtException() );
2949 SbxVariableRef refVar = rPar.Get(0);
2950 if( xInterface.is() )
2952 Any aAny;
2953 aAny <<= xInterface;
2955 // SbUnoObject daraus basteln und zurueckliefern
2956 SbUnoObjectRef xUnoObj = new SbUnoObject( aServiceName, aAny );
2957 if( xUnoObj->getUnoAny().getValueType().getTypeClass() != TypeClass_VOID )
2959 // Objekt zurueckliefern
2960 refVar->PutObject( (SbUnoObject*)xUnoObj );
2962 else
2964 refVar->PutObject( NULL );
2967 else
2969 refVar->PutObject( NULL );
2973 void RTL_Impl_CreateUnoServiceWithArguments( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
2975 (void)pBasic;
2976 (void)bWrite;
2978 // Wir brauchen mindestens 2 Parameter
2979 if ( rPar.Count() < 3 )
2981 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2982 return;
2985 // Klassen-Name der struct holen
2986 String aServiceName = rPar.Get(1)->GetString();
2987 Any aArgAsAny = sbxToUnoValue( rPar.Get(2),
2988 getCppuType( (Sequence<Any>*)0 ) );
2989 Sequence< Any > aArgs;
2990 aArgAsAny >>= aArgs;
2992 // Service suchen und instanzieren
2993 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
2994 Reference< XInterface > xInterface;
2995 if ( xFactory.is() )
2999 xInterface = xFactory->createInstanceWithArguments( aServiceName, aArgs );
3001 catch( const Exception& )
3003 implHandleAnyException( ::cppu::getCaughtException() );
3007 SbxVariableRef refVar = rPar.Get(0);
3008 if( xInterface.is() )
3010 Any aAny;
3011 aAny <<= xInterface;
3013 // SbUnoObject daraus basteln und zurueckliefern
3014 SbUnoObjectRef xUnoObj = new SbUnoObject( aServiceName, aAny );
3015 if( xUnoObj->getUnoAny().getValueType().getTypeClass() != TypeClass_VOID )
3017 // Objekt zurueckliefern
3018 refVar->PutObject( (SbUnoObject*)xUnoObj );
3020 else
3022 refVar->PutObject( NULL );
3025 else
3027 refVar->PutObject( NULL );
3031 void RTL_Impl_GetProcessServiceManager( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
3033 (void)pBasic;
3034 (void)bWrite;
3036 SbxVariableRef refVar = rPar.Get(0);
3038 // Globalen Service-Manager holen
3039 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
3040 if( xFactory.is() )
3042 Any aAny;
3043 aAny <<= xFactory;
3045 // SbUnoObject daraus basteln und zurueckliefern
3046 SbUnoObjectRef xUnoObj = new SbUnoObject( String( RTL_CONSTASCII_USTRINGPARAM("ProcessServiceManager") ), aAny );
3047 refVar->PutObject( (SbUnoObject*)xUnoObj );
3049 else
3051 refVar->PutObject( NULL );
3055 void RTL_Impl_HasInterfaces( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
3057 (void)pBasic;
3058 (void)bWrite;
3060 // Wir brauchen mindestens 2 Parameter
3061 USHORT nParCount = rPar.Count();
3062 if( nParCount < 3 )
3064 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3065 return;
3068 // Variable fuer Rueckgabewert
3069 SbxVariableRef refVar = rPar.Get(0);
3070 refVar->PutBool( FALSE );
3072 // Uno-Objekt holen
3073 SbxBaseRef pObj = (SbxBase*)rPar.Get( 1 )->GetObject();
3074 if( !(pObj && pObj->ISA(SbUnoObject)) )
3075 return;
3076 Any aAny = ((SbUnoObject*)(SbxBase*)pObj)->getUnoAny();
3077 TypeClass eType = aAny.getValueType().getTypeClass();
3078 if( eType != TypeClass_INTERFACE )
3079 return;
3081 // Interface aus dem Any besorgen
3082 Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
3084 // CoreReflection holen
3085 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
3086 if( !xCoreReflection.is() )
3087 return;
3089 for( USHORT i = 2 ; i < nParCount ; i++ )
3091 // Interface-Name der struct holen
3092 String aIfaceName = rPar.Get( i )->GetString();
3094 // Klasse suchen
3095 Reference< XIdlClass > xClass = xCoreReflection->forName( aIfaceName );
3096 if( !xClass.is() )
3097 return;
3099 // Pruefen, ob das Interface unterstuetzt wird
3100 ::rtl::OUString aClassName = xClass->getName();
3101 Type aClassType( xClass->getTypeClass(), aClassName.getStr() );
3102 if( !x->queryInterface( aClassType ).hasValue() )
3103 return;
3106 // Alles hat geklappt, dann TRUE liefern
3107 refVar->PutBool( TRUE );
3110 void RTL_Impl_IsUnoStruct( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
3112 (void)pBasic;
3113 (void)bWrite;
3115 // Wir brauchen mindestens 1 Parameter
3116 if ( rPar.Count() < 2 )
3118 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3119 return;
3122 // Variable fuer Rueckgabewert
3123 SbxVariableRef refVar = rPar.Get(0);
3124 refVar->PutBool( FALSE );
3126 // Uno-Objekt holen
3127 SbxVariableRef xParam = rPar.Get( 1 );
3128 if( !xParam->IsObject() )
3129 return;
3130 SbxBaseRef pObj = (SbxBase*)rPar.Get( 1 )->GetObject();
3131 if( !(pObj && pObj->ISA(SbUnoObject)) )
3132 return;
3133 Any aAny = ((SbUnoObject*)(SbxBase*)pObj)->getUnoAny();
3134 TypeClass eType = aAny.getValueType().getTypeClass();
3135 if( eType == TypeClass_STRUCT )
3136 refVar->PutBool( TRUE );
3140 void RTL_Impl_EqualUnoObjects( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
3142 (void)pBasic;
3143 (void)bWrite;
3145 if ( rPar.Count() < 3 )
3147 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3148 return;
3151 // Variable fuer Rueckgabewert
3152 SbxVariableRef refVar = rPar.Get(0);
3153 refVar->PutBool( FALSE );
3155 // Uno-Objekte holen
3156 SbxVariableRef xParam1 = rPar.Get( 1 );
3157 if( !xParam1->IsObject() )
3158 return;
3159 SbxBaseRef pObj1 = (SbxBase*)xParam1->GetObject();
3160 if( !(pObj1 && pObj1->ISA(SbUnoObject)) )
3161 return;
3162 Any aAny1 = ((SbUnoObject*)(SbxBase*)pObj1)->getUnoAny();
3163 TypeClass eType1 = aAny1.getValueType().getTypeClass();
3164 if( eType1 != TypeClass_INTERFACE )
3165 return;
3166 Reference< XInterface > x1;
3167 aAny1 >>= x1;
3168 //XInterfaceRef x1 = *(XInterfaceRef*)aAny1.get();
3170 SbxVariableRef xParam2 = rPar.Get( 2 );
3171 if( !xParam2->IsObject() )
3172 return;
3173 SbxBaseRef pObj2 = (SbxBase*)xParam2->GetObject();
3174 if( !(pObj2 && pObj2->ISA(SbUnoObject)) )
3175 return;
3176 Any aAny2 = ((SbUnoObject*)(SbxBase*)pObj2)->getUnoAny();
3177 TypeClass eType2 = aAny2.getValueType().getTypeClass();
3178 if( eType2 != TypeClass_INTERFACE )
3179 return;
3180 Reference< XInterface > x2;
3181 aAny2 >>= x2;
3182 //XInterfaceRef x2 = *(XInterfaceRef*)aAny2.get();
3184 if( x1 == x2 )
3185 refVar->PutBool( TRUE );
3188 typedef std::hash_map< ::rtl::OUString, std::vector< ::rtl::OUString >, ::rtl::OUStringHash, ::std::equal_to< ::rtl::OUString > > ModuleHash;
3191 // helper wrapper function to interact with TypeProvider and
3192 // XTypeDescriptionEnumerationAccess.
3193 // if it fails for whatever reason
3194 // returned Reference<> be null e.g. .is() will be false
3196 Reference< XTypeDescriptionEnumeration >
3197 getTypeDescriptorEnumeration( const ::rtl::OUString& sSearchRoot,
3198 const Sequence< TypeClass >& types, TypeDescriptionSearchDepth depth )
3200 Reference< XTypeDescriptionEnumeration > xEnum;
3201 Reference< XTypeDescriptionEnumerationAccess> xTypeEnumAccess( getTypeProvider_Impl(), UNO_QUERY );
3202 if ( xTypeEnumAccess.is() )
3206 xEnum = xTypeEnumAccess->createTypeDescriptionEnumeration(
3207 sSearchRoot, types, depth );
3209 catch( NoSuchTypeNameException& /*nstne*/ ) {}
3210 catch( InvalidTypeNameException& /*nstne*/ ) {}
3212 return xEnum;
3215 typedef std::hash_map< ::rtl::OUString, Any, ::rtl::OUStringHash, ::std::equal_to< ::rtl::OUString > > VBAConstantsHash;
3217 VBAConstantHelper&
3218 VBAConstantHelper::instance()
3220 static VBAConstantHelper aHelper;
3221 return aHelper;
3224 void
3225 VBAConstantHelper::init()
3227 if ( !isInited )
3229 Sequence< TypeClass > types(1);
3230 types[ 0 ] = TypeClass_CONSTANTS;
3231 Reference< XTypeDescriptionEnumeration > xEnum = getTypeDescriptorEnumeration( defaultNameSpace, types, TypeDescriptionSearchDepth_INFINITE );
3233 if ( !xEnum.is() )
3234 return; //NULL;
3236 while ( xEnum->hasMoreElements() )
3238 Reference< XConstantsTypeDescription > xConstants( xEnum->nextElement(), UNO_QUERY );
3239 if ( xConstants.is() )
3241 // store constant group name
3242 ::rtl::OUString sFullName = xConstants->getName();
3243 sal_Int32 indexLastDot = sFullName.lastIndexOf('.');
3244 ::rtl::OUString sLeafName( sFullName );
3245 if ( indexLastDot > -1 )
3246 sLeafName = sFullName.copy( indexLastDot + 1);
3247 aConstCache.push_back( sLeafName ); // assume constant group names are unique
3248 Sequence< Reference< XConstantTypeDescription > > aConsts = xConstants->getConstants();
3249 Reference< XConstantTypeDescription >* pSrc = aConsts.getArray();
3250 sal_Int32 nLen = aConsts.getLength();
3251 for ( sal_Int32 index =0; index<nLen; ++pSrc, ++index )
3253 // store constant member name
3254 Reference< XConstantTypeDescription >& rXConst =
3255 *pSrc;
3256 sFullName = rXConst->getName();
3257 indexLastDot = sFullName.lastIndexOf('.');
3258 sLeafName = sFullName;
3259 if ( indexLastDot > -1 )
3260 sLeafName = sFullName.copy( indexLastDot + 1);
3261 aConstHash[ sLeafName.toAsciiLowerCase() ] = rXConst->getConstantValue();
3265 isInited = true;
3269 bool
3270 VBAConstantHelper::isVBAConstantType( const String& rName )
3272 init();
3273 bool bConstant = false;
3274 ::rtl::OUString sKey( rName );
3275 VBAConstantsVector::const_iterator it = aConstCache.begin();
3277 for( ; it != aConstCache.end(); it++ )
3279 if( sKey.equalsIgnoreAsciiCase( *it ) )
3281 bConstant = true;
3282 break;
3285 return bConstant;
3288 SbxVariable*
3289 VBAConstantHelper::getVBAConstant( const String& rName )
3291 SbxVariable* pConst = NULL;
3292 init();
3294 ::rtl::OUString sKey( rName );
3296 VBAConstantsHash::const_iterator it = aConstHash.find( sKey.toAsciiLowerCase() );
3298 if ( it != aConstHash.end() )
3300 pConst = new SbxVariable( SbxVARIANT );
3301 pConst->SetName( rName );
3302 unoToSbxValue( pConst, it->second );
3305 return pConst;
3308 // Funktion, um einen globalen Bezeichner im
3309 // UnoScope zu suchen und fuer Sbx zu wrappen
3310 SbUnoClass* findUnoClass( const String& rName )
3312 // #105550 Check if module exists
3313 SbUnoClass* pUnoClass = NULL;
3315 Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl();
3316 if( xTypeAccess->hasByHierarchicalName( rName ) )
3318 Any aRet = xTypeAccess->getByHierarchicalName( rName );
3319 Reference< XTypeDescription > xTypeDesc;
3320 aRet >>= xTypeDesc;
3322 if( xTypeDesc.is() )
3324 TypeClass eTypeClass = xTypeDesc->getTypeClass();
3325 if( eTypeClass == TypeClass_MODULE || eTypeClass == TypeClass_CONSTANTS )
3326 pUnoClass = new SbUnoClass( rName );
3329 return pUnoClass;
3332 SbxVariable* SbUnoClass::Find( const XubString& rName, SbxClassType t )
3334 (void)t;
3336 SbxVariable* pRes = SbxObject::Find( rName, SbxCLASS_VARIABLE );
3338 // Wenn nichts gefunden wird, ist das Sub-Modul noch nicht bekannt
3339 if( !pRes )
3341 // Wenn es schon eine Klasse ist, nach einen Feld fragen
3342 if( m_xClass.is() )
3344 // Ist es ein Field
3345 ::rtl::OUString aUStr( rName );
3346 Reference< XIdlField > xField = m_xClass->getField( aUStr );
3347 Reference< XIdlClass > xClass;
3348 if( xField.is() )
3352 Any aAny;
3353 aAny = xField->get( aAny );
3355 // Nach Sbx wandeln
3356 pRes = new SbxVariable( SbxVARIANT );
3357 pRes->SetName( rName );
3358 unoToSbxValue( pRes, aAny );
3360 catch( const Exception& )
3362 implHandleAnyException( ::cppu::getCaughtException() );
3366 else
3368 // Vollqualifizierten Namen erweitern
3369 String aNewName = GetName();
3370 aNewName.AppendAscii( "." );
3371 aNewName += rName;
3373 // CoreReflection holen
3374 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
3375 if( xCoreReflection.is() )
3377 // Ist es eine Konstante?
3378 Reference< XHierarchicalNameAccess > xHarryName( xCoreReflection, UNO_QUERY );
3379 if( xHarryName.is() )
3383 Any aValue = xHarryName->getByHierarchicalName( aNewName );
3384 TypeClass eType = aValue.getValueType().getTypeClass();
3386 // Interface gefunden? Dann ist es eine Klasse
3387 if( eType == TypeClass_INTERFACE )
3389 Reference< XInterface > xIface = *(Reference< XInterface >*)aValue.getValue();
3390 Reference< XIdlClass > xClass( xIface, UNO_QUERY );
3391 if( xClass.is() )
3393 pRes = new SbxVariable( SbxVARIANT );
3394 SbxObjectRef xWrapper = (SbxObject*)new SbUnoClass( aNewName, xClass );
3395 pRes->PutObject( xWrapper );
3398 else
3400 pRes = new SbxVariable( SbxVARIANT );
3401 unoToSbxValue( pRes, aValue );
3404 catch( NoSuchElementException& e1 )
3406 String aMsg = implGetExceptionMsg( e1 );
3410 // Sonst wieder als Klasse annehmen
3411 if( !pRes )
3413 SbUnoClass* pNewClass = findUnoClass( aNewName );
3414 if( pNewClass )
3416 pRes = new SbxVariable( SbxVARIANT );
3417 SbxObjectRef xWrapper = (SbxObject*)pNewClass;
3418 pRes->PutObject( xWrapper );
3422 // An UNO service?
3423 if( !pRes )
3425 SbUnoService* pUnoService = findUnoService( aNewName );
3426 if( pUnoService )
3428 pRes = new SbxVariable( SbxVARIANT );
3429 SbxObjectRef xWrapper = (SbxObject*)pUnoService;
3430 pRes->PutObject( xWrapper );
3436 if( pRes )
3438 pRes->SetName( rName );
3440 // Variable einfuegen, damit sie spaeter im Find gefunden wird
3441 QuickInsert( pRes );
3443 // Uns selbst gleich wieder als Listener rausnehmen,
3444 // die Werte sind alle konstant
3445 if( pRes->IsBroadcaster() )
3446 EndListening( pRes->GetBroadcaster(), TRUE );
3449 return pRes;
3453 SbUnoService* findUnoService( const String& rName )
3455 SbUnoService* pSbUnoService = NULL;
3457 Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl();
3458 if( xTypeAccess->hasByHierarchicalName( rName ) )
3460 Any aRet = xTypeAccess->getByHierarchicalName( rName );
3461 Reference< XTypeDescription > xTypeDesc;
3462 aRet >>= xTypeDesc;
3464 if( xTypeDesc.is() )
3466 TypeClass eTypeClass = xTypeDesc->getTypeClass();
3467 if( eTypeClass == TypeClass_SERVICE )
3469 Reference< XServiceTypeDescription2 > xServiceTypeDesc( xTypeDesc, UNO_QUERY );
3470 if( xServiceTypeDesc.is() )
3471 pSbUnoService = new SbUnoService( rName, xServiceTypeDesc );
3475 return pSbUnoService;
3478 SbxVariable* SbUnoService::Find( const String& rName, SbxClassType )
3480 SbxVariable* pRes = SbxObject::Find( rName, SbxCLASS_METHOD );
3482 if( !pRes )
3484 // Wenn es schon eine Klasse ist, nach einen Feld fragen
3485 if( m_bNeedsInit && m_xServiceTypeDesc.is() )
3487 m_bNeedsInit = false;
3489 Sequence< Reference< XServiceConstructorDescription > > aSCDSeq = m_xServiceTypeDesc->getConstructors();
3490 const Reference< XServiceConstructorDescription >* pCtorSeq = aSCDSeq.getConstArray();
3491 int nCtorCount = aSCDSeq.getLength();
3492 for( int i = 0 ; i < nCtorCount ; ++i )
3494 Reference< XServiceConstructorDescription > xCtor = pCtorSeq[i];
3496 String aName( xCtor->getName() );
3497 if( !aName.Len() )
3499 if( xCtor->isDefaultConstructor() )
3500 aName = String::CreateFromAscii( "create" );
3503 if( aName.Len() )
3505 // Create and insert SbUnoServiceCtor
3506 SbxVariableRef xSbCtorRef = new SbUnoServiceCtor( aName, xCtor );
3507 QuickInsert( (SbxVariable*)xSbCtorRef );
3508 pRes = xSbCtorRef;
3514 return pRes;
3517 void SbUnoService::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
3518 const SfxHint& rHint, const TypeId& rHintType )
3520 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
3521 if( pHint )
3523 SbxVariable* pVar = pHint->GetVar();
3524 SbxArray* pParams = pVar->GetParameters();
3525 SbUnoServiceCtor* pUnoCtor = PTR_CAST(SbUnoServiceCtor,pVar);
3526 if( pUnoCtor && pHint->GetId() == SBX_HINT_DATAWANTED )
3528 // Parameter count -1 because of Param0 == this
3529 UINT32 nParamCount = pParams ? ((UINT32)pParams->Count() - 1) : 0;
3530 Sequence<Any> args;
3531 BOOL bOutParams = FALSE;
3533 Reference< XServiceConstructorDescription > xCtor = pUnoCtor->getServiceCtorDesc();
3534 Sequence< Reference< XParameter > > aParameterSeq = xCtor->getParameters();
3535 const Reference< XParameter >* pParameterSeq = aParameterSeq.getConstArray();
3536 UINT32 nUnoParamCount = aParameterSeq.getLength();
3538 // Default: Ignore not needed parameters
3539 bool bParameterError = false;
3541 // Is the last parameter a rest parameter?
3542 bool bRestParameterMode = false;
3543 if( nUnoParamCount > 0 )
3545 Reference< XParameter > xLastParam = pParameterSeq[ nUnoParamCount - 1 ];
3546 if( xLastParam.is() )
3548 if( xLastParam->isRestParameter() )
3549 bRestParameterMode = true;
3553 // Too many parameters with context as first parameter?
3554 USHORT nSbxParameterOffset = 1;
3555 USHORT nParameterOffsetByContext = 0;
3556 Reference < XComponentContext > xFirstParamContext;
3557 if( nParamCount > nUnoParamCount )
3559 // Check if first parameter is a context and use it
3560 // then in createInstanceWithArgumentsAndContext
3561 Any aArg0 = sbxToUnoValue( pParams->Get( nSbxParameterOffset ) );
3562 if( (aArg0 >>= xFirstParamContext) && xFirstParamContext.is() )
3563 nParameterOffsetByContext = 1;
3566 UINT32 nEffectiveParamCount = nParamCount - nParameterOffsetByContext;
3567 UINT32 nAllocParamCount = nEffectiveParamCount;
3568 if( nEffectiveParamCount > nUnoParamCount )
3570 if( !bRestParameterMode )
3572 nEffectiveParamCount = nUnoParamCount;
3573 nAllocParamCount = nUnoParamCount;
3576 // Not enough parameters?
3577 else if( nUnoParamCount > nEffectiveParamCount )
3579 // RestParameterMode only helps if one (the last) parameter is missing
3580 int nDiff = nUnoParamCount - nEffectiveParamCount;
3581 if( !bRestParameterMode || nDiff > 1 )
3583 bParameterError = true;
3584 StarBASIC::Error( SbERR_NOT_OPTIONAL );
3588 if( !bParameterError )
3590 if( nAllocParamCount > 0 )
3592 args.realloc( nAllocParamCount );
3593 Any* pAnyArgs = args.getArray();
3594 for( UINT32 i = 0 ; i < nEffectiveParamCount ; i++ )
3596 USHORT iSbx = (USHORT)(i + nSbxParameterOffset + nParameterOffsetByContext);
3598 // bRestParameterMode allows nEffectiveParamCount > nUnoParamCount
3599 Reference< XParameter > xParam;
3600 if( i < nUnoParamCount )
3602 xParam = pParameterSeq[i];
3603 if( !xParam.is() )
3604 continue;
3606 Reference< XTypeDescription > xParamTypeDesc = xParam->getType();
3607 if( !xParamTypeDesc.is() )
3608 continue;
3609 com::sun::star::uno::Type aType( xParamTypeDesc->getTypeClass(), xParamTypeDesc->getName() );
3611 // sbx paramter needs offset 1
3612 pAnyArgs[i] = sbxToUnoValue( pParams->Get( iSbx ), aType );
3614 // Check for out parameter if not already done
3615 if( !bOutParams )
3617 if( xParam->isOut() )
3618 bOutParams = TRUE;
3621 else
3623 pAnyArgs[i] = sbxToUnoValue( pParams->Get( iSbx ) );
3628 // "Call" ctor using createInstanceWithArgumentsAndContext
3629 Reference < XComponentContext > xContext;
3630 if( xFirstParamContext.is() )
3632 xContext = xFirstParamContext;
3634 else
3636 Reference < XPropertySet > xProps( ::comphelper::getProcessServiceFactory(), UNO_QUERY_THROW );
3637 xContext.set( xProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "DefaultContext" )) ), UNO_QUERY_THROW );
3639 Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
3641 Any aRetAny;
3642 if( xServiceMgr.is() )
3644 String aServiceName = GetName();
3645 Reference < XInterface > xRet;
3648 xRet = xServiceMgr->createInstanceWithArgumentsAndContext( aServiceName, args, xContext );
3650 catch( const Exception& )
3652 implHandleAnyException( ::cppu::getCaughtException() );
3654 aRetAny <<= xRet;
3656 unoToSbxValue( pVar, aRetAny );
3658 // Copy back out parameters?
3659 if( bOutParams )
3661 const Any* pAnyArgs = args.getConstArray();
3663 for( UINT32 j = 0 ; j < nUnoParamCount ; j++ )
3665 Reference< XParameter > xParam = pParameterSeq[j];
3666 if( !xParam.is() )
3667 continue;
3669 if( xParam->isOut() )
3670 unoToSbxValue( (SbxVariable*)pParams->Get( (USHORT)(j+1) ), pAnyArgs[ j ] );
3675 else
3676 SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
3682 static SbUnoServiceCtor* pFirstCtor = NULL;
3684 void clearUnoServiceCtors( void )
3686 SbUnoServiceCtor* pCtor = pFirstCtor;
3687 while( pCtor )
3689 pCtor->SbxValue::Clear();
3690 pCtor = pCtor->pNext;
3694 SbUnoServiceCtor::SbUnoServiceCtor( const String& aName_, Reference< XServiceConstructorDescription > xServiceCtorDesc )
3695 : SbxMethod( aName_, SbxOBJECT )
3696 , m_xServiceCtorDesc( xServiceCtorDesc )
3700 SbUnoServiceCtor::~SbUnoServiceCtor()
3704 SbxInfo* SbUnoServiceCtor::GetInfo()
3706 SbxInfo* pRet = NULL;
3708 return pRet;
3713 //========================================================================
3714 //========================================================================
3715 //========================================================================
3717 // Implementation eines EventAttacher-bezogenen AllListeners, der
3718 // nur einzelne Events an einen allgemeinen AllListener weiterleitet
3719 class BasicAllListener_Impl : public BasicAllListenerHelper
3721 virtual void firing_impl(const AllEventObject& Event, Any* pRet);
3723 public:
3724 SbxObjectRef xSbxObj;
3725 ::rtl::OUString aPrefixName;
3727 BasicAllListener_Impl( const ::rtl::OUString& aPrefixName );
3728 ~BasicAllListener_Impl();
3730 // Methoden von XInterface
3731 //virtual BOOL queryInterface( Uik aUik, Reference< XInterface > & rOut );
3733 // Methoden von XAllListener
3734 virtual void SAL_CALL firing(const AllEventObject& Event) throw ( RuntimeException );
3735 virtual Any SAL_CALL approveFiring(const AllEventObject& Event) throw ( RuntimeException );
3737 // Methoden von XEventListener
3738 virtual void SAL_CALL disposing(const EventObject& Source) throw ( RuntimeException );
3742 //========================================================================
3743 BasicAllListener_Impl::BasicAllListener_Impl
3745 const ::rtl::OUString & aPrefixName_
3747 : aPrefixName( aPrefixName_ )
3751 //========================================================================
3752 BasicAllListener_Impl::~BasicAllListener_Impl()
3756 //========================================================================
3758 void BasicAllListener_Impl::firing_impl( const AllEventObject& Event, Any* pRet )
3760 NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
3762 if( xSbxObj.Is() )
3764 ::rtl::OUString aMethodName = aPrefixName;
3765 aMethodName = aMethodName + Event.MethodName;
3767 SbxVariable * pP = xSbxObj;
3768 while( pP->GetParent() )
3770 pP = pP->GetParent();
3771 StarBASIC * pLib = PTR_CAST(StarBASIC,pP);
3772 if( pLib )
3774 // In Basic Array anlegen
3775 SbxArrayRef xSbxArray = new SbxArray( SbxVARIANT );
3776 const Any * pArgs = Event.Arguments.getConstArray();
3777 INT32 nCount = Event.Arguments.getLength();
3778 for( INT32 i = 0; i < nCount; i++ )
3780 // Elemente wandeln
3781 SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
3782 unoToSbxValue( (SbxVariable*)xVar, pArgs[i] );
3783 xSbxArray->Put( xVar, sal::static_int_cast< USHORT >(i+1) );
3786 pLib->Call( aMethodName, xSbxArray );
3788 // Return-Wert aus dem Param-Array holen, wenn verlangt
3789 if( pRet )
3791 SbxVariable* pVar = xSbxArray->Get( 0 );
3792 if( pVar )
3794 // #95792 Avoid a second call
3795 USHORT nFlags = pVar->GetFlags();
3796 pVar->SetFlag( SBX_NO_BROADCAST );
3797 *pRet = sbxToUnoValueImpl( pVar );
3798 pVar->SetFlags( nFlags );
3801 break;
3808 // Methoden von XAllListener
3809 void BasicAllListener_Impl::firing( const AllEventObject& Event ) throw ( RuntimeException )
3811 firing_impl( Event, NULL );
3814 Any BasicAllListener_Impl::approveFiring( const AllEventObject& Event ) throw ( RuntimeException )
3816 Any aRetAny;
3817 firing_impl( Event, &aRetAny );
3818 return aRetAny;
3821 //========================================================================
3822 // Methoden von XEventListener
3823 void BasicAllListener_Impl ::disposing(const EventObject& ) throw ( RuntimeException )
3825 NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
3827 xSbxObj.Clear();
3832 //*************************************************************************
3833 // class InvocationToAllListenerMapper
3834 // helper class to map XInvocation to XAllListener (also in project eventattacher!)
3835 //*************************************************************************
3836 class InvocationToAllListenerMapper : public WeakImplHelper1< XInvocation >
3838 public:
3839 InvocationToAllListenerMapper( const Reference< XIdlClass >& ListenerType,
3840 const Reference< XAllListener >& AllListener, const Any& Helper );
3842 // XInvocation
3843 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection(void) throw( RuntimeException );
3844 virtual Any SAL_CALL invoke(const ::rtl::OUString& FunctionName, const Sequence< Any >& Params, Sequence< sal_Int16 >& OutParamIndex, Sequence< Any >& OutParam)
3845 throw( IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException );
3846 virtual void SAL_CALL setValue(const ::rtl::OUString& PropertyName, const Any& Value)
3847 throw( UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException );
3848 virtual Any SAL_CALL getValue(const ::rtl::OUString& PropertyName) throw( UnknownPropertyException, RuntimeException );
3849 virtual sal_Bool SAL_CALL hasMethod(const ::rtl::OUString& Name) throw( RuntimeException );
3850 virtual sal_Bool SAL_CALL hasProperty(const ::rtl::OUString& Name) throw( RuntimeException );
3852 private:
3853 Reference< XIdlReflection > m_xCoreReflection;
3854 Reference< XAllListener > m_xAllListener;
3855 Reference< XIdlClass > m_xListenerType;
3856 Any m_Helper;
3860 // Function to replace AllListenerAdapterService::createAllListerAdapter
3861 Reference< XInterface > createAllListenerAdapter
3863 const Reference< XInvocationAdapterFactory >& xInvocationAdapterFactory,
3864 const Reference< XIdlClass >& xListenerType,
3865 const Reference< XAllListener >& xListener,
3866 const Any& Helper
3869 Reference< XInterface > xAdapter;
3870 if( xInvocationAdapterFactory.is() && xListenerType.is() && xListener.is() )
3872 Reference< XInvocation > xInvocationToAllListenerMapper =
3873 (XInvocation*)new InvocationToAllListenerMapper( xListenerType, xListener, Helper );
3874 Type aListenerType( xListenerType->getTypeClass(), xListenerType->getName() );
3875 xAdapter = xInvocationAdapterFactory->createAdapter( xInvocationToAllListenerMapper, aListenerType );
3877 return xAdapter;
3881 //--------------------------------------------------------------------------------------------------
3882 // InvocationToAllListenerMapper
3883 InvocationToAllListenerMapper::InvocationToAllListenerMapper
3884 ( const Reference< XIdlClass >& ListenerType, const Reference< XAllListener >& AllListener, const Any& Helper )
3885 : m_xAllListener( AllListener )
3886 , m_xListenerType( ListenerType )
3887 , m_Helper( Helper )
3891 //*************************************************************************
3892 Reference< XIntrospectionAccess > SAL_CALL InvocationToAllListenerMapper::getIntrospection(void)
3893 throw( RuntimeException )
3895 return Reference< XIntrospectionAccess >();
3898 //*************************************************************************
3899 Any SAL_CALL InvocationToAllListenerMapper::invoke(const ::rtl::OUString& FunctionName, const Sequence< Any >& Params,
3900 Sequence< sal_Int16 >& OutParamIndex, Sequence< Any >& OutParam)
3901 throw( IllegalArgumentException, CannotConvertException,
3902 InvocationTargetException, RuntimeException )
3904 (void)OutParamIndex;
3905 (void)OutParam ;
3907 Any aRet;
3909 // Check if to firing or approveFiring has to be called
3910 Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( FunctionName );
3911 sal_Bool bApproveFiring = sal_False;
3912 if( !xMethod.is() )
3913 return aRet;
3914 Reference< XIdlClass > xReturnType = xMethod->getReturnType();
3915 Sequence< Reference< XIdlClass > > aExceptionSeq = xMethod->getExceptionTypes();
3916 if( ( xReturnType.is() && xReturnType->getTypeClass() != TypeClass_VOID ) ||
3917 aExceptionSeq.getLength() > 0 )
3919 bApproveFiring = sal_True;
3921 else
3923 Sequence< ParamInfo > aParamSeq = xMethod->getParameterInfos();
3924 sal_uInt32 nParamCount = aParamSeq.getLength();
3925 if( nParamCount > 1 )
3927 const ParamInfo* pInfos = aParamSeq.getConstArray();
3928 for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
3930 if( pInfos[ i ].aMode != ParamMode_IN )
3932 bApproveFiring = sal_True;
3933 break;
3939 AllEventObject aAllEvent;
3940 aAllEvent.Source = (OWeakObject*) this;
3941 aAllEvent.Helper = m_Helper;
3942 aAllEvent.ListenerType = Type(m_xListenerType->getTypeClass(), m_xListenerType->getName() );
3943 aAllEvent.MethodName = FunctionName;
3944 aAllEvent.Arguments = Params;
3945 if( bApproveFiring )
3946 aRet = m_xAllListener->approveFiring( aAllEvent );
3947 else
3948 m_xAllListener->firing( aAllEvent );
3949 return aRet;
3952 //*************************************************************************
3953 void SAL_CALL InvocationToAllListenerMapper::setValue(const ::rtl::OUString& PropertyName, const Any& Value)
3954 throw( UnknownPropertyException, CannotConvertException,
3955 InvocationTargetException, RuntimeException )
3957 (void)PropertyName;
3958 (void)Value;
3961 //*************************************************************************
3962 Any SAL_CALL InvocationToAllListenerMapper::getValue(const ::rtl::OUString& PropertyName)
3963 throw( UnknownPropertyException, RuntimeException )
3965 (void)PropertyName;
3967 return Any();
3970 //*************************************************************************
3971 sal_Bool SAL_CALL InvocationToAllListenerMapper::hasMethod(const ::rtl::OUString& Name)
3972 throw( RuntimeException )
3974 Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( Name );
3975 return xMethod.is();
3978 //*************************************************************************
3979 sal_Bool SAL_CALL InvocationToAllListenerMapper::hasProperty(const ::rtl::OUString& Name)
3980 throw( RuntimeException )
3982 Reference< XIdlField > xField = m_xListenerType->getField( Name );
3983 return xField.is();
3986 //========================================================================
3987 // Uno-Service erzeugen
3988 // 1. Parameter == Prefix-Name der Makros
3989 // 2. Parameter == voll qualifizierter Name des Listeners
3990 void SbRtl_CreateUnoListener( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
3991 //RTLFUNC(CreateUnoListener)
3993 (void)bWrite;
3995 // Wir brauchen 2 Parameter
3996 if ( rPar.Count() != 3 )
3998 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3999 return;
4002 // Klassen-Name der struct holen
4003 String aPrefixName = rPar.Get(1)->GetString();
4004 String aListenerClassName = rPar.Get(2)->GetString();
4006 // CoreReflection holen
4007 Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
4008 if( !xCoreReflection.is() )
4009 return;
4011 // AllListenerAdapterService holen
4012 Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
4013 if( !xFactory.is() )
4014 return;
4016 // Klasse suchen
4017 Reference< XIdlClass > xClass = xCoreReflection->forName( aListenerClassName );
4018 if( !xClass.is() )
4019 return;
4021 // AB, 30.11.1999 InvocationAdapterFactory holen
4022 Reference< XInvocationAdapterFactory > xInvocationAdapterFactory = Reference< XInvocationAdapterFactory >(
4023 xFactory->createInstance( rtl::OUString::createFromAscii("com.sun.star.script.InvocationAdapterFactory") ), UNO_QUERY );
4025 BasicAllListener_Impl * p;
4026 Reference< XAllListener > xAllLst = p = new BasicAllListener_Impl( aPrefixName );
4027 Any aTmp;
4028 Reference< XInterface > xLst = createAllListenerAdapter( xInvocationAdapterFactory, xClass, xAllLst, aTmp );
4029 if( !xLst.is() )
4030 return;
4032 ::rtl::OUString aClassName = xClass->getName();
4033 Type aClassType( xClass->getTypeClass(), aClassName.getStr() );
4034 aTmp = xLst->queryInterface( aClassType );
4035 if( !aTmp.hasValue() )
4036 return;
4038 SbUnoObject* pUnoObj = new SbUnoObject( aListenerClassName, aTmp );
4039 p->xSbxObj = pUnoObj;
4040 p->xSbxObj->SetParent( pBasic );
4042 // #100326 Register listener object to set Parent NULL in Dtor
4043 SbxArrayRef xBasicUnoListeners = pBasic->getUnoListeners();
4044 xBasicUnoListeners->Insert( pUnoObj, xBasicUnoListeners->Count() );
4046 // Objekt zurueckliefern
4047 SbxVariableRef refVar = rPar.Get(0);
4048 refVar->PutObject( p->xSbxObj );
4051 //========================================================================
4052 // Represents the DefaultContext property of the ProcessServiceManager
4053 // in the Basic runtime system.
4054 void RTL_Impl_GetDefaultContext( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
4056 (void)pBasic;
4057 (void)bWrite;
4059 SbxVariableRef refVar = rPar.Get(0);
4061 Reference< XMultiServiceFactory > xFactory = comphelper::getProcessServiceFactory();
4062 Reference< XPropertySet> xPSMPropertySet( xFactory, UNO_QUERY );
4063 if( xPSMPropertySet.is() )
4065 Any aContextAny = xPSMPropertySet->getPropertyValue(
4066 String( RTL_CONSTASCII_USTRINGPARAM("DefaultContext") ) );
4068 SbUnoObjectRef xUnoObj = new SbUnoObject
4069 ( String( RTL_CONSTASCII_USTRINGPARAM("DefaultContext") ),
4070 aContextAny );
4071 refVar->PutObject( (SbUnoObject*)xUnoObj );
4073 else
4075 refVar->PutObject( NULL );
4079 //========================================================================
4080 // Creates a Basic wrapper object for a strongly typed Uno value
4081 // 1. parameter: Uno type as full qualified type name, e.g. "byte[]"
4082 void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
4084 (void)pBasic;
4085 (void)bWrite;
4087 // 2 parameters needed
4088 if ( rPar.Count() != 3 )
4090 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4091 return;
4094 // Klassen-Name der struct holen
4095 String aTypeName = rPar.Get(1)->GetString();
4096 SbxVariable* pVal = rPar.Get(2);
4098 // Check the type
4099 Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl();
4100 Any aRet;
4103 aRet = xTypeAccess->getByHierarchicalName( aTypeName );
4105 catch( NoSuchElementException& e1 )
4107 String aNoSuchElementExceptionName
4108 ( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.container.NoSuchElementException" ) );
4109 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
4110 implGetExceptionMsg( e1, aNoSuchElementExceptionName ) );
4111 return;
4113 Reference< XTypeDescription > xTypeDesc;
4114 aRet >>= xTypeDesc;
4115 TypeClass eTypeClass = xTypeDesc->getTypeClass();
4116 Type aDestType( eTypeClass, aTypeName );
4119 // Preconvert value
4120 Any aVal = sbxToUnoValueImpl( pVal );
4121 Any aConvertedVal = convertAny( aVal, aDestType );
4124 // Convert
4125 Reference< XTypeConverter > xConverter = getTypeConverter_Impl();
4128 aConvertedVal = xConverter->convertTo( aVal, aDestType );
4130 catch( IllegalArgumentException& e1 )
4132 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
4133 implGetExceptionMsg( ::cppu::getCaughtException() ) );
4134 return;
4136 catch( CannotConvertException& e2 )
4138 String aCannotConvertExceptionName
4139 ( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.lang.IllegalArgumentException" ) );
4140 StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
4141 implGetExceptionMsg( e2, aCannotConvertExceptionName ) );
4142 return;
4146 SbxVariableRef refVar = rPar.Get(0);
4147 SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aConvertedVal );
4148 refVar->PutObject( xUnoAnyObject );