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