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