xref: /aoo42x/main/basic/source/runtime/step0.cxx (revision 7a164331)
1 /**************************************************************
2  *
3  * Licensed to the Apache Software Foundation (ASF) under one
4  * or more contributor license agreements.  See the NOTICE file
5  * distributed with this work for additional information
6  * regarding copyright ownership.  The ASF licenses this file
7  * to you under the Apache License, Version 2.0 (the
8  * "License"); you may not use this file except in compliance
9  * with the License.  You may obtain a copy of the License at
10  *
11  *   http://www.apache.org/licenses/LICENSE-2.0
12  *
13  * Unless required by applicable law or agreed to in writing,
14  * software distributed under the License is distributed on an
15  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16  * KIND, either express or implied.  See the License for the
17  * specific language governing permissions and limitations
18  * under the License.
19  *
20  *************************************************************/
21 
22 
23 
24 // MARKER(update_precomp.py): autogen include statement, do not remove
25 #include "precompiled_basic.hxx"
26 #include <vcl/msgbox.hxx>
27 #include <tools/fsys.hxx>
28 
29 #include "errobject.hxx"
30 #include "runtime.hxx"
31 #include "sbintern.hxx"
32 #include "iosys.hxx"
33 #include <sb.hrc>
34 #include <basrid.hxx>
35 #include "sbunoobj.hxx"
36 #include "image.hxx"
37 #include <com/sun/star/uno/Any.hxx>
38 #include <com/sun/star/util/SearchOptions.hdl>
39 #include <vcl/svapp.hxx>
40 #include <unotools/textsearch.hxx>
41 
42 Reference< XInterface > createComListener( const Any& aControlAny, const ::rtl::OUString& aVBAType,
43 										   const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj );
44 
45 #include <algorithm>
46 #include <hash_map>
47 
48 SbxVariable* getDefaultProp( SbxVariable* pRef );
49 
StepNOP()50 void SbiRuntime::StepNOP()
51 {}
52 
StepArith(SbxOperator eOp)53 void SbiRuntime::StepArith( SbxOperator eOp )
54 {
55 	SbxVariableRef p1 = PopVar();
56 	TOSMakeTemp();
57 	SbxVariable* p2 = GetTOS();
58 
59 
60 	// This could & should be moved to the MakeTempTOS() method in runtime.cxx
61 	// In the code which this is cut'npaste from there is a check for a ref
62 	// count != 1 based on which the copy of the SbxVariable is done.
63 	// see orig code in MakeTempTOS ( and I'm not sure what the significance,
64 	// of that is )
65 	// here we alway seem to have a refcount of 1. Also it seems that
66 	// MakeTempTOS is called for other operation, so I hold off for now
67 	// until I have a better idea
68 	if ( bVBAEnabled
69 		&& ( p2->GetType() == SbxOBJECT || p2->GetType() == SbxVARIANT )
70 	)
71 	{
72 		SbxVariable* pDflt = getDefaultProp( p2 );
73 		if ( pDflt )
74 		{
75 			pDflt->Broadcast( SBX_HINT_DATAWANTED );
76 			// replacing new p2 on stack causes object pointed by
77 			// pDft->pParent to be deleted, when p2->Compute() is
78 			// called below pParent is accessed ( but its deleted )
79 			// so set it to NULL now
80 			pDflt->SetParent( NULL );
81 			p2 = new SbxVariable( *pDflt );
82 			p2->SetFlag( SBX_READWRITE );
83 			refExprStk->Put( p2, nExprLvl - 1 );
84 		}
85 	}
86 
87 	p2->ResetFlag( SBX_FIXED );
88 	p2->Compute( eOp, *p1 );
89 
90     checkArithmeticOverflow( p2 );
91 }
92 
StepUnary(SbxOperator eOp)93 void SbiRuntime::StepUnary( SbxOperator eOp )
94 {
95 	TOSMakeTemp();
96 	SbxVariable* p = GetTOS();
97 	p->Compute( eOp, *p );
98 }
99 
StepCompare(SbxOperator eOp)100 void SbiRuntime::StepCompare( SbxOperator eOp )
101 {
102 	SbxVariableRef p1 = PopVar();
103 	SbxVariableRef p2 = PopVar();
104 
105 	// Make sure objects with default params have
106 	// values ( and type ) set as appropriate
107 	SbxDataType p1Type = p1->GetType();
108 	SbxDataType p2Type = p2->GetType();
109 	if ( p1Type == p2Type )
110 	{
111 		if ( p1Type == SbxEMPTY )
112 		{
113 			p1->Broadcast( SBX_HINT_DATAWANTED );
114 			p2->Broadcast( SBX_HINT_DATAWANTED );
115 		}
116 		// if both sides are an object and have default props
117 		// then we need to use the default props
118 		// we don't need to worry if only one side ( lhs, rhs ) is an
119 		// object ( object side will get coerced to correct type in
120 		// Compare )
121 		else if ( p1Type ==  SbxOBJECT )
122 		{
123 			SbxVariable* pDflt = getDefaultProp( p1 );
124 			if ( pDflt )
125 			{
126 				p1 = pDflt;
127 				p1->Broadcast( SBX_HINT_DATAWANTED );
128 			}
129 			pDflt = getDefaultProp( p2 );
130 			if ( pDflt )
131 			{
132 				p2 = pDflt;
133 				p2->Broadcast( SBX_HINT_DATAWANTED );
134 			}
135 		}
136 
137 	}
138 	static SbxVariable* pTRUE = NULL;
139 	static SbxVariable* pFALSE = NULL;
140 
141 	if( p2->Compare( eOp, *p1 ) )
142 	{
143 		if( !pTRUE )
144 		{
145 			pTRUE = new SbxVariable;
146 			pTRUE->PutBool( sal_True );
147 			pTRUE->AddRef();
148 		}
149 		PushVar( pTRUE );
150 	}
151 	else
152 	{
153 		if( !pFALSE )
154 		{
155 			pFALSE = new SbxVariable;
156 			pFALSE->PutBool( sal_False );
157 			pFALSE->AddRef();
158 		}
159 		PushVar( pFALSE );
160 	}
161 }
162 
StepEXP()163 void SbiRuntime::StepEXP()		{ StepArith( SbxEXP );		}
StepMUL()164 void SbiRuntime::StepMUL()		{ StepArith( SbxMUL );		}
StepDIV()165 void SbiRuntime::StepDIV()		{ StepArith( SbxDIV );		}
StepIDIV()166 void SbiRuntime::StepIDIV()		{ StepArith( SbxIDIV );		}
StepMOD()167 void SbiRuntime::StepMOD()		{ StepArith( SbxMOD );		}
StepPLUS()168 void SbiRuntime::StepPLUS()		{ StepArith( SbxPLUS );		}
StepMINUS()169 void SbiRuntime::StepMINUS()		{ StepArith( SbxMINUS );	}
StepCAT()170 void SbiRuntime::StepCAT()		{ StepArith( SbxCAT );		}
StepAND()171 void SbiRuntime::StepAND()		{ StepArith( SbxAND );		}
StepOR()172 void SbiRuntime::StepOR()		{ StepArith( SbxOR );		}
StepXOR()173 void SbiRuntime::StepXOR()		{ StepArith( SbxXOR );		}
StepEQV()174 void SbiRuntime::StepEQV()		{ StepArith( SbxEQV );		}
StepIMP()175 void SbiRuntime::StepIMP()		{ StepArith( SbxIMP );		}
176 
StepNEG()177 void SbiRuntime::StepNEG()		{ StepUnary( SbxNEG );		}
StepNOT()178 void SbiRuntime::StepNOT()		{ StepUnary( SbxNOT );		}
179 
StepEQ()180 void SbiRuntime::StepEQ()		{ StepCompare( SbxEQ );		}
StepNE()181 void SbiRuntime::StepNE()		{ StepCompare( SbxNE );		}
StepLT()182 void SbiRuntime::StepLT()		{ StepCompare( SbxLT );		}
StepGT()183 void SbiRuntime::StepGT()		{ StepCompare( SbxGT );		}
StepLE()184 void SbiRuntime::StepLE()		{ StepCompare( SbxLE );		}
StepGE()185 void SbiRuntime::StepGE()		{ StepCompare( SbxGE );		}
186 
187 namespace
188 {
NeedEsc(sal_Unicode cCode)189 	bool NeedEsc(sal_Unicode cCode)
190 	{
191 		String sEsc(RTL_CONSTASCII_USTRINGPARAM(".^$+\\|{}()"));
192 		return (STRING_NOTFOUND != sEsc.Search(cCode));
193 	}
194 
VBALikeToRegexp(const String & rIn)195 	String VBALikeToRegexp(const String &rIn)
196 	{
197 		String sResult;
198 		const sal_Unicode *start = rIn.GetBuffer();
199 		const sal_Unicode *end = start + rIn.Len();
200 
201 		int seenright = 0;
202 
203 		sResult.Append('^');
204 
205 		while (start < end)
206 		{
207 			switch (*start)
208 			{
209 				case '?':
210 					sResult.Append('.');
211 					start++;
212 					break;
213 				case '*':
214 					sResult.Append(String(RTL_CONSTASCII_USTRINGPARAM(".*")));
215 					start++;
216 					break;
217 				case '#':
218 					sResult.Append(String(RTL_CONSTASCII_USTRINGPARAM("[0-9]")));
219 					start++;
220 					break;
221 				case ']':
222 					sResult.Append('\\');
223 					sResult.Append(*start++);
224 					break;
225 				case '[':
226 					sResult.Append(*start++);
227 					seenright = 0;
228 					while (start < end && !seenright)
229 					{
230 						switch (*start)
231 						{
232 							case '[':
233 							case '?':
234 							case '*':
235 							sResult.Append('\\');
236 							sResult.Append(*start);
237 								break;
238 							case ']':
239 							sResult.Append(*start);
240 								seenright = 1;
241 								break;
242 							case '!':
243 								sResult.Append('^');
244 								break;
245 							default:
246 							if (NeedEsc(*start))
247 									sResult.Append('\\');
248 							sResult.Append(*start);
249 								break;
250 						}
251 						start++;
252 					}
253 					break;
254 				default:
255 					if (NeedEsc(*start))
256 						sResult.Append('\\');
257 					sResult.Append(*start++);
258 			}
259 		}
260 
261 		sResult.Append('$');
262 
263 		return sResult;
264 	}
265 }
266 
StepLIKE()267 void SbiRuntime::StepLIKE()
268 {
269     SbxVariableRef refVar1 = PopVar();
270     SbxVariableRef refVar2 = PopVar();
271 
272     String pattern = VBALikeToRegexp(refVar1->GetString());
273     String value = refVar2->GetString();
274 
275     com::sun::star::util::SearchOptions aSearchOpt;
276 
277     aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
278 
279     aSearchOpt.Locale = Application::GetSettings().GetLocale();
280     aSearchOpt.searchString = pattern;
281 
282     int bTextMode(1);
283     bool bCompatibility = ( pINST && pINST->IsCompatibility() );
284     if( bCompatibility )
285         bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
286 
287     if( bTextMode )
288         aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
289 
290     SbxVariable* pRes = new SbxVariable;
291     utl::TextSearch aSearch(aSearchOpt);
292     xub_StrLen nStart=0, nEnd=value.Len();
293     int bRes = aSearch.SearchFrwrd(value, &nStart, &nEnd);
294     pRes->PutBool( bRes != 0 );
295 
296     PushVar( pRes );
297 }
298 
299 // TOS und TOS-1 sind beides Objektvariable und enthalten den selben Pointer
300 
StepIS()301 void SbiRuntime::StepIS()
302 {
303 	SbxVariableRef refVar1 = PopVar();
304 	SbxVariableRef refVar2 = PopVar();
305 
306 	SbxDataType eType1 = refVar1->GetType();
307 	SbxDataType eType2 = refVar2->GetType();
308 	if ( eType1 == SbxEMPTY )
309 	{
310 		refVar1->Broadcast( SBX_HINT_DATAWANTED );
311 		eType1 = refVar1->GetType();
312 	}
313 	if ( eType2 == SbxEMPTY )
314 	{
315 		refVar2->Broadcast( SBX_HINT_DATAWANTED );
316 		eType2 = refVar2->GetType();
317 	}
318 
319 	sal_Bool bRes = sal_Bool( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
320 	if ( bVBAEnabled  && !bRes )
321 		Error( SbERR_INVALID_USAGE_OBJECT );
322 	bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
323 	SbxVariable* pRes = new SbxVariable;
324 	pRes->PutBool( bRes );
325 	PushVar( pRes );
326 }
327 
328 // Aktualisieren des Wertes von TOS
329 
StepGET()330 void SbiRuntime::StepGET()
331 {
332 	SbxVariable* p = GetTOS();
333 	p->Broadcast( SBX_HINT_DATAWANTED );
334 }
335 
336 // #67607 Uno-Structs kopieren
checkUnoStructCopy(SbxVariableRef & refVal,SbxVariableRef & refVar)337 inline void checkUnoStructCopy( SbxVariableRef& refVal, SbxVariableRef& refVar )
338 {
339 	SbxDataType eVarType = refVar->GetType();
340 	if( eVarType != SbxOBJECT )
341         return;
342 
343 	SbxObjectRef xValObj = (SbxObject*)refVal->GetObject();
344 	if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
345         return;
346 
347 	// #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
348 	if( refVar->ISA(SbProcedureProperty) )
349 		return;
350 
351 	SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject();
352 	SbxDataType eValType = refVal->GetType();
353 	if( eValType == SbxOBJECT && xVarObj == xValObj )
354 	{
355 		SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxObject*)xVarObj);
356 		if( pUnoObj )
357 		{
358 			Any aAny = pUnoObj->getUnoAny();
359 			if( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
360 			{
361 				SbUnoObject* pNewUnoObj = new SbUnoObject( pUnoObj->GetName(), aAny );
362 				// #70324: ClassName uebernehmen
363 				pNewUnoObj->SetClassName( pUnoObj->GetClassName() );
364 				refVar->PutObject( pNewUnoObj );
365 			}
366 		}
367 	}
368 }
369 
370 
371 // Ablage von TOS in TOS-1
372 
StepPUT()373 void SbiRuntime::StepPUT()
374 {
375 	SbxVariableRef refVal = PopVar();
376 	SbxVariableRef refVar = PopVar();
377 	// Store auf die eigene Methode (innerhalb einer Function)?
378 	sal_Bool bFlagsChanged = sal_False;
379 	sal_uInt16 n = 0;
380 	if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
381 	{
382 		bFlagsChanged = sal_True;
383 		n = refVar->GetFlags();
384 		refVar->SetFlag( SBX_WRITE );
385 	}
386 
387 	// if left side arg is an object or variant and right handside isn't
388 	// either an object or a variant then try and see if a default
389 	// property exists.
390 	// to use e.g. Range{"A1") = 34
391 	// could equate to Range("A1").Value = 34
392 	if ( bVBAEnabled )
393 	{
394 		if ( refVar->GetType() == SbxOBJECT  )
395 		{
396 			SbxVariable* pDflt = getDefaultProp( refVar );
397 			if ( pDflt )
398 				refVar = pDflt;
399 		}
400 		if (  refVal->GetType() == SbxOBJECT  )
401 		{
402 			SbxVariable* pDflt = getDefaultProp( refVal );
403 			if ( pDflt )
404 				refVal = pDflt;
405 		}
406 	}
407 
408 	*refVar = *refVal;
409 	// lhs is a property who's value is currently null
410 	if ( !bVBAEnabled || ( bVBAEnabled && refVar->GetType() != SbxEMPTY ) )
411 	// #67607 Uno-Structs kopieren
412 		checkUnoStructCopy( refVal, refVar );
413 	if( bFlagsChanged )
414 		refVar->SetFlags( n );
415 }
416 
417 
418 // VBA Dim As New behavior handling, save init object information
419 struct DimAsNewRecoverItem
420 {
421 	String			m_aObjClass;
422 	String			m_aObjName;
423 	SbxObject*		m_pObjParent;
424 	SbModule*		m_pClassModule;
425 
DimAsNewRecoverItemDimAsNewRecoverItem426 	DimAsNewRecoverItem( void )
427 		: m_pObjParent( NULL )
428 		, m_pClassModule( NULL )
429 	{}
430 
DimAsNewRecoverItemDimAsNewRecoverItem431 	DimAsNewRecoverItem( const String& rObjClass, const String& rObjName,
432 		SbxObject* pObjParent, SbModule* pClassModule )
433 			: m_aObjClass( rObjClass )
434 			, m_aObjName( rObjName )
435 			, m_pObjParent( pObjParent )
436 			, m_pClassModule( pClassModule )
437 	{}
438 
439 };
440 
441 
442 struct SbxVariablePtrHash
443 {
operator ()SbxVariablePtrHash444     size_t operator()( SbxVariable* pVar ) const
445         { return (size_t)pVar; }
446 };
447 
448 typedef std::hash_map< SbxVariable*, DimAsNewRecoverItem, SbxVariablePtrHash >	DimAsNewRecoverHash;
449 
450 static DimAsNewRecoverHash		GaDimAsNewRecoverHash;
451 
removeDimAsNewRecoverItem(SbxVariable * pVar)452 void removeDimAsNewRecoverItem( SbxVariable* pVar )
453 {
454 	DimAsNewRecoverHash::iterator it = GaDimAsNewRecoverHash.find( pVar );
455 	if( it != GaDimAsNewRecoverHash.end() )
456 		GaDimAsNewRecoverHash.erase( it );
457 }
458 
459 
460 // Speichern Objektvariable
461 // Nicht-Objekt-Variable fuehren zu Fehlern
462 
463 static const char pCollectionStr[] = "Collection";
464 
StepSET_Impl(SbxVariableRef & refVal,SbxVariableRef & refVar,bool bHandleDefaultProp)465 void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
466 {
467 	// #67733 Typen mit Array-Flag sind auch ok
468 
469 	// Check var, !object is no error for sure if, only if type is fixed
470 	SbxDataType eVarType = refVar->GetType();
471 	if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
472 	{
473 		Error( SbERR_INVALID_USAGE_OBJECT );
474 		return;
475 	}
476 
477 	// Check value, !object is no error for sure if, only if type is fixed
478 	SbxDataType eValType = refVal->GetType();
479 //	bool bGetValObject = false;
480 	if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
481 	{
482 		Error( SbERR_INVALID_USAGE_OBJECT );
483 		return;
484 	}
485 
486 	// Getting in here causes problems with objects with default properties
487 	// if they are SbxEMPTY I guess
488 	if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
489 	{
490 	// Auf refVal GetObject fuer Collections ausloesen
491 		SbxBase* pObjVarObj = refVal->GetObject();
492 		if( pObjVarObj )
493 		{
494 			SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
495 
496 			// #67733 Typen mit Array-Flag sind auch ok
497 			if( refObjVal )
498 				refVal = refObjVal;
499 			else if( !(eValType & SbxARRAY) )
500 				refVal = NULL;
501 		}
502 	}
503 
504 	// #52896 Wenn Uno-Sequences bzw. allgemein Arrays einer als
505 	// Object deklarierten Variable zugewiesen werden, kann hier
506 	// refVal ungueltig sein!
507 	if( !refVal )
508 	{
509 		Error( SbERR_INVALID_USAGE_OBJECT );
510 	}
511 	else
512 	{
513 		// Store auf die eigene Methode (innerhalb einer Function)?
514 		sal_Bool bFlagsChanged = sal_False;
515 		sal_uInt16 n = 0;
516 		if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
517 		{
518 			bFlagsChanged = sal_True;
519 			n = refVar->GetFlags();
520 			refVar->SetFlag( SBX_WRITE );
521 		}
522 		SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
523 		if( pProcProperty )
524 			pProcProperty->setSet( true );
525 
526 		if ( bHandleDefaultProp )
527 		{
528 			// get default properties for lhs & rhs where necessary
529 			// SbxVariable* defaultProp = NULL; unused variable
530 			bool bLHSHasDefaultProp = false;
531 			// LHS try determine if a default prop exists
532 			if ( refVar->GetType() == SbxOBJECT )
533 			{
534 				SbxVariable* pDflt = getDefaultProp( refVar );
535 				if ( pDflt )
536 				{
537 					refVar = pDflt;
538 					bLHSHasDefaultProp = true;
539 				}
540 			}
541 			// RHS only get a default prop is the rhs has one
542 			if (  refVal->GetType() == SbxOBJECT )
543 			{
544 				// check if lhs is a null object
545 				// if it is then use the object not the default property
546 				SbxObject* pObj = NULL;
547 
548 
549 				pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
550 
551 				// calling GetObject on a SbxEMPTY variable raises
552 				// object not set errors, make sure its an Object
553 				if ( !pObj && refVar->GetType() == SbxOBJECT )
554 				{
555 					SbxBase* pObjVarObj = refVar->GetObject();
556 					pObj = PTR_CAST(SbxObject,pObjVarObj);
557 				}
558 				SbxVariable* pDflt = NULL;
559 				if ( pObj || bLHSHasDefaultProp )
560 					// lhs is either a valid object || or has a defaultProp
561 					pDflt = getDefaultProp( refVal );
562 				if ( pDflt )
563 					refVal = pDflt;
564 			}
565 		}
566 
567 		// Handle Dim As New
568 		sal_Bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
569 		SbxBaseRef xPrevVarObj;
570 		if( bDimAsNew )
571 			xPrevVarObj = refVar->GetObject();
572 
573 		// Handle withevents
574 		sal_Bool bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
575         if ( bWithEvents )
576         {
577             Reference< XInterface > xComListener;
578 
579             SbxBase* pObj = refVal->GetObject();
580             SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
581             if( pUnoObj != NULL )
582             {
583                 Any aControlAny = pUnoObj->getUnoAny();
584                 String aDeclareClassName = refVar->GetDeclareClassName();
585                 ::rtl::OUString aVBAType = aDeclareClassName;
586                 ::rtl::OUString aPrefix = refVar->GetName();
587                 SbxObjectRef xScopeObj = refVar->GetParent();
588                 xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
589 
590                 refVal->SetDeclareClassName( aDeclareClassName );
591                 refVal->SetComListener( xComListener, &rBasic );		// Hold reference
592             }
593 
594             *refVar = *refVal;
595         }
596         else
597         {
598             *refVar = *refVal;
599         }
600 
601         if ( bDimAsNew )
602         {
603 			if( !refVar->ISA(SbxObject) )
604 			{
605 	            SbxBase* pValObjBase = refVal->GetObject();
606 				if( pValObjBase == NULL )
607 				{
608 					if( xPrevVarObj.Is() )
609 					{
610 						// Object is overwritten with NULL, instantiate init object
611 						DimAsNewRecoverHash::iterator it = GaDimAsNewRecoverHash.find( refVar );
612 						if( it != GaDimAsNewRecoverHash.end() )
613 						{
614 							const DimAsNewRecoverItem& rItem = it->second;
615 							if( rItem.m_pClassModule != NULL )
616 							{
617 								SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
618 								pNewObj->SetName( rItem.m_aObjName );
619 								pNewObj->SetParent( rItem.m_pObjParent );
620 								refVar->PutObject( pNewObj );
621 							}
622 							else if( rItem.m_aObjClass.EqualsIgnoreCaseAscii( pCollectionStr ) )
623 							{
624 								BasicCollection* pNewCollection = new BasicCollection( String( RTL_CONSTASCII_USTRINGPARAM(pCollectionStr) ) );
625 								pNewCollection->SetName( rItem.m_aObjName );
626 								pNewCollection->SetParent( rItem.m_pObjParent );
627 								refVar->PutObject( pNewCollection );
628 							}
629 						}
630 					}
631 				}
632 				else
633 				{
634 					// Does old value exist?
635 					bool bFirstInit = !xPrevVarObj.Is();
636 					if( bFirstInit )
637 					{
638 						// Store information to instantiate object later
639 						SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
640 						if( pValObj != NULL )
641 						{
642 							String aObjClass = pValObj->GetClassName();
643 
644 							SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
645 							if( pClassModuleObj != NULL )
646 							{
647 								SbModule* pClassModule = pClassModuleObj->getClassModule();
648 								GaDimAsNewRecoverHash[refVar] =
649 									DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
650 							}
651 							else if( aObjClass.EqualsIgnoreCaseAscii( "Collection" ) )
652 							{
653 								GaDimAsNewRecoverHash[refVar] =
654 									DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
655 							}
656 						}
657 					}
658 				}
659 			}
660 		}
661 
662 
663 		// lhs is a property who's value is currently (Empty e.g. no broadcast yet)
664 		// in this case if there is a default prop involved the value of the
665 		// default property may infact be void so the type will also be SbxEMPTY
666 		// in this case we do not want to call checkUnoStructCopy 'cause that will
667 		// cause an error also
668 		if ( !bHandleDefaultProp || ( bHandleDefaultProp && ( refVar->GetType() != SbxEMPTY ) ) )
669 		// #67607 Uno-Structs kopieren
670 			checkUnoStructCopy( refVal, refVar );
671 		if( bFlagsChanged )
672 			refVar->SetFlags( n );
673 	}
674 }
675 
StepSET()676 void SbiRuntime::StepSET()
677 {
678 	SbxVariableRef refVal = PopVar();
679 	SbxVariableRef refVar = PopVar();
680 	StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
681 }
682 
StepVBASET()683 void SbiRuntime::StepVBASET()
684 {
685 	SbxVariableRef refVal = PopVar();
686 	SbxVariableRef refVar = PopVar();
687 	// don't handle default property
688 	StepSET_Impl( refVal, refVar, false ); // set obj = something
689 }
690 
691 
692 // JSM 07.10.95
StepLSET()693 void SbiRuntime::StepLSET()
694 {
695 	SbxVariableRef refVal = PopVar();
696 	SbxVariableRef refVar = PopVar();
697 	if( refVar->GetType() != SbxSTRING
698 	 || refVal->GetType() != SbxSTRING )
699 		Error( SbERR_INVALID_USAGE_OBJECT );
700 	else
701 	{
702 		// Store auf die eigene Methode (innerhalb einer Function)?
703 		sal_uInt16 n = refVar->GetFlags();
704 		if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
705 			refVar->SetFlag( SBX_WRITE );
706 		String aRefVarString = refVar->GetString();
707 		String aRefValString = refVal->GetString();
708 
709         sal_uInt16 nVarStrLen = aRefVarString.Len();
710         sal_uInt16 nValStrLen = aRefValString.Len();
711         String aNewStr;
712 		if( nVarStrLen > nValStrLen )
713         {
714 			aRefVarString.Fill(nVarStrLen,' ');
715 		    aNewStr  = aRefValString.Copy( 0, nValStrLen );
716 		    aNewStr += aRefVarString.Copy( nValStrLen, nVarStrLen - nValStrLen );
717         }
718         else
719         {
720 		    aNewStr = aRefValString.Copy( 0, nVarStrLen );
721         }
722 
723 	    refVar->PutString( aNewStr );
724 		refVar->SetFlags( n );
725 	}
726 }
727 
728 // JSM 07.10.95
StepRSET()729 void SbiRuntime::StepRSET()
730 {
731 	SbxVariableRef refVal = PopVar();
732 	SbxVariableRef refVar = PopVar();
733 	if( refVar->GetType() != SbxSTRING
734 	 || refVal->GetType() != SbxSTRING )
735 		Error( SbERR_INVALID_USAGE_OBJECT );
736 	else
737 	{
738 		// Store auf die eigene Methode (innerhalb einer Function)?
739 		sal_uInt16 n = refVar->GetFlags();
740 		if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
741 			refVar->SetFlag( SBX_WRITE );
742 		String aRefVarString = refVar->GetString();
743 		String aRefValString = refVal->GetString();
744 
745 		sal_uInt16 nPos = 0;
746         sal_uInt16 nVarStrLen = aRefVarString.Len();
747 		if( nVarStrLen > aRefValString.Len() )
748 		{
749 			aRefVarString.Fill(nVarStrLen,' ');
750 			nPos = nVarStrLen - aRefValString.Len();
751 		}
752 		aRefVarString  = aRefVarString.Copy( 0, nPos );
753 		aRefVarString += aRefValString.Copy( 0, nVarStrLen - nPos );
754 		refVar->PutString(aRefVarString);
755 
756 		refVar->SetFlags( n );
757 	}
758 }
759 
760 // Ablage von TOS in TOS-1, dann ReadOnly-Bit setzen
761 
StepPUTC()762 void SbiRuntime::StepPUTC()
763 {
764 	SbxVariableRef refVal = PopVar();
765 	SbxVariableRef refVar = PopVar();
766 	refVar->SetFlag( SBX_WRITE );
767 	*refVar = *refVal;
768 	refVar->ResetFlag( SBX_WRITE );
769 	refVar->SetFlag( SBX_CONST );
770 }
771 
772 // DIM
773 // TOS = Variable fuer das Array mit Dimensionsangaben als Parameter
774 
StepDIM()775 void SbiRuntime::StepDIM()
776 {
777 	SbxVariableRef refVar = PopVar();
778 	DimImpl( refVar );
779 }
780 
781 // #56204 DIM-Funktionalitaet in Hilfsmethode auslagern (step0.cxx)
DimImpl(SbxVariableRef refVar)782 void SbiRuntime::DimImpl( SbxVariableRef refVar )
783 {
784 	SbxArray* pDims = refVar->GetParameters();
785 	// Muss eine gerade Anzahl Argumente haben
786 	// Man denke daran, dass Arg[0] nicht zaehlt!
787 	if( pDims && !( pDims->Count() & 1 ) )
788 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
789 	else
790 	{
791 		SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
792 		SbxDimArray* pArray = new SbxDimArray( eType );
793 		// AB 2.4.1996, auch Arrays ohne Dimensionsangaben zulassen (VB-komp.)
794 		if( pDims )
795 		{
796 			refVar->ResetFlag( SBX_VAR_TO_DIM );
797 
798 			for( sal_uInt16 i = 1; i < pDims->Count(); )
799 			{
800 				sal_Int32 lb = pDims->Get( i++ )->GetLong();
801 				sal_Int32 ub = pDims->Get( i++ )->GetLong();
802 				if( ub < lb )
803 					Error( SbERR_OUT_OF_RANGE ), ub = lb;
804 				pArray->AddDim32( lb, ub );
805 				if ( lb != ub )
806 					pArray->setHasFixedSize( true );
807 			}
808 		}
809 		else
810 		{
811 			// #62867 Beim Anlegen eines Arrays der Laenge 0 wie bei
812 			// Uno-Sequences der Laenge 0 eine Dimension anlegen
813 			pArray->unoAddDim( 0, -1 );
814 		}
815 		sal_uInt16 nSavFlags = refVar->GetFlags();
816 		refVar->ResetFlag( SBX_FIXED );
817 		refVar->PutObject( pArray );
818 		refVar->SetFlags( nSavFlags );
819 		refVar->SetParameters( NULL );
820 	}
821 }
822 
823 // REDIM
824 // TOS  = Variable fuer das Array
825 // argv = Dimensionsangaben
826 
StepREDIM()827 void SbiRuntime::StepREDIM()
828 {
829 	// Im Moment ist es nichts anderes als Dim, da doppeltes Dim
830 	// bereits vom Compiler erkannt wird.
831 	StepDIM();
832 }
833 
834 
835 // Helper function for StepREDIMP
implCopyDimArray(SbxDimArray * pNewArray,SbxDimArray * pOldArray,short nMaxDimIndex,short nActualDim,sal_Int32 * pActualIndices,sal_Int32 * pLowerBounds,sal_Int32 * pUpperBounds)836 void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
837 	short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
838 {
839 	sal_Int32& ri = pActualIndices[nActualDim];
840 	for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
841 	{
842 		if( nActualDim < nMaxDimIndex )
843 		{
844 			implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
845 				pActualIndices, pLowerBounds, pUpperBounds );
846 		}
847 		else
848 		{
849 			SbxVariable* pSource = pOldArray->Get32( pActualIndices );
850 			SbxVariable* pDest   = pNewArray->Get32( pActualIndices );
851 			if( pSource && pDest )
852 				*pDest = *pSource;
853 		}
854 	}
855 }
856 
857 // REDIM PRESERVE
858 // TOS  = Variable fuer das Array
859 // argv = Dimensionsangaben
860 
StepREDIMP()861 void SbiRuntime::StepREDIMP()
862 {
863 	SbxVariableRef refVar = PopVar();
864 	DimImpl( refVar );
865 
866 	// Now check, if we can copy from the old array
867 	if( refRedimpArray.Is() )
868 	{
869 		SbxBase* pElemObj = refVar->GetObject();
870 		SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
871 		SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
872 		if( pNewArray )
873 		{
874 			short nDimsNew = pNewArray->GetDims();
875 			short nDimsOld = pOldArray->GetDims();
876 			short nDims = nDimsNew;
877 			sal_Bool bRangeError = sal_False;
878 
879 			// Store dims to use them for copying later
880 			sal_Int32* pLowerBounds = new sal_Int32[nDims];
881 			sal_Int32* pUpperBounds = new sal_Int32[nDims];
882 			sal_Int32* pActualIndices = new sal_Int32[nDims];
883 
884 			if( nDimsOld != nDimsNew )
885 			{
886 				bRangeError = sal_True;
887 			}
888 			else
889 			{
890 				// Compare bounds
891 				for( short i = 1 ; i <= nDims ; i++ )
892 				{
893 					sal_Int32 lBoundNew, uBoundNew;
894 					sal_Int32 lBoundOld, uBoundOld;
895 					pNewArray->GetDim32( i, lBoundNew, uBoundNew );
896 					pOldArray->GetDim32( i, lBoundOld, uBoundOld );
897 
898                     /* #69094 Allow all dimensions to be changed
899                        although Visual Basic is not able to do so.
900 					// All bounds but the last have to be the same
901 					if( i < nDims && ( lBoundNew != lBoundOld || uBoundNew != uBoundOld ) )
902 					{
903 						bRangeError = sal_True;
904 						break;
905 					}
906 					else
907                     */
908 					{
909 						// #69094: if( i == nDims )
910 						{
911 							lBoundNew = std::max( lBoundNew, lBoundOld );
912 							uBoundNew = std::min( uBoundNew, uBoundOld );
913 						}
914 						short j = i - 1;
915 						pActualIndices[j] = pLowerBounds[j] = lBoundNew;
916 						pUpperBounds[j] = uBoundNew;
917 					}
918 				}
919 			}
920 
921 			if( bRangeError )
922 			{
923 				StarBASIC::Error( SbERR_OUT_OF_RANGE );
924 			}
925 			else
926 			{
927 				// Copy data from old array by going recursively through all dimensions
928 				// (It would be faster to work on the flat internal data array of an
929 				// SbyArray but this solution is clearer and easier)
930 				implCopyDimArray( pNewArray, pOldArray, nDims - 1,
931 					0, pActualIndices, pLowerBounds, pUpperBounds );
932 			}
933 
934 			delete[] pUpperBounds;
935 			delete[] pLowerBounds;
936 			delete[] pActualIndices;
937 			refRedimpArray = NULL;
938 		}
939 	}
940 
941 	//StarBASIC::FatalError( SbERR_NOT_IMPLEMENTED );
942 }
943 
944 // REDIM_COPY
945 // TOS  = Array-Variable, Reference to array is copied
946 //		  Variable is cleared as in ERASE
947 
StepREDIMP_ERASE()948 void SbiRuntime::StepREDIMP_ERASE()
949 {
950 	SbxVariableRef refVar = PopVar();
951 	SbxDataType eType = refVar->GetType();
952 	if( eType & SbxARRAY )
953 	{
954 		SbxBase* pElemObj = refVar->GetObject();
955 		SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
956 		if( pDimArray )
957 		{
958 			refRedimpArray = pDimArray;
959 		}
960 
961 		// As in ERASE
962 		sal_uInt16 nSavFlags = refVar->GetFlags();
963 		refVar->ResetFlag( SBX_FIXED );
964 		refVar->SetType( SbxDataType(eType & 0x0FFF) );
965 		refVar->SetFlags( nSavFlags );
966 		refVar->Clear();
967 	}
968 	else
969 	if( refVar->IsFixed() )
970 		refVar->Clear();
971 	else
972 		refVar->SetType( SbxEMPTY );
973 }
974 
lcl_clearImpl(SbxVariableRef & refVar,SbxDataType & eType)975 void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
976 {
977 	sal_uInt16 nSavFlags = refVar->GetFlags();
978 	refVar->ResetFlag( SBX_FIXED );
979 	refVar->SetType( SbxDataType(eType & 0x0FFF) );
980 	refVar->SetFlags( nSavFlags );
981 	refVar->Clear();
982 }
983 
lcl_eraseImpl(SbxVariableRef & refVar,bool bVBAEnabled)984 void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
985 {
986 	SbxDataType eType = refVar->GetType();
987 	if( eType & SbxARRAY )
988 	{
989 		if ( bVBAEnabled )
990 		{
991 			SbxBase* pElemObj = refVar->GetObject();
992 			SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
993 			bool bClearValues = true;
994 			if( pDimArray )
995 			{
996 				if ( pDimArray->hasFixedSize() )
997 				{
998 					// Clear all Value(s)
999 					pDimArray->SbxArray::Clear();
1000 					bClearValues = false;
1001 				}
1002 				else
1003 					pDimArray->Clear(); // clear Dims
1004 			}
1005 			if ( bClearValues )
1006 			{
1007 				SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
1008 				if ( pArray )
1009 					pArray->Clear();
1010 			}
1011 		}
1012 		else
1013 		// AB 2.4.1996
1014 		// Arrays haben bei Erase nach VB ein recht komplexes Verhalten. Hier
1015 		// werden zunaechst nur die Typ-Probleme bei REDIM (#26295) beseitigt:
1016 		// Typ hart auf den Array-Typ setzen, da eine Variable mit Array
1017 		// SbxOBJECT ist. Bei REDIM entsteht dann ein SbxOBJECT-Array und
1018 		// der ursruengliche Typ geht verloren -> Laufzeitfehler
1019 			lcl_clearImpl( refVar, eType );
1020 	}
1021 	else
1022 	if( refVar->IsFixed() )
1023 		refVar->Clear();
1024 	else
1025 		refVar->SetType( SbxEMPTY );
1026 }
1027 
1028 // Variable loeschen
1029 // TOS = Variable
1030 
StepERASE()1031 void SbiRuntime::StepERASE()
1032 {
1033 	SbxVariableRef refVar = PopVar();
1034 	lcl_eraseImpl( refVar, bVBAEnabled );
1035 }
1036 
StepERASE_CLEAR()1037 void SbiRuntime::StepERASE_CLEAR()
1038 {
1039 	SbxVariableRef refVar = PopVar();
1040 	lcl_eraseImpl( refVar, bVBAEnabled );
1041 	SbxDataType eType = refVar->GetType();
1042 	lcl_clearImpl( refVar, eType );
1043 }
1044 
StepARRAYACCESS()1045 void SbiRuntime::StepARRAYACCESS()
1046 {
1047 	if( !refArgv )
1048 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1049     SbxVariableRef refVar = PopVar();
1050 	refVar->SetParameters( refArgv );
1051 	PopArgv();
1052 	PushVar( CheckArray( refVar ) );
1053 }
1054 
StepBYVAL()1055 void SbiRuntime::StepBYVAL()
1056 {
1057 	// Copy variable on stack to break call by reference
1058 	SbxVariableRef pVar = PopVar();
1059 	SbxDataType t = pVar->GetType();
1060 
1061 	SbxVariable* pCopyVar = new SbxVariable( t );
1062 	pCopyVar->SetFlag( SBX_READWRITE );
1063 	*pCopyVar = *pVar;
1064 
1065 	PushVar( pCopyVar );
1066 }
1067 
1068 // Einrichten eines Argvs
1069 // nOp1 bleibt so -> 1. Element ist Returnwert
1070 
StepARGC()1071 void SbiRuntime::StepARGC()
1072 {
1073 	PushArgv();
1074 	refArgv = new SbxArray;
1075 	nArgc = 1;
1076 }
1077 
1078 // Speichern eines Arguments in Argv
1079 
StepARGV()1080 void SbiRuntime::StepARGV()
1081 {
1082 	if( !refArgv )
1083 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1084 	else
1085 	{
1086 		SbxVariableRef pVal = PopVar();
1087 
1088 		// Before fix of #94916:
1089 		// if( pVal->ISA(SbxMethod) || pVal->ISA(SbxProperty) )
1090 		if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
1091 		{
1092 			// Methoden und Properties evaluieren!
1093 			SbxVariable* pRes = new SbxVariable( *pVal );
1094 			pVal = pRes;
1095 		}
1096 		refArgv->Put( pVal, nArgc++ );
1097 	}
1098 }
1099 
1100 // Input to Variable. Die Variable ist auf TOS und wird
1101 // anschliessend entfernt.
1102 
StepINPUT()1103 void SbiRuntime::StepINPUT()
1104 {
1105 	String s;
1106 	char ch = 0;
1107 	SbError err;
1108 	// Skip whitespace
1109 	while( ( err = pIosys->GetError() ) == 0 )
1110 	{
1111 		ch = pIosys->Read();
1112 		if( ch != ' ' && ch != '\t' && ch != '\n' )
1113 			break;
1114 	}
1115 	if( !err )
1116 	{
1117 		// Scan until comma or whitespace
1118 		char sep = ( ch == '"' ) ? ch : 0;
1119 		if( sep ) ch = pIosys->Read();
1120 		while( ( err = pIosys->GetError() ) == 0 )
1121 		{
1122 			if( ch == sep )
1123 			{
1124 				ch = pIosys->Read();
1125 				if( ch != sep )
1126 					break;
1127 			}
1128 			else if( !sep && (ch == ',' || ch == '\n') )
1129 				break;
1130 			s += ch;
1131 			ch = pIosys->Read();
1132 		}
1133 		// skip whitespace
1134 		if( ch == ' ' || ch == '\t' )
1135 		  while( ( err = pIosys->GetError() ) == 0 )
1136 		{
1137 			if( ch != ' ' && ch != '\t' && ch != '\n' )
1138 				break;
1139 			ch = pIosys->Read();
1140 		}
1141 	}
1142 	if( !err )
1143 	{
1144 		SbxVariableRef pVar = GetTOS();
1145 		// Zuerst versuchen, die Variable mit einem numerischen Wert
1146 		// zu fuellen, dann mit einem Stringwert
1147 		if( !pVar->IsFixed() || pVar->IsNumeric() )
1148 		{
1149 			sal_uInt16 nLen = 0;
1150 			if( !pVar->Scan( s, &nLen ) )
1151 			{
1152 				err = SbxBase::GetError();
1153 				SbxBase::ResetError();
1154 			}
1155 			// Der Wert muss komplett eingescant werden
1156 			else if( nLen != s.Len() && !pVar->PutString( s ) )
1157 			{
1158 				err = SbxBase::GetError();
1159 				SbxBase::ResetError();
1160 			}
1161 			else if( nLen != s.Len() && pVar->IsNumeric() )
1162 			{
1163 				err = SbxBase::GetError();
1164 				SbxBase::ResetError();
1165 				if( !err )
1166 					err = SbERR_CONVERSION;
1167 			}
1168 		}
1169 		else
1170 		{
1171 			pVar->PutString( s );
1172 			err = SbxBase::GetError();
1173 			SbxBase::ResetError();
1174 		}
1175 	}
1176 	if( err == SbERR_USER_ABORT )
1177 		Error( err );
1178 	else if( err )
1179 	{
1180 		if( pRestart && !pIosys->GetChannel() )
1181 		{
1182 			BasResId aId( IDS_SBERR_START + 4 );
1183 			String aMsg( aId );
1184 
1185             //****** DON'T CHECK IN, TEST ONLY *******
1186             //****** DON'T CHECK IN, TEST ONLY *******
1187 			// ErrorBox( NULL, WB_OK, aMsg ).Execute();
1188             //****** DON'T CHECK IN, TEST ONLY *******
1189             //****** DON'T CHECK IN, TEST ONLY *******
1190 
1191 			pCode = pRestart;
1192 		}
1193 		else
1194 			Error( err );
1195 	}
1196 	else
1197 	{
1198 		// pIosys->ResetChannel();
1199 		PopVar();
1200 	}
1201 }
1202 
1203 // Line Input to Variable. Die Variable ist auf TOS und wird
1204 // anschliessend entfernt.
1205 
StepLINPUT()1206 void SbiRuntime::StepLINPUT()
1207 {
1208 	ByteString aInput;
1209 	pIosys->Read( aInput );
1210 	Error( pIosys->GetError() );
1211 	SbxVariableRef p = PopVar();
1212 	p->PutString( String( aInput, gsl_getSystemTextEncoding() ) );
1213 	// pIosys->ResetChannel();
1214 }
1215 
1216 // Programmende
1217 
StepSTOP()1218 void SbiRuntime::StepSTOP()
1219 {
1220 	pInst->Stop();
1221 }
1222 
1223 // FOR-Variable initialisieren
1224 
StepINITFOR()1225 void SbiRuntime::StepINITFOR()
1226 {
1227 	PushFor();
1228 }
1229 
StepINITFOREACH()1230 void SbiRuntime::StepINITFOREACH()
1231 {
1232 	PushForEach();
1233 }
1234 
1235 // FOR-Variable inkrementieren
1236 
StepNEXT()1237 void SbiRuntime::StepNEXT()
1238 {
1239 	if( !pForStk )
1240 	{
1241 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1242 		return;
1243 	}
1244 	if( pForStk->eForType == FOR_TO )
1245 		pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
1246 }
1247 
1248 // Anfang CASE: TOS in CASE-Stack
1249 
StepCASE()1250 void SbiRuntime::StepCASE()
1251 {
1252 	if( !refCaseStk.Is() )
1253 		refCaseStk = new SbxArray;
1254 	SbxVariableRef xVar = PopVar();
1255 	refCaseStk->Put( xVar, refCaseStk->Count() );
1256 }
1257 
1258 // Ende CASE: Variable freigeben
1259 
StepENDCASE()1260 void SbiRuntime::StepENDCASE()
1261 {
1262 	if( !refCaseStk || !refCaseStk->Count() )
1263 		StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1264 	else
1265 		refCaseStk->Remove( refCaseStk->Count() - 1 );
1266 }
1267 
1268 // Standard-Fehlerbehandlung
1269 
StepSTDERROR()1270 void SbiRuntime::StepSTDERROR()
1271 {
1272 	pError = NULL; bError = sal_True;
1273 	pInst->aErrorMsg = String();
1274 	pInst->nErr = 0L;
1275 	pInst->nErl = 0;
1276 	nError = 0L;
1277 	SbxErrObject::getUnoErrObject()->Clear();
1278 }
1279 
StepNOERROR()1280 void SbiRuntime::StepNOERROR()
1281 {
1282 	pInst->aErrorMsg = String();
1283 	pInst->nErr = 0L;
1284 	pInst->nErl = 0;
1285 	nError = 0L;
1286 	SbxErrObject::getUnoErrObject()->Clear();
1287 	bError = sal_False;
1288 }
1289 
1290 // UP verlassen
1291 
StepLEAVE()1292 void SbiRuntime::StepLEAVE()
1293 {
1294 	bRun = sal_False;
1295         // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
1296 	if ( bInError && pError )
1297 	    SbxErrObject::getUnoErrObject()->Clear();
1298 }
1299 
StepCHANNEL()1300 void SbiRuntime::StepCHANNEL()	  	// TOS = Kanalnummer
1301 {
1302 	SbxVariableRef pChan = PopVar();
1303 	short nChan = pChan->GetInteger();
1304 	pIosys->SetChannel( nChan );
1305 	Error( pIosys->GetError() );
1306 }
1307 
StepCHANNEL0()1308 void SbiRuntime::StepCHANNEL0()
1309 {
1310 	pIosys->ResetChannel();
1311 }
1312 
StepPRINT()1313 void SbiRuntime::StepPRINT()	  	// print TOS
1314 {
1315 	SbxVariableRef p = PopVar();
1316 	String s1 = p->GetString();
1317 	String s;
1318 	if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
1319 		s = ' ';	// ein Blank davor
1320 	s += s1;
1321 	ByteString aByteStr( s, gsl_getSystemTextEncoding() );
1322 	pIosys->Write( aByteStr );
1323 	Error( pIosys->GetError() );
1324 }
1325 
StepPRINTF()1326 void SbiRuntime::StepPRINTF()	  	// print TOS in field
1327 {
1328 	SbxVariableRef p = PopVar();
1329 	String s1 = p->GetString();
1330 	String s;
1331 	if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
1332 		s = ' ';	// ein Blank davor
1333 	s += s1;
1334 	s.Expand( 14, ' ' );
1335 	ByteString aByteStr( s, gsl_getSystemTextEncoding() );
1336 	pIosys->Write( aByteStr );
1337 	Error( pIosys->GetError() );
1338 }
1339 
StepWRITE()1340 void SbiRuntime::StepWRITE()	  	// write TOS
1341 {
1342 	SbxVariableRef p = PopVar();
1343 	// Muss der String gekapselt werden?
1344 	char ch = 0;
1345 	switch (p->GetType() )
1346 	{
1347 		case SbxSTRING: ch = '"'; break;
1348 		case SbxCURRENCY:
1349 		case SbxBOOL:
1350 		case SbxDATE: ch = '#'; break;
1351 		default: break;
1352 	}
1353 	String s;
1354 	if( ch )
1355 		s += ch;
1356 	s += p->GetString();
1357 	if( ch )
1358 		s += ch;
1359 	ByteString aByteStr( s, gsl_getSystemTextEncoding() );
1360 	pIosys->Write( aByteStr );
1361 	Error( pIosys->GetError() );
1362 }
1363 
StepRENAME()1364 void SbiRuntime::StepRENAME()	  	// Rename Tos+1 to Tos
1365 {
1366 	SbxVariableRef pTos1 = PopVar();
1367 	SbxVariableRef pTos  = PopVar();
1368 	String aDest = pTos1->GetString();
1369 	String aSource = pTos->GetString();
1370 
1371 	// <-- UCB
1372 	if( hasUno() )
1373 	{
1374 		implStepRenameUCB( aSource, aDest );
1375 	}
1376 	else
1377 	// --> UCB
1378 	{
1379 #ifdef _OLD_FILE_IMPL
1380 		DirEntry aSourceDirEntry( aSource );
1381 		if( aSourceDirEntry.Exists() )
1382 		{
1383 			if( aSourceDirEntry.MoveTo( DirEntry(aDest) ) != FSYS_ERR_OK )
1384 				StarBASIC::Error( SbERR_PATH_NOT_FOUND );
1385 		}
1386 		else
1387 				StarBASIC::Error( SbERR_PATH_NOT_FOUND );
1388 #else
1389 		implStepRenameOSL( aSource, aDest );
1390 #endif
1391 	}
1392 }
1393 
1394 // TOS = Prompt
1395 
StepPROMPT()1396 void SbiRuntime::StepPROMPT()
1397 {
1398 	SbxVariableRef p = PopVar();
1399 	ByteString aStr( p->GetString(), gsl_getSystemTextEncoding() );
1400 	pIosys->SetPrompt( aStr );
1401 }
1402 
1403 // Set Restart point
1404 
StepRESTART()1405 void SbiRuntime::StepRESTART()
1406 {
1407 	pRestart = pCode;
1408 }
1409 
1410 // Leerer Ausdruck auf Stack fuer fehlenden Parameter
1411 
StepEMPTY()1412 void SbiRuntime::StepEMPTY()
1413 {
1414 	// #57915 Die Semantik von StepEMPTY() ist die Repraesentation eines fehlenden
1415 	// Arguments. Dies wird in VB durch ein durch den Wert 448 (SbERR_NAMED_NOT_FOUND)
1416 	// vom Typ Error repraesentiert. StepEmpty jetzt muesste besser StepMISSING()
1417 	// heissen, aber der Name wird der Einfachkeit halber beibehalten.
1418 	SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
1419 	xVar->PutErr( 448 );
1420 	PushVar( xVar );
1421 	// ALT: PushVar( new SbxVariable( SbxEMPTY ) );
1422 }
1423 
1424 // TOS = Fehlercode
1425 
StepERROR()1426 void SbiRuntime::StepERROR()
1427 {
1428 	SbxVariableRef refCode = PopVar();
1429 	sal_uInt16 n = refCode->GetUShort();
1430 	SbError error = StarBASIC::GetSfxFromVBError( n );
1431 	if ( bVBAEnabled )
1432 		pInst->Error( error );
1433 	else
1434 		Error( error );
1435 }
1436 
1437