1 /************************************************************** 2 * 3 * Licensed to the Apache Software Foundation (ASF) under one 4 * or more contributor license agreements. See the NOTICE file 5 * distributed with this work for additional information 6 * regarding copyright ownership. The ASF licenses this file 7 * to you under the Apache License, Version 2.0 (the 8 * "License"); you may not use this file except in compliance 9 * with the License. You may obtain a copy of the License at 10 * 11 * http://www.apache.org/licenses/LICENSE-2.0 12 * 13 * Unless required by applicable law or agreed to in writing, 14 * software distributed under the License is distributed on an 15 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16 * KIND, either express or implied. See the License for the 17 * specific language governing permissions and limitations 18 * under the License. 19 * 20 *************************************************************/ 21 22 23 24 // MARKER(update_precomp.py): autogen include statement, do not remove 25 #include "precompiled_basic.hxx" 26 27 #include "runtime.hxx" 28 #ifndef GCC 29 #endif 30 #include "iosys.hxx" 31 #include "image.hxx" 32 #include "sbintern.hxx" 33 #include "sbunoobj.hxx" 34 #include "opcodes.hxx" 35 36 #include <com/sun/star/container/XIndexAccess.hpp> 37 #include <com/sun/star/script/XDefaultMethod.hpp> 38 #include <com/sun/star/beans/XPropertySet.hpp> 39 #include <com/sun/star/uno/Any.hxx> 40 #include <comphelper/processfactory.hxx> 41 42 using namespace com::sun::star::uno; 43 using namespace com::sun::star::container; 44 using namespace com::sun::star::lang; 45 using namespace com::sun::star::beans; 46 using namespace com::sun::star::script; 47 48 using com::sun::star::uno::Reference; 49 50 SbxVariable* getVBAConstant( const String& rName ); 51 52 // Suchen eines Elements 53 // Die Bits im String-ID: 54 // 0x8000 - Argv ist belegt 55 56 SbxVariable* SbiRuntime::FindElement 57 ( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, SbError nNotFound, sal_Bool bLocal, sal_Bool bStatic ) 58 { 59 bool bIsVBAInterOp = SbiRuntime::isVBAEnabled(); 60 if( bIsVBAInterOp ) 61 { 62 StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib; 63 if( pMSOMacroRuntimeLib != NULL ) 64 pMSOMacroRuntimeLib->ResetFlag( SBX_EXTSEARCH ); 65 } 66 67 SbxVariable* pElem = NULL; 68 if( !pObj ) 69 { 70 Error( SbERR_NO_OBJECT ); 71 pElem = new SbxVariable; 72 } 73 else 74 { 75 sal_Bool bFatalError = sal_False; 76 SbxDataType t = (SbxDataType) nOp2; 77 String aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) ); 78 // Hacky capture of Evaluate [] syntax 79 // this should be tackled I feel at the pcode level 80 if ( bIsVBAInterOp && aName.Search('[') == 0 ) 81 { 82 // emulate pcode here 83 StepARGC(); 84 // psuedo StepLOADSC 85 String sArg = aName.Copy( 1, aName.Len() - 2 ); 86 SbxVariable* p = new SbxVariable; 87 p->PutString( sArg ); 88 PushVar( p ); 89 // 90 StepARGV(); 91 nOp1 = nOp1 | 0x8000; // indicate params are present 92 aName = String::CreateFromAscii("Evaluate"); 93 } 94 if( bLocal ) 95 { 96 if ( bStatic ) 97 { 98 if ( pMeth ) 99 pElem = pMeth->GetStatics()->Find( aName, SbxCLASS_DONTCARE ); 100 } 101 102 if ( !pElem ) 103 pElem = refLocals->Find( aName, SbxCLASS_DONTCARE ); 104 } 105 if( !pElem ) 106 { 107 // Die RTL brauchen wir nicht mehr zu durchsuchen! 108 sal_Bool bSave = rBasic.bNoRtl; 109 rBasic.bNoRtl = sal_True; 110 pElem = pObj->Find( aName, SbxCLASS_DONTCARE ); 111 112 // #110004, #112015: Make private really private 113 if( bLocal && pElem ) // Local as flag for global search 114 { 115 if( pElem->IsSet( SBX_PRIVATE ) ) 116 { 117 SbiInstance* pInst_ = pINST; 118 if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() ) 119 pElem = NULL; // Found but in wrong module! 120 121 // Interfaces: Use SBX_EXTFOUND 122 } 123 } 124 rBasic.bNoRtl = bSave; 125 126 // Ist es ein globaler Uno-Bezeichner? 127 if( bLocal && !pElem ) 128 { 129 bool bSetName = true; // preserve normal behaviour 130 131 // i#i68894# if VBAInterOp favour searching vba globals 132 // over searching for uno classess 133 if ( bVBAEnabled ) 134 { 135 // Try Find in VBA symbols space 136 pElem = rBasic.VBAFind( aName, SbxCLASS_DONTCARE ); 137 if ( pElem ) 138 bSetName = false; // don't overwrite uno name 139 else 140 pElem = getVBAConstant( aName ); 141 } 142 143 if( !pElem ) 144 { 145 // #72382 VORSICHT! Liefert jetzt wegen unbekannten 146 // Modulen IMMER ein Ergebnis! 147 SbUnoClass* pUnoClass = findUnoClass( aName ); 148 if( pUnoClass ) 149 { 150 pElem = new SbxVariable( t ); 151 SbxValues aRes( SbxOBJECT ); 152 aRes.pObj = pUnoClass; 153 pElem->SbxVariable::Put( aRes ); 154 } 155 } 156 157 // #62939 Wenn eine Uno-Klasse gefunden wurde, muss 158 // das Wrapper-Objekt gehalten werden, da sonst auch 159 // die Uno-Klasse, z.B. "stardiv" immer wieder neu 160 // aus der Registry gelesen werden muss 161 if( pElem ) 162 { 163 // #63774 Darf nicht mit gespeichert werden!!! 164 pElem->SetFlag( SBX_DONTSTORE ); 165 pElem->SetFlag( SBX_NO_MODIFY); 166 167 // #72382 Lokal speichern, sonst werden alle implizit 168 // deklarierten Vars automatisch global ! 169 if ( bSetName ) 170 pElem->SetName( aName ); 171 refLocals->Put( pElem, refLocals->Count() ); 172 } 173 } 174 175 if( !pElem ) 176 { 177 // Nicht da und nicht im Objekt? 178 // Hat das Ding Parameter, nicht einrichten! 179 if( nOp1 & 0x8000 ) 180 bFatalError = sal_True; 181 // ALT: StarBASIC::FatalError( nNotFound ); 182 183 // Sonst, falls keine Parameter sind, anderen Error Code verwenden 184 if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) ) 185 { 186 // #39108 Bei explizit und als ELEM immer ein Fatal Error 187 bFatalError = sal_True; 188 189 // Falls keine Parameter sind, anderen Error Code verwenden 190 if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED ) 191 nNotFound = SbERR_VAR_UNDEFINED; 192 } 193 if( bFatalError ) 194 { 195 // #39108 Statt FatalError zu setzen, Dummy-Variable liefern 196 if( !xDummyVar.Is() ) 197 xDummyVar = new SbxVariable( SbxVARIANT ); 198 pElem = xDummyVar; 199 200 // Parameter von Hand loeschen 201 ClearArgvStack(); 202 203 // Normalen Error setzen 204 Error( nNotFound, aName ); 205 } 206 else 207 { 208 if ( bStatic ) 209 pElem = StepSTATIC_Impl( aName, t ); 210 if ( !pElem ) 211 { 212 // Sonst Variable neu anlegen 213 pElem = new SbxVariable( t ); 214 if( t != SbxVARIANT ) 215 pElem->SetFlag( SBX_FIXED ); 216 pElem->SetName( aName ); 217 refLocals->Put( pElem, refLocals->Count() ); 218 } 219 } 220 } 221 } 222 // #39108 Args koennen schon geloescht sein! 223 if( !bFatalError ) 224 SetupArgs( pElem, nOp1 ); 225 // Ein bestimmter Call-Type wurde gewuenscht, daher muessen 226 // wir hier den Typ setzen und das Ding anfassen, um den 227 // korrekten Returnwert zu erhalten! 228 if( pElem->IsA( TYPE(SbxMethod) ) ) 229 { 230 // Soll der Typ konvertiert werden? 231 SbxDataType t2 = pElem->GetType(); 232 sal_Bool bSet = sal_False; 233 if( !( pElem->GetFlags() & SBX_FIXED ) ) 234 { 235 if( t != SbxVARIANT && t != t2 && 236 t >= SbxINTEGER && t <= SbxSTRING ) 237 pElem->SetType( t ), bSet = sal_True; 238 } 239 // pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen 240 SbxVariableRef refTemp = pElem; 241 242 // Moegliche Reste vom letzten Aufruf der SbxMethod beseitigen 243 // Vorher Schreiben freigeben, damit kein Error gesetzt wird. 244 sal_uInt16 nSavFlags = pElem->GetFlags(); 245 pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST ); 246 pElem->SbxValue::Clear(); 247 pElem->SetFlags( nSavFlags ); 248 249 // Erst nach dem Setzen anfassen, da z.B. LEFT() 250 // den Unterschied zwischen Left$() und Left() kennen muss 251 252 // AB 12.8.96: Da in PopVar() die Parameter von Methoden weggehauen 253 // werden, muessen wir hier explizit eine neue SbxMethod anlegen 254 SbxVariable* pNew = new SbxMethod( *((SbxMethod*)pElem) ); // das ist der Call! 255 //ALT: SbxVariable* pNew = new SbxVariable( *pElem ); // das ist der Call! 256 257 pElem->SetParameters(0); // sonst bleibt Ref auf sich selbst 258 pNew->SetFlag( SBX_READWRITE ); 259 260 // den Datentypen zuruecksetzen? 261 if( bSet ) 262 pElem->SetType( t2 ); 263 pElem = pNew; 264 } 265 // Index-Access bei UnoObjekten beruecksichtigen 266 // definitely we want this for VBA where properties are often 267 // collections ( which need index access ), but lets only do 268 // this if we actually have params following 269 else if( bVBAEnabled && pElem->ISA(SbUnoProperty) && pElem->GetParameters() ) 270 { 271 // pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen 272 SbxVariableRef refTemp = pElem; 273 274 // Variable kopieren und dabei den Notify aufloesen 275 SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) ); // das ist der Call! 276 pElem->SetParameters( NULL ); // sonst bleibt Ref auf sich selbst 277 pElem = pNew; 278 } 279 } 280 return CheckArray( pElem ); 281 } 282 283 // Find-Funktion ueber Name fuer aktuellen Scope (z.B. Abfrage aus BASIC-IDE) 284 SbxBase* SbiRuntime::FindElementExtern( const String& rName ) 285 { 286 // Hinweis zu #35281#: Es darf nicht davon ausgegangen werden, dass 287 // pMeth != null, da im RunInit noch keine gesetzt ist. 288 289 SbxVariable* pElem = NULL; 290 if( !pMod || !rName.Len() ) 291 return NULL; 292 293 // Lokal suchen 294 if( refLocals ) 295 pElem = refLocals->Find( rName, SbxCLASS_DONTCARE ); 296 297 // In Statics suchen 298 if ( !pElem && pMeth ) 299 { 300 // Bei Statics, Name der Methode davor setzen 301 String aMethName = pMeth->GetName(); 302 aMethName += ':'; 303 aMethName += rName; 304 pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE); 305 } 306 307 // In Parameter-Liste suchen 308 if( !pElem && pMeth ) 309 { 310 SbxInfo* pInfo = pMeth->GetInfo(); 311 if( pInfo && refParams ) 312 { 313 sal_uInt16 nParamCount = refParams->Count(); 314 sal_uInt16 j = 1; 315 const SbxParamInfo* pParam = pInfo->GetParam( j ); 316 while( pParam ) 317 { 318 if( pParam->aName.EqualsIgnoreCaseAscii( rName ) ) 319 { 320 if( j >= nParamCount ) 321 { 322 // Parameter is missing 323 pElem = new SbxVariable( SbxSTRING ); 324 pElem->PutString( String( RTL_CONSTASCII_USTRINGPARAM("<missing parameter>" ) ) ); 325 } 326 else 327 { 328 pElem = refParams->Get( j ); 329 } 330 break; 331 } 332 pParam = pInfo->GetParam( ++j ); 333 } 334 } 335 } 336 337 // Im Modul suchen 338 if( !pElem ) 339 { 340 // RTL nicht durchsuchen! 341 sal_Bool bSave = rBasic.bNoRtl; 342 rBasic.bNoRtl = sal_True; 343 pElem = pMod->Find( rName, SbxCLASS_DONTCARE ); 344 rBasic.bNoRtl = bSave; 345 } 346 return pElem; 347 } 348 349 350 // Argumente eines Elements setzen 351 // Dabei auch die Argumente umsetzen, falls benannte Parameter 352 // verwendet wurden 353 354 void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 ) 355 { 356 if( nOp1 & 0x8000 ) 357 { 358 if( !refArgv ) 359 StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); 360 sal_Bool bHasNamed = sal_False; 361 sal_uInt16 i; 362 sal_uInt16 nArgCount = refArgv->Count(); 363 for( i = 1 ; i < nArgCount ; i++ ) 364 { 365 if( refArgv->GetAlias( i ).Len() ) 366 { 367 bHasNamed = sal_True; break; 368 } 369 } 370 if( bHasNamed ) 371 { 372 // Wir haben mindestens einen benannten Parameter! 373 // Wir muessen also umsortieren 374 // Gibt es Parameter-Infos? 375 SbxInfo* pInfo = p->GetInfo(); 376 if( !pInfo ) 377 { 378 bool bError_ = true; 379 380 SbUnoMethod* pUnoMethod = PTR_CAST(SbUnoMethod,p); 381 SbUnoProperty* pUnoProperty = PTR_CAST(SbUnoProperty,p); 382 if( pUnoMethod || pUnoProperty ) 383 { 384 SbUnoObject* pParentUnoObj = PTR_CAST( SbUnoObject,p->GetParent() ); 385 if( pParentUnoObj ) 386 { 387 Any aUnoAny = pParentUnoObj->getUnoAny(); 388 Reference< XInvocation > xInvocation; 389 aUnoAny >>= xInvocation; 390 if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() ) 391 { 392 bError_ = false; 393 394 sal_uInt16 nCurPar = 1; 395 AutomationNamedArgsSbxArray* pArg = 396 new AutomationNamedArgsSbxArray( nArgCount ); 397 ::rtl::OUString* pNames = pArg->getNames().getArray(); 398 for( i = 1 ; i < nArgCount ; i++ ) 399 { 400 SbxVariable* pVar = refArgv->Get( i ); 401 const String& rName = refArgv->GetAlias( i ); 402 if( rName.Len() ) 403 pNames[i] = rName; 404 pArg->Put( pVar, nCurPar++ ); 405 } 406 refArgv = pArg; 407 } 408 } 409 } 410 else if( bVBAEnabled && p->GetType() == SbxOBJECT && (!p->ISA(SbxMethod) || !p->IsBroadcaster()) ) 411 { 412 // Check for default method with named parameters 413 SbxBaseRef pObj = (SbxBase*)p->GetObject(); 414 if( pObj && pObj->ISA(SbUnoObject) ) 415 { 416 SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj; 417 Any aAny = pUnoObj->getUnoAny(); 418 419 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 420 { 421 Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue(); 422 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY ); 423 424 rtl::OUString sDefaultMethod; 425 if ( xDfltMethod.is() ) 426 sDefaultMethod = xDfltMethod->getDefaultMethodName(); 427 if ( !sDefaultMethod.isEmpty() ) 428 { 429 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD ); 430 if( meth != NULL ) 431 pInfo = meth->GetInfo(); 432 if( pInfo ) 433 bError_ = false; 434 } 435 } 436 } 437 } 438 if( bError_ ) 439 Error( SbERR_NO_NAMED_ARGS ); 440 } 441 else 442 { 443 sal_uInt16 nCurPar = 1; 444 SbxArray* pArg = new SbxArray; 445 for( i = 1 ; i < nArgCount ; i++ ) 446 { 447 SbxVariable* pVar = refArgv->Get( i ); 448 const String& rName = refArgv->GetAlias( i ); 449 if( rName.Len() ) 450 { 451 // nCurPar wird auf den gefundenen Parameter gesetzt 452 sal_uInt16 j = 1; 453 const SbxParamInfo* pParam = pInfo->GetParam( j ); 454 while( pParam ) 455 { 456 if( pParam->aName.EqualsIgnoreCaseAscii( rName ) ) 457 { 458 nCurPar = j; 459 break; 460 } 461 pParam = pInfo->GetParam( ++j ); 462 } 463 if( !pParam ) 464 { 465 Error( SbERR_NAMED_NOT_FOUND ); break; 466 } 467 } 468 pArg->Put( pVar, nCurPar++ ); 469 } 470 refArgv = pArg; 471 } 472 } 473 // Eigene Var als Parameter 0 474 refArgv->Put( p, 0 ); 475 p->SetParameters( refArgv ); 476 PopArgv(); 477 } 478 else 479 p->SetParameters( NULL ); 480 } 481 482 // Holen eines Array-Elements 483 484 SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem ) 485 { 486 // Falls wir ein Array haben, wollen wir bitte das Array-Element! 487 SbxArray* pPar; 488 if( pElem->GetType() & SbxARRAY ) 489 { 490 SbxBase* pElemObj = pElem->GetObject(); 491 SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj); 492 pPar = pElem->GetParameters(); 493 if( pDimArray ) 494 { 495 // Die Parameter koennen fehlen, wenn ein Array als 496 // Argument uebergeben wird. 497 if( pPar ) 498 pElem = pDimArray->Get( pPar ); 499 } 500 else 501 { 502 SbxArray* pArray = PTR_CAST(SbxArray,pElemObj); 503 if( pArray ) 504 { 505 if( !pPar ) 506 { 507 Error( SbERR_OUT_OF_RANGE ); 508 pElem = new SbxVariable; 509 } 510 else 511 pElem = pArray->Get( pPar->Get( 1 )->GetInteger() ); 512 } 513 } 514 515 // #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt 516 if( pPar ) 517 pPar->Put( NULL, 0 ); 518 } 519 // Index-Access bei UnoObjekten beruecksichtigen 520 else if( pElem->GetType() == SbxOBJECT && (!pElem->ISA(SbxMethod) || (bVBAEnabled && !pElem->IsBroadcaster()) ) ) 521 { 522 pPar = pElem->GetParameters(); 523 if ( pPar ) 524 { 525 // Ist es ein Uno-Objekt? 526 SbxBaseRef pObj = (SbxBase*)pElem->GetObject(); 527 if( pObj ) 528 { 529 if( pObj->ISA(SbUnoObject) ) 530 { 531 SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj; 532 Any aAny = pUnoObj->getUnoAny(); 533 534 if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) 535 { 536 Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue(); 537 Reference< XIndexAccess > xIndexAccess( x, UNO_QUERY ); 538 if ( !bVBAEnabled ) 539 { 540 // Haben wir Index-Access? 541 if( xIndexAccess.is() ) 542 { 543 sal_uInt32 nParamCount = (sal_uInt32)pPar->Count() - 1; 544 if( nParamCount != 1 ) 545 { 546 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 547 return pElem; 548 } 549 550 // Index holen 551 sal_Int32 nIndex = pPar->Get( 1 )->GetLong(); 552 Reference< XInterface > xRet; 553 try 554 { 555 Any aAny2 = xIndexAccess->getByIndex( nIndex ); 556 TypeClass eType = aAny2.getValueType().getTypeClass(); 557 if( eType == TypeClass_INTERFACE ) 558 xRet = *(Reference< XInterface >*)aAny2.getValue(); 559 } 560 catch (IndexOutOfBoundsException&) 561 { 562 // Bei Exception erstmal immer von Konvertierungs-Problem ausgehen 563 StarBASIC::Error( SbERR_OUT_OF_RANGE ); 564 } 565 566 // #57847 Immer neue Variable anlegen, sonst Fehler 567 // durch PutObject(NULL) bei ReadOnly-Properties. 568 pElem = new SbxVariable( SbxVARIANT ); 569 if( xRet.is() ) 570 { 571 aAny <<= xRet; 572 573 // #67173 Kein Namen angeben, damit echter Klassen-Namen eintragen wird 574 String aName; 575 SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny ); 576 pElem->PutObject( xWrapper ); 577 } 578 else 579 { 580 pElem->PutObject( NULL ); 581 } 582 } 583 } 584 else 585 { 586 rtl::OUString sDefaultMethod; 587 588 Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY ); 589 590 if ( xDfltMethod.is() ) 591 sDefaultMethod = xDfltMethod->getDefaultMethodName(); 592 else if( xIndexAccess.is() ) 593 sDefaultMethod = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "getByIndex" ) ); 594 595 if ( !sDefaultMethod.isEmpty() ) 596 { 597 SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxCLASS_METHOD ); 598 SbxVariableRef refTemp = meth; 599 if ( refTemp ) 600 { 601 meth->SetParameters( pPar ); 602 SbxVariable* pNew = new SbxMethod( *(SbxMethod*)meth ); 603 pElem = pNew; 604 } 605 } 606 } 607 } 608 609 // #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt 610 pPar->Put( NULL, 0 ); 611 } 612 else if( pObj->ISA(BasicCollection) ) 613 { 614 BasicCollection* pCol = (BasicCollection*)(SbxBase*)pObj; 615 pElem = new SbxVariable( SbxVARIANT ); 616 pPar->Put( pElem, 0 ); 617 pCol->CollItem( pPar ); 618 } 619 } 620 else if( bVBAEnabled ) // !pObj 621 { 622 SbxArray* pParam = pElem->GetParameters(); 623 if( pParam != NULL && !pElem->IsSet( SBX_VAR_TO_DIM ) ) 624 Error( SbERR_NO_OBJECT ); 625 } 626 } 627 } 628 629 return pElem; 630 } 631 632 // Laden eines Elements aus der Runtime-Library (+StringID+Typ) 633 634 void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 635 { 636 PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_False ) ); 637 } 638 639 void 640 SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, SbError nNotFound, sal_Bool bLocal, sal_Bool bStatic ) 641 { 642 if( !refLocals ) 643 refLocals = new SbxArray; 644 PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, bLocal, bStatic ) ); 645 } 646 // Laden einer lokalen/globalen Variablen (+StringID+Typ) 647 648 void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 649 { 650 StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True ); 651 } 652 653 // Search inside a class module (CM) to enable global search in time 654 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 655 { 656 657 SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pMod); 658 if( pClassModuleObject ) 659 pMod->SetFlag( SBX_GBLSEARCH ); 660 661 StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True ); 662 663 if( pClassModuleObject ) 664 pMod->ResetFlag( SBX_GBLSEARCH ); 665 } 666 667 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 668 { 669 StepFIND_Impl( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, sal_True, sal_True ); 670 } 671 672 // Laden eines Objekt-Elements (+StringID+Typ) 673 // Das Objekt liegt auf TOS 674 675 void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 676 { 677 // Liegt auf dem TOS ein Objekt? 678 SbxVariableRef pObjVar = PopVar(); 679 680 SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar); 681 if( !pObj ) 682 { 683 SbxBase* pObjVarObj = pObjVar->GetObject(); 684 pObj = PTR_CAST(SbxObject,pObjVarObj); 685 } 686 687 // #56368 Bei StepElem Referenz sichern, sonst koennen Objekte 688 // in Qualifizierungsketten wie ActiveComponent.Selection(0).Text 689 // zu fueh die Referenz verlieren 690 // #74254 Jetzt per Liste 691 if( pObj ) 692 SaveRef( (SbxVariable*)pObj ); 693 694 PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, sal_False ) ); 695 } 696 697 // Laden eines Parameters (+Offset+Typ) 698 // Wenn der Datentyp nicht stimmen sollte, eine Kopie anlegen 699 // Der Datentyp SbxEMPTY zeigt an, daa kein Parameter angegeben ist. 700 // Get( 0 ) darf EMPTY sein 701 702 void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 703 { 704 sal_uInt16 i = static_cast<sal_uInt16>( nOp1 & 0x7FFF ); 705 SbxDataType t = (SbxDataType) nOp2; 706 SbxVariable* p; 707 708 // #57915 Missing sauberer loesen 709 sal_uInt16 nParamCount = refParams->Count(); 710 if( i >= nParamCount ) 711 { 712 sal_Int16 iLoop = i; 713 while( iLoop >= nParamCount ) 714 { 715 p = new SbxVariable(); 716 717 if( SbiRuntime::isVBAEnabled() && 718 (t == SbxOBJECT || t == SbxSTRING) ) 719 { 720 if( t == SbxOBJECT ) 721 p->PutObject( NULL ); 722 else 723 p->PutString( String() ); 724 } 725 else 726 p->PutErr( 448 ); // Wie in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND) 727 728 refParams->Put( p, iLoop ); 729 iLoop--; 730 } 731 } 732 p = refParams->Get( i ); 733 734 if( p->GetType() == SbxERROR && ( i ) ) 735 //if( p->GetType() == SbxEMPTY && ( i ) ) 736 { 737 // Wenn ein Parameter fehlt, kann er OPTIONAL sein 738 sal_Bool bOpt = sal_False; 739 if( pMeth ) 740 { 741 SbxInfo* pInfo = pMeth->GetInfo(); 742 if ( pInfo ) 743 { 744 const SbxParamInfo* pParam = pInfo->GetParam( i ); 745 if( pParam && ( (pParam->nFlags & SBX_OPTIONAL) != 0 ) ) 746 { 747 // Default value? 748 sal_uInt16 nDefaultId = sal::static_int_cast< sal_uInt16 >( 749 pParam->nUserData & 0xffff ); 750 if( nDefaultId > 0 ) 751 { 752 String aDefaultStr = pImg->GetString( nDefaultId ); 753 p = new SbxVariable(); 754 p->PutString( aDefaultStr ); 755 refParams->Put( p, i ); 756 } 757 bOpt = sal_True; 758 } 759 } 760 } 761 if( bOpt == sal_False ) 762 Error( SbERR_NOT_OPTIONAL ); 763 } 764 else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t ) 765 { 766 SbxVariable* q = new SbxVariable( t ); 767 SaveRef( q ); 768 *q = *p; 769 p = q; 770 } 771 SetupArgs( p, nOp1 ); 772 PushVar( CheckArray( p ) ); 773 } 774 775 // Case-Test (+True-Target+Test-Opcode) 776 777 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 778 { 779 if( !refCaseStk || !refCaseStk->Count() ) 780 StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); 781 else 782 { 783 SbxVariableRef xComp = PopVar(); 784 SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 ); 785 if( xCase->Compare( (SbxOperator) nOp2, *xComp ) ) 786 StepJUMP( nOp1 ); 787 } 788 } 789 790 // Aufruf einer DLL-Prozedur (+StringID+Typ) 791 // Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist 792 793 void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 794 { 795 String aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ); 796 SbxArray* pArgs = NULL; 797 if( nOp1 & 0x8000 ) 798 pArgs = refArgv; 799 DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, sal_False ); 800 aLibName = String(); 801 if( nOp1 & 0x8000 ) 802 PopArgv(); 803 } 804 805 // Aufruf einer DLL-Prozedur nach CDecl (+StringID+Typ) 806 // Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist 807 808 void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 809 { 810 String aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ); 811 SbxArray* pArgs = NULL; 812 if( nOp1 & 0x8000 ) 813 pArgs = refArgv; 814 DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, sal_True ); 815 aLibName = String(); 816 if( nOp1 & 0x8000 ) 817 PopArgv(); 818 } 819 820 821 // Beginn eines Statements (+Line+Col) 822 823 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 824 { 825 // Wenn der Expr-Stack am Anfang einen Statements eine Variable enthaelt, 826 // hat ein Trottel X als Funktion aufgerufen, obwohl es eine Variable ist! 827 sal_Bool bFatalExpr = sal_False; 828 String sUnknownMethodName; 829 if( nExprLvl > 1 ) 830 bFatalExpr = sal_True; 831 else if( nExprLvl ) 832 { 833 SbxVariable* p = refExprStk->Get( 0 ); 834 if( p->GetRefCount() > 1 835 && refLocals.Is() && refLocals->Find( p->GetName(), p->GetClass() ) ) 836 { 837 sUnknownMethodName = p->GetName(); 838 bFatalExpr = sal_True; 839 } 840 } 841 // Der Expr-Stack ist nun nicht mehr notwendig 842 ClearExprStack(); 843 844 // #56368 Kuenstliche Referenz fuer StepElem wieder freigeben, 845 // damit sie nicht ueber ein Statement hinaus erhalten bleibt 846 //refSaveObj = NULL; 847 // #74254 Jetzt per Liste 848 ClearRefs(); 849 850 // Wir muessen hier hart abbrechen, da sonst Zeile und Spalte nicht mehr 851 // stimmen! 852 if( bFatalExpr) 853 { 854 StarBASIC::FatalError( SbERR_NO_METHOD, sUnknownMethodName ); 855 return; 856 } 857 pStmnt = pCode - 9; 858 sal_uInt16 nOld = nLine; 859 nLine = static_cast<short>( nOp1 ); 860 861 // #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern 862 nCol1 = static_cast<short>( nOp2 & 0xFF ); 863 864 // Suchen des naechsten STMNT-Befehls, 865 // um die End-Spalte dieses Statements zu setzen 866 // Searches of the next STMNT instruction, 867 // around the final column of this statement to set 868 869 nCol2 = 0xffff; 870 sal_uInt16 n1, n2; 871 const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 ); 872 if( p ) 873 { 874 if( n1 == nOp1 ) 875 { 876 // #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern 877 nCol2 = (n2 & 0xFF) - 1; 878 } 879 } 880 881 // #29955 for-Schleifen-Ebene korrigieren, #67452 NICHT im Error-Handler sonst Chaos 882 if( !bInError ) 883 { 884 // (Bei Spr�ngen aus Schleifen tritt hier eine Differenz auf) 885 sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 ); 886 if( pGosubStk ) 887 nExspectedForLevel = nExspectedForLevel + pGosubStk->nStartForLvl; 888 889 // Wenn der tatsaechliche For-Level zu klein ist, wurde aus 890 // einer Schleife heraus gesprungen -> korrigieren 891 while( nForLvl > nExspectedForLevel ) 892 PopFor(); 893 } 894 895 // 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out 896 // Erkl�rung siehe bei _ImplGetBreakCallLevel. 897 if( pInst->nCallLvl <= pInst->nBreakCallLvl ) 898 //if( nFlags & SbDEBUG_STEPINTO ) 899 { 900 StarBASIC* pStepBasic = GetCurrentBasic( &rBasic ); 901 sal_uInt16 nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 ); 902 903 // Neuen BreakCallLevel ermitteln 904 pInst->CalcBreakCallLevel( nNewFlags ); 905 } 906 907 // Breakpoints nur bei STMNT-Befehlen in neuer Zeile! 908 else if( ( nOp1 != nOld ) 909 && ( nFlags & SbDEBUG_BREAK ) 910 && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) ) 911 { 912 StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic ); 913 sal_uInt16 nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 ); 914 915 // Neuen BreakCallLevel ermitteln 916 pInst->CalcBreakCallLevel( nNewFlags ); 917 //16.10.96, ALT: 918 //if( nNewFlags != SbDEBUG_CONTINUE ) 919 // nFlags = nNewFlags; 920 } 921 } 922 923 // (+SvStreamFlags+Flags) 924 // Stack: Blocklaenge 925 // Kanalnummer 926 // Dateiname 927 928 void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 929 { 930 SbxVariableRef pName = PopVar(); 931 SbxVariableRef pChan = PopVar(); 932 SbxVariableRef pLen = PopVar(); 933 short nBlkLen = pLen->GetInteger(); 934 short nChan = pChan->GetInteger(); 935 ByteString aName( pName->GetString(), gsl_getSystemTextEncoding() ); 936 pIosys->Open( nChan, aName, static_cast<short>( nOp1 ), 937 static_cast<short>( nOp2 ), nBlkLen ); 938 Error( pIosys->GetError() ); 939 } 940 941 // Objekt kreieren (+StringID+StringID) 942 943 void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 944 { 945 String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) ); 946 SbxObject *pObj = SbxBase::CreateObject( aClass ); 947 if( !pObj ) 948 Error( SbERR_INVALID_OBJECT ); 949 else 950 { 951 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 952 pObj->SetName( aName ); 953 // Das Objekt muss BASIC rufen koennen 954 pObj->SetParent( &rBasic ); 955 SbxVariable* pNew = new SbxVariable; 956 pNew->PutObject( pObj ); 957 PushVar( pNew ); 958 } 959 } 960 961 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 962 { 963 StepDCREATE_IMPL( nOp1, nOp2 ); 964 } 965 966 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 967 { 968 StepDCREATE_IMPL( nOp1, nOp2 ); 969 } 970 971 972 // Helper function for StepDCREATE_IMPL / bRedimp = true 973 void implCopyDimArray_DCREATE( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex, 974 short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds ) 975 { 976 sal_Int32& ri = pActualIndices[nActualDim]; 977 for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ ) 978 { 979 if( nActualDim < nMaxDimIndex ) 980 { 981 implCopyDimArray_DCREATE( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1, 982 pActualIndices, pLowerBounds, pUpperBounds ); 983 } 984 else 985 { 986 SbxVariable* pSource = pOldArray->Get32( pActualIndices ); 987 pNewArray->Put32( pSource, pActualIndices ); 988 } 989 } 990 } 991 992 // #56204 Objekt-Array kreieren (+StringID+StringID), DCREATE == Dim-Create 993 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 994 { 995 SbxVariableRef refVar = PopVar(); 996 997 DimImpl( refVar ); 998 999 // Das Array mit Instanzen der geforderten Klasse fuellen 1000 SbxBaseRef xObj = (SbxBase*)refVar->GetObject(); 1001 if( !xObj ) 1002 { 1003 StarBASIC::Error( SbERR_INVALID_OBJECT ); 1004 return; 1005 } 1006 1007 SbxDimArray* pArray = 0; 1008 if( xObj->ISA(SbxDimArray) ) 1009 { 1010 SbxBase* pObj = (SbxBase*)xObj; 1011 pArray = (SbxDimArray*)pObj; 1012 1013 // Dimensionen auswerten 1014 short nDims = pArray->GetDims(); 1015 sal_Int32 nTotalSize = 0; 1016 1017 // es muss ein eindimensionales Array sein 1018 sal_Int32 nLower, nUpper, nSize; 1019 sal_Int32 i; 1020 for( i = 0 ; i < nDims ; i++ ) 1021 { 1022 pArray->GetDim32( i+1, nLower, nUpper ); 1023 nSize = nUpper - nLower + 1; 1024 if( i == 0 ) 1025 nTotalSize = nSize; 1026 else 1027 nTotalSize *= nSize; 1028 } 1029 1030 // Objekte anlegen und ins Array eintragen 1031 String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) ); 1032 for( i = 0 ; i < nTotalSize ; i++ ) 1033 { 1034 SbxObject *pClassObj = SbxBase::CreateObject( aClass ); 1035 if( !pClassObj ) 1036 { 1037 Error( SbERR_INVALID_OBJECT ); 1038 break; 1039 } 1040 else 1041 { 1042 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 1043 pClassObj->SetName( aName ); 1044 // Das Objekt muss BASIC rufen koennen 1045 pClassObj->SetParent( &rBasic ); 1046 pArray->SbxArray::Put32( pClassObj, i ); 1047 } 1048 } 1049 } 1050 1051 SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray; 1052 if( pArray && pOldArray ) 1053 { 1054 short nDimsNew = pArray->GetDims(); 1055 short nDimsOld = pOldArray->GetDims(); 1056 short nDims = nDimsNew; 1057 sal_Bool bRangeError = sal_False; 1058 1059 // Store dims to use them for copying later 1060 sal_Int32* pLowerBounds = new sal_Int32[nDims]; 1061 sal_Int32* pUpperBounds = new sal_Int32[nDims]; 1062 sal_Int32* pActualIndices = new sal_Int32[nDims]; 1063 if( nDimsOld != nDimsNew ) 1064 { 1065 bRangeError = sal_True; 1066 } 1067 else 1068 { 1069 // Compare bounds 1070 for( short i = 1 ; i <= nDims ; i++ ) 1071 { 1072 sal_Int32 lBoundNew, uBoundNew; 1073 sal_Int32 lBoundOld, uBoundOld; 1074 pArray->GetDim32( i, lBoundNew, uBoundNew ); 1075 pOldArray->GetDim32( i, lBoundOld, uBoundOld ); 1076 1077 lBoundNew = std::max( lBoundNew, lBoundOld ); 1078 uBoundNew = std::min( uBoundNew, uBoundOld ); 1079 short j = i - 1; 1080 pActualIndices[j] = pLowerBounds[j] = lBoundNew; 1081 pUpperBounds[j] = uBoundNew; 1082 } 1083 } 1084 1085 if( bRangeError ) 1086 { 1087 StarBASIC::Error( SbERR_OUT_OF_RANGE ); 1088 } 1089 else 1090 { 1091 // Copy data from old array by going recursively through all dimensions 1092 // (It would be faster to work on the flat internal data array of an 1093 // SbyArray but this solution is clearer and easier) 1094 implCopyDimArray_DCREATE( pArray, pOldArray, nDims - 1, 1095 0, pActualIndices, pLowerBounds, pUpperBounds ); 1096 } 1097 delete [] pUpperBounds; 1098 delete [] pLowerBounds; 1099 delete [] pActualIndices; 1100 refRedimpArray = NULL; 1101 } 1102 } 1103 1104 // Objekt aus User-Type kreieren (+StringID+StringID) 1105 1106 SbxObject* createUserTypeImpl( const String& rClassName ); // sb.cxx 1107 1108 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1109 { 1110 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 1111 String aClass( pImg->GetString( static_cast<short>( nOp2 ) ) ); 1112 1113 SbxObject* pCopyObj = createUserTypeImpl( aClass ); 1114 if( pCopyObj ) 1115 pCopyObj->SetName( aName ); 1116 SbxVariable* pNew = new SbxVariable; 1117 pNew->PutObject( pCopyObj ); 1118 pNew->SetDeclareClassName( aClass ); 1119 PushVar( pNew ); 1120 } 1121 1122 void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 ) 1123 { 1124 bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0); 1125 if( bWithEvents ) 1126 pVar->SetFlag( SBX_WITH_EVENTS ); 1127 1128 bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0); 1129 if( bDimAsNew ) 1130 pVar->SetFlag( SBX_DIM_AS_NEW ); 1131 1132 bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0); 1133 if( bFixedString ) 1134 { 1135 sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000 1136 String aStr; 1137 aStr.Fill( nCount, 0 ); 1138 pVar->PutString( aStr ); 1139 } 1140 1141 bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0); 1142 if( bVarToDim ) 1143 pVar->SetFlag( SBX_VAR_TO_DIM ); 1144 } 1145 1146 // Einrichten einer lokalen Variablen (+StringID+Typ) 1147 1148 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1149 { 1150 if( !refLocals.Is() ) 1151 refLocals = new SbxArray; 1152 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 1153 if( refLocals->Find( aName, SbxCLASS_DONTCARE ) == NULL ) 1154 { 1155 SbxDataType t = (SbxDataType)(nOp2 & 0xffff); 1156 SbxVariable* p = new SbxVariable( t ); 1157 p->SetName( aName ); 1158 implHandleSbxFlags( p, t, nOp2 ); 1159 refLocals->Put( p, refLocals->Count() ); 1160 } 1161 } 1162 1163 // Einrichten einer modulglobalen Variablen (+StringID+Typ) 1164 1165 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule ) 1166 { 1167 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 1168 SbxDataType t = (SbxDataType)(SbxDataType)(nOp2 & 0xffff);; 1169 sal_Bool bFlag = pMod->IsSet( SBX_NO_MODIFY ); 1170 pMod->SetFlag( SBX_NO_MODIFY ); 1171 SbxVariableRef p = pMod->Find( aName, SbxCLASS_PROPERTY ); 1172 if( p.Is() ) 1173 pMod->Remove (p); 1174 SbProperty* pProp = pMod->GetProperty( aName, t ); 1175 if( !bUsedForClassModule ) 1176 pProp->SetFlag( SBX_PRIVATE ); 1177 if( !bFlag ) 1178 pMod->ResetFlag( SBX_NO_MODIFY ); 1179 if( pProp ) 1180 { 1181 pProp->SetFlag( SBX_DONTSTORE ); 1182 // AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden' 1183 pProp->SetFlag( SBX_NO_MODIFY); 1184 1185 implHandleSbxFlags( pProp, t, nOp2 ); 1186 } 1187 } 1188 1189 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1190 { 1191 StepPUBLIC_Impl( nOp1, nOp2, false ); 1192 } 1193 1194 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1195 { 1196 // Creates module variable that isn't reinitialised when 1197 // between invocations ( for VBASupport & document basic only ) 1198 if( pMod->pImage->bFirstInit ) 1199 { 1200 bool bUsedForClassModule = pImg->GetFlag( SBIMG_CLASSMODULE ); 1201 StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule ); 1202 } 1203 } 1204 1205 // Einrichten einer globalen Variablen (+StringID+Typ) 1206 1207 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1208 { 1209 if( pImg->GetFlag( SBIMG_CLASSMODULE ) ) 1210 StepPUBLIC_Impl( nOp1, nOp2, true ); 1211 1212 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 1213 SbxDataType t = (SbxDataType)(nOp2 & 0xffff); 1214 1215 // Store module scope variables at module scope 1216 // in non vba mode these are stored at the library level :/ 1217 // not sure if this really should not be enabled for ALL basic 1218 SbxObject* pStorage = &rBasic; 1219 if ( SbiRuntime::isVBAEnabled() ) 1220 { 1221 pStorage = pMod; 1222 pMod->AddVarName( aName ); 1223 } 1224 1225 sal_Bool bFlag = pStorage->IsSet( SBX_NO_MODIFY ); 1226 rBasic.SetFlag( SBX_NO_MODIFY ); 1227 SbxVariableRef p = pStorage->Find( aName, SbxCLASS_PROPERTY ); 1228 if( p.Is() ) 1229 pStorage->Remove (p); 1230 p = pStorage->Make( aName, SbxCLASS_PROPERTY, t ); 1231 if( !bFlag ) 1232 pStorage->ResetFlag( SBX_NO_MODIFY ); 1233 if( p ) 1234 { 1235 p->SetFlag( SBX_DONTSTORE ); 1236 // AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden' 1237 p->SetFlag( SBX_NO_MODIFY); 1238 } 1239 } 1240 1241 1242 // Creates global variable that isn't reinitialised when 1243 // basic is restarted, P=PERSIST (+StringID+Typ) 1244 1245 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1246 { 1247 if( pMod->pImage->bFirstInit ) 1248 { 1249 StepGLOBAL( nOp1, nOp2 ); 1250 } 1251 } 1252 1253 1254 // Searches for global variable, behavior depends on the fact 1255 // if the variable is initialised for the first time 1256 1257 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1258 { 1259 if( pMod->pImage->bFirstInit ) 1260 { 1261 // Behave like always during first init 1262 StepFIND( nOp1, nOp2 ); 1263 } 1264 else 1265 { 1266 // Return dummy variable 1267 SbxDataType t = (SbxDataType) nOp2; 1268 String aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) ); 1269 1270 SbxVariable* pDummyVar = new SbxVariable( t ); 1271 pDummyVar->SetName( aName ); 1272 PushVar( pDummyVar ); 1273 } 1274 } 1275 1276 1277 SbxVariable* SbiRuntime::StepSTATIC_Impl( String& aName, SbxDataType& t ) 1278 { 1279 SbxVariable* p = NULL; 1280 if ( pMeth ) 1281 { 1282 SbxArray* pStatics = pMeth->GetStatics(); 1283 if( pStatics && ( pStatics->Find( aName, SbxCLASS_DONTCARE ) == NULL ) ) 1284 { 1285 p = new SbxVariable( t ); 1286 if( t != SbxVARIANT ) 1287 p->SetFlag( SBX_FIXED ); 1288 p->SetName( aName ); 1289 pStatics->Put( p, pStatics->Count() ); 1290 } 1291 } 1292 return p; 1293 } 1294 // Einrichten einer statischen Variablen (+StringID+Typ) 1295 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 ) 1296 { 1297 String aName( pImg->GetString( static_cast<short>( nOp1 ) ) ); 1298 SbxDataType t = (SbxDataType) nOp2; 1299 StepSTATIC_Impl( aName, t ); 1300 } 1301 1302