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