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
FindElement(SbxObject * pObj,sal_uInt32 nOp1,sal_uInt32 nOp2,SbError nNotFound,sal_Bool bLocal,sal_Bool bStatic)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 // pseudo 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)
FindElementExtern(const String & rName)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
SetupArgs(SbxVariable * p,sal_uInt32 nOp1)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
CheckArray(SbxVariable * pElem)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
StepRTL(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepFIND_Impl(SbxObject * pObj,sal_uInt32 nOp1,sal_uInt32 nOp2,SbError nNotFound,sal_Bool bLocal,sal_Bool bStatic)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
StepFIND(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepFIND_CM(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepFIND_STATIC(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepELEM(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepPARAM(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepCASEIS(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepCALL(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepCALLC(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepSTMNT(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepOPEN(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepCREATE(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepDCREATE(sal_uInt32 nOp1,sal_uInt32 nOp2)961 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
962 {
963 StepDCREATE_IMPL( nOp1, nOp2 );
964 }
965
StepDCREATE_REDIMP(sal_uInt32 nOp1,sal_uInt32 nOp2)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
implCopyDimArray_DCREATE(SbxDimArray * pNewArray,SbxDimArray * pOldArray,short nMaxDimIndex,short nActualDim,sal_Int32 * pActualIndices,sal_Int32 * pLowerBounds,sal_Int32 * pUpperBounds)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
StepDCREATE_IMPL(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepTCREATE(sal_uInt32 nOp1,sal_uInt32 nOp2)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
implHandleSbxFlags(SbxVariable * pVar,SbxDataType t,sal_uInt32 nOp2)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
StepLOCAL(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepPUBLIC_Impl(sal_uInt32 nOp1,sal_uInt32 nOp2,bool bUsedForClassModule)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
StepPUBLIC(sal_uInt32 nOp1,sal_uInt32 nOp2)1189 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
1190 {
1191 StepPUBLIC_Impl( nOp1, nOp2, false );
1192 }
1193
StepPUBLIC_P(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepGLOBAL(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepGLOBAL_P(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepFIND_G(sal_uInt32 nOp1,sal_uInt32 nOp2)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
StepSTATIC_Impl(String & aName,SbxDataType & t)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)
StepSTATIC(sal_uInt32 nOp1,sal_uInt32 nOp2)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