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