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