xref: /aoo42x/main/basic/source/classes/sb.cxx (revision e1f63238)
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 
27 #include <stdio.h>
28 
29 #include "sb.hxx"
30 #include <tools/rcid.h>
31 #include <tools/config.hxx>
32 #include <tools/stream.hxx>
33 #ifndef __RSC //autogen
34 #include <tools/errinf.hxx>
35 #endif
36 #include <basic/sbx.hxx>
37 #include <tools/list.hxx>
38 #include <tools/shl.hxx>
39 #include <tools/rc.hxx>
40 #include <vcl/svapp.hxx>
41 #include <comphelper/processfactory.hxx>
42 #include "sbunoobj.hxx"
43 #include "sbjsmeth.hxx"
44 #include "sbjsmod.hxx"
45 #include "sbintern.hxx"
46 #include "disas.hxx"
47 #include "runtime.hxx"
48 #include <basic/sbuno.hxx>
49 #include <basic/sbobjmod.hxx>
50 #include "stdobj.hxx"
51 #include "filefmt.hxx"
52 #include "sb.hrc"
53 #include <basrid.hxx>
54 #include <vos/mutex.hxx>
55 #include <cppuhelper/implbase1.hxx>
56 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
57 #include <com/sun/star/util/XCloseBroadcaster.hpp>
58 #include <com/sun/star/util/XCloseListener.hpp>
59 #include "errobject.hxx"
60 #include <map>
61 #include <hash_map>
62 
63 #include <com/sun/star/script/ModuleType.hpp>
64 #include <com/sun/star/script/ModuleInfo.hpp>
65 using namespace ::com::sun::star::script;
66 
67 // #pragma SW_SEGMENT_CLASS( SBASIC, SBASIC_CODE )
68 
69 SV_IMPL_VARARR(SbTextPortions,SbTextPortion)
70 
71 TYPEINIT1(StarBASIC,SbxObject)
72 
73 #define RTLNAME "@SBRTL"
74 //  i#i68894#
75 using namespace ::com::sun::star;
76 using com::sun::star::uno::Reference;
77 using com::sun::star::uno::Any;
78 using com::sun::star::uno::UNO_QUERY;
79 using com::sun::star::lang::XMultiServiceFactory;
80 
81 const static String aThisComponent( RTL_CONSTASCII_USTRINGPARAM("ThisComponent") );
82 const static String aVBAHook( RTL_CONSTASCII_USTRINGPARAM( "VBAGlobals" ) );
83 
84 // ============================================================================
85 
86 class DocBasicItem : public ::cppu::WeakImplHelper1< util::XCloseListener >
87 {
88 public:
89     explicit DocBasicItem( StarBASIC& rDocBasic );
90     virtual ~DocBasicItem();
91 
92     inline const SbxObjectRef& getClassModules() const { return mxClassModules; }
93     inline bool isDocClosed() const { return mbDocClosed; }
94 
95 	void clearDependingVarsOnDelete( StarBASIC& rDeletedBasic );
96 
97     void startListening();
98     void stopListening();
99 
100     virtual void SAL_CALL queryClosing( const lang::EventObject& rSource, sal_Bool bGetsOwnership ) throw (util::CloseVetoException, uno::RuntimeException);
101     virtual void SAL_CALL notifyClosing( const lang::EventObject& rSource ) throw (uno::RuntimeException);
102     virtual void SAL_CALL disposing( const lang::EventObject& rSource ) throw (uno::RuntimeException);
103 
104 private:
105     StarBASIC&      mrDocBasic;
106     SbxObjectRef    mxClassModules;
107     bool            mbDocClosed;
108     bool            mbDisposed;
109 };
110 
111 // ----------------------------------------------------------------------------
112 
113 DocBasicItem::DocBasicItem( StarBASIC& rDocBasic ) :
114     mrDocBasic( rDocBasic ),
115     mxClassModules( new SbxObject( String() ) ),
116     mbDocClosed( false ),
117     mbDisposed( false )
118 {
119 }
120 
121 DocBasicItem::~DocBasicItem()
122 {
123     stopListening();
124 }
125 
126 void DocBasicItem::clearDependingVarsOnDelete( StarBASIC& rDeletedBasic )
127 {
128     mrDocBasic.implClearDependingVarsOnDelete( &rDeletedBasic );
129 }
130 
131 void DocBasicItem::startListening()
132 {
133     Any aThisComp;
134     mrDocBasic.GetUNOConstant( "ThisComponent", aThisComp );
135     Reference< util::XCloseBroadcaster > xCloseBC( aThisComp, UNO_QUERY );
136     mbDisposed = !xCloseBC.is();
137     if( xCloseBC.is() )
138         try { xCloseBC->addCloseListener( this ); } catch( uno::Exception& ) {}
139 }
140 
141 void DocBasicItem::stopListening()
142 {
143     if( mbDisposed ) return;
144     mbDisposed = true;
145     Any aThisComp;
146     mrDocBasic.GetUNOConstant( "ThisComponent", aThisComp );
147     Reference< util::XCloseBroadcaster > xCloseBC( aThisComp, UNO_QUERY );
148     if( xCloseBC.is() )
149         try { xCloseBC->removeCloseListener( this ); } catch( uno::Exception& ) {}
150 }
151 
152 void SAL_CALL DocBasicItem::queryClosing( const lang::EventObject& /*rSource*/, sal_Bool /*bGetsOwnership*/ ) throw (util::CloseVetoException, uno::RuntimeException)
153 {
154 }
155 
156 void SAL_CALL DocBasicItem::notifyClosing( const lang::EventObject& /*rEvent*/ ) throw (uno::RuntimeException)
157 {
158     stopListening();
159     mbDocClosed = true;
160 }
161 
162 void SAL_CALL DocBasicItem::disposing( const lang::EventObject& /*rEvent*/ ) throw (uno::RuntimeException)
163 {
164     stopListening();
165 }
166 
167 // ----------------------------------------------------------------------------
168 
169 namespace {
170 
171 typedef ::rtl::Reference< DocBasicItem > DocBasicItemRef;
172 typedef std::map< const StarBASIC*, DocBasicItemRef > DocBasicItemMap;
173 static DocBasicItemMap GaDocBasicItems;
174 
175 const DocBasicItem* lclFindDocBasicItem( const StarBASIC* pDocBasic )
176 {
177     DocBasicItemMap::iterator it = GaDocBasicItems.find( pDocBasic );
178     return (it != GaDocBasicItems.end()) ? it->second.get() : 0;
179 }
180 
181 void lclInsertDocBasicItem( StarBASIC& rDocBasic )
182 {
183     DocBasicItemRef& rxDocBasicItem = GaDocBasicItems[ &rDocBasic ];
184     rxDocBasicItem.set( new DocBasicItem( rDocBasic ) );
185     rxDocBasicItem->startListening();
186 }
187 
188 void lclRemoveDocBasicItem( StarBASIC& rDocBasic )
189 {
190     DocBasicItemMap::iterator it = GaDocBasicItems.find( &rDocBasic );
191     if( it != GaDocBasicItems.end() )
192     {
193         it->second->stopListening();
194         GaDocBasicItems.erase( it );
195     }
196     DocBasicItemMap::iterator it_end = GaDocBasicItems.end();
197     for( it = GaDocBasicItems.begin(); it != it_end; ++it )
198         it->second->clearDependingVarsOnDelete( rDocBasic );
199 }
200 
201 StarBASIC* lclGetDocBasicForModule( SbModule* pModule )
202 {
203     StarBASIC* pRetBasic = NULL;
204     SbxObject* pCurParent = pModule;
205     while( pCurParent->GetParent() != NULL )
206     {
207         pCurParent = pCurParent->GetParent();
208         StarBASIC* pDocBasic = PTR_CAST( StarBASIC, pCurParent );
209         if( pDocBasic != NULL && pDocBasic->IsDocBasic() )
210         {
211             pRetBasic = pDocBasic;
212             break;
213         }
214     }
215     return pRetBasic;
216 }
217 
218 } // namespace
219 
220 // ============================================================================
221 
222 SbxObject* StarBASIC::getVBAGlobals( )
223 {
224 	if ( !pVBAGlobals )
225 	{
226 		Any aThisDoc;
227 		if ( GetUNOConstant("ThisComponent", aThisDoc) )
228 		{
229 			Reference< XMultiServiceFactory > xDocFac( aThisDoc, UNO_QUERY );
230                         if ( xDocFac.is() )
231 			{
232 				try
233 				{
234 					xDocFac->createInstance( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.VBAGlobals" ) ) );
235 				}
236 				catch( Exception& )
237 				{
238 					// Ignore
239 				}
240 			}
241 		}
242 		pVBAGlobals = (SbUnoObject*)Find( aVBAHook , SbxCLASS_DONTCARE );
243 	}
244 	return pVBAGlobals;
245 }
246 
247 //  i#i68894#
248 SbxVariable* StarBASIC::VBAFind( const String& rName, SbxClassType t )
249 {
250 	if( rName == aThisComponent )
251 		return NULL;
252 	// rename to init globals
253 	if ( getVBAGlobals( ) )
254 		return pVBAGlobals->Find( rName, t );
255 	return NULL;
256 
257 }
258 // Create array for conversion SFX <-> VB error code
259 struct SFX_VB_ErrorItem
260 {
261 	sal_uInt16  nErrorVB;
262 	SbError nErrorSFX;
263 };
264 
265 const SFX_VB_ErrorItem __FAR_DATA SFX_VB_ErrorTab[] =
266 {
267 	{ 1, SbERR_BASIC_EXCEPTION },  // #87844 Map exception to error code 1
268 	{ 2, SbERR_SYNTAX },
269 	{ 3, SbERR_NO_GOSUB },
270 	{ 4, SbERR_REDO_FROM_START },
271 	{ 5, SbERR_BAD_ARGUMENT },
272 	{ 6, SbERR_MATH_OVERFLOW },
273 	{ 7, SbERR_NO_MEMORY },
274 	{ 8, SbERR_ALREADY_DIM },
275 	{ 9, SbERR_OUT_OF_RANGE },
276 	{ 10, SbERR_DUPLICATE_DEF },
277 	{ 11, SbERR_ZERODIV },
278 	{ 12, SbERR_VAR_UNDEFINED },
279 	{ 13, SbERR_CONVERSION },
280 	{ 14, SbERR_BAD_PARAMETER },
281 	{ 18, SbERR_USER_ABORT },
282 	{ 20, SbERR_BAD_RESUME },
283 	{ 28, SbERR_STACK_OVERFLOW },
284 	{ 35, SbERR_PROC_UNDEFINED },
285 	{ 48, SbERR_BAD_DLL_LOAD },
286 	{ 49, SbERR_BAD_DLL_CALL },
287 	{ 51, SbERR_INTERNAL_ERROR },
288 	{ 52, SbERR_BAD_CHANNEL },
289 	{ 53, SbERR_FILE_NOT_FOUND },
290 	{ 54, SbERR_BAD_FILE_MODE },
291 	{ 55, SbERR_FILE_ALREADY_OPEN },
292 	{ 57, SbERR_IO_ERROR },
293 	{ 58, SbERR_FILE_EXISTS },
294 	{ 59, SbERR_BAD_RECORD_LENGTH },
295 	{ 61, SbERR_DISK_FULL },
296 	{ 62, SbERR_READ_PAST_EOF },
297 	{ 63, SbERR_BAD_RECORD_NUMBER },
298 	{ 67, SbERR_TOO_MANY_FILES },
299 	{ 68, SbERR_NO_DEVICE },
300 	{ 70, SbERR_ACCESS_DENIED },
301 	{ 71, SbERR_NOT_READY },
302 	{ 73, SbERR_NOT_IMPLEMENTED },
303 	{ 74, SbERR_DIFFERENT_DRIVE },
304 	{ 75, SbERR_ACCESS_ERROR },
305 	{ 76, SbERR_PATH_NOT_FOUND },
306 	{ 91, SbERR_NO_OBJECT },
307 	{ 93, SbERR_BAD_PATTERN },
308 	{ 94, SBERR_IS_NULL },
309 	{ 250, SbERR_DDE_ERROR },
310 	{ 280, SbERR_DDE_WAITINGACK },
311 	{ 281, SbERR_DDE_OUTOFCHANNELS },
312 	{ 282, SbERR_DDE_NO_RESPONSE },
313 	{ 283, SbERR_DDE_MULT_RESPONSES },
314 	{ 284, SbERR_DDE_CHANNEL_LOCKED },
315 	{ 285, SbERR_DDE_NOTPROCESSED },
316 	{ 286, SbERR_DDE_TIMEOUT },
317 	{ 287, SbERR_DDE_USER_INTERRUPT },
318 	{ 288, SbERR_DDE_BUSY },
319 	{ 289, SbERR_DDE_NO_DATA },
320 	{ 290, SbERR_DDE_WRONG_DATA_FORMAT },
321 	{ 291, SbERR_DDE_PARTNER_QUIT },
322 	{ 292, SbERR_DDE_CONV_CLOSED },
323 	{ 293, SbERR_DDE_NO_CHANNEL },
324 	{ 294, SbERR_DDE_INVALID_LINK },
325 	{ 295, SbERR_DDE_QUEUE_OVERFLOW },
326 	{ 296, SbERR_DDE_LINK_ALREADY_EST },
327 	{ 297, SbERR_DDE_LINK_INV_TOPIC },
328 	{ 298, SbERR_DDE_DLL_NOT_FOUND },
329 	{ 323, SbERR_CANNOT_LOAD },
330 	{ 341, SbERR_BAD_INDEX },
331 	{ 366, SbERR_NO_ACTIVE_OBJECT },
332 	{ 380, SbERR_BAD_PROP_VALUE },
333 	{ 382, SbERR_PROP_READONLY },
334 	{ 394, SbERR_PROP_WRITEONLY },
335 	{ 420, SbERR_INVALID_OBJECT },
336 	{ 423, SbERR_NO_METHOD },
337 	{ 424, SbERR_NEEDS_OBJECT },
338 	{ 425, SbERR_INVALID_USAGE_OBJECT },
339 	{ 430, SbERR_NO_OLE },
340 	{ 438, SbERR_BAD_METHOD },
341 	{ 440, SbERR_OLE_ERROR },
342 	{ 445, SbERR_BAD_ACTION },
343 	{ 446, SbERR_NO_NAMED_ARGS },
344 	{ 447, SbERR_BAD_LOCALE },
345 	{ 448, SbERR_NAMED_NOT_FOUND },
346 	{ 449, SbERR_NOT_OPTIONAL },
347 	{ 450, SbERR_WRONG_ARGS },
348 	{ 451, SbERR_NOT_A_COLL },
349 	{ 452, SbERR_BAD_ORDINAL },
350 	{ 453, SbERR_DLLPROC_NOT_FOUND },
351 	{ 460, SbERR_BAD_CLIPBD_FORMAT },
352 	{ 951, SbERR_UNEXPECTED },
353 	{ 952, SbERR_EXPECTED },
354 	{ 953, SbERR_SYMBOL_EXPECTED },
355 	{ 954, SbERR_VAR_EXPECTED },
356 	{ 955, SbERR_LABEL_EXPECTED },
357 	{ 956, SbERR_LVALUE_EXPECTED },
358 	{ 957, SbERR_VAR_DEFINED },
359 	{ 958, SbERR_PROC_DEFINED },
360 	{ 959, SbERR_LABEL_DEFINED },
361 	{ 960, SbERR_UNDEF_VAR },
362 	{ 961, SbERR_UNDEF_ARRAY },
363 	{ 962, SbERR_UNDEF_PROC },
364 	{ 963, SbERR_UNDEF_LABEL },
365 	{ 964, SbERR_UNDEF_TYPE },
366 	{ 965, SbERR_BAD_EXIT },
367 	{ 966, SbERR_BAD_BLOCK },
368 	{ 967, SbERR_BAD_BRACKETS },
369 	{ 968, SbERR_BAD_DECLARATION },
370 	{ 969, SbERR_BAD_PARAMETERS },
371 	{ 970, SbERR_BAD_CHAR_IN_NUMBER },
372 	{ 971, SbERR_MUST_HAVE_DIMS },
373 	{ 972, SbERR_NO_IF },
374 	{ 973, SbERR_NOT_IN_SUBR },
375 	{ 974, SbERR_NOT_IN_MAIN },
376 	{ 975, SbERR_WRONG_DIMS },
377 	{ 976, SbERR_BAD_OPTION },
378 	{ 977, SbERR_CONSTANT_REDECLARED },
379 	{ 978, SbERR_PROG_TOO_LARGE },
380 	{ 979, SbERR_NO_STRINGS_ARRAYS },
381 	{ 1000, SbERR_PROPERTY_NOT_FOUND },
382 	{ 1001, SbERR_METHOD_NOT_FOUND },
383 	{ 1002, SbERR_ARG_MISSING },
384 	{ 1003, SbERR_BAD_NUMBER_OF_ARGS },
385 	{ 1004, SbERR_METHOD_FAILED },
386 	{ 1005, SbERR_SETPROP_FAILED },
387 	{ 1006, SbERR_GETPROP_FAILED },
388 	{ 1007, SbERR_BASIC_COMPAT },
389 	{ 0xFFFF, 0xFFFFFFFFL }		// End mark
390 };
391 
392 // The StarBASIC factory is a hack. When a SbModule is created, its pointer
393 // is saved and given to the following SbProperties/SbMethods. This restores
394 // the Modul-relationshop. But it works only when a modul is loaded.
395 // Can cause troubles with separately loaded properties!
396 
397 SbxBase* SbiFactory::Create( sal_uInt16 nSbxId, sal_uInt32 nCreator )
398 {
399 	if( nCreator ==  SBXCR_SBX )
400 	{
401 		String aEmpty;
402 		switch( nSbxId )
403 		{
404 			case SBXID_BASIC:
405 				return new StarBASIC( NULL );
406 			case SBXID_BASICMOD:
407 				return new SbModule( aEmpty );
408 			case SBXID_BASICPROP:
409 				return new SbProperty( aEmpty, SbxVARIANT, NULL );
410 			case SBXID_BASICMETHOD:
411 				return new SbMethod( aEmpty, SbxVARIANT, NULL );
412 			case SBXID_JSCRIPTMOD:
413 				return new SbJScriptModule( aEmpty );
414 			case SBXID_JSCRIPTMETH:
415 				return new SbJScriptMethod( aEmpty, SbxVARIANT, NULL );
416 		}
417 	}
418 	return NULL;
419 }
420 
421 SbxObject* SbiFactory::CreateObject( const String& rClass )
422 {
423 	if( rClass.EqualsIgnoreCaseAscii( "StarBASIC" ) )
424 		return new StarBASIC( NULL );
425 	else
426 	if( rClass.EqualsIgnoreCaseAscii( "StarBASICModule" ) )
427 	{
428 		String aEmpty;
429 		return new SbModule( aEmpty );
430 	}
431 	else
432 	if( rClass.EqualsIgnoreCaseAscii( "Collection" ) )
433 	{
434 		String aCollectionName( RTL_CONSTASCII_USTRINGPARAM("Collection") );
435 		return new BasicCollection( aCollectionName );
436 	}
437 	else
438     if( rClass.EqualsIgnoreCaseAscii( "FileSystemObject" ) )
439     {
440         try
441         {
442             Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory(), UNO_SET_THROW );
443             ::rtl::OUString aServiceName( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.FileSystemObject" ) );
444             Reference< XInterface > xInterface( xFactory->createInstance( aServiceName ), UNO_SET_THROW );
445             return new SbUnoObject( aServiceName, uno::makeAny( xInterface ) );
446         }
447         catch( Exception& )
448         {}
449     }
450 
451     return NULL;
452 }
453 
454 
455 // Factory class to create OLE objects
456 class SbOLEFactory : public SbxFactory
457 {
458 public:
459 	virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 = SBXCR_SBX );
460 	virtual SbxObject* CreateObject( const String& );
461 };
462 
463 SbxBase* SbOLEFactory::Create( sal_uInt16, sal_uInt32 )
464 {
465 	// Not supported
466 	return NULL;
467 }
468 
469 SbUnoObject* createOLEObject_Impl( const String& aType );	// sbunoobj.cxx
470 
471 SbxObject* SbOLEFactory::CreateObject( const String& rClassName )
472 {
473 	SbxObject* pRet = createOLEObject_Impl( rClassName );
474 	return pRet;
475 }
476 
477 
478 //========================================================================
479 // SbFormFactory, show user forms by: dim as new <user form name>
480 
481 class SbFormFactory : public SbxFactory
482 {
483 public:
484 	virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 = SBXCR_SBX );
485 	virtual SbxObject* CreateObject( const String& );
486 };
487 
488 SbxBase* SbFormFactory::Create( sal_uInt16, sal_uInt32 )
489 {
490 	// Not supported
491 	return NULL;
492 }
493 
494 SbxObject* SbFormFactory::CreateObject( const String& rClassName )
495 {
496 	if( SbModule* pMod = pMOD )
497 	{
498 		if( SbxVariable* pVar = pMod->Find( rClassName, SbxCLASS_OBJECT ) )
499 		{
500 			if( SbUserFormModule* pFormModule = PTR_CAST( SbUserFormModule, pVar->GetObject() ) )
501 			{
502 			    bool bInitState = pFormModule->getInitState();
503 				if( bInitState )
504 				{
505 					// Not the first instantiate, reset
506 					bool bTriggerTerminateEvent = false;
507 					pFormModule->ResetApiObj( bTriggerTerminateEvent );
508 					pFormModule->setInitState( false );
509 				}
510 				else
511 				{
512 					pFormModule->Load();
513 				}
514 				return pFormModule->CreateInstance();
515 			}
516 		}
517 	}
518 	return 0;
519 }
520 
521 
522 //========================================================================
523 // SbTypeFactory
524 
525 SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj )
526 {
527 	SbxObject* pRet = new SbxObject( rTypeObj );
528 	pRet->PutObject( pRet );
529 
530 	// Copy the properties, not only the reference to them
531 	SbxArray* pProps = pRet->GetProperties();
532 	sal_uInt32 nCount = pProps->Count32();
533 	for( sal_uInt32 i = 0 ; i < nCount ; i++ )
534 	{
535 		SbxVariable* pVar = pProps->Get32( i );
536 		SbxProperty* pProp = PTR_CAST( SbxProperty, pVar );
537 		if( pProp )
538 		{
539 			SbxProperty* pNewProp = new SbxProperty( *pProp );
540 			SbxDataType eVarType = pVar->GetType();
541 			if( eVarType & SbxARRAY )
542 			{
543 				SbxBase* pParObj = pVar->GetObject();
544 				SbxDimArray* pSource = PTR_CAST(SbxDimArray,pParObj);
545 				SbxDimArray* pDest = new SbxDimArray( pVar->GetType() );
546 				sal_Int32 lb = 0;
547 				sal_Int32 ub = 0;
548 
549 				pDest->setHasFixedSize( pSource->hasFixedSize() );
550 				if ( pSource->GetDims() && pSource->hasFixedSize() )
551 				{
552 					for ( sal_Int32 j = 1 ; j <= pSource->GetDims(); ++j )
553 					{
554 						pSource->GetDim32( (sal_Int32)j, lb, ub );
555 						pDest->AddDim32( lb, ub );
556 					}
557 				}
558 				else
559 					pDest->unoAddDim( 0, -1 ); // variant array
560 
561 				sal_uInt16 nSavFlags = pVar->GetFlags();
562 				pNewProp->ResetFlag( SBX_FIXED );
563 				// need to reset the FIXED flag
564 				// when calling PutObject ( because the type will not match Object )
565 				pNewProp->PutObject( pDest );
566 				pNewProp->SetFlags( nSavFlags );
567 			}
568 			if( eVarType == SbxOBJECT )
569 			{
570 				SbxBase* pObjBase = pVar->GetObject();
571 				SbxObject* pSrcObj = PTR_CAST(SbxObject,pObjBase);
572 				SbxObject* pDestObj = NULL;
573 				if( pSrcObj != NULL )
574 					pDestObj = cloneTypeObjectImpl( *pSrcObj );
575 				pNewProp->PutObject( pDestObj );
576 			}
577 			pProps->PutDirect( pNewProp, i );
578 		}
579 	}
580 	return pRet;
581 }
582 
583 // Factory class to create user defined objects (type command)
584 class SbTypeFactory : public SbxFactory
585 {
586 public:
587 	virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 = SBXCR_SBX );
588 	virtual SbxObject* CreateObject( const String& );
589 };
590 
591 SbxBase* SbTypeFactory::Create( sal_uInt16, sal_uInt32 )
592 {
593 	// Not supported
594 	return NULL;
595 }
596 
597 SbxObject* SbTypeFactory::CreateObject( const String& rClassName )
598 {
599 	SbxObject* pRet = NULL;
600 	SbModule* pMod = pMOD;
601 	if( pMod )
602 	{
603 		const SbxObject* pObj = pMod->FindType( rClassName );
604 		if( pObj )
605 			pRet = cloneTypeObjectImpl( *pObj );
606 	}
607 	return pRet;
608 }
609 
610 SbxObject* createUserTypeImpl( const String& rClassName )
611 {
612 	SbxObject* pRetObj = pTYPEFAC->CreateObject( rClassName );
613 	return pRetObj;
614 }
615 
616 
617 TYPEINIT1(SbClassModuleObject,SbModule)
618 
619 SbClassModuleObject::SbClassModuleObject( SbModule* pClassModule )
620 	: SbModule( pClassModule->GetName() )
621 	, mpClassModule( pClassModule )
622 	, mbInitializeEventDone( false )
623 {
624 	aOUSource = pClassModule->aOUSource;
625 	aComment = pClassModule->aComment;
626 	pImage = pClassModule->pImage;
627 	pBreaks = pClassModule->pBreaks;
628 
629 	SetClassName( pClassModule->GetName() );
630 
631 	// Allow search only internally
632 	ResetFlag( SBX_GBLSEARCH );
633 
634 	// Copy the methods from original class module
635 	SbxArray* pClassMethods = pClassModule->GetMethods();
636 	sal_uInt32 nMethodCount = pClassMethods->Count32();
637 	sal_uInt32 i;
638 	for( i = 0 ; i < nMethodCount ; i++ )
639 	{
640 		SbxVariable* pVar = pClassMethods->Get32( i );
641 
642 		// Exclude SbIfaceMapperMethod to copy them in a second step
643 		SbIfaceMapperMethod* pIfaceMethod = PTR_CAST( SbIfaceMapperMethod, pVar );
644 		if( !pIfaceMethod )
645 		{
646 			SbMethod* pMethod = PTR_CAST(SbMethod, pVar );
647 			if( pMethod )
648 			{
649 				sal_uInt16 nFlags_ = pMethod->GetFlags();
650 				pMethod->SetFlag( SBX_NO_BROADCAST );
651 				SbMethod* pNewMethod = new SbMethod( *pMethod );
652 				pNewMethod->ResetFlag( SBX_NO_BROADCAST );
653 				pMethod->SetFlags( nFlags_ );
654 				pNewMethod->pMod = this;
655 				pNewMethod->SetParent( this );
656 				pMethods->PutDirect( pNewMethod, i );
657 				StartListening( pNewMethod->GetBroadcaster(), sal_True );
658 			}
659 		}
660 	}
661 
662 	// Copy SbIfaceMapperMethod in a second step to ensure that
663 	// the corresponding base methods have already been copied
664 	for( i = 0 ; i < nMethodCount ; i++ )
665 	{
666 		SbxVariable* pVar = pClassMethods->Get32( i );
667 
668 		SbIfaceMapperMethod* pIfaceMethod = PTR_CAST( SbIfaceMapperMethod, pVar );
669 		if( pIfaceMethod )
670 		{
671 			SbMethod* pImplMethod = pIfaceMethod->getImplMethod();
672 			if( !pImplMethod )
673 			{
674 				DBG_ERROR( "No ImplMethod" );
675 				continue;
676 			}
677 
678 			// Search for own copy of ImplMethod
679 			String aImplMethodName = pImplMethod->GetName();
680 			SbxVariable* p = pMethods->Find( aImplMethodName, SbxCLASS_METHOD );
681 			SbMethod* pImplMethodCopy = p ? PTR_CAST(SbMethod,p) : NULL;
682 			if( !pImplMethodCopy )
683 			{
684 				DBG_ERROR( "Found no ImplMethod copy" );
685 				continue;
686 			}
687 			SbIfaceMapperMethod* pNewIfaceMethod =
688 				new SbIfaceMapperMethod( pIfaceMethod->GetName(), pImplMethodCopy );
689 			pMethods->PutDirect( pNewIfaceMethod, i );
690 		}
691 	}
692 
693 	// Copy the properties from original class module
694 	SbxArray* pClassProps = pClassModule->GetProperties();
695 	sal_uInt32 nPropertyCount = pClassProps->Count32();
696 	for( i = 0 ; i < nPropertyCount ; i++ )
697 	{
698 		SbxVariable* pVar = pClassProps->Get32( i );
699 		SbProcedureProperty* pProcedureProp = PTR_CAST( SbProcedureProperty, pVar );
700 		if( pProcedureProp )
701 		{
702 			sal_uInt16 nFlags_ = pProcedureProp->GetFlags();
703 			pProcedureProp->SetFlag( SBX_NO_BROADCAST );
704 			SbProcedureProperty* pNewProp = new SbProcedureProperty
705 				( pProcedureProp->GetName(), pProcedureProp->GetType() );
706 				// ( pProcedureProp->GetName(), pProcedureProp->GetType(), this );
707 			pNewProp->SetFlags( nFlags_ ); // Copy flags
708 			pNewProp->ResetFlag( SBX_NO_BROADCAST ); // except the Broadcast if it was set
709 			pProcedureProp->SetFlags( nFlags_ );
710 			pProps->PutDirect( pNewProp, i );
711 			StartListening( pNewProp->GetBroadcaster(), sal_True );
712 		}
713 		else
714 		{
715 			SbxProperty* pProp = PTR_CAST( SbxProperty, pVar );
716 			if( pProp )
717 			{
718 				sal_uInt16 nFlags_ = pProp->GetFlags();
719 				pProp->SetFlag( SBX_NO_BROADCAST );
720 				SbxProperty* pNewProp = new SbxProperty( *pProp );
721 
722 				// Special handling for modules instances and collections, they need
723 				// to be instantiated, otherwise all refer to the same base object
724 				SbxDataType eVarType = pProp->GetType();
725 				if( eVarType == SbxOBJECT )
726 				{
727 					SbxBase* pObjBase = pProp->GetObject();
728 					SbxObject* pObj = PTR_CAST(SbxObject,pObjBase);
729 					if( pObj != NULL )
730 					{
731 						String aObjClass = pObj->GetClassName();
732 
733 						SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pObjBase);
734 						if( pClassModuleObj != NULL )
735 						{
736 							SbModule* pLclClassModule = pClassModuleObj->getClassModule();
737 							SbClassModuleObject* pNewObj = new SbClassModuleObject( pLclClassModule );
738 							pNewObj->SetName( pProp->GetName() );
739 							pNewObj->SetParent( pLclClassModule->pParent );
740 							pNewProp->PutObject( pNewObj );
741 						}
742 						else if( aObjClass.EqualsIgnoreCaseAscii( "Collection" ) )
743 						{
744 							String aCollectionName( RTL_CONSTASCII_USTRINGPARAM("Collection") );
745 							BasicCollection* pNewCollection = new BasicCollection( aCollectionName );
746 							pNewCollection->SetName( pProp->GetName() );
747 							pNewCollection->SetParent( pClassModule->pParent );
748 							pNewProp->PutObject( pNewCollection );
749 						}
750 					}
751 				}
752 
753 				pNewProp->ResetFlag( SBX_NO_BROADCAST );
754 				pNewProp->SetParent( this );
755 				pProps->PutDirect( pNewProp, i );
756 				pProp->SetFlags( nFlags_ );
757 			}
758 		}
759 	}
760 	SetModuleType( ModuleType::CLASS );
761 	mbVBACompat = pClassModule->mbVBACompat;
762 }
763 
764 SbClassModuleObject::~SbClassModuleObject()
765 {
766     // do not trigger termination event when document is already closed
767 	if( StarBASIC::IsRunning() )
768         if( StarBASIC* pDocBasic = lclGetDocBasicForModule( this ) )
769             if( const DocBasicItem* pDocBasicItem = lclFindDocBasicItem( pDocBasic ) )
770                 if( !pDocBasicItem->isDocClosed() )
771                     triggerTerminateEvent();
772 
773 	// Must be deleted by base class dtor because this data
774 	// is not owned by the SbClassModuleObject object
775 	pImage = NULL;
776 	pBreaks = NULL;
777 }
778 
779 void SbClassModuleObject::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
780 						   const SfxHint& rHint, const TypeId& rHintType )
781 {
782 	handleProcedureProperties( rBC, rHint );
783 }
784 
785 SbxVariable* SbClassModuleObject::Find( const XubString& rName, SbxClassType t )
786 {
787 	SbxVariable* pRes = SbxObject::Find( rName, t );
788 	if( pRes )
789 	{
790 		triggerInitializeEvent();
791 
792 		SbIfaceMapperMethod* pIfaceMapperMethod = PTR_CAST(SbIfaceMapperMethod,pRes);
793 		if( pIfaceMapperMethod )
794 		{
795 			pRes = pIfaceMapperMethod->getImplMethod();
796 			pRes->SetFlag( SBX_EXTFOUND );
797 		}
798 	}
799 	return pRes;
800 }
801 
802 void SbClassModuleObject::triggerInitializeEvent( void )
803 {
804 	static String aInitMethodName( RTL_CONSTASCII_USTRINGPARAM("Class_Initialize") );
805 
806 	if( mbInitializeEventDone )
807 		return;
808 
809 	mbInitializeEventDone = true;
810 
811 	// Search method
812 	SbxVariable* pMeth = SbxObject::Find( aInitMethodName, SbxCLASS_METHOD );
813 	if( pMeth )
814 	{
815 		SbxValues aVals;
816 		pMeth->Get( aVals );
817 	}
818 }
819 
820 void SbClassModuleObject::triggerTerminateEvent( void )
821 {
822 	static String aTermMethodName( RTL_CONSTASCII_USTRINGPARAM("Class_Terminate") );
823 
824 	if( !mbInitializeEventDone || GetSbData()->bRunInit )
825 		return;
826 
827 	// Search method
828 	SbxVariable* pMeth = SbxObject::Find( aTermMethodName, SbxCLASS_METHOD );
829 	if( pMeth )
830 	{
831 		SbxValues aVals;
832 		pMeth->Get( aVals );
833 	}
834 }
835 
836 
837 SbClassData::SbClassData( void )
838 {
839 	mxIfaces = new SbxArray();
840 }
841 
842 void SbClassData::clear( void )
843 {
844 	mxIfaces->Clear();
845 	maRequiredTypes.clear();
846 }
847 
848 SbClassFactory::SbClassFactory( void )
849 {
850 	String aDummyName;
851 	xClassModules = new SbxObject( aDummyName );
852 }
853 
854 SbClassFactory::~SbClassFactory()
855 {}
856 
857 void SbClassFactory::AddClassModule( SbModule* pClassModule )
858 {
859 	SbxObjectRef xToUseClassModules = xClassModules;
860 
861     if( StarBASIC* pDocBasic = lclGetDocBasicForModule( pClassModule ) )
862         if( const DocBasicItem* pDocBasicItem = lclFindDocBasicItem( pDocBasic ) )
863             xToUseClassModules = pDocBasicItem->getClassModules();
864 
865 	SbxObject* pParent = pClassModule->GetParent();
866 	xToUseClassModules->Insert( pClassModule );
867 	pClassModule->SetParent( pParent );
868 }
869 
870 void SbClassFactory::RemoveClassModule( SbModule* pClassModule )
871 {
872 	xClassModules->Remove( pClassModule );
873 }
874 
875 SbxBase* SbClassFactory::Create( sal_uInt16, sal_uInt32 )
876 {
877 	// Not supported
878 	return NULL;
879 }
880 
881 SbxObject* SbClassFactory::CreateObject( const String& rClassName )
882 {
883 	SbxObjectRef xToUseClassModules = xClassModules;
884 
885     if( SbModule* pMod = pMOD )
886         if( StarBASIC* pDocBasic = lclGetDocBasicForModule( pMod ) )
887             if( const DocBasicItem* pDocBasicItem = lclFindDocBasicItem( pDocBasic ) )
888                 xToUseClassModules = pDocBasicItem->getClassModules();
889 
890 	SbxVariable* pVar = xToUseClassModules->Find( rClassName, SbxCLASS_OBJECT );
891 	SbxObject* pRet = NULL;
892 	if( pVar )
893 	{
894 		SbModule* pVarMod = (SbModule*)pVar;
895 		pRet = new SbClassModuleObject( pVarMod );
896 	}
897 	return pRet;
898 }
899 
900 SbModule* SbClassFactory::FindClass( const String& rClassName )
901 {
902 	SbxVariable* pVar = xClassModules->Find( rClassName, SbxCLASS_DONTCARE );
903 	SbModule* pMod = pVar ? (SbModule*)pVar : NULL;
904 	return pMod;
905 }
906 
907 StarBASIC::StarBASIC( StarBASIC* p, sal_Bool bIsDocBasic  )
908 	: SbxObject( String( RTL_CONSTASCII_USTRINGPARAM("StarBASIC") ) ), bDocBasic( bIsDocBasic )
909 {
910 	SetParent( p );
911 	pLibInfo = NULL;
912 	bNoRtl = bBreak = sal_False;
913 	bVBAEnabled = sal_False;
914 	pModules = new SbxArray;
915 
916 	if( !GetSbData()->nInst++ )
917 	{
918 		pSBFAC = new SbiFactory;
919 		AddFactory( pSBFAC );
920 		pTYPEFAC = new SbTypeFactory;
921 		AddFactory( pTYPEFAC );
922 		pCLASSFAC = new SbClassFactory;
923 		AddFactory( pCLASSFAC );
924 		pOLEFAC = new SbOLEFactory;
925 		AddFactory( pOLEFAC );
926 		pFORMFAC = new SbFormFactory;
927 		AddFactory( pFORMFAC );
928 		pUNOFAC = new SbUnoFactory;
929 		AddFactory( pUNOFAC );
930 	}
931 	pRtl = new SbiStdObject( String( RTL_CONSTASCII_USTRINGPARAM(RTLNAME) ), this );
932     // Search via StarBasic is always global
933 	SetFlag( SBX_GBLSEARCH );
934 	pVBAGlobals = NULL;
935 	bQuit = sal_False;
936 
937 	if( bDocBasic )
938         lclInsertDocBasicItem( *this );
939 }
940 
941 // #51727 Override SetModified so that the modified state
942 // is not given to the parent
943 void StarBASIC::SetModified( sal_Bool b )
944 {
945     SbxBase::SetModified( b );
946 }
947 
948 extern void lcl_closeTraceFile();
949 
950 StarBASIC::~StarBASIC()
951 {
952 #ifdef DBG_TRACE_BASIC
953     lcl_closeTraceFile();
954 #endif
955 
956 	// Needs to be first action as it can trigger events
957 	disposeComVariablesForBasic( this );
958 
959 	if( !--GetSbData()->nInst )
960 	{
961 		RemoveFactory( pSBFAC );
962 		delete pSBFAC; pSBFAC = NULL;
963 		RemoveFactory( pUNOFAC );
964 		delete pUNOFAC; pUNOFAC = NULL;
965 		RemoveFactory( pTYPEFAC );
966 		delete pTYPEFAC; pTYPEFAC = NULL;
967 		RemoveFactory( pCLASSFAC );
968 		delete pCLASSFAC; pCLASSFAC = NULL;
969 		RemoveFactory( pOLEFAC );
970 		delete pOLEFAC; pOLEFAC = NULL;
971 		RemoveFactory( pFORMFAC );
972 		delete pFORMFAC; pFORMFAC = NULL;
973 
974 #ifdef DBG_UTIL
975 	// There is no need to clean SbiData at program end,
976 	// but we dislike MLK's at Purify
977 	// TODO: Where else???
978 	SbiGlobals** pp = (SbiGlobals**) ::GetAppData( SHL_SBC );
979 	SbiGlobals* p = *pp;
980 	if( p )
981 	{
982 		delete p;
983 		*pp = 0;
984 	}
985 #endif
986 	}
987 	else if( bDocBasic )
988 	{
989 	    SbxError eOld = SbxBase::GetError();
990 
991         lclRemoveDocBasicItem( *this );
992 
993 		SbxBase::ResetError();
994 		if( eOld != SbxERR_OK )
995 			SbxBase::SetError( eOld );
996 	}
997 
998     // #100326 Set Parent NULL in registered listeners
999     if( xUnoListeners.Is() )
1000     {
1001         sal_uInt16 uCount = xUnoListeners->Count();
1002 	    for( sal_uInt16 i = 0 ; i < uCount ; i++ )
1003 	    {
1004 		    SbxVariable* pListenerObj = xUnoListeners->Get( i );
1005             pListenerObj->SetParent( NULL );
1006         }
1007         xUnoListeners = NULL;
1008     }
1009 
1010     clearUnoMethodsForBasic( this );
1011 }
1012 
1013 // Override new() operator, so that everyone can create a new instance
1014 void* StarBASIC::operator new( size_t n )
1015 {
1016 	if( n < sizeof( StarBASIC ) )
1017 	{
1018 //		DBG_ASSERT( sal_False, "Warnung: inkompatibler BASIC-Stand!" );
1019 		n = sizeof( StarBASIC );
1020 	}
1021 	return ::operator new( n );
1022 }
1023 
1024 void StarBASIC::operator delete( void* p )
1025 {
1026 	::operator delete( p );
1027 }
1028 
1029 void StarBASIC::implClearDependingVarsOnDelete( StarBASIC* pDeletedBasic )
1030 {
1031 	if( this != pDeletedBasic )
1032 	{
1033 		for( sal_uInt16 i = 0; i < pModules->Count(); i++ )
1034 		{
1035 			SbModule* p = (SbModule*)pModules->Get( i );
1036 			p->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
1037 		}
1038 	}
1039 
1040 	for( sal_uInt16 nObj = 0; nObj < pObjs->Count(); nObj++ )
1041 	{
1042 		SbxVariable* pVar = pObjs->Get( nObj );
1043 		StarBASIC* pBasic = PTR_CAST(StarBASIC,pVar);
1044 		if( pBasic && pBasic != pDeletedBasic )
1045 			pBasic->implClearDependingVarsOnDelete( pDeletedBasic );
1046 	}
1047 }
1048 
1049 
1050 /**************************************************************************
1051 *
1052 *    Creation/Managment of modules
1053 *
1054 **************************************************************************/
1055 
1056 SbModule* StarBASIC::MakeModule( const String& rName, const String& rSrc )
1057 {
1058 	return MakeModule32( rName, rSrc );
1059 }
1060 
1061 SbModule* StarBASIC::MakeModule32( const String& rName, const ::rtl::OUString& rSrc )
1062 {
1063     ModuleInfo mInfo;
1064     mInfo.ModuleType = ModuleType::NORMAL;
1065     return MakeModule32(  rName, mInfo, rSrc );
1066 }
1067 SbModule* StarBASIC::MakeModule32( const String& rName, const ModuleInfo& mInfo, const rtl::OUString& rSrc )
1068 {
1069 
1070     OSL_TRACE("create module %s type mInfo %d", rtl::OUStringToOString( rName, RTL_TEXTENCODING_UTF8 ).getStr(), mInfo.ModuleType );
1071     SbModule* p = NULL;
1072     switch ( mInfo.ModuleType )
1073     {
1074         case ModuleType::DOCUMENT:
1075             // In theory we should be able to create Object modules
1076             // in ordinary basic ( in vba mode thought these are create
1077             // by the application/basic and not by the user )
1078             p = new SbObjModule( rName, mInfo, isVBAEnabled() );
1079             break;
1080         case ModuleType::CLASS:
1081             p = new SbModule( rName, isVBAEnabled() );
1082 			p->SetModuleType( ModuleType::CLASS );
1083 	    break;
1084         case ModuleType::FORM:
1085             p = new SbUserFormModule( rName, mInfo, isVBAEnabled() );
1086 	    break;
1087         default:
1088             p = new SbModule( rName, isVBAEnabled() );
1089 
1090     }
1091 	p->SetSource32( rSrc );
1092 	p->SetParent( this );
1093 	pModules->Insert( p, pModules->Count() );
1094 	SetModified( sal_True );
1095 	return p;
1096 }
1097 
1098 void StarBASIC::Insert( SbxVariable* pVar )
1099 {
1100 	if( pVar->IsA( TYPE(SbModule) ) )
1101 	{
1102 		pModules->Insert( pVar, pModules->Count() );
1103 		pVar->SetParent( this );
1104 		StartListening( pVar->GetBroadcaster(), sal_True );
1105 	}
1106 	else
1107 	{
1108 		sal_Bool bWasModified = IsModified();
1109 		SbxObject::Insert( pVar );
1110 		if( !bWasModified && pVar->IsSet( SBX_DONTSTORE ) )
1111 			SetModified( sal_False );
1112 	}
1113 }
1114 
1115 void StarBASIC::Remove( SbxVariable* pVar )
1116 {
1117 	if( pVar->IsA( TYPE(SbModule) ) )
1118 	{
1119         // #87540 Can be last reference!
1120         SbxVariableRef xVar = pVar;
1121 		pModules->Remove( pVar );
1122 		pVar->SetParent( 0 );
1123 		EndListening( pVar->GetBroadcaster() );
1124 	}
1125 	else
1126 		SbxObject::Remove( pVar );
1127 }
1128 
1129 sal_Bool StarBASIC::Compile( SbModule* pMod )
1130 {
1131 	return pMod ? pMod->Compile() : sal_False;
1132 }
1133 
1134 sal_Bool StarBASIC::Disassemble( SbModule* pMod, String& rText )
1135 {
1136 	rText.Erase();
1137 	if( pMod )
1138 		pMod->Disassemble( rText );
1139 	return sal_Bool( rText.Len() != 0 );
1140 }
1141 
1142 void StarBASIC::Clear()
1143 {
1144 	while( pModules->Count() )
1145 		pModules->Remove( pModules->Count() - 1 );
1146 }
1147 
1148 SbModule* StarBASIC::FindModule( const String& rName )
1149 {
1150 	for( sal_uInt16 i = 0; i < pModules->Count(); i++ )
1151 	{
1152 		SbModule* p = (SbModule*) pModules->Get( i );
1153 		if( p->GetName().EqualsIgnoreCaseAscii( rName ) )
1154 			return p;
1155 	}
1156 	return NULL;
1157 }
1158 
1159 
1160 struct ClassModuleRunInitItem
1161 {
1162 	SbModule*		m_pModule;
1163 	bool			m_bProcessing;
1164 	bool			m_bRunInitDone;
1165 	//ModuleVector	m_vModulesDependingOnThisModule;
1166 
1167 	ClassModuleRunInitItem( void )
1168 		: m_pModule( NULL )
1169 		, m_bProcessing( false )
1170 		, m_bRunInitDone( false )
1171 	{}
1172 	ClassModuleRunInitItem( SbModule* pModule )
1173 		: m_pModule( pModule )
1174 		, m_bProcessing( false )
1175 		, m_bRunInitDone( false )
1176 	{}
1177 };
1178 
1179 // Derive from has_map type instead of typedef
1180 // to allow forward declaration in sbmod.hxx
1181 class ModuleInitDependencyMap : public
1182 	std::hash_map< ::rtl::OUString, ClassModuleRunInitItem,
1183 		::rtl::OUStringHash, ::std::equal_to< ::rtl::OUString > >
1184 {};
1185 
1186 void SbModule::implProcessModuleRunInit( ModuleInitDependencyMap& rMap, ClassModuleRunInitItem& rItem )
1187 {
1188 	rItem.m_bProcessing = true;
1189 
1190 	//bool bAnyDependencies = true;
1191 	SbModule* pModule = rItem.m_pModule;
1192 	if( pModule->pClassData != NULL )
1193 	{
1194 		StringVector& rReqTypes = pModule->pClassData->maRequiredTypes;
1195 		if( rReqTypes.size() > 0 )
1196 		{
1197 			for( StringVector::iterator it = rReqTypes.begin() ; it != rReqTypes.end() ; ++it )
1198 			{
1199 				String& rStr = *it;
1200 
1201 				// Is required type a class module?
1202 				ModuleInitDependencyMap::iterator itFind = rMap.find( rStr );
1203 				if( itFind != rMap.end() )
1204 				{
1205 					ClassModuleRunInitItem& rParentItem = itFind->second;
1206 					if( rParentItem.m_bProcessing )
1207 					{
1208 						// TODO: raise error?
1209 						DBG_ERROR( "Cyclic module dependency detected" );
1210 						continue;
1211 					}
1212 
1213 					if( !rParentItem.m_bRunInitDone )
1214 						implProcessModuleRunInit( rMap, rParentItem );
1215 				}
1216 			}
1217 		}
1218 	}
1219 
1220 	pModule->RunInit();
1221 	rItem.m_bRunInitDone = true;
1222 	rItem.m_bProcessing = false;
1223 }
1224 
1225 // Run Init-Code of all modules (including inserted libraries)
1226 void StarBASIC::InitAllModules( StarBASIC* pBasicNotToInit )
1227 {
1228 	::vos::OGuard guard( Application::GetSolarMutex() );
1229 
1230     // Init own modules
1231 	for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1232 	{
1233 		SbModule* pModule = (SbModule*)pModules->Get( nMod );
1234 		if(	!pModule->IsCompiled() )
1235 			pModule->Compile();
1236 	}
1237 	// compile modules first then RunInit ( otherwise there is
1238 	// can be order dependency, e.g. classmodule A has a member
1239 	// of of type classmodule B and classmodule B hasn't been compiled yet )
1240 
1241 	// Consider required types to init in right order. Class modules
1242 	// that are required by other modules have to be initialized first.
1243 	ModuleInitDependencyMap aMIDMap;
1244 	for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1245 	{
1246 		SbModule* pModule = (SbModule*)pModules->Get( nMod );
1247 		String aModuleName = pModule->GetName();
1248 		if( pModule->isProxyModule() )
1249 			aMIDMap[aModuleName] = ClassModuleRunInitItem( pModule );
1250 	}
1251 
1252 	ModuleInitDependencyMap::iterator it;
1253 	for( it = aMIDMap.begin() ; it != aMIDMap.end(); ++it )
1254 	{
1255 		ClassModuleRunInitItem& rItem = it->second;
1256 		SbModule::implProcessModuleRunInit( aMIDMap, rItem );
1257 	}
1258 
1259 	// Call RunInit on standard modules
1260 	for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1261 	{
1262 		SbModule* pModule = (SbModule*)pModules->Get( nMod );
1263 		if( !pModule->isProxyModule() )
1264 			pModule->RunInit();
1265 	}
1266 
1267     // Check all objects if they are BASIC,
1268     // if yes initialize
1269 	for ( sal_uInt16 nObj = 0; nObj < pObjs->Count(); nObj++ )
1270 	{
1271 		SbxVariable* pVar = pObjs->Get( nObj );
1272 		StarBASIC* pBasic = PTR_CAST(StarBASIC,pVar);
1273 		if( pBasic && pBasic != pBasicNotToInit )
1274 			pBasic->InitAllModules();
1275 	}
1276 }
1277 
1278 // #88329 Put modules back to not initialised state to
1279 // force reinitialisation at next start
1280 void StarBASIC::DeInitAllModules( void )
1281 {
1282     // Deinit own modules
1283 	for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1284 	{
1285 		SbModule* pModule = (SbModule*)pModules->Get( nMod );
1286         if( pModule->pImage && !pModule->isProxyModule() && !pModule->ISA(SbObjModule) )
1287 		    pModule->pImage->bInit = false;
1288 	}
1289 
1290 	for ( sal_uInt16 nObj = 0; nObj < pObjs->Count(); nObj++ )
1291 	{
1292 		SbxVariable* pVar = pObjs->Get( nObj );
1293 		StarBASIC* pBasic = PTR_CAST(StarBASIC,pVar);
1294 		if( pBasic )
1295 			pBasic->DeInitAllModules();
1296 	}
1297 }
1298 
1299 // #43011 For TestTool, to delete global vars
1300 void StarBASIC::ClearGlobalVars( void )
1301 {
1302 	SbxArrayRef xProps( GetProperties() );
1303 	sal_uInt16 nPropCount = xProps->Count();
1304 	for ( sal_uInt16 nProp = 0 ; nProp < nPropCount ; ++nProp )
1305 	{
1306 		SbxBase* pVar = xProps->Get( nProp );
1307 		pVar->Clear();
1308 	}
1309 	SetModified( sal_True );
1310 }
1311 
1312 // This implementation at first searches within the runtime library,
1313 // then it looks for an element within one module. This moudle can be
1314 // a public var or an entrypoint. If it is not found and we look for a
1315 // method and a module with the given name is found the search continues
1316 // for entrypoint "Main".
1317 // If this fails again a conventional search over objects is performend.
1318 SbxVariable* StarBASIC::Find( const String& rName, SbxClassType t )
1319 {
1320 	static String aMainStr( RTL_CONSTASCII_USTRINGPARAM("Main") );
1321 
1322 	SbxVariable* pRes = NULL;
1323 	SbModule* pNamed = NULL;
1324 	// "Extended" search in Runtime Lib
1325 	// but only if SbiRuntime has not set the flag
1326 	if( !bNoRtl )
1327 	{
1328 		if( t == SbxCLASS_DONTCARE || t == SbxCLASS_OBJECT )
1329 		{
1330 			if( rName.EqualsIgnoreCaseAscii( RTLNAME ) )
1331 				pRes = pRtl;
1332 		}
1333 		if( !pRes )
1334 			pRes = ((SbiStdObject*) (SbxObject*) pRtl)->Find( rName, t );
1335 		if( pRes )
1336 			pRes->SetFlag( SBX_EXTFOUND );
1337 	}
1338 	// Search module
1339 	if( !pRes )
1340 	  for( sal_uInt16 i = 0; i < pModules->Count(); i++ )
1341 	{
1342 		SbModule* p = (SbModule*) pModules->Get( i );
1343 		if( p->IsVisible() )
1344 		{
1345 			// Remember modul fpr Main() call
1346 			// or is the name equal?!?
1347 			if( p->GetName().EqualsIgnoreCaseAscii( rName ) )
1348 			{
1349 				if( t == SbxCLASS_OBJECT || t == SbxCLASS_DONTCARE )
1350 				{
1351 					pRes = p; break;
1352 				}
1353 				pNamed = p;
1354 			}
1355 			// Only variables qualified by the Module Name e.g. Sheet1.foo
1356 			// should work for Documant && Class type Modules
1357 			sal_Int32 nType = p->GetModuleType();
1358 			if ( nType == ModuleType::DOCUMENT || nType == ModuleType::FORM )
1359 				continue;
1360 
1361 			// otherwise check if the element is available
1362 			// unset GBLSEARCH-Flag (due to Rekursion)
1363 			sal_uInt16 nGblFlag = p->GetFlags() & SBX_GBLSEARCH;
1364 			p->ResetFlag( SBX_GBLSEARCH );
1365 			pRes = p->Find( rName, t );
1366 			p->SetFlag( nGblFlag );
1367 			if( pRes )
1368 				break;
1369 		}
1370 	}
1371 	if( !pRes && pNamed && ( t == SbxCLASS_METHOD || t == SbxCLASS_DONTCARE ) &&
1372 		!pNamed->GetName().EqualsIgnoreCaseAscii( aMainStr ) )
1373 			pRes = pNamed->Find( aMainStr, SbxCLASS_METHOD );
1374 	if( !pRes )
1375 		pRes = SbxObject::Find( rName, t );
1376 	return pRes;
1377 }
1378 
1379 sal_Bool StarBASIC::Call( const String& rName, SbxArray* pParam )
1380 {
1381 	sal_Bool bRes = SbxObject::Call( rName, pParam );
1382 	if( !bRes )
1383 	{
1384 		SbxError eErr = SbxBase::GetError();
1385 		SbxBase::ResetError();
1386 		if( eErr != SbxERR_OK )
1387 			RTError( (SbError)eErr, 0, 0, 0 );
1388 	}
1389 	return bRes;
1390 }
1391 
1392 // Find method via name (e.g. query via BASIC IDE)
1393 SbxBase* StarBASIC::FindSBXInCurrentScope( const String& rName )
1394 {
1395 	if( !pINST )
1396 		return NULL;
1397 	if( !pINST->pRun )
1398 		return NULL;
1399 	return pINST->pRun->FindElementExtern( rName );
1400 }
1401 
1402 // Preserve old interface
1403 SbxVariable* StarBASIC::FindVarInCurrentScopy
1404 ( const String& rName, sal_uInt16& rStatus )
1405 {
1406 	rStatus = 1;              // Presumption: nothing found
1407 	SbxVariable* pVar = NULL;
1408 	SbxBase* pSbx = FindSBXInCurrentScope( rName );
1409 	if( pSbx )
1410 	{
1411 		if( !pSbx->ISA(SbxMethod) && !pSbx->ISA(SbxObject) )
1412 			pVar = PTR_CAST(SbxVariable,pSbx);
1413 	}
1414 	if( pVar )
1415 		rStatus = 0;      // We found something
1416 	return pVar;
1417 }
1418 
1419 void StarBASIC::QuitAndExitApplication()
1420 {
1421     Stop();
1422     bQuit = sal_True;
1423 }
1424 
1425 void StarBASIC::Stop()
1426 {
1427 	SbiInstance* p = pINST;
1428 	while( p )
1429 	{
1430 		p->Stop();
1431 		p = p->pNext;
1432 	}
1433 }
1434 
1435 sal_Bool StarBASIC::IsRunning()
1436 {
1437 	return sal_Bool( pINST != NULL );
1438 }
1439 
1440 /**************************************************************************
1441 *
1442 *    Object factories and others
1443 *
1444 **************************************************************************/
1445 
1446 // Activation of an object. There is no need to access active objects
1447 // with name via BASIC. If NULL is given, everything is activated.
1448 void StarBASIC::ActivateObject( const String* pName, sal_Bool bActivate )
1449 {
1450 	if( pName )
1451 	{
1452 		SbxObject* p = (SbxObject*) SbxObject::Find( *pName, SbxCLASS_OBJECT );
1453 		if( p )
1454 		{
1455 			if( bActivate )
1456 				p->SetFlag( SBX_EXTSEARCH );
1457 			else
1458 				p->ResetFlag( SBX_EXTSEARCH );
1459 		}
1460 	}
1461 	else
1462 	{
1463 		for( sal_uInt16 i = 0; i < GetObjects()->Count(); i++ )
1464 		{
1465 			SbxObject* p = (SbxObject*) GetObjects()->Get( i );
1466 			if( bActivate )
1467 				p->SetFlag( SBX_EXTSEARCH );
1468 			else
1469 				p->ResetFlag( SBX_EXTSEARCH );
1470 		}
1471 	}
1472 }
1473 
1474 /**************************************************************************
1475 *
1476 *    Debugging and error handling
1477 *
1478 **************************************************************************/
1479 
1480 SbMethod* StarBASIC::GetActiveMethod( sal_uInt16 nLevel )
1481 {
1482 	if( pINST )
1483 		return pINST->GetCaller( nLevel );
1484 	else
1485 		return NULL;
1486 }
1487 
1488 SbModule* StarBASIC::GetActiveModule()
1489 {
1490 	if( pINST && !IsCompilerError() )
1491 		return pINST->GetActiveModule();
1492 	else
1493 		return pCMOD;
1494 }
1495 
1496 sal_uInt16 StarBASIC::BreakPoint( sal_uInt16 l, sal_uInt16 c1, sal_uInt16 c2 )
1497 {
1498 	SetErrorData( 0, l, c1, c2 );
1499 	bBreak = sal_True;
1500 	if( GetSbData()->aBreakHdl.IsSet() )
1501 		return (sal_uInt16) GetSbData()->aBreakHdl.Call( this );
1502 	else
1503 		return BreakHdl();
1504 }
1505 
1506 sal_uInt16 StarBASIC::StepPoint( sal_uInt16 l, sal_uInt16 c1, sal_uInt16 c2 )
1507 {
1508 	SetErrorData( 0, l, c1, c2 );
1509 	bBreak = sal_False;
1510 	if( GetSbData()->aBreakHdl.IsSet() )
1511 		return (sal_uInt16) GetSbData()->aBreakHdl.Call( this );
1512 	else
1513 		return BreakHdl();
1514 }
1515 
1516 sal_uInt16 __EXPORT StarBASIC::BreakHdl()
1517 {
1518 	return (sal_uInt16) ( aBreakHdl.IsSet()
1519 		? aBreakHdl.Call( this ) : SbDEBUG_CONTINUE );
1520 }
1521 
1522 // Calls for error handler and break handler
1523 sal_uInt16 StarBASIC::GetLine()		{ return GetSbData()->nLine; }
1524 sal_uInt16 StarBASIC::GetCol1()		{ return GetSbData()->nCol1; }
1525 sal_uInt16 StarBASIC::GetCol2()		{ return GetSbData()->nCol2; }
1526 
1527 // Specific to error handler
1528 SbError StarBASIC::GetErrorCode()		{ return GetSbData()->nCode; }
1529 const String& StarBASIC::GetErrorText()	{ return GetSbData()->aErrMsg; }
1530 sal_Bool StarBASIC::IsCompilerError()		{ return GetSbData()->bCompiler; }
1531 void StarBASIC::SetGlobalLanguageMode( SbLanguageMode eLanguageMode )
1532 {
1533 	GetSbData()->eLanguageMode = eLanguageMode;
1534 }
1535 SbLanguageMode StarBASIC::GetGlobalLanguageMode()
1536 {
1537 	return GetSbData()->eLanguageMode;
1538 }
1539 // Local settings
1540 SbLanguageMode StarBASIC::GetLanguageMode()
1541 {
1542 	// Use global settings?
1543 	if( eLanguageMode == SB_LANG_GLOBAL )
1544 		return GetSbData()->eLanguageMode;
1545 	else
1546 		return eLanguageMode;
1547 }
1548 
1549 // AB: 29.3.96
1550 // Das Mapping zwischen alten und neuen Fehlercodes erfolgt, indem die Tabelle
1551 // SFX_VB_ErrorTab[] durchsucht wird. Dies ist zwar nicht besonders performant,
1552 // verbraucht aber viel weniger Speicher als entsprechende switch-Bloecke.
1553 // Die Umrechnung von Fehlercodes muss nicht schnell sein, daher auch keine
1554 // binaere Suche bei VB-Error -> SFX-Error.
1555 
1556 // Neue Fehler-Codes auf alte, Sbx-Kompatible zurueckmappen
1557 sal_uInt16 StarBASIC::GetVBErrorCode( SbError nError )
1558 {
1559 	sal_uInt16 nRet = 0;
1560 
1561 	if( SbiRuntime::isVBAEnabled() )
1562 	{
1563 		switch( nError )
1564 		{
1565 			case SbERR_BASIC_ARRAY_FIX:
1566 				return 10;
1567 			case SbERR_BASIC_STRING_OVERFLOW:
1568 				return 14;
1569 			case SbERR_BASIC_EXPR_TOO_COMPLEX:
1570 				return 16;
1571 			case SbERR_BASIC_OPER_NOT_PERFORM:
1572 				return 17;
1573 			case SbERR_BASIC_TOO_MANY_DLL:
1574 				return 47;
1575 			case SbERR_BASIC_LOOP_NOT_INIT:
1576 				return 92;
1577 			default:
1578 				nRet = 0;
1579 		}
1580 	}
1581 
1582 	// Suchschleife
1583 	const SFX_VB_ErrorItem* pErrItem;
1584 	sal_uInt16 nIndex = 0;
1585 	do
1586 	{
1587 		pErrItem = SFX_VB_ErrorTab + nIndex;
1588 		if( pErrItem->nErrorSFX == nError )
1589 		{
1590 			nRet = pErrItem->nErrorVB;
1591 			break;
1592 		}
1593 		nIndex++;
1594 	}
1595 	while( pErrItem->nErrorVB != 0xFFFF );		// bis End-Marke
1596 	return nRet;
1597 }
1598 
1599 SbError	StarBASIC::GetSfxFromVBError( sal_uInt16 nError )
1600 {
1601 	SbError nRet = 0L;
1602 
1603 	if( SbiRuntime::isVBAEnabled() )
1604 	{
1605 		switch( nError )
1606 		{
1607 			case 1:
1608 			case 2:
1609 			case 4:
1610 			case 8:
1611 			case 12:
1612 			case 73:
1613 				return 0L;
1614 			case 10:
1615 				return SbERR_BASIC_ARRAY_FIX;
1616 			case 14:
1617 				return SbERR_BASIC_STRING_OVERFLOW;
1618 			case 16:
1619 				return SbERR_BASIC_EXPR_TOO_COMPLEX;
1620 			case 17:
1621 				return SbERR_BASIC_OPER_NOT_PERFORM;
1622 			case 47:
1623 				return SbERR_BASIC_TOO_MANY_DLL;
1624 			case 92:
1625 				return SbERR_BASIC_LOOP_NOT_INIT;
1626 			default:
1627 				nRet = 0L;
1628 		}
1629 	}
1630 	const SFX_VB_ErrorItem* pErrItem;
1631 	sal_uInt16 nIndex = 0;
1632 	do
1633 	{
1634 		pErrItem = SFX_VB_ErrorTab + nIndex;
1635 		if( pErrItem->nErrorVB == nError )
1636 		{
1637 			nRet = pErrItem->nErrorSFX;
1638 			break;
1639 		}
1640 		else if( pErrItem->nErrorVB > nError )
1641 			break;				// kann nicht mehr gefunden werden
1642 
1643 		nIndex++;
1644 	}
1645 	while( pErrItem->nErrorVB != 0xFFFF );		// bis End-Marke
1646 	return nRet;
1647 }
1648 
1649 // Error- / Break-Daten setzen
1650 void StarBASIC::SetErrorData
1651 ( SbError nCode, sal_uInt16 nLine, sal_uInt16 nCol1, sal_uInt16 nCol2 )
1652 {
1653 	SbiGlobals& aGlobals = *GetSbData();
1654 	aGlobals.nCode = nCode;
1655 	aGlobals.nLine = nLine;
1656 	aGlobals.nCol1 = nCol1;
1657 	aGlobals.nCol2 = nCol2;
1658 }
1659 
1660 //----------------------------------------------------------------
1661 // Hilfsklasse zum Zugriff auf String SubResourcen einer Resource.
1662 // Quelle: sfx2\source\doc\docfile.cxx (TLX)
1663 struct BasicStringList_Impl : private Resource
1664 {
1665 	ResId aResId;
1666 
1667 	BasicStringList_Impl( ResId& rErrIdP,  sal_uInt16 nId)
1668 		: Resource( rErrIdP ),aResId(nId, *rErrIdP.GetResMgr() ){}
1669 	~BasicStringList_Impl() { FreeResource(); }
1670 
1671 	String GetString(){ return String( aResId ); }
1672 	sal_Bool IsErrorTextAvailable( void )
1673 		{ return IsAvailableRes(aResId.SetRT(RSC_STRING)); }
1674 };
1675 //----------------------------------------------------------------
1676 
1677 // #60175 Flag, das bei Basic-Fehlern das Anziehen der SFX-Resourcen verhindert
1678 static sal_Bool bStaticSuppressSfxResource = sal_False;
1679 
1680 void StarBASIC::StaticSuppressSfxResource( sal_Bool bSuppress )
1681 {
1682 	bStaticSuppressSfxResource = bSuppress;
1683 }
1684 
1685 // Hack for #83750, use bStaticSuppressSfxResource as setup flag
1686 sal_Bool runsInSetup( void )
1687 {
1688 	return bStaticSuppressSfxResource;
1689 }
1690 
1691 
1692 void StarBASIC::MakeErrorText( SbError nId, const String& aMsg )
1693 {
1694 	vos::OGuard aSolarGuard( Application::GetSolarMutex() );
1695 
1696 	if( bStaticSuppressSfxResource )
1697 	{
1698 		GetSbData()->aErrMsg = String( RTL_CONSTASCII_USTRINGPARAM("No resource: Error message not available") );
1699 		return;
1700 	}
1701 
1702 	sal_uInt16 nOldID = GetVBErrorCode( nId );
1703 
1704 	// Hilfsklasse instanzieren
1705 	BasResId aId( RID_BASIC_START );
1706 	BasicStringList_Impl aMyStringList( aId, sal_uInt16(nId & ERRCODE_RES_MASK) );
1707 
1708 	if( aMyStringList.IsErrorTextAvailable() )
1709 	{
1710 		// Merge Message mit Zusatztext
1711 		String aMsg1 = aMyStringList.GetString();
1712 		// Argument-Platzhalter durch %s ersetzen
1713 		String aSrgStr( RTL_CONSTASCII_USTRINGPARAM("$(ARG1)") );
1714 		sal_uInt16 nResult = aMsg1.Search( aSrgStr );
1715 
1716 		if( nResult != STRING_NOTFOUND )
1717 		{
1718 			aMsg1.Erase( nResult, aSrgStr.Len() );
1719 			aMsg1.Insert( aMsg, nResult );
1720 		}
1721 		GetSbData()->aErrMsg = aMsg1;
1722 	}
1723 	else if( nOldID != 0 )
1724 	{
1725 		String aStdMsg( RTL_CONSTASCII_USTRINGPARAM("Fehler ") );
1726 		aStdMsg += String::CreateFromInt32( nOldID);
1727 		aStdMsg += String( RTL_CONSTASCII_USTRINGPARAM(": Kein Fehlertext verfuegbar!") );
1728 		GetSbData()->aErrMsg = aStdMsg;
1729 	}
1730 	else
1731 		GetSbData()->aErrMsg = String::EmptyString();
1732 
1733 }
1734 
1735 sal_Bool StarBASIC::CError
1736 	( SbError code, const String& rMsg, sal_uInt16 l, sal_uInt16 c1, sal_uInt16 c2 )
1737 {
1738 	vos::OGuard aSolarGuard( Application::GetSolarMutex() );
1739 
1740 	// Compiler-Fehler waehrend der Laufzeit -> Programm anhalten
1741 	if( IsRunning() )
1742 	{
1743 		// #109018 Check if running Basic is affected
1744 		StarBASIC* pStartedBasic = pINST->GetBasic();
1745 		if( pStartedBasic != this )
1746 			return sal_False;
1747 
1748 		Stop();
1749 	}
1750 
1751 	// Flag setzen, damit GlobalRunInit den Fehler mitbekommt
1752 	GetSbData()->bGlobalInitErr = sal_True;
1753 
1754 	// Fehlertext basteln
1755 	MakeErrorText( code, rMsg );
1756 
1757 	// Umsetzung des Codes fuer String-Transport in SFX-Error
1758 	if( rMsg.Len() )
1759 		code = (sal_uIntPtr)*new StringErrorInfo( code, String(rMsg) );
1760 
1761 	SetErrorData( code, l, c1, c2 );
1762 	GetSbData()->bCompiler = sal_True;
1763 	sal_Bool bRet;
1764 	if( GetSbData()->aErrHdl.IsSet() )
1765 		bRet = (sal_Bool) GetSbData()->aErrHdl.Call( this );
1766 	else
1767 		bRet = ErrorHdl();
1768 	GetSbData()->bCompiler = sal_False;		// nur sal_True fuer Error-Handler
1769 	return bRet;
1770 }
1771 
1772 sal_Bool StarBASIC::RTError
1773 	( SbError code, sal_uInt16 l, sal_uInt16 c1, sal_uInt16 c2 )
1774 {
1775 	return RTError( code, String(), l, c1, c2 );
1776 }
1777 
1778 sal_Bool StarBASIC::RTError( SbError code, const String& rMsg, sal_uInt16 l, sal_uInt16 c1, sal_uInt16 c2 )
1779 {
1780 	vos::OGuard aSolarGuard( Application::GetSolarMutex() );
1781 
1782 	SbError c = code;
1783 	if( (c & ERRCODE_CLASS_MASK) == ERRCODE_CLASS_COMPILER )
1784 		c = 0;
1785 	MakeErrorText( c, rMsg );
1786 
1787 	// Umsetzung des Codes fuer String-Transport in SFX-Error
1788 	if( rMsg.Len() )
1789 	{
1790 		// very confusing, even though MakeErrorText sets up the error text
1791 		// seems that this is not used ( if rMsg already has content )
1792 		// In the case of VBA MakeErrorText also formats the error to be alittle more
1793 		// like vba ( adds an error number etc )
1794 		if ( SbiRuntime::isVBAEnabled() && ( code == SbERR_BASIC_COMPAT ) )
1795 		{
1796 			String aTmp = '\'';
1797 			aTmp += String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() );
1798 			aTmp += String( RTL_CONSTASCII_USTRINGPARAM("\'\n") );
1799 			aTmp +=  GetSbData()->aErrMsg.Len() ? GetSbData()->aErrMsg : rMsg;
1800 			code = (sal_uIntPtr)*new StringErrorInfo( code, aTmp );
1801 		}
1802 		else
1803 			code = (sal_uIntPtr)*new StringErrorInfo( code, String(rMsg) );
1804 	}
1805 
1806 	SetErrorData( code, l, c1, c2 );
1807 	if( GetSbData()->aErrHdl.IsSet() )
1808 		return (sal_Bool) GetSbData()->aErrHdl.Call( this );
1809 	else
1810 		return ErrorHdl();
1811 }
1812 
1813 void StarBASIC::Error( SbError n )
1814 {
1815 	Error( n, String() );
1816 }
1817 
1818 void StarBASIC::Error( SbError n, const String& rMsg )
1819 {
1820 	if( pINST )
1821 		pINST->Error( n, rMsg );
1822 }
1823 
1824 void StarBASIC::FatalError( SbError n )
1825 {
1826 	if( pINST )
1827 		pINST->FatalError( n );
1828 }
1829 
1830 void StarBASIC::FatalError( SbError _errCode, const String& _details )
1831 {
1832 	if( pINST )
1833 		pINST->FatalError( _errCode, _details );
1834 }
1835 
1836 SbError StarBASIC::GetErrBasic()
1837 {
1838 	if( pINST )
1839 		return pINST->GetErr();
1840 	else
1841 		return 0;
1842 }
1843 
1844 // #66536 Zusatz-Message fuer RTL-Funktion Error zugreifbar machen
1845 String StarBASIC::GetErrorMsg()
1846 {
1847 	if( pINST )
1848 		return pINST->GetErrorMsg();
1849 	else
1850 		return String();
1851 }
1852 
1853 sal_uInt16 StarBASIC::GetErl()
1854 {
1855 	if( pINST )
1856 		return pINST->GetErl();
1857 	else
1858 		return 0;
1859 }
1860 
1861 sal_Bool __EXPORT StarBASIC::ErrorHdl()
1862 {
1863 	return (sal_Bool) ( aErrorHdl.IsSet()
1864 		? aErrorHdl.Call( this ) : sal_False );
1865 }
1866 
1867 Link StarBASIC::GetGlobalErrorHdl()
1868 {
1869 	return GetSbData()->aErrHdl;
1870 }
1871 
1872 void StarBASIC::SetGlobalErrorHdl( const Link& rLink )
1873 {
1874 	GetSbData()->aErrHdl = rLink;
1875 }
1876 
1877 
1878 Link StarBASIC::GetGlobalBreakHdl()
1879 {
1880 	return GetSbData()->aBreakHdl;
1881 }
1882 
1883 void StarBASIC::SetGlobalBreakHdl( const Link& rLink )
1884 {
1885 	GetSbData()->aBreakHdl = rLink;
1886 }
1887 
1888 SbxArrayRef StarBASIC::getUnoListeners( void )
1889 {
1890     if( !xUnoListeners.Is() )
1891         xUnoListeners = new SbxArray();
1892     return xUnoListeners;
1893 }
1894 
1895 
1896 /**************************************************************************
1897 *
1898 *	Laden und Speichern
1899 *
1900 **************************************************************************/
1901 
1902 sal_Bool StarBASIC::LoadData( SvStream& r, sal_uInt16 nVer )
1903 {
1904 	if( !SbxObject::LoadData( r, nVer ) )
1905 		return sal_False;
1906 
1907     // #95459 Delete dialogs, otherwise endless recursion
1908     // in SbxVarable::GetType() if dialogs are accessed
1909     sal_uInt16 nObjCount = pObjs->Count();
1910     SbxVariable** ppDeleteTab = new SbxVariable*[ nObjCount ];
1911 	sal_uInt16 nObj;
1912 
1913 	for( nObj = 0 ; nObj < nObjCount ; nObj++ )
1914 	{
1915 		SbxVariable* pVar = pObjs->Get( nObj );
1916 		StarBASIC* pBasic = PTR_CAST( StarBASIC, pVar );
1917         ppDeleteTab[nObj] = pBasic ? NULL : pVar;
1918 	}
1919 	for( nObj = 0 ; nObj < nObjCount ; nObj++ )
1920 	{
1921         SbxVariable* pVar = ppDeleteTab[nObj];
1922         if( pVar )
1923             pObjs->Remove( pVar );
1924     }
1925     delete[] ppDeleteTab;
1926 
1927 	sal_uInt16 nMod;
1928 	pModules->Clear();
1929 	r >> nMod;
1930 	for( sal_uInt16 i = 0; i < nMod; i++ )
1931 	{
1932 		SbModule* pMod = (SbModule*) SbxBase::Load( r );
1933 		if( !pMod )
1934 			return sal_False;
1935 		else if( pMod->ISA(SbJScriptModule) )
1936 		{
1937 			// Ref zuweisen, damit pMod deleted wird
1938 			SbModuleRef xRef = pMod;
1939 		}
1940 		else
1941 		{
1942 			pMod->SetParent( this );
1943 			pModules->Put( pMod, i );
1944 		}
1945 	}
1946 	// HACK fuer SFX-Mist!
1947 	SbxVariable* p = Find( String( RTL_CONSTASCII_USTRINGPARAM("FALSE") ), SbxCLASS_PROPERTY );
1948 	if( p )
1949 		Remove( p );
1950 	p = Find( String( RTL_CONSTASCII_USTRINGPARAM("TRUE") ), SbxCLASS_PROPERTY );
1951 	if( p )
1952 		Remove( p );
1953 	// Ende des Hacks!
1954 	// Suche ueber StarBASIC ist immer global
1955 	DBG_ASSERT( IsSet( SBX_GBLSEARCH ), "Basic ohne GBLSEARCH geladen" );
1956 	SetFlag( SBX_GBLSEARCH );
1957 	return sal_True;
1958 }
1959 
1960 sal_Bool StarBASIC::StoreData( SvStream& r ) const
1961 {
1962 	if( !SbxObject::StoreData( r ) )
1963 		return sal_False;
1964 	r << (sal_uInt16) pModules->Count();
1965 	for( sal_uInt16 i = 0; i < pModules->Count(); i++ )
1966 	{
1967 		SbModule* p = (SbModule*) pModules->Get( i );
1968 		if( !p->Store( r ) )
1969 			return sal_False;
1970 	}
1971 	return sal_True;
1972 }
1973 
1974 sal_Bool StarBASIC::LoadOldModules( SvStream& )
1975 {
1976 	return sal_False;
1977 }
1978 
1979 bool StarBASIC::GetUNOConstant( const sal_Char* _pAsciiName, ::com::sun::star::uno::Any& aOut )
1980 {
1981     bool bRes = false;
1982     ::rtl::OUString sVarName( ::rtl::OUString::createFromAscii( _pAsciiName ) );
1983     SbUnoObject* pGlobs = dynamic_cast<SbUnoObject*>( Find( sVarName, SbxCLASS_DONTCARE ) );
1984     if ( pGlobs )
1985     {
1986         aOut = pGlobs->getUnoAny();
1987         bRes = true;
1988     }
1989     return bRes;
1990 }
1991 
1992 Reference< frame::XModel > StarBASIC::GetModelFromBasic( SbxObject* pBasic )
1993 {
1994     OSL_PRECOND( pBasic != NULL, "getModelFromBasic: illegal call!" );
1995     if ( !pBasic )
1996         return NULL;
1997 
1998     // look for the ThisComponent variable, first in the parent (which
1999     // might be the document's Basic), then in the parent's parent (which might be
2000     // the application Basic)
2001     const ::rtl::OUString sThisComponent( RTL_CONSTASCII_USTRINGPARAM( "ThisComponent" ) );
2002     SbxVariable* pThisComponent = NULL;
2003 
2004     SbxObject* pLookup = pBasic->GetParent();
2005     while ( pLookup && !pThisComponent )
2006     {
2007         pThisComponent = pLookup->Find( sThisComponent, SbxCLASS_OBJECT );
2008         pLookup = pLookup->GetParent();
2009     }
2010     if ( !pThisComponent )
2011     {
2012         OSL_TRACE("Failed to get ThisComponent");
2013             // the application Basic, at the latest, should have this variable
2014         return NULL;
2015     }
2016 
2017     Any aThisComponentAny( sbxToUnoValue( pThisComponent ) );
2018     Reference< frame::XModel > xModel( aThisComponentAny, UNO_QUERY );
2019     if ( !xModel.is() )
2020     {
2021         // it's no XModel. Okay, ThisComponent nowadays is allowed to be a controller.
2022         Reference< frame::XController > xController( aThisComponentAny, UNO_QUERY );
2023         if ( xController.is() )
2024             xModel = xController->getModel();
2025     }
2026 
2027     if ( !xModel.is() )
2028         return NULL;
2029 
2030 #if OSL_DEBUG_LEVEL > 0
2031     OSL_TRACE("Have model ThisComponent points to url %s",
2032         ::rtl::OUStringToOString( xModel->getURL(),
2033             RTL_TEXTENCODING_ASCII_US ).pData->buffer );
2034 #endif
2035 
2036     return xModel;
2037 }
2038 
2039 
2040 //========================================================================
2041 // #118116 Implementation Collection object
2042 
2043 TYPEINIT1(BasicCollection,SbxObject)
2044 
2045 static const char pCountStr[]	= "Count";
2046 static const char pAddStr[]		= "Add";
2047 static const char pItemStr[]	= "Item";
2048 static const char pRemoveStr[]	= "Remove";
2049 static sal_uInt16 nCountHash = 0, nAddHash, nItemHash, nRemoveHash;
2050 
2051 SbxInfoRef BasicCollection::xAddInfo = NULL;
2052 SbxInfoRef BasicCollection::xItemInfo = NULL;
2053 
2054 BasicCollection::BasicCollection( const XubString& rClass )
2055 			 : SbxObject( rClass )
2056 {
2057 	if( !nCountHash )
2058 	{
2059 		nCountHash  = MakeHashCode( String::CreateFromAscii( pCountStr ) );
2060 		nAddHash    = MakeHashCode( String::CreateFromAscii( pAddStr ) );
2061 		nItemHash   = MakeHashCode( String::CreateFromAscii( pItemStr ) );
2062 		nRemoveHash = MakeHashCode( String::CreateFromAscii( pRemoveStr ) );
2063 	}
2064 	Initialize();
2065 
2066 }
2067 
2068 BasicCollection::~BasicCollection()
2069 {}
2070 
2071 void BasicCollection::Clear()
2072 {
2073 	SbxObject::Clear();
2074 	Initialize();
2075 }
2076 
2077 void BasicCollection::Initialize()
2078 {
2079 	xItemArray = new SbxArray();
2080 	SetType( SbxOBJECT );
2081 	SetFlag( SBX_FIXED );
2082 	ResetFlag( SBX_WRITE );
2083 	SbxVariable* p;
2084 	p = Make( String::CreateFromAscii( pCountStr ), SbxCLASS_PROPERTY, SbxINTEGER );
2085 	p->ResetFlag( SBX_WRITE );
2086 	p->SetFlag( SBX_DONTSTORE );
2087 	p = Make( String::CreateFromAscii( pAddStr ), SbxCLASS_METHOD, SbxEMPTY );
2088 	p->SetFlag( SBX_DONTSTORE );
2089 	p = Make( String::CreateFromAscii( pItemStr ), SbxCLASS_METHOD, SbxVARIANT );
2090 	p->SetFlag( SBX_DONTSTORE );
2091 	p = Make( String::CreateFromAscii( pRemoveStr ), SbxCLASS_METHOD, SbxEMPTY );
2092 	p->SetFlag( SBX_DONTSTORE );
2093 	if ( !xAddInfo.Is() )
2094 	{
2095 		xAddInfo = new SbxInfo;
2096 		xAddInfo->AddParam(  String( RTL_CONSTASCII_USTRINGPARAM("Item") ), SbxVARIANT, SBX_READ );
2097 		xAddInfo->AddParam(  String( RTL_CONSTASCII_USTRINGPARAM("Key") ), SbxVARIANT, SBX_READ | SBX_OPTIONAL );
2098 		xAddInfo->AddParam(  String( RTL_CONSTASCII_USTRINGPARAM("Before") ), SbxVARIANT, SBX_READ | SBX_OPTIONAL );
2099 		xAddInfo->AddParam(  String( RTL_CONSTASCII_USTRINGPARAM("After") ), SbxVARIANT, SBX_READ | SBX_OPTIONAL );
2100 	}
2101 	if ( !xItemInfo.Is() )
2102 	{
2103 		xItemInfo = new SbxInfo;
2104 		xItemInfo->AddParam(  String( RTL_CONSTASCII_USTRINGPARAM("Index") ), SbxVARIANT, SBX_READ | SBX_OPTIONAL);
2105 	}
2106 }
2107 
2108 SbxVariable* BasicCollection::Find( const XubString& rName, SbxClassType t )
2109 {
2110 	SbxVariable* pFind = SbxObject::Find( rName, t );
2111 	return pFind;
2112 }
2113 
2114 void BasicCollection::SFX_NOTIFY( SfxBroadcaster& rCst, const TypeId& rId1,
2115 								const SfxHint& rHint, const TypeId& rId2 )
2116 {
2117 	const SbxHint* p = PTR_CAST(SbxHint,&rHint);
2118 	if( p )
2119 	{
2120 		sal_uIntPtr nId = p->GetId();
2121 		sal_Bool bRead  = sal_Bool( nId == SBX_HINT_DATAWANTED );
2122 		sal_Bool bWrite = sal_Bool( nId == SBX_HINT_DATACHANGED );
2123 		sal_Bool bRequestInfo = sal_Bool( nId == SBX_HINT_INFOWANTED );
2124 		SbxVariable* pVar = p->GetVar();
2125 		SbxArray* pArg = pVar->GetParameters();
2126 		XubString aVarName( pVar->GetName() );
2127 		if( bRead || bWrite )
2128 		{
2129 			if( pVar->GetHashCode() == nCountHash
2130 				  && aVarName.EqualsIgnoreCaseAscii( pCountStr ) )
2131 				pVar->PutLong( xItemArray->Count32() );
2132 			else if( pVar->GetHashCode() == nAddHash
2133 				  && aVarName.EqualsIgnoreCaseAscii( pAddStr ) )
2134 				CollAdd( pArg );
2135 			else if( pVar->GetHashCode() == nItemHash
2136 				  && aVarName.EqualsIgnoreCaseAscii( pItemStr ) )
2137 				CollItem( pArg );
2138 			else if( pVar->GetHashCode() == nRemoveHash
2139 				  && aVarName.EqualsIgnoreCaseAscii( pRemoveStr ) )
2140 				CollRemove( pArg );
2141 			else
2142 				SbxObject::SFX_NOTIFY( rCst, rId1, rHint, rId2 );
2143 			return;
2144 		}
2145 		else if ( bRequestInfo )
2146 		{
2147 			if( pVar->GetHashCode() == nAddHash
2148 				  && aVarName.EqualsIgnoreCaseAscii( pAddStr ) )
2149 				pVar->SetInfo( xAddInfo );
2150 			else if( pVar->GetHashCode() == nItemHash
2151 				  && aVarName.EqualsIgnoreCaseAscii( pItemStr ) )
2152 				pVar->SetInfo( xItemInfo );
2153 		}
2154 	}
2155 	SbxObject::SFX_NOTIFY( rCst, rId1, rHint, rId2 );
2156 }
2157 
2158 sal_Int32 BasicCollection::implGetIndex( SbxVariable* pIndexVar )
2159 {
2160 	sal_Int32 nIndex = -1;
2161 	if( pIndexVar->GetType() == SbxSTRING )
2162 		nIndex = implGetIndexForName( pIndexVar->GetString() );
2163 	else
2164 		nIndex = pIndexVar->GetLong() - 1;
2165 	return nIndex;
2166 }
2167 
2168 sal_Int32 BasicCollection::implGetIndexForName( const String& rName )
2169 {
2170 	sal_Int32 nIndex = -1;
2171 	sal_Int32 nCount = xItemArray->Count32();
2172 	sal_Int32 nNameHash = MakeHashCode( rName );
2173 	for( sal_Int32 i = 0 ; i < nCount ; i++ )
2174 	{
2175 		SbxVariable* pVar = xItemArray->Get32( i );
2176 		if( pVar->GetHashCode() == nNameHash &&
2177 			pVar->GetName().EqualsIgnoreCaseAscii( rName ) )
2178 		{
2179 			nIndex = i;
2180 			break;
2181 		}
2182 	}
2183 	return nIndex;
2184 }
2185 
2186 void BasicCollection::CollAdd( SbxArray* pPar_ )
2187 {
2188 	sal_uInt16 nCount = pPar_->Count();
2189 	if( nCount < 2 || nCount > 5 )
2190 	{
2191 		SetError( SbxERR_WRONG_ARGS );
2192 		return;
2193 	}
2194 
2195 	SbxVariable* pItem = pPar_->Get(1);
2196 	if( pItem )
2197 	{
2198 		int nNextIndex;
2199 		if( nCount < 4 )
2200 		{
2201 			nNextIndex = xItemArray->Count();
2202 		}
2203 		else
2204 		{
2205 			SbxVariable* pBefore = pPar_->Get(3);
2206 			if( nCount == 5 )
2207 			{
2208 				if( !( pBefore->IsErr() || ( pBefore->GetType() == SbxEMPTY ) ) )
2209 				{
2210 					SetError( SbERR_BAD_ARGUMENT );
2211 					return;
2212 				}
2213 				SbxVariable* pAfter = pPar_->Get(4);
2214 				sal_Int32 nAfterIndex = implGetIndex( pAfter );
2215 				if( nAfterIndex == -1 )
2216 				{
2217 					SetError( SbERR_BAD_ARGUMENT );
2218 					return;
2219 				}
2220 				nNextIndex = nAfterIndex + 1;
2221 			}
2222 			else // if( nCount == 4 )
2223 			{
2224 				sal_Int32 nBeforeIndex = implGetIndex( pBefore );
2225 				if( nBeforeIndex == -1 )
2226 				{
2227 					SetError( SbERR_BAD_ARGUMENT );
2228 					return;
2229 				}
2230 				nNextIndex = nBeforeIndex;
2231 			}
2232 		}
2233 
2234 		SbxVariableRef pNewItem = new SbxVariable( *pItem );
2235 		if( nCount >= 3 )
2236 		{
2237 			SbxVariable* pKey = pPar_->Get(2);
2238 			if( !( pKey->IsErr() || ( pKey->GetType() == SbxEMPTY ) ) )
2239 			{
2240 				if( pKey->GetType() != SbxSTRING )
2241 				{
2242 					SetError( SbERR_BAD_ARGUMENT );
2243 					return;
2244 				}
2245 				String aKey = pKey->GetString();
2246 				if( implGetIndexForName( aKey ) != -1 )
2247 				{
2248 					SetError( SbERR_BAD_ARGUMENT );
2249 					return;
2250 				}
2251 				pNewItem->SetName( aKey );
2252 			}
2253 		}
2254 		pNewItem->SetFlag( SBX_READWRITE );
2255 		xItemArray->Insert32( pNewItem, nNextIndex );
2256 	}
2257 	else
2258 	{
2259 		SetError( SbERR_BAD_ARGUMENT );
2260 		return;
2261 	}
2262 }
2263 
2264 void BasicCollection::CollItem( SbxArray* pPar_ )
2265 {
2266 	if( pPar_->Count() != 2 )
2267 	{
2268 		SetError( SbxERR_WRONG_ARGS );
2269 		return;
2270 	}
2271 	SbxVariable* pRes = NULL;
2272 	SbxVariable* p = pPar_->Get( 1 );
2273 	sal_Int32 nIndex = implGetIndex( p );
2274 	if( nIndex >= 0 && nIndex < (sal_Int32)xItemArray->Count32() )
2275 		pRes = xItemArray->Get32( nIndex );
2276 	if( !pRes )
2277 		SetError( SbERR_BAD_ARGUMENT );
2278 	else
2279 		*(pPar_->Get(0)) = *pRes;
2280 }
2281 
2282 void BasicCollection::CollRemove( SbxArray* pPar_ )
2283 {
2284 	if( pPar_ == NULL || pPar_->Count() != 2 )
2285 	{
2286 		SetError( SbxERR_WRONG_ARGS );
2287 		return;
2288 	}
2289 
2290 	SbxVariable* p = pPar_->Get( 1 );
2291 	sal_Int32 nIndex = implGetIndex( p );
2292 	if( nIndex >= 0 && nIndex < (sal_Int32)xItemArray->Count32() )
2293 	{
2294 		xItemArray->Remove32( nIndex );
2295 
2296 		// Correct for stack if necessary
2297 		SbiInstance* pInst = pINST;
2298 		SbiRuntime* pRT = pInst ? pInst->pRun : NULL;
2299 		if( pRT )
2300 		{
2301 			SbiForStack* pStack = pRT->FindForStackItemForCollection( this );
2302 			if( pStack != NULL )
2303 			{
2304 				if( pStack->nCurCollectionIndex >= nIndex )
2305 					--pStack->nCurCollectionIndex;
2306 			}
2307 		}
2308 	}
2309 	else
2310 		SetError( SbERR_BAD_ARGUMENT );
2311 }
2312 
2313