xref: /aoo42x/main/basic/source/runtime/step2.cxx (revision 07a3d7f1)
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 "runtime.hxx"
28 #ifndef GCC
29 #endif
30 #include "iosys.hxx"
31 #include "image.hxx"
32 #include "sbintern.hxx"
33 #include "sbunoobj.hxx"
34 #include "opcodes.hxx"
35 
36 #include <com/sun/star/container/XIndexAccess.hpp>
37 #include <com/sun/star/script/XDefaultMethod.hpp>
38 #include <com/sun/star/beans/XPropertySet.hpp>
39 #include <com/sun/star/uno/Any.hxx>
40 #include <comphelper/processfactory.hxx>
41 
42 using namespace com::sun::star::uno;
43 using namespace com::sun::star::container;
44 using namespace com::sun::star::lang;
45 using namespace com::sun::star::beans;
46 using namespace com::sun::star::script;
47 
48 using com::sun::star::uno::Reference;
49 
50 SbxVariable* getVBAConstant( const String& rName );
51 
52 // Suchen eines Elements
53 // Die Bits im String-ID:
54 // 0x8000 - Argv ist belegt
55 
FindElement(SbxObject * pObj,sal_uInt32 nOp1,sal_uInt32 nOp2,SbError nNotFound,sal_Bool bLocal,sal_Bool bStatic)56 SbxVariable* SbiRuntime::FindElement
57 	( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, SbError nNotFound, sal_Bool bLocal, sal_Bool bStatic )
58 {
59 	bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
60 	if( bIsVBAInterOp )
61 	{
62 		StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
63 		if( pMSOMacroRuntimeLib != NULL )
64 			pMSOMacroRuntimeLib->ResetFlag( SBX_EXTSEARCH );
65 	}
66 
67 	SbxVariable* pElem = NULL;
68 	if( !pObj )
69 	{
70 		Error( SbERR_NO_OBJECT );
71 		pElem = new SbxVariable;
72 	}
73 	else
74 	{
75 		sal_Bool bFatalError = sal_False;
76 		SbxDataType t = (SbxDataType) nOp2;
77 		String aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
78 		// Hacky capture of Evaluate [] syntax
79 		// this should be tackled I feel at the pcode level
80 		if ( bIsVBAInterOp && aName.Search('[') == 0 )
81 		{
82 			// emulate pcode here
83 			StepARGC();
84 			// pseudo StepLOADSC
85 			String sArg = aName.Copy( 1, aName.Len() - 2 );
86 			SbxVariable* p = new SbxVariable;
87 			p->PutString( sArg );
88 			PushVar( p );
89 			//
90 			StepARGV();
91 			nOp1 = nOp1 | 0x8000; // indicate params are present
92 			aName = String::CreateFromAscii("Evaluate");
93 		}
94 		if( bLocal )
95 		{
96 			if ( bStatic )
97 			{
98 				if ( pMeth )
99 					pElem = pMeth->GetStatics()->Find( aName, SbxCLASS_DONTCARE );
100 			}
101 
102 			if ( !pElem )
103 				pElem = refLocals->Find( aName, SbxCLASS_DONTCARE );
104 		}
105 		if( !pElem )
106 		{
107 			// Die RTL brauchen wir nicht mehr zu durchsuchen!
108 			sal_Bool bSave = rBasic.bNoRtl;
109 			rBasic.bNoRtl = sal_True;
110 			pElem = pObj->Find( aName, SbxCLASS_DONTCARE );
111 
112 			// #110004, #112015: Make private really private
113 			if( bLocal && pElem )	// Local as flag for global search
114 			{
115 				if( pElem->IsSet( SBX_PRIVATE ) )
116 				{
117 					SbiInstance* pInst_ = pINST;
118 					if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
119 						pElem = NULL;	// Found but in wrong module!
120 
121 					// Interfaces: Use SBX_EXTFOUND
122 				}
123 			}
124 			rBasic.bNoRtl = bSave;
125 
126 			// Ist es ein globaler Uno-Bezeichner?
127 			if( bLocal && !pElem )
128 			{
129 				bool bSetName = true; // preserve normal behaviour
130 
131 				// i#i68894# if VBAInterOp favour searching vba globals
132 				// over searching for uno classess
133 				if ( bVBAEnabled )
134 				{
135 					// Try Find in VBA symbols space
136 					pElem = rBasic.VBAFind( aName, SbxCLASS_DONTCARE );
137 					if ( pElem )
138 						bSetName = false; // don't overwrite uno name
139 					else
140 						pElem = getVBAConstant( aName );
141 				}
142 
143 				if( !pElem )
144 				{
145 					// #72382 VORSICHT! Liefert jetzt wegen unbekannten
146 					// Modulen IMMER ein Ergebnis!
147 					SbUnoClass* pUnoClass = findUnoClass( aName );
148 					if( pUnoClass )
149 					{
150 						pElem = new SbxVariable( t );
151 						SbxValues aRes( SbxOBJECT );
152 						aRes.pObj = pUnoClass;
153 						pElem->SbxVariable::Put( aRes );
154 					}
155 				}
156 
157 				// #62939 Wenn eine Uno-Klasse gefunden wurde, muss
158 				// das Wrapper-Objekt gehalten werden, da sonst auch
159 				// die Uno-Klasse, z.B. "stardiv" immer wieder neu
160 				// aus der Registry gelesen werden muss
161 				if( pElem )
162 				{
163 					// #63774 Darf nicht mit gespeichert werden!!!
164 					pElem->SetFlag( SBX_DONTSTORE );
165 					pElem->SetFlag( SBX_NO_MODIFY);
166 
167 					// #72382 Lokal speichern, sonst werden alle implizit
168 					// deklarierten Vars automatisch global !
169 					if ( bSetName )
170 						pElem->SetName( aName );
171 					refLocals->Put( pElem, refLocals->Count() );
172 				}
173 			}
174 
175 			if( !pElem )
176 			{
177 				// Nicht da und nicht im Objekt?
178 				// Hat das Ding Parameter, nicht einrichten!
179 				if( nOp1 & 0x8000 )
180 					bFatalError = sal_True;
181 					// ALT: StarBASIC::FatalError( nNotFound );
182 
183 				// Sonst, falls keine Parameter sind, anderen Error Code verwenden
184 				if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) )
185 				{
186 					// #39108 Bei explizit und als ELEM immer ein Fatal Error
187 					bFatalError = sal_True;
188 
189 					// Falls keine Parameter sind, anderen Error Code verwenden
190 					if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED )
191 						nNotFound = SbERR_VAR_UNDEFINED;
192 				}
193 				if( bFatalError )
194 				{
195 					// #39108 Statt FatalError zu setzen, Dummy-Variable liefern
196 					if( !xDummyVar.Is() )
197 						xDummyVar = new SbxVariable( SbxVARIANT );
198 					pElem = xDummyVar;
199 
200 					// Parameter von Hand loeschen
201 					ClearArgvStack();
202 
203 					// Normalen Error setzen
204 					Error( nNotFound, aName );
205 				}
206 				else
207 				{
208 					if ( bStatic )
209 						pElem = StepSTATIC_Impl( aName, t );
210 					if ( !pElem )
211 					{
212 						// Sonst Variable neu anlegen
213 						pElem = new SbxVariable( t );
214 						if( t != SbxVARIANT )
215 							pElem->SetFlag( SBX_FIXED );
216 						pElem->SetName( aName );
217 						refLocals->Put( pElem, refLocals->Count() );
218 					}
219 				}
220 			}
221 		}
222 		// #39108 Args koennen schon geloescht sein!
223 		if( !bFatalError )
224 			SetupArgs( pElem, nOp1 );
225 		// Ein bestimmter Call-Type wurde gewuenscht, daher muessen
226 		// wir hier den Typ setzen und das Ding anfassen, um den
227 		// korrekten Returnwert zu erhalten!
228 		if( pElem->IsA( TYPE(SbxMethod) ) )
229 		{
230 			// Soll der Typ konvertiert werden?
231 			SbxDataType t2 = pElem->GetType();
232 			sal_Bool bSet = sal_False;
233 			if( !( pElem->GetFlags() & SBX_FIXED ) )
234 			{
235 				if( t != SbxVARIANT && t != t2 &&
236 					t >= SbxINTEGER && t <= SbxSTRING )
237 					pElem->SetType( t ), bSet = sal_True;
238 			}
239 			// pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen
240 			SbxVariableRef refTemp = pElem;
241 
242 			// Moegliche Reste vom letzten Aufruf der SbxMethod beseitigen
243 			// Vorher Schreiben freigeben, damit kein Error gesetzt wird.
244 			sal_uInt16 nSavFlags = pElem->GetFlags();
245 			pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST );
246 			pElem->SbxValue::Clear();
247 			pElem->SetFlags( nSavFlags );
248 
249 			// Erst nach dem Setzen anfassen, da z.B. LEFT()
250 			// den Unterschied zwischen Left$() und Left() kennen muss
251 
252 			// AB 12.8.96: Da in PopVar() die Parameter von Methoden weggehauen
253 			// werden, muessen wir hier explizit eine neue SbxMethod anlegen
254 			SbxVariable* pNew = new SbxMethod( *((SbxMethod*)pElem) ); // das ist der Call!
255 			//ALT: SbxVariable* pNew = new SbxVariable( *pElem ); // das ist der Call!
256 
257 			pElem->SetParameters(0); // sonst bleibt Ref auf sich selbst
258 			pNew->SetFlag( SBX_READWRITE );
259 
260 			// den Datentypen zuruecksetzen?
261 			if( bSet )
262 				pElem->SetType( t2 );
263 			pElem = pNew;
264 		}
265 		// Index-Access bei UnoObjekten beruecksichtigen
266 		// definitely we want this for VBA where properties are often
267 		// collections ( which need index access ), but lets only do
268 		// this if we actually have params following
269 		else if( bVBAEnabled && pElem->ISA(SbUnoProperty) && pElem->GetParameters() )
270 		{
271 			// pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen
272 			SbxVariableRef refTemp = pElem;
273 
274 			// Variable kopieren und dabei den Notify aufloesen
275 			SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) ); // das ist der Call!
276 			pElem->SetParameters( NULL ); // sonst bleibt Ref auf sich selbst
277 			pElem = pNew;
278 		}
279 	}
280 	return CheckArray( pElem );
281 }
282 
283 // Find-Funktion ueber Name fuer aktuellen Scope (z.B. Abfrage aus BASIC-IDE)
FindElementExtern(const String & rName)284 SbxBase* SbiRuntime::FindElementExtern( const String& rName )
285 {
286 	// Hinweis zu #35281#: Es darf nicht davon ausgegangen werden, dass
287 	// pMeth != null, da im RunInit noch keine gesetzt ist.
288 
289 	SbxVariable* pElem = NULL;
290 	if( !pMod || !rName.Len() )
291 		return NULL;
292 
293 	// Lokal suchen
294 	if( refLocals )
295 		pElem = refLocals->Find( rName, SbxCLASS_DONTCARE );
296 
297 	// In Statics suchen
298 	if ( !pElem && pMeth )
299 	{
300 		// Bei Statics, Name der Methode davor setzen
301 		String aMethName = pMeth->GetName();
302 		aMethName += ':';
303 		aMethName += rName;
304 		pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE);
305 	}
306 
307 	// In Parameter-Liste suchen
308 	if( !pElem && pMeth )
309 	{
310 		SbxInfo* pInfo = pMeth->GetInfo();
311 		if( pInfo && refParams )
312 		{
313         	sal_uInt16 nParamCount = refParams->Count();
314 			sal_uInt16 j = 1;
315 			const SbxParamInfo* pParam = pInfo->GetParam( j );
316 			while( pParam )
317 			{
318 				if( pParam->aName.EqualsIgnoreCaseAscii( rName ) )
319 				{
320 	                if( j >= nParamCount )
321 	                {
322                         // Parameter is missing
323     					pElem = new SbxVariable( SbxSTRING );
324                         pElem->PutString( String( RTL_CONSTASCII_USTRINGPARAM("<missing parameter>" ) ) );
325                     }
326                     else
327                     {
328     					pElem = refParams->Get( j );
329                     }
330 					break;
331 				}
332 				pParam = pInfo->GetParam( ++j );
333 			}
334 		}
335 	}
336 
337 	// Im Modul suchen
338 	if( !pElem )
339 	{
340 		// RTL nicht durchsuchen!
341 		sal_Bool bSave = rBasic.bNoRtl;
342 		rBasic.bNoRtl = sal_True;
343 		pElem = pMod->Find( rName, SbxCLASS_DONTCARE );
344 		rBasic.bNoRtl = bSave;
345 	}
346 	return pElem;
347 }
348 
349 
350 // Argumente eines Elements setzen
351 // Dabei auch die Argumente umsetzen, falls benannte Parameter
352 // verwendet wurden
353 
SetupArgs(SbxVariable * p,sal_uInt32 nOp1)354 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
355 {
356 	if( nOp1 & 0x8000 )
357 	{
358 		if( !refArgv )
359 			StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
360 		sal_Bool bHasNamed = sal_False;
361 		sal_uInt16 i;
362 		sal_uInt16 nArgCount = refArgv->Count();
363 		for( i = 1 ; i < nArgCount ; i++ )
364 		{
365 			if( refArgv->GetAlias( i ).Len() )
366 			{
367 				bHasNamed = sal_True; break;
368 			}
369 		}
370 		if( bHasNamed )
371 		{
372 			// Wir haben mindestens einen benannten Parameter!
373 			// Wir muessen also umsortieren
374 			// Gibt es Parameter-Infos?
375 			SbxInfo* pInfo = p->GetInfo();
376 			if( !pInfo )
377 			{
378 				bool bError_ = true;
379 
380 				SbUnoMethod* pUnoMethod = PTR_CAST(SbUnoMethod,p);
381 				SbUnoProperty* pUnoProperty = PTR_CAST(SbUnoProperty,p);
382 				if( pUnoMethod || pUnoProperty )
383 				{
384 					SbUnoObject* pParentUnoObj = PTR_CAST( SbUnoObject,p->GetParent() );
385 					if( pParentUnoObj )
386 					{
387 						Any aUnoAny = pParentUnoObj->getUnoAny();
388 						Reference< XInvocation > xInvocation;
389 						aUnoAny >>= xInvocation;
390 						if( xInvocation.is() )	// TODO: if( xOLEAutomation.is() )
391 						{
392 							bError_ = false;
393 
394 							sal_uInt16 nCurPar = 1;
395 							AutomationNamedArgsSbxArray* pArg =
396 								new AutomationNamedArgsSbxArray( nArgCount );
397 							::rtl::OUString* pNames = pArg->getNames().getArray();
398 							for( i = 1 ; i < nArgCount ; i++ )
399 							{
400 								SbxVariable* pVar = refArgv->Get( i );
401 								const String& rName = refArgv->GetAlias( i );
402 								if( rName.Len() )
403 									pNames[i] = rName;
404 								pArg->Put( pVar, nCurPar++ );
405 							}
406 							refArgv = pArg;
407 						}
408 					}
409 				}
410 				else if( bVBAEnabled && p->GetType() == SbxOBJECT && (!p->ISA(SbxMethod) || !p->IsBroadcaster()) )
411 				{
412 					// Check for default method with named parameters
413 					SbxBaseRef pObj = (SbxBase*)p->GetObject();
414 					if( pObj && pObj->ISA(SbUnoObject) )
415 					{
416 						SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj;
417 						Any aAny = pUnoObj->getUnoAny();
418 
419 						if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
420 						{
421 							Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
422 							Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
423 
424 							rtl::OUString sDefaultMethod;
425 							if ( xDfltMethod.is() )
426 								sDefaultMethod = xDfltMethod->getDefaultMethodName();
427 							if ( !sDefaultMethod.isEmpty() )
428 							{
429 								SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD );
430 								if( meth != NULL )
431 									pInfo = meth->GetInfo();
432 								if( pInfo )
433 									bError_ = false;
434 							}
435 						}
436 					}
437 				}
438 				if( bError_ )
439 					Error( SbERR_NO_NAMED_ARGS );
440 			}
441 			else
442 			{
443 				sal_uInt16 nCurPar = 1;
444 				SbxArray* pArg = new SbxArray;
445 				for( i = 1 ; i < nArgCount ; i++ )
446 				{
447 					SbxVariable* pVar = refArgv->Get( i );
448 					const String& rName = refArgv->GetAlias( i );
449 					if( rName.Len() )
450 					{
451 						// nCurPar wird auf den gefundenen Parameter gesetzt
452 						sal_uInt16 j = 1;
453 						const SbxParamInfo* pParam = pInfo->GetParam( j );
454 						while( pParam )
455 						{
456 							if( pParam->aName.EqualsIgnoreCaseAscii( rName ) )
457 							{
458 								nCurPar = j;
459 								break;
460 							}
461 							pParam = pInfo->GetParam( ++j );
462 						}
463 						if( !pParam )
464 						{
465 							Error( SbERR_NAMED_NOT_FOUND ); break;
466 						}
467 					}
468 					pArg->Put( pVar, nCurPar++ );
469 				}
470 				refArgv = pArg;
471 			}
472 		}
473 		// Eigene Var als Parameter 0
474 		refArgv->Put( p, 0 );
475 		p->SetParameters( refArgv );
476 		PopArgv();
477 	}
478 	else
479 		p->SetParameters( NULL );
480 }
481 
482 // Holen eines Array-Elements
483 
CheckArray(SbxVariable * pElem)484 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
485 {
486 	// Falls wir ein Array haben, wollen wir bitte das Array-Element!
487 	SbxArray* pPar;
488 	if( pElem->GetType() & SbxARRAY )
489 	{
490 		SbxBase* pElemObj = pElem->GetObject();
491 		SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
492 		pPar = pElem->GetParameters();
493 		if( pDimArray )
494 		{
495 			// Die Parameter koennen fehlen, wenn ein Array als
496 			// Argument uebergeben wird.
497 			if( pPar )
498 				pElem = pDimArray->Get( pPar );
499 		}
500 		else
501 		{
502 			SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
503 			if( pArray )
504 			{
505 				if( !pPar )
506 				{
507 					Error( SbERR_OUT_OF_RANGE );
508 					pElem = new SbxVariable;
509 				}
510 				else
511 					pElem = pArray->Get( pPar->Get( 1 )->GetInteger() );
512 			}
513 		}
514 
515 		// #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt
516 		if( pPar )
517 			pPar->Put( NULL, 0 );
518 	}
519 	// Index-Access bei UnoObjekten beruecksichtigen
520 	else if( pElem->GetType() == SbxOBJECT && (!pElem->ISA(SbxMethod) || (bVBAEnabled && !pElem->IsBroadcaster()) ) )
521     {
522         pPar = pElem->GetParameters();
523         if ( pPar )
524         {
525             // Ist es ein Uno-Objekt?
526             SbxBaseRef pObj = (SbxBase*)pElem->GetObject();
527             if( pObj )
528             {
529                 if( pObj->ISA(SbUnoObject) )
530                 {
531                     SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj;
532                     Any aAny = pUnoObj->getUnoAny();
533 
534                     if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
535                     {
536                         Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue();
537                         Reference< XIndexAccess > xIndexAccess( x, UNO_QUERY );
538                         if ( !bVBAEnabled )
539                         {
540                             // Haben wir Index-Access?
541                             if( xIndexAccess.is() )
542                             {
543                                 sal_uInt32 nParamCount = (sal_uInt32)pPar->Count() - 1;
544                                 if( nParamCount != 1 )
545                                 {
546                                     StarBASIC::Error( SbERR_BAD_ARGUMENT );
547                                     return pElem;
548                                 }
549 
550                                 // Index holen
551                                 sal_Int32 nIndex = pPar->Get( 1 )->GetLong();
552                                 Reference< XInterface > xRet;
553                                 try
554                                 {
555                                     Any aAny2 = xIndexAccess->getByIndex( nIndex );
556                                     TypeClass eType = aAny2.getValueType().getTypeClass();
557                                     if( eType == TypeClass_INTERFACE )
558                                         xRet = *(Reference< XInterface >*)aAny2.getValue();
559                                 }
560                                 catch (IndexOutOfBoundsException&)
561                                 {
562                                     // Bei Exception erstmal immer von Konvertierungs-Problem ausgehen
563                                     StarBASIC::Error( SbERR_OUT_OF_RANGE );
564                                 }
565 
566                                 // #57847 Immer neue Variable anlegen, sonst Fehler
567                                 // durch PutObject(NULL) bei ReadOnly-Properties.
568                                 pElem = new SbxVariable( SbxVARIANT );
569                                 if( xRet.is() )
570                                 {
571                                     aAny <<= xRet;
572 
573                                     // #67173 Kein Namen angeben, damit echter Klassen-Namen eintragen wird
574                                     String aName;
575                                     SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny );
576                                     pElem->PutObject( xWrapper );
577                                 }
578                                 else
579                                 {
580                                     pElem->PutObject( NULL );
581                                 }
582                             }
583                         }
584                         else
585                         {
586                             rtl::OUString sDefaultMethod;
587 
588                             Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
589 
590                             if ( xDfltMethod.is() )
591                                 sDefaultMethod = xDfltMethod->getDefaultMethodName();
592                             else if( xIndexAccess.is() )
593                                 sDefaultMethod = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "getByIndex" ) );
594 
595                             if ( !sDefaultMethod.isEmpty() )
596                             {
597                                 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD );
598                                 SbxVariableRef refTemp = meth;
599                                 if ( refTemp )
600                                 {
601                                     meth->SetParameters( pPar );
602                                     SbxVariable* pNew = new SbxMethod( *(SbxMethod*)meth );
603                                     pElem = pNew;
604                                 }
605                             }
606                         }
607                     }
608 
609                     // #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt
610                     pPar->Put( NULL, 0 );
611                 }
612                 else if( pObj->ISA(BasicCollection) )
613                 {
614                     BasicCollection* pCol = (BasicCollection*)(SbxBase*)pObj;
615                     pElem = new SbxVariable( SbxVARIANT );
616                     pPar->Put( pElem, 0 );
617                     pCol->CollItem( pPar );
618                 }
619             }
620 			else if( bVBAEnabled )	// !pObj
621             {
622 				SbxArray* pParam = pElem->GetParameters();
623 				if( pParam != NULL && !pElem->IsSet( SBX_VAR_TO_DIM ) )
624 					Error( SbERR_NO_OBJECT );
625 			}
626         }
627     }
628 
629 	return pElem;
630 }
631 
632 // Laden eines Elements aus der Runtime-Library (+StringID+Typ)
633 
StepRTL(sal_uInt32 nOp1,sal_uInt32 nOp2)634 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
635 {
636 	PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_False ) );
637 }
638 
639 void
StepFIND_Impl(SbxObject * pObj,sal_uInt32 nOp1,sal_uInt32 nOp2,SbError nNotFound,sal_Bool bLocal,sal_Bool bStatic)640 SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, SbError nNotFound, sal_Bool bLocal, sal_Bool bStatic )
641 {
642 	if( !refLocals )
643 		refLocals = new SbxArray;
644 	PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, bLocal, bStatic ) );
645 }
646 // Laden einer lokalen/globalen Variablen (+StringID+Typ)
647 
StepFIND(sal_uInt32 nOp1,sal_uInt32 nOp2)648 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
649 {
650 	StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True );
651 }
652 
653 // Search inside a class module (CM) to enable global search in time
StepFIND_CM(sal_uInt32 nOp1,sal_uInt32 nOp2)654 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
655 {
656 
657 	SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pMod);
658 	if( pClassModuleObject )
659 		pMod->SetFlag( SBX_GBLSEARCH );
660 
661 	StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True );
662 
663 	if( pClassModuleObject )
664 		pMod->ResetFlag( SBX_GBLSEARCH );
665 }
666 
StepFIND_STATIC(sal_uInt32 nOp1,sal_uInt32 nOp2)667 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
668 {
669 	StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True, sal_True );
670 }
671 
672 // Laden eines Objekt-Elements (+StringID+Typ)
673 // Das Objekt liegt auf TOS
674 
StepELEM(sal_uInt32 nOp1,sal_uInt32 nOp2)675 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
676 {
677 	// Liegt auf dem TOS ein Objekt?
678 	SbxVariableRef pObjVar = PopVar();
679 
680 	SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar);
681 	if( !pObj )
682 	{
683 		SbxBase* pObjVarObj = pObjVar->GetObject();
684 		pObj = PTR_CAST(SbxObject,pObjVarObj);
685 	}
686 
687 	// #56368 Bei StepElem Referenz sichern, sonst koennen Objekte
688 	// in Qualifizierungsketten wie ActiveComponent.Selection(0).Text
689 	// zu fueh die Referenz verlieren
690 	// #74254 Jetzt per Liste
691 	if( pObj )
692 		SaveRef( (SbxVariable*)pObj );
693 
694 	PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, sal_False ) );
695 }
696 
697 // Laden eines Parameters (+Offset+Typ)
698 // Wenn der Datentyp nicht stimmen sollte, eine Kopie anlegen
699 // Der Datentyp SbxEMPTY zeigt an, daa kein Parameter angegeben ist.
700 // Get( 0 ) darf EMPTY sein
701 
StepPARAM(sal_uInt32 nOp1,sal_uInt32 nOp2)702 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
703 {
704 	sal_uInt16 i = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
705 	SbxDataType t = (SbxDataType) nOp2;
706 	SbxVariable* p;
707 
708 	// #57915 Missing sauberer loesen
709 	sal_uInt16 nParamCount = refParams->Count();
710 	if( i >= nParamCount )
711 	{
712 		sal_Int16 iLoop = i;
713 		while( iLoop >= nParamCount )
714 		{
715 			p = new SbxVariable();
716 
717 			if( SbiRuntime::isVBAEnabled() &&
718 				(t == SbxOBJECT || t == SbxSTRING) )
719 			{
720 				if( t == SbxOBJECT )
721 					p->PutObject( NULL );
722 				else
723 					p->PutString( String() );
724 			}
725 			else
726 				p->PutErr( 448 );		// Wie in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND)
727 
728 			refParams->Put( p, iLoop );
729 			iLoop--;
730 		}
731 	}
732 	p = refParams->Get( i );
733 
734 	if( p->GetType() == SbxERROR && ( i ) )
735 	//if( p->GetType() == SbxEMPTY && ( i ) )
736 	{
737 		// Wenn ein Parameter fehlt, kann er OPTIONAL sein
738 		sal_Bool bOpt = sal_False;
739 		if( pMeth )
740 		{
741             SbxInfo* pInfo = pMeth->GetInfo();
742             if ( pInfo )
743             {
744                 const SbxParamInfo* pParam = pInfo->GetParam( i );
745                 if( pParam && ( (pParam->nFlags & SBX_OPTIONAL) != 0 ) )
746                 {
747                     // Default value?
748                     sal_uInt16 nDefaultId = sal::static_int_cast< sal_uInt16 >(
749                         pParam->nUserData & 0xffff );
750                     if( nDefaultId > 0 )
751                     {
752                         String aDefaultStr = pImg->GetString( nDefaultId );
753                         p = new SbxVariable();
754                         p->PutString( aDefaultStr );
755                         refParams->Put( p, i );
756                     }
757                     bOpt = sal_True;
758                 }
759             }
760 		}
761 		if( bOpt == sal_False )
762 			Error( SbERR_NOT_OPTIONAL );
763 	}
764 	else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t )
765 	{
766 		SbxVariable* q = new SbxVariable( t );
767 		SaveRef( q );
768 		*q = *p;
769 		p = q;
770 	}
771 	SetupArgs( p, nOp1 );
772 	PushVar( CheckArray( p ) );
773 }
774 
775 // Case-Test (+True-Target+Test-Opcode)
776 
StepCASEIS(sal_uInt32 nOp1,sal_uInt32 nOp2)777 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
778 {
779 	if( !refCaseStk || !refCaseStk->Count() )
780 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
781 	else
782 	{
783 		SbxVariableRef xComp = PopVar();
784 		SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 );
785 		if( xCase->Compare( (SbxOperator) nOp2, *xComp ) )
786 			StepJUMP( nOp1 );
787 	}
788 }
789 
790 // Aufruf einer DLL-Prozedur (+StringID+Typ)
791 // Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist
792 
StepCALL(sal_uInt32 nOp1,sal_uInt32 nOp2)793 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
794 {
795 	String aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
796 	SbxArray* pArgs = NULL;
797 	if( nOp1 & 0x8000 )
798 		pArgs = refArgv;
799 	DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, sal_False );
800 	aLibName = String();
801 	if( nOp1 & 0x8000 )
802 		PopArgv();
803 }
804 
805 // Aufruf einer DLL-Prozedur nach CDecl (+StringID+Typ)
806 // Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist
807 
StepCALLC(sal_uInt32 nOp1,sal_uInt32 nOp2)808 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
809 {
810 	String aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
811 	SbxArray* pArgs = NULL;
812 	if( nOp1 & 0x8000 )
813 		pArgs = refArgv;
814 	DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, sal_True );
815 	aLibName = String();
816 	if( nOp1 & 0x8000 )
817 		PopArgv();
818 }
819 
820 
821 // Beginn eines Statements (+Line+Col)
822 
StepSTMNT(sal_uInt32 nOp1,sal_uInt32 nOp2)823 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
824 {
825 	// Wenn der Expr-Stack am Anfang einen Statements eine Variable enthaelt,
826 	// hat ein Trottel X als Funktion aufgerufen, obwohl es eine Variable ist!
827 	sal_Bool bFatalExpr = sal_False;
828     String sUnknownMethodName;
829 	if( nExprLvl > 1 )
830 		bFatalExpr = sal_True;
831 	else if( nExprLvl )
832 	{
833 		SbxVariable* p = refExprStk->Get( 0 );
834 		if( p->GetRefCount() > 1
835 		 && refLocals.Is() && refLocals->Find( p->GetName(), p->GetClass() ) )
836         {
837             sUnknownMethodName = p->GetName();
838 			bFatalExpr = sal_True;
839         }
840 	}
841 	// Der Expr-Stack ist nun nicht mehr notwendig
842 	ClearExprStack();
843 
844 	// #56368 Kuenstliche Referenz fuer StepElem wieder freigeben,
845 	// damit sie nicht ueber ein Statement hinaus erhalten bleibt
846 	//refSaveObj = NULL;
847 	// #74254 Jetzt per Liste
848 	ClearRefs();
849 
850 	// Wir muessen hier hart abbrechen, da sonst Zeile und Spalte nicht mehr
851 	// stimmen!
852 	if( bFatalExpr)
853 	{
854 		StarBASIC::FatalError( SbERR_NO_METHOD, sUnknownMethodName );
855 		return;
856 	}
857 	pStmnt = pCode - 9;
858 	sal_uInt16 nOld = nLine;
859 	nLine = static_cast<short>( nOp1 );
860 
861 	// #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern
862 	nCol1 = static_cast<short>( nOp2 & 0xFF );
863 
864 	// Suchen des naechsten STMNT-Befehls,
865 	// um die End-Spalte dieses Statements zu setzen
866 	// Searches of the next STMNT instruction,
867 	// around the final column of this statement to set
868 
869 	nCol2 = 0xffff;
870 	sal_uInt16 n1, n2;
871 	const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
872 	if( p )
873 	{
874 		if( n1 == nOp1 )
875 		{
876 			// #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern
877 			nCol2 = (n2 & 0xFF) - 1;
878 		}
879 	}
880 
881 	// #29955 for-Schleifen-Ebene korrigieren, #67452 NICHT im Error-Handler sonst Chaos
882 	if( !bInError )
883 	{
884 		// (Bei Spr�ngen aus Schleifen tritt hier eine Differenz auf)
885 		sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
886 		if( pGosubStk )
887 			nExspectedForLevel = nExspectedForLevel + pGosubStk->nStartForLvl;
888 
889 		// Wenn der tatsaechliche For-Level zu klein ist, wurde aus
890 		// einer Schleife heraus gesprungen -> korrigieren
891 		while( nForLvl > nExspectedForLevel )
892 			PopFor();
893 	}
894 
895 	// 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out
896 	// Erkl�rung siehe bei _ImplGetBreakCallLevel.
897 	if( pInst->nCallLvl <= pInst->nBreakCallLvl )
898 	//if( nFlags & SbDEBUG_STEPINTO )
899 	{
900 		StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
901 		sal_uInt16 nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
902 
903 		// Neuen BreakCallLevel ermitteln
904 		pInst->CalcBreakCallLevel( nNewFlags );
905 	}
906 
907 	// Breakpoints nur bei STMNT-Befehlen in neuer Zeile!
908 	else if( ( nOp1 != nOld )
909 		&& ( nFlags & SbDEBUG_BREAK )
910 		&& pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
911 	{
912 		StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
913 		sal_uInt16 nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
914 
915 		// Neuen BreakCallLevel ermitteln
916 		pInst->CalcBreakCallLevel( nNewFlags );
917 		//16.10.96, ALT:
918 		//if( nNewFlags != SbDEBUG_CONTINUE )
919 		//	nFlags = nNewFlags;
920 	}
921 }
922 
923 // (+SvStreamFlags+Flags)
924 // Stack: Blocklaenge
925 //        Kanalnummer
926 //        Dateiname
927 
StepOPEN(sal_uInt32 nOp1,sal_uInt32 nOp2)928 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
929 {
930 	SbxVariableRef pName = PopVar();
931 	SbxVariableRef pChan = PopVar();
932 	SbxVariableRef pLen  = PopVar();
933 	short nBlkLen = pLen->GetInteger();
934 	short nChan   = pChan->GetInteger();
935 	ByteString aName( pName->GetString(), gsl_getSystemTextEncoding() );
936 	pIosys->Open( nChan, aName, static_cast<short>( nOp1 ),
937 		static_cast<short>( nOp2 ), nBlkLen );
938 	Error( pIosys->GetError() );
939 }
940 
941 // Objekt kreieren (+StringID+StringID)
942 
StepCREATE(sal_uInt32 nOp1,sal_uInt32 nOp2)943 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
944 {
945 	String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
946 	SbxObject *pObj = SbxBase::CreateObject( aClass );
947 	if( !pObj )
948 		Error( SbERR_INVALID_OBJECT );
949 	else
950 	{
951 		String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
952 		pObj->SetName( aName );
953 	// Das Objekt muss BASIC rufen koennen
954 		pObj->SetParent( &rBasic );
955 		SbxVariable* pNew = new SbxVariable;
956 		pNew->PutObject( pObj );
957 		PushVar( pNew );
958 	}
959 }
960 
StepDCREATE(sal_uInt32 nOp1,sal_uInt32 nOp2)961 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
962 {
963     StepDCREATE_IMPL( nOp1, nOp2 );
964 }
965 
StepDCREATE_REDIMP(sal_uInt32 nOp1,sal_uInt32 nOp2)966 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
967 {
968     StepDCREATE_IMPL( nOp1, nOp2 );
969 }
970 
971 
972 // Helper function for StepDCREATE_IMPL / bRedimp = true
implCopyDimArray_DCREATE(SbxDimArray * pNewArray,SbxDimArray * pOldArray,short nMaxDimIndex,short nActualDim,sal_Int32 * pActualIndices,sal_Int32 * pLowerBounds,sal_Int32 * pUpperBounds)973 void implCopyDimArray_DCREATE( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
974 	short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
975 {
976 	sal_Int32& ri = pActualIndices[nActualDim];
977 	for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
978 	{
979 		if( nActualDim < nMaxDimIndex )
980 		{
981 			implCopyDimArray_DCREATE( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
982 				pActualIndices, pLowerBounds, pUpperBounds );
983 		}
984 		else
985 		{
986 			SbxVariable* pSource = pOldArray->Get32( pActualIndices );
987             pNewArray->Put32( pSource, pActualIndices );
988 		}
989 	}
990 }
991 
992 // #56204 Objekt-Array kreieren (+StringID+StringID), DCREATE == Dim-Create
StepDCREATE_IMPL(sal_uInt32 nOp1,sal_uInt32 nOp2)993 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
994 {
995 	SbxVariableRef refVar = PopVar();
996 
997 	DimImpl( refVar );
998 
999 	// Das Array mit Instanzen der geforderten Klasse fuellen
1000 	SbxBaseRef xObj = (SbxBase*)refVar->GetObject();
1001 	if( !xObj )
1002 	{
1003 		StarBASIC::Error( SbERR_INVALID_OBJECT );
1004 		return;
1005 	}
1006 
1007     SbxDimArray* pArray = 0;
1008 	if( xObj->ISA(SbxDimArray) )
1009 	{
1010 		SbxBase* pObj = (SbxBase*)xObj;
1011 		pArray = (SbxDimArray*)pObj;
1012 
1013 		// Dimensionen auswerten
1014 		short nDims = pArray->GetDims();
1015 		sal_Int32 nTotalSize = 0;
1016 
1017 		// es muss ein eindimensionales Array sein
1018 		sal_Int32 nLower, nUpper, nSize;
1019 		sal_Int32 i;
1020 		for( i = 0 ; i < nDims ; i++ )
1021 		{
1022 			pArray->GetDim32( i+1, nLower, nUpper );
1023 			nSize = nUpper - nLower + 1;
1024 			if( i == 0 )
1025 				nTotalSize = nSize;
1026 			else
1027 				nTotalSize *= nSize;
1028 		}
1029 
1030 		// Objekte anlegen und ins Array eintragen
1031 		String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
1032 		for( i = 0 ; i < nTotalSize ; i++ )
1033 		{
1034 			SbxObject *pClassObj = SbxBase::CreateObject( aClass );
1035 			if( !pClassObj )
1036 			{
1037 				Error( SbERR_INVALID_OBJECT );
1038 				break;
1039 			}
1040 			else
1041 			{
1042 				String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
1043 				pClassObj->SetName( aName );
1044 				// Das Objekt muss BASIC rufen koennen
1045 				pClassObj->SetParent( &rBasic );
1046 				pArray->SbxArray::Put32( pClassObj, i );
1047 			}
1048 		}
1049 	}
1050 
1051 	SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
1052 	if( pArray && pOldArray )
1053 	{
1054 		short nDimsNew = pArray->GetDims();
1055 		short nDimsOld = pOldArray->GetDims();
1056 		short nDims = nDimsNew;
1057 		sal_Bool bRangeError = sal_False;
1058 
1059 		// Store dims to use them for copying later
1060 		sal_Int32* pLowerBounds = new sal_Int32[nDims];
1061 		sal_Int32* pUpperBounds = new sal_Int32[nDims];
1062 		sal_Int32* pActualIndices = new sal_Int32[nDims];
1063 		if( nDimsOld != nDimsNew )
1064 		{
1065 			bRangeError = sal_True;
1066 		}
1067 		else
1068 		{
1069 			// Compare bounds
1070 			for( short i = 1 ; i <= nDims ; i++ )
1071 			{
1072 				sal_Int32 lBoundNew, uBoundNew;
1073 				sal_Int32 lBoundOld, uBoundOld;
1074 				pArray->GetDim32( i, lBoundNew, uBoundNew );
1075 				pOldArray->GetDim32( i, lBoundOld, uBoundOld );
1076 
1077 				lBoundNew = std::max( lBoundNew, lBoundOld );
1078 				uBoundNew = std::min( uBoundNew, uBoundOld );
1079 				short j = i - 1;
1080 				pActualIndices[j] = pLowerBounds[j] = lBoundNew;
1081 				pUpperBounds[j] = uBoundNew;
1082 			}
1083 		}
1084 
1085 		if( bRangeError )
1086 		{
1087 			StarBASIC::Error( SbERR_OUT_OF_RANGE );
1088 		}
1089 		else
1090 		{
1091 			// Copy data from old array by going recursively through all dimensions
1092 			// (It would be faster to work on the flat internal data array of an
1093 			// SbyArray but this solution is clearer and easier)
1094 			implCopyDimArray_DCREATE( pArray, pOldArray, nDims - 1,
1095 				0, pActualIndices, pLowerBounds, pUpperBounds );
1096 		}
1097 		delete [] pUpperBounds;
1098 		delete [] pLowerBounds;
1099 		delete [] pActualIndices;
1100 		refRedimpArray = NULL;
1101     }
1102 }
1103 
1104 // Objekt aus User-Type kreieren  (+StringID+StringID)
1105 
1106 SbxObject* createUserTypeImpl( const String& rClassName );	// sb.cxx
1107 
StepTCREATE(sal_uInt32 nOp1,sal_uInt32 nOp2)1108 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1109 {
1110 	String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
1111 	String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
1112 
1113 	SbxObject* pCopyObj = createUserTypeImpl( aClass );
1114 	if( pCopyObj )
1115 		pCopyObj->SetName( aName );
1116 	SbxVariable* pNew = new SbxVariable;
1117 	pNew->PutObject( pCopyObj );
1118 	pNew->SetDeclareClassName( aClass );
1119 	PushVar( pNew );
1120 }
1121 
implHandleSbxFlags(SbxVariable * pVar,SbxDataType t,sal_uInt32 nOp2)1122 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
1123 {
1124 	bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
1125 	if( bWithEvents )
1126 		pVar->SetFlag( SBX_WITH_EVENTS );
1127 
1128 	bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
1129 	if( bDimAsNew )
1130 		pVar->SetFlag( SBX_DIM_AS_NEW );
1131 
1132 	bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
1133 	if( bFixedString )
1134 	{
1135 		sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 );		// len = all bits above 0x10000
1136 		String aStr;
1137 		aStr.Fill( nCount, 0 );
1138 		pVar->PutString( aStr );
1139 	}
1140 
1141 	bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
1142 	if( bVarToDim )
1143 		pVar->SetFlag( SBX_VAR_TO_DIM );
1144 }
1145 
1146 // Einrichten einer lokalen Variablen (+StringID+Typ)
1147 
StepLOCAL(sal_uInt32 nOp1,sal_uInt32 nOp2)1148 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1149 {
1150 	if( !refLocals.Is() )
1151 		refLocals = new SbxArray;
1152 	String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
1153 	if( refLocals->Find( aName, SbxCLASS_DONTCARE ) == NULL )
1154 	{
1155 		SbxDataType t = (SbxDataType)(nOp2 & 0xffff);
1156 		SbxVariable* p = new SbxVariable( t );
1157 		p->SetName( aName );
1158 		implHandleSbxFlags( p, t, nOp2 );
1159 		refLocals->Put( p, refLocals->Count() );
1160 	}
1161 }
1162 
1163 // Einrichten einer modulglobalen Variablen (+StringID+Typ)
1164 
StepPUBLIC_Impl(sal_uInt32 nOp1,sal_uInt32 nOp2,bool bUsedForClassModule)1165 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
1166 {
1167 	String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
1168 	SbxDataType t = (SbxDataType)(SbxDataType)(nOp2 & 0xffff);;
1169 	sal_Bool bFlag = pMod->IsSet( SBX_NO_MODIFY );
1170 	pMod->SetFlag( SBX_NO_MODIFY );
1171 	SbxVariableRef p = pMod->Find( aName, SbxCLASS_PROPERTY );
1172 	if( p.Is() )
1173 		pMod->Remove (p);
1174 	SbProperty* pProp = pMod->GetProperty( aName, t );
1175 	if( !bUsedForClassModule )
1176 		pProp->SetFlag( SBX_PRIVATE );
1177 	if( !bFlag )
1178 		pMod->ResetFlag( SBX_NO_MODIFY );
1179 	if( pProp )
1180 	{
1181 		pProp->SetFlag( SBX_DONTSTORE );
1182 		// AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden'
1183 		pProp->SetFlag( SBX_NO_MODIFY);
1184 
1185 		implHandleSbxFlags( pProp, t, nOp2 );
1186 	}
1187 }
1188 
StepPUBLIC(sal_uInt32 nOp1,sal_uInt32 nOp2)1189 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1190 {
1191 	StepPUBLIC_Impl( nOp1, nOp2, false );
1192 }
1193 
StepPUBLIC_P(sal_uInt32 nOp1,sal_uInt32 nOp2)1194 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1195 {
1196     // Creates module variable that isn't reinitialised when
1197     // between invocations ( for VBASupport & document basic only )
1198     if( pMod->pImage->bFirstInit )
1199 	{
1200 		bool bUsedForClassModule = pImg->GetFlag( SBIMG_CLASSMODULE );
1201 		StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
1202 	}
1203 }
1204 
1205 // Einrichten einer globalen Variablen (+StringID+Typ)
1206 
StepGLOBAL(sal_uInt32 nOp1,sal_uInt32 nOp2)1207 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1208 {
1209 	if( pImg->GetFlag( SBIMG_CLASSMODULE ) )
1210 		StepPUBLIC_Impl( nOp1, nOp2, true );
1211 
1212 	String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
1213 	SbxDataType t = (SbxDataType)(nOp2 & 0xffff);
1214 
1215 	// Store module scope variables at module scope
1216 	// in non vba mode these are stored at the library level :/
1217 	// not sure if this really should not be enabled for ALL basic
1218 	SbxObject* pStorage = &rBasic;
1219 	if ( SbiRuntime::isVBAEnabled() )
1220 	{
1221 		pStorage = pMod;
1222 		pMod->AddVarName( aName );
1223 	}
1224 
1225 	sal_Bool bFlag = pStorage->IsSet( SBX_NO_MODIFY );
1226 	rBasic.SetFlag( SBX_NO_MODIFY );
1227 	SbxVariableRef p = pStorage->Find( aName, SbxCLASS_PROPERTY );
1228 	if( p.Is() )
1229 		pStorage->Remove (p);
1230 	p = pStorage->Make( aName, SbxCLASS_PROPERTY, t );
1231 	if( !bFlag )
1232 		pStorage->ResetFlag( SBX_NO_MODIFY );
1233 	if( p )
1234 	{
1235 		p->SetFlag( SBX_DONTSTORE );
1236 		// AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden'
1237 		p->SetFlag( SBX_NO_MODIFY);
1238 	}
1239 }
1240 
1241 
1242 // Creates global variable that isn't reinitialised when
1243 // basic is restarted, P=PERSIST (+StringID+Typ)
1244 
StepGLOBAL_P(sal_uInt32 nOp1,sal_uInt32 nOp2)1245 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1246 {
1247     if( pMod->pImage->bFirstInit )
1248     {
1249         StepGLOBAL( nOp1, nOp2 );
1250     }
1251 }
1252 
1253 
1254 // Searches for global variable, behavior depends on the fact
1255 // if the variable is initialised for the first time
1256 
StepFIND_G(sal_uInt32 nOp1,sal_uInt32 nOp2)1257 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1258 {
1259     if( pMod->pImage->bFirstInit )
1260     {
1261         // Behave like always during first init
1262         StepFIND( nOp1, nOp2 );
1263     }
1264     else
1265     {
1266         // Return dummy variable
1267 		SbxDataType t = (SbxDataType) nOp2;
1268 		String aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
1269 
1270         SbxVariable* pDummyVar = new SbxVariable( t );
1271 		pDummyVar->SetName( aName );
1272     	PushVar( pDummyVar );
1273     }
1274 }
1275 
1276 
StepSTATIC_Impl(String & aName,SbxDataType & t)1277 SbxVariable* SbiRuntime::StepSTATIC_Impl( String& aName, SbxDataType& t )
1278 {
1279     SbxVariable* p = NULL;
1280     if ( pMeth )
1281     {
1282         SbxArray* pStatics = pMeth->GetStatics();
1283         if( pStatics && ( pStatics->Find( aName, SbxCLASS_DONTCARE ) == NULL ) )
1284         {
1285             p = new SbxVariable( t );
1286             if( t != SbxVARIANT )
1287                 p->SetFlag( SBX_FIXED );
1288             p->SetName( aName );
1289             pStatics->Put( p, pStatics->Count() );
1290         }
1291     }
1292     return p;
1293 }
1294 // Einrichten einer statischen Variablen (+StringID+Typ)
StepSTATIC(sal_uInt32 nOp1,sal_uInt32 nOp2)1295 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1296 {
1297     String aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
1298     SbxDataType t = (SbxDataType) nOp2;
1299     StepSTATIC_Impl( aName, t );
1300 }
1301 
1302