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 <utility> 42 #include <vcl/svapp.hxx> 43 #include <vcl/settings.hxx> 44 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 refArgv_, short nArgc_) : 148 refArgv(std::move(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 : nDirFlags(SbAttributes::NONE) 294 , nCurDirPos(0) 295 { 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 or XIndexAccess? 1200 Any aAny = pUnoObj->getUnoAny(); 1201 Reference<XIndexAccess> xIndexAccess; 1202 Reference< XEnumerationAccess > xEnumerationAccess; 1203 if( aAny >>= xEnumerationAccess ) 1204 { 1205 p->xEnumeration = xEnumerationAccess->createEnumeration(); 1206 p->eForType = ForType::EachXEnumeration; 1207 } 1208 // tdf#130307 - support for each loop for objects exposing XIndexAccess 1209 else if (aAny >>= xIndexAccess) 1210 { 1211 p->eForType = ForType::EachXIndexAccess; 1212 p->xIndexAccess = xIndexAccess; 1213 p->nCurCollectionIndex = 0; 1214 } 1215 else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() ) 1216 { 1217 uno::Reference< script::XInvocation > xInvocation; 1218 if ( ( aAny >>= xInvocation ) && xInvocation.is() ) 1219 { 1220 try 1221 { 1222 p->xEnumeration = new ComEnumerationWrapper( xInvocation ); 1223 p->eForType = ForType::EachXEnumeration; 1224 } 1225 catch(const uno::Exception& ) 1226 {} 1227 } 1228 } 1229 } 1230 1231 // Container variable 1232 p->refVar = PopVar(); 1233 nForLvl++; 1234 } 1235 1236 1237 void SbiRuntime::PopFor() 1238 { 1239 if( pForStk ) 1240 { 1241 SbiForStack* p = pForStk; 1242 pForStk = p->pNext; 1243 delete p; 1244 nForLvl--; 1245 } 1246 } 1247 1248 1249 void SbiRuntime::ClearForStack() 1250 { 1251 while( pForStk ) 1252 { 1253 PopFor(); 1254 } 1255 } 1256 1257 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection const * pCollection ) 1258 { 1259 for (SbiForStack *p = pForStk; p; p = p->pNext) 1260 { 1261 SbxVariable* pVar = p->refEnd.is() ? p->refEnd.get() : nullptr; 1262 if( p->eForType == ForType::EachCollection 1263 && pVar != nullptr 1264 && dynamic_cast<BasicCollection*>( pVar) == pCollection ) 1265 { 1266 return p; 1267 } 1268 } 1269 1270 return nullptr; 1271 } 1272 1273 1274 // DLL-calls 1275 1276 void SbiRuntime::DllCall 1277 ( std::u16string_view aFuncName, 1278 std::u16string_view aDLLName, 1279 SbxArray* pArgs, // parameter (from index 1, can be NULL) 1280 SbxDataType eResType, // return value 1281 bool bCDecl ) // true: according to C-conventions 1282 { 1283 // NOT YET IMPLEMENTED 1284 1285 SbxVariable* pRes = new SbxVariable( eResType ); 1286 SbiDllMgr* pDllMgr = pInst->GetDllMgr(); 1287 ErrCode nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl ); 1288 if( nErr ) 1289 { 1290 Error( nErr ); 1291 } 1292 PushVar( pRes ); 1293 } 1294 1295 bool SbiRuntime::IsImageFlag( SbiImageFlags n ) const 1296 { 1297 return pImg->IsFlag( n ); 1298 } 1299 1300 sal_uInt16 SbiRuntime::GetBase() const 1301 { 1302 return pImg->GetBase(); 1303 } 1304 1305 void SbiRuntime::StepNOP() 1306 {} 1307 1308 void SbiRuntime::StepArith( SbxOperator eOp ) 1309 { 1310 SbxVariableRef p1 = PopVar(); 1311 TOSMakeTemp(); 1312 SbxVariable* p2 = GetTOS(); 1313 1314 // tdf#144353 - do not compute any operation with a missing optional variable 1315 if ((p1->GetType() == SbxERROR && IsMissing(p1.get(), 1)) 1316 || (p2->GetType() == SbxERROR && IsMissing(p2, 1))) 1317 { 1318 Error(ERRCODE_BASIC_NOT_OPTIONAL); 1319 return; 1320 } 1321 1322 p2->ResetFlag( SbxFlagBits::Fixed ); 1323 p2->Compute( eOp, *p1 ); 1324 1325 checkArithmeticOverflow( p2 ); 1326 } 1327 1328 void SbiRuntime::StepUnary( SbxOperator eOp ) 1329 { 1330 TOSMakeTemp(); 1331 SbxVariable* p = GetTOS(); 1332 // tdf#144353 - do not compute any operation with a missing optional variable 1333 if (p->GetType() == SbxERROR && IsMissing(p, 1)) 1334 { 1335 Error(ERRCODE_BASIC_NOT_OPTIONAL); 1336 return; 1337 } 1338 p->Compute( eOp, *p ); 1339 } 1340 1341 void SbiRuntime::StepCompare( SbxOperator eOp ) 1342 { 1343 SbxVariableRef p1 = PopVar(); 1344 SbxVariableRef p2 = PopVar(); 1345 1346 // tdf#144353 - do not compare a missing optional variable 1347 if ((p1->GetType() == SbxERROR && SbiRuntime::IsMissing(p1.get(), 1)) 1348 || (p2->GetType() == SbxERROR && SbiRuntime::IsMissing(p2.get(), 1))) 1349 { 1350 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL); 1351 return; 1352 } 1353 1354 // Make sure objects with default params have 1355 // values ( and type ) set as appropriate 1356 SbxDataType p1Type = p1->GetType(); 1357 SbxDataType p2Type = p2->GetType(); 1358 if ( p1Type == SbxEMPTY ) 1359 { 1360 p1->Broadcast( SfxHintId::BasicDataWanted ); 1361 p1Type = p1->GetType(); 1362 } 1363 if ( p2Type == SbxEMPTY ) 1364 { 1365 p2->Broadcast( SfxHintId::BasicDataWanted ); 1366 p2Type = p2->GetType(); 1367 } 1368 if ( p1Type == p2Type ) 1369 { 1370 // if both sides are an object and have default props 1371 // then we need to use the default props 1372 // we don't need to worry if only one side ( lhs, rhs ) is an 1373 // object ( object side will get coerced to correct type in 1374 // Compare ) 1375 if ( p1Type == SbxOBJECT ) 1376 { 1377 SbxVariable* pDflt = getDefaultProp( p1.get() ); 1378 if ( pDflt ) 1379 { 1380 p1 = pDflt; 1381 p1->Broadcast( SfxHintId::BasicDataWanted ); 1382 } 1383 pDflt = getDefaultProp( p2.get() ); 1384 if ( pDflt ) 1385 { 1386 p2 = pDflt; 1387 p2->Broadcast( SfxHintId::BasicDataWanted ); 1388 } 1389 } 1390 1391 } 1392 static SbxVariable* pTRUE = nullptr; 1393 static SbxVariable* pFALSE = nullptr; 1394 // why do this on non-windows ? 1395 // why do this at all ? 1396 // I dumbly follow the pattern :-/ 1397 if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) ) 1398 { 1399 static SbxVariable* pNULL = []() { 1400 SbxVariable* p = new SbxVariable; 1401 p->PutNull(); 1402 p->AddFirstRef(); 1403 return p; 1404 }(); 1405 PushVar( pNULL ); 1406 } 1407 else if( p2->Compare( eOp, *p1 ) ) 1408 { 1409 if( !pTRUE ) 1410 { 1411 pTRUE = new SbxVariable; 1412 pTRUE->PutBool( true ); 1413 pTRUE->AddFirstRef(); 1414 } 1415 PushVar( pTRUE ); 1416 } 1417 else 1418 { 1419 if( !pFALSE ) 1420 { 1421 pFALSE = new SbxVariable; 1422 pFALSE->PutBool( false ); 1423 pFALSE->AddFirstRef(); 1424 } 1425 PushVar( pFALSE ); 1426 } 1427 } 1428 1429 void SbiRuntime::StepEXP() { StepArith( SbxEXP ); } 1430 void SbiRuntime::StepMUL() { StepArith( SbxMUL ); } 1431 void SbiRuntime::StepDIV() { StepArith( SbxDIV ); } 1432 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); } 1433 void SbiRuntime::StepMOD() { StepArith( SbxMOD ); } 1434 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); } 1435 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); } 1436 void SbiRuntime::StepCAT() { StepArith( SbxCAT ); } 1437 void SbiRuntime::StepAND() { StepArith( SbxAND ); } 1438 void SbiRuntime::StepOR() { StepArith( SbxOR ); } 1439 void SbiRuntime::StepXOR() { StepArith( SbxXOR ); } 1440 void SbiRuntime::StepEQV() { StepArith( SbxEQV ); } 1441 void SbiRuntime::StepIMP() { StepArith( SbxIMP ); } 1442 1443 void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); } 1444 void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); } 1445 1446 void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); } 1447 void SbiRuntime::StepNE() { StepCompare( SbxNE ); } 1448 void SbiRuntime::StepLT() { StepCompare( SbxLT ); } 1449 void SbiRuntime::StepGT() { StepCompare( SbxGT ); } 1450 void SbiRuntime::StepLE() { StepCompare( SbxLE ); } 1451 void SbiRuntime::StepGE() { StepCompare( SbxGE ); } 1452 1453 namespace 1454 { 1455 bool NeedEsc(sal_Unicode cCode) 1456 { 1457 if(!rtl::isAscii(cCode)) 1458 { 1459 return false; 1460 } 1461 switch(cCode) 1462 { 1463 case '.': 1464 case '^': 1465 case '$': 1466 case '+': 1467 case '\\': 1468 case '|': 1469 case '{': 1470 case '}': 1471 case '(': 1472 case ')': 1473 return true; 1474 default: 1475 return false; 1476 } 1477 } 1478 1479 OUString VBALikeToRegexp(const OUString &rIn) 1480 { 1481 OUStringBuffer sResult; 1482 const sal_Unicode *start = rIn.getStr(); 1483 const sal_Unicode *end = start + rIn.getLength(); 1484 1485 int seenright = 0; 1486 1487 sResult.append('^'); 1488 1489 while (start < end) 1490 { 1491 switch (*start) 1492 { 1493 case '?': 1494 sResult.append('.'); 1495 start++; 1496 break; 1497 case '*': 1498 sResult.append(".*"); 1499 start++; 1500 break; 1501 case '#': 1502 sResult.append("[0-9]"); 1503 start++; 1504 break; 1505 case ']': 1506 sResult.append('\\'); 1507 sResult.append(*start++); 1508 break; 1509 case '[': 1510 sResult.append(*start++); 1511 seenright = 0; 1512 while (start < end && !seenright) 1513 { 1514 switch (*start) 1515 { 1516 case '[': 1517 case '?': 1518 case '*': 1519 sResult.append('\\'); 1520 sResult.append(*start); 1521 break; 1522 case ']': 1523 sResult.append(*start); 1524 seenright = 1; 1525 break; 1526 case '!': 1527 sResult.append('^'); 1528 break; 1529 default: 1530 if (NeedEsc(*start)) 1531 { 1532 sResult.append('\\'); 1533 } 1534 sResult.append(*start); 1535 break; 1536 } 1537 start++; 1538 } 1539 break; 1540 default: 1541 if (NeedEsc(*start)) 1542 { 1543 sResult.append('\\'); 1544 } 1545 sResult.append(*start++); 1546 } 1547 } 1548 1549 sResult.append('$'); 1550 1551 return sResult.makeStringAndClear(); 1552 } 1553 } 1554 1555 void SbiRuntime::StepLIKE() 1556 { 1557 SbxVariableRef refVar1 = PopVar(); 1558 SbxVariableRef refVar2 = PopVar(); 1559 1560 OUString pattern = VBALikeToRegexp(refVar1->GetOUString()); 1561 OUString value = refVar2->GetOUString(); 1562 1563 i18nutil::SearchOptions2 aSearchOpt; 1564 1565 aSearchOpt.AlgorithmType2 = css::util::SearchAlgorithms2::REGEXP; 1566 1567 aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale(); 1568 aSearchOpt.searchString = pattern; 1569 1570 bool bTextMode(true); 1571 bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() ); 1572 if( bCompatibility ) 1573 { 1574 bTextMode = IsImageFlag( SbiImageFlags::COMPARETEXT ); 1575 } 1576 if( bTextMode ) 1577 { 1578 aSearchOpt.transliterateFlags |= TransliterationFlags::IGNORE_CASE; 1579 } 1580 SbxVariable* pRes = new SbxVariable; 1581 utl::TextSearch aSearch( aSearchOpt); 1582 sal_Int32 nStart=0, nEnd=value.getLength(); 1583 bool bRes = aSearch.SearchForward(value, &nStart, &nEnd); 1584 pRes->PutBool( bRes ); 1585 1586 PushVar( pRes ); 1587 } 1588 1589 // TOS and TOS-1 are both object variables and contain the same pointer 1590 1591 void SbiRuntime::StepIS() 1592 { 1593 SbxVariableRef refVar1 = PopVar(); 1594 SbxVariableRef refVar2 = PopVar(); 1595 1596 SbxDataType eType1 = refVar1->GetType(); 1597 SbxDataType eType2 = refVar2->GetType(); 1598 if ( eType1 == SbxEMPTY ) 1599 { 1600 refVar1->Broadcast( SfxHintId::BasicDataWanted ); 1601 eType1 = refVar1->GetType(); 1602 } 1603 if ( eType2 == SbxEMPTY ) 1604 { 1605 refVar2->Broadcast( SfxHintId::BasicDataWanted ); 1606 eType2 = refVar2->GetType(); 1607 } 1608 1609 bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT ); 1610 if ( bVBAEnabled && !bRes ) 1611 { 1612 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1613 } 1614 bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() ); 1615 SbxVariable* pRes = new SbxVariable; 1616 pRes->PutBool( bRes ); 1617 PushVar( pRes ); 1618 } 1619 1620 // update the value of TOS 1621 1622 void SbiRuntime::StepGET() 1623 { 1624 SbxVariable* p = GetTOS(); 1625 p->Broadcast( SfxHintId::BasicDataWanted ); 1626 } 1627 1628 // #67607 copy Uno-Structs 1629 static bool checkUnoStructCopy( bool bVBA, SbxVariableRef const & refVal, SbxVariableRef const & refVar ) 1630 { 1631 SbxDataType eVarType = refVar->GetType(); 1632 SbxDataType eValType = refVal->GetType(); 1633 1634 // tdf#144353 - do not assign a missing optional variable to a property 1635 if (refVal->GetType() == SbxERROR && SbiRuntime::IsMissing(refVal.get(), 1)) 1636 { 1637 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL); 1638 return true; 1639 } 1640 1641 if ( ( bVBA && ( eVarType == SbxEMPTY ) ) || !refVar->CanWrite() ) 1642 return false; 1643 1644 if ( eValType != SbxOBJECT ) 1645 return false; 1646 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to 1647 // there :-/ not sure if for every '=' we would want struct handling 1648 if( eVarType != SbxOBJECT ) 1649 { 1650 if ( refVar->IsFixed() ) 1651 return false; 1652 } 1653 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure 1654 else if( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr ) 1655 return false; 1656 1657 SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject()); 1658 if( !xValObj.is() || dynamic_cast<const SbUnoAnyObject*>( xValObj.get() ) != nullptr ) 1659 return false; 1660 1661 SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() ); 1662 SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() ); 1663 Any aAny; 1664 // make doubly sure value is either a Uno object or 1665 // a uno struct 1666 if ( pUnoVal || pUnoStructVal ) 1667 aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny(); 1668 else 1669 return false; 1670 if ( aAny.getValueType().getTypeClass() != TypeClass_STRUCT ) 1671 return false; 1672 1673 refVar->SetType( SbxOBJECT ); 1674 ErrCode eOldErr = SbxBase::GetError(); 1675 // There are some circumstances when calling GetObject 1676 // will trigger an error, we need to squash those here. 1677 // Alternatively it is possible that the same scenario 1678 // could overwrite and existing error. Lets prevent that 1679 SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject()); 1680 if ( eOldErr != ERRCODE_NONE ) 1681 SbxBase::SetError( eOldErr ); 1682 else 1683 SbxBase::ResetError(); 1684 1685 SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( xVarObj.get() ); 1686 1687 OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName(); 1688 OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName(); 1689 1690 if ( pUnoStructObj ) 1691 { 1692 StructRefInfo aInfo = pUnoStructObj->getStructInfo(); 1693 aInfo.setValue( aAny ); 1694 } 1695 else 1696 { 1697 SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny ); 1698 // #70324: adopt ClassName 1699 pNewUnoObj->SetClassName( sClassName ); 1700 refVar->PutObject( pNewUnoObj ); 1701 } 1702 return true; 1703 } 1704 1705 1706 // laying down TOS in TOS-1 1707 1708 void SbiRuntime::StepPUT() 1709 { 1710 SbxVariableRef refVal = PopVar(); 1711 SbxVariableRef refVar = PopVar(); 1712 // store on its own method (inside a function)? 1713 bool bFlagsChanged = false; 1714 SbxFlagBits n = SbxFlagBits::NONE; 1715 if( refVar.get() == pMeth ) 1716 { 1717 bFlagsChanged = true; 1718 n = refVar->GetFlags(); 1719 refVar->SetFlag( SbxFlagBits::Write ); 1720 } 1721 1722 // if left side arg is an object or variant and right handside isn't 1723 // either an object or a variant then try and see if a default 1724 // property exists. 1725 // to use e.g. Range{"A1") = 34 1726 // could equate to Range("A1").Value = 34 1727 if ( bVBAEnabled ) 1728 { 1729 // yet more hacking at this, I feel we don't quite have the correct 1730 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe 1731 // obj1 ) has default member/property ) ) It seems that default props 1732 // aren't dealt with if the object is a member of some parent object 1733 bool bObjAssign = false; 1734 if ( refVar->GetType() == SbxEMPTY ) 1735 refVar->Broadcast( SfxHintId::BasicDataWanted ); 1736 if ( refVar->GetType() == SbxOBJECT ) 1737 { 1738 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() ) 1739 { 1740 SbxVariable* pDflt = getDefaultProp( refVar.get() ); 1741 1742 if ( pDflt ) 1743 refVar = pDflt; 1744 } 1745 else 1746 bObjAssign = true; 1747 } 1748 if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( dynamic_cast<const SbxMethod *>(refVal.get()) != nullptr || ! refVal->GetParent() ) ) 1749 { 1750 SbxVariable* pDflt = getDefaultProp( refVal.get() ); 1751 if ( pDflt ) 1752 refVal = pDflt; 1753 } 1754 } 1755 1756 if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) ) 1757 *refVar = *refVal; 1758 1759 if( bFlagsChanged ) 1760 refVar->SetFlags( n ); 1761 } 1762 1763 namespace { 1764 1765 // VBA Dim As New behavior handling, save init object information 1766 struct DimAsNewRecoverItem 1767 { 1768 OUString m_aObjClass; 1769 OUString m_aObjName; 1770 SbxObject* m_pObjParent; 1771 SbModule* m_pClassModule; 1772 1773 DimAsNewRecoverItem() 1774 : m_pObjParent( nullptr ) 1775 , m_pClassModule( nullptr ) 1776 {} 1777 1778 DimAsNewRecoverItem( OUString aObjClass, OUString aObjName, 1779 SbxObject* pObjParent, SbModule* pClassModule ) 1780 : m_aObjClass(std::move( aObjClass )) 1781 , m_aObjName(std::move( aObjName )) 1782 , m_pObjParent( pObjParent ) 1783 , m_pClassModule( pClassModule ) 1784 {} 1785 1786 }; 1787 1788 1789 struct SbxVariablePtrHash 1790 { 1791 size_t operator()( SbxVariable* pVar ) const 1792 { return reinterpret_cast<size_t>(pVar); } 1793 }; 1794 1795 } 1796 1797 typedef std::unordered_map< SbxVariable*, DimAsNewRecoverItem, 1798 SbxVariablePtrHash > DimAsNewRecoverHash; 1799 1800 namespace { 1801 1802 DimAsNewRecoverHash gaDimAsNewRecoverHash; 1803 1804 } 1805 1806 void removeDimAsNewRecoverItem( SbxVariable* pVar ) 1807 { 1808 DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( pVar ); 1809 if( it != gaDimAsNewRecoverHash.end() ) 1810 { 1811 gaDimAsNewRecoverHash.erase( it ); 1812 } 1813 } 1814 1815 1816 // saving object variable 1817 // not-object variables will cause errors 1818 1819 constexpr OUStringLiteral pCollectionStr = u"Collection"; 1820 1821 void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp ) 1822 { 1823 // #67733 types with array-flag are OK too 1824 1825 // Check var, !object is no error for sure if, only if type is fixed 1826 SbxDataType eVarType = refVar->GetType(); 1827 if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() ) 1828 { 1829 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1830 return; 1831 } 1832 1833 // Check value, !object is no error for sure if, only if type is fixed 1834 SbxDataType eValType = refVal->GetType(); 1835 if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() ) 1836 { 1837 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1838 return; 1839 } 1840 1841 // Getting in here causes problems with objects with default properties 1842 // if they are SbxEMPTY I guess 1843 if ( !bHandleDefaultProp || eValType == SbxOBJECT ) 1844 { 1845 // activate GetObject for collections on refVal 1846 SbxBase* pObjVarObj = refVal->GetObject(); 1847 if( pObjVarObj ) 1848 { 1849 SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj ); 1850 1851 if( refObjVal.is() ) 1852 { 1853 refVal = refObjVal; 1854 } 1855 else if( !(eValType & SbxARRAY) ) 1856 { 1857 refVal = nullptr; 1858 } 1859 } 1860 } 1861 1862 // #52896 refVal can be invalid here, if uno-sequences - or more 1863 // general arrays - are assigned to variables that are declared 1864 // as an object! 1865 if( !refVal.is() ) 1866 { 1867 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 1868 } 1869 else 1870 { 1871 bool bFlagsChanged = false; 1872 SbxFlagBits n = SbxFlagBits::NONE; 1873 if( refVar.get() == pMeth ) 1874 { 1875 bFlagsChanged = true; 1876 n = refVar->GetFlags(); 1877 refVar->SetFlag( SbxFlagBits::Write ); 1878 } 1879 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() ); 1880 if( pProcProperty ) 1881 { 1882 pProcProperty->setSet( true ); 1883 } 1884 if ( bHandleDefaultProp ) 1885 { 1886 // get default properties for lhs & rhs where necessary 1887 // SbxVariable* defaultProp = NULL; unused variable 1888 // LHS try determine if a default prop exists 1889 // again like in StepPUT (see there too ) we are tweaking the 1890 // heuristics again for when to assign an object reference or 1891 // use default members if they exist 1892 // #FIXME we really need to get to the bottom of this mess 1893 bool bObjAssign = false; 1894 if ( refVar->GetType() == SbxOBJECT ) 1895 { 1896 if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() ) 1897 { 1898 SbxVariable* pDflt = getDefaultProp( refVar.get() ); 1899 if ( pDflt ) 1900 { 1901 refVar = pDflt; 1902 } 1903 } 1904 else 1905 bObjAssign = true; 1906 } 1907 // RHS only get a default prop is the rhs has one 1908 if ( refVal->GetType() == SbxOBJECT ) 1909 { 1910 // check if lhs is a null object 1911 // if it is then use the object not the default property 1912 SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() ); 1913 1914 // calling GetObject on a SbxEMPTY variable raises 1915 // object not set errors, make sure it's an Object 1916 if ( !pObj && refVar->GetType() == SbxOBJECT ) 1917 { 1918 SbxBase* pObjVarObj = refVar->GetObject(); 1919 pObj = dynamic_cast<SbxObject*>( pObjVarObj ); 1920 } 1921 SbxVariable* pDflt = nullptr; 1922 if ( pObj && !bObjAssign ) 1923 { 1924 // lhs is either a valid object || or has a defaultProp 1925 pDflt = getDefaultProp( refVal.get() ); 1926 } 1927 if ( pDflt ) 1928 { 1929 refVal = pDflt; 1930 } 1931 } 1932 } 1933 1934 // Handle Dim As New 1935 bool bDimAsNew = bVBAEnabled && refVar->IsSet( SbxFlagBits::DimAsNew ); 1936 SbxBaseRef xPrevVarObj; 1937 if( bDimAsNew ) 1938 { 1939 xPrevVarObj = refVar->GetObject(); 1940 } 1941 // Handle withevents 1942 bool bWithEvents = refVar->IsSet( SbxFlagBits::WithEvents ); 1943 if ( bWithEvents ) 1944 { 1945 Reference< XInterface > xComListener; 1946 1947 SbxBase* pObj = refVal->GetObject(); 1948 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj ); 1949 if( pUnoObj != nullptr ) 1950 { 1951 Any aControlAny = pUnoObj->getUnoAny(); 1952 OUString aDeclareClassName = refVar->GetDeclareClassName(); 1953 OUString aPrefix = refVar->GetName(); 1954 SbxObjectRef xScopeObj = refVar->GetParent(); 1955 xComListener = createComListener( aControlAny, aDeclareClassName, aPrefix, xScopeObj ); 1956 1957 refVal->SetDeclareClassName( aDeclareClassName ); 1958 refVal->SetComListener( xComListener, &rBasic ); // Hold reference 1959 } 1960 1961 } 1962 1963 // lhs is a property who's value is currently (Empty e.g. no broadcast yet) 1964 // in this case if there is a default prop involved the value of the 1965 // default property may in fact be void so the type will also be SbxEMPTY 1966 // in this case we do not want to call checkUnoStructCopy 'cause that will 1967 // cause an error also 1968 if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) ) 1969 { 1970 *refVar = *refVal; 1971 } 1972 if ( bDimAsNew ) 1973 { 1974 if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr ) 1975 { 1976 SbxBase* pValObjBase = refVal->GetObject(); 1977 if( pValObjBase == nullptr ) 1978 { 1979 if( xPrevVarObj.is() ) 1980 { 1981 // Object is overwritten with NULL, instantiate init object 1982 DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( refVar.get() ); 1983 if( it != gaDimAsNewRecoverHash.end() ) 1984 { 1985 const DimAsNewRecoverItem& rItem = it->second; 1986 if( rItem.m_pClassModule != nullptr ) 1987 { 1988 SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule ); 1989 pNewObj->SetName( rItem.m_aObjName ); 1990 pNewObj->SetParent( rItem.m_pObjParent ); 1991 refVar->PutObject( pNewObj ); 1992 } 1993 else if( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) ) 1994 { 1995 BasicCollection* pNewCollection = new BasicCollection( pCollectionStr ); 1996 pNewCollection->SetName( rItem.m_aObjName ); 1997 pNewCollection->SetParent( rItem.m_pObjParent ); 1998 refVar->PutObject( pNewCollection ); 1999 } 2000 } 2001 } 2002 } 2003 else 2004 { 2005 // Does old value exist? 2006 bool bFirstInit = !xPrevVarObj.is(); 2007 if( bFirstInit ) 2008 { 2009 // Store information to instantiate object later 2010 SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase ); 2011 if( pValObj != nullptr ) 2012 { 2013 OUString aObjClass = pValObj->GetClassName(); 2014 2015 SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pValObjBase ); 2016 if( pClassModuleObj != nullptr ) 2017 { 2018 SbModule* pClassModule = pClassModuleObj->getClassModule(); 2019 gaDimAsNewRecoverHash[refVar.get()] = 2020 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule ); 2021 } 2022 else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) ) 2023 { 2024 gaDimAsNewRecoverHash[refVar.get()] = 2025 DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), nullptr ); 2026 } 2027 } 2028 } 2029 } 2030 } 2031 } 2032 2033 if( bFlagsChanged ) 2034 { 2035 refVar->SetFlags( n ); 2036 } 2037 } 2038 } 2039 2040 void SbiRuntime::StepSET() 2041 { 2042 SbxVariableRef refVal = PopVar(); 2043 SbxVariableRef refVar = PopVar(); 2044 StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assignment 2045 } 2046 2047 void SbiRuntime::StepVBASET() 2048 { 2049 SbxVariableRef refVal = PopVar(); 2050 SbxVariableRef refVar = PopVar(); 2051 // don't handle default property 2052 StepSET_Impl( refVal, refVar ); // set obj = something 2053 } 2054 2055 2056 void SbiRuntime::StepLSET() 2057 { 2058 SbxVariableRef refVal = PopVar(); 2059 SbxVariableRef refVar = PopVar(); 2060 if( refVar->GetType() != SbxSTRING || 2061 refVal->GetType() != SbxSTRING ) 2062 { 2063 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 2064 } 2065 else 2066 { 2067 SbxFlagBits n = refVar->GetFlags(); 2068 if( refVar.get() == pMeth ) 2069 { 2070 refVar->SetFlag( SbxFlagBits::Write ); 2071 } 2072 OUString aRefVarString = refVar->GetOUString(); 2073 OUString aRefValString = refVal->GetOUString(); 2074 2075 sal_Int32 nVarStrLen = aRefVarString.getLength(); 2076 sal_Int32 nValStrLen = aRefValString.getLength(); 2077 OUString aNewStr; 2078 if( nVarStrLen > nValStrLen ) 2079 { 2080 OUStringBuffer buf(aRefValString); 2081 comphelper::string::padToLength(buf, nVarStrLen, ' '); 2082 aNewStr = buf.makeStringAndClear(); 2083 } 2084 else 2085 { 2086 aNewStr = aRefValString.copy( 0, nVarStrLen ); 2087 } 2088 2089 refVar->PutString(aNewStr); 2090 refVar->SetFlags( n ); 2091 } 2092 } 2093 2094 void SbiRuntime::StepRSET() 2095 { 2096 SbxVariableRef refVal = PopVar(); 2097 SbxVariableRef refVar = PopVar(); 2098 if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING ) 2099 { 2100 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 2101 } 2102 else 2103 { 2104 SbxFlagBits n = refVar->GetFlags(); 2105 if( refVar.get() == pMeth ) 2106 { 2107 refVar->SetFlag( SbxFlagBits::Write ); 2108 } 2109 OUString aRefVarString = refVar->GetOUString(); 2110 OUString aRefValString = refVal->GetOUString(); 2111 sal_Int32 nVarStrLen = aRefVarString.getLength(); 2112 sal_Int32 nValStrLen = aRefValString.getLength(); 2113 2114 OUStringBuffer aNewStr(nVarStrLen); 2115 if (nVarStrLen > nValStrLen) 2116 { 2117 comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' '); 2118 aNewStr.append(aRefValString); 2119 } 2120 else 2121 { 2122 aNewStr.append(aRefValString.subView(0, nVarStrLen)); 2123 } 2124 refVar->PutString(aNewStr.makeStringAndClear()); 2125 2126 refVar->SetFlags( n ); 2127 } 2128 } 2129 2130 // laying down TOS in TOS-1, then set ReadOnly-Bit 2131 2132 void SbiRuntime::StepPUTC() 2133 { 2134 SbxVariableRef refVal = PopVar(); 2135 SbxVariableRef refVar = PopVar(); 2136 refVar->SetFlag( SbxFlagBits::Write ); 2137 *refVar = *refVal; 2138 refVar->ResetFlag( SbxFlagBits::Write ); 2139 refVar->SetFlag( SbxFlagBits::Const ); 2140 } 2141 2142 // DIM 2143 // TOS = variable for the array with dimension information as parameter 2144 2145 void SbiRuntime::StepDIM() 2146 { 2147 SbxVariableRef refVar = PopVar(); 2148 DimImpl( refVar ); 2149 } 2150 2151 // #56204 swap out DIM-functionality into a help method (step0.cxx) 2152 void SbiRuntime::DimImpl(const SbxVariableRef& refVar) 2153 { 2154 // If refDim then this DIM statement is terminating a ReDIM and 2155 // previous StepERASE_CLEAR for an array, the following actions have 2156 // been delayed from ( StepERASE_CLEAR ) 'till here 2157 if ( refRedim.is() ) 2158 { 2159 if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve 2160 { 2161 lcl_eraseImpl( refVar, bVBAEnabled ); 2162 } 2163 SbxDataType eType = refVar->GetType(); 2164 lcl_clearImpl( refVar, eType ); 2165 refRedim = nullptr; 2166 } 2167 SbxArray* pDims = refVar->GetParameters(); 2168 // must have an even number of arguments 2169 // have in mind that Arg[0] does not count! 2170 if (pDims && !(pDims->Count() & 1)) 2171 { 2172 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2173 } 2174 else 2175 { 2176 SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT; 2177 SbxDimArray* pArray = new SbxDimArray( eType ); 2178 // allow arrays without dimension information, too (VB-compatible) 2179 if( pDims ) 2180 { 2181 refVar->ResetFlag( SbxFlagBits::VarToDim ); 2182 2183 for (sal_uInt32 i = 1; i < pDims->Count();) 2184 { 2185 sal_Int32 lb = pDims->Get(i++)->GetLong(); 2186 sal_Int32 ub = pDims->Get(i++)->GetLong(); 2187 if( ub < lb ) 2188 { 2189 Error( ERRCODE_BASIC_OUT_OF_RANGE ); 2190 ub = lb; 2191 } 2192 pArray->AddDim(lb, ub); 2193 if ( lb != ub ) 2194 { 2195 pArray->setHasFixedSize( true ); 2196 } 2197 } 2198 } 2199 else 2200 { 2201 // #62867 On creating an array of the length 0, create 2202 // a dimension (like for Uno-Sequences of the length 0) 2203 pArray->unoAddDim(0, -1); 2204 } 2205 SbxFlagBits nSavFlags = refVar->GetFlags(); 2206 refVar->ResetFlag( SbxFlagBits::Fixed ); 2207 refVar->PutObject( pArray ); 2208 refVar->SetFlags( nSavFlags ); 2209 refVar->SetParameters( nullptr ); 2210 } 2211 } 2212 2213 // REDIM 2214 // TOS = variable for the array 2215 // argv = dimension information 2216 2217 void SbiRuntime::StepREDIM() 2218 { 2219 // Nothing different than dim at the moment because 2220 // a double dim is already recognized by the compiler. 2221 StepDIM(); 2222 } 2223 2224 2225 // Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true 2226 static void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, sal_Int32 nMaxDimIndex, 2227 sal_Int32 nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds ) 2228 { 2229 sal_Int32& ri = pActualIndices[nActualDim]; 2230 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ ) 2231 { 2232 if( nActualDim < nMaxDimIndex ) 2233 { 2234 implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1, 2235 pActualIndices, pLowerBounds, pUpperBounds ); 2236 } 2237 else 2238 { 2239 SbxVariable* pSource = pOldArray->Get(pActualIndices); 2240 if (pSource && pOldArray->GetRefCount() > 1) 2241 // tdf#134692: old array will stay alive after the redim - we need to copy deep 2242 pSource = new SbxVariable(*pSource); 2243 pNewArray->Put(pSource, pActualIndices); 2244 } 2245 } 2246 } 2247 2248 // Returns true when actually restored 2249 static bool implRestorePreservedArray(SbxDimArray* pNewArray, SbxArrayRef& rrefRedimpArray, bool* pbWasError = nullptr) 2250 { 2251 assert(pNewArray); 2252 bool bResult = false; 2253 if (pbWasError) 2254 *pbWasError = false; 2255 if (rrefRedimpArray) 2256 { 2257 SbxDimArray* pOldArray = static_cast<SbxDimArray*>(rrefRedimpArray.get()); 2258 const sal_Int32 nDimsNew = pNewArray->GetDims(); 2259 const sal_Int32 nDimsOld = pOldArray->GetDims(); 2260 2261 if (nDimsOld != nDimsNew) 2262 { 2263 StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE); 2264 if (pbWasError) 2265 *pbWasError = true; 2266 } 2267 else if (nDimsNew > 0) 2268 { 2269 // Store dims to use them for copying later 2270 std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDimsNew]); 2271 std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDimsNew]); 2272 std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDimsNew]); 2273 bool bNeedsPreallocation = true; 2274 2275 // Compare bounds 2276 for (sal_Int32 i = 1; i <= nDimsNew; i++) 2277 { 2278 sal_Int32 lBoundNew, uBoundNew; 2279 sal_Int32 lBoundOld, uBoundOld; 2280 pNewArray->GetDim(i, lBoundNew, uBoundNew); 2281 pOldArray->GetDim(i, lBoundOld, uBoundOld); 2282 lBoundNew = std::max(lBoundNew, lBoundOld); 2283 uBoundNew = std::min(uBoundNew, uBoundOld); 2284 sal_Int32 j = i - 1; 2285 pActualIndices[j] = pLowerBounds[j] = lBoundNew; 2286 pUpperBounds[j] = uBoundNew; 2287 if (lBoundNew > uBoundNew) // No elements in the dimension -> no elements to restore 2288 bNeedsPreallocation = false; 2289 } 2290 2291 // Optimization: pre-allocate underlying container 2292 if (bNeedsPreallocation) 2293 pNewArray->Put(nullptr, pUpperBounds.get()); 2294 2295 // Copy data from old array by going recursively through all dimensions 2296 // (It would be faster to work on the flat internal data array of an 2297 // SbyArray but this solution is clearer and easier) 2298 implCopyDimArray(pNewArray, pOldArray, nDimsNew - 1, 0, pActualIndices.get(), 2299 pLowerBounds.get(), pUpperBounds.get()); 2300 bResult = true; 2301 } 2302 2303 rrefRedimpArray.clear(); 2304 } 2305 return bResult; 2306 } 2307 2308 // REDIM PRESERVE 2309 // TOS = variable for the array 2310 // argv = dimension information 2311 2312 void SbiRuntime::StepREDIMP() 2313 { 2314 SbxVariableRef refVar = PopVar(); 2315 DimImpl( refVar ); 2316 2317 // Now check, if we can copy from the old array 2318 if( refRedimpArray.is() ) 2319 { 2320 if (SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>(refVar->GetObject())) 2321 implRestorePreservedArray(pNewArray, refRedimpArray); 2322 } 2323 } 2324 2325 // REDIM_COPY 2326 // TOS = Array-Variable, Reference to array is copied 2327 // Variable is cleared as in ERASE 2328 2329 void SbiRuntime::StepREDIMP_ERASE() 2330 { 2331 SbxVariableRef refVar = PopVar(); 2332 refRedim = refVar; 2333 SbxDataType eType = refVar->GetType(); 2334 if( eType & SbxARRAY ) 2335 { 2336 SbxBase* pElemObj = refVar->GetObject(); 2337 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); 2338 if( pDimArray ) 2339 { 2340 refRedimpArray = pDimArray; 2341 } 2342 2343 } 2344 else if( refVar->IsFixed() ) 2345 { 2346 refVar->Clear(); 2347 } 2348 else 2349 { 2350 refVar->SetType( SbxEMPTY ); 2351 } 2352 } 2353 2354 static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType ) 2355 { 2356 SbxFlagBits nSavFlags = refVar->GetFlags(); 2357 refVar->ResetFlag( SbxFlagBits::Fixed ); 2358 refVar->SetType( SbxDataType(eType & 0x0FFF) ); 2359 refVar->SetFlags( nSavFlags ); 2360 refVar->Clear(); 2361 } 2362 2363 static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled ) 2364 { 2365 SbxDataType eType = refVar->GetType(); 2366 if( eType & SbxARRAY ) 2367 { 2368 if ( bVBAEnabled ) 2369 { 2370 SbxBase* pElemObj = refVar->GetObject(); 2371 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); 2372 if( pDimArray ) 2373 { 2374 if ( pDimArray->hasFixedSize() ) 2375 { 2376 // Clear all Value(s) 2377 pDimArray->SbxArray::Clear(); 2378 } 2379 else 2380 { 2381 pDimArray->Clear(); // clear dims and values 2382 } 2383 } 2384 else 2385 { 2386 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj ); 2387 if ( pArray ) 2388 { 2389 pArray->Clear(); 2390 } 2391 } 2392 } 2393 else 2394 { 2395 // Arrays have on an erase to VB quite a complex behaviour. Here are 2396 // only the type problems at REDIM (#26295) removed at first: 2397 // Set type hard onto the array-type, because a variable with array is 2398 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and 2399 // the original type is lost -> runtime error 2400 lcl_clearImpl( refVar, eType ); 2401 } 2402 } 2403 else if( refVar->IsFixed() ) 2404 { 2405 refVar->Clear(); 2406 } 2407 else 2408 { 2409 refVar->SetType( SbxEMPTY ); 2410 } 2411 } 2412 2413 // delete variable 2414 // TOS = variable 2415 2416 void SbiRuntime::StepERASE() 2417 { 2418 SbxVariableRef refVar = PopVar(); 2419 lcl_eraseImpl( refVar, bVBAEnabled ); 2420 } 2421 2422 void SbiRuntime::StepERASE_CLEAR() 2423 { 2424 refRedim = PopVar(); 2425 } 2426 2427 void SbiRuntime::StepARRAYACCESS() 2428 { 2429 if( !refArgv.is() ) 2430 { 2431 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2432 } 2433 SbxVariableRef refVar = PopVar(); 2434 refVar->SetParameters( refArgv.get() ); 2435 PopArgv(); 2436 PushVar( CheckArray( refVar.get() ) ); 2437 } 2438 2439 void SbiRuntime::StepBYVAL() 2440 { 2441 // Copy variable on stack to break call by reference 2442 SbxVariableRef pVar = PopVar(); 2443 SbxDataType t = pVar->GetType(); 2444 2445 SbxVariable* pCopyVar = new SbxVariable( t ); 2446 pCopyVar->SetFlag( SbxFlagBits::ReadWrite ); 2447 *pCopyVar = *pVar; 2448 2449 PushVar( pCopyVar ); 2450 } 2451 2452 // establishing an argv 2453 // nOp1 stays as it is -> 1st element is the return value 2454 2455 void SbiRuntime::StepARGC() 2456 { 2457 PushArgv(); 2458 refArgv = new SbxArray; 2459 nArgc = 1; 2460 } 2461 2462 // storing an argument in Argv 2463 2464 void SbiRuntime::StepARGV() 2465 { 2466 if( !refArgv.is() ) 2467 { 2468 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2469 } 2470 else 2471 { 2472 SbxVariableRef pVal = PopVar(); 2473 2474 // Before fix of #94916: 2475 if( dynamic_cast<const SbxMethod*>( pVal.get() ) != nullptr 2476 || dynamic_cast<const SbUnoProperty*>( pVal.get() ) != nullptr 2477 || dynamic_cast<const SbProcedureProperty*>( pVal.get() ) != nullptr ) 2478 { 2479 // evaluate methods and properties! 2480 SbxVariable* pRes = new SbxVariable( *pVal ); 2481 pVal = pRes; 2482 } 2483 refArgv->Put(pVal.get(), nArgc++); 2484 } 2485 } 2486 2487 // Input to Variable. The variable is on TOS and is 2488 // is removed afterwards. 2489 void SbiRuntime::StepINPUT() 2490 { 2491 OUStringBuffer sin; 2492 char ch = 0; 2493 ErrCode err; 2494 // Skip whitespace 2495 while( ( err = pIosys->GetError() ) == ERRCODE_NONE ) 2496 { 2497 ch = pIosys->Read(); 2498 if( ch != ' ' && ch != '\t' && ch != '\n' ) 2499 { 2500 break; 2501 } 2502 } 2503 if( !err ) 2504 { 2505 // Scan until comma or whitespace 2506 char sep = ( ch == '"' ) ? ch : 0; 2507 if( sep ) 2508 { 2509 ch = pIosys->Read(); 2510 } 2511 while( ( err = pIosys->GetError() ) == ERRCODE_NONE ) 2512 { 2513 if( ch == sep ) 2514 { 2515 ch = pIosys->Read(); 2516 if( ch != sep ) 2517 { 2518 break; 2519 } 2520 } 2521 else if( !sep && (ch == ',' || ch == '\n') ) 2522 { 2523 break; 2524 } 2525 sin.append( ch ); 2526 ch = pIosys->Read(); 2527 } 2528 // skip whitespace 2529 if( ch == ' ' || ch == '\t' ) 2530 { 2531 while( ( err = pIosys->GetError() ) == ERRCODE_NONE ) 2532 { 2533 if( ch != ' ' && ch != '\t' && ch != '\n' ) 2534 { 2535 break; 2536 } 2537 ch = pIosys->Read(); 2538 } 2539 } 2540 } 2541 if( !err ) 2542 { 2543 OUString s = sin.makeStringAndClear(); 2544 SbxVariableRef pVar = GetTOS(); 2545 // try to fill the variable with a numeric value first, 2546 // then with a string value 2547 if( !pVar->IsFixed() || pVar->IsNumeric() ) 2548 { 2549 sal_uInt16 nLen = 0; 2550 if( !pVar->Scan( s, &nLen ) ) 2551 { 2552 err = SbxBase::GetError(); 2553 SbxBase::ResetError(); 2554 } 2555 // the value has to be scanned in completely 2556 else if( nLen != s.getLength() && !pVar->PutString( s ) ) 2557 { 2558 err = SbxBase::GetError(); 2559 SbxBase::ResetError(); 2560 } 2561 else if( nLen != s.getLength() && pVar->IsNumeric() ) 2562 { 2563 err = SbxBase::GetError(); 2564 SbxBase::ResetError(); 2565 if( !err ) 2566 { 2567 err = ERRCODE_BASIC_CONVERSION; 2568 } 2569 } 2570 } 2571 else 2572 { 2573 pVar->PutString( s ); 2574 err = SbxBase::GetError(); 2575 SbxBase::ResetError(); 2576 } 2577 } 2578 if( err == ERRCODE_BASIC_USER_ABORT ) 2579 { 2580 Error( err ); 2581 } 2582 else if( err ) 2583 { 2584 if( pRestart && !pIosys->GetChannel() ) 2585 { 2586 pCode = pRestart; 2587 } 2588 else 2589 { 2590 Error( err ); 2591 } 2592 } 2593 else 2594 { 2595 PopVar(); 2596 } 2597 } 2598 2599 // Line Input to Variable. The variable is on TOS and is 2600 // deleted afterwards. 2601 2602 void SbiRuntime::StepLINPUT() 2603 { 2604 OString aInput; 2605 pIosys->Read( aInput ); 2606 Error( pIosys->GetError() ); 2607 SbxVariableRef p = PopVar(); 2608 p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding())); 2609 } 2610 2611 // end of program 2612 2613 void SbiRuntime::StepSTOP() 2614 { 2615 pInst->Stop(); 2616 } 2617 2618 2619 void SbiRuntime::StepINITFOR() 2620 { 2621 PushFor(); 2622 } 2623 2624 void SbiRuntime::StepINITFOREACH() 2625 { 2626 PushForEach(); 2627 } 2628 2629 // increment FOR-variable 2630 2631 void SbiRuntime::StepNEXT() 2632 { 2633 if( !pForStk ) 2634 { 2635 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2636 return; 2637 } 2638 if (pForStk->eForType != ForType::To) 2639 return; 2640 if (!pForStk->refVar) 2641 { 2642 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2643 return; 2644 } 2645 // tdf#85371 - grant explicitly write access to the index variable 2646 // since it could be the name of a method itself used in the next statement. 2647 ScopedWritableGuard aGuard(pForStk->refVar, pForStk->refVar.get() == pMeth); 2648 pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc ); 2649 } 2650 2651 // beginning CASE: TOS in CASE-stack 2652 2653 void SbiRuntime::StepCASE() 2654 { 2655 if( !refCaseStk.is() ) 2656 { 2657 refCaseStk = new SbxArray; 2658 } 2659 SbxVariableRef xVar = PopVar(); 2660 refCaseStk->Put(xVar.get(), refCaseStk->Count()); 2661 } 2662 2663 // end CASE: free variable 2664 2665 void SbiRuntime::StepENDCASE() 2666 { 2667 if (!refCaseStk.is() || !refCaseStk->Count()) 2668 { 2669 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2670 } 2671 else 2672 { 2673 refCaseStk->Remove(refCaseStk->Count() - 1); 2674 } 2675 } 2676 2677 2678 void SbiRuntime::StepSTDERROR() 2679 { 2680 pError = nullptr; bError = true; 2681 pInst->aErrorMsg.clear(); 2682 pInst->nErr = ERRCODE_NONE; 2683 pInst->nErl = 0; 2684 nError = ERRCODE_NONE; 2685 SbxErrObject::getUnoErrObject()->Clear(); 2686 } 2687 2688 void SbiRuntime::StepNOERROR() 2689 { 2690 pInst->aErrorMsg.clear(); 2691 pInst->nErr = ERRCODE_NONE; 2692 pInst->nErl = 0; 2693 nError = ERRCODE_NONE; 2694 SbxErrObject::getUnoErrObject()->Clear(); 2695 bError = false; 2696 } 2697 2698 // leave UP 2699 2700 void SbiRuntime::StepLEAVE() 2701 { 2702 bRun = false; 2703 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed ) 2704 if ( bInError && pError ) 2705 { 2706 SbxErrObject::getUnoErrObject()->Clear(); 2707 } 2708 } 2709 2710 void SbiRuntime::StepCHANNEL() // TOS = channel number 2711 { 2712 SbxVariableRef pChan = PopVar(); 2713 short nChan = pChan->GetInteger(); 2714 pIosys->SetChannel( nChan ); 2715 Error( pIosys->GetError() ); 2716 } 2717 2718 void SbiRuntime::StepCHANNEL0() 2719 { 2720 pIosys->ResetChannel(); 2721 } 2722 2723 void SbiRuntime::StepPRINT() // print TOS 2724 { 2725 SbxVariableRef p = PopVar(); 2726 OUString s1 = p->GetOUString(); 2727 OUString s; 2728 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE ) 2729 { 2730 s = " "; // one blank before 2731 } 2732 s += s1; 2733 pIosys->Write( s ); 2734 Error( pIosys->GetError() ); 2735 } 2736 2737 void SbiRuntime::StepPRINTF() // print TOS in field 2738 { 2739 SbxVariableRef p = PopVar(); 2740 OUString s1 = p->GetOUString(); 2741 OUStringBuffer s; 2742 if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE ) 2743 { 2744 s.append(' '); 2745 } 2746 s.append(s1); 2747 comphelper::string::padToLength(s, 14, ' '); 2748 pIosys->Write( s ); 2749 Error( pIosys->GetError() ); 2750 } 2751 2752 void SbiRuntime::StepWRITE() // write TOS 2753 { 2754 SbxVariableRef p = PopVar(); 2755 // Does the string have to be encapsulated? 2756 char ch = 0; 2757 switch (p->GetType() ) 2758 { 2759 case SbxSTRING: ch = '"'; break; 2760 case SbxCURRENCY: 2761 case SbxBOOL: 2762 case SbxDATE: ch = '#'; break; 2763 default: break; 2764 } 2765 OUString s; 2766 if( ch ) 2767 { 2768 s += OUStringChar(ch); 2769 } 2770 s += p->GetOUString(); 2771 if( ch ) 2772 { 2773 s += OUStringChar(ch); 2774 } 2775 pIosys->Write( s ); 2776 Error( pIosys->GetError() ); 2777 } 2778 2779 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos 2780 { 2781 SbxVariableRef pTos1 = PopVar(); 2782 SbxVariableRef pTos = PopVar(); 2783 OUString aDest = pTos1->GetOUString(); 2784 OUString aSource = pTos->GetOUString(); 2785 2786 if( hasUno() ) 2787 { 2788 implStepRenameUCB( aSource, aDest ); 2789 } 2790 else 2791 { 2792 implStepRenameOSL( aSource, aDest ); 2793 } 2794 } 2795 2796 // TOS = Prompt 2797 2798 void SbiRuntime::StepPROMPT() 2799 { 2800 SbxVariableRef p = PopVar(); 2801 OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding())); 2802 pIosys->SetPrompt( aStr ); 2803 } 2804 2805 // Set Restart point 2806 2807 void SbiRuntime::StepRESTART() 2808 { 2809 pRestart = pCode; 2810 } 2811 2812 // empty expression on stack for missing parameter 2813 2814 void SbiRuntime::StepEMPTY() 2815 { 2816 // #57915 The semantics of StepEMPTY() is the representation of a missing argument. 2817 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error 2818 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept 2819 // to simplify matters. 2820 SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); 2821 xVar->PutErr( 448 ); 2822 // tdf#79426, tdf#125180 - add additional information about a missing parameter 2823 SetIsMissing( xVar.get() ); 2824 PushVar( xVar.get() ); 2825 } 2826 2827 // TOS = error code 2828 2829 void SbiRuntime::StepERROR() 2830 { 2831 SbxVariableRef refCode = PopVar(); 2832 sal_uInt16 n = refCode->GetUShort(); 2833 ErrCode error = StarBASIC::GetSfxFromVBError( n ); 2834 if ( bVBAEnabled ) 2835 { 2836 pInst->Error( error ); 2837 } 2838 else 2839 { 2840 Error( error ); 2841 } 2842 } 2843 2844 // loading a numeric constant (+ID) 2845 2846 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 ) 2847 { 2848 // tdf#143707 - check if the data type character was added after the string termination symbol 2849 SbxDataType eTypeStr; 2850 // #57844 use localized function 2851 OUString aStr = pImg->GetString(nOp1, &eTypeStr); 2852 // also allow , !!! 2853 sal_Int32 iComma = aStr.indexOf(','); 2854 if( iComma >= 0 ) 2855 { 2856 aStr = aStr.replaceAt(iComma, 1, u"."); 2857 } 2858 sal_Int32 nParseEnd = 0; 2859 rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok; 2860 double n = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd ); 2861 2862 // tdf#131296 - retrieve data type put in SbiExprNode::Gen 2863 SbxDataType eType = SbxDOUBLE; 2864 if ( nParseEnd < aStr.getLength() ) 2865 { 2866 // tdf#143707 - Check if there was a data type character after the numeric constant, 2867 // added by older versions of the fix of the default values for strings. 2868 switch ( aStr[nParseEnd] ) 2869 { 2870 // See GetSuffixType in basic/source/comp/scanner.cxx for type characters 2871 case '%': eType = SbxINTEGER; break; 2872 case '&': eType = SbxLONG; break; 2873 case '!': eType = SbxSINGLE; break; 2874 case '@': eType = SbxCURRENCY; break; 2875 // tdf#142460 - properly handle boolean values in string pool 2876 case 'b': eType = SbxBOOL; break; 2877 } 2878 } 2879 // tdf#143707 - if the data type character is different from the default value, it was added 2880 // in basic/source/comp/symtbl.cxx. Hence, change the type of the numeric constant to be loaded. 2881 else if (eTypeStr != SbxSTRING) 2882 { 2883 eType = eTypeStr; 2884 } 2885 SbxVariable* p = new SbxVariable( eType ); 2886 p->PutDouble( n ); 2887 // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors 2888 p->ResetFlag( SbxFlagBits::Fixed ); 2889 PushVar( p ); 2890 } 2891 2892 // loading a string constant (+ID) 2893 2894 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 ) 2895 { 2896 SbxVariable* p = new SbxVariable; 2897 p->PutString( pImg->GetString( nOp1 ) ); 2898 PushVar( p ); 2899 } 2900 2901 // Immediate Load (+value) 2902 // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images 2903 2904 void SbiRuntime::StepLOADI( sal_uInt32 nOp1 ) 2905 { 2906 SbxVariable* p = new SbxVariable; 2907 p->PutInteger( static_cast<sal_Int16>( nOp1 ) ); 2908 PushVar( p ); 2909 } 2910 2911 // store a named argument in Argv (+Arg-no. from 1!) 2912 2913 void SbiRuntime::StepARGN( sal_uInt32 nOp1 ) 2914 { 2915 if( !refArgv.is() ) 2916 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2917 else 2918 { 2919 OUString aAlias( pImg->GetString( nOp1 ) ); 2920 SbxVariableRef pVal = PopVar(); 2921 if( bVBAEnabled && 2922 ( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr 2923 || dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr 2924 || dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) ) 2925 { 2926 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast 2927 if ( pVal->GetType() == SbxEMPTY ) 2928 pVal->Broadcast( SfxHintId::BasicDataWanted ); 2929 // evaluate methods and properties! 2930 SbxVariable* pRes = new SbxVariable( *pVal ); 2931 pVal = pRes; 2932 } 2933 refArgv->Put(pVal.get(), nArgc); 2934 refArgv->PutAlias(aAlias, nArgc++); 2935 } 2936 } 2937 2938 // converting the type of an argument in Argv for DECLARE-Fkt. (+type) 2939 2940 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 ) 2941 { 2942 if( !refArgv.is() ) 2943 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 2944 else 2945 { 2946 bool bByVal = (nOp1 & 0x8000) != 0; // Is BYVAL requested? 2947 SbxDataType t = static_cast<SbxDataType>(nOp1 & 0x7FFF); 2948 SbxVariable* pVar = refArgv->Get(refArgv->Count() - 1); // last Arg 2949 2950 // check BYVAL 2951 if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL 2952 { 2953 // parameter is a reference 2954 if( bByVal ) 2955 { 2956 // Call by Value is requested -> create a copy 2957 pVar = new SbxVariable( *pVar ); 2958 pVar->SetFlag( SbxFlagBits::ReadWrite ); 2959 refExprStk->Put(pVar, refArgv->Count() - 1); 2960 } 2961 else 2962 pVar->SetFlag( SbxFlagBits::Reference ); // Ref-Flag for DllMgr 2963 } 2964 else 2965 { 2966 // parameter is NO reference 2967 if( bByVal ) 2968 pVar->ResetFlag( SbxFlagBits::Reference ); // no reference -> OK 2969 else 2970 Error( ERRCODE_BASIC_BAD_PARAMETERS ); // reference needed 2971 } 2972 2973 if( pVar->GetType() != t ) 2974 { 2975 // variant for correct conversion 2976 // besides error, if SbxBYREF 2977 pVar->Convert( SbxVARIANT ); 2978 pVar->Convert( t ); 2979 } 2980 } 2981 } 2982 2983 // bring string to a definite length (+length) 2984 2985 void SbiRuntime::StepPAD( sal_uInt32 nOp1 ) 2986 { 2987 SbxVariable* p = GetTOS(); 2988 OUString s = p->GetOUString(); 2989 sal_Int32 nLen(nOp1); 2990 if( s.getLength() == nLen ) 2991 return; 2992 2993 OUStringBuffer aBuf(s); 2994 if (aBuf.getLength() > nLen) 2995 { 2996 comphelper::string::truncateToLength(aBuf, nLen); 2997 } 2998 else 2999 { 3000 comphelper::string::padToLength(aBuf, nLen, ' '); 3001 } 3002 s = aBuf.makeStringAndClear(); 3003 } 3004 3005 // jump (+target) 3006 3007 void SbiRuntime::StepJUMP( sal_uInt32 nOp1 ) 3008 { 3009 #ifdef DBG_UTIL 3010 // #QUESTION shouldn't this be 3011 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() ) 3012 if( nOp1 >= pImg->GetCodeSize() ) 3013 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3014 #endif 3015 pCode = pImg->GetCode() + nOp1; 3016 } 3017 3018 bool SbiRuntime::EvaluateTopOfStackAsBool() 3019 { 3020 SbxVariableRef tos = PopVar(); 3021 // In a test e.g. If Null then 3022 // will evaluate Null will act as if False 3023 if ( bVBAEnabled && tos->IsNull() ) 3024 { 3025 return false; 3026 } 3027 if ( tos->IsObject() ) 3028 { 3029 //GetBool applied to an Object attempts to dereference and evaluate 3030 //the underlying value as Bool. Here, we're checking rather that 3031 //it is not null 3032 return tos->GetObject(); 3033 } 3034 else 3035 { 3036 return tos->GetBool(); 3037 } 3038 } 3039 3040 // evaluate TOS, conditional jump (+target) 3041 3042 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 ) 3043 { 3044 if ( EvaluateTopOfStackAsBool() ) 3045 { 3046 StepJUMP( nOp1 ); 3047 } 3048 } 3049 3050 // evaluate TOS, conditional jump (+target) 3051 3052 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 ) 3053 { 3054 if ( !EvaluateTopOfStackAsBool() ) 3055 { 3056 StepJUMP( nOp1 ); 3057 } 3058 } 3059 3060 // evaluate TOS, jump into JUMP-table (+MaxVal) 3061 // looks like this: 3062 // ONJUMP 2 3063 // JUMP target1 3064 // JUMP target2 3065 3066 // if 0x8000 is set in the operand, push the return address (ON..GOSUB) 3067 3068 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 ) 3069 { 3070 SbxVariableRef p = PopVar(); 3071 sal_Int16 n = p->GetInteger(); 3072 if( nOp1 & 0x8000 ) 3073 { 3074 nOp1 &= 0x7FFF; 3075 PushGosub( pCode + 5 * nOp1 ); 3076 } 3077 if( n < 1 || o3tl::make_unsigned(n) > nOp1 ) 3078 n = static_cast<sal_Int16>( nOp1 + 1 ); 3079 nOp1 = static_cast<sal_uInt32>(pCode - pImg->GetCode()) + 5 * --n; 3080 StepJUMP( nOp1 ); 3081 } 3082 3083 // UP-call (+target) 3084 3085 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 ) 3086 { 3087 PushGosub( pCode ); 3088 if( nOp1 >= pImg->GetCodeSize() ) 3089 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3090 pCode = pImg->GetCode() + nOp1; 3091 } 3092 3093 // UP-return (+0 or target) 3094 3095 void SbiRuntime::StepRETURN( sal_uInt32 nOp1 ) 3096 { 3097 PopGosub(); 3098 if( nOp1 ) 3099 StepJUMP( nOp1 ); 3100 } 3101 3102 // check FOR-variable (+Endlabel) 3103 3104 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 ) 3105 { 3106 if( !pForStk ) 3107 { 3108 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3109 return; 3110 } 3111 3112 bool bEndLoop = false; 3113 switch( pForStk->eForType ) 3114 { 3115 case ForType::To: 3116 { 3117 SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT; 3118 if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) ) 3119 bEndLoop = true; 3120 if (SbxBase::IsError()) 3121 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3122 break; 3123 } 3124 case ForType::EachArray: 3125 { 3126 SbiForStack* p = pForStk; 3127 if (!p->refEnd) 3128 { 3129 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3130 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3131 } 3132 else if (p->pArrayCurIndices == nullptr) 3133 { 3134 bEndLoop = true; 3135 } 3136 else 3137 { 3138 SbxDimArray* pArray = reinterpret_cast<SbxDimArray*>(p->refEnd.get()); 3139 sal_Int32 nDims = pArray->GetDims(); 3140 3141 // Empty array? 3142 if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] ) 3143 { 3144 bEndLoop = true; 3145 break; 3146 } 3147 SbxVariable* pVal = pArray->Get(p->pArrayCurIndices.get()); 3148 *(p->refVar) = *pVal; 3149 3150 bool bFoundNext = false; 3151 for(sal_Int32 i = 0 ; i < nDims ; i++ ) 3152 { 3153 if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] ) 3154 { 3155 bFoundNext = true; 3156 p->pArrayCurIndices[i]++; 3157 for( sal_Int32 j = i - 1 ; j >= 0 ; j-- ) 3158 p->pArrayCurIndices[j] = p->pArrayLowerBounds[j]; 3159 break; 3160 } 3161 } 3162 if( !bFoundNext ) 3163 { 3164 p->pArrayCurIndices.reset(); 3165 } 3166 } 3167 break; 3168 } 3169 case ForType::EachCollection: 3170 { 3171 if (!pForStk->refEnd) 3172 { 3173 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3174 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3175 break; 3176 } 3177 3178 BasicCollection* pCollection = static_cast<BasicCollection*>(pForStk->refEnd.get()); 3179 SbxArrayRef xItemArray = pCollection->xItemArray; 3180 sal_Int32 nCount = xItemArray->Count(); 3181 if( pForStk->nCurCollectionIndex < nCount ) 3182 { 3183 SbxVariable* pRes = xItemArray->Get(pForStk->nCurCollectionIndex); 3184 pForStk->nCurCollectionIndex++; 3185 (*pForStk->refVar) = *pRes; 3186 } 3187 else 3188 { 3189 bEndLoop = true; 3190 } 3191 break; 3192 } 3193 case ForType::EachXEnumeration: 3194 { 3195 SbiForStack* p = pForStk; 3196 if (!p->xEnumeration) 3197 { 3198 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3199 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3200 } 3201 else if (p->xEnumeration->hasMoreElements()) 3202 { 3203 Any aElem = p->xEnumeration->nextElement(); 3204 SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); 3205 unoToSbxValue( xVar.get(), aElem ); 3206 (*pForStk->refVar) = *xVar; 3207 } 3208 else 3209 { 3210 bEndLoop = true; 3211 } 3212 break; 3213 } 3214 // tdf#130307 - support for each loop for objects exposing XIndexAccess 3215 case ForType::EachXIndexAccess: 3216 { 3217 SbiForStack* p = pForStk; 3218 if (!p->xIndexAccess) 3219 { 3220 SbxBase::SetError(ERRCODE_BASIC_CONVERSION); 3221 pForStk->eForType = ForType::Error; // terminate loop at the next iteration 3222 } 3223 else if (pForStk->nCurCollectionIndex < p->xIndexAccess->getCount()) 3224 { 3225 Any aElem = p->xIndexAccess->getByIndex(pForStk->nCurCollectionIndex); 3226 pForStk->nCurCollectionIndex++; 3227 SbxVariableRef xVar = new SbxVariable(SbxVARIANT); 3228 unoToSbxValue(xVar.get(), aElem); 3229 (*pForStk->refVar) = *xVar; 3230 } 3231 else 3232 { 3233 bEndLoop = true; 3234 } 3235 break; 3236 } 3237 case ForType::Error: 3238 { 3239 // We are in Resume Next mode after failed loop initialization 3240 bEndLoop = true; 3241 Error(ERRCODE_BASIC_BAD_PARAMETER); 3242 break; 3243 } 3244 } 3245 if( bEndLoop ) 3246 { 3247 PopFor(); 3248 StepJUMP( nOp1 ); 3249 } 3250 } 3251 3252 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target) 3253 3254 void SbiRuntime::StepCASETO( sal_uInt32 nOp1 ) 3255 { 3256 if (!refCaseStk.is() || !refCaseStk->Count()) 3257 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3258 else 3259 { 3260 SbxVariableRef xTo = PopVar(); 3261 SbxVariableRef xFrom = PopVar(); 3262 SbxVariableRef xCase = refCaseStk->Get(refCaseStk->Count() - 1); 3263 if( *xCase >= *xFrom && *xCase <= *xTo ) 3264 StepJUMP( nOp1 ); 3265 } 3266 } 3267 3268 3269 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 ) 3270 { 3271 const sal_uInt8* p = pCode; 3272 StepJUMP( nOp1 ); 3273 pError = pCode; 3274 pCode = p; 3275 pInst->aErrorMsg.clear(); 3276 pInst->nErr = ERRCODE_NONE; 3277 pInst->nErl = 0; 3278 nError = ERRCODE_NONE; 3279 SbxErrObject::getUnoErrObject()->Clear(); 3280 } 3281 3282 // Resume after errors (+0=statement, 1=next or Label) 3283 3284 void SbiRuntime::StepRESUME( sal_uInt32 nOp1 ) 3285 { 3286 // #32714 Resume without error? -> error 3287 if( !bInError ) 3288 { 3289 Error( ERRCODE_BASIC_BAD_RESUME ); 3290 return; 3291 } 3292 if( nOp1 ) 3293 { 3294 // set Code-pointer to the next statement 3295 sal_uInt16 n1, n2; 3296 pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg ); 3297 } 3298 else 3299 pCode = pErrStmnt; 3300 if ( pError ) // current in error handler ( and got a Resume Next statement ) 3301 SbxErrObject::getUnoErrObject()->Clear(); 3302 3303 if( nOp1 > 1 ) 3304 StepJUMP( nOp1 ); 3305 pInst->aErrorMsg.clear(); 3306 pInst->nErr = ERRCODE_NONE; 3307 pInst->nErl = 0; 3308 nError = ERRCODE_NONE; 3309 bInError = false; 3310 } 3311 3312 // close channel (+channel, 0=all) 3313 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 ) 3314 { 3315 ErrCode err; 3316 if( !nOp1 ) 3317 pIosys->Shutdown(); 3318 else 3319 { 3320 err = pIosys->GetError(); 3321 if( !err ) 3322 { 3323 pIosys->Close(); 3324 } 3325 } 3326 err = pIosys->GetError(); 3327 Error( err ); 3328 } 3329 3330 // output character (+char) 3331 3332 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 ) 3333 { 3334 OUString s(static_cast<sal_Unicode>(nOp1)); 3335 pIosys->Write( s ); 3336 Error( pIosys->GetError() ); 3337 } 3338 3339 // check whether TOS is a certain object class (+StringID) 3340 3341 bool SbiRuntime::implIsClass( SbxObject const * pObj, const OUString& aClass ) 3342 { 3343 bool bRet = true; 3344 3345 if( !aClass.isEmpty() ) 3346 { 3347 bRet = pObj->IsClass( aClass ); 3348 if( !bRet ) 3349 bRet = aClass.equalsIgnoreAsciiCase( "object" ); 3350 if( !bRet ) 3351 { 3352 const OUString& aObjClass = pObj->GetClassName(); 3353 SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass ); 3354 if( pClassMod ) 3355 { 3356 SbClassData* pClassData = pClassMod->pClassData.get(); 3357 if (pClassData != nullptr ) 3358 { 3359 SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxClassType::DontCare ); 3360 bRet = (pClassVar != nullptr); 3361 } 3362 } 3363 } 3364 } 3365 return bRet; 3366 } 3367 3368 bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal, 3369 const OUString& aClass, bool bRaiseErrors, bool bDefault ) 3370 { 3371 bool bOk = bDefault; 3372 3373 SbxDataType t = refVal->GetType(); 3374 SbxVariable* pVal = refVal.get(); 3375 // we don't know the type of uno properties that are (maybevoid) 3376 if ( t == SbxEMPTY ) 3377 { 3378 if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) ) 3379 { 3380 t = pProp->getRealType(); 3381 } 3382 } 3383 if( t == SbxOBJECT || bVBAEnabled ) 3384 { 3385 SbxObject* pObj = dynamic_cast<SbxObject*>(pVal); 3386 if (!pObj) 3387 { 3388 pObj = dynamic_cast<SbxObject*>(refVal->GetObject()); 3389 } 3390 if( pObj ) 3391 { 3392 if( !implIsClass( pObj, aClass ) ) 3393 { 3394 SbUnoObject* pUnoObj(nullptr); 3395 if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration()) 3396 { 3397 pUnoObj = dynamic_cast<SbUnoObject*>(pObj); 3398 } 3399 3400 if (pUnoObj) 3401 bOk = checkUnoObjectType(*pUnoObj, aClass); 3402 else 3403 bOk = false; 3404 if ( !bOk && bRaiseErrors ) 3405 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); 3406 } 3407 else 3408 { 3409 bOk = true; 3410 3411 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pObj ); 3412 if( pClassModuleObject != nullptr ) 3413 pClassModuleObject->triggerInitializeEvent(); 3414 } 3415 } 3416 } 3417 else 3418 { 3419 if( bRaiseErrors ) 3420 Error( ERRCODE_BASIC_NEEDS_OBJECT ); 3421 bOk = false; 3422 } 3423 return bOk; 3424 } 3425 3426 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt ) 3427 { 3428 SbxVariableRef refVal = PopVar(); 3429 SbxVariableRef refVar = PopVar(); 3430 OUString aClass( pImg->GetString( nOp1 ) ); 3431 3432 bool bOk = checkClass_Impl( refVal, aClass, true, true ); 3433 if( bOk ) 3434 { 3435 StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set 3436 } 3437 } 3438 3439 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 ) 3440 { 3441 StepSETCLASS_impl( nOp1, false ); 3442 } 3443 3444 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 ) 3445 { 3446 StepSETCLASS_impl( nOp1, true ); 3447 } 3448 3449 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 ) 3450 { 3451 SbxVariableRef xObjVal = PopVar(); 3452 OUString aClass( pImg->GetString( nOp1 ) ); 3453 bool bDefault = !bVBAEnabled; 3454 bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault ); 3455 3456 SbxVariable* pRet = new SbxVariable; 3457 pRet->PutBool( bOk ); 3458 PushVar( pRet ); 3459 } 3460 3461 // define library for following declare-call 3462 3463 void SbiRuntime::StepLIB( sal_uInt32 nOp1 ) 3464 { 3465 aLibName = pImg->GetString( nOp1 ); 3466 } 3467 3468 // TOS is incremented by BASE, BASE is pushed before (+BASE) 3469 // This opcode is pushed before DIM/REDIM-commands, 3470 // if there's been only one index named. 3471 3472 void SbiRuntime::StepBASED( sal_uInt32 nOp1 ) 3473 { 3474 SbxVariable* p1 = new SbxVariable; 3475 SbxVariableRef x2 = PopVar(); 3476 3477 // #109275 Check compatibility mode 3478 bool bCompatible = ((nOp1 & 0x8000) != 0); 3479 sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1 3480 p1->PutInteger( uBase ); 3481 if( !bCompatible ) 3482 { 3483 // tdf#85371 - grant explicitly write access to the dimension variable 3484 // since in Star/OpenOffice Basic the upper index border is affected, 3485 // and the dimension variable could be the name of the method itself. 3486 ScopedWritableGuard aGuard(x2, x2.get() == pMeth); 3487 x2->Compute( SbxPLUS, *p1 ); 3488 } 3489 PushVar( x2.get() ); // first the Expr 3490 PushVar( p1 ); // then the Base 3491 } 3492 3493 // the bits in the String-ID: 3494 // 0x8000 - Argv is reserved 3495 3496 SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, 3497 ErrCode nNotFound, bool bLocal, bool bStatic ) 3498 { 3499 bool bIsVBAInterOp = SbiRuntime::isVBAEnabled(); 3500 if( bIsVBAInterOp ) 3501 { 3502 StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib; 3503 if( pMSOMacroRuntimeLib != nullptr ) 3504 { 3505 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::ExtSearch ); 3506 } 3507 } 3508 3509 SbxVariable* pElem = nullptr; 3510 if( !pObj ) 3511 { 3512 Error( ERRCODE_BASIC_NO_OBJECT ); 3513 pElem = new SbxVariable; 3514 } 3515 else 3516 { 3517 bool bFatalError = false; 3518 SbxDataType t = static_cast<SbxDataType>(nOp2); 3519 OUString aName( pImg->GetString( nOp1 & 0x7FFF ) ); 3520 // Hacky capture of Evaluate [] syntax 3521 // this should be tackled I feel at the pcode level 3522 if ( bIsVBAInterOp && aName.startsWith("[") ) 3523 { 3524 // emulate pcode here 3525 StepARGC(); 3526 // pseudo StepLOADSC 3527 OUString sArg = aName.copy( 1, aName.getLength() - 2 ); 3528 SbxVariable* p = new SbxVariable; 3529 p->PutString( sArg ); 3530 PushVar( p ); 3531 StepARGV(); 3532 nOp1 = nOp1 | 0x8000; // indicate params are present 3533 aName = "Evaluate"; 3534 } 3535 if( bLocal ) 3536 { 3537 if ( bStatic && pMeth ) 3538 { 3539 pElem = pMeth->GetStatics()->Find( aName, SbxClassType::DontCare ); 3540 } 3541 3542 if ( !pElem ) 3543 { 3544 pElem = refLocals->Find( aName, SbxClassType::DontCare ); 3545 } 3546 } 3547 if( !pElem ) 3548 { 3549 bool bSave = rBasic.bNoRtl; 3550 rBasic.bNoRtl = true; 3551 pElem = pObj->Find( aName, SbxClassType::DontCare ); 3552 3553 // #110004, #112015: Make private really private 3554 if( bLocal && pElem ) // Local as flag for global search 3555 { 3556 if( pElem->IsSet( SbxFlagBits::Private ) ) 3557 { 3558 SbiInstance* pInst_ = GetSbData()->pInst; 3559 if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() ) 3560 { 3561 pElem = nullptr; // Found but in wrong module! 3562 } 3563 // Interfaces: Use SbxFlagBits::ExtFound 3564 } 3565 } 3566 rBasic.bNoRtl = bSave; 3567 3568 // is it a global uno-identifier? 3569 if( bLocal && !pElem ) 3570 { 3571 bool bSetName = true; // preserve normal behaviour 3572 3573 // i#i68894# if VBAInterOp favour searching vba globals 3574 // over searching for uno classes 3575 if ( bVBAEnabled ) 3576 { 3577 // Try Find in VBA symbols space 3578 pElem = rBasic.VBAFind( aName, SbxClassType::DontCare ); 3579 if ( pElem ) 3580 { 3581 bSetName = false; // don't overwrite uno name 3582 } 3583 else 3584 { 3585 pElem = VBAConstantHelper::instance().getVBAConstant( aName ); 3586 } 3587 } 3588 3589 if( !pElem ) 3590 { 3591 // #72382 ATTENTION! ALWAYS returns a result now 3592 // because of unknown modules! 3593 SbUnoClass* pUnoClass = findUnoClass( aName ); 3594 if( pUnoClass ) 3595 { 3596 pElem = new SbxVariable( t ); 3597 SbxValues aRes( SbxOBJECT ); 3598 aRes.pObj = pUnoClass; 3599 pElem->SbxVariable::Put( aRes ); 3600 } 3601 } 3602 3603 // #62939 If a uno-class has been found, the wrapper 3604 // object has to be held, because the uno-class, e. g. 3605 // "stardiv", has to be read out of the registry 3606 // every time again otherwise 3607 if( pElem ) 3608 { 3609 // #63774 May not be saved too!!! 3610 pElem->SetFlag( SbxFlagBits::DontStore ); 3611 pElem->SetFlag( SbxFlagBits::NoModify); 3612 3613 // #72382 save locally, all variables that have been declared 3614 // implicit would become global automatically otherwise! 3615 if ( bSetName ) 3616 { 3617 pElem->SetName( aName ); 3618 } 3619 refLocals->Put(pElem, refLocals->Count()); 3620 } 3621 } 3622 3623 if( !pElem ) 3624 { 3625 // not there and not in the object? 3626 // don't establish if that thing has parameters! 3627 if( nOp1 & 0x8000 ) 3628 { 3629 bFatalError = true; 3630 } 3631 3632 // else, if there are parameters, use different error code 3633 if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) ) 3634 { 3635 // #39108 if explicit and as ELEM always a fatal error 3636 bFatalError = true; 3637 3638 3639 if( !( nOp1 & 0x8000 ) && nNotFound == ERRCODE_BASIC_PROC_UNDEFINED ) 3640 { 3641 nNotFound = ERRCODE_BASIC_VAR_UNDEFINED; 3642 } 3643 } 3644 if( bFatalError ) 3645 { 3646 // #39108 use dummy variable instead of fatal error 3647 if( !xDummyVar.is() ) 3648 { 3649 xDummyVar = new SbxVariable( SbxVARIANT ); 3650 } 3651 pElem = xDummyVar.get(); 3652 3653 ClearArgvStack(); 3654 3655 Error( nNotFound, aName ); 3656 } 3657 else 3658 { 3659 if ( bStatic ) 3660 { 3661 pElem = StepSTATIC_Impl( aName, t, 0 ); 3662 } 3663 if ( !pElem ) 3664 { 3665 pElem = new SbxVariable( t ); 3666 if( t != SbxVARIANT ) 3667 { 3668 pElem->SetFlag( SbxFlagBits::Fixed ); 3669 } 3670 pElem->SetName( aName ); 3671 refLocals->Put(pElem, refLocals->Count()); 3672 } 3673 } 3674 } 3675 } 3676 // #39108 Args can already be deleted! 3677 if( !bFatalError ) 3678 { 3679 SetupArgs( pElem, nOp1 ); 3680 } 3681 // because a particular call-type is requested 3682 if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem)) 3683 { 3684 // shall the type be converted? 3685 SbxDataType t2 = pElem->GetType(); 3686 bool bSet = false; 3687 if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE ) 3688 { 3689 if( t != SbxVARIANT && t != t2 && 3690 t >= SbxINTEGER && t <= SbxSTRING ) 3691 { 3692 pElem->SetType( t ); 3693 bSet = true; 3694 } 3695 } 3696 // assign pElem to a Ref, to delete a temp-var if applicable 3697 SbxVariableRef xDeleteRef = pElem; 3698 3699 // remove potential rests of the last call of the SbxMethod 3700 // free Write before, so that there's no error 3701 SbxFlagBits nSavFlags = pElem->GetFlags(); 3702 pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast ); 3703 pElem->SbxValue::Clear(); 3704 pElem->SetFlags( nSavFlags ); 3705 3706 // don't touch before setting, as e. g. LEFT() 3707 // has to know the difference between Left$() and Left() 3708 3709 // because the methods' parameters are cut away in PopVar() 3710 SbxVariable* pNew = new SbxMethod(*pMethod); 3711 //OLD: SbxVariable* pNew = new SbxVariable( *pElem ); 3712 3713 pElem->SetParameters(nullptr); 3714 pNew->SetFlag( SbxFlagBits::ReadWrite ); 3715 3716 if( bSet ) 3717 { 3718 pElem->SetType( t2 ); 3719 } 3720 pElem = pNew; 3721 } 3722 // consider index-access for UnoObjects 3723 // definitely we want this for VBA where properties are often 3724 // collections ( which need index access ), but lets only do 3725 // this if we actually have params following 3726 else if( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() ) 3727 { 3728 SbxVariableRef xDeleteRef = pElem; 3729 3730 // dissolve the notify while copying variable 3731 SbxVariable* pNew = new SbxVariable( *pElem ); 3732 pElem->SetParameters( nullptr ); 3733 pElem = pNew; 3734 } 3735 } 3736 return CheckArray( pElem ); 3737 } 3738 3739 // for current scope (e. g. query from BASIC-IDE) 3740 SbxBase* SbiRuntime::FindElementExtern( const OUString& rName ) 3741 { 3742 // don't expect pMeth to be != 0, as there are none set 3743 // in the RunInit yet 3744 3745 SbxVariable* pElem = nullptr; 3746 if( !pMod || rName.isEmpty() ) 3747 { 3748 return nullptr; 3749 } 3750 if( refLocals.is() ) 3751 { 3752 pElem = refLocals->Find( rName, SbxClassType::DontCare ); 3753 } 3754 if ( !pElem && pMeth ) 3755 { 3756 const OUString aMethName = pMeth->GetName(); 3757 // tdf#57308 - check if the name is the current method instance 3758 if (pMeth->GetName() == rName) 3759 { 3760 pElem = pMeth; 3761 } 3762 else 3763 { 3764 // for statics, set the method's name in front 3765 pElem = pMod->Find(aMethName + ":" + rName, SbxClassType::DontCare); 3766 } 3767 } 3768 3769 3770 // search in parameter list 3771 if( !pElem && pMeth ) 3772 { 3773 SbxInfo* pInfo = pMeth->GetInfo(); 3774 if( pInfo && refParams.is() ) 3775 { 3776 sal_uInt32 nParamCount = refParams->Count(); 3777 assert(nParamCount <= std::numeric_limits<sal_uInt16>::max()); 3778 sal_uInt16 j = 1; 3779 const SbxParamInfo* pParam = pInfo->GetParam( j ); 3780 while( pParam ) 3781 { 3782 if( pParam->aName.equalsIgnoreAsciiCase( rName ) ) 3783 { 3784 if( j >= nParamCount ) 3785 { 3786 // Parameter is missing 3787 pElem = new SbxVariable( SbxSTRING ); 3788 pElem->PutString( "<missing parameter>"); 3789 } 3790 else 3791 { 3792 pElem = refParams->Get(j); 3793 } 3794 break; 3795 } 3796 pParam = pInfo->GetParam( ++j ); 3797 } 3798 } 3799 } 3800 3801 // search in module 3802 if( !pElem ) 3803 { 3804 bool bSave = rBasic.bNoRtl; 3805 rBasic.bNoRtl = true; 3806 pElem = pMod->Find( rName, SbxClassType::DontCare ); 3807 rBasic.bNoRtl = bSave; 3808 } 3809 return pElem; 3810 } 3811 3812 3813 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 ) 3814 { 3815 if( nOp1 & 0x8000 ) 3816 { 3817 if( !refArgv.is() ) 3818 { 3819 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 3820 } 3821 bool bHasNamed = false; 3822 sal_uInt32 i; 3823 sal_uInt32 nArgCount = refArgv->Count(); 3824 for( i = 1 ; i < nArgCount ; i++ ) 3825 { 3826 if (!refArgv->GetAlias(i).isEmpty()) 3827 { 3828 bHasNamed = true; break; 3829 } 3830 } 3831 if( bHasNamed ) 3832 { 3833 SbxInfo* pInfo = p->GetInfo(); 3834 if( !pInfo ) 3835 { 3836 bool bError_ = true; 3837 3838 SbUnoMethod* pUnoMethod = dynamic_cast<SbUnoMethod*>( p ); 3839 SbUnoProperty* pUnoProperty = dynamic_cast<SbUnoProperty*>( p ); 3840 if( pUnoMethod || pUnoProperty ) 3841 { 3842 SbUnoObject* pParentUnoObj = dynamic_cast<SbUnoObject*>( p->GetParent() ); 3843 if( pParentUnoObj ) 3844 { 3845 Any aUnoAny = pParentUnoObj->getUnoAny(); 3846 Reference< XInvocation > xInvocation; 3847 aUnoAny >>= xInvocation; 3848 if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() ) 3849 { 3850 bError_ = false; 3851 3852 sal_uInt32 nCurPar = 1; 3853 AutomationNamedArgsSbxArray* pArg = 3854 new AutomationNamedArgsSbxArray( nArgCount ); 3855 OUString* pNames = pArg->getNames().getArray(); 3856 for( i = 1 ; i < nArgCount ; i++ ) 3857 { 3858 SbxVariable* pVar = refArgv->Get(i); 3859 OUString aName = refArgv->GetAlias(i); 3860 if (!aName.isEmpty()) 3861 { 3862 pNames[i] = aName; 3863 } 3864 pArg->Put(pVar, nCurPar++); 3865 } 3866 refArgv = pArg; 3867 } 3868 } 3869 } 3870 else if( bVBAEnabled && p->GetType() == SbxOBJECT && (dynamic_cast<const SbxMethod*>( p) == nullptr || !p->IsBroadcaster()) ) 3871 { 3872 // Check for default method with named parameters 3873 SbxBaseRef xObj = p->GetObject(); 3874 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( xObj.get() )) 3875 { 3876 Any aAny = pUnoObj->getUnoAny(); 3877 3878 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 3879 { 3880 Reference< XDefaultMethod > xDfltMethod( aAny, UNO_QUERY ); 3881 3882 OUString sDefaultMethod; 3883 if ( xDfltMethod.is() ) 3884 { 3885 sDefaultMethod = xDfltMethod->getDefaultMethodName(); 3886 } 3887 if ( !sDefaultMethod.isEmpty() ) 3888 { 3889 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method ); 3890 if( meth != nullptr ) 3891 { 3892 pInfo = meth->GetInfo(); 3893 } 3894 if( pInfo ) 3895 { 3896 bError_ = false; 3897 } 3898 } 3899 } 3900 } 3901 } 3902 if( bError_ ) 3903 { 3904 Error( ERRCODE_BASIC_NO_NAMED_ARGS ); 3905 } 3906 } 3907 else 3908 { 3909 sal_uInt32 nCurPar = 1; 3910 SbxArray* pArg = new SbxArray; 3911 for( i = 1 ; i < nArgCount ; i++ ) 3912 { 3913 SbxVariable* pVar = refArgv->Get(i); 3914 OUString aName = refArgv->GetAlias(i); 3915 if (!aName.isEmpty()) 3916 { 3917 // nCurPar is set to the found parameter 3918 sal_uInt16 j = 1; 3919 const SbxParamInfo* pParam = pInfo->GetParam( j ); 3920 while( pParam ) 3921 { 3922 if( pParam->aName.equalsIgnoreAsciiCase( aName ) ) 3923 { 3924 nCurPar = j; 3925 break; 3926 } 3927 pParam = pInfo->GetParam( ++j ); 3928 } 3929 if( !pParam ) 3930 { 3931 Error( ERRCODE_BASIC_NAMED_NOT_FOUND ); break; 3932 } 3933 } 3934 pArg->Put(pVar, nCurPar++); 3935 } 3936 refArgv = pArg; 3937 } 3938 } 3939 // own var as parameter 0 3940 refArgv->Put(p, 0); 3941 p->SetParameters( refArgv.get() ); 3942 PopArgv(); 3943 } 3944 else 3945 { 3946 p->SetParameters( nullptr ); 3947 } 3948 } 3949 3950 // getting an array element 3951 3952 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem ) 3953 { 3954 SbxArray* pPar; 3955 if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem ) 3956 { 3957 SbxBase* pElemObj = pElem->GetObject(); 3958 SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); 3959 pPar = pElem->GetParameters(); 3960 if( pDimArray ) 3961 { 3962 // parameters may be missing, if an array is 3963 // passed as an argument 3964 if( pPar ) 3965 pElem = pDimArray->Get( pPar ); 3966 } 3967 else 3968 { 3969 SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj ); 3970 if( pArray ) 3971 { 3972 if( !pPar ) 3973 { 3974 Error( ERRCODE_BASIC_OUT_OF_RANGE ); 3975 pElem = new SbxVariable; 3976 } 3977 else 3978 { 3979 pElem = pArray->Get(pPar->Get(1)->GetInteger()); 3980 } 3981 } 3982 } 3983 3984 // #42940, set parameter 0 to NULL so that var doesn't contain itself 3985 if( pPar ) 3986 { 3987 pPar->Put(nullptr, 0); 3988 } 3989 } 3990 // consider index-access for UnoObjects 3991 else if( pElem->GetType() == SbxOBJECT && 3992 dynamic_cast<const SbxMethod*>( pElem) == nullptr && 3993 ( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) ) 3994 { 3995 pPar = pElem->GetParameters(); 3996 if ( pPar ) 3997 { 3998 // is it a uno-object? 3999 SbxBaseRef pObj = pElem->GetObject(); 4000 if( pObj.is() ) 4001 { 4002 if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get())) 4003 { 4004 Any aAny = pUnoObj->getUnoAny(); 4005 4006 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 4007 { 4008 Reference< XIndexAccess > xIndexAccess( aAny, UNO_QUERY ); 4009 if ( !bVBAEnabled ) 4010 { 4011 if( xIndexAccess.is() ) 4012 { 4013 sal_uInt32 nParamCount = pPar->Count() - 1; 4014 if( nParamCount != 1 ) 4015 { 4016 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT ); 4017 return pElem; 4018 } 4019 4020 // get index 4021 sal_Int32 nIndex = pPar->Get(1)->GetLong(); 4022 Reference< XInterface > xRet; 4023 try 4024 { 4025 Any aAny2 = xIndexAccess->getByIndex( nIndex ); 4026 aAny2 >>= xRet; 4027 } 4028 catch (const IndexOutOfBoundsException&) 4029 { 4030 // usually expect converting problem 4031 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE ); 4032 } 4033 4034 // #57847 always create a new variable, else error 4035 // due to PutObject(NULL) at ReadOnly-properties 4036 pElem = new SbxVariable( SbxVARIANT ); 4037 if( xRet.is() ) 4038 { 4039 aAny <<= xRet; 4040 4041 // #67173 don't specify a name so that the real class name is entered 4042 SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny )); 4043 pElem->PutObject( xWrapper.get() ); 4044 } 4045 else 4046 { 4047 pElem->PutObject( nullptr ); 4048 } 4049 } 4050 } 4051 else 4052 { 4053 // check if there isn't a default member between the current variable 4054 // and the params, e.g. 4055 // Dim rst1 As New ADODB.Recordset 4056 // " 4057 // val = rst1("FirstName") 4058 // has the default 'Fields' member between rst1 and '("FirstName")' 4059 Any x = aAny; 4060 SbxVariable* pDflt = getDefaultProp( pElem ); 4061 if ( pDflt ) 4062 { 4063 pDflt->Broadcast( SfxHintId::BasicDataWanted ); 4064 SbxBaseRef pDfltObj = pDflt->GetObject(); 4065 if( pDfltObj.is() ) 4066 { 4067 if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get())) 4068 { 4069 pUnoObj = pSbObj; 4070 Any aUnoAny = pUnoObj->getUnoAny(); 4071 4072 if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 4073 x = aUnoAny; 4074 pElem = pDflt; 4075 } 4076 } 4077 } 4078 OUString sDefaultMethod; 4079 4080 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY ); 4081 4082 if ( xDfltMethod.is() ) 4083 { 4084 sDefaultMethod = xDfltMethod->getDefaultMethodName(); 4085 } 4086 else if( xIndexAccess.is() ) 4087 { 4088 sDefaultMethod = "getByIndex"; 4089 } 4090 if ( !sDefaultMethod.isEmpty() ) 4091 { 4092 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method ); 4093 SbxVariableRef refTemp = meth; 4094 if ( refTemp.is() ) 4095 { 4096 meth->SetParameters( pPar ); 4097 SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) ); 4098 pElem = pNew; 4099 } 4100 } 4101 } 4102 } 4103 4104 // #42940, set parameter 0 to NULL so that var doesn't contain itself 4105 pPar->Put(nullptr, 0); 4106 } 4107 else if (BasicCollection* pCol = dynamic_cast<BasicCollection*>(pObj.get())) 4108 { 4109 pElem = new SbxVariable( SbxVARIANT ); 4110 pPar->Put(pElem, 0); 4111 pCol->CollItem( pPar ); 4112 } 4113 } 4114 else if( bVBAEnabled ) // !pObj 4115 { 4116 SbxArray* pParam = pElem->GetParameters(); 4117 if( pParam != nullptr && !pElem->IsSet( SbxFlagBits::VarToDim ) ) 4118 { 4119 Error( ERRCODE_BASIC_NO_OBJECT ); 4120 } 4121 } 4122 } 4123 } 4124 4125 return pElem; 4126 } 4127 4128 // loading an element from the runtime-library (+StringID+type) 4129 4130 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4131 { 4132 PushVar( FindElement( rBasic.pRtl.get(), nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, false ) ); 4133 } 4134 4135 void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, 4136 ErrCode nNotFound, bool bStatic ) 4137 { 4138 if( !refLocals.is() ) 4139 { 4140 refLocals = new SbxArray; 4141 } 4142 PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, true/*bLocal*/, bStatic ) ); 4143 } 4144 // loading a local/global variable (+StringID+type) 4145 4146 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4147 { 4148 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED ); 4149 } 4150 4151 // Search inside a class module (CM) to enable global search in time 4152 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4153 { 4154 4155 SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pMod ); 4156 if( pClassModuleObject ) 4157 { 4158 pMod->SetFlag( SbxFlagBits::GlobalSearch ); 4159 } 4160 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED); 4161 4162 if( pClassModuleObject ) 4163 { 4164 pMod->ResetFlag( SbxFlagBits::GlobalSearch ); 4165 } 4166 } 4167 4168 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4169 { 4170 StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, true ); 4171 } 4172 4173 // loading an object-element (+StringID+type) 4174 // the object lies on TOS 4175 4176 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4177 { 4178 SbxVariableRef pObjVar = PopVar(); 4179 4180 SbxObject* pObj = dynamic_cast<SbxObject*>( pObjVar.get() ); 4181 if( !pObj ) 4182 { 4183 SbxBase* pObjVarObj = pObjVar->GetObject(); 4184 pObj = dynamic_cast<SbxObject*>( pObjVarObj ); 4185 } 4186 4187 // #56368 save reference at StepElem, otherwise objects could 4188 // lose their reference too early in qualification chains like 4189 // ActiveComponent.Selection(0).Text 4190 // #74254 now per list 4191 if( pObj ) 4192 { 4193 aRefSaved.emplace_back(pObj ); 4194 } 4195 PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) ); 4196 } 4197 4198 /** Loading of a parameter (+offset+type) 4199 If the data type is wrong, create a copy and search for optionals including 4200 the default value. The data type SbxEMPTY shows that no parameters are given. 4201 Get( 0 ) may be EMPTY 4202 4203 @param nOp1 4204 the index of the current parameter being processed, 4205 where the entry of the index 0 is for the return value. 4206 4207 @param nOp2 4208 the data type of the parameter. 4209 */ 4210 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4211 { 4212 sal_uInt16 nIdx = static_cast<sal_uInt16>( nOp1 & 0x7FFF ); 4213 SbxDataType eType = static_cast<SbxDataType>(nOp2); 4214 SbxVariable* pVar; 4215 4216 // #57915 solve missing in a cleaner way 4217 sal_uInt32 nParamCount = refParams->Count(); 4218 if( nIdx >= nParamCount ) 4219 { 4220 sal_uInt16 iLoop = nIdx; 4221 while( iLoop >= nParamCount ) 4222 { 4223 pVar = new SbxVariable(); 4224 pVar->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) 4225 // tdf#79426, tdf#125180 - add additional information about a missing parameter 4226 SetIsMissing( pVar ); 4227 refParams->Put(pVar, iLoop); 4228 iLoop--; 4229 } 4230 } 4231 pVar = refParams->Get(nIdx); 4232 4233 // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing 4234 if( pVar->GetType() == SbxERROR && IsMissing( pVar, 1 ) && nIdx ) 4235 { 4236 // if there's a parameter missing, it can be OPTIONAL 4237 bool bOpt = false; 4238 if( pMeth ) 4239 { 4240 SbxInfo* pInfo = pMeth->GetInfo(); 4241 if ( pInfo ) 4242 { 4243 const SbxParamInfo* pParam = pInfo->GetParam( nIdx ); 4244 if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) ) 4245 { 4246 // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors 4247 pVar->ResetFlag( SbxFlagBits::Fixed ); 4248 // Default value? 4249 sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff); 4250 if( nDefaultId > 0 ) 4251 { 4252 // tdf#143707 - check if the data type character was added after the string 4253 // termination symbol, and convert the variable if it was present. The 4254 // data type character was added in basic/source/comp/symtbl.cxx. 4255 SbxDataType eTypeStr; 4256 OUString aDefaultStr = pImg->GetString( nDefaultId, &eTypeStr ); 4257 pVar = new SbxVariable(pParam-> eType); 4258 pVar->PutString( aDefaultStr ); 4259 if (eTypeStr != SbxSTRING) 4260 pVar->Convert(eTypeStr); 4261 refParams->Put(pVar, nIdx); 4262 } 4263 else if ( SbiRuntime::isVBAEnabled() && eType != SbxVARIANT ) 4264 { 4265 // tdf#36737 - initialize the parameter with the default value of its type 4266 pVar = new SbxVariable( pParam->eType ); 4267 refParams->Put(pVar, nIdx); 4268 } 4269 bOpt = true; 4270 } 4271 } 4272 } 4273 if( !bOpt ) 4274 { 4275 Error( ERRCODE_BASIC_NOT_OPTIONAL ); 4276 } 4277 } 4278 else if( eType != SbxVARIANT && static_cast<SbxDataType>(pVar->GetType() & 0x0FFF ) != eType ) 4279 { 4280 // tdf#43003 - convert parameter to the requested type 4281 pVar->Convert(eType); 4282 } 4283 SetupArgs( pVar, nOp1 ); 4284 PushVar( CheckArray( pVar ) ); 4285 } 4286 4287 // Case-Test (+True-Target+Test-Opcode) 4288 4289 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4290 { 4291 if (!refCaseStk.is() || !refCaseStk->Count()) 4292 { 4293 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); 4294 } 4295 else 4296 { 4297 SbxVariableRef xComp = PopVar(); 4298 SbxVariableRef xCase = refCaseStk->Get(refCaseStk->Count() - 1); 4299 if( xCase->Compare( static_cast<SbxOperator>(nOp2), *xComp ) ) 4300 { 4301 StepJUMP( nOp1 ); 4302 } 4303 } 4304 } 4305 4306 // call of a DLL-procedure (+StringID+type) 4307 // the StringID's MSB shows that Argv is occupied 4308 4309 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4310 { 4311 OUString aName = pImg->GetString( nOp1 & 0x7FFF ); 4312 SbxArray* pArgs = nullptr; 4313 if( nOp1 & 0x8000 ) 4314 { 4315 pArgs = refArgv.get(); 4316 } 4317 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), false ); 4318 aLibName.clear(); 4319 if( nOp1 & 0x8000 ) 4320 { 4321 PopArgv(); 4322 } 4323 } 4324 4325 // call of a DLL-procedure after CDecl (+StringID+type) 4326 4327 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4328 { 4329 OUString aName = pImg->GetString( nOp1 & 0x7FFF ); 4330 SbxArray* pArgs = nullptr; 4331 if( nOp1 & 0x8000 ) 4332 { 4333 pArgs = refArgv.get(); 4334 } 4335 DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), true ); 4336 aLibName.clear(); 4337 if( nOp1 & 0x8000 ) 4338 { 4339 PopArgv(); 4340 } 4341 } 4342 4343 4344 // beginning of a statement (+Line+Col) 4345 4346 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4347 { 4348 // If the Expr-Stack at the beginning of a statement contains a variable, 4349 // some fool has called X as a function, although it's a variable! 4350 bool bFatalExpr = false; 4351 OUString sUnknownMethodName; 4352 if( nExprLvl > 1 ) 4353 { 4354 bFatalExpr = true; 4355 } 4356 else if( nExprLvl ) 4357 { 4358 SbxVariable* p = refExprStk->Get(0); 4359 if( p->GetRefCount() > 1 && 4360 refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) ) 4361 { 4362 sUnknownMethodName = p->GetName(); 4363 bFatalExpr = true; 4364 } 4365 } 4366 4367 ClearExprStack(); 4368 4369 aRefSaved.clear(); 4370 4371 // We have to cancel hard here because line and column 4372 // would be wrong later otherwise! 4373 if( bFatalExpr) 4374 { 4375 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName ); 4376 return; 4377 } 4378 pStmnt = pCode - 9; 4379 sal_uInt16 nOld = nLine; 4380 nLine = static_cast<short>( nOp1 ); 4381 4382 // #29955 & 0xFF, to filter out for-loop-level 4383 nCol1 = static_cast<short>( nOp2 & 0xFF ); 4384 4385 // find the next STMNT-command to set the final column 4386 // of this statement 4387 4388 nCol2 = 0xffff; 4389 sal_uInt16 n1, n2; 4390 const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 ); 4391 if( p ) 4392 { 4393 if( n1 == nOp1 ) 4394 { 4395 // #29955 & 0xFF, to filter out for-loop-level 4396 nCol2 = (n2 & 0xFF) - 1; 4397 } 4398 } 4399 4400 // #29955 correct for-loop-level, #67452 NOT in the error-handler 4401 if( !bInError ) 4402 { 4403 // (there's a difference here in case of a jump out of a loop) 4404 sal_uInt16 nExpectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 ); 4405 if( !pGosubStk.empty() ) 4406 { 4407 nExpectedForLevel = nExpectedForLevel + pGosubStk.back().nStartForLvl; 4408 } 4409 4410 // if the actual for-level is too small it'd jump out 4411 // of a loop -> corrected 4412 while( nForLvl > nExpectedForLevel ) 4413 { 4414 PopFor(); 4415 } 4416 } 4417 4418 // 16.10.96: #31460 new concept for StepInto/Over/Out 4419 // see explanation at _ImplGetBreakCallLevel 4420 if( pInst->nCallLvl <= pInst->nBreakCallLvl ) 4421 { 4422 StarBASIC* pStepBasic = GetCurrentBasic( &rBasic ); 4423 BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 ); 4424 4425 pInst->CalcBreakCallLevel( nNewFlags ); 4426 } 4427 4428 // break points only at STMNT-commands in a new line! 4429 else if( ( nOp1 != nOld ) 4430 && ( nFlags & BasicDebugFlags::Break ) 4431 && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) ) 4432 { 4433 StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic ); 4434 BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 ); 4435 4436 pInst->CalcBreakCallLevel( nNewFlags ); 4437 } 4438 } 4439 4440 // (+StreamMode+Flags) 4441 // Stack: block length 4442 // channel number 4443 // file name 4444 4445 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4446 { 4447 SbxVariableRef pName = PopVar(); 4448 SbxVariableRef pChan = PopVar(); 4449 SbxVariableRef pLen = PopVar(); 4450 short nBlkLen = pLen->GetInteger(); 4451 short nChan = pChan->GetInteger(); 4452 OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding())); 4453 pIosys->Open( nChan, aName, static_cast<StreamMode>( nOp1 ), 4454 static_cast<SbiStreamFlags>( nOp2 ), nBlkLen ); 4455 Error( pIosys->GetError() ); 4456 } 4457 4458 // create object (+StringID+StringID) 4459 4460 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4461 { 4462 OUString aClass( pImg->GetString( nOp2 ) ); 4463 SbxObjectRef pObj = SbxBase::CreateObject( aClass ); 4464 if( !pObj ) 4465 { 4466 Error( ERRCODE_BASIC_INVALID_OBJECT ); 4467 } 4468 else 4469 { 4470 OUString aName( pImg->GetString( nOp1 ) ); 4471 pObj->SetName( aName ); 4472 // the object must be able to call the BASIC 4473 pObj->SetParent( &rBasic ); 4474 SbxVariableRef pNew = new SbxVariable; 4475 pNew->PutObject( pObj.get() ); 4476 PushVar( pNew.get() ); 4477 } 4478 } 4479 4480 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4481 { 4482 StepDCREATE_IMPL( nOp1, nOp2 ); 4483 } 4484 4485 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4486 { 4487 StepDCREATE_IMPL( nOp1, nOp2 ); 4488 } 4489 4490 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create 4491 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4492 { 4493 SbxVariableRef refVar = PopVar(); 4494 4495 DimImpl( refVar ); 4496 4497 // fill the array with instances of the requested class 4498 SbxBase* pObj = refVar->GetObject(); 4499 if (!pObj) 4500 { 4501 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT ); 4502 return; 4503 } 4504 4505 SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj); 4506 if (!pArray) 4507 return; 4508 4509 const sal_Int32 nDims = pArray->GetDims(); 4510 sal_Int32 nTotalSize = nDims > 0 ? 1 : 0; 4511 4512 // must be a one-dimensional array 4513 sal_Int32 nLower, nUpper; 4514 for( sal_Int32 i = 0 ; i < nDims ; ++i ) 4515 { 4516 pArray->GetDim(i + 1, nLower, nUpper); 4517 const sal_Int32 nSize = nUpper - nLower + 1; 4518 nTotalSize *= nSize; 4519 } 4520 4521 // Optimization: pre-allocate underlying container 4522 if (nTotalSize > 0) 4523 pArray->SbxArray::GetRef(nTotalSize - 1); 4524 4525 // First, fill those parts of the array that are preserved 4526 bool bWasError = false; 4527 const bool bRestored = implRestorePreservedArray(pArray, refRedimpArray, &bWasError); 4528 if (bWasError) 4529 nTotalSize = 0; // on error, don't create objects 4530 4531 // create objects and insert them into the array 4532 OUString aClass( pImg->GetString( nOp2 ) ); 4533 OUString aName; 4534 for( sal_Int32 i = 0 ; i < nTotalSize ; ++i ) 4535 { 4536 if (!bRestored || !pArray->SbxArray::GetRef(i)) // For those left unset after preserve 4537 { 4538 SbxObjectRef pClassObj = SbxBase::CreateObject(aClass); 4539 if (!pClassObj) 4540 { 4541 Error(ERRCODE_BASIC_INVALID_OBJECT); 4542 break; 4543 } 4544 else 4545 { 4546 if (aName.isEmpty()) 4547 aName = pImg->GetString(nOp1); 4548 pClassObj->SetName(aName); 4549 // the object must be able to call the basic 4550 pClassObj->SetParent(&rBasic); 4551 pArray->SbxArray::Put(pClassObj.get(), i); 4552 } 4553 } 4554 } 4555 } 4556 4557 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4558 { 4559 OUString aName( pImg->GetString( nOp1 ) ); 4560 OUString aClass( pImg->GetString( nOp2 ) ); 4561 4562 SbxObjectRef pCopyObj = createUserTypeImpl( aClass ); 4563 if( pCopyObj ) 4564 { 4565 pCopyObj->SetName( aName ); 4566 } 4567 SbxVariableRef pNew = new SbxVariable; 4568 pNew->PutObject( pCopyObj.get() ); 4569 pNew->SetDeclareClassName( aClass ); 4570 PushVar( pNew.get() ); 4571 } 4572 4573 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 ) 4574 { 4575 bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0); 4576 if( bWithEvents ) 4577 { 4578 pVar->SetFlag( SbxFlagBits::WithEvents ); 4579 } 4580 bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0); 4581 if( bDimAsNew ) 4582 { 4583 pVar->SetFlag( SbxFlagBits::DimAsNew ); 4584 } 4585 bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0); 4586 if( bFixedString ) 4587 { 4588 sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000 4589 OUStringBuffer aBuf(nCount); 4590 comphelper::string::padToLength(aBuf, nCount); 4591 pVar->PutString(aBuf.makeStringAndClear()); 4592 } 4593 4594 bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0); 4595 if( bVarToDim ) 4596 { 4597 pVar->SetFlag( SbxFlagBits::VarToDim ); 4598 } 4599 } 4600 4601 // establishing a local variable (+StringID+type) 4602 4603 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4604 { 4605 if( !refLocals.is() ) 4606 { 4607 refLocals = new SbxArray; 4608 } 4609 OUString aName( pImg->GetString( nOp1 ) ); 4610 if( refLocals->Find( aName, SbxClassType::DontCare ) == nullptr ) 4611 { 4612 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4613 SbxVariable* p = new SbxVariable( t ); 4614 p->SetName( aName ); 4615 implHandleSbxFlags( p, t, nOp2 ); 4616 refLocals->Put(p, refLocals->Count()); 4617 } 4618 } 4619 4620 // establishing a module-global variable (+StringID+type) 4621 4622 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule ) 4623 { 4624 OUString aName( pImg->GetString( nOp1 ) ); 4625 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4626 bool bFlag = pMod->IsSet( SbxFlagBits::NoModify ); 4627 pMod->SetFlag( SbxFlagBits::NoModify ); 4628 SbxVariableRef p = pMod->Find( aName, SbxClassType::Property ); 4629 if( p.is() ) 4630 { 4631 pMod->Remove (p.get()); 4632 } 4633 SbProperty* pProp = pMod->GetProperty( aName, t ); 4634 if( !bUsedForClassModule ) 4635 { 4636 pProp->SetFlag( SbxFlagBits::Private ); 4637 } 4638 if( !bFlag ) 4639 { 4640 pMod->ResetFlag( SbxFlagBits::NoModify ); 4641 } 4642 if( pProp ) 4643 { 4644 pProp->SetFlag( SbxFlagBits::DontStore ); 4645 // from 2.7.1996: HACK because of 'reference can't be saved' 4646 pProp->SetFlag( SbxFlagBits::NoModify); 4647 4648 implHandleSbxFlags( pProp, t, nOp2 ); 4649 } 4650 } 4651 4652 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4653 { 4654 StepPUBLIC_Impl( nOp1, nOp2, false ); 4655 } 4656 4657 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4658 { 4659 // Creates module variable that isn't reinitialised when 4660 // between invocations ( for VBASupport & document basic only ) 4661 if( pMod->pImage->bFirstInit ) 4662 { 4663 bool bUsedForClassModule = pImg->IsFlag( SbiImageFlags::CLASSMODULE ); 4664 StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule ); 4665 } 4666 } 4667 4668 // establishing a global variable (+StringID+type) 4669 4670 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4671 { 4672 if( pImg->IsFlag( SbiImageFlags::CLASSMODULE ) ) 4673 { 4674 StepPUBLIC_Impl( nOp1, nOp2, true ); 4675 } 4676 OUString aName( pImg->GetString( nOp1 ) ); 4677 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4678 4679 // Store module scope variables at module scope 4680 // in non vba mode these are stored at the library level :/ 4681 // not sure if this really should not be enabled for ALL basic 4682 SbxObject* pStorage = &rBasic; 4683 if ( SbiRuntime::isVBAEnabled() ) 4684 { 4685 pStorage = pMod; 4686 pMod->AddVarName( aName ); 4687 } 4688 4689 bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify ); 4690 rBasic.SetFlag( SbxFlagBits::NoModify ); 4691 SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property ); 4692 if( p.is() ) 4693 { 4694 pStorage->Remove (p.get()); 4695 } 4696 p = pStorage->Make( aName, SbxClassType::Property, t ); 4697 if( !bFlag ) 4698 { 4699 pStorage->ResetFlag( SbxFlagBits::NoModify ); 4700 } 4701 if( p.is() ) 4702 { 4703 p->SetFlag( SbxFlagBits::DontStore ); 4704 // from 2.7.1996: HACK because of 'reference can't be saved' 4705 p->SetFlag( SbxFlagBits::NoModify); 4706 } 4707 } 4708 4709 4710 // Creates global variable that isn't reinitialised when 4711 // basic is restarted, P=PERSIST (+StringID+Typ) 4712 4713 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4714 { 4715 if( pMod->pImage->bFirstInit ) 4716 { 4717 StepGLOBAL( nOp1, nOp2 ); 4718 } 4719 } 4720 4721 4722 // Searches for global variable, behavior depends on the fact 4723 // if the variable is initialised for the first time 4724 4725 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4726 { 4727 if( pMod->pImage->bFirstInit ) 4728 { 4729 // Behave like always during first init 4730 StepFIND( nOp1, nOp2 ); 4731 } 4732 else 4733 { 4734 // Return dummy variable 4735 SbxDataType t = static_cast<SbxDataType>(nOp2); 4736 OUString aName( pImg->GetString( nOp1 & 0x7FFF ) ); 4737 4738 SbxVariable* pDummyVar = new SbxVariable( t ); 4739 pDummyVar->SetName( aName ); 4740 PushVar( pDummyVar ); 4741 } 4742 } 4743 4744 4745 SbxVariable* SbiRuntime::StepSTATIC_Impl( 4746 OUString const & aName, SbxDataType t, sal_uInt32 nOp2 ) 4747 { 4748 SbxVariable* p = nullptr; 4749 if ( pMeth ) 4750 { 4751 SbxArray* pStatics = pMeth->GetStatics(); 4752 if( pStatics && ( pStatics->Find( aName, SbxClassType::DontCare ) == nullptr ) ) 4753 { 4754 p = new SbxVariable( t ); 4755 if( t != SbxVARIANT ) 4756 { 4757 p->SetFlag( SbxFlagBits::Fixed ); 4758 } 4759 p->SetName( aName ); 4760 implHandleSbxFlags( p, t, nOp2 ); 4761 pStatics->Put(p, pStatics->Count()); 4762 } 4763 } 4764 return p; 4765 } 4766 // establishing a static variable (+StringID+type) 4767 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 4768 { 4769 OUString aName( pImg->GetString( nOp1 ) ); 4770 SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff); 4771 StepSTATIC_Impl( aName, t, nOp2 ); 4772 } 4773 4774 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */ 4775
