1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ 2 /* 3 * This file is part of the LibreOffice project. 4 * 5 * This Source Code Form is subject to the terms of the Mozilla Public 6 * License, v. 2.0. If a copy of the MPL was not distributed with this 7 * file, You can obtain one at http://mozilla.org/MPL/2.0/. 8 * 9 * This file incorporates work covered by the following license notice: 10 * 11 * Licensed to the Apache Software Foundation (ASF) under one or more 12 * contributor license agreements. See the NOTICE file distributed 13 * with this work for additional information regarding copyright 14 * ownership. The ASF licenses this file to you under the Apache 15 * License, Version 2.0 (the "License"); you may not use this file 16 * except in compliance with the License. You may obtain a copy of 17 * the License at http://www.apache.org/licenses/LICENSE-2.0 . 18 */ 19 20 #include <stdlib.h> 21 22 #include <algorithm> 23 #include <string_view> 24 #include <unordered_map> 25 26 #include <com/sun/star/beans/XPropertySet.hpp> 27 #include <com/sun/star/container/XEnumerationAccess.hpp> 28 #include <com/sun/star/container/XIndexAccess.hpp> 29 #include <com/sun/star/script/XDefaultMethod.hpp> 30 #include <com/sun/star/uno/Any.hxx> 31 #include <com/sun/star/util/SearchAlgorithms2.hpp> 32 33 #include <comphelper/processfactory.hxx> 34 #include <comphelper/string.hxx> 35 #include <o3tl/safeint.hxx> 36 #include <sal/log.hxx> 37 38 #include <tools/wldcrd.hxx> 39 #include <tools/diagnose_ex.h> 40 41 #include <vcl/svapp.hxx> 42 #include <vcl/settings.hxx> 43 44 #include <rtl/instance.hxx> 45 #include <rtl/math.hxx> 46 #include <rtl/ustrbuf.hxx> 47 #include <rtl/character.hxx> 48 49 #include <svl/numformat.hxx> 50 #include <svl/zforlist.hxx> 51 52 #include <i18nutil/searchopt.hxx> 53 #include <unotools/syslocale.hxx> 54 #include <unotools/textsearch.hxx> 55 56 #include <basic/sbuno.hxx> 57 58 #include <codegen.hxx> 59 #include "comenumwrapper.hxx" 60 #include "ddectrl.hxx" 61 #include "dllmgr.hxx" 62 #include <errobject.hxx> 63 #include <image.hxx> 64 #include <iosys.hxx> 65 #include <opcodes.hxx> 66 #include <runtime.hxx> 67 #include <sb.hxx> 68 #include <sbintern.hxx> 69 #include <sbprop.hxx> 70 #include <sbunoobj.hxx> 71 #include <basic/codecompletecache.hxx> 72 #include <memory> 73 74 using com::sun::star::uno::Reference; 75 76 using namespace com::sun::star::uno; 77 using namespace com::sun::star::container; 78 using namespace com::sun::star::lang; 79 using namespace com::sun::star::beans; 80 using namespace com::sun::star::script; 81 82 using namespace ::com::sun::star; 83 84 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType ); 85 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled ); 86 87 namespace 88 { 89 class ScopedWritableGuard 90 { 91 public: 92 ScopedWritableGuard(const SbxVariableRef& rVar, bool bMakeWritable) 93 : m_rVar(rVar) 94 , m_bReset(bMakeWritable && !rVar->CanWrite()) 95 { 96 if (m_bReset) 97 { 98 m_rVar->SetFlag(SbxFlagBits::Write); 99 } 100 } 101 ~ScopedWritableGuard() 102 { 103 if (m_bReset) 104 { 105 m_rVar->ResetFlag(SbxFlagBits::Write); 106 } 107 } 108 109 private: 110 SbxVariableRef m_rVar; 111 bool m_bReset; 112 }; 113 } 114 115 bool SbiRuntime::isVBAEnabled() 116 { 117 bool bResult = false; 118 SbiInstance* pInst = GetSbData()->pInst; 119 if ( pInst && GetSbData()->pInst->pRun ) 120 bResult = pInst->pRun->bVBAEnabled; 121 return bResult; 122 } 123 124 void StarBASIC::SetVBAEnabled( bool bEnabled ) 125 { 126 if ( bDocBasic ) 127 { 128 bVBAEnabled = bEnabled; 129 } 130 } 131 132 bool StarBASIC::isVBAEnabled() const 133 { 134 if ( bDocBasic ) 135 { 136 if( SbiRuntime::isVBAEnabled() ) 137 return true; 138 return bVBAEnabled; 139 } 140 return false; 141 } 142 143 struct SbiArgv { // Argv stack: 144 SbxArrayRef refArgv; // Argv 145 short nArgc; // Argc 146 147 SbiArgv(SbxArrayRef const & refArgv_, short nArgc_) : 148 refArgv(refArgv_), 149 nArgc(nArgc_) {} 150 }; 151 152 struct SbiGosub { // GOSUB-Stack: 153 const sal_uInt8* pCode; // Return-Pointer 154 sal_uInt16 nStartForLvl; // #118235: For Level in moment of gosub 155 156 SbiGosub(const sal_uInt8* pCode_, sal_uInt16 nStartForLvl_) : 157 pCode(pCode_), 158 nStartForLvl(nStartForLvl_) {} 159 }; 160 161 const SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // all opcodes without operands 162 &SbiRuntime::StepNOP, 163 &SbiRuntime::StepEXP, 164 &SbiRuntime::StepMUL, 165 &SbiRuntime::StepDIV, 166 &SbiRuntime::StepMOD, 167 &SbiRuntime::StepPLUS, 168 &SbiRuntime::StepMINUS, 169 &SbiRuntime::StepNEG, 170 &SbiRuntime::StepEQ, 171 &SbiRuntime::StepNE, 172 &SbiRuntime::StepLT, 173 &SbiRuntime::StepGT, 174 &SbiRuntime::StepLE, 175 &SbiRuntime::StepGE, 176 &SbiRuntime::StepIDIV, 177 &SbiRuntime::StepAND, 178 &SbiRuntime::StepOR, 179 &SbiRuntime::StepXOR, 180 &SbiRuntime::StepEQV, 181 &SbiRuntime::StepIMP, 182 &SbiRuntime::StepNOT, 183 &SbiRuntime::StepCAT, 184 185 &SbiRuntime::StepLIKE, 186 &SbiRuntime::StepIS, 187 // load/save 188 &SbiRuntime::StepARGC, // establish new Argv 189 &SbiRuntime::StepARGV, // TOS ==> current Argv 190 &SbiRuntime::StepINPUT, // Input ==> TOS 191 &SbiRuntime::StepLINPUT, // Line Input ==> TOS 192 &SbiRuntime::StepGET, // touch TOS 193 &SbiRuntime::StepSET, // save object TOS ==> TOS-1 194 &SbiRuntime::StepPUT, // TOS ==> TOS-1 195 &SbiRuntime::StepPUTC, // TOS ==> TOS-1, then ReadOnly 196 &SbiRuntime::StepDIM, // DIM 197 &SbiRuntime::StepREDIM, // REDIM 198 &SbiRuntime::StepREDIMP, // REDIM PRESERVE 199 &SbiRuntime::StepERASE, // delete TOS 200 // branch 201 &SbiRuntime::StepSTOP, // program end 202 &SbiRuntime::StepINITFOR, // initialize FOR-Variable 203 &SbiRuntime::StepNEXT, // increment FOR-Variable 204 &SbiRuntime::StepCASE, // beginning CASE 205 &SbiRuntime::StepENDCASE, // end CASE 206 &SbiRuntime::StepSTDERROR, // standard error handling 207 &SbiRuntime::StepNOERROR, // no error handling 208 &SbiRuntime::StepLEAVE, // leave UP 209 // E/A 210 &SbiRuntime::StepCHANNEL, // TOS = channel number 211 &SbiRuntime::StepPRINT, // print TOS 212 &SbiRuntime::StepPRINTF, // print TOS in field 213 &SbiRuntime::StepWRITE, // write TOS 214 &SbiRuntime::StepRENAME, // Rename Tos+1 to Tos 215 &SbiRuntime::StepPROMPT, // define Input Prompt from TOS 216 &SbiRuntime::StepRESTART, // Set restart point 217 &SbiRuntime::StepCHANNEL0, // set E/A-channel 0 218 &SbiRuntime::StepEMPTY, // empty expression on stack 219 &SbiRuntime::StepERROR, // TOS = error code 220 &SbiRuntime::StepLSET, // save object TOS ==> TOS-1 221 &SbiRuntime::StepRSET, // save object TOS ==> TOS-1 222 &SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP 223 &SbiRuntime::StepINITFOREACH,// Init for each loop 224 &SbiRuntime::StepVBASET,// vba-like set statement 225 &SbiRuntime::StepERASE_CLEAR,// vba-like set statement 226 &SbiRuntime::StepARRAYACCESS,// access TOS as array 227 &SbiRuntime::StepBYVAL, // access TOS as array 228 }; 229 230 const SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // all opcodes with one operand 231 &SbiRuntime::StepLOADNC, // loading a numeric constant (+ID) 232 &SbiRuntime::StepLOADSC, // loading a string constant (+ID) 233 &SbiRuntime::StepLOADI, // Immediate Load (+value) 234 &SbiRuntime::StepARGN, // save a named Args in Argv (+StringID) 235 &SbiRuntime::StepPAD, // bring string to a definite length (+length) 236 // branches 237 &SbiRuntime::StepJUMP, // jump (+Target) 238 &SbiRuntime::StepJUMPT, // evaluate TOS, conditional jump (+Target) 239 &SbiRuntime::StepJUMPF, // evaluate TOS, conditional jump (+Target) 240 &SbiRuntime::StepONJUMP, // evaluate TOS, jump into JUMP-table (+MaxVal) 241 &SbiRuntime::StepGOSUB, // UP-call (+Target) 242 &SbiRuntime::StepRETURN, // UP-return (+0 or Target) 243 &SbiRuntime::StepTESTFOR, // check FOR-variable, increment (+Endlabel) 244 &SbiRuntime::StepCASETO, // Tos+1 <= Case <= Tos), 2xremove (+Target) 245 &SbiRuntime::StepERRHDL, // error handler (+Offset) 246 &SbiRuntime::StepRESUME, // resume after errors (+0 or 1 or Label) 247 // E/A 248 &SbiRuntime::StepCLOSE, // (+channel/0) 249 &SbiRuntime::StepPRCHAR, // (+char) 250 // management 251 &SbiRuntime::StepSETCLASS, // check set + class names (+StringId) 252 &SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId) 253 &SbiRuntime::StepLIB, // lib for declare-call (+StringId) 254 &SbiRuntime::StepBASED, // TOS is incremented by BASE, BASE is pushed before 255 &SbiRuntime::StepARGTYP, // convert last parameter in Argv (+Type) 256 &SbiRuntime::StepVBASETCLASS,// vba-like set statement 257 }; 258 259 const SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// all opcodes with two operands 260 &SbiRuntime::StepRTL, // load from RTL (+StringID+Typ) 261 &SbiRuntime::StepFIND, // load (+StringID+Typ) 262 &SbiRuntime::StepELEM, // load element (+StringID+Typ) 263 &SbiRuntime::StepPARAM, // Parameter (+Offset+Typ) 264 // branches 265 &SbiRuntime::StepCALL, // Declare-Call (+StringID+Typ) 266 &SbiRuntime::StepCALLC, // CDecl-Declare-Call (+StringID+Typ) 267 &SbiRuntime::StepCASEIS, // Case-Test (+Test-Opcode+False-Target) 268 // management 269 &SbiRuntime::StepSTMNT, // beginning of a statement (+Line+Col) 270 // E/A 271 &SbiRuntime::StepOPEN, // (+StreamMode+Flags) 272 // Objects 273 &SbiRuntime::StepLOCAL, // define local variable (+StringId+Typ) 274 &SbiRuntime::StepPUBLIC, // module global variable (+StringID+Typ) 275 &SbiRuntime::StepGLOBAL, // define global variable (+StringID+Typ) 276 &SbiRuntime::StepCREATE, // create object (+StringId+StringId) 277 &SbiRuntime::StepSTATIC, // static variable (+StringId+StringId) 278 &SbiRuntime::StepTCREATE, // user-defined objects (+StringId+StringId) 279 &SbiRuntime::StepDCREATE, // create object-array (+StringID+StringID) 280 &SbiRuntime::StepGLOBAL_P, // define global variable which is not overwritten 281 // by the Basic on a restart (+StringID+Typ) 282 &SbiRuntime::StepFIND_G, // finds global variable with special treatment because of _GLOBAL_P 283 &SbiRuntime::StepDCREATE_REDIMP, // redimension object array (+StringID+StringID) 284 &SbiRuntime::StepFIND_CM, // Search inside a class module (CM) to enable global search in time 285 &SbiRuntime::StepPUBLIC_P, // Search inside a class module (CM) to enable global search in time 286 &SbiRuntime::StepFIND_STATIC, // Search inside a class module (CM) to enable global search in time 287 }; 288 289 290 // SbiRTLData 291 292 SbiRTLData::SbiRTLData() 293 { 294 nDirFlags = SbAttributes::NONE; 295 nCurDirPos = 0; 296 } 297 298 SbiRTLData::~SbiRTLData() 299 { 300 } 301 302 // SbiInstance 303 304 // 16.10.96: #31460 new concept for StepInto/Over/Out 305 // The decision whether StepPoint shall be called is done with the help of 306 // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl. 307 // The current CallLevel can never be smaller than 1, as it's also incremented 308 // during the call of a method (also main). Therefore a BreakCallLvl from 0 309 // means that the program isn't stopped at all. 310 // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() ) 311 312 313 void SbiInstance::CalcBreakCallLevel( BasicDebugFlags nFlags ) 314 { 315 316 nFlags &= ~BasicDebugFlags::Break; 317 318 sal_uInt16 nRet; 319 if (nFlags == BasicDebugFlags::StepInto) { 320 nRet = nCallLvl + 1; // CallLevel+1 is also stopped 321 } else if (nFlags == (BasicDebugFlags::StepOver | BasicDebugFlags::StepInto)) { 322 nRet = nCallLvl; // current CallLevel is stopped 323 } else if (nFlags == BasicDebugFlags::StepOut) { 324 nRet = nCallLvl - 1; // smaller CallLevel is stopped 325 } else { 326 // Basic-IDE returns 0 instead of BasicDebugFlags::Continue, so also default=continue 327 nRet = 0; // CallLevel is always > 0 -> no StepPoint 328 } 329 nBreakCallLvl = nRet; // take result 330 } 331 332 SbiInstance::SbiInstance( StarBASIC* p ) 333 : pIosys(new SbiIoSystem) 334 , pDdeCtrl(new SbiDdeControl) 335 , pBasic(p) 336 , meFormatterLangType(LANGUAGE_DONTKNOW) 337 , meFormatterDateOrder(DateOrder::YMD) 338 , nStdDateIdx(0) 339 , nStdTimeIdx(0) 340 , nStdDateTimeIdx(0) 341 , nErr(0) 342 , nErl(0) 343 , bReschedule(true) 344 , bCompatibility(false) 345 , pRun(nullptr) 346 , nCallLvl(0) 347 , nBreakCallLvl(0) 348 { 349 } 350 351 SbiInstance::~SbiInstance() 352 { 353 while( pRun ) 354 { 355 SbiRuntime* p = pRun->pNext; 356 delete pRun; 357 pRun = p; 358 } 359 360 try 361 { 362 int nSize = ComponentVector.size(); 363 if( nSize ) 364 { 365 for( int i = nSize - 1 ; i >= 0 ; --i ) 366 { 367 Reference< XComponent > xDlgComponent = ComponentVector[i]; 368 if( xDlgComponent.is() ) 369 xDlgComponent->dispose(); 370 } 371 } 372 } 373 catch( const Exception& ) 374 { 375 TOOLS_WARN_EXCEPTION("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components" ); 376 } 377 } 378 379 SbiDllMgr* SbiInstance::GetDllMgr() 380 { 381 if( !pDllMgr ) 382 { 383 pDllMgr.reset(new SbiDllMgr); 384 } 385 return pDllMgr.get(); 386 } 387 388 // #39629 create NumberFormatter with the help of a static method now 389 std::shared_ptr<SvNumberFormatter> const & SbiInstance::GetNumberFormatter() 390 { 391 LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType(); 392 SvtSysLocale aSysLocale; 393 DateOrder eDate = aSysLocale.GetLocaleData().getDateOrder(); 394 if( pNumberFormatter ) 395 { 396 if( eLangType != meFormatterLangType || 397 eDate != meFormatterDateOrder ) 398 { 399 pNumberFormatter.reset(); 400 } 401 } 402 meFormatterLangType = eLangType; 403 meFormatterDateOrder = eDate; 404 if( !pNumberFormatter ) 405 { 406 pNumberFormatter = PrepareNumberFormatter( nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx, 407 &meFormatterLangType, &meFormatterDateOrder); 408 } 409 return pNumberFormatter; 410 } 411 412 // #39629 offer NumberFormatter static too 413 std::shared_ptr<SvNumberFormatter> SbiInstance::PrepareNumberFormatter( sal_uInt32 &rnStdDateIdx, 414 sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx, 415 LanguageType const * peFormatterLangType, DateOrder const * peFormatterDateOrder ) 416 { 417 LanguageType eLangType; 418 if( peFormatterLangType ) 419 { 420 eLangType = *peFormatterLangType; 421 } 422 else 423 { 424 eLangType = Application::GetSettings().GetLanguageTag().getLanguageType(); 425 } 426 DateOrder eDate; 427 if( peFormatterDateOrder ) 428 { 429 eDate = *peFormatterDateOrder; 430 } 431 else 432 { 433 SvtSysLocale aSysLocale; 434 eDate = aSysLocale.GetLocaleData().getDateOrder(); 435 } 436 437 std::shared_ptr<SvNumberFormatter> pNumberFormatter = 438 std::make_shared<SvNumberFormatter>( comphelper::getProcessComponentContext(), eLangType ); 439 440 // Several parser methods pass SvNumberFormatter::IsNumberFormat() a number 441 // format index to parse against. Tell the formatter the proper date 442 // evaluation order, which also determines the date acceptance patterns to 443 // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the 444 // format's locale's date patterns/order (no init/system locale match 445 // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0) 446 // (or an unknown) format index was passed. 447 pNumberFormatter->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT); 448 449 sal_Int32 nCheckPos = 0; 450 SvNumFormatType nType; 451 rnStdTimeIdx = pNumberFormatter->GetStandardFormat( SvNumFormatType::TIME, eLangType ); 452 453 // the formatter's standard templates have only got a two-digit date 454 // -> registering an own format 455 456 // HACK, because the numberformatter doesn't swap the place holders 457 // for month, day and year according to the system setting. 458 // Problem: Print Year(Date) under engl. BS 459 // also have a look at: basic/source/sbx/sbxdate.cxx 460 461 OUString aDateStr; 462 switch( eDate ) 463 { 464 default: 465 case DateOrder::MDY: aDateStr = "MM/DD/YYYY"; break; 466 case DateOrder::DMY: aDateStr = "DD/MM/YYYY"; break; 467 case DateOrder::YMD: aDateStr = "YYYY/MM/DD"; break; 468 } 469 OUString aStr( aDateStr ); // PutandConvertEntry() modifies string! 470 pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType, 471 rnStdDateIdx, LANGUAGE_ENGLISH_US, eLangType, true); 472 nCheckPos = 0; 473 aDateStr += " HH:MM:SS"; 474 aStr = aDateStr; 475 pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType, 476 rnStdDateTimeIdx, LANGUAGE_ENGLISH_US, eLangType, true); 477 return pNumberFormatter; 478 } 479 480 481 // Let engine run. If Flags == BasicDebugFlags::Continue, take Flags over 482 483 void SbiInstance::Stop() 484 { 485 for( SbiRuntime* p = pRun; p; p = p->pNext ) 486 { 487 p->Stop(); 488 } 489 } 490 491 // Allows Basic IDE to set watch mode to suppress errors 492 static bool bWatchMode = false; 493 494 void setBasicWatchMode( bool bOn ) 495 { 496 bWatchMode = bOn; 497 } 498 499 void SbiInstance::Error( ErrCode n ) 500 { 501 Error( n, OUString() ); 502 } 503 504 void SbiInstance::Error( ErrCode n, const OUString& rMsg ) 505 { 506 if( !bWatchMode ) 507 { 508 aErrorMsg = rMsg; 509 pRun->Error( n ); 510 } 511 } 512 513 void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const OUString& rMsg ) 514 { 515 if( !bWatchMode ) 516 { 517 ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) ); 518 if ( !n ) 519 { 520 n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors 521 } 522 aErrorMsg = rMsg; 523 SbiRuntime::translateErrorToVba( n, aErrorMsg ); 524 525 pRun->Error( ERRCODE_BASIC_COMPAT, true/*bVBATranslationAlreadyDone*/ ); 526 } 527 } 528 529 void SbiInstance::setErrorVB( sal_Int32 nVBNumber ) 530 { 531 ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) ); 532 if( !n ) 533 { 534 n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors 535 } 536 aErrorMsg = OUString(); 537 SbiRuntime::translateErrorToVba( n, aErrorMsg ); 538 539 nErr = n; 540 } 541 542 543 void SbiInstance::FatalError( ErrCode n ) 544 { 545 pRun->FatalError( n ); 546 } 547 548 void SbiInstance::FatalError( ErrCode _errCode, const OUString& _details ) 549 { 550 pRun->FatalError( _errCode, _details ); 551 } 552 553 void SbiInstance::Abort() 554 { 555 StarBASIC* pErrBasic = GetCurrentBasic( pBasic ); 556 pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 ); 557 StarBASIC::Stop(); 558 } 559 560 // can be unequal to pRTBasic 561 StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic ) 562 { 563 StarBASIC* pCurBasic = pRTBasic; 564 SbModule* pActiveModule = StarBASIC::GetActiveModule(); 565 if( pActiveModule ) 566 { 567 SbxObject* pParent = pActiveModule->GetParent(); 568 if (StarBASIC *pBasic = dynamic_cast<StarBASIC*>(pParent)) 569 pCurBasic = pBasic; 570 } 571 return pCurBasic; 572 } 573 574 SbModule* SbiInstance::GetActiveModule() 575 { 576 if( pRun ) 577 { 578 return pRun->GetModule(); 579 } 580 else 581 { 582 return nullptr; 583 } 584 } 585 586 SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel ) 587 { 588 SbiRuntime* p = pRun; 589 while( nLevel-- && p ) 590 { 591 p = p->pNext; 592 } 593 return p ? p->GetCaller() : nullptr; 594 } 595 596 // SbiInstance 597 598 // Attention: pMeth can also be NULL (on a call of the init-code) 599 600 SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart ) 601 : rBasic( *static_cast<StarBASIC*>(pm->pParent) ), pInst( GetSbData()->pInst ), 602 pMod( pm ), pMeth( pe ), pImg( pMod->pImage.get() ), mpExtCaller(nullptr), m_nLastTime(0) 603 { 604 nFlags = pe ? pe->GetDebugFlags() : BasicDebugFlags::NONE; 605 pIosys = pInst->GetIoSystem(); 606 pForStk = nullptr; 607 pError = nullptr; 608 pErrCode = 609 pErrStmnt = 610 pRestart = nullptr; 611 pNext = nullptr; 612 pCode = 613 pStmnt = pImg->GetCode() + nStart; 614 bRun = 615 bError = true; 616 bInError = false; 617 bBlocked = false; 618 nLine = 0; 619 nCol1 = 0; 620 nCol2 = 0; 621 nExprLvl = 0; 622 nArgc = 0; 623 nError = ERRCODE_NONE; 624 nForLvl = 0; 625 nOps = 0; 626 refExprStk = new SbxArray; 627 SetVBAEnabled( pMod->IsVBACompat() ); 628 SetParameters( pe ? pe->GetParameters() : nullptr ); 629 } 630 631 SbiRuntime::~SbiRuntime() 632 { 633 ClearArgvStack(); 634 ClearForStack(); 635 } 636 637 void SbiRuntime::SetVBAEnabled(bool bEnabled ) 638 { 639 bVBAEnabled = bEnabled; 640 if ( bVBAEnabled ) 641 { 642 if ( pMeth ) 643 { 644 mpExtCaller = pMeth->mCaller; 645 } 646 } 647 else 648 { 649 mpExtCaller = nullptr; 650 } 651 } 652 653 // tdf#79426, tdf#125180 - adds the information about a missing parameter 654 void SbiRuntime::SetIsMissing( SbxVariable* pVar ) 655 { 656 SbxInfo* pInfo = pVar->GetInfo() ? pVar->GetInfo() : new SbxInfo(); 657 pInfo->AddParam( pVar->GetName(), SbxMISSING, pVar->GetFlags() ); 658 pVar->SetInfo( pInfo ); 659 } 660 661 // tdf#79426, tdf#125180 - checks if a variable contains the information about a missing parameter 662 bool SbiRuntime::IsMissing( SbxVariable* pVar, sal_uInt16 nIdx ) 663 { 664 return pVar->GetInfo() && pVar->GetInfo()->GetParam( nIdx ) && pVar->GetInfo()->GetParam( nIdx )->eType & SbxMISSING; 665 } 666 667 // Construction of the parameter list. All ByRef-parameters are directly 668 // taken over; copies of ByVal-parameters are created. If a particular 669 // data type is requested, it is converted. 670 671 void SbiRuntime::SetParameters( SbxArray* pParams ) 672 { 673 refParams = new SbxArray; 674 // for the return value 675 refParams->Put(pMeth, 0); 676 677 SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : nullptr; 678 sal_uInt32 nParamCount = pParams ? pParams->Count() : 1; 679 assert(nParamCount <= std::numeric_limits<sal_uInt16>::max()); 680 if( nParamCount > 1 ) 681 { 682 for( sal_uInt32 i = 1 ; i < nParamCount ; i++ ) 683 { 684 const SbxParamInfo* p = pInfo ? pInfo->GetParam( sal::static_int_cast<sal_uInt16>(i) ) : nullptr; 685 686 // #111897 ParamArray 687 if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 ) 688 { 689 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); 690 sal_uInt32 nParamArrayParamCount = nParamCount - i; 691 pArray->unoAddDim(0, nParamArrayParamCount - 1); 692 for (sal_uInt32 j = i; j < nParamCount ; ++j) 693 { 694 SbxVariable* v = pParams->Get(j); 695 sal_Int32 aDimIndex[1]; 696 aDimIndex[0] = j - i; 697 pArray->Put(v, aDimIndex); 698 } 699 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT ); 700 pArrayVar->SetFlag( SbxFlagBits::ReadWrite ); 701 pArrayVar->PutObject( pArray ); 702 refParams->Put(pArrayVar, i); 703 704 // Block ParamArray for missing parameter 705 pInfo = nullptr; 706 break; 707 } 708 709 SbxVariable* v = pParams->Get(i); 710 // methods are always byval! 711 bool bByVal = dynamic_cast<const SbxMethod *>(v) != nullptr; 712 SbxDataType t = v->GetType(); 713 bool bTargetTypeIsArray = false; 714 if( p ) 715 { 716 bByVal |= ( p->eType & SbxBYREF ) == 0; 717 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type 718 if ( !IsMissing( v, 1 ) ) 719 { 720 t = static_cast<SbxDataType>( p->eType & 0x0FFF ); 721 } 722 723 if( !bByVal && t != SbxVARIANT && 724 (!v->IsFixed() || static_cast<SbxDataType>(v->GetType() & 0x0FFF ) != t) ) 725 { 726 bByVal = true; 727 } 728 729 bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0; 730 } 731 if( bByVal ) 732 { 733 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type 734 if( bTargetTypeIsArray && !IsMissing( v, 1 ) ) 735 { 736 t = SbxOBJECT; 737 } 738 SbxVariable* v2 = new SbxVariable( t ); 739 v2->SetFlag( SbxFlagBits::ReadWrite ); 740 // tdf#79426, tdf#125180 - if parameter was missing, readd additional information about a missing parameter 741 if ( IsMissing( v, 1 ) ) 742 { 743 SetIsMissing( v2 ); 744 } 745 *v2 = *v; 746 refParams->Put(v2, i); 747 } 748 else 749 { 750 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type 751 if( t != SbxVARIANT && !IsMissing( v, 1 ) && t != ( v->GetType() & 0x0FFF ) ) 752 { 753 if( p && (p->eType & SbxARRAY) ) 754 { 755 Error( ERRCODE_BASIC_CONVERSION ); 756 } 757 else 758 { 759 v->Convert( t ); 760 } 761 } 762 refParams->Put(v, i); 763 } 764 if( p ) 765 { 766 refParams->PutAlias(p->aName, i); 767 } 768 } 769 } 770 771 // ParamArray for missing parameter 772 if( !pInfo ) 773 return; 774 775 // #111897 Check first missing parameter for ParamArray 776 const SbxParamInfo* p = pInfo->GetParam(sal::static_int_cast<sal_uInt16>(nParamCount)); 777 if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 ) 778 { 779 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); 780 pArray->unoAddDim(0, -1); 781 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT ); 782 pArrayVar->SetFlag( SbxFlagBits::ReadWrite ); 783 pArrayVar->PutObject( pArray ); 784 refParams->Put(pArrayVar, nParamCount); 785 } 786 } 787 788 789 // execute a P-Code 790 791 bool SbiRuntime::Step() 792 { 793 if( bRun ) 794 { 795 // in any case check casually! 796 if( !( ++nOps & 0xF ) && pInst->IsReschedule() ) 797 { 798 sal_uInt32 nTime = osl_getGlobalTimer(); 799 if (nTime - m_nLastTime > 5 ) // 20 ms 800 { 801 Application::Reschedule(); 802 m_nLastTime = nTime; 803 } 804 } 805 806 // #i48868 blocked by next call level? 807 while( bBlocked ) 808 { 809 if( pInst->IsReschedule() ) 810 { 811 Application::Reschedule(); 812 } 813 } 814 815 SbiOpcode eOp = static_cast<SbiOpcode>( *pCode++ ); 816 sal_uInt32 nOp1; 817 if (eOp <= SbiOpcode::SbOP0_END) 818 { 819 (this->*( aStep0[ int(eOp) ] ) )(); 820 } 821 else if (eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END) 822 { 823 nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24; 824 825 (this->*( aStep1[ int(eOp) - int(SbiOpcode::SbOP1_START) ] ) )( nOp1 ); 826 } 827 else if (eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END) 828 { 829 nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24; 830 sal_uInt32 nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24; 831 (this->*( aStep2[ int(eOp) - int(SbiOpcode::SbOP2_START) ] ) )( nOp1, nOp2 ); 832 } 833 else 834 { 835 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 836 } 837 838 ErrCode nErrCode = SbxBase::GetError(); 839 Error( nErrCode.IgnoreWarning() ); 840 841 // from 13.2.1997, new error handling: 842 // ATTENTION: nError can be set already even if !nErrCode 843 // since nError can now also be set from other RT-instances 844 845 if( nError ) 846 { 847 SbxBase::ResetError(); 848 } 849 850 // from 15.3.96: display errors only if BASIC is still active 851 // (especially not after compiler errors at the runtime) 852 if( nError && bRun ) 853 { 854 ErrCode err = nError; 855 ClearExprStack(); 856 nError = ERRCODE_NONE; 857 pInst->nErr = err; 858 pInst->nErl = nLine; 859 pErrCode = pCode; 860 pErrStmnt = pStmnt; 861 // An error occurred in an error handler 862 // force parent handler ( if there is one ) 863 // to handle the error 864 bool bLetParentHandleThis = false; 865 866 // in the error handler? so std-error 867 if ( !bInError ) 868 { 869 bInError = true; 870 871 if( !bError ) // On Error Resume Next 872 { 873 StepRESUME( 1 ); 874 } 875 else if( pError ) // On Error Goto ... 876 { 877 pCode = pError; 878 } 879 else 880 { 881 bLetParentHandleThis = true; 882 } 883 } 884 else 885 { 886 bLetParentHandleThis = true; 887 pError = nullptr; //terminate the handler 888 } 889 if ( bLetParentHandleThis ) 890 { 891 // from 13.2.1997, new error handling: 892 // consider superior error handlers 893 894 // there's no error handler -> find one farther above 895 SbiRuntime* pRtErrHdl = nullptr; 896 SbiRuntime* pRt = this; 897 while( (pRt = pRt->pNext) != nullptr ) 898 { 899 if( !pRt->bError || pRt->pError != nullptr ) 900 { 901 pRtErrHdl = pRt; 902 break; 903 } 904 } 905 906 907 if( pRtErrHdl ) 908 { 909 // manipulate all the RTs that are below in the call-stack 910 pRt = this; 911 do 912 { 913 pRt->nError = err; 914 if( pRt != pRtErrHdl ) 915 { 916 pRt->bRun = false; 917 } 918 else 919 { 920 break; 921 } 922 pRt = pRt->pNext; 923 } 924 while( pRt ); 925 } 926 // no error-hdl found -> old behaviour 927 else 928 { 929 pInst->Abort(); 930 } 931 } 932 } 933 } 934 return bRun; 935 } 936 937 void SbiRuntime::Error( ErrCode n, bool bVBATranslationAlreadyDone ) 938 { 939 if( !n ) 940 return; 941 942 nError = n; 943 if( !isVBAEnabled() || bVBATranslationAlreadyDone ) 944 return; 945 946 OUString aMsg = pInst->GetErrorMsg(); 947 sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg ); 948 SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject().get(); 949 SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar ); 950 if( pGlobErr != nullptr ) 951 { 952 pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg ); 953 } 954 pInst->aErrorMsg = aMsg; 955 nError = ERRCODE_BASIC_COMPAT; 956 } 957 958 void SbiRuntime::Error( ErrCode _errCode, const OUString& _details ) 959 { 960 if ( !_errCode ) 961 return; 962 963 // Not correct for class module usage, remove for now 964 //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" ); 965 if ( pInst->pRun == this ) 966 { 967 pInst->Error( _errCode, _details ); 968 //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" ); 969 } 970 else 971 { 972 nError = _errCode; 973 } 974 } 975 976 void SbiRuntime::FatalError( ErrCode n ) 977 { 978 StepSTDERROR(); 979 Error( n ); 980 } 981 982 void SbiRuntime::FatalError( ErrCode _errCode, const OUString& _details ) 983 { 984 StepSTDERROR(); 985 Error( _errCode, _details ); 986 } 987 988 sal_Int32 SbiRuntime::translateErrorToVba( ErrCode nError, OUString& rMsg ) 989 { 990 // If a message is defined use that ( in preference to 991 // the defined one for the error ) NB #TODO 992 // if there is an error defined it more than likely 993 // is not the one you want ( some are the same though ) 994 // we really need a new vba compatible error list 995 // tdf#123144 - always translate an error number to a vba error message 996 StarBASIC::MakeErrorText( nError, rMsg ); 997 rMsg = StarBASIC::GetErrorText(); 998 // no num? most likely then it *is* really a vba err 999 sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError ); 1000 sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? sal_uInt32(nError) : nVBErrorCode; 1001 return nVBAErrorNumber; 1002 } 1003 1004 // Stacks 1005 1006 // The expression-stack is available for the continuous evaluation 1007 // of expressions. 1008 1009 void SbiRuntime::PushVar( SbxVariable* pVar ) 1010 { 1011 if( pVar ) 1012 { 1013 refExprStk->Put(pVar, nExprLvl++); 1014 } 1015 } 1016 1017 SbxVariableRef SbiRuntime::PopVar() 1018 { 1019 #ifdef DBG_UTIL 1020 if( !nExprLvl ) 1021 { 1022 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 1023 return new SbxVariable; 1024 } 1025 #endif 1026 SbxVariableRef xVar = refExprStk->Get(--nExprLvl); 1027 SAL_INFO_IF( xVar->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" ); 1028 // methods hold themselves in parameter 0 1029 if( dynamic_cast<const SbxMethod *>(xVar.get()) != nullptr ) 1030 { 1031 xVar->SetParameters(nullptr); 1032 } 1033 return xVar; 1034 } 1035 1036 void SbiRuntime::ClearExprStack() 1037 { 1038 // Attention: Clear() doesn't suffice as methods must be deleted 1039 while ( nExprLvl ) 1040 { 1041 PopVar(); 1042 } 1043 refExprStk->Clear(); 1044 } 1045 1046 // Take variable from the expression-stack without removing it 1047 // n counts from 0 1048 1049 SbxVariable* SbiRuntime::GetTOS() 1050 { 1051 short n = nExprLvl - 1; 1052 #ifdef DBG_UTIL 1053 if( n < 0 ) 1054 { 1055 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 1056 return new SbxVariable; 1057 } 1058 #endif 1059 return refExprStk->Get(static_cast<sal_uInt32>(n)); 1060 } 1061 1062 1063 void SbiRuntime::TOSMakeTemp() 1064 { 1065 SbxVariable* p = refExprStk->Get(nExprLvl - 1); 1066 if ( p->GetType() == SbxEMPTY ) 1067 { 1068 p->Broadcast( SfxHintId::BasicDataWanted ); 1069 } 1070 1071 SbxVariable* pDflt = nullptr; 1072 if ( bVBAEnabled && ( p->GetType() == SbxOBJECT || p->GetType() == SbxVARIANT ) && ((pDflt = getDefaultProp(p)) != nullptr) ) 1073 { 1074 pDflt->Broadcast( SfxHintId::BasicDataWanted ); 1075 // replacing new p on stack causes object pointed by 1076 // pDft->pParent to be deleted, when p2->Compute() is 1077 // called below pParent is accessed (but it's deleted) 1078 // so set it to NULL now 1079 pDflt->SetParent( nullptr ); 1080 p = new SbxVariable( *pDflt ); 1081 p->SetFlag( SbxFlagBits::ReadWrite ); 1082 refExprStk->Put(p, nExprLvl - 1); 1083 } 1084 else if( p->GetRefCount() != 1 ) 1085 { 1086 SbxVariable* pNew = new SbxVariable( *p ); 1087 pNew->SetFlag( SbxFlagBits::ReadWrite ); 1088 refExprStk->Put(pNew, nExprLvl - 1); 1089 } 1090 } 1091 1092 // the GOSUB-stack collects return-addresses for GOSUBs 1093 void SbiRuntime::PushGosub( const sal_uInt8* pc ) 1094 { 1095 if( pGosubStk.size() >= MAXRECURSION ) 1096 { 1097 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW ); 1098 } 1099 pGosubStk.emplace_back(pc, nForLvl); 1100 } 1101 1102 void SbiRuntime::PopGosub() 1103 { 1104 if( pGosubStk.empty() ) 1105 { 1106 Error( ERRCODE_BASIC_NO_GOSUB ); 1107 } 1108 else 1109 { 1110 pCode = pGosubStk.back().pCode; 1111 pGosubStk.pop_back(); 1112 } 1113 } 1114 1115 // the Argv-stack collects current argument-vectors 1116 1117 void SbiRuntime::PushArgv() 1118 { 1119 pArgvStk.emplace_back(refArgv, nArgc); 1120 nArgc = 1; 1121 refArgv.clear(); 1122 } 1123 1124 void SbiRuntime::PopArgv() 1125 { 1126 if( !pArgvStk.empty() ) 1127 { 1128 refArgv = pArgvStk.back().refArgv; 1129 nArgc = pArgvStk.back().nArgc; 1130 pArgvStk.pop_back(); 1131 } 1132 } 1133 1134 1135 void SbiRuntime::ClearArgvStack() 1136 { 1137 while( !pArgvStk.empty() ) 1138 { 1139 PopArgv(); 1140 } 1141 } 1142 1143 // Push of the for-stack. The stack has increment, end, begin and variable. 1144 // After the creation of the stack-element the stack's empty. 1145 1146 void SbiRuntime::PushFor() 1147 { 1148 SbiForStack* p = new SbiForStack; 1149 p->eForType = ForType::To; 1150 p->pNext = pForStk; 1151 pForStk = p; 1152 1153 p->refInc = PopVar(); 1154 p->refEnd = PopVar(); 1155 SbxVariableRef xBgn = PopVar(); 1156 p->refVar = PopVar(); 1157 // tdf#85371 - grant explicitly write access to the index variable 1158 // since it could be the name of a method itself used in the next statement. 1159 ScopedWritableGuard aGuard(p->refVar, p->refVar.get() == pMeth); 1160 *(p->refVar) = *xBgn; 1161 nForLvl++; 1162 } 1163 1164 void SbiRuntime::PushForEach() 1165 { 1166 SbiForStack* p = new SbiForStack; 1167 // Set default value in case of error which is ignored in Resume Next 1168 p->eForType = ForType::EachArray; 1169 p->pNext = pForStk; 1170 pForStk = p; 1171 1172 SbxVariableRef xObjVar = PopVar(); 1173 SbxBase* pObj = xObjVar && xObjVar->GetFullType() == SbxOBJECT ? xObjVar->GetObject() : nullptr; 1174 1175 if (SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj)) 1176 { 1177 p->refEnd = reinterpret_cast<SbxVariable*>(pArray); 1178 1179 sal_Int32 nDims = pArray->GetDims(); 1180 p->pArrayLowerBounds.reset( new sal_Int32[nDims] ); 1181 p->pArrayUpperBounds.reset( new sal_Int32[nDims] ); 1182 p->pArrayCurIndices.reset( new sal_Int32[nDims] ); 1183 sal_Int32 lBound, uBound; 1184 for( sal_Int32 i = 0 ; i < nDims ; i++ ) 1185 { 1186 pArray->GetDim(i + 1, lBound, uBound); 1187 p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound; 1188 p->pArrayUpperBounds[i] = uBound; 1189 } 1190 } 1191 else if (BasicCollection* pCollection = dynamic_cast<BasicCollection*>(pObj)) 1192 { 1193 p->eForType = ForType::EachCollection; 1194 p->refEnd = pCollection; 1195 p->nCurCollectionIndex = 0; 1196 } 1197 else if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj)) 1198 { 1199 // XEnumerationAccess? 1200 Any aAny = pUnoObj->getUnoAny(); 1201 Reference< XEnumerationAccess > xEnumerationAccess; 1202 if( aAny >>= xEnumerationAccess ) 1203 { 1204 p->xEnumeration = xEnumerationAccess->createEnumeration(); 1205 p->eForType = ForType::EachXEnumeration; 1206 } 1207 else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() ) 1208 { 1209 uno::Reference< script::XInvocation > xInvocation; 1210 if ( ( aAny >>= xInvocation ) && xInvocation.is() ) 1211 { 1212 try 1213 { 1214 p->xEnumeration = new ComEnumerationWrapper( xInvocation ); 1215 p->eForType = ForType::EachXEnumeration; 1216 } 1217 catch(const uno::Exception& ) 1218 {} 1219 } 1220 } 1221 } 1222 1223 // Container variable 1224 p->refVar = PopVar(); 1225 nForLvl++; 1226 } 1227 1228 1229 void SbiRuntime::PopFor() 1230 { 1231 if( pForStk ) 1232 { 1233 SbiForStack* p = pForStk; 1234 pForStk = p->pNext; 1235 delete p; 1236 nForLvl--; 1237 } 1238 } 1239 1240 1241 void SbiRuntime::ClearForStack() 1242 { 1243 while( pForStk ) 1244 { 1245 PopFor(); 1246 } 1247 } 1248 1249 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection const * pCollection ) 1250 { 1251 for (SbiForStack *p = pForStk; p; p = p->pNext) 1252 { 1253 SbxVariable* pVar = p->refEnd.is() ? p->refEnd.get() : nullptr; 1254 if( p->eForType == ForType::EachCollection 1255 && pVar != nullptr 1256 && dynamic_cast<BasicCollection*>( pVar) == pCollection ) 1257 { 1258 return p; 1259 } 1260 } 1261 1262 return nullptr; 1263 } 1264 1265 1266 // DLL-calls 1267 1268 void SbiRuntime::DllCall 1269 ( std::u16string_view aFuncName, 1270 std::u16string_view aDLLName, 1271 SbxArray* pArgs, // parameter (from index 1, can be NULL) 1272 SbxDataType eResType, // return value 1273 bool bCDecl ) // true: according to C-conventions 1274 { 1275 // NOT YET IMPLEMENTED 1276 1277 SbxVariable* pRes = new SbxVariable( eResType ); 1278 SbiDllMgr* pDllMgr = pInst->GetDllMgr(); 1279 ErrCode nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl ); 1280 if( nErr ) 1281 { 1282 Error( nErr ); 1283 } 1284 PushVar( pRes ); 1285 } 1286 1287 bool SbiRuntime::IsImageFlag( SbiImageFlags n ) const 1288 { 1289 return pImg->IsFlag( n ); 1290 } 1291 1292 sal_uInt16 SbiRuntime::GetBase() const 1293 { 1294 return pImg->GetBase(); 1295 } 1296 1297 void SbiRuntime::StepNOP() 1298 {} 1299 1300 void SbiRuntime::StepArith( SbxOperator eOp ) 1301 { 1302 SbxVariableRef p1 = PopVar(); 1303 TOSMakeTemp(); 1304 SbxVariable* p2 = GetTOS(); 1305 1306 // tdf#144353 - do not compute any operation with a missing optional variable 1307 if ((p1->GetType() == SbxERROR && IsMissing(p1.get(), 1)) 1308 || (p2->GetType() == SbxERROR && IsMissing(p2, 1))) 1309 { 1310 Error(ERRCODE_BASIC_NOT_OPTIONAL); 1311 return; 1312 } 1313 1314 p2->ResetFlag( SbxFlagBits::Fixed ); 1315 p2->Compute( eOp, *p1 ); 1316 1317 checkArithmeticOverflow( p2 ); 1318 } 1319 1320 void SbiRuntime::StepUnary( SbxOperator eOp ) 1321 { 1322 TOSMakeTemp(); 1323 SbxVariable* p = GetTOS(); 1324 // tdf#144353 - do not compute any operation with a missing optional variable 1325 if (p->GetType() == SbxERROR && IsMissing(p, 1)) 1326 { 1327 Error(ERRCODE_BASIC_NOT_OPTIONAL); 1328 return; 1329 } 1330 p->Compute( eOp, *p ); 1331 } 1332 1333 void SbiRuntime::StepCompare( SbxOperator eOp ) 1334 { 1335 SbxVariableRef p1 = PopVar(); 1336 SbxVariableRef p2 = PopVar(); 1337 1338 // tdf#144353 - do not compare a missing optional variable 1339 if ((p1->GetType() == SbxERROR && SbiRuntime::IsMissing(p1.get(), 1)) 1340 || (p2->GetType() == SbxERROR && SbiRuntime::IsMissing(p2.get(), 1))) 1341 { 1342 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL); 1343 return; 1344 } 1345 1346 // Make sure objects with default params have 1347 // values ( and type ) set as appropriate 1348 SbxDataType p1Type = p1->GetType(); 1349 SbxDataType p2Type = p2->GetType(); 1350 if ( p1Type == SbxEMPTY ) 1351 { 1352 p1->Broadcast( SfxHintId::BasicDataWanted ); 1353 p1Type = p1->GetType(); 1354 } 1355 if ( p2Type == SbxEMPTY ) 1356 { 1357 p2->Broadcast( SfxHintId::BasicDataWanted ); 1358 p2Type = p2->GetType(); 1359 } 1360 if ( p1Type == p2Type ) 1361 { 1362 // if both sides are an object and have default props 1363 // then we need to use the default props 1364 // we don't need to worry if only one side ( lhs, rhs ) is an 1365 // object ( object side will get coerced to correct type in 1366 // Compare ) 1367 if ( p1Type == SbxOBJECT ) 1368 { 1369 SbxVariable* pDflt = getDefaultProp( p1.get() ); 1370 if ( pDflt ) 1371 { 1372 p1 = pDflt; 1373 p1->Broadcast( SfxHintId::BasicDataWanted ); 1374 } 1375 pDflt = getDefaultProp( p2.get() ); 1376 if ( pDflt ) 1377 { 1378 p2 = pDflt; 1379 p2->Broadcast( SfxHintId::BasicDataWanted ); 1380 } 1381 } 1382 1383 } 1384 static SbxVariable* pTRUE = nullptr; 1385 static SbxVariable* pFALSE = nullptr; 1386 // why do this on non-windows ? 1387 // why do this at all ? 1388 // I dumbly follow the pattern :-/ 1389 if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) ) 1390 { 1391 static SbxVariable* pNULL = []() { 1392 SbxVariable* p = new SbxVariable; 1393 p->PutNull(); 1394 p->AddFirstRef(); 1395 return p; 1396 }(); 1397 PushVar( pNULL ); 1398 } 1399 else if( p2->Compare( eOp, *p1 ) ) 1400 { 1401 if( !pTRUE ) 1402 { 1403 pTRUE = new SbxVariable; 1404 pTRUE->PutBool( true ); 1405 pTRUE->AddFirstRef(); 1406 } 1407 PushVar( pTRUE ); 1408 } 1409 else 1410 { 1411 if( !pFALSE ) 1412 { 1413 pFALSE = new SbxVariable; 1414 pFALSE->PutBool( false ); 1415 pFALSE->AddFirstRef(); 1416 } 1417 PushVar( pFALSE ); 1418 } 1419 } 1420 1421 void SbiRuntime::StepEXP() { StepArith( SbxEXP ); } 1422 void SbiRuntime::StepMUL() { StepArith( SbxMUL ); } 1423 void SbiRuntime::StepDIV() { StepArith( SbxDIV ); } 1424 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); } 1425 void SbiRuntime::StepMOD() { StepArith( SbxMOD ); } 1426 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); } 1427 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); } 1428 void SbiRuntime::StepCAT() { StepArith( SbxCAT ); } 1429 void SbiRuntime::StepAND() { StepArith( SbxAND ); } 1430 void SbiRuntime::StepOR() { StepArith( SbxOR ); } 1431 void SbiRuntime::StepXOR() { StepArith( SbxXOR ); } 1432 void SbiRuntime::StepEQV() { StepArith( SbxEQV ); } 1433 void SbiRuntime::StepIMP() { StepArith( SbxIMP ); } 1434 1435 void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); } 1436 void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); } 1437 1438 void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); } 1439 void SbiRuntime::StepNE() { StepCompare( SbxNE ); } 1440 void SbiRuntime::StepLT() { StepCompare( SbxLT ); } 1441 void SbiRuntime::StepGT() { StepCompare( SbxGT ); } 1442 void SbiRuntime::StepLE() { StepCompare( SbxLE ); } 1443 void SbiRuntime::StepGE() { StepCompare( SbxGE ); } 1444 1445 namespace 1446 { 1447 bool NeedEsc(sal_Unicode cCode) 1448 { 1449 if(!rtl::isAscii(cCode)) 1450 { 1451 return false; 1452 } 1453 switch(cCode) 1454 { 1455 case '.': 1456 case '^': 1457 case '$': 1458 case '+': 1459 case '\\': 1460 case '|': 1461 case '{': 1462 case '}': 1463 case '(': 1464 case ')': 1465 return true; 1466 default: 1467 return false; 1468 } 1469 } 1470 1471 OUString VBALikeToRegexp(const OUString &rIn) 1472 { 1473 OUStringBuffer sResult; 1474 const sal_Unicode *start = rIn.getStr(); 1475 const sal_Unicode *end = start + rIn.getLength(); 1476 1477 int seenright = 0; 1478 1479 sResult.append('^'); 1480 1481 while (start < end) 1482 { 1483 switch (*start) 1484 { 1485 case '?': 1486 sResult.append('.'); 1487 start++; 1488 break; 1489 case '*': 1490 sResult.append(".*"); 1491 start++; 1492 break; 1493 case '#': 1494 sResult.append("[0-9]"); 1495 start++; 1496 break; 1497 case ']': 1498 sResult.append('\\'); 1499 sResult.append(*start++); 1500 break; 1501 case '[': 1502 sResult.append(*start++); 1503 seenright = 0; 1504 while (start < end && !seenright) 1505 { 1506 switch (*start) 1507 { 1508 case '[': 1509 case '?': 1510 case '*': 1511 sResult.append('\\'); 1512 sResult.append(*start); 1513 break; 1514 case ']': 1515 sResult.append(*start); 1516 seenright = 1; 1517 break; 1518 case '!': 1519 sResult.append('^'); 1520 break; 1521 default: 1522 if (NeedEsc(*start)) 1523 { 1524 sResult.append('\\'); 1525 } 1526 sResult.append(*start); 1527 break; 1528 } 1529 start++; 1530 } 1531 break; 1532 default: 1533 if (NeedEsc(*start)) 1534 { 1535 sResult.append('\\'); 1536 } 1537 sResult.append(*start++); 1538 } 1539 } 1540 1541 sResult.append('$'); 1542 1543 return sResult.makeStringAndClear(); 1544 } 1545 } 1546 1547 void SbiRuntime::StepLIKE() 1548 { 1549 SbxVariableRef refVar1 = PopVar(); 1550 SbxVariableRef refVar2 = PopVar(); 1551 1552 OUString pattern = VBALikeToRegexp(refVar1->GetOUString()); 1553 OUString value = refVar2->GetOUString(); 1554 1555 i18nutil::SearchOptions2 aSearchOpt; 1556 1557 aSearchOpt.AlgorithmType2 = css::util::SearchAlgorithms2::REGEXP; 1558 1559 aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale(); 1560 aSearchOpt.searchString = pattern; 1561 1562 bool bTextMode(true); 1563 bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() ); 1564 if( bCompatibility ) 1565 { 1566 bTextMode = IsImageFlag( SbiImageFlags::COMPARETEXT ); 1567 } 1568 if( bTextMode ) 1569 { 1570 aSearchOpt.transliterateFlags |= TransliterationFlags::IGNORE_CASE; 1571 } 1572 SbxVariable* pRes = new SbxVariable; 1573 utl::TextSearch aSearch( aSearchOpt); 1574 sal_Int32 nStart=0, nEnd=value.getLength(); 1575 bool bRes = aSearch.SearchForward(value, &nStart, &nEnd); 1576 pRes->PutBool( bRes ); 1577 1578 PushVar( pRes ); 1579 } 1580 1581 // TOS and TOS-1 are both object variables and contain the same pointer 1582 1583 void SbiRuntime::StepIS() 1584 { 1585 SbxVariableRef refVar1 = PopVar(); 1586 SbxVariableRef refVar2 = PopVar(); 1587 1588 SbxDataType eType1 = refVar1->GetType(); 1589 SbxDataType eType2 = refVar2->GetType(); 1590 if ( eType1 == SbxEMPTY ) 1591 { 1592 refVar1->Broadcast( SfxHintId::BasicDataWanted ); 1593 eType1 = refVar1->GetType(); 1594 } 1595 if ( eType2 == SbxEMPTY ) 1596 { 1597 refVar2->Broadcast( SfxHintId::BasicDataWanted ); 1598 eType2 = refVar2->GetType(); 1599 } 1600 1601 bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT ); 1602 if ( bVBAEnabled && !bRes ) 1603 { 1604 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1605 } 1606 bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() ); 1607 SbxVariable* pRes = new SbxVariable; 1608 pRes->PutBool( bRes ); 1609 PushVar( pRes ); 1610 } 1611 1612 // update the value of TOS 1613 1614 void SbiRuntime::StepGET() 1615 { 1616 SbxVariable* p = GetTOS(); 1617 p->Broadcast( SfxHintId::BasicDataWanted ); 1618 } 1619 1620 // #67607 copy Uno-Structs 1621 static bool checkUnoStructCopy( bool bVBA, SbxVariableRef const & refVal, SbxVariableRef const & refVar ) 1622 { 1623 SbxDataType eVarType = refVar->GetType(); 1624 SbxDataType eValType = refVal->GetType(); 1625 1626 // tdf#144353 - do not assign a missing optional variable to a property 1627 if (refVal->GetType() == SbxERROR && SbiRuntime::IsMissing(refVal.get(), 1)) 1628 { 1629 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL); 1630 return true; 1631 } 1632 1633 if ( ( bVBA && ( eVarType == SbxEMPTY ) ) || !refVar->CanWrite() ) 1634 return false; 1635 1636 if ( eValType != SbxOBJECT ) 1637 return false; 1638 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to 1639 // there :-/ not sure if for every '=' we would want struct handling 1640 if( eVarType != SbxOBJECT ) 1641 { 1642 if ( refVar->IsFixed() ) 1643 return false; 1644 } 1645 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure 1646 else if( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr ) 1647 return false; 1648 1649 SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject()); 1650 if( !xValObj.is() || dynamic_cast<const SbUnoAnyObject*>( xValObj.get() ) != nullptr ) 1651 return false; 1652 1653 SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() ); 1654 SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() ); 1655 Any aAny; 1656 // make doubly sure value is either a Uno object or 1657 // a uno struct 1658 if ( pUnoVal || pUnoStructVal ) 1659 aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny(); 1660 else 1661 return false; 1662 if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT ) 1663 { 1664 refVar->SetType( SbxOBJECT ); 1665 ErrCode eOldErr = SbxBase::GetError(); 1666 // There are some circumstances when calling GetObject 1667 // will trigger an error, we need to squash those here. 1668 // Alternatively it is possible that the same scenario 1669 // could overwrite and existing error. Lets prevent that 1670 SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject()); 1671 if ( eOldErr != ERRCODE_NONE ) 1672 SbxBase::SetError( eOldErr ); 1673 else 1674 SbxBase::ResetError(); 1675 1676 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( xVarObj.get() ); 1677 1678 OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName(); 1679 OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName(); 1680 1681 if ( pUnoStructObj ) 1682 { 1683 StructRefInfo aInfo = pUnoStructObj->getStructInfo(); 1684 aInfo.setValue( aAny ); 1685 } 1686 else 1687 { 1688 SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny ); 1689 // #70324: adopt ClassName 1690 pNewUnoObj->SetClassName( sClassName ); 1691 refVar->PutObject( pNewUnoObj ); 1692 } 1693 return true; 1694 } 1695 return false; 1696 } 1697 1698 1699 // laying down TOS in TOS-1 1700 1701 void SbiRuntime::StepPUT() 1702 { 1703 SbxVariableRef refVal = PopVar(); 1704 SbxVariableRef refVar = PopVar(); 1705 // store on its own method (inside a function)? 1706 bool bFlagsChanged = false; 1707 SbxFlagBits n = SbxFlagBits::NONE; 1708 if( refVar.get() == pMeth ) 1709 { 1710 bFlagsChanged = true; 1711 n = refVar->GetFlags(); 1712 refVar->SetFlag( SbxFlagBits::Write ); 1713 } 1714 1715 // if left side arg is an object or variant and right handside isn't 1716 // either an object or a variant then try and see if a default 1717 // property exists. 1718 // to use e.g. Range{"A1") = 34 1719 // could equate to Range("A1").Value = 34 1720 if ( bVBAEnabled ) 1721 { 1722 // yet more hacking at this, I feel we don't quite have the correct 1723 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe 1724 // obj1 ) has default member/property ) ) It seems that default props 1725 // aren't dealt with if the object is a member of some parent object 1726 bool bObjAssign = false; 1727 if ( refVar->GetType() == SbxEMPTY ) 1728 refVar->Broadcast( SfxHintId::BasicDataWanted ); 1729 if ( refVar->GetType() == SbxOBJECT ) 1730 { 1731 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() ) 1732 { 1733 SbxVariable* pDflt = getDefaultProp( refVar.get() ); 1734 1735 if ( pDflt ) 1736 refVar = pDflt; 1737 } 1738 else 1739 bObjAssign = true; 1740 } 1741 if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( dynamic_cast<const SbxMethod *>(refVal.get()) != nullptr || ! refVal->GetParent() ) ) 1742 { 1743 SbxVariable* pDflt = getDefaultProp( refVal.get() ); 1744 if ( pDflt ) 1745 refVal = pDflt; 1746 } 1747 } 1748 1749 if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) ) 1750 *refVar = *refVal; 1751 1752 if( bFlagsChanged ) 1753 refVar->SetFlags( n ); 1754 } 1755 1756 namespace { 1757 1758 // VBA Dim As New behavior handling, save init object information 1759 struct DimAsNewRecoverItem 1760 { 1761 OUString m_aObjClass; 1762 OUString m_aObjName; 1763 SbxObject* m_pObjParent; 1764 SbModule* m_pClassModule; 1765 1766 DimAsNewRecoverItem() 1767 : m_pObjParent( nullptr ) 1768 , m_pClassModule( nullptr ) 1769 {} 1770 1771 DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName, 1772 SbxObject* pObjParent, SbModule* pClassModule ) 1773 : m_aObjClass( rObjClass ) 1774 , m_aObjName( rObjName ) 1775 , m_pObjParent( pObjParent ) 1776 , m_pClassModule( pClassModule ) 1777 {} 1778 1779 }; 1780 1781 1782 struct SbxVariablePtrHash 1783 { 1784 size_t operator()( SbxVariable* pVar ) const 1785 { return reinterpret_cast<size_t>(pVar); } 1786 }; 1787 1788 } 1789 1790 typedef std::unordered_map< SbxVariable*, DimAsNewRecoverItem, 1791 SbxVariablePtrHash > DimAsNewRecoverHash; 1792 1793 namespace { 1794 1795 DimAsNewRecoverHash gaDimAsNewRecoverHash; 1796 1797 } 1798 1799 void removeDimAsNewRecoverItem( SbxVariable* pVar ) 1800 { 1801 DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( pVar ); 1802 if( it != gaDimAsNewRecoverHash.end() ) 1803 { 1804 gaDimAsNewRecoverHash.erase( it ); 1805 } 1806 } 1807 1808 1809 // saving object variable 1810 // not-object variables will cause errors 1811 1812 constexpr OUStringLiteral pCollectionStr = u"Collection"; 1813 1814 void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp ) 1815 { 1816 // #67733 types with array-flag are OK too 1817 1818 // Check var, !object is no error for sure if, only if type is fixed 1819 SbxDataType eVarType = refVar->GetType(); 1820 if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() ) 1821 { 1822 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1823 return; 1824 } 1825 1826 // Check value, !object is no error for sure if, only if type is fixed 1827 SbxDataType eValType = refVal->GetType(); 1828 if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() ) 1829 { 1830 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1831 return; 1832 } 1833 1834 // Getting in here causes problems with objects with default properties 1835 // if they are SbxEMPTY I guess 1836 if ( !bHandleDefaultProp || eValType == SbxOBJECT ) 1837 { 1838 // activate GetObject for collections on refVal 1839 SbxBase* pObjVarObj = refVal->GetObject(); 1840 if( pObjVarObj ) 1841 { 1842 SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj ); 1843 1844 if( refObjVal.is() ) 1845 { 1846 refVal = refObjVal; 1847 } 1848 else if( !(eValType & SbxARRAY) ) 1849 { 1850 refVal = nullptr; 1851 } 1852 } 1853 } 1854 1855 // #52896 refVal can be invalid here, if uno-sequences - or more 1856 // general arrays - are assigned to variables that are declared 1857 // as an object! 1858 if( !refVal.is() ) 1859 { 1860 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1861 } 1862 else 1863 { 1864 bool bFlagsChanged = false; 1865 SbxFlagBits n = SbxFlagBits::NONE; 1866 if( refVar.get() == pMeth ) 1867 { 1868 bFlagsChanged = true; 1869 n = refVar->GetFlags(); 1870 refVar->SetFlag( SbxFlagBits::Write ); 1871 } 1872 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() ); 1873 if( pProcProperty ) 1874 { 1875 pProcProperty->setSet( true ); 1876 } 1877 if ( bHandleDefaultProp ) 1878 { 1879 // get default properties for lhs & rhs where necessary 1880 // SbxVariable* defaultProp = NULL; unused variable 1881 // LHS try determine if a default prop exists 1882 // again like in StepPUT (see there too ) we are tweaking the 1883 // heuristics again for when to assign an object reference or 1884 // use default members if they exist 1885 // #FIXME we really need to get to the bottom of this mess 1886 bool bObjAssign = false; 1887 if ( refVar->GetType() == SbxOBJECT ) 1888 { 1889 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() ) 1890 { 1891 SbxVariable* pDflt = getDefaultProp( refVar.get() ); 1892 if ( pDflt ) 1893 { 1894 refVar = pDflt; 1895 } 1896 } 1897 else 1898 bObjAssign = true; 1899 } 1900 // RHS only get a default prop is the rhs has one 1901 if ( refVal->GetType() == SbxOBJECT ) 1902 { 1903 // check if lhs is a null object 1904 // if it is then use the object not the default property 1905 SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() ); 1906 1907 // calling GetObject on a SbxEMPTY variable raises 1908 // object not set errors, make sure it's an Object 1909 if ( !pObj && refVar->GetType() == SbxOBJECT ) 1910 { 1911 SbxBase* pObjVarObj = refVar->GetObject(); 1912 pObj = dynamic_cast<SbxObject*>( pObjVarObj ); 1913 } 1914 SbxVariable* pDflt = nullptr; 1915 if ( pObj && !bObjAssign ) 1916 { 1917 // lhs is either a valid object || or has a defaultProp 1918 pDflt = getDefaultProp( refVal.get() ); 1919 } 1920 if ( pDflt ) 1921 { 1922 refVal = pDflt; 1923 } 1924 } 1925 } 1926 1927 // Handle Dim As New 1928 bool bDimAsNew = bVBAEnabled && refVar->IsSet( SbxFlagBits::DimAsNew ); 1929 SbxBaseRef xPrevVarObj; 1930 if( bDimAsNew ) 1931 { 1932 xPrevVarObj = refVar->GetObject(); 1933 } 1934 // Handle withevents 1935 bool bWithEvents = refVar->IsSet( SbxFlagBits::WithEvents ); 1936 if ( bWithEvents ) 1937 { 1938 Reference< XInterface > xComListener; 1939 1940 SbxBase* pObj = refVal->GetObject(); 1941 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj ); 1942 if( pUnoObj != nullptr ) 1943 { 1944 Any aControlAny = pUnoObj->getUnoAny(); 1945 OUString aDeclareClassName = refVar->GetDeclareClassName(); 1946 OUString aPrefix = refVar->GetName(); 1947 SbxObjectRef xScopeObj = refVar->GetParent(); 1948 xComListener = createComListener( aControlAny, aDeclareClassName, aPrefix, xScopeObj ); 1949 1950 refVal->SetDeclareClassName( aDeclareClassName ); 1951 refVal->SetComListener( xComListener, &rBasic ); // Hold reference 1952 } 1953 1954 } 1955 1956 // lhs is a property who's value is currently (Empty e.g. no broadcast yet) 1957 // in this case if there is a default prop involved the value of the 1958 // default property may in fact be void so the type will also be SbxEMPTY 1959 // in this case we do not want to call checkUnoStructCopy 'cause that will 1960 // cause an error also 1961 if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) ) 1962 { 1963 *refVar = *refVal; 1964 } 1965 if ( bDimAsNew ) 1966 { 1967 if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr ) 1968 { 1969 SbxBase* pValObjBase = refVal->GetObject(); 1970 if( pValObjBase == nullptr ) 1971 { 1972 if( xPrevVarObj.is() ) 1973 { 1974 // Object is overwritten with NULL, instantiate init object 1975 DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( refVar.get() ); 1976 if( it != gaDimAsNewRecoverHash.end() ) 1977 { 1978 const DimAsNewRecoverItem& rItem = it->second; 1979 if( rItem.m_pClassModule != nullptr ) 1980 { 1981 SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule ); 1982 pNewObj->SetName( rItem.m_aObjName ); 1983 pNewObj->SetParent( rItem.m_pObjParent ); 1984 refVar->PutObject( pNewObj ); 1985 } 1986 else if( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) ) 1987 { 1988 BasicCollection* pNewCollection = new BasicCollection( pCollectionStr ); 1989 pNewCollection->SetName( rItem.m_aObjName ); 1990 pNewCollection->SetParent( rItem.m_pObjParent ); 1991 refVar->PutObject( pNewCollection ); 1992 } 1993 } 1994 } 1995 } 1996 else 1997 { 1998 // Does old value exist? 1999 bool bFirstInit = !xPrevVarObj.is(); 2000 if( bFirstInit ) 2001 { 2002 // Store information to instantiate object later 2003 SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase ); 2004 if( pValObj != nullptr ) 2005 { 2006 OUString aObjClass = pValObj->GetClassName(); 2007 2008 SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pValObjBase ); 2009 if( pClassModuleObj != nullptr ) 2010 { 2011 SbModule* pClassModule = pClassModuleObj->getClassModule(); 2012 gaDimAsNewRecoverHash[refVar.get()] = 2013 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule ); 2014 } 2015 else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) ) 2016 { 2017 gaDimAsNewRecoverHash[refVar.get()] = 2018 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), nullptr ); 2019 } 2020 } 2021 } 2022 } 2023 } 2024 } 2025 2026 if( bFlagsChanged ) 2027 { 2028 refVar->SetFlags( n ); 2029 } 2030 } 2031 } 2032 2033 void SbiRuntime::StepSET() 2034 { 2035 SbxVariableRef refVal = PopVar(); 2036 SbxVariableRef refVar = PopVar(); 2037 StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assignment 2038 } 2039 2040 void SbiRuntime::StepVBASET() 2041 { 2042 SbxVariableRef refVal = PopVar(); 2043 SbxVariableRef refVar = PopVar(); 2044 // don't handle default property 2045 StepSET_Impl( refVal, refVar ); // set obj = something 2046 } 2047 2048 2049 void SbiRuntime::StepLSET() 2050 { 2051 SbxVariableRef refVal = PopVar(); 2052 SbxVariableRef refVar = PopVar(); 2053 if( refVar->GetType() != SbxSTRING || 2054 refVal->GetType() != SbxSTRING ) 2055 { 2056 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 2057 } 2058 else 2059 { 2060 SbxFlagBits n = refVar->GetFlags(); 2061 if( refVar.get() == pMeth ) 2062 { 2063 refVar->SetFlag( SbxFlagBits::Write ); 2064 } 2065 OUString aRefVarString = refVar->GetOUString(); 2066 OUString aRefValString = refVal->GetOUString(); 2067 2068 sal_Int32 nVarStrLen = aRefVarString.getLength(); 2069 sal_Int32 nValStrLen = aRefValString.getLength(); 2070 OUString aNewStr; 2071 if( nVarStrLen > nValStrLen ) 2072 { 2073 OUStringBuffer buf(aRefValString); 2074 comphelper::string::padToLength(buf, nVarStrLen, ' '); 2075 aNewStr = buf.makeStringAndClear(); 2076 } 2077 else 2078 { 2079 aNewStr = aRefValString.copy( 0, nVarStrLen ); 2080 } 2081 2082 refVar->PutString(aNewStr); 2083 refVar->SetFlags( n ); 2084 } 2085 } 2086 2087 void SbiRuntime::StepRSET() 2088 { 2089 SbxVariableRef refVal = PopVar(); 2090 SbxVariableRef refVar = PopVar(); 2091 if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING ) 2092 { 2093 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 2094 } 2095 else 2096 { 2097 SbxFlagBits n = refVar->GetFlags(); 2098 if( refVar.get() == pMeth ) 2099 { 2100 refVar->SetFlag( SbxFlagBits::Write ); 2101 } 2102 OUString aRefVarString = refVar->GetOUString(); 2103 OUString aRefValString = refVal->GetOUString(); 2104 sal_Int32 nVarStrLen = aRefVarString.getLength(); 2105 sal_Int32 nValStrLen = aRefValString.getLength(); 2106 2107 OUStringBuffer aNewStr(nVarStrLen); 2108 if (nVarStrLen > nValStrLen) 2109 { 2110 comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' '); 2111 aNewStr.append(aRefValString); 2112 } 2113 else 2114 { 2115 aNewStr.append(aRefValString.subView(0, nVarStrLen)); 2116 } 2117 refVar->PutString(aNewStr.makeStringAndClear()); 2118 2119 refVar->SetFlags( n ); 2120 } 2121 } 2122 2123 // laying down TOS in TOS-1, then set ReadOnly-Bit 2124 2125 void SbiRuntime::StepPUTC() 2126 { 2127 SbxVariableRef refVal = PopVar(); 2128 SbxVariableRef refVar = PopVar(); 2129 refVar->SetFlag( SbxFlagBits::Write ); 2130 *refVar = *refVal; 2131 refVar->ResetFlag( SbxFlagBits::Write ); 2132 refVar->SetFlag( SbxFlagBits::Const ); 2133 } 2134 2135 // DIM 2136 // TOS = variable for the array with dimension information as parameter 2137 2138 void SbiRuntime::StepDIM() 2139 { 2140 SbxVariableRef refVar = PopVar(); 2141 DimImpl( refVar ); 2142 } 2143 2144 // #56204 swap out DIM-functionality into a help method (step0.cxx) 2145 void SbiRuntime::DimImpl(const SbxVariableRef& refVar) 2146 { 2147 // If refDim then this DIM statement is terminating a ReDIM and 2148 // previous StepERASE_CLEAR for an array, the following actions have 2149 // been delayed from ( StepERASE_CLEAR ) 'till here 2150 if ( refRedim.is() ) 2151 { 2152 if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve 2153 { 2154 lcl_eraseImpl( refVar, bVBAEnabled ); 2155 } 2156 SbxDataType eType = refVar->GetType(); 2157 lcl_clearImpl( refVar, eType ); 2158 refRedim = nullptr; 2159 } 2160 SbxArray* pDims = refVar->GetParameters(); 2161 // must have an even number of arguments 2162 // have in mind that Arg[0] does not count! 2163 if (pDims && !(pDims->Count() & 1)) 2164 { 2165 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2166 } 2167 else 2168 { 2169 SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT; 2170 SbxDimArray* pArray = new SbxDimArray( eType ); 2171 // allow arrays without dimension information, too (VB-compatible) 2172 if( pDims ) 2173 { 2174 refVar->ResetFlag( SbxFlagBits::VarToDim ); 2175 2176 for (sal_uInt32 i = 1; i < pDims->Count();) 2177 { 2178 sal_Int32 lb = pDims->Get(i++)->GetLong(); 2179 sal_Int32 ub = pDims->Get(i++)->GetLong(); 2180 if( ub < lb ) 2181 { 2182 Error( ERRCODE_BASIC_OUT_OF_RANGE ); 2183 ub = lb; 2184 } 2185 pArray->AddDim(lb, ub); 2186 if ( lb != ub ) 2187 { 2188 pArray->setHasFixedSize( true ); 2189 } 2190 } 2191 } 2192 else 2193 { 2194 // #62867 On creating an array of the length 0, create 2195 // a dimension (like for Uno-Sequences of the length 0) 2196 pArray->unoAddDim(0, -1); 2197 } 2198 SbxFlagBits nSavFlags = refVar->GetFlags(); 2199 refVar->ResetFlag( SbxFlagBits::Fixed ); 2200 refVar->PutObject( pArray ); 2201 refVar->SetFlags( nSavFlags ); 2202 refVar->SetParameters( nullptr ); 2203 } 2204 } 2205 2206 // REDIM 2207 // TOS = variable for the array 2208 // argv = dimension information 2209 2210 void SbiRuntime::StepREDIM() 2211 { 2212 // Nothing different than dim at the moment because 2213 // a double dim is already recognized by the compiler. 2214 StepDIM(); 2215 } 2216 2217 2218 // Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true 2219 static void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, sal_Int32 nMaxDimIndex, 2220 sal_Int32 nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds ) 2221 { 2222 sal_Int32& ri = pActualIndices[nActualDim]; 2223 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ ) 2224 { 2225 if( nActualDim < nMaxDimIndex ) 2226 { 2227 implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1, 2228 pActualIndices, pLowerBounds, pUpperBounds ); 2229 } 2230 else 2231 { 2232 SbxVariable* pSource = pOldArray->Get(pActualIndices); 2233 if (pSource && pOldArray->GetRefCount() > 1) 2234 // tdf#134692: old array will stay alive after the redim - we need to copy deep 2235 pSource = new SbxVariable(*pSource); 2236 pNewArray->Put(pSource, pActualIndices); 2237 } 2238 } 2239 } 2240 2241 // Returns true when actually restored 2242 static bool implRestorePreservedArray(SbxDimArray* pNewArray, SbxArrayRef& rrefRedimpArray, bool* pbWasError = nullptr) 2243 { 2244 assert(pNewArray); 2245 bool bResult = false; 2246 if (pbWasError) 2247 *pbWasError = false; 2248 if (rrefRedimpArray) 2249 { 2250 SbxDimArray* pOldArray = static_cast<SbxDimArray*>(rrefRedimpArray.get()); 2251 const sal_Int32 nDimsNew = pNewArray->GetDims(); 2252 const sal_Int32 nDimsOld = pOldArray->GetDims(); 2253 2254 if (nDimsOld != nDimsNew) 2255 { 2256 StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE); 2257 if (pbWasError) 2258 *pbWasError = true; 2259 } 2260 else if (nDimsNew > 0) 2261 { 2262 // Store dims to use them for copying later 2263 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDimsNew]); 2264 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDimsNew]); 2265 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDimsNew]); 2266 bool bNeedsPreallocation = true; 2267 2268 // Compare bounds 2269 for (sal_Int32 i = 1; i <= nDimsNew; i++) 2270 { 2271 sal_Int32 lBoundNew, uBoundNew; 2272 sal_Int32 lBoundOld, uBoundOld; 2273 pNewArray->GetDim(i, lBoundNew, uBoundNew); 2274 pOldArray->GetDim(i, lBoundOld, uBoundOld); 2275 lBoundNew = std::max(lBoundNew, lBoundOld); 2276 uBoundNew = std::min(uBoundNew, uBoundOld); 2277 sal_Int32 j = i - 1; 2278 pActualIndices[j] = pLowerBounds[j] = lBoundNew; 2279 pUpperBounds[j] = uBoundNew; 2280 if (lBoundNew > uBoundNew) // No elements in the dimension -> no elements to restore 2281 bNeedsPreallocation = false; 2282 } 2283 2284 // Optimization: pre-allocate underlying container 2285 if (bNeedsPreallocation) 2286 pNewArray->Put(nullptr, pUpperBounds.get()); 2287 2288 // Copy data from old array by going recursively through all dimensions 2289 // (It would be faster to work on the flat internal data array of an 2290 // SbyArray but this solution is clearer and easier) 2291 implCopyDimArray(pNewArray, pOldArray, nDimsNew - 1, 0, pActualIndices.get(), 2292 pLowerBounds.get(), pUpperBounds.get()); 2293 bResult = true; 2294 } 2295 2296 rrefRedimpArray.clear(); 2297 } 2298 return bResult; 2299 } 2300 2301 // REDIM PRESERVE 2302 // TOS = variable for the array 2303 // argv = dimension information 2304 2305 void SbiRuntime::StepREDIMP() 2306 { 2307 SbxVariableRef refVar = PopVar(); 2308 DimImpl( refVar ); 2309 2310 // Now check, if we can copy from the old array 2311 if( refRedimpArray.is() ) 2312 { 2313 if (SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>(refVar->GetObject())) 2314 implRestorePreservedArray(pNewArray, refRedimpArray); 2315 } 2316 } 2317 2318 // REDIM_COPY 2319 // TOS = Array-Variable, Reference to array is copied 2320 // Variable is cleared as in ERASE 2321 2322 void SbiRuntime::StepREDIMP_ERASE() 2323 { 2324 SbxVariableRef refVar = PopVar(); 2325 refRedim = refVar; 2326 SbxDataType eType = refVar->GetType(); 2327 if( eType & SbxARRAY ) 2328 { 2329 SbxBase* pElemObj = refVar->GetObject(); 2330 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); 2331 if( pDimArray ) 2332 { 2333 refRedimpArray = pDimArray; 2334 } 2335 2336 } 2337 else if( refVar->IsFixed() ) 2338 { 2339 refVar->Clear(); 2340 } 2341 else 2342 { 2343 refVar->SetType( SbxEMPTY ); 2344 } 2345 } 2346 2347 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType ) 2348 { 2349 SbxFlagBits nSavFlags = refVar->GetFlags(); 2350 refVar->ResetFlag( SbxFlagBits::Fixed ); 2351 refVar->SetType( SbxDataType(eType & 0x0FFF) ); 2352 refVar->SetFlags( nSavFlags ); 2353 refVar->Clear(); 2354 } 2355 2356 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled ) 2357 { 2358 SbxDataType eType = refVar->GetType(); 2359 if( eType & SbxARRAY ) 2360 { 2361 if ( bVBAEnabled ) 2362 { 2363 SbxBase* pElemObj = refVar->GetObject(); 2364 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); 2365 if( pDimArray ) 2366 { 2367 if ( pDimArray->hasFixedSize() ) 2368 { 2369 // Clear all Value(s) 2370 pDimArray->SbxArray::Clear(); 2371 } 2372 else 2373 { 2374 pDimArray->Clear(); // clear dims and values 2375 } 2376 } 2377 else 2378 { 2379 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj ); 2380 if ( pArray ) 2381 { 2382 pArray->Clear(); 2383 } 2384 } 2385 } 2386 else 2387 { 2388 // Arrays have on an erase to VB quite a complex behaviour. Here are 2389 // only the type problems at REDIM (#26295) removed at first: 2390 // Set type hard onto the array-type, because a variable with array is 2391 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and 2392 // the original type is lost -> runtime error 2393 lcl_clearImpl( refVar, eType ); 2394 } 2395 } 2396 else if( refVar->IsFixed() ) 2397 { 2398 refVar->Clear(); 2399 } 2400 else 2401 { 2402 refVar->SetType( SbxEMPTY ); 2403 } 2404 } 2405 2406 // delete variable 2407 // TOS = variable 2408 2409 void SbiRuntime::StepERASE() 2410 { 2411 SbxVariableRef refVar = PopVar(); 2412 lcl_eraseImpl( refVar, bVBAEnabled ); 2413 } 2414 2415 void SbiRuntime::StepERASE_CLEAR() 2416 { 2417 refRedim = PopVar(); 2418 } 2419 2420 void SbiRuntime::StepARRAYACCESS() 2421 { 2422 if( !refArgv.is() ) 2423 { 2424 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2425 } 2426 SbxVariableRef refVar = PopVar(); 2427 refVar->SetParameters( refArgv.get() ); 2428 PopArgv(); 2429 PushVar( CheckArray( refVar.get() ) ); 2430 } 2431 2432 void SbiRuntime::StepBYVAL() 2433 { 2434 // Copy variable on stack to break call by reference 2435 SbxVariableRef pVar = PopVar(); 2436 SbxDataType t = pVar->GetType(); 2437 2438 SbxVariable* pCopyVar = new SbxVariable( t ); 2439 pCopyVar->SetFlag( SbxFlagBits::ReadWrite ); 2440 *pCopyVar = *pVar; 2441 2442 PushVar( pCopyVar ); 2443 } 2444 2445 // establishing an argv 2446 // nOp1 stays as it is -> 1st element is the return value 2447 2448 void SbiRuntime::StepARGC() 2449 { 2450 PushArgv(); 2451 refArgv = new SbxArray; 2452 nArgc = 1; 2453 } 2454 2455 // storing an argument in Argv 2456 2457 void SbiRuntime::StepARGV() 2458 { 2459 if( !refArgv.is() ) 2460 { 2461 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2462 } 2463 else 2464 { 2465 SbxVariableRef pVal = PopVar(); 2466 2467 // Before fix of #94916: 2468 if( dynamic_cast<const SbxMethod*>( pVal.get() ) != nullptr 2469 || dynamic_cast<const SbUnoProperty*>( pVal.get() ) != nullptr 2470 || dynamic_cast<const SbProcedureProperty*>( pVal.get() ) != nullptr ) 2471 { 2472 // evaluate methods and properties! 2473 SbxVariable* pRes = new SbxVariable( *pVal ); 2474 pVal = pRes; 2475 } 2476 refArgv->Put(pVal.get(), nArgc++); 2477 } 2478 } 2479 2480 // Input to Variable. The variable is on TOS and is 2481 // is removed afterwards. 2482 void SbiRuntime::StepINPUT() 2483 { 2484 OUStringBuffer sin; 2485 char ch = 0; 2486 ErrCode err; 2487 // Skip whitespace 2488 while( ( err = pIosys->GetError() ) == ERRCODE_NONE ) 2489 { 2490 ch = pIosys->Read(); 2491 if( ch != ' ' && ch != '\t' && ch != '\n' ) 2492 { 2493 break; 2494 } 2495 } 2496 if( !err ) 2497 { 2498 // Scan until comma or whitespace 2499 char sep = ( ch == '"' ) ? ch : 0; 2500 if( sep ) 2501 { 2502 ch = pIosys->Read(); 2503 } 2504 while( ( err = pIosys->GetError() ) == ERRCODE_NONE ) 2505 { 2506 if( ch == sep ) 2507 { 2508 ch = pIosys->Read(); 2509 if( ch != sep ) 2510 { 2511 break; 2512 } 2513 } 2514 else if( !sep && (ch == ',' || ch == '\n') ) 2515 { 2516 break; 2517 } 2518 sin.append( ch ); 2519 ch = pIosys->Read(); 2520 } 2521 // skip whitespace 2522 if( ch == ' ' || ch == '\t' ) 2523 { 2524 while( ( err = pIosys->GetError() ) == ERRCODE_NONE ) 2525 { 2526 if( ch != ' ' && ch != '\t' && ch != '\n' ) 2527 { 2528 break; 2529 } 2530 ch = pIosys->Read(); 2531 } 2532 } 2533 } 2534 if( !err ) 2535 { 2536 OUString s = sin.makeStringAndClear(); 2537 SbxVariableRef pVar = GetTOS(); 2538 // try to fill the variable with a numeric value first, 2539 // then with a string value 2540 if( !pVar->IsFixed() || pVar->IsNumeric() ) 2541 { 2542 sal_uInt16 nLen = 0; 2543 if( !pVar->Scan( s, &nLen ) ) 2544 { 2545 err = SbxBase::GetError(); 2546 SbxBase::ResetError(); 2547 } 2548 // the value has to be scanned in completely 2549 else if( nLen != s.getLength() && !pVar->PutString( s ) ) 2550 { 2551 err = SbxBase::GetError(); 2552 SbxBase::ResetError(); 2553 } 2554 else if( nLen != s.getLength() && pVar->IsNumeric() ) 2555 { 2556 err = SbxBase::GetError(); 2557 SbxBase::ResetError(); 2558 if( !err ) 2559 { 2560 err = ERRCODE_BASIC_CONVERSION; 2561 } 2562 } 2563 } 2564 else 2565 { 2566 pVar->PutString( s ); 2567 err = SbxBase::GetError(); 2568 SbxBase::ResetError(); 2569 } 2570 } 2571 if( err == ERRCODE_BASIC_USER_ABORT ) 2572 { 2573 Error( err ); 2574 } 2575 else if( err ) 2576 { 2577 if( pRestart && !pIosys->GetChannel() ) 2578 { 2579 pCode = pRestart; 2580 } 2581 else 2582 { 2583 Error( err ); 2584 } 2585 } 2586 else 2587 { 2588 PopVar(); 2589 } 2590 } 2591 2592 // Line Input to Variable. The variable is on TOS and is 2593 // deleted afterwards. 2594 2595 void SbiRuntime::StepLINPUT() 2596 { 2597 OString aInput; 2598 pIosys->Read( aInput ); 2599 Error( pIosys->GetError() ); 2600 SbxVariableRef p = PopVar(); 2601 p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding())); 2602 } 2603 2604 // end of program 2605 2606 void SbiRuntime::StepSTOP() 2607 { 2608 pInst->Stop(); 2609 } 2610 2611 2612 void SbiRuntime::StepINITFOR() 2613 { 2614 PushFor(); 2615 } 2616 2617 void SbiRuntime::StepINITFOREACH() 2618 { 2619 PushForEach(); 2620 } 2621 2622 // increment FOR-variable 2623 2624 void SbiRuntime::StepNEXT() 2625 { 2626 if( !pForStk ) 2627 { 2628 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2629 return; 2630 } 2631 if (pForStk->eForType != ForType::To) 2632 return; 2633 if (!pForStk->refVar) 2634 { 2635 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2636 return; 2637 } 2638 // tdf#85371 - grant explicitly write access to the index variable 2639 // since it could be the name of a method itself used in the next statement. 2640 ScopedWritableGuard aGuard(pForStk->refVar, pForStk->refVar.get() == pMeth); 2641 pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc ); 2642 } 2643 2644 // beginning CASE: TOS in CASE-stack 2645 2646 void SbiRuntime::StepCASE() 2647 { 2648 if( !refCaseStk.is() ) 2649 { 2650 refCaseStk = new SbxArray; 2651 } 2652 SbxVariableRef xVar = PopVar(); 2653 refCaseStk->Put(xVar.get(), refCaseStk->Count()); 2654 } 2655 2656 // end CASE: free variable 2657 2658 void SbiRuntime::StepENDCASE() 2659 { 2660 if (!refCaseStk.is() || !refCaseStk->Count()) 2661 { 2662 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2663 } 2664 else 2665 { 2666 refCaseStk->Remove(refCaseStk->Count() - 1); 2667 } 2668 } 2669 2670 2671 void SbiRuntime::StepSTDERROR() 2672 { 2673 pError = nullptr; bError = true; 2674 pInst->aErrorMsg.clear(); 2675 pInst->nErr = ERRCODE_NONE; 2676 pInst->nErl = 0; 2677 nError = ERRCODE_NONE; 2678 SbxErrObject::getUnoErrObject()->Clear(); 2679 } 2680 2681 void SbiRuntime::StepNOERROR() 2682 { 2683 pInst->aErrorMsg.clear(); 2684 pInst->nErr = ERRCODE_NONE; 2685 pInst->nErl = 0; 2686 nError = ERRCODE_NONE; 2687 SbxErrObject::getUnoErrObject()->Clear(); 2688 bError = false; 2689 } 2690 2691 // leave UP 2692 2693 void SbiRuntime::StepLEAVE() 2694 { 2695 bRun = false; 2696 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed ) 2697 if ( bInError && pError ) 2698 { 2699 SbxErrObject::getUnoErrObject()->Clear(); 2700 } 2701 } 2702 2703 void SbiRuntime::StepCHANNEL() // TOS = channel number 2704 { 2705 SbxVariableRef pChan = PopVar(); 2706 short nChan = pChan->GetInteger(); 2707 pIosys->SetChannel( nChan ); 2708 Error( pIosys->GetError() ); 2709 } 2710 2711 void SbiRuntime::StepCHANNEL0() 2712 { 2713 pIosys->ResetChannel(); 2714 } 2715 2716 void SbiRuntime::StepPRINT() // print TOS 2717 { 2718 SbxVariableRef p = PopVar(); 2719 OUString s1 = p->GetOUString(); 2720 OUString s; 2721 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE ) 2722 { 2723 s = " "; // one blank before 2724 } 2725 s += s1; 2726 pIosys->Write( s ); 2727 Error( pIosys->GetError() ); 2728 } 2729 2730 void SbiRuntime::StepPRINTF() // print TOS in field 2731 { 2732 SbxVariableRef p = PopVar(); 2733 OUString s1 = p->GetOUString(); 2734 OUStringBuffer s; 2735 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE ) 2736 { 2737 s.append(' '); 2738 } 2739 s.append(s1); 2740 comphelper::string::padToLength(s, 14, ' '); 2741 pIosys->Write( s.makeStringAndClear() ); 2742 Error( pIosys->GetError() ); 2743 } 2744 2745 void SbiRuntime::StepWRITE() // write TOS 2746 { 2747 SbxVariableRef p = PopVar(); 2748 // Does the string have to be encapsulated? 2749 char ch = 0; 2750 switch (p->GetType() ) 2751 { 2752 case SbxSTRING: ch = '"'; break; 2753 case SbxCURRENCY: 2754 case SbxBOOL: 2755 case SbxDATE: ch = '#'; break; 2756 default: break; 2757 } 2758 OUString s; 2759 if( ch ) 2760 { 2761 s += OUStringChar(ch); 2762 } 2763 s += p->GetOUString(); 2764 if( ch ) 2765 { 2766 s += OUStringChar(ch); 2767 } 2768 pIosys->Write( s ); 2769 Error( pIosys->GetError() ); 2770 } 2771 2772 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos 2773 { 2774 SbxVariableRef pTos1 = PopVar(); 2775 SbxVariableRef pTos = PopVar(); 2776 OUString aDest = pTos1->GetOUString(); 2777 OUString aSource = pTos->GetOUString(); 2778 2779 if( hasUno() ) 2780 { 2781 implStepRenameUCB( aSource, aDest ); 2782 } 2783 else 2784 { 2785 implStepRenameOSL( aSource, aDest ); 2786 } 2787 } 2788 2789 // TOS = Prompt 2790 2791 void SbiRuntime::StepPROMPT() 2792 { 2793 SbxVariableRef p = PopVar(); 2794 OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding())); 2795 pIosys->SetPrompt( aStr ); 2796 } 2797 2798 // Set Restart point 2799 2800 void SbiRuntime::StepRESTART() 2801 { 2802 pRestart = pCode; 2803 } 2804 2805 // empty expression on stack for missing parameter 2806 2807 void SbiRuntime::StepEMPTY() 2808 { 2809 // #57915 The semantics of StepEMPTY() is the representation of a missing argument. 2810 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error 2811 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept 2812 // to simplify matters. 2813 SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); 2814 xVar->PutErr( 448 ); 2815 // tdf#79426, tdf#125180 - add additional information about a missing parameter 2816 SetIsMissing( xVar.get() ); 2817 PushVar( xVar.get() ); 2818 } 2819 2820 // TOS = error code 2821 2822 void SbiRuntime::StepERROR() 2823 { 2824 SbxVariableRef refCode = PopVar(); 2825 sal_uInt16 n = refCode->GetUShort(); 2826 ErrCode error = StarBASIC::GetSfxFromVBError( n ); 2827 if ( bVBAEnabled ) 2828 { 2829 pInst->Error( error ); 2830 } 2831 else 2832 { 2833 Error( error ); 2834 } 2835 } 2836 2837 // loading a numeric constant (+ID) 2838 2839 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 ) 2840 { 2841 // tdf#143707 - check if the data type character was added after the string termination symbol 2842 SbxDataType eTypeStr; 2843 // #57844 use localized function 2844 OUString aStr = pImg->GetString(static_cast<short>(nOp1), &eTypeStr); 2845 // also allow , !!! 2846 sal_Int32 iComma = aStr.indexOf(','); 2847 if( iComma >= 0 ) 2848 { 2849 aStr = aStr.replaceAt(iComma, 1, "."); 2850 } 2851 sal_Int32 nParseEnd = 0; 2852 rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok; 2853 double n = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd ); 2854 2855 // tdf#131296 - retrieve data type put in SbiExprNode::Gen 2856 SbxDataType eType = SbxDOUBLE; 2857 if ( nParseEnd < aStr.getLength() ) 2858 { 2859 // tdf#143707 - Check if there was a data type character after the numeric constant, 2860 // added by older versions of the fix of the default values for strings. 2861 switch ( aStr[nParseEnd] ) 2862 { 2863 // See GetSuffixType in basic/source/comp/scanner.cxx for type characters 2864 case '%': eType = SbxINTEGER; break; 2865 case '&': eType = SbxLONG; break; 2866 case '!': eType = SbxSINGLE; break; 2867 case '@': eType = SbxCURRENCY; break; 2868 // tdf#142460 - properly handle boolean values in string pool 2869 case 'b': eType = SbxBOOL; break; 2870 } 2871 } 2872 // tdf#143707 - if the data type character is different from the default value, it was added 2873 // in basic/source/comp/symtbl.cxx. Hence, change the type of the numeric constant to be loaded. 2874 else if (eTypeStr != SbxSTRING) 2875 { 2876 eType = eTypeStr; 2877 } 2878 SbxVariable* p = new SbxVariable( eType ); 2879 p->PutDouble( n ); 2880 // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors 2881 p->ResetFlag( SbxFlagBits::Fixed ); 2882 PushVar( p ); 2883 } 2884 2885 // loading a string constant (+ID) 2886 2887 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 ) 2888 { 2889 SbxVariable* p = new SbxVariable; 2890 p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) ); 2891 PushVar( p ); 2892 } 2893 2894 // Immediate Load (+value) 2895 // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images 2896 2897 void SbiRuntime::StepLOADI( sal_uInt32 nOp1 ) 2898 { 2899 SbxVariable* p = new SbxVariable; 2900 p->PutInteger( static_cast<sal_Int16>( nOp1 ) ); 2901 PushVar( p ); 2902 } 2903 2904 // store a named argument in Argv (+Arg-no. from 1!) 2905 2906 void SbiRuntime::StepARGN( sal_uInt32 nOp1 ) 2907 { 2908 if( !refArgv.is() ) 2909 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2910 else 2911 { 2912 OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) ); 2913 SbxVariableRef pVal = PopVar(); 2914 if( bVBAEnabled && 2915 ( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr 2916 || dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr 2917 || dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) ) 2918 { 2919 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast 2920 if ( pVal->GetType() == SbxEMPTY ) 2921 pVal->Broadcast( SfxHintId::BasicDataWanted ); 2922 // evaluate methods and properties! 2923 SbxVariable* pRes = new SbxVariable( *pVal ); 2924 pVal = pRes; 2925 } 2926 refArgv->Put(pVal.get(), nArgc); 2927 refArgv->PutAlias(aAlias, nArgc++); 2928 } 2929 } 2930 2931 // converting the type of an argument in Argv for DECLARE-Fkt. (+type) 2932 2933 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 ) 2934 { 2935 if( !refArgv.is() ) 2936 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2937 else 2938 { 2939 bool bByVal = (nOp1 & 0x8000) != 0; // Is BYVAL requested? 2940 SbxDataType t = static_cast<SbxDataType>(nOp1 & 0x7FFF); 2941 SbxVariable* pVar = refArgv->Get(refArgv->Count() - 1); // last Arg 2942 2943 // check BYVAL 2944 if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL 2945 { 2946 // parameter is a reference 2947 if( bByVal ) 2948 { 2949 // Call by Value is requested -> create a copy 2950 pVar = new SbxVariable( *pVar ); 2951 pVar->SetFlag( SbxFlagBits::ReadWrite ); 2952 refExprStk->Put(pVar, refArgv->Count() - 1); 2953 } 2954 else 2955 pVar->SetFlag( SbxFlagBits::Reference ); // Ref-Flag for DllMgr 2956 } 2957 else 2958 { 2959 // parameter is NO reference 2960 if( bByVal ) 2961 pVar->ResetFlag( SbxFlagBits::Reference ); // no reference -> OK 2962 else 2963 Error( ERRCODE_BASIC_BAD_PARAMETERS ); // reference needed 2964 } 2965 2966 if( pVar->GetType() != t ) 2967 { 2968 // variant for correct conversion 2969 // besides error, if SbxBYREF 2970 pVar->Convert( SbxVARIANT ); 2971 pVar->Convert( t ); 2972 } 2973 } 2974 } 2975 2976 // bring string to a definite length (+length) 2977 2978 void SbiRuntime::StepPAD( sal_uInt32 nOp1 ) 2979 { 2980 SbxVariable* p = GetTOS(); 2981 OUString s = p->GetOUString(); 2982 sal_Int32 nLen(nOp1); 2983 if( s.getLength() == nLen ) 2984 return; 2985 2986 OUStringBuffer aBuf(s); 2987 if (aBuf.getLength() > nLen) 2988 { 2989 comphelper::string::truncateToLength(aBuf, nLen); 2990 } 2991 else 2992 { 2993 comphelper::string::padToLength(aBuf, nLen, ' '); 2994 } 2995 s = aBuf.makeStringAndClear(); 2996 } 2997 2998 // jump (+target) 2999 3000 void SbiRuntime::StepJUMP( sal_uInt32 nOp1 ) 3001 { 3002 #ifdef DBG_UTIL 3003 // #QUESTION shouldn't this be 3004 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() ) 3005 if( nOp1 >= pImg->GetCodeSize() ) 3006 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3007 #endif 3008 pCode = pImg->GetCode() + nOp1; 3009 } 3010 3011 bool SbiRuntime::EvaluateTopOfStackAsBool() 3012 { 3013 SbxVariableRef tos = PopVar(); 3014 // In a test e.g. If Null then 3015 // will evaluate Null will act as if False 3016 if ( bVBAEnabled && tos->IsNull() ) 3017 { 3018 return false; 3019 } 3020 if ( tos->IsObject() ) 3021 { 3022 //GetBool applied to an Object attempts to dereference and evaluate 3023 //the underlying value as Bool. Here, we're checking rather that 3024 //it is not null 3025 return tos->GetObject(); 3026 } 3027 else 3028 { 3029 return tos->GetBool(); 3030 } 3031 } 3032 3033 // evaluate TOS, conditional jump (+target) 3034 3035 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 ) 3036 { 3037 if ( EvaluateTopOfStackAsBool() ) 3038 { 3039 StepJUMP( nOp1 ); 3040 } 3041 } 3042 3043 // evaluate TOS, conditional jump (+target) 3044 3045 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 ) 3046 { 3047 if ( !EvaluateTopOfStackAsBool() ) 3048 { 3049 StepJUMP( nOp1 ); 3050 } 3051 } 3052 3053 // evaluate TOS, jump into JUMP-table (+MaxVal) 3054 // looks like this: 3055 // ONJUMP 2 3056 // JUMP target1 3057 // JUMP target2 3058 3059 // if 0x8000 is set in the operand, push the return address (ON..GOSUB) 3060 3061 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 ) 3062 { 3063 SbxVariableRef p = PopVar(); 3064 sal_Int16 n = p->GetInteger(); 3065 if( nOp1 & 0x8000 ) 3066 { 3067 nOp1 &= 0x7FFF; 3068 PushGosub( pCode + 5 * nOp1 ); 3069 } 3070 if( n < 1 || o3tl::make_unsigned(n) > nOp1 ) 3071 n = static_cast<sal_Int16>( nOp1 + 1 ); 3072 nOp1 = static_cast<sal_uInt32>(pCode - pImg->GetCode()) + 5 * --n; 3073 StepJUMP( nOp1 ); 3074 } 3075 3076 // UP-call (+target) 3077 3078 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 ) 3079 { 3080 PushGosub( pCode ); 3081 if( nOp1 >= pImg->GetCodeSize() ) 3082 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3083 pCode = pImg->GetCode() + nOp1; 3084 } 3085 3086 // UP-return (+0 or target) 3087 3088 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 ) 3089 { 3090 PopGosub(); 3091 if( nOp1 ) 3092 StepJUMP( nOp1 ); 3093 } 3094 3095 // check FOR-variable (+Endlabel) 3096 3097 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 ) 3098 { 3099 if( !pForStk ) 3100 { 3101 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3102 return; 3103 } 3104 3105 bool bEndLoop = false; 3106 switch( pForStk->eForType ) 3107 { 3108 case ForType::To: 3109 { 3110 SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT; 3111 if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) ) 3112 bEndLoop = true; 3113 if (SbxBase::IsError()) 3114 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3115 break; 3116 } 3117 case ForType::EachArray: 3118 { 3119 SbiForStack* p = pForStk; 3120 if (!p->refEnd) 3121 { 3122 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3123 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3124 } 3125 else if (p->pArrayCurIndices == nullptr) 3126 { 3127 bEndLoop = true; 3128 } 3129 else 3130 { 3131 SbxDimArray* pArray = reinterpret_cast<SbxDimArray*>(p->refEnd.get()); 3132 sal_Int32 nDims = pArray->GetDims(); 3133 3134 // Empty array? 3135 if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] ) 3136 { 3137 bEndLoop = true; 3138 break; 3139 } 3140 SbxVariable* pVal = pArray->Get(p->pArrayCurIndices.get()); 3141 *(p->refVar) = *pVal; 3142 3143 bool bFoundNext = false; 3144 for(sal_Int32 i = 0 ; i < nDims ; i++ ) 3145 { 3146 if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] ) 3147 { 3148 bFoundNext = true; 3149 p->pArrayCurIndices[i]++; 3150 for( sal_Int32 j = i - 1 ; j >= 0 ; j-- ) 3151 p->pArrayCurIndices[j] = p->pArrayLowerBounds[j]; 3152 break; 3153 } 3154 } 3155 if( !bFoundNext ) 3156 { 3157 p->pArrayCurIndices.reset(); 3158 } 3159 } 3160 break; 3161 } 3162 case ForType::EachCollection: 3163 { 3164 if (!pForStk->refEnd) 3165 { 3166 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3167 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3168 break; 3169 } 3170 3171 BasicCollection* pCollection = static_cast<BasicCollection*>(pForStk->refEnd.get()); 3172 SbxArrayRef xItemArray = pCollection->xItemArray; 3173 sal_Int32 nCount = xItemArray->Count(); 3174 if( pForStk->nCurCollectionIndex < nCount ) 3175 { 3176 SbxVariable* pRes = xItemArray->Get(pForStk->nCurCollectionIndex); 3177 pForStk->nCurCollectionIndex++; 3178 (*pForStk->refVar) = *pRes; 3179 } 3180 else 3181 { 3182 bEndLoop = true; 3183 } 3184 break; 3185 } 3186 case ForType::EachXEnumeration: 3187 { 3188 SbiForStack* p = pForStk; 3189 if (!p->xEnumeration) 3190 { 3191 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3192 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3193 } 3194 else if (p->xEnumeration->hasMoreElements()) 3195 { 3196 Any aElem = p->xEnumeration->nextElement(); 3197 SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); 3198 unoToSbxValue( xVar.get(), aElem ); 3199 (*pForStk->refVar) = *xVar; 3200 } 3201 else 3202 { 3203 bEndLoop = true; 3204 } 3205 break; 3206 } 3207 case ForType::Error: 3208 { 3209 // We are in Resume Next mode after failed loop initialization 3210 bEndLoop = true; 3211 Error(ERRCODE_BASIC_BAD_PARAMETER); 3212 break; 3213 } 3214 } 3215 if( bEndLoop ) 3216 { 3217 PopFor(); 3218 StepJUMP( nOp1 ); 3219 } 3220 } 3221 3222 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target) 3223 3224 void SbiRuntime::StepCASETO( sal_uInt32 nOp1 ) 3225 { 3226 if (!refCaseStk.is() || !refCaseStk->Count()) 3227 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3228 else 3229 { 3230 SbxVariableRef xTo = PopVar(); 3231 SbxVariableRef xFrom = PopVar(); 3232 SbxVariableRef xCase = refCaseStk->Get(refCaseStk->Count() - 1); 3233 if( *xCase >= *xFrom && *xCase <= *xTo ) 3234 StepJUMP( nOp1 ); 3235 } 3236 } 3237 3238 3239 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 ) 3240 { 3241 const sal_uInt8* p = pCode; 3242 StepJUMP( nOp1 ); 3243 pError = pCode; 3244 pCode = p; 3245 pInst->aErrorMsg.clear(); 3246 pInst->nErr = ERRCODE_NONE; 3247 pInst->nErl = 0; 3248 nError = ERRCODE_NONE; 3249 SbxErrObject::getUnoErrObject()->Clear(); 3250 } 3251 3252 // Resume after errors (+0=statement, 1=next or Label) 3253 3254 void SbiRuntime::StepRESUME( sal_uInt32 nOp1 ) 3255 { 3256 // #32714 Resume without error? -> error 3257 if( !bInError ) 3258 { 3259 Error( ERRCODE_BASIC_BAD_RESUME ); 3260 return; 3261 } 3262 if( nOp1 ) 3263 { 3264 // set Code-pointer to the next statement 3265 sal_uInt16 n1, n2; 3266 pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg ); 3267 } 3268 else 3269 pCode = pErrStmnt; 3270 if ( pError ) // current in error handler ( and got a Resume Next statement ) 3271 SbxErrObject::getUnoErrObject()->Clear(); 3272 3273 if( nOp1 > 1 ) 3274 StepJUMP( nOp1 ); 3275 pInst->aErrorMsg.clear(); 3276 pInst->nErr = ERRCODE_NONE; 3277 pInst->nErl = 0; 3278 nError = ERRCODE_NONE; 3279 bInError = false; 3280 } 3281 3282 // close channel (+channel, 0=all) 3283 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 ) 3284 { 3285 ErrCode err; 3286 if( !nOp1 ) 3287 pIosys->Shutdown(); 3288 else 3289 { 3290 err = pIosys->GetError(); 3291 if( !err ) 3292 { 3293 pIosys->Close(); 3294 } 3295 } 3296 err = pIosys->GetError(); 3297 Error( err ); 3298 } 3299 3300 // output character (+char) 3301 3302 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 ) 3303 { 3304 OUString s(static_cast<sal_Unicode>(nOp1)); 3305 pIosys->Write( s ); 3306 Error( pIosys->GetError() ); 3307 } 3308 3309 // check whether TOS is a certain object class (+StringID) 3310 3311 bool SbiRuntime::implIsClass( SbxObject const * pObj, const OUString& aClass ) 3312 { 3313 bool bRet = true; 3314 3315 if( !aClass.isEmpty() ) 3316 { 3317 bRet = pObj->IsClass( aClass ); 3318 if( !bRet ) 3319 bRet = aClass.equalsIgnoreAsciiCase( "object" ); 3320 if( !bRet ) 3321 { 3322 const OUString& aObjClass = pObj->GetClassName(); 3323 SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass ); 3324 if( pClassMod ) 3325 { 3326 SbClassData* pClassData = pClassMod->pClassData.get(); 3327 if (pClassData != nullptr ) 3328 { 3329 SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxClassType::DontCare ); 3330 bRet = (pClassVar != nullptr); 3331 } 3332 } 3333 } 3334 } 3335 return bRet; 3336 } 3337 3338 bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal, 3339 const OUString& aClass, bool bRaiseErrors, bool bDefault ) 3340 { 3341 bool bOk = bDefault; 3342 3343 SbxDataType t = refVal->GetType(); 3344 SbxVariable* pVal = refVal.get(); 3345 // we don't know the type of uno properties that are (maybevoid) 3346 if ( t == SbxEMPTY ) 3347 { 3348 if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) ) 3349 { 3350 t = pProp->getRealType(); 3351 } 3352 } 3353 if( t == SbxOBJECT || bVBAEnabled ) 3354 { 3355 SbxObject* pObj = dynamic_cast<SbxObject*>(pVal); 3356 if (!pObj) 3357 { 3358 pObj = dynamic_cast<SbxObject*>(refVal->GetObject()); 3359 } 3360 if( pObj ) 3361 { 3362 if( !implIsClass( pObj, aClass ) ) 3363 { 3364 SbUnoObject* pUnoObj(nullptr); 3365 if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration()) 3366 { 3367 pUnoObj = dynamic_cast<SbUnoObject*>(pObj); 3368 } 3369 3370 if (pUnoObj) 3371 bOk = checkUnoObjectType(*pUnoObj, aClass); 3372 else 3373 bOk = false; 3374 if ( !bOk && bRaiseErrors ) 3375 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 3376 } 3377 else 3378 { 3379 bOk = true; 3380 3381 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pObj ); 3382 if( pClassModuleObject != nullptr ) 3383 pClassModuleObject->triggerInitializeEvent(); 3384 } 3385 } 3386 } 3387 else 3388 { 3389 if( bRaiseErrors ) 3390 Error( ERRCODE_BASIC_NEEDS_OBJECT ); 3391 bOk = false; 3392 } 3393 return bOk; 3394 } 3395 3396 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt ) 3397 { 3398 SbxVariableRef refVal = PopVar(); 3399 SbxVariableRef refVar = PopVar(); 3400 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) ); 3401 3402 bool bOk = checkClass_Impl( refVal, aClass, true, true ); 3403 if( bOk ) 3404 { 3405 StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set 3406 } 3407 } 3408 3409 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 ) 3410 { 3411 StepSETCLASS_impl( nOp1, false ); 3412 } 3413 3414 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 ) 3415 { 3416 StepSETCLASS_impl( nOp1, true ); 3417 } 3418 3419 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 ) 3420 { 3421 SbxVariableRef xObjVal = PopVar(); 3422 OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) ); 3423 bool bDefault = !bVBAEnabled; 3424 bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault ); 3425 3426 SbxVariable* pRet = new SbxVariable; 3427 pRet->PutBool( bOk ); 3428 PushVar( pRet ); 3429 } 3430 3431 // define library for following declare-call 3432 3433 void SbiRuntime::StepLIB( sal_uInt32 nOp1 ) 3434 { 3435 aLibName = pImg->GetString( static_cast<short>( nOp1 ) ); 3436 } 3437 3438 // TOS is incremented by BASE, BASE is pushed before (+BASE) 3439 // This opcode is pushed before DIM/REDIM-commands, 3440 // if there's been only one index named. 3441 3442 void SbiRuntime::StepBASED( sal_uInt32 nOp1 ) 3443 { 3444 SbxVariable* p1 = new SbxVariable; 3445 SbxVariableRef x2 = PopVar(); 3446 3447 // #109275 Check compatibility mode 3448 bool bCompatible = ((nOp1 & 0x8000) != 0); 3449 sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1 3450 p1->PutInteger( uBase ); 3451 if( !bCompatible ) 3452 { 3453 // tdf#85371 - grant explicitly write access to the dimension variable 3454 // since in Star/OpenOffice Basic the upper index border is affected, 3455 // and the dimension variable could be the name of the method itself. 3456 ScopedWritableGuard aGuard(x2, x2.get() == pMeth); 3457 x2->Compute( SbxPLUS, *p1 ); 3458 } 3459 PushVar( x2.get() ); // first the Expr 3460 PushVar( p1 ); // then the Base 3461 } 3462 3463 // the bits in the String-ID: 3464 // 0x8000 - Argv is reserved 3465 3466 SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, 3467 ErrCode nNotFound, bool bLocal, bool bStatic ) 3468 { 3469 bool bIsVBAInterOp = SbiRuntime::isVBAEnabled(); 3470 if( bIsVBAInterOp ) 3471 { 3472 StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib; 3473 if( pMSOMacroRuntimeLib != nullptr ) 3474 { 3475 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::ExtSearch ); 3476 } 3477 } 3478 3479 SbxVariable* pElem = nullptr; 3480 if( !pObj ) 3481 { 3482 Error( ERRCODE_BASIC_NO_OBJECT ); 3483 pElem = new SbxVariable; 3484 } 3485 else 3486 { 3487 bool bFatalError = false; 3488 SbxDataType t = static_cast<SbxDataType>(nOp2); 3489 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) ); 3490 // Hacky capture of Evaluate [] syntax 3491 // this should be tackled I feel at the pcode level 3492 if ( bIsVBAInterOp && aName.startsWith("[") ) 3493 { 3494 // emulate pcode here 3495 StepARGC(); 3496 // pseudo StepLOADSC 3497 OUString sArg = aName.copy( 1, aName.getLength() - 2 ); 3498 SbxVariable* p = new SbxVariable; 3499 p->PutString( sArg ); 3500 PushVar( p ); 3501 StepARGV(); 3502 nOp1 = nOp1 | 0x8000; // indicate params are present 3503 aName = "Evaluate"; 3504 } 3505 if( bLocal ) 3506 { 3507 if ( bStatic && pMeth ) 3508 { 3509 pElem = pMeth->GetStatics()->Find( aName, SbxClassType::DontCare ); 3510 } 3511 3512 if ( !pElem ) 3513 { 3514 pElem = refLocals->Find( aName, SbxClassType::DontCare ); 3515 } 3516 } 3517 if( !pElem ) 3518 { 3519 bool bSave = rBasic.bNoRtl; 3520 rBasic.bNoRtl = true; 3521 pElem = pObj->Find( aName, SbxClassType::DontCare ); 3522 3523 // #110004, #112015: Make private really private 3524 if( bLocal && pElem ) // Local as flag for global search 3525 { 3526 if( pElem->IsSet( SbxFlagBits::Private ) ) 3527 { 3528 SbiInstance* pInst_ = GetSbData()->pInst; 3529 if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() ) 3530 { 3531 pElem = nullptr; // Found but in wrong module! 3532 } 3533 // Interfaces: Use SbxFlagBits::ExtFound 3534 } 3535 } 3536 rBasic.bNoRtl = bSave; 3537 3538 // is it a global uno-identifier? 3539 if( bLocal && !pElem ) 3540 { 3541 bool bSetName = true; // preserve normal behaviour 3542 3543 // i#i68894# if VBAInterOp favour searching vba globals 3544 // over searching for uno classes 3545 if ( bVBAEnabled ) 3546 { 3547 // Try Find in VBA symbols space 3548 pElem = rBasic.VBAFind( aName, SbxClassType::DontCare ); 3549 if ( pElem ) 3550 { 3551 bSetName = false; // don't overwrite uno name 3552 } 3553 else 3554 { 3555 pElem = VBAConstantHelper::instance().getVBAConstant( aName ); 3556 } 3557 } 3558 3559 if( !pElem ) 3560 { 3561 // #72382 ATTENTION! ALWAYS returns a result now 3562 // because of unknown modules! 3563 SbUnoClass* pUnoClass = findUnoClass( aName ); 3564 if( pUnoClass ) 3565 { 3566 pElem = new SbxVariable( t ); 3567 SbxValues aRes( SbxOBJECT ); 3568 aRes.pObj = pUnoClass; 3569 pElem->SbxVariable::Put( aRes ); 3570 } 3571 } 3572 3573 // #62939 If a uno-class has been found, the wrapper 3574 // object has to be held, because the uno-class, e. g. 3575 // "stardiv", has to be read out of the registry 3576 // every time again otherwise 3577 if( pElem ) 3578 { 3579 // #63774 May not be saved too!!! 3580 pElem->SetFlag( SbxFlagBits::DontStore ); 3581 pElem->SetFlag( SbxFlagBits::NoModify); 3582 3583 // #72382 save locally, all variables that have been declared 3584 // implicit would become global automatically otherwise! 3585 if ( bSetName ) 3586 { 3587 pElem->SetName( aName ); 3588 } 3589 refLocals->Put(pElem, refLocals->Count()); 3590 } 3591 } 3592 3593 if( !pElem ) 3594 { 3595 // not there and not in the object? 3596 // don't establish if that thing has parameters! 3597 if( nOp1 & 0x8000 ) 3598 { 3599 bFatalError = true; 3600 } 3601 3602 // else, if there are parameters, use different error code 3603 if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) ) 3604 { 3605 // #39108 if explicit and as ELEM always a fatal error 3606 bFatalError = true; 3607 3608 3609 if( !( nOp1 & 0x8000 ) && nNotFound == ERRCODE_BASIC_PROC_UNDEFINED ) 3610 { 3611 nNotFound = ERRCODE_BASIC_VAR_UNDEFINED; 3612 } 3613 } 3614 if( bFatalError ) 3615 { 3616 // #39108 use dummy variable instead of fatal error 3617 if( !xDummyVar.is() ) 3618 { 3619 xDummyVar = new SbxVariable( SbxVARIANT ); 3620 } 3621 pElem = xDummyVar.get(); 3622 3623 ClearArgvStack(); 3624 3625 Error( nNotFound, aName ); 3626 } 3627 else 3628 { 3629 if ( bStatic ) 3630 { 3631 pElem = StepSTATIC_Impl( aName, t, 0 ); 3632 } 3633 if ( !pElem ) 3634 { 3635 pElem = new SbxVariable( t ); 3636 if( t != SbxVARIANT ) 3637 { 3638 pElem->SetFlag( SbxFlagBits::Fixed ); 3639 } 3640 pElem->SetName( aName ); 3641 refLocals->Put(pElem, refLocals->Count()); 3642 } 3643 } 3644 } 3645 } 3646 // #39108 Args can already be deleted! 3647 if( !bFatalError ) 3648 { 3649 SetupArgs( pElem, nOp1 ); 3650 } 3651 // because a particular call-type is requested 3652 if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem)) 3653 { 3654 // shall the type be converted? 3655 SbxDataType t2 = pElem->GetType(); 3656 bool bSet = false; 3657 if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE ) 3658 { 3659 if( t != SbxVARIANT && t != t2 && 3660 t >= SbxINTEGER && t <= SbxSTRING ) 3661 { 3662 pElem->SetType( t ); 3663 bSet = true; 3664 } 3665 } 3666 // assign pElem to a Ref, to delete a temp-var if applicable 3667 SbxVariableRef xDeleteRef = pElem; 3668 3669 // remove potential rests of the last call of the SbxMethod 3670 // free Write before, so that there's no error 3671 SbxFlagBits nSavFlags = pElem->GetFlags(); 3672 pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast ); 3673 pElem->SbxValue::Clear(); 3674 pElem->SetFlags( nSavFlags ); 3675 3676 // don't touch before setting, as e. g. LEFT() 3677 // has to know the difference between Left$() and Left() 3678 3679 // because the methods' parameters are cut away in PopVar() 3680 SbxVariable* pNew = new SbxMethod(*pMethod); 3681 //OLD: SbxVariable* pNew = new SbxVariable( *pElem ); 3682 3683 pElem->SetParameters(nullptr); 3684 pNew->SetFlag( SbxFlagBits::ReadWrite ); 3685 3686 if( bSet ) 3687 { 3688 pElem->SetType( t2 ); 3689 } 3690 pElem = pNew; 3691 } 3692 // consider index-access for UnoObjects 3693 // definitely we want this for VBA where properties are often 3694 // collections ( which need index access ), but lets only do 3695 // this if we actually have params following 3696 else if( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() ) 3697 { 3698 SbxVariableRef xDeleteRef = pElem; 3699 3700 // dissolve the notify while copying variable 3701 SbxVariable* pNew = new SbxVariable( *pElem ); 3702 pElem->SetParameters( nullptr ); 3703 pElem = pNew; 3704 } 3705 } 3706 return CheckArray( pElem ); 3707 } 3708 3709 // for current scope (e. g. query from BASIC-IDE) 3710 SbxBase* SbiRuntime::FindElementExtern( const OUString& rName ) 3711 { 3712 // don't expect pMeth to be != 0, as there are none set 3713 // in the RunInit yet 3714 3715 SbxVariable* pElem = nullptr; 3716 if( !pMod || rName.isEmpty() ) 3717 { 3718 return nullptr; 3719 } 3720 if( refLocals.is() ) 3721 { 3722 pElem = refLocals->Find( rName, SbxClassType::DontCare ); 3723 } 3724 if ( !pElem && pMeth ) 3725 { 3726 // for statics, set the method's name in front 3727 OUString aMethName = pMeth->GetName() + ":" + rName; 3728 pElem = pMod->Find(aMethName, SbxClassType::DontCare); 3729 } 3730 3731 // search in parameter list 3732 if( !pElem && pMeth ) 3733 { 3734 SbxInfo* pInfo = pMeth->GetInfo(); 3735 if( pInfo && refParams.is() ) 3736 { 3737 sal_uInt32 nParamCount = refParams->Count(); 3738 assert(nParamCount <= std::numeric_limits<sal_uInt16>::max()); 3739 sal_uInt16 j = 1; 3740 const SbxParamInfo* pParam = pInfo->GetParam( j ); 3741 while( pParam ) 3742 { 3743 if( pParam->aName.equalsIgnoreAsciiCase( rName ) ) 3744 { 3745 if( j >= nParamCount ) 3746 { 3747 // Parameter is missing 3748 pElem = new SbxVariable( SbxSTRING ); 3749 pElem->PutString( "<missing parameter>"); 3750 } 3751 else 3752 { 3753 pElem = refParams->Get(j); 3754 } 3755 break; 3756 } 3757 pParam = pInfo->GetParam( ++j ); 3758 } 3759 } 3760 } 3761 3762 // search in module 3763 if( !pElem ) 3764 { 3765 bool bSave = rBasic.bNoRtl; 3766 rBasic.bNoRtl = true; 3767 pElem = pMod->Find( rName, SbxClassType::DontCare ); 3768 rBasic.bNoRtl = bSave; 3769 } 3770 return pElem; 3771 } 3772 3773 3774 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 ) 3775 { 3776 if( nOp1 & 0x8000 ) 3777 { 3778 if( !refArgv.is() ) 3779 { 3780 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3781 } 3782 bool bHasNamed = false; 3783 sal_uInt32 i; 3784 sal_uInt32 nArgCount = refArgv->Count(); 3785 for( i = 1 ; i < nArgCount ; i++ ) 3786 { 3787 if (!refArgv->GetAlias(i).isEmpty()) 3788 { 3789 bHasNamed = true; break; 3790 } 3791 } 3792 if( bHasNamed ) 3793 { 3794 SbxInfo* pInfo = p->GetInfo(); 3795 if( !pInfo ) 3796 { 3797 bool bError_ = true; 3798 3799 SbUnoMethod* pUnoMethod = dynamic_cast<SbUnoMethod*>( p ); 3800 SbUnoProperty* pUnoProperty = dynamic_cast<SbUnoProperty*>( p ); 3801 if( pUnoMethod || pUnoProperty ) 3802 { 3803 SbUnoObject* pParentUnoObj = dynamic_cast<SbUnoObject*>( p->GetParent() ); 3804 if( pParentUnoObj ) 3805 { 3806 Any aUnoAny = pParentUnoObj->getUnoAny(); 3807 Reference< XInvocation > xInvocation; 3808 aUnoAny >>= xInvocation; 3809 if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() ) 3810 { 3811 bError_ = false; 3812 3813 sal_uInt32 nCurPar = 1; 3814 AutomationNamedArgsSbxArray* pArg = 3815 new AutomationNamedArgsSbxArray( nArgCount ); 3816 OUString* pNames = pArg->getNames().getArray(); 3817 for( i = 1 ; i < nArgCount ; i++ ) 3818 { 3819 SbxVariable* pVar = refArgv->Get(i); 3820 OUString aName = refArgv->GetAlias(i); 3821 if (!aName.isEmpty()) 3822 { 3823 pNames[i] = aName; 3824 } 3825 pArg->Put(pVar, nCurPar++); 3826 } 3827 refArgv = pArg; 3828 } 3829 } 3830 } 3831 else if( bVBAEnabled && p->GetType() == SbxOBJECT && (dynamic_cast<const SbxMethod*>( p) == nullptr || !p->IsBroadcaster()) ) 3832 { 3833 // Check for default method with named parameters 3834 SbxBaseRef xObj = p->GetObject(); 3835 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( xObj.get() )) 3836 { 3837 Any aAny = pUnoObj->getUnoAny(); 3838 3839 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 3840 { 3841 Reference< XDefaultMethod > xDfltMethod( aAny, UNO_QUERY ); 3842 3843 OUString sDefaultMethod; 3844 if ( xDfltMethod.is() ) 3845 { 3846 sDefaultMethod = xDfltMethod->getDefaultMethodName(); 3847 } 3848 if ( !sDefaultMethod.isEmpty() ) 3849 { 3850 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method ); 3851 if( meth != nullptr ) 3852 { 3853 pInfo = meth->GetInfo(); 3854 } 3855 if( pInfo ) 3856 { 3857 bError_ = false; 3858 } 3859 } 3860 } 3861 } 3862 } 3863 if( bError_ ) 3864 { 3865 Error( ERRCODE_BASIC_NO_NAMED_ARGS ); 3866 } 3867 } 3868 else 3869 { 3870 sal_uInt32 nCurPar = 1; 3871 SbxArray* pArg = new SbxArray; 3872 for( i = 1 ; i < nArgCount ; i++ ) 3873 { 3874 SbxVariable* pVar = refArgv->Get(i); 3875 OUString aName = refArgv->GetAlias(i); 3876 if (!aName.isEmpty()) 3877 { 3878 // nCurPar is set to the found parameter 3879 sal_uInt16 j = 1; 3880 const SbxParamInfo* pParam = pInfo->GetParam( j ); 3881 while( pParam ) 3882 { 3883 if( pParam->aName.equalsIgnoreAsciiCase( aName ) ) 3884 { 3885 nCurPar = j; 3886 break; 3887 } 3888 pParam = pInfo->GetParam( ++j ); 3889 } 3890 if( !pParam ) 3891 { 3892 Error( ERRCODE_BASIC_NAMED_NOT_FOUND ); break; 3893 } 3894 } 3895 pArg->Put(pVar, nCurPar++); 3896 } 3897 refArgv = pArg; 3898 } 3899 } 3900 // own var as parameter 0 3901 refArgv->Put(p, 0); 3902 p->SetParameters( refArgv.get() ); 3903 PopArgv(); 3904 } 3905 else 3906 { 3907 p->SetParameters( nullptr ); 3908 } 3909 } 3910 3911 // getting an array element 3912 3913 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem ) 3914 { 3915 SbxArray* pPar; 3916 if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem ) 3917 { 3918 SbxBase* pElemObj = pElem->GetObject(); 3919 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); 3920 pPar = pElem->GetParameters(); 3921 if( pDimArray ) 3922 { 3923 // parameters may be missing, if an array is 3924 // passed as an argument 3925 if( pPar ) 3926 pElem = pDimArray->Get( pPar ); 3927 } 3928 else 3929 { 3930 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj ); 3931 if( pArray ) 3932 { 3933 if( !pPar ) 3934 { 3935 Error( ERRCODE_BASIC_OUT_OF_RANGE ); 3936 pElem = new SbxVariable; 3937 } 3938 else 3939 { 3940 pElem = pArray->Get(pPar->Get(1)->GetInteger()); 3941 } 3942 } 3943 } 3944 3945 // #42940, set parameter 0 to NULL so that var doesn't contain itself 3946 if( pPar ) 3947 { 3948 pPar->Put(nullptr, 0); 3949 } 3950 } 3951 // consider index-access for UnoObjects 3952 else if( pElem->GetType() == SbxOBJECT && 3953 dynamic_cast<const SbxMethod*>( pElem) == nullptr && 3954 ( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) ) 3955 { 3956 pPar = pElem->GetParameters(); 3957 if ( pPar ) 3958 { 3959 // is it a uno-object? 3960 SbxBaseRef pObj = pElem->GetObject(); 3961 if( pObj.is() ) 3962 { 3963 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get())) 3964 { 3965 Any aAny = pUnoObj->getUnoAny(); 3966 3967 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 3968 { 3969 Reference< XIndexAccess > xIndexAccess( aAny, UNO_QUERY ); 3970 if ( !bVBAEnabled ) 3971 { 3972 if( xIndexAccess.is() ) 3973 { 3974 sal_uInt32 nParamCount = pPar->Count() - 1; 3975 if( nParamCount != 1 ) 3976 { 3977 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT ); 3978 return pElem; 3979 } 3980 3981 // get index 3982 sal_Int32 nIndex = pPar->Get(1)->GetLong(); 3983 Reference< XInterface > xRet; 3984 try 3985 { 3986 Any aAny2 = xIndexAccess->getByIndex( nIndex ); 3987 aAny2 >>= xRet; 3988 } 3989 catch (const IndexOutOfBoundsException&) 3990 { 3991 // usually expect converting problem 3992 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE ); 3993 } 3994 3995 // #57847 always create a new variable, else error 3996 // due to PutObject(NULL) at ReadOnly-properties 3997 pElem = new SbxVariable( SbxVARIANT ); 3998 if( xRet.is() ) 3999 { 4000 aAny <<= xRet; 4001 4002 // #67173 don't specify a name so that the real class name is entered 4003 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny )); 4004 pElem->PutObject( xWrapper.get() ); 4005 } 4006 else 4007 { 4008 pElem->PutObject( nullptr ); 4009 } 4010 } 4011 } 4012 else 4013 { 4014 // check if there isn't a default member between the current variable 4015 // and the params, e.g. 4016 // Dim rst1 As New ADODB.Recordset 4017 // " 4018 // val = rst1("FirstName") 4019 // has the default 'Fields' member between rst1 and '("FirstName")' 4020 Any x = aAny; 4021 SbxVariable* pDflt = getDefaultProp( pElem ); 4022 if ( pDflt ) 4023 { 4024 pDflt->Broadcast( SfxHintId::BasicDataWanted ); 4025 SbxBaseRef pDfltObj = pDflt->GetObject(); 4026 if( pDfltObj.is() ) 4027 { 4028 if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get())) 4029 { 4030 pUnoObj = pSbObj; 4031 Any aUnoAny = pUnoObj->getUnoAny(); 4032 4033 if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 4034 x = aUnoAny; 4035 pElem = pDflt; 4036 } 4037 } 4038 } 4039 OUString sDefaultMethod; 4040 4041 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY ); 4042 4043 if ( xDfltMethod.is() ) 4044 { 4045 sDefaultMethod = xDfltMethod->getDefaultMethodName(); 4046 } 4047 else if( xIndexAccess.is() ) 4048 { 4049 sDefaultMethod = "getByIndex"; 4050 } 4051 if ( !sDefaultMethod.isEmpty() ) 4052 { 4053 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method ); 4054 SbxVariableRef refTemp = meth; 4055 if ( refTemp.is() ) 4056 { 4057 meth->SetParameters( pPar ); 4058 SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) ); 4059 pElem = pNew; 4060 } 4061 } 4062 } 4063 } 4064 4065 // #42940, set parameter 0 to NULL so that var doesn't contain itself 4066 pPar->Put(nullptr, 0); 4067 } 4068 else if (BasicCollection* pCol = dynamic_cast<BasicCollection*>(pObj.get())) 4069 { 4070 pElem = new SbxVariable( SbxVARIANT ); 4071 pPar->Put(pElem, 0); 4072 pCol->CollItem( pPar ); 4073 } 4074 } 4075 else if( bVBAEnabled ) // !pObj 4076 { 4077 SbxArray* pParam = pElem->GetParameters(); 4078 if( pParam != nullptr && !pElem->IsSet( SbxFlagBits::VarToDim ) ) 4079 { 4080 Error( ERRCODE_BASIC_NO_OBJECT ); 4081 } 4082 } 4083 } 4084 } 4085 4086 return pElem; 4087 } 4088 4089 // loading an element from the runtime-library (+StringID+type) 4090 4091 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4092 { 4093 PushVar( FindElement( rBasic.pRtl.get(), nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, false ) ); 4094 } 4095 4096 void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, 4097 ErrCode nNotFound, bool bStatic ) 4098 { 4099 if( !refLocals.is() ) 4100 { 4101 refLocals = new SbxArray; 4102 } 4103 PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, true/*bLocal*/, bStatic ) ); 4104 } 4105 // loading a local/global variable (+StringID+type) 4106 4107 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4108 { 4109 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED ); 4110 } 4111 4112 // Search inside a class module (CM) to enable global search in time 4113 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4114 { 4115 4116 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pMod ); 4117 if( pClassModuleObject ) 4118 { 4119 pMod->SetFlag( SbxFlagBits::GlobalSearch ); 4120 } 4121 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED); 4122 4123 if( pClassModuleObject ) 4124 { 4125 pMod->ResetFlag( SbxFlagBits::GlobalSearch ); 4126 } 4127 } 4128 4129 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4130 { 4131 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, true ); 4132 } 4133 4134 // loading an object-element (+StringID+type) 4135 // the object lies on TOS 4136 4137 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4138 { 4139 SbxVariableRef pObjVar = PopVar(); 4140 4141 SbxObject* pObj = dynamic_cast<SbxObject*>( pObjVar.get() ); 4142 if( !pObj ) 4143 { 4144 SbxBase* pObjVarObj = pObjVar->GetObject(); 4145 pObj = dynamic_cast<SbxObject*>( pObjVarObj ); 4146 } 4147 4148 // #56368 save reference at StepElem, otherwise objects could 4149 // lose their reference too early in qualification chains like 4150 // ActiveComponent.Selection(0).Text 4151 // #74254 now per list 4152 if( pObj ) 4153 { 4154 aRefSaved.emplace_back(pObj ); 4155 } 4156 PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) ); 4157 } 4158 4159 /** Loading of a parameter (+offset+type) 4160 If the data type is wrong, create a copy and search for optionals including 4161 the default value. The data type SbxEMPTY shows that no parameters are given. 4162 Get( 0 ) may be EMPTY 4163 4164 @param nOp1 4165 the index of the current parameter being processed, 4166 where the entry of the index 0 is for the return value. 4167 4168 @param nOp2 4169 the data type of the parameter. 4170 */ 4171 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4172 { 4173 sal_uInt16 nIdx = static_cast<sal_uInt16>( nOp1 & 0x7FFF ); 4174 SbxDataType eType = static_cast<SbxDataType>(nOp2); 4175 SbxVariable* pVar; 4176 4177 // #57915 solve missing in a cleaner way 4178 sal_uInt32 nParamCount = refParams->Count(); 4179 if( nIdx >= nParamCount ) 4180 { 4181 sal_uInt16 iLoop = nIdx; 4182 while( iLoop >= nParamCount ) 4183 { 4184 pVar = new SbxVariable(); 4185 pVar->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) 4186 // tdf#79426, tdf#125180 - add additional information about a missing parameter 4187 SetIsMissing( pVar ); 4188 refParams->Put(pVar, iLoop); 4189 iLoop--; 4190 } 4191 } 4192 pVar = refParams->Get(nIdx); 4193 4194 // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing 4195 if( pVar->GetType() == SbxERROR && IsMissing( pVar, 1 ) && nIdx ) 4196 { 4197 // if there's a parameter missing, it can be OPTIONAL 4198 bool bOpt = false; 4199 if( pMeth ) 4200 { 4201 SbxInfo* pInfo = pMeth->GetInfo(); 4202 if ( pInfo ) 4203 { 4204 const SbxParamInfo* pParam = pInfo->GetParam( nIdx ); 4205 if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) ) 4206 { 4207 // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors 4208 pVar->ResetFlag( SbxFlagBits::Fixed ); 4209 // Default value? 4210 sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff); 4211 if( nDefaultId > 0 ) 4212 { 4213 // tdf#143707 - check if the data type character was added after the string 4214 // termination symbol, and convert the variable if it was present. The 4215 // data type character was added in basic/source/comp/symtbl.cxx. 4216 SbxDataType eTypeStr; 4217 OUString aDefaultStr = pImg->GetString( nDefaultId, &eTypeStr ); 4218 pVar = new SbxVariable(pParam-> eType); 4219 pVar->PutString( aDefaultStr ); 4220 if (eTypeStr != SbxSTRING) 4221 pVar->Convert(eTypeStr); 4222 refParams->Put(pVar, nIdx); 4223 } 4224 else if ( SbiRuntime::isVBAEnabled() && eType != SbxVARIANT ) 4225 { 4226 // tdf#36737 - initialize the parameter with the default value of its type 4227 pVar = new SbxVariable( pParam->eType ); 4228 refParams->Put(pVar, nIdx); 4229 } 4230 bOpt = true; 4231 } 4232 } 4233 } 4234 if( !bOpt ) 4235 { 4236 Error( ERRCODE_BASIC_NOT_OPTIONAL ); 4237 } 4238 } 4239 else if( eType != SbxVARIANT && static_cast<SbxDataType>(pVar->GetType() & 0x0FFF ) != eType ) 4240 { 4241 // tdf#43003 - convert parameter to the requested type 4242 pVar->Convert(eType); 4243 } 4244 SetupArgs( pVar, nOp1 ); 4245 PushVar( CheckArray( pVar ) ); 4246 } 4247 4248 // Case-Test (+True-Target+Test-Opcode) 4249 4250 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4251 { 4252 if (!refCaseStk.is() || !refCaseStk->Count()) 4253 { 4254 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 4255 } 4256 else 4257 { 4258 SbxVariableRef xComp = PopVar(); 4259 SbxVariableRef xCase = refCaseStk->Get(refCaseStk->Count() - 1); 4260 if( xCase->Compare( static_cast<SbxOperator>(nOp2), *xComp ) ) 4261 { 4262 StepJUMP( nOp1 ); 4263 } 4264 } 4265 } 4266 4267 // call of a DLL-procedure (+StringID+type) 4268 // the StringID's MSB shows that Argv is occupied 4269 4270 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4271 { 4272 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ); 4273 SbxArray* pArgs = nullptr; 4274 if( nOp1 & 0x8000 ) 4275 { 4276 pArgs = refArgv.get(); 4277 } 4278 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), false ); 4279 aLibName.clear(); 4280 if( nOp1 & 0x8000 ) 4281 { 4282 PopArgv(); 4283 } 4284 } 4285 4286 // call of a DLL-procedure after CDecl (+StringID+type) 4287 4288 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4289 { 4290 OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ); 4291 SbxArray* pArgs = nullptr; 4292 if( nOp1 & 0x8000 ) 4293 { 4294 pArgs = refArgv.get(); 4295 } 4296 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), true ); 4297 aLibName.clear(); 4298 if( nOp1 & 0x8000 ) 4299 { 4300 PopArgv(); 4301 } 4302 } 4303 4304 4305 // beginning of a statement (+Line+Col) 4306 4307 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4308 { 4309 // If the Expr-Stack at the beginning of a statement contains a variable, 4310 // some fool has called X as a function, although it's a variable! 4311 bool bFatalExpr = false; 4312 OUString sUnknownMethodName; 4313 if( nExprLvl > 1 ) 4314 { 4315 bFatalExpr = true; 4316 } 4317 else if( nExprLvl ) 4318 { 4319 SbxVariable* p = refExprStk->Get(0); 4320 if( p->GetRefCount() > 1 && 4321 refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) ) 4322 { 4323 sUnknownMethodName = p->GetName(); 4324 bFatalExpr = true; 4325 } 4326 } 4327 4328 ClearExprStack(); 4329 4330 aRefSaved.clear(); 4331 4332 // We have to cancel hard here because line and column 4333 // would be wrong later otherwise! 4334 if( bFatalExpr) 4335 { 4336 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName ); 4337 return; 4338 } 4339 pStmnt = pCode - 9; 4340 sal_uInt16 nOld = nLine; 4341 nLine = static_cast<short>( nOp1 ); 4342 4343 // #29955 & 0xFF, to filter out for-loop-level 4344 nCol1 = static_cast<short>( nOp2 & 0xFF ); 4345 4346 // find the next STMNT-command to set the final column 4347 // of this statement 4348 4349 nCol2 = 0xffff; 4350 sal_uInt16 n1, n2; 4351 const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 ); 4352 if( p ) 4353 { 4354 if( n1 == nOp1 ) 4355 { 4356 // #29955 & 0xFF, to filter out for-loop-level 4357 nCol2 = (n2 & 0xFF) - 1; 4358 } 4359 } 4360 4361 // #29955 correct for-loop-level, #67452 NOT in the error-handler 4362 if( !bInError ) 4363 { 4364 // (there's a difference here in case of a jump out of a loop) 4365 sal_uInt16 nExpectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 ); 4366 if( !pGosubStk.empty() ) 4367 { 4368 nExpectedForLevel = nExpectedForLevel + pGosubStk.back().nStartForLvl; 4369 } 4370 4371 // if the actual for-level is too small it'd jump out 4372 // of a loop -> corrected 4373 while( nForLvl > nExpectedForLevel ) 4374 { 4375 PopFor(); 4376 } 4377 } 4378 4379 // 16.10.96: #31460 new concept for StepInto/Over/Out 4380 // see explanation at _ImplGetBreakCallLevel 4381 if( pInst->nCallLvl <= pInst->nBreakCallLvl ) 4382 { 4383 StarBASIC* pStepBasic = GetCurrentBasic( &rBasic ); 4384 BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 ); 4385 4386 pInst->CalcBreakCallLevel( nNewFlags ); 4387 } 4388 4389 // break points only at STMNT-commands in a new line! 4390 else if( ( nOp1 != nOld ) 4391 && ( nFlags & BasicDebugFlags::Break ) 4392 && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) ) 4393 { 4394 StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic ); 4395 BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 ); 4396 4397 pInst->CalcBreakCallLevel( nNewFlags ); 4398 } 4399 } 4400 4401 // (+StreamMode+Flags) 4402 // Stack: block length 4403 // channel number 4404 // file name 4405 4406 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4407 { 4408 SbxVariableRef pName = PopVar(); 4409 SbxVariableRef pChan = PopVar(); 4410 SbxVariableRef pLen = PopVar(); 4411 short nBlkLen = pLen->GetInteger(); 4412 short nChan = pChan->GetInteger(); 4413 OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding())); 4414 pIosys->Open( nChan, aName, static_cast<StreamMode>( nOp1 ), 4415 static_cast<SbiStreamFlags>( nOp2 ), nBlkLen ); 4416 Error( pIosys->GetError() ); 4417 } 4418 4419 // create object (+StringID+StringID) 4420 4421 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4422 { 4423 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) ); 4424 SbxObjectRef pObj = SbxBase::CreateObject( aClass ); 4425 if( !pObj ) 4426 { 4427 Error( ERRCODE_BASIC_INVALID_OBJECT ); 4428 } 4429 else 4430 { 4431 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 4432 pObj->SetName( aName ); 4433 // the object must be able to call the BASIC 4434 pObj->SetParent( &rBasic ); 4435 SbxVariableRef pNew = new SbxVariable; 4436 pNew->PutObject( pObj.get() ); 4437 PushVar( pNew.get() ); 4438 } 4439 } 4440 4441 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4442 { 4443 StepDCREATE_IMPL( nOp1, nOp2 ); 4444 } 4445 4446 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4447 { 4448 StepDCREATE_IMPL( nOp1, nOp2 ); 4449 } 4450 4451 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create 4452 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4453 { 4454 SbxVariableRef refVar = PopVar(); 4455 4456 DimImpl( refVar ); 4457 4458 // fill the array with instances of the requested class 4459 SbxBase* pObj = refVar->GetObject(); 4460 if (!pObj) 4461 { 4462 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT ); 4463 return; 4464 } 4465 4466 SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj); 4467 if (!pArray) 4468 return; 4469 4470 const sal_Int32 nDims = pArray->GetDims(); 4471 sal_Int32 nTotalSize = nDims > 0 ? 1 : 0; 4472 4473 // must be a one-dimensional array 4474 sal_Int32 nLower, nUpper; 4475 for( sal_Int32 i = 0 ; i < nDims ; ++i ) 4476 { 4477 pArray->GetDim(i + 1, nLower, nUpper); 4478 const sal_Int32 nSize = nUpper - nLower + 1; 4479 nTotalSize *= nSize; 4480 } 4481 4482 // Optimization: pre-allocate underlying container 4483 if (nTotalSize > 0) 4484 pArray->SbxArray::GetRef(nTotalSize - 1); 4485 4486 // First, fill those parts of the array that are preserved 4487 bool bWasError = false; 4488 const bool bRestored = implRestorePreservedArray(pArray, refRedimpArray, &bWasError); 4489 if (bWasError) 4490 nTotalSize = 0; // on error, don't create objects 4491 4492 // create objects and insert them into the array 4493 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) ); 4494 OUString aName; 4495 for( sal_Int32 i = 0 ; i < nTotalSize ; ++i ) 4496 { 4497 if (!bRestored || !pArray->SbxArray::GetRef(i)) // For those left unset after preserve 4498 { 4499 SbxObjectRef pClassObj = SbxBase::CreateObject(aClass); 4500 if (!pClassObj) 4501 { 4502 Error(ERRCODE_BASIC_INVALID_OBJECT); 4503 break; 4504 } 4505 else 4506 { 4507 if (aName.isEmpty()) 4508 aName = pImg->GetString(static_cast<short>(nOp1)); 4509 pClassObj->SetName(aName); 4510 // the object must be able to call the basic 4511 pClassObj->SetParent(&rBasic); 4512 pArray->SbxArray::Put(pClassObj.get(), i); 4513 } 4514 } 4515 } 4516 } 4517 4518 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4519 { 4520 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 4521 OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) ); 4522 4523 SbxObjectRef pCopyObj = createUserTypeImpl( aClass ); 4524 if( pCopyObj ) 4525 { 4526 pCopyObj->SetName( aName ); 4527 } 4528 SbxVariableRef pNew = new SbxVariable; 4529 pNew->PutObject( pCopyObj.get() ); 4530 pNew->SetDeclareClassName( aClass ); 4531 PushVar( pNew.get() ); 4532 } 4533 4534 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 ) 4535 { 4536 bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0); 4537 if( bWithEvents ) 4538 { 4539 pVar->SetFlag( SbxFlagBits::WithEvents ); 4540 } 4541 bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0); 4542 if( bDimAsNew ) 4543 { 4544 pVar->SetFlag( SbxFlagBits::DimAsNew ); 4545 } 4546 bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0); 4547 if( bFixedString ) 4548 { 4549 sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000 4550 OUStringBuffer aBuf; 4551 comphelper::string::padToLength(aBuf, nCount); 4552 pVar->PutString(aBuf.makeStringAndClear()); 4553 } 4554 4555 bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0); 4556 if( bVarToDim ) 4557 { 4558 pVar->SetFlag( SbxFlagBits::VarToDim ); 4559 } 4560 } 4561 4562 // establishing a local variable (+StringID+type) 4563 4564 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4565 { 4566 if( !refLocals.is() ) 4567 { 4568 refLocals = new SbxArray; 4569 } 4570 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 4571 if( refLocals->Find( aName, SbxClassType::DontCare ) == nullptr ) 4572 { 4573 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4574 SbxVariable* p = new SbxVariable( t ); 4575 p->SetName( aName ); 4576 implHandleSbxFlags( p, t, nOp2 ); 4577 refLocals->Put(p, refLocals->Count()); 4578 } 4579 } 4580 4581 // establishing a module-global variable (+StringID+type) 4582 4583 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule ) 4584 { 4585 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 4586 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4587 bool bFlag = pMod->IsSet( SbxFlagBits::NoModify ); 4588 pMod->SetFlag( SbxFlagBits::NoModify ); 4589 SbxVariableRef p = pMod->Find( aName, SbxClassType::Property ); 4590 if( p.is() ) 4591 { 4592 pMod->Remove (p.get()); 4593 } 4594 SbProperty* pProp = pMod->GetProperty( aName, t ); 4595 if( !bUsedForClassModule ) 4596 { 4597 pProp->SetFlag( SbxFlagBits::Private ); 4598 } 4599 if( !bFlag ) 4600 { 4601 pMod->ResetFlag( SbxFlagBits::NoModify ); 4602 } 4603 if( pProp ) 4604 { 4605 pProp->SetFlag( SbxFlagBits::DontStore ); 4606 // from 2.7.1996: HACK because of 'reference can't be saved' 4607 pProp->SetFlag( SbxFlagBits::NoModify); 4608 4609 implHandleSbxFlags( pProp, t, nOp2 ); 4610 } 4611 } 4612 4613 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4614 { 4615 StepPUBLIC_Impl( nOp1, nOp2, false ); 4616 } 4617 4618 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4619 { 4620 // Creates module variable that isn't reinitialised when 4621 // between invocations ( for VBASupport & document basic only ) 4622 if( pMod->pImage->bFirstInit ) 4623 { 4624 bool bUsedForClassModule = pImg->IsFlag( SbiImageFlags::CLASSMODULE ); 4625 StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule ); 4626 } 4627 } 4628 4629 // establishing a global variable (+StringID+type) 4630 4631 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4632 { 4633 if( pImg->IsFlag( SbiImageFlags::CLASSMODULE ) ) 4634 { 4635 StepPUBLIC_Impl( nOp1, nOp2, true ); 4636 } 4637 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 4638 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4639 4640 // Store module scope variables at module scope 4641 // in non vba mode these are stored at the library level :/ 4642 // not sure if this really should not be enabled for ALL basic 4643 SbxObject* pStorage = &rBasic; 4644 if ( SbiRuntime::isVBAEnabled() ) 4645 { 4646 pStorage = pMod; 4647 pMod->AddVarName( aName ); 4648 } 4649 4650 bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify ); 4651 rBasic.SetFlag( SbxFlagBits::NoModify ); 4652 SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property ); 4653 if( p.is() ) 4654 { 4655 pStorage->Remove (p.get()); 4656 } 4657 p = pStorage->Make( aName, SbxClassType::Property, t ); 4658 if( !bFlag ) 4659 { 4660 pStorage->ResetFlag( SbxFlagBits::NoModify ); 4661 } 4662 if( p.is() ) 4663 { 4664 p->SetFlag( SbxFlagBits::DontStore ); 4665 // from 2.7.1996: HACK because of 'reference can't be saved' 4666 p->SetFlag( SbxFlagBits::NoModify); 4667 } 4668 } 4669 4670 4671 // Creates global variable that isn't reinitialised when 4672 // basic is restarted, P=PERSIST (+StringID+Typ) 4673 4674 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4675 { 4676 if( pMod->pImage->bFirstInit ) 4677 { 4678 StepGLOBAL( nOp1, nOp2 ); 4679 } 4680 } 4681 4682 4683 // Searches for global variable, behavior depends on the fact 4684 // if the variable is initialised for the first time 4685 4686 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4687 { 4688 if( pMod->pImage->bFirstInit ) 4689 { 4690 // Behave like always during first init 4691 StepFIND( nOp1, nOp2 ); 4692 } 4693 else 4694 { 4695 // Return dummy variable 4696 SbxDataType t = static_cast<SbxDataType>(nOp2); 4697 OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) ); 4698 4699 SbxVariable* pDummyVar = new SbxVariable( t ); 4700 pDummyVar->SetName( aName ); 4701 PushVar( pDummyVar ); 4702 } 4703 } 4704 4705 4706 SbxVariable* SbiRuntime::StepSTATIC_Impl( 4707 OUString const & aName, SbxDataType t, sal_uInt32 nOp2 ) 4708 { 4709 SbxVariable* p = nullptr; 4710 if ( pMeth ) 4711 { 4712 SbxArray* pStatics = pMeth->GetStatics(); 4713 if( pStatics && ( pStatics->Find( aName, SbxClassType::DontCare ) == nullptr ) ) 4714 { 4715 p = new SbxVariable( t ); 4716 if( t != SbxVARIANT ) 4717 { 4718 p->SetFlag( SbxFlagBits::Fixed ); 4719 } 4720 p->SetName( aName ); 4721 implHandleSbxFlags( p, t, nOp2 ); 4722 pStatics->Put(p, pStatics->Count()); 4723 } 4724 } 4725 return p; 4726 } 4727 // establishing a static variable (+StringID+type) 4728 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4729 { 4730 OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 4731 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4732 StepSTATIC_Impl( aName, t, nOp2 ); 4733 } 4734 4735 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */ 4736
