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