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