xref: /AOO41X/main/basic/source/runtime/runtime.cxx (revision 93ed1f2908b97a4746d8a0cef01e9c4b6219d66b)
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 #include <tools/fsys.hxx>
27 #include <vcl/svapp.hxx>
28 #include <tools/wldcrd.hxx>
29 #include <svl/zforlist.hxx>
30 #include <unotools/syslocale.hxx>
31 #include "runtime.hxx"
32 #include "sbintern.hxx"
33 #include "opcodes.hxx"
34 #include "codegen.hxx"
35 #include "iosys.hxx"
36 #include "image.hxx"
37 #include "ddectrl.hxx"
38 #include "dllmgr.hxx"
39 #include <comphelper/processfactory.hxx>
40 #include <com/sun/star/container/XEnumerationAccess.hpp>
41 #include "sbunoobj.hxx"
42 #include "errobject.hxx"
43 #include "sbtrace.hxx"
44 #include "comenumwrapper.hxx"
45 
46 using namespace ::com::sun::star;
47 
isVBAEnabled()48 bool SbiRuntime::isVBAEnabled()
49 {
50     bool result = false;
51     SbiInstance* pInst = pINST;
52     if ( pInst && pINST->pRun )
53         result = pInst->pRun->bVBAEnabled;
54     return result;
55 }
56 
57 // #91147 Global reschedule flag
58 static sal_Bool bStaticGlobalEnableReschedule = sal_True;
59 
StaticEnableReschedule(sal_Bool bReschedule)60 void StarBASIC::StaticEnableReschedule( sal_Bool bReschedule )
61 {
62     bStaticGlobalEnableReschedule = bReschedule;
63 }
SetVBAEnabled(sal_Bool bEnabled)64 void StarBASIC::SetVBAEnabled( sal_Bool bEnabled )
65 {
66     if ( bDocBasic )
67     {
68         bVBAEnabled = bEnabled;
69     }
70 }
71 
isVBAEnabled()72 sal_Bool StarBASIC::isVBAEnabled()
73 {
74     if ( bDocBasic )
75     {
76         if( SbiRuntime::isVBAEnabled() )
77             return sal_True;
78         return bVBAEnabled;
79     }
80     return sal_False;
81 }
82 
83 
84 struct SbiArgvStack {                   // Argv stack:
85     SbiArgvStack*  pNext;               // Stack Chain
86     SbxArrayRef    refArgv;             // Argv
87     short nArgc;                        // Argc
88 };
89 
90 SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // Alle Opcodes ohne Operanden
91     &SbiRuntime::StepNOP,
92     &SbiRuntime::StepEXP,
93     &SbiRuntime::StepMUL,
94     &SbiRuntime::StepDIV,
95     &SbiRuntime::StepMOD,
96     &SbiRuntime::StepPLUS,
97     &SbiRuntime::StepMINUS,
98     &SbiRuntime::StepNEG,
99     &SbiRuntime::StepEQ,
100     &SbiRuntime::StepNE,
101     &SbiRuntime::StepLT,
102     &SbiRuntime::StepGT,
103     &SbiRuntime::StepLE,
104     &SbiRuntime::StepGE,
105     &SbiRuntime::StepIDIV,
106     &SbiRuntime::StepAND,
107     &SbiRuntime::StepOR,
108     &SbiRuntime::StepXOR,
109     &SbiRuntime::StepEQV,
110     &SbiRuntime::StepIMP,
111     &SbiRuntime::StepNOT,
112     &SbiRuntime::StepCAT,
113 
114     &SbiRuntime::StepLIKE,
115     &SbiRuntime::StepIS,
116     // Laden/speichern
117     &SbiRuntime::StepARGC,      // neuen Argv einrichten
118     &SbiRuntime::StepARGV,      // TOS ==> aktueller Argv
119     &SbiRuntime::StepINPUT,     // Input ==> TOS
120     &SbiRuntime::StepLINPUT,        // Line Input ==> TOS
121     &SbiRuntime::StepGET,        // TOS anfassen
122     &SbiRuntime::StepSET,        // Speichern Objekt TOS ==> TOS-1
123     &SbiRuntime::StepPUT,       // TOS ==> TOS-1
124     &SbiRuntime::StepPUTC,      // TOS ==> TOS-1, dann ReadOnly
125     &SbiRuntime::StepDIM,       // DIM
126     &SbiRuntime::StepREDIM,         // REDIM
127     &SbiRuntime::StepREDIMP,        // REDIM PRESERVE
128     &SbiRuntime::StepERASE,         // TOS loeschen
129     // Verzweigen
130     &SbiRuntime::StepSTOP,          // Programmende
131     &SbiRuntime::StepINITFOR,   // FOR-Variable initialisieren
132     &SbiRuntime::StepNEXT,      // FOR-Variable inkrementieren
133     &SbiRuntime::StepCASE,      // Anfang CASE
134     &SbiRuntime::StepENDCASE,   // Ende CASE
135     &SbiRuntime::StepSTDERROR,      // Standard-Fehlerbehandlung
136     &SbiRuntime::StepNOERROR,   // keine Fehlerbehandlung
137     &SbiRuntime::StepLEAVE,     // UP verlassen
138     // E/A
139     &SbiRuntime::StepCHANNEL,   // TOS = Kanalnummer
140     &SbiRuntime::StepPRINT,     // print TOS
141     &SbiRuntime::StepPRINTF,        // print TOS in field
142     &SbiRuntime::StepWRITE,     // write TOS
143     &SbiRuntime::StepRENAME,        // Rename Tos+1 to Tos
144     &SbiRuntime::StepPROMPT,        // Input Prompt aus TOS definieren
145     &SbiRuntime::StepRESTART,   // Set restart point
146     &SbiRuntime::StepCHANNEL0,  // E/A-Kanal 0 einstellen
147     &SbiRuntime::StepEMPTY,     // Leeren Ausdruck auf Stack
148     &SbiRuntime::StepERROR,     // TOS = Fehlercode
149     &SbiRuntime::StepLSET,      // Speichern Objekt TOS ==> TOS-1
150     &SbiRuntime::StepRSET,      // Speichern Objekt TOS ==> TOS-1
151     &SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
152     &SbiRuntime::StepINITFOREACH,// Init for each loop
153     &SbiRuntime::StepVBASET,// vba-like set statement
154     &SbiRuntime::StepERASE_CLEAR,// vba-like set statement
155     &SbiRuntime::StepARRAYACCESS,// access TOS as array
156     &SbiRuntime::StepBYVAL,     // access TOS as array
157 };
158 
159 SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // Alle Opcodes mit einem Operanden
160     &SbiRuntime::StepLOADNC,        // Laden einer numerischen Konstanten (+ID)
161     &SbiRuntime::StepLOADSC,        // Laden einer Stringkonstanten (+ID)
162     &SbiRuntime::StepLOADI,     // Immediate Load (+Wert)
163     &SbiRuntime::StepARGN,      // Speichern eines named Args in Argv (+StringID)
164     &SbiRuntime::StepPAD,       // String auf feste Laenge bringen (+Laenge)
165     // Verzweigungen
166     &SbiRuntime::StepJUMP,      // Sprung (+Target)
167     &SbiRuntime::StepJUMPT,     // TOS auswerten), bedingter Sprung (+Target)
168     &SbiRuntime::StepJUMPF,     // TOS auswerten), bedingter Sprung (+Target)
169     &SbiRuntime::StepONJUMP,        // TOS auswerten), Sprung in JUMP-Tabelle (+MaxVal)
170     &SbiRuntime::StepGOSUB,     // UP-Aufruf (+Target)
171     &SbiRuntime::StepRETURN,        // UP-Return (+0 oder Target)
172     &SbiRuntime::StepTESTFOR,   // FOR-Variable testen), inkrementieren (+Endlabel)
173     &SbiRuntime::StepCASETO,        // Tos+1 <= Case <= Tos), 2xremove (+Target)
174     &SbiRuntime::StepERRHDL,        // Fehler-Handler (+Offset)
175     &SbiRuntime::StepRESUME,        // Resume nach Fehlern (+0 or 1 or Label)
176     // E/A
177     &SbiRuntime::StepCLOSE,     // (+Kanal/0)
178     &SbiRuntime::StepPRCHAR,        // (+char)
179     // Verwaltung
180     &SbiRuntime::StepSETCLASS,  // Set + Klassennamen testen (+StringId)
181     &SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId)
182     &SbiRuntime::StepLIB,       // Lib fuer Declare-Call (+StringId)
183     &SbiRuntime::StepBASED,     // TOS wird um BASE erhoeht, BASE davor gepusht
184     &SbiRuntime::StepARGTYP,        // Letzten Parameter in Argv konvertieren (+Typ)
185     &SbiRuntime::StepVBASETCLASS,// vba-like set statement
186 };
187 
188 SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// Alle Opcodes mit zwei Operanden
189     &SbiRuntime::StepRTL,       // Laden aus RTL (+StringID+Typ)
190     &SbiRuntime::StepFIND,      // Laden (+StringID+Typ)
191     &SbiRuntime::StepELEM,          // Laden Element (+StringID+Typ)
192     &SbiRuntime::StepPARAM,     // Parameter (+Offset+Typ)
193     // Verzweigen
194     &SbiRuntime::StepCALL,      // Declare-Call (+StringID+Typ)
195     &SbiRuntime::StepCALLC,     // CDecl-Declare-Call (+StringID+Typ)
196     &SbiRuntime::StepCASEIS,        // Case-Test (+Test-Opcode+False-Target)
197     // Verwaltung
198     &SbiRuntime::StepSTMNT,         // Beginn eines Statements (+Line+Col)
199     // E/A
200     &SbiRuntime::StepOPEN,          // (+SvStreamFlags+Flags)
201     // Objekte
202     &SbiRuntime::StepLOCAL,     // Lokale Variable definieren (+StringId+Typ)
203     &SbiRuntime::StepPUBLIC,        // Modulglobale Variable (+StringID+Typ)
204     &SbiRuntime::StepGLOBAL,        // Globale Variable definieren (+StringID+Typ)
205     &SbiRuntime::StepCREATE,        // Objekt kreieren (+StringId+StringId)
206     &SbiRuntime::StepSTATIC,     // Statische Variable (+StringId+StringId)
207     &SbiRuntime::StepTCREATE,    // User Defined Objekte (+StringId+StringId)
208     &SbiRuntime::StepDCREATE,    // Objekt-Array kreieren (+StringID+StringID)
209     &SbiRuntime::StepGLOBAL_P,   // Globale Variable definieren, die beim Neustart
210                                         // von Basic nicht ueberschrieben wird (+StringID+Typ)
211     &SbiRuntime::StepFIND_G,        // Sucht globale Variable mit Spezialbehandlung wegen _GLOBAL_P
212     &SbiRuntime::StepDCREATE_REDIMP, // Objekt-Array redimensionieren (+StringID+StringID)
213     &SbiRuntime::StepFIND_CM,    // Search inside a class module (CM) to enable global search in time
214     &SbiRuntime::StepPUBLIC_P,    // Search inside a class module (CM) to enable global search in time
215     &SbiRuntime::StepFIND_STATIC,    // Search inside a class module (CM) to enable global search in time
216 };
217 
218 
219 //////////////////////////////////////////////////////////////////////////
220 //                              SbiRTLData                              //
221 //////////////////////////////////////////////////////////////////////////
222 
SbiRTLData()223 SbiRTLData::SbiRTLData()
224 {
225     pDir        = 0;
226     nDirFlags   = 0;
227     nCurDirPos  = 0;
228     pWildCard   = NULL;
229 }
230 
~SbiRTLData()231 SbiRTLData::~SbiRTLData()
232 {
233     delete pDir;
234     pDir = 0;
235     delete pWildCard;
236 }
237 
238 //////////////////////////////////////////////////////////////////////////
239 //                              SbiInstance                             //
240 //////////////////////////////////////////////////////////////////////////
241 
242 // 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out
243 // Die Entscheidung, ob StepPoint aufgerufen werden soll, wird anhand des
244 // CallLevels getroffen. Angehalten wird, wenn der aktuelle CallLevel <=
245 // nBreakCallLvl ist. Der aktuelle CallLevel kann niemals kleiner als 1
246 // sein, da er beim Aufruf einer Methode (auch main) inkrementiert wird.
247 // Daher bedeutet ein BreakCallLvl von 0, dass das Programm gar nicht
248 // angehalten wird.
249 // (siehe auch step2.cxx, SbiRuntime::StepSTMNT() )
250 
251 // Hilfsfunktion, um den BreakCallLevel gemaess der der Debug-Flags zu ermitteln
CalcBreakCallLevel(sal_uInt16 nFlags)252 void SbiInstance::CalcBreakCallLevel( sal_uInt16 nFlags )
253 {
254     // Break-Flag wegfiltern
255     nFlags &= ~((sal_uInt16)SbDEBUG_BREAK);
256 
257     sal_uInt16 nRet;
258     switch( nFlags )
259     {
260         case SbDEBUG_STEPINTO:
261             nRet = nCallLvl + 1;    // CallLevel+1 wird auch angehalten
262             break;
263         case SbDEBUG_STEPOVER | SbDEBUG_STEPINTO:
264             nRet = nCallLvl;        // Aktueller CallLevel wird angehalten
265             break;
266         case SbDEBUG_STEPOUT:
267             nRet = nCallLvl - 1;    // Kleinerer CallLevel wird angehalten
268             break;
269         case SbDEBUG_CONTINUE:
270         // Basic-IDE liefert 0 statt SbDEBUG_CONTINUE, also auch default=continue
271         default:
272             nRet = 0;               // CallLevel ist immer >0 -> kein StepPoint
273     }
274     nBreakCallLvl = nRet;           // Ergebnis uebernehmen
275 }
276 
SbiInstance(StarBASIC * p)277 SbiInstance::SbiInstance( StarBASIC* p )
278 {
279     pBasic   = p;
280     pNext    = NULL;
281     pRun     = NULL;
282     pIosys   = new SbiIoSystem;
283     pDdeCtrl = new SbiDdeControl;
284     pDllMgr  = 0; // on demand
285     pNumberFormatter = 0; // on demand
286     nCallLvl = 0;
287     nBreakCallLvl = 0;
288     nErr     =
289     nErl     = 0;
290     bReschedule = sal_True;
291     bCompatibility = sal_False;
292 }
293 
~SbiInstance()294 SbiInstance::~SbiInstance()
295 {
296     while( pRun )
297     {
298         SbiRuntime* p = pRun->pNext;
299         delete pRun;
300         pRun = p;
301     }
302     delete pIosys;
303     delete pDdeCtrl;
304     delete pDllMgr;
305     delete pNumberFormatter;
306 
307     try
308     {
309         int nSize = ComponentVector.size();
310         if( nSize )
311         {
312             for( int i = nSize - 1 ; i >= 0 ; --i )
313             {
314                 Reference< XComponent > xDlgComponent = ComponentVector[i];
315                 if( xDlgComponent.is() )
316                     xDlgComponent->dispose();
317             }
318         }
319     }
320     catch( const Exception& )
321     {
322         DBG_ERROR( "SbiInstance::~SbiInstance: caught an exception while disposing the components!" );
323     }
324 
325     ComponentVector.clear();
326 }
327 
GetDllMgr()328 SbiDllMgr* SbiInstance::GetDllMgr()
329 {
330     if( !pDllMgr )
331         pDllMgr = new SbiDllMgr;
332     return pDllMgr;
333 }
334 
335 // #39629 NumberFormatter jetzt ueber statische Methode anlegen
GetNumberFormatter()336 SvNumberFormatter* SbiInstance::GetNumberFormatter()
337 {
338     LanguageType eLangType = GetpApp()->GetSettings().GetLanguage();
339     SvtSysLocale aSysLocale;
340     DateFormat eDate = aSysLocale.GetLocaleData().getDateFormat();
341     if( pNumberFormatter )
342     {
343         if( eLangType != meFormatterLangType ||
344             eDate != meFormatterDateFormat )
345         {
346             delete pNumberFormatter;
347             pNumberFormatter = NULL;
348         }
349     }
350     meFormatterLangType = eLangType;
351     meFormatterDateFormat = eDate;
352     if( !pNumberFormatter )
353         PrepareNumberFormatter( pNumberFormatter, nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx,
354         &meFormatterLangType, &meFormatterDateFormat );
355     return pNumberFormatter;
356 }
357 
358 // #39629 NumberFormatter auch statisch anbieten
PrepareNumberFormatter(SvNumberFormatter * & rpNumberFormatter,sal_uInt32 & rnStdDateIdx,sal_uInt32 & rnStdTimeIdx,sal_uInt32 & rnStdDateTimeIdx,LanguageType * peFormatterLangType,DateFormat * peFormatterDateFormat)359 void SbiInstance::PrepareNumberFormatter( SvNumberFormatter*& rpNumberFormatter,
360     sal_uInt32 &rnStdDateIdx, sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
361     LanguageType* peFormatterLangType, DateFormat* peFormatterDateFormat )
362 {
363     com::sun::star::uno::Reference< com::sun::star::lang::XMultiServiceFactory >
364         xFactory = comphelper::getProcessServiceFactory();
365 
366     LanguageType eLangType;
367     if( peFormatterLangType )
368         eLangType = *peFormatterLangType;
369     else
370         eLangType = GetpApp()->GetSettings().GetLanguage();
371 
372     DateFormat eDate;
373     if( peFormatterDateFormat )
374         eDate = *peFormatterDateFormat;
375     else
376     {
377         SvtSysLocale aSysLocale;
378         eDate = aSysLocale.GetLocaleData().getDateFormat();
379     }
380 
381     rpNumberFormatter = new SvNumberFormatter( xFactory, eLangType );
382 
383     xub_StrLen nCheckPos = 0; short nType;
384     rnStdTimeIdx = rpNumberFormatter->GetStandardFormat( NUMBERFORMAT_TIME, eLangType );
385 
386     // Standard-Vorlagen des Formatters haben nur zweistellige
387     // Jahreszahl. Deshalb eigenes Format registrieren
388 
389     // HACK, da der Numberformatter in PutandConvertEntry die Platzhalter
390     // fuer Monat, Tag, Jahr nicht entsprechend der Systemeinstellung
391     // austauscht. Problem: Print Year(Date) unter engl. BS
392     // siehe auch svtools\source\sbx\sbxdate.cxx
393 
394     String aDateStr;
395     switch( eDate )
396     {
397         case MDY: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") ); break;
398         case DMY: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("TT.MM.JJJJ") ); break;
399         case YMD: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("JJJJ.MM.TT") ); break;
400         default:  aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") );
401     }
402     String aStr( aDateStr );
403     rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
404         rnStdDateIdx, LANGUAGE_GERMAN, eLangType );
405     nCheckPos = 0;
406     String aStrHHMMSS( RTL_CONSTASCII_USTRINGPARAM(" HH:MM:SS") );
407     aStr = aDateStr;
408     aStr += aStrHHMMSS;
409     rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
410         rnStdDateTimeIdx, LANGUAGE_GERMAN, eLangType );
411 }
412 
413 
414 
415 // Engine laufenlassen. Falls Flags == SbDEBUG_CONTINUE, Flags uebernehmen
416 
Stop()417 void SbiInstance::Stop()
418 {
419     for( SbiRuntime* p = pRun; p; p = p->pNext )
420         p->Stop();
421 }
422 
423 // Allows Basic IDE to set watch mode to suppress errors
424 static bool bWatchMode = false;
425 
setBasicWatchMode(bool bOn)426 void setBasicWatchMode( bool bOn )
427 {
428     bWatchMode = bOn;
429 }
430 
Error(SbError n)431 void SbiInstance::Error( SbError n )
432 {
433     Error( n, String() );
434 }
435 
Error(SbError n,const String & rMsg)436 void SbiInstance::Error( SbError n, const String& rMsg )
437 {
438     if( !bWatchMode )
439     {
440         aErrorMsg = rMsg;
441         pRun->Error( n );
442     }
443 }
444 
ErrorVB(sal_Int32 nVBNumber,const String & rMsg)445 void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const String& rMsg )
446 {
447     if( !bWatchMode )
448     {
449         SbError n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
450         if ( !n )
451             n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
452 
453         aErrorMsg = rMsg;
454         SbiRuntime::translateErrorToVba( n, aErrorMsg );
455 
456         bool bVBATranslationAlreadyDone = true;
457         pRun->Error( SbERR_BASIC_COMPAT, bVBATranslationAlreadyDone );
458     }
459 }
460 
setErrorVB(sal_Int32 nVBNumber,const String & rMsg)461 void SbiInstance::setErrorVB( sal_Int32 nVBNumber, const String& rMsg )
462 {
463     SbError n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
464     if( !n )
465         n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
466 
467     aErrorMsg = rMsg;
468     SbiRuntime::translateErrorToVba( n, aErrorMsg );
469 
470     nErr = n;
471 }
472 
473 
FatalError(SbError n)474 void SbiInstance::FatalError( SbError n )
475 {
476     pRun->FatalError( n );
477 }
478 
FatalError(SbError _errCode,const String & _details)479 void SbiInstance::FatalError( SbError _errCode, const String& _details )
480 {
481     pRun->FatalError( _errCode, _details );
482 }
483 
Abort()484 void SbiInstance::Abort()
485 {
486     // Basic suchen, in dem der Fehler auftrat
487     StarBASIC* pErrBasic = GetCurrentBasic( pBasic );
488     pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 );
489     pBasic->Stop();
490 }
491 
492 // Hilfsfunktion, um aktives Basic zu finden, kann ungleich pRTBasic sein
GetCurrentBasic(StarBASIC * pRTBasic)493 StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic )
494 {
495     StarBASIC* pCurBasic = pRTBasic;
496     SbModule* pActiveModule = pRTBasic->GetActiveModule();
497     if( pActiveModule )
498     {
499         SbxObject* pParent = pActiveModule->GetParent();
500         if( pParent && pParent->ISA(StarBASIC) )
501             pCurBasic = (StarBASIC*)pParent;
502     }
503     return pCurBasic;
504 }
505 
GetActiveModule()506 SbModule* SbiInstance::GetActiveModule()
507 {
508     if( pRun )
509         return pRun->GetModule();
510     else
511         return NULL;
512 }
513 
GetCaller(sal_uInt16 nLevel)514 SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel )
515 {
516     SbiRuntime* p = pRun;
517     while( nLevel-- && p )
518         p = p->pNext;
519     if( p )
520         return p->GetCaller();
521     else
522         return NULL;
523 }
524 
GetLocals(SbMethod * pMeth)525 SbxArray* SbiInstance::GetLocals( SbMethod* pMeth )
526 {
527     SbiRuntime* p = pRun;
528     while( p && p->GetMethod() != pMeth )
529         p = p->pNext;
530     if( p )
531         return p->GetLocals();
532     else
533         return NULL;
534 }
535 
536 //////////////////////////////////////////////////////////////////////////
537 //                              SbiInstance                             //
538 //////////////////////////////////////////////////////////////////////////
539 
540 // Achtung: pMeth kann auch NULL sein (beim Aufruf des Init-Codes)
541 
SbiRuntime(SbModule * pm,SbMethod * pe,sal_uInt32 nStart)542 SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart )
543          : rBasic( *(StarBASIC*)pm->pParent ), pInst( pINST ),
544            pMod( pm ), pMeth( pe ), pImg( pMod->pImage ), m_nLastTime(0)
545 {
546     nFlags    = pe ? pe->GetDebugFlags() : 0;
547     pIosys    = pInst->pIosys;
548     pArgvStk  = NULL;
549     pGosubStk = NULL;
550     pForStk   = NULL;
551     pError    = NULL;
552     pErrCode  =
553     pErrStmnt =
554     pRestart  = NULL;
555     pNext     = NULL;
556     pCode     =
557     pStmnt    = (const sal_uInt8* ) pImg->GetCode() + nStart;
558     bRun      =
559     bError    = sal_True;
560     bInError  = sal_False;
561     bBlocked  = sal_False;
562     nLine     = 0;
563     nCol1     = 0;
564     nCol2     = 0;
565     nExprLvl  = 0;
566     nArgc     = 0;
567     nError    = 0;
568     nGosubLvl = 0;
569     nForLvl   = 0;
570     nOps      = 0;
571     refExprStk = new SbxArray;
572     SetVBAEnabled( pMod->IsVBACompat() );
573 #if defined GCC
574     SetParameters( pe ? pe->GetParameters() : (class SbxArray *)NULL );
575 #else
576     SetParameters( pe ? pe->GetParameters() : NULL );
577 #endif
578     pRefSaveList = NULL;
579     pItemStoreList = NULL;
580 }
581 
~SbiRuntime()582 SbiRuntime::~SbiRuntime()
583 {
584     ClearGosubStack();
585     ClearArgvStack();
586     ClearForStack();
587 
588     // #74254 Items zum Sichern temporaere Referenzen freigeben
589     ClearRefs();
590     while( pItemStoreList )
591     {
592         RefSaveItem* pToDeleteItem = pItemStoreList;
593         pItemStoreList = pToDeleteItem->pNext;
594         delete pToDeleteItem;
595     }
596 }
597 
SetVBAEnabled(bool bEnabled)598 void SbiRuntime::SetVBAEnabled(bool bEnabled )
599 {
600     bVBAEnabled = bEnabled;
601 }
602 
603 // Aufbau der Parameterliste. Alle ByRef-Parameter werden direkt
604 // uebernommen; von ByVal-Parametern werden Kopien angelegt. Falls
605 // ein bestimmter Datentyp verlangt wird, wird konvertiert.
606 
SetParameters(SbxArray * pParams)607 void SbiRuntime::SetParameters( SbxArray* pParams )
608 {
609     refParams = new SbxArray;
610     // fuer den Returnwert
611     refParams->Put( pMeth, 0 );
612 
613     SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : NULL;
614     sal_uInt16 nParamCount = pParams ? pParams->Count() : 1;
615     if( nParamCount > 1 )
616     {
617         for( sal_uInt16 i = 1 ; i < nParamCount ; i++ )
618         {
619             const SbxParamInfo* p = pInfo ? pInfo->GetParam( i ) : NULL;
620 
621             // #111897 ParamArray
622             if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
623             {
624                 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
625                 sal_uInt16 nParamArrayParamCount = nParamCount - i;
626                 pArray->unoAddDim( 0, nParamArrayParamCount - 1 );
627                 for( sal_uInt16 j = i ; j < nParamCount ; j++ )
628                 {
629                     SbxVariable* v = pParams->Get( j );
630                     short nDimIndex = j - i;
631                     pArray->Put( v, &nDimIndex );
632                 }
633                 SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
634                 pArrayVar->SetFlag( SBX_READWRITE );
635                 pArrayVar->PutObject( pArray );
636                 refParams->Put( pArrayVar, i );
637 
638                 // Block ParamArray for missing parameter
639                 pInfo = NULL;
640                 break;
641             }
642 
643             SbxVariable* v = pParams->Get( i );
644             // Methoden sind immer byval!
645             sal_Bool bByVal = v->IsA( TYPE(SbxMethod) );
646             SbxDataType t = v->GetType();
647             bool bTargetTypeIsArray = false;
648             if( p )
649             {
650                 bByVal |= sal_Bool( ( p->eType & SbxBYREF ) == 0 );
651                 t = (SbxDataType) ( p->eType & 0x0FFF );
652 
653                 if( !bByVal && t != SbxVARIANT &&
654                     (!v->IsFixed() || (SbxDataType)(v->GetType() & 0x0FFF ) != t) )
655                         bByVal = sal_True;
656 
657                 bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0;
658             }
659             if( bByVal )
660             {
661                 if( bTargetTypeIsArray )
662                     t = SbxOBJECT;
663                 SbxVariable* v2 = new SbxVariable( t );
664                 v2->SetFlag( SBX_READWRITE );
665                 *v2 = *v;
666                 refParams->Put( v2, i );
667             }
668             else
669             {
670                 if( t != SbxVARIANT && t != ( v->GetType() & 0x0FFF ) )
671                 {
672                     // Array konvertieren??
673                     if( p && (p->eType & SbxARRAY) )
674                         Error( SbERR_CONVERSION );
675                     else
676                         v->Convert( t );
677                 }
678                 refParams->Put( v, i );
679             }
680             if( p )
681                 refParams->PutAlias( p->aName, i );
682         }
683     }
684 
685     // ParamArray for missing parameter
686     if( pInfo )
687     {
688         // #111897 Check first missing parameter for ParamArray
689         const SbxParamInfo* p = pInfo->GetParam( nParamCount );
690         if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
691         {
692             SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
693             pArray->unoAddDim( 0, -1 );
694             SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
695             pArrayVar->SetFlag( SBX_READWRITE );
696             pArrayVar->PutObject( pArray );
697             refParams->Put( pArrayVar, nParamCount );
698         }
699     }
700 }
701 
702 
703 // Einen P-Code ausfuehren
704 
Step()705 sal_Bool SbiRuntime::Step()
706 {
707     if( bRun )
708     {
709         // Unbedingt gelegentlich die Kontrolle abgeben!
710         if( !( ++nOps & 0xF ) && pInst->IsReschedule() && bStaticGlobalEnableReschedule )
711         {
712             sal_uInt32 nTime = osl_getGlobalTimer();
713             if (nTime - m_nLastTime > 5 ) // 20 ms
714             {
715                 Application::Reschedule();
716                 m_nLastTime = nTime;
717             }
718         }
719 
720         // #i48868 blocked by next call level?
721         while( bBlocked )
722         {
723             if( pInst->IsReschedule() && bStaticGlobalEnableReschedule )
724                 Application::Reschedule();
725         }
726 
727 #ifdef DBG_TRACE_BASIC
728         sal_uInt32 nPC = ( pCode - (const sal_uInt8* )pImg->GetCode() );
729         dbg_traceStep( pMod, nPC, pINST->nCallLvl );
730 #endif
731 
732         SbiOpcode eOp = (SbiOpcode ) ( *pCode++ );
733         sal_uInt32 nOp1, nOp2;
734         if (eOp < SbOP0_END)
735         {
736             (this->*( aStep0[ eOp ] ) )();
737         }
738         else if (eOp >= SbOP1_START && eOp < SbOP1_END)
739         {
740             nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
741 
742             (this->*( aStep1[ eOp - SbOP1_START ] ) )( nOp1 );
743         }
744         else if (eOp >= SbOP2_START && eOp < SbOP2_END)
745         {
746             nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
747             nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24;
748             (this->*( aStep2[ eOp - SbOP2_START ] ) )( nOp1, nOp2 );
749         }
750         else
751             StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
752 
753         // SBX-Fehler aufgetreten?
754         SbError nSbError = SbxBase::GetError();
755         Error( ERRCODE_TOERROR(nSbError) );         // Warnings rausfiltern
756 
757         // AB 13.2.1997, neues Error-Handling:
758         // ACHTUNG: Hier kann nError auch dann gesetzt sein, wenn !nSbError,
759         // da nError jetzt auch von anderen RT-Instanzen gesetzt werden kann
760 
761         if( nError )
762             SbxBase::ResetError();
763 
764         // AB,15.3.96: Fehler nur anzeigen, wenn BASIC noch aktiv
765         // (insbesondere nicht nach Compiler-Fehlern zur Laufzeit)
766         if( nError && bRun )
767         {
768 #ifdef DBG_TRACE_BASIC
769             SbError nTraceErr = nError;
770             String aTraceErrMsg = GetSbData()->aErrMsg;
771             bool bTraceErrHandled = true;
772 #endif
773             SbError err = nError;
774             ClearExprStack();
775             nError = 0;
776             pInst->nErr = err;
777             pInst->nErl = nLine;
778             pErrCode    = pCode;
779             pErrStmnt   = pStmnt;
780             // An error occured in an error handler
781             // force parent handler ( if there is one )
782             // to handle the error
783             bool bLetParentHandleThis = false;
784 
785             // Im Error Handler? Dann Std-Error
786             if ( !bInError )
787             {
788                 bInError = sal_True;
789 
790                 if( !bError )           // On Error Resume Next
791                     StepRESUME( 1 );
792                 else if( pError )       // On Error Goto ...
793                     pCode = pError;
794                 else
795                     bLetParentHandleThis = true;
796             }
797             else
798             {
799                 bLetParentHandleThis = true;
800                 pError = NULL; //terminate the handler
801             }
802             if ( bLetParentHandleThis )
803             {
804                 // AB 13.2.1997, neues Error-Handling:
805                 // Uebergeordnete Error-Handler beruecksichtigen
806 
807                 // Wir haben keinen Error-Handler -> weiter oben suchen
808                 SbiRuntime* pRtErrHdl = NULL;
809                 SbiRuntime* pRt = this;
810                 while( NULL != (pRt = pRt->pNext) )
811                 {
812                     // Gibt es einen Error-Handler?
813                     if( pRt->bError == sal_False || pRt->pError != NULL )
814                     {
815                         pRtErrHdl = pRt;
816                         break;
817                     }
818                 }
819 
820                 // Error-Hdl gefunden?
821                 if( pRtErrHdl )
822                 {
823                     // (Neuen) Error-Stack anlegen
824                     SbErrorStack*& rErrStack = GetSbData()->pErrStack;
825                     if( rErrStack )
826                         delete rErrStack;
827                     rErrStack = new SbErrorStack();
828 
829                     // Alle im Call-Stack darunter stehenden RTs manipulieren
830                     pRt = this;
831                     do
832                     {
833                         // Fehler setzen
834                         pRt->nError = err;
835                         if( pRt != pRtErrHdl )
836                             pRt->bRun = sal_False;
837 
838                         // In Error-Stack eintragen
839                         SbErrorStackEntry *pEntry = new SbErrorStackEntry
840                             ( pRt->pMeth, pRt->nLine, pRt->nCol1, pRt->nCol2 );
841                         rErrStack->C40_INSERT(SbErrorStackEntry, pEntry, rErrStack->Count() );
842 
843                         // Nach RT mit Error-Handler aufhoeren
844                         if( pRt == pRtErrHdl )
845                             break;
846                            pRt = pRt->pNext;
847                     }
848                     while( pRt );
849                 }
850                 // Kein Error-Hdl gefunden -> altes Vorgehen
851                 else
852                 {
853 #ifdef DBG_TRACE_BASIC
854                     bTraceErrHandled = false;
855 #endif
856                     pInst->Abort();
857                 }
858 
859                 // ALT: Nur
860                 // pInst->Abort();
861             }
862 
863 #ifdef DBG_TRACE_BASIC
864             dbg_traceNotifyError( nTraceErr, aTraceErrMsg, bTraceErrHandled, pINST->nCallLvl );
865 #endif
866         }
867     }
868     return bRun;
869 }
870 
Error(SbError n,bool bVBATranslationAlreadyDone)871 void SbiRuntime::Error( SbError n, bool bVBATranslationAlreadyDone )
872 {
873     if( n )
874     {
875         nError = n;
876         if( isVBAEnabled() && !bVBATranslationAlreadyDone )
877         {
878             String aMsg = pInst->GetErrorMsg();
879             sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
880             SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject();
881             SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
882             if( pGlobErr != NULL )
883                 pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
884 
885             pInst->aErrorMsg = aMsg;
886             nError = SbERR_BASIC_COMPAT;
887         }
888     }
889 }
890 
Error(SbError _errCode,const String & _details)891 void SbiRuntime::Error( SbError _errCode, const String& _details )
892 {
893     if ( _errCode )
894     {
895         // Not correct for class module usage, remove for now
896         //OSL_ENSURE( pInst->pRun == this, "SbiRuntime::Error: can't propagate the error message details!" );
897         if ( pInst->pRun == this )
898         {
899             pInst->Error( _errCode, _details );
900             //OSL_POSTCOND( nError == _errCode, "SbiRuntime::Error: the instance is expecte to propagate the error code back to me!" );
901         }
902         else
903         {
904             nError = _errCode;
905         }
906     }
907 }
908 
FatalError(SbError n)909 void SbiRuntime::FatalError( SbError n )
910 {
911     StepSTDERROR();
912     Error( n );
913 }
914 
FatalError(SbError _errCode,const String & _details)915 void SbiRuntime::FatalError( SbError _errCode, const String& _details )
916 {
917     StepSTDERROR();
918     Error( _errCode, _details );
919 }
920 
translateErrorToVba(SbError nError,String & rMsg)921 sal_Int32 SbiRuntime::translateErrorToVba( SbError nError, String& rMsg )
922 {
923     // If a message is defined use that ( in preference to
924     // the defined one for the error ) NB #TODO
925     // if there is an error defined it more than likely
926     // is not the one you want ( some are the same though )
927     // we really need a new vba compatible error list
928     if ( !rMsg.Len() )
929     {
930         // TEST, has to be vb here always
931 #ifdef DBG_UTIL
932         SbError nTmp = StarBASIC::GetSfxFromVBError( (sal_uInt16)nError );
933         DBG_ASSERT( nTmp, "No VB error!" );
934 #endif
935 
936         StarBASIC::MakeErrorText( nError, rMsg );
937         rMsg = StarBASIC::GetErrorText();
938         if ( !rMsg.Len() ) // no message for err no, need localized resource here
939             rMsg = String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") );
940     }
941     // no num? most likely then it *is* really a vba err
942     sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
943     sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? nError : nVBErrorCode;
944     return nVBAErrorNumber;
945 }
946 
947 //////////////////////////////////////////////////////////////////////////
948 //
949 //  Parameter, Locals, Caller
950 //
951 //////////////////////////////////////////////////////////////////////////
952 
GetCaller()953 SbMethod* SbiRuntime::GetCaller()
954 {
955     return pMeth;
956 }
957 
GetLocals()958 SbxArray* SbiRuntime::GetLocals()
959 {
960     return refLocals;
961 }
962 
GetParams()963 SbxArray* SbiRuntime::GetParams()
964 {
965     return refParams;
966 }
967 
968 //////////////////////////////////////////////////////////////////////////
969 //
970 //  Stacks
971 //
972 //////////////////////////////////////////////////////////////////////////
973 
974 // Der Expression-Stack steht fuer die laufende Auswertung von Expressions
975 // zur Verfuegung.
976 
PushVar(SbxVariable * pVar)977 void SbiRuntime::PushVar( SbxVariable* pVar )
978 {
979     if( pVar )
980         refExprStk->Put( pVar, nExprLvl++ );
981 }
982 
PopVar()983 SbxVariableRef SbiRuntime::PopVar()
984 {
985 #ifdef DBG_UTIL
986     if( !nExprLvl )
987     {
988         StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
989         return new SbxVariable;
990     }
991 #endif
992     SbxVariableRef xVar = refExprStk->Get( --nExprLvl );
993 #ifdef DBG_UTIL
994     if ( xVar->GetName().EqualsAscii( "Cells" ) )
995         DBG_TRACE( "" );
996 #endif
997     // Methods halten im 0.Parameter sich selbst, also weghauen
998     if( xVar->IsA( TYPE(SbxMethod) ) )
999         xVar->SetParameters(0);
1000     return xVar;
1001 }
1002 
ClearExprStack()1003 sal_Bool SbiRuntime::ClearExprStack()
1004 {
1005     // Achtung: Clear() reicht nicht, da Methods geloescht werden muessen
1006     while ( nExprLvl )
1007     {
1008         PopVar();
1009     }
1010     refExprStk->Clear();
1011     return sal_False;
1012 }
1013 
1014 // Variable auf dem Expression-Stack holen, ohne sie zu entfernen
1015 // n zaehlt ab 0.
1016 
GetTOS(short n)1017 SbxVariable* SbiRuntime::GetTOS( short n )
1018 {
1019     n = nExprLvl - n - 1;
1020 #ifdef DBG_UTIL
1021     if( n < 0 )
1022     {
1023         StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1024         return new SbxVariable;
1025     }
1026 #endif
1027     return refExprStk->Get( (sal_uInt16) n );
1028 }
1029 
1030 // Sicherstellen, dass TOS eine temporaere Variable ist
1031 
TOSMakeTemp()1032 void SbiRuntime::TOSMakeTemp()
1033 {
1034     SbxVariable* p = refExprStk->Get( nExprLvl - 1 );
1035     if( p->GetRefCount() != 1 )
1036     {
1037         SbxVariable* pNew = new SbxVariable( *p );
1038         pNew->SetFlag( SBX_READWRITE );
1039         refExprStk->Put( pNew, nExprLvl - 1 );
1040     }
1041 }
1042 
1043 // Der GOSUB-Stack nimmt Returnadressen fuer GOSUBs auf
1044 
PushGosub(const sal_uInt8 * pc)1045 void SbiRuntime::PushGosub( const sal_uInt8* pc )
1046 {
1047     if( ++nGosubLvl > MAXRECURSION )
1048         StarBASIC::FatalError( SbERR_STACK_OVERFLOW );
1049     SbiGosubStack* p = new SbiGosubStack;
1050     p->pCode  = pc;
1051     p->pNext  = pGosubStk;
1052     p->nStartForLvl = nForLvl;
1053     pGosubStk = p;
1054 }
1055 
PopGosub()1056 void SbiRuntime::PopGosub()
1057 {
1058     if( !pGosubStk )
1059         Error( SbERR_NO_GOSUB );
1060     else
1061     {
1062         SbiGosubStack* p = pGosubStk;
1063         pCode = p->pCode;
1064         pGosubStk = p->pNext;
1065         delete p;
1066         nGosubLvl--;
1067     }
1068 }
1069 
1070 // Entleeren des GOSUB-Stacks
1071 
ClearGosubStack()1072 void SbiRuntime::ClearGosubStack()
1073 {
1074     SbiGosubStack* p;
1075     while(( p = pGosubStk ) != NULL )
1076         pGosubStk = p->pNext, delete p;
1077     nGosubLvl = 0;
1078 }
1079 
1080 // Der Argv-Stack nimmt aktuelle Argument-Vektoren auf
1081 
PushArgv()1082 void SbiRuntime::PushArgv()
1083 {
1084     SbiArgvStack* p = new SbiArgvStack;
1085     p->refArgv = refArgv;
1086     p->nArgc = nArgc;
1087     nArgc = 1;
1088     refArgv.Clear();
1089     p->pNext = pArgvStk;
1090     pArgvStk = p;
1091 }
1092 
PopArgv()1093 void SbiRuntime::PopArgv()
1094 {
1095     if( pArgvStk )
1096     {
1097         SbiArgvStack* p = pArgvStk;
1098         pArgvStk = p->pNext;
1099         refArgv = p->refArgv;
1100         nArgc = p->nArgc;
1101         delete p;
1102     }
1103 }
1104 
1105 // Entleeren des Argv-Stacks
1106 
ClearArgvStack()1107 void SbiRuntime::ClearArgvStack()
1108 {
1109     while( pArgvStk )
1110         PopArgv();
1111 }
1112 
1113 // Push des For-Stacks. Der Stack hat Inkrement, Ende, Beginn und Variable.
1114 // Nach Aufbau des Stack-Elements ist der Stack leer.
1115 
PushFor()1116 void SbiRuntime::PushFor()
1117 {
1118     SbiForStack* p = new SbiForStack;
1119     p->eForType = FOR_TO;
1120     p->pNext = pForStk;
1121     pForStk = p;
1122     // Der Stack ist wie folgt aufgebaut:
1123     p->refInc = PopVar();
1124     p->refEnd = PopVar();
1125     SbxVariableRef xBgn = PopVar();
1126     p->refVar = PopVar();
1127     *(p->refVar) = *xBgn;
1128     nForLvl++;
1129 }
1130 
PushForEach()1131 void SbiRuntime::PushForEach()
1132 {
1133     SbiForStack* p = new SbiForStack;
1134     p->pNext = pForStk;
1135     pForStk = p;
1136 
1137     SbxVariableRef xObjVar = PopVar();
1138     SbxBase* pObj = xObjVar.Is() ? xObjVar->GetObject() : NULL;
1139     if( pObj == NULL )
1140     {
1141         Error( SbERR_NO_OBJECT );
1142         return;
1143     }
1144 
1145     bool bError_ = false;
1146     BasicCollection* pCollection;
1147     SbxDimArray* pArray;
1148     SbUnoObject* pUnoObj;
1149     if( (pArray = PTR_CAST(SbxDimArray,pObj)) != NULL )
1150     {
1151         p->eForType = FOR_EACH_ARRAY;
1152         p->refEnd = (SbxVariable*)pArray;
1153 
1154         short nDims = pArray->GetDims();
1155         p->pArrayLowerBounds = new sal_Int32[nDims];
1156         p->pArrayUpperBounds = new sal_Int32[nDims];
1157         p->pArrayCurIndices  = new sal_Int32[nDims];
1158         sal_Int32 lBound, uBound;
1159         for( short i = 0 ; i < nDims ; i++ )
1160         {
1161             pArray->GetDim32( i+1, lBound, uBound );
1162             p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
1163             p->pArrayUpperBounds[i] = uBound;
1164         }
1165     }
1166     else if( (pCollection = PTR_CAST(BasicCollection,pObj)) != NULL )
1167     {
1168         p->eForType = FOR_EACH_COLLECTION;
1169         p->refEnd = pCollection;
1170         p->nCurCollectionIndex = 0;
1171     }
1172     else if( (pUnoObj = PTR_CAST(SbUnoObject,pObj)) != NULL )
1173     {
1174         // XEnumerationAccess?
1175         Any aAny = pUnoObj->getUnoAny();
1176         Reference< XEnumerationAccess > xEnumerationAccess;
1177         if( (aAny >>= xEnumerationAccess) )
1178         {
1179             p->xEnumeration = xEnumerationAccess->createEnumeration();
1180             p->eForType = FOR_EACH_XENUMERATION;
1181         }
1182         else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
1183         {
1184             uno::Reference< script::XInvocation > xInvocation;
1185             if ( ( aAny >>= xInvocation ) && xInvocation.is() )
1186             {
1187                 try
1188                 {
1189                     p->xEnumeration = new ComEnumerationWrapper( xInvocation );
1190                     p->eForType = FOR_EACH_XENUMERATION;
1191                 }
1192                 catch( uno::Exception& )
1193                 {}
1194             }
1195 
1196             if ( !p->xEnumeration.is() )
1197                 bError_ = true;
1198         }
1199         else
1200         {
1201             bError_ = true;
1202         }
1203     }
1204     else
1205     {
1206         bError_ = true;
1207     }
1208 
1209     if( bError_ )
1210     {
1211         Error( SbERR_CONVERSION );
1212         return;
1213     }
1214 
1215     // Container variable
1216     p->refVar = PopVar();
1217     nForLvl++;
1218 }
1219 
1220 // Poppen des FOR-Stacks
1221 
PopFor()1222 void SbiRuntime::PopFor()
1223 {
1224     if( pForStk )
1225     {
1226         SbiForStack* p = pForStk;
1227         pForStk = p->pNext;
1228         delete p;
1229         nForLvl--;
1230     }
1231 }
1232 
1233 // Entleeren des FOR-Stacks
1234 
ClearForStack()1235 void SbiRuntime::ClearForStack()
1236 {
1237     while( pForStk )
1238         PopFor();
1239 }
1240 
FindForStackItemForCollection(class BasicCollection * pCollection)1241 SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection* pCollection )
1242 {
1243     SbiForStack* pRet = NULL;
1244 
1245     SbiForStack* p = pForStk;
1246     while( p )
1247     {
1248         SbxVariable* pVar = p->refEnd.Is() ? (SbxVariable*)p->refEnd : NULL;
1249         if( p->eForType == FOR_EACH_COLLECTION && pVar != NULL &&
1250             (pCollection = PTR_CAST(BasicCollection,pVar)) == pCollection )
1251         {
1252             pRet = p;
1253             break;
1254         }
1255     }
1256 
1257     return pRet;
1258 }
1259 
1260 
1261 //////////////////////////////////////////////////////////////////////////
1262 //
1263 //  DLL-Aufrufe
1264 //
1265 //////////////////////////////////////////////////////////////////////////
1266 
DllCall(const String & aFuncName,const String & aDLLName,SbxArray * pArgs,SbxDataType eResType,sal_Bool bCDecl)1267 void SbiRuntime::DllCall
1268     ( const String& aFuncName,  // Funktionsname
1269       const String& aDLLName,   // Name der DLL
1270       SbxArray* pArgs,          // Parameter (ab Index 1, kann NULL sein)
1271       SbxDataType eResType,     // Returnwert
1272       sal_Bool bCDecl )             // sal_True: nach C-Konventionen
1273 {
1274     // No DllCall for "virtual" portal users
1275     if( needSecurityRestrictions() )
1276     {
1277         StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
1278         return;
1279     }
1280 
1281     // MUSS NOCH IMPLEMENTIERT WERDEN
1282     /*
1283     String aMsg;
1284     aMsg = "FUNC=";
1285     aMsg += pFunc;
1286     aMsg += " DLL=";
1287     aMsg += pDLL;
1288     MessBox( NULL, WB_OK, String( "DLL-CALL" ), aMsg ).Execute();
1289     Error( SbERR_NOT_IMPLEMENTED );
1290     */
1291 
1292     SbxVariable* pRes = new SbxVariable( eResType );
1293     SbiDllMgr* pDllMgr = pInst->GetDllMgr();
1294     SbError nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
1295     if( nErr )
1296         Error( nErr );
1297     PushVar( pRes );
1298 }
1299 
GetImageFlag(sal_uInt16 n) const1300 sal_uInt16 SbiRuntime::GetImageFlag( sal_uInt16 n ) const
1301 {
1302     return pImg->GetFlag( n );
1303 }
1304 
GetBase()1305 sal_uInt16 SbiRuntime::GetBase()
1306 {
1307     return pImg->GetBase();
1308 }
1309