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