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