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 <comphelper/string.hxx>
21 : #include <vcl/msgbox.hxx>
22 : #include <tools/fsys.hxx>
23 :
24 : #include "errobject.hxx"
25 : #include "runtime.hxx"
26 : #include "sbintern.hxx"
27 : #include "iosys.hxx"
28 : #include <sb.hrc>
29 : #include <basrid.hxx>
30 : #include "sbunoobj.hxx"
31 : #include "image.hxx"
32 : #include <com/sun/star/uno/Any.hxx>
33 : #include <com/sun/star/util/SearchOptions.hpp>
34 : #include <rtl/instance.hxx>
35 : #include <vcl/svapp.hxx>
36 : #include <unotools/textsearch.hxx>
37 :
38 : Reference< XInterface > createComListener( const Any& aControlAny, const OUString& aVBAType,
39 : const OUString& aPrefix, SbxObjectRef xScopeObj );
40 :
41 : #include <algorithm>
42 : #include <boost/unordered_map.hpp>
43 :
44 : // for a patch forward declaring these methods below makes sense
45 : // but, #FIXME lets really just move the methods to the top
46 : static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType );
47 : static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled );
48 :
49 : SbxVariable* getDefaultProp( SbxVariable* pRef );
50 :
51 0 : void SbiRuntime::StepNOP()
52 0 : {}
53 :
54 3 : void SbiRuntime::StepArith( SbxOperator eOp )
55 : {
56 3 : SbxVariableRef p1 = PopVar();
57 3 : TOSMakeTemp();
58 3 : SbxVariable* p2 = GetTOS();
59 :
60 3 : p2->ResetFlag( SBX_FIXED );
61 3 : p2->Compute( eOp, *p1 );
62 :
63 3 : checkArithmeticOverflow( p2 );
64 3 : }
65 :
66 0 : void SbiRuntime::StepUnary( SbxOperator eOp )
67 : {
68 0 : TOSMakeTemp();
69 0 : SbxVariable* p = GetTOS();
70 0 : p->Compute( eOp, *p );
71 0 : }
72 :
73 2 : void SbiRuntime::StepCompare( SbxOperator eOp )
74 : {
75 2 : SbxVariableRef p1 = PopVar();
76 2 : SbxVariableRef p2 = PopVar();
77 :
78 : // Make sure objects with default params have
79 : // values ( and type ) set as appropriate
80 2 : SbxDataType p1Type = p1->GetType();
81 2 : SbxDataType p2Type = p2->GetType();
82 2 : if ( p1Type == SbxEMPTY )
83 : {
84 0 : p1->Broadcast( SBX_HINT_DATAWANTED );
85 0 : p1Type = p1->GetType();
86 : }
87 2 : if ( p2Type == SbxEMPTY )
88 : {
89 0 : p2->Broadcast( SBX_HINT_DATAWANTED );
90 0 : p2Type = p2->GetType();
91 : }
92 2 : if ( p1Type == p2Type )
93 : {
94 : // if both sides are an object and have default props
95 : // then we need to use the default props
96 : // we don't need to worry if only one side ( lhs, rhs ) is an
97 : // object ( object side will get coerced to correct type in
98 : // Compare )
99 2 : if ( p1Type == SbxOBJECT )
100 : {
101 0 : SbxVariable* pDflt = getDefaultProp( p1 );
102 0 : if ( pDflt )
103 : {
104 0 : p1 = pDflt;
105 0 : p1->Broadcast( SBX_HINT_DATAWANTED );
106 : }
107 0 : pDflt = getDefaultProp( p2 );
108 0 : if ( pDflt )
109 : {
110 0 : p2 = pDflt;
111 0 : p2->Broadcast( SBX_HINT_DATAWANTED );
112 : }
113 : }
114 :
115 : }
116 : static SbxVariable* pTRUE = NULL;
117 : static SbxVariable* pFALSE = NULL;
118 : static SbxVariable* pNULL = NULL;
119 : // why do this on non-windows ?
120 : // why do this at all ?
121 : // I dumbly follow the pattern :-/
122 2 : if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
123 : {
124 0 : if( !pNULL )
125 : {
126 0 : pNULL = new SbxVariable;
127 0 : pNULL->PutNull();
128 0 : pNULL->AddRef();
129 : }
130 0 : PushVar( pNULL );
131 : }
132 2 : else if( p2->Compare( eOp, *p1 ) )
133 : {
134 2 : if( !pTRUE )
135 : {
136 1 : pTRUE = new SbxVariable;
137 1 : pTRUE->PutBool( sal_True );
138 1 : pTRUE->AddRef();
139 : }
140 2 : PushVar( pTRUE );
141 : }
142 : else
143 : {
144 0 : if( !pFALSE )
145 : {
146 0 : pFALSE = new SbxVariable;
147 0 : pFALSE->PutBool( sal_False );
148 0 : pFALSE->AddRef();
149 : }
150 0 : PushVar( pFALSE );
151 2 : }
152 2 : }
153 :
154 0 : void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
155 0 : void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
156 0 : void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
157 0 : void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
158 0 : void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
159 3 : void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
160 0 : void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
161 0 : void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
162 0 : void SbiRuntime::StepAND() { StepArith( SbxAND ); }
163 0 : void SbiRuntime::StepOR() { StepArith( SbxOR ); }
164 0 : void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
165 0 : void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
166 0 : void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
167 :
168 0 : void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
169 0 : void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
170 :
171 2 : void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
172 0 : void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
173 0 : void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
174 0 : void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
175 0 : void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
176 0 : void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
177 :
178 : namespace
179 : {
180 0 : bool NeedEsc(sal_Unicode cCode)
181 : {
182 0 : if((cCode & 0xFF80))
183 : {
184 0 : return false;
185 : }
186 0 : switch((sal_uInt8)(cCode & 0x07F))
187 : {
188 : case '.':
189 : case '^':
190 : case '$':
191 : case '+':
192 : case '\\':
193 : case '|':
194 : case '{':
195 : case '}':
196 : case '(':
197 : case ')':
198 0 : return true;
199 : default:
200 0 : return false;
201 : }
202 : }
203 :
204 0 : OUString VBALikeToRegexp(const OUString &rIn)
205 : {
206 0 : OUStringBuffer sResult;
207 0 : const sal_Unicode *start = rIn.getStr();
208 0 : const sal_Unicode *end = start + rIn.getLength();
209 :
210 0 : int seenright = 0;
211 :
212 0 : sResult.append('^');
213 :
214 0 : while (start < end)
215 : {
216 0 : switch (*start)
217 : {
218 : case '?':
219 0 : sResult.append('.');
220 0 : start++;
221 0 : break;
222 : case '*':
223 0 : sResult.append(".*");
224 0 : start++;
225 0 : break;
226 : case '#':
227 0 : sResult.append("[0-9]");
228 0 : start++;
229 0 : break;
230 : case ']':
231 0 : sResult.append('\\');
232 0 : sResult.append(*start++);
233 0 : break;
234 : case '[':
235 0 : sResult.append(*start++);
236 0 : seenright = 0;
237 0 : while (start < end && !seenright)
238 : {
239 0 : switch (*start)
240 : {
241 : case '[':
242 : case '?':
243 : case '*':
244 0 : sResult.append('\\');
245 0 : sResult.append(*start);
246 0 : break;
247 : case ']':
248 0 : sResult.append(*start);
249 0 : seenright = 1;
250 0 : break;
251 : case '!':
252 0 : sResult.append('^');
253 0 : break;
254 : default:
255 0 : if (NeedEsc(*start))
256 : {
257 0 : sResult.append('\\');
258 : }
259 0 : sResult.append(*start);
260 0 : break;
261 : }
262 0 : start++;
263 : }
264 0 : break;
265 : default:
266 0 : if (NeedEsc(*start))
267 : {
268 0 : sResult.append('\\');
269 : }
270 0 : sResult.append(*start++);
271 : }
272 : }
273 :
274 0 : sResult.append('$');
275 :
276 0 : return sResult.makeStringAndClear();
277 : }
278 : }
279 :
280 0 : void SbiRuntime::StepLIKE()
281 : {
282 0 : SbxVariableRef refVar1 = PopVar();
283 0 : SbxVariableRef refVar2 = PopVar();
284 :
285 0 : OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
286 0 : OUString value = refVar2->GetOUString();
287 :
288 0 : com::sun::star::util::SearchOptions aSearchOpt;
289 :
290 0 : aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
291 :
292 0 : aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
293 0 : aSearchOpt.searchString = pattern;
294 :
295 0 : int bTextMode(1);
296 0 : bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
297 0 : if( bCompatibility )
298 : {
299 0 : bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
300 : }
301 0 : if( bTextMode )
302 : {
303 0 : aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
304 : }
305 0 : SbxVariable* pRes = new SbxVariable;
306 0 : utl::TextSearch aSearch(aSearchOpt);
307 0 : sal_uInt16 nStart=0, nEnd=value.getLength();
308 0 : int bRes = aSearch.SearchFrwrd(value, &nStart, &nEnd);
309 0 : pRes->PutBool( bRes != 0 );
310 :
311 0 : PushVar( pRes );
312 0 : }
313 :
314 : // TOS and TOS-1 are both object variables and contain the same pointer
315 :
316 0 : void SbiRuntime::StepIS()
317 : {
318 0 : SbxVariableRef refVar1 = PopVar();
319 0 : SbxVariableRef refVar2 = PopVar();
320 :
321 0 : SbxDataType eType1 = refVar1->GetType();
322 0 : SbxDataType eType2 = refVar2->GetType();
323 0 : if ( eType1 == SbxEMPTY )
324 : {
325 0 : refVar1->Broadcast( SBX_HINT_DATAWANTED );
326 0 : eType1 = refVar1->GetType();
327 : }
328 0 : if ( eType2 == SbxEMPTY )
329 : {
330 0 : refVar2->Broadcast( SBX_HINT_DATAWANTED );
331 0 : eType2 = refVar2->GetType();
332 : }
333 :
334 0 : sal_Bool bRes = sal_Bool( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
335 0 : if ( bVBAEnabled && !bRes )
336 : {
337 0 : Error( SbERR_INVALID_USAGE_OBJECT );
338 : }
339 0 : bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
340 0 : SbxVariable* pRes = new SbxVariable;
341 0 : pRes->PutBool( bRes );
342 0 : PushVar( pRes );
343 0 : }
344 :
345 : // update the value of TOS
346 :
347 0 : void SbiRuntime::StepGET()
348 : {
349 0 : SbxVariable* p = GetTOS();
350 0 : p->Broadcast( SBX_HINT_DATAWANTED );
351 0 : }
352 :
353 : // #67607 copy Uno-Structs
354 31 : inline bool checkUnoStructCopy( bool bVBA, SbxVariableRef& refVal, SbxVariableRef& refVar )
355 : {
356 31 : SbxDataType eVarType = refVar->GetType();
357 31 : SbxDataType eValType = refVal->GetType();
358 :
359 31 : if ( !( !bVBA|| ( bVBA && refVar->GetType() != SbxEMPTY ) ) || !refVar->CanWrite() )
360 0 : return false;
361 :
362 31 : if ( eValType != SbxOBJECT )
363 19 : return false;
364 : // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
365 : // there :-/ not sure if for every '=' we would want struct handling
366 12 : if( eVarType != SbxOBJECT )
367 : {
368 1 : if ( refVar->IsFixed() )
369 0 : return false;
370 : }
371 : // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
372 11 : else if( refVar->ISA(SbProcedureProperty) )
373 0 : return false;
374 :
375 12 : SbxObjectRef xValObj = (SbxObject*)refVal->GetObject();
376 12 : if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
377 0 : return false;
378 :
379 12 : SbUnoObject* pUnoVal = PTR_CAST(SbUnoObject,(SbxObject*)xValObj);
380 12 : SbUnoStructRefObject* pUnoStructVal = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xValObj);
381 12 : Any aAny;
382 : // make doubly sure value is either an Uno object or
383 : // an uno struct
384 12 : if ( pUnoVal || pUnoStructVal )
385 12 : aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
386 : else
387 0 : return false;
388 12 : if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
389 : {
390 12 : refVar->SetType( SbxOBJECT );
391 12 : SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject();
392 12 : SbUnoStructRefObject* pUnoStructObj = PTR_CAST(SbUnoStructRefObject,(SbxObject*)xVarObj);
393 :
394 12 : if ( ( !pUnoVal && !pUnoStructVal ) )
395 0 : return false;
396 :
397 12 : OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
398 12 : OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
399 :
400 12 : if ( pUnoStructObj )
401 : {
402 3 : StructRefInfo aInfo = pUnoStructObj->getStructInfo();
403 3 : aInfo.setValue( aAny );
404 : }
405 : else
406 : {
407 9 : SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
408 : // #70324: adopt ClassName
409 9 : pNewUnoObj->SetClassName( sClassName );
410 9 : refVar->PutObject( pNewUnoObj );
411 : }
412 12 : return true;
413 : }
414 0 : return false;
415 : }
416 :
417 :
418 : // laying down TOS in TOS-1
419 :
420 23 : void SbiRuntime::StepPUT()
421 : {
422 23 : SbxVariableRef refVal = PopVar();
423 23 : SbxVariableRef refVar = PopVar();
424 : // store on its own method (inside a function)?
425 23 : bool bFlagsChanged = false;
426 23 : sal_uInt16 n = 0;
427 23 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
428 : {
429 7 : bFlagsChanged = true;
430 7 : n = refVar->GetFlags();
431 7 : refVar->SetFlag( SBX_WRITE );
432 : }
433 :
434 : // if left side arg is an object or variant and right handside isn't
435 : // either an object or a variant then try and see if a default
436 : // property exists.
437 : // to use e.g. Range{"A1") = 34
438 : // could equate to Range("A1").Value = 34
439 23 : if ( bVBAEnabled )
440 : {
441 0 : if ( refVar->GetType() == SbxOBJECT )
442 : {
443 0 : SbxVariable* pDflt = getDefaultProp( refVar );
444 0 : if ( pDflt )
445 0 : refVar = pDflt;
446 : }
447 0 : if ( refVal->GetType() == SbxOBJECT )
448 : {
449 0 : SbxVariable* pDflt = getDefaultProp( refVal );
450 0 : if ( pDflt )
451 0 : refVal = pDflt;
452 : }
453 : }
454 :
455 23 : if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
456 19 : *refVar = *refVal;
457 :
458 23 : if( bFlagsChanged )
459 7 : refVar->SetFlags( n );
460 23 : }
461 :
462 :
463 : // VBA Dim As New behavior handling, save init object information
464 0 : struct DimAsNewRecoverItem
465 : {
466 : OUString m_aObjClass;
467 : OUString m_aObjName;
468 : SbxObject* m_pObjParent;
469 : SbModule* m_pClassModule;
470 :
471 0 : DimAsNewRecoverItem( void )
472 : : m_pObjParent( NULL )
473 0 : , m_pClassModule( NULL )
474 0 : {}
475 :
476 0 : DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
477 : SbxObject* pObjParent, SbModule* pClassModule )
478 : : m_aObjClass( rObjClass )
479 : , m_aObjName( rObjName )
480 : , m_pObjParent( pObjParent )
481 0 : , m_pClassModule( pClassModule )
482 0 : {}
483 :
484 : };
485 :
486 :
487 : struct SbxVariablePtrHash
488 : {
489 0 : size_t operator()( SbxVariable* pVar ) const
490 0 : { return (size_t)pVar; }
491 : };
492 :
493 : typedef boost::unordered_map< SbxVariable*, DimAsNewRecoverItem,
494 : SbxVariablePtrHash > DimAsNewRecoverHash;
495 :
496 : class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
497 :
498 0 : void removeDimAsNewRecoverItem( SbxVariable* pVar )
499 : {
500 0 : DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
501 0 : DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
502 0 : if( it != rDimAsNewRecoverHash.end() )
503 : {
504 0 : rDimAsNewRecoverHash.erase( it );
505 : }
506 0 : }
507 :
508 :
509 : // saving object variable
510 : // not-object variables will cause errors
511 :
512 : static const char pCollectionStr[] = "Collection";
513 :
514 8 : void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
515 : {
516 : // #67733 types with array-flag are OK too
517 :
518 : // Check var, !object is no error for sure if, only if type is fixed
519 8 : SbxDataType eVarType = refVar->GetType();
520 8 : if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
521 : {
522 0 : Error( SbERR_INVALID_USAGE_OBJECT );
523 0 : return;
524 : }
525 :
526 : // Check value, !object is no error for sure if, only if type is fixed
527 8 : SbxDataType eValType = refVal->GetType();
528 8 : if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
529 : {
530 0 : Error( SbERR_INVALID_USAGE_OBJECT );
531 0 : return;
532 : }
533 :
534 : // Getting in here causes problems with objects with default properties
535 : // if they are SbxEMPTY I guess
536 8 : if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
537 : {
538 : // activate GetOject for collections on refVal
539 8 : SbxBase* pObjVarObj = refVal->GetObject();
540 8 : if( pObjVarObj )
541 : {
542 8 : SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
543 :
544 8 : if( refObjVal )
545 : {
546 8 : refVal = refObjVal;
547 : }
548 0 : else if( !(eValType & SbxARRAY) )
549 : {
550 0 : refVal = NULL;
551 8 : }
552 : }
553 : }
554 :
555 : // #52896 refVal can be invalid here, if uno-sequences - or more
556 : // general arrays - are assigned to variables that are declared
557 : // as an object!
558 8 : if( !refVal )
559 : {
560 0 : Error( SbERR_INVALID_USAGE_OBJECT );
561 : }
562 : else
563 : {
564 8 : bool bFlagsChanged = false;
565 8 : sal_uInt16 n = 0;
566 8 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
567 : {
568 0 : bFlagsChanged = true;
569 0 : n = refVar->GetFlags();
570 0 : refVar->SetFlag( SBX_WRITE );
571 : }
572 8 : SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
573 8 : if( pProcProperty )
574 : {
575 0 : pProcProperty->setSet( true );
576 : }
577 8 : if ( bHandleDefaultProp )
578 : {
579 : // get default properties for lhs & rhs where necessary
580 : // SbxVariable* defaultProp = NULL; unused variable
581 2 : bool bLHSHasDefaultProp = false;
582 : // LHS try determine if a default prop exists
583 2 : if ( refVar->GetType() == SbxOBJECT )
584 : {
585 2 : SbxVariable* pDflt = getDefaultProp( refVar );
586 2 : if ( pDflt )
587 : {
588 0 : refVar = pDflt;
589 0 : bLHSHasDefaultProp = true;
590 : }
591 : }
592 : // RHS only get a default prop is the rhs has one
593 2 : if ( refVal->GetType() == SbxOBJECT )
594 : {
595 : // check if lhs is a null object
596 : // if it is then use the object not the default property
597 2 : SbxObject* pObj = NULL;
598 :
599 :
600 2 : pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
601 :
602 : // calling GetObject on a SbxEMPTY variable raises
603 : // object not set errors, make sure its an Object
604 2 : if ( !pObj && refVar->GetType() == SbxOBJECT )
605 : {
606 2 : SbxBase* pObjVarObj = refVar->GetObject();
607 2 : pObj = PTR_CAST(SbxObject,pObjVarObj);
608 : }
609 2 : SbxVariable* pDflt = NULL;
610 2 : if ( pObj || bLHSHasDefaultProp )
611 : {
612 : // lhs is either a valid object || or has a defaultProp
613 2 : pDflt = getDefaultProp( refVal );
614 : }
615 2 : if ( pDflt )
616 : {
617 0 : refVal = pDflt;
618 : }
619 : }
620 : }
621 :
622 : // Handle Dim As New
623 8 : bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
624 8 : SbxBaseRef xPrevVarObj;
625 8 : if( bDimAsNew )
626 : {
627 0 : xPrevVarObj = refVar->GetObject();
628 : }
629 : // Handle withevents
630 8 : sal_Bool bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
631 8 : if ( bWithEvents )
632 : {
633 0 : Reference< XInterface > xComListener;
634 :
635 0 : SbxBase* pObj = refVal->GetObject();
636 0 : SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
637 0 : if( pUnoObj != NULL )
638 : {
639 0 : Any aControlAny = pUnoObj->getUnoAny();
640 0 : OUString aDeclareClassName = refVar->GetDeclareClassName();
641 0 : OUString aVBAType = aDeclareClassName;
642 0 : OUString aPrefix = refVar->GetName();
643 0 : SbxObjectRef xScopeObj = refVar->GetParent();
644 0 : xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
645 :
646 0 : refVal->SetDeclareClassName( aDeclareClassName );
647 0 : refVal->SetComListener( xComListener, &rBasic ); // Hold reference
648 0 : }
649 :
650 : }
651 :
652 : // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
653 : // in this case if there is a default prop involved the value of the
654 : // default property may infact be void so the type will also be SbxEMPTY
655 : // in this case we do not want to call checkUnoStructCopy 'cause that will
656 : // cause an error also
657 8 : if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
658 : {
659 0 : *refVar = *refVal;
660 : }
661 8 : if ( bDimAsNew )
662 : {
663 0 : if( !refVar->ISA(SbxObject) )
664 : {
665 0 : SbxBase* pValObjBase = refVal->GetObject();
666 0 : if( pValObjBase == NULL )
667 : {
668 0 : if( xPrevVarObj.Is() )
669 : {
670 : // Object is overwritten with NULL, instantiate init object
671 0 : DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
672 0 : DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar );
673 0 : if( it != rDimAsNewRecoverHash.end() )
674 : {
675 0 : const DimAsNewRecoverItem& rItem = it->second;
676 0 : if( rItem.m_pClassModule != NULL )
677 : {
678 0 : SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
679 0 : pNewObj->SetName( rItem.m_aObjName );
680 0 : pNewObj->SetParent( rItem.m_pObjParent );
681 0 : refVar->PutObject( pNewObj );
682 : }
683 0 : else if( rItem.m_aObjClass.equalsIgnoreAsciiCaseAscii( pCollectionStr ) )
684 : {
685 0 : BasicCollection* pNewCollection = new BasicCollection( OUString(pCollectionStr) );
686 0 : pNewCollection->SetName( rItem.m_aObjName );
687 0 : pNewCollection->SetParent( rItem.m_pObjParent );
688 0 : refVar->PutObject( pNewCollection );
689 : }
690 : }
691 : }
692 : }
693 : else
694 : {
695 : // Does old value exist?
696 0 : bool bFirstInit = !xPrevVarObj.Is();
697 0 : if( bFirstInit )
698 : {
699 : // Store information to instantiate object later
700 0 : SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
701 0 : if( pValObj != NULL )
702 : {
703 0 : OUString aObjClass = pValObj->GetClassName();
704 :
705 0 : SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
706 0 : DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
707 0 : if( pClassModuleObj != NULL )
708 : {
709 0 : SbModule* pClassModule = pClassModuleObj->getClassModule();
710 0 : rDimAsNewRecoverHash[refVar] =
711 0 : DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
712 : }
713 0 : else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
714 : {
715 0 : rDimAsNewRecoverHash[refVar] =
716 0 : DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
717 0 : }
718 : }
719 : }
720 : }
721 : }
722 : }
723 :
724 8 : if( bFlagsChanged )
725 : {
726 0 : refVar->SetFlags( n );
727 8 : }
728 : }
729 : }
730 :
731 6 : void SbiRuntime::StepSET()
732 : {
733 6 : SbxVariableRef refVal = PopVar();
734 6 : SbxVariableRef refVar = PopVar();
735 6 : StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
736 6 : }
737 :
738 0 : void SbiRuntime::StepVBASET()
739 : {
740 0 : SbxVariableRef refVal = PopVar();
741 0 : SbxVariableRef refVar = PopVar();
742 : // don't handle default property
743 0 : StepSET_Impl( refVal, refVar, false ); // set obj = something
744 0 : }
745 :
746 :
747 0 : void SbiRuntime::StepLSET()
748 : {
749 0 : SbxVariableRef refVal = PopVar();
750 0 : SbxVariableRef refVar = PopVar();
751 0 : if( refVar->GetType() != SbxSTRING ||
752 0 : refVal->GetType() != SbxSTRING )
753 : {
754 0 : Error( SbERR_INVALID_USAGE_OBJECT );
755 : }
756 : else
757 : {
758 0 : sal_uInt16 n = refVar->GetFlags();
759 0 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
760 : {
761 0 : refVar->SetFlag( SBX_WRITE );
762 : }
763 0 : OUString aRefVarString = refVar->GetOUString();
764 0 : OUString aRefValString = refVal->GetOUString();
765 :
766 0 : sal_Int32 nVarStrLen = aRefVarString.getLength();
767 0 : sal_Int32 nValStrLen = aRefValString.getLength();
768 0 : OUStringBuffer aNewStr;
769 0 : if( nVarStrLen > nValStrLen )
770 : {
771 0 : aNewStr.append(aRefValString);
772 0 : comphelper::string::padToLength(aNewStr, nVarStrLen, ' ');
773 : }
774 : else
775 : {
776 0 : aNewStr = aRefValString.copy( 0, nVarStrLen );
777 : }
778 :
779 0 : refVar->PutString(aNewStr.makeStringAndClear());
780 0 : refVar->SetFlags( n );
781 0 : }
782 0 : }
783 :
784 0 : void SbiRuntime::StepRSET()
785 : {
786 0 : SbxVariableRef refVal = PopVar();
787 0 : SbxVariableRef refVar = PopVar();
788 0 : if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
789 : {
790 0 : Error( SbERR_INVALID_USAGE_OBJECT );
791 : }
792 : else
793 : {
794 0 : sal_uInt16 n = refVar->GetFlags();
795 0 : if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
796 : {
797 0 : refVar->SetFlag( SBX_WRITE );
798 : }
799 0 : OUString aRefVarString = refVar->GetOUString();
800 0 : OUString aRefValString = refVal->GetOUString();
801 0 : sal_Int32 nVarStrLen = aRefVarString.getLength();
802 0 : sal_Int32 nValStrLen = aRefValString.getLength();
803 :
804 0 : OUStringBuffer aNewStr(nVarStrLen);
805 0 : if (nVarStrLen > nValStrLen)
806 : {
807 0 : comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
808 0 : aNewStr.append(aRefValString);
809 : }
810 : else
811 : {
812 0 : aNewStr.append(aRefValString.copy(0, nVarStrLen));
813 : }
814 0 : refVar->PutString(aNewStr.makeStringAndClear());
815 :
816 0 : refVar->SetFlags( n );
817 0 : }
818 0 : }
819 :
820 : // laying down TOS in TOS-1, then set ReadOnly-Bit
821 :
822 0 : void SbiRuntime::StepPUTC()
823 : {
824 0 : SbxVariableRef refVal = PopVar();
825 0 : SbxVariableRef refVar = PopVar();
826 0 : refVar->SetFlag( SBX_WRITE );
827 0 : *refVar = *refVal;
828 0 : refVar->ResetFlag( SBX_WRITE );
829 0 : refVar->SetFlag( SBX_CONST );
830 0 : }
831 :
832 : // DIM
833 : // TOS = variable for the array with dimension information as parameter
834 :
835 0 : void SbiRuntime::StepDIM()
836 : {
837 0 : SbxVariableRef refVar = PopVar();
838 0 : DimImpl( refVar );
839 0 : }
840 :
841 : // #56204 swap out DIM-functionality into a help method (step0.cxx)
842 0 : void SbiRuntime::DimImpl( SbxVariableRef refVar )
843 : {
844 : // If refDim then this DIM statement is terminating a ReDIM and
845 : // previous StepERASE_CLEAR for an array, the following actions have
846 : // been delayed from ( StepERASE_CLEAR ) 'till here
847 0 : if ( refRedim )
848 : {
849 0 : if ( !refRedimpArray ) // only erase the array not ReDim Preserve
850 : {
851 0 : lcl_eraseImpl( refVar, bVBAEnabled );
852 : }
853 0 : SbxDataType eType = refVar->GetType();
854 0 : lcl_clearImpl( refVar, eType );
855 0 : refRedim = NULL;
856 : }
857 0 : SbxArray* pDims = refVar->GetParameters();
858 : // must have an even number of arguments
859 : // have in mind that Arg[0] does not count!
860 0 : if( pDims && !( pDims->Count() & 1 ) )
861 : {
862 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
863 : }
864 : else
865 : {
866 0 : SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
867 0 : SbxDimArray* pArray = new SbxDimArray( eType );
868 : // allow arrays without dimension information, too (VB-compatible)
869 0 : if( pDims )
870 : {
871 0 : refVar->ResetFlag( SBX_VAR_TO_DIM );
872 :
873 0 : for( sal_uInt16 i = 1; i < pDims->Count(); )
874 : {
875 0 : sal_Int32 lb = pDims->Get( i++ )->GetLong();
876 0 : sal_Int32 ub = pDims->Get( i++ )->GetLong();
877 0 : if( ub < lb )
878 : {
879 0 : Error( SbERR_OUT_OF_RANGE ), ub = lb;
880 : }
881 0 : pArray->AddDim32( lb, ub );
882 0 : if ( lb != ub )
883 : {
884 0 : pArray->setHasFixedSize( true );
885 : }
886 : }
887 : }
888 : else
889 : {
890 : // #62867 On creating an array of the length 0, create
891 : // a dimension (like for Uno-Sequences of the length 0)
892 0 : pArray->unoAddDim( 0, -1 );
893 : }
894 0 : sal_uInt16 nSavFlags = refVar->GetFlags();
895 0 : refVar->ResetFlag( SBX_FIXED );
896 0 : refVar->PutObject( pArray );
897 0 : refVar->SetFlags( nSavFlags );
898 0 : refVar->SetParameters( NULL );
899 : }
900 0 : }
901 :
902 : // REDIM
903 : // TOS = variable for the array
904 : // argv = dimension information
905 :
906 0 : void SbiRuntime::StepREDIM()
907 : {
908 : // Nothing different than dim at the moment because
909 : // a double dim is already recognized by the compiler.
910 0 : StepDIM();
911 0 : }
912 :
913 :
914 : // Helper function for StepREDIMP
915 0 : void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
916 : short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
917 : {
918 0 : sal_Int32& ri = pActualIndices[nActualDim];
919 0 : for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
920 : {
921 0 : if( nActualDim < nMaxDimIndex )
922 : {
923 : implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
924 0 : pActualIndices, pLowerBounds, pUpperBounds );
925 : }
926 : else
927 : {
928 0 : SbxVariable* pSource = pOldArray->Get32( pActualIndices );
929 0 : SbxVariable* pDest = pNewArray->Get32( pActualIndices );
930 0 : if( pSource && pDest )
931 : {
932 0 : *pDest = *pSource;
933 : }
934 : }
935 : }
936 0 : }
937 :
938 : // REDIM PRESERVE
939 : // TOS = variable for the array
940 : // argv = dimension information
941 :
942 0 : void SbiRuntime::StepREDIMP()
943 : {
944 0 : SbxVariableRef refVar = PopVar();
945 0 : DimImpl( refVar );
946 :
947 : // Now check, if we can copy from the old array
948 0 : if( refRedimpArray.Is() )
949 : {
950 0 : SbxBase* pElemObj = refVar->GetObject();
951 0 : SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
952 0 : SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
953 0 : if( pNewArray )
954 : {
955 0 : short nDimsNew = pNewArray->GetDims();
956 0 : short nDimsOld = pOldArray->GetDims();
957 0 : short nDims = nDimsNew;
958 0 : bool bRangeError = false;
959 :
960 : // Store dims to use them for copying later
961 0 : sal_Int32* pLowerBounds = new sal_Int32[nDims];
962 0 : sal_Int32* pUpperBounds = new sal_Int32[nDims];
963 0 : sal_Int32* pActualIndices = new sal_Int32[nDims];
964 :
965 0 : if( nDimsOld != nDimsNew )
966 : {
967 0 : bRangeError = true;
968 : }
969 : else
970 : {
971 : // Compare bounds
972 0 : for( short i = 1 ; i <= nDims ; i++ )
973 : {
974 : sal_Int32 lBoundNew, uBoundNew;
975 : sal_Int32 lBoundOld, uBoundOld;
976 0 : pNewArray->GetDim32( i, lBoundNew, uBoundNew );
977 0 : pOldArray->GetDim32( i, lBoundOld, uBoundOld );
978 0 : lBoundNew = std::max( lBoundNew, lBoundOld );
979 0 : uBoundNew = std::min( uBoundNew, uBoundOld );
980 0 : short j = i - 1;
981 0 : pActualIndices[j] = pLowerBounds[j] = lBoundNew;
982 0 : pUpperBounds[j] = uBoundNew;
983 : }
984 : }
985 :
986 0 : if( bRangeError )
987 : {
988 0 : StarBASIC::Error( SbERR_OUT_OF_RANGE );
989 : }
990 : else
991 : {
992 : // Copy data from old array by going recursively through all dimensions
993 : // (It would be faster to work on the flat internal data array of an
994 : // SbyArray but this solution is clearer and easier)
995 : implCopyDimArray( pNewArray, pOldArray, nDims - 1,
996 0 : 0, pActualIndices, pLowerBounds, pUpperBounds );
997 : }
998 :
999 0 : delete[] pUpperBounds;
1000 0 : delete[] pLowerBounds;
1001 0 : delete[] pActualIndices;
1002 0 : refRedimpArray = NULL;
1003 : }
1004 0 : }
1005 :
1006 0 : }
1007 :
1008 : // REDIM_COPY
1009 : // TOS = Array-Variable, Reference to array is copied
1010 : // Variable is cleared as in ERASE
1011 :
1012 0 : void SbiRuntime::StepREDIMP_ERASE()
1013 : {
1014 0 : SbxVariableRef refVar = PopVar();
1015 0 : refRedim = refVar;
1016 0 : SbxDataType eType = refVar->GetType();
1017 0 : if( eType & SbxARRAY )
1018 : {
1019 0 : SbxBase* pElemObj = refVar->GetObject();
1020 0 : SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
1021 0 : if( pDimArray )
1022 : {
1023 0 : refRedimpArray = pDimArray;
1024 : }
1025 :
1026 : }
1027 0 : else if( refVar->IsFixed() )
1028 : {
1029 0 : refVar->Clear();
1030 : }
1031 : else
1032 : {
1033 0 : refVar->SetType( SbxEMPTY );
1034 0 : }
1035 0 : }
1036 :
1037 0 : static void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
1038 : {
1039 0 : sal_uInt16 nSavFlags = refVar->GetFlags();
1040 0 : refVar->ResetFlag( SBX_FIXED );
1041 0 : refVar->SetType( SbxDataType(eType & 0x0FFF) );
1042 0 : refVar->SetFlags( nSavFlags );
1043 0 : refVar->Clear();
1044 0 : }
1045 :
1046 0 : static void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
1047 : {
1048 0 : SbxDataType eType = refVar->GetType();
1049 0 : if( eType & SbxARRAY )
1050 : {
1051 0 : if ( bVBAEnabled )
1052 : {
1053 0 : SbxBase* pElemObj = refVar->GetObject();
1054 0 : SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
1055 0 : bool bClearValues = true;
1056 0 : if( pDimArray )
1057 : {
1058 0 : if ( pDimArray->hasFixedSize() )
1059 : {
1060 : // Clear all Value(s)
1061 0 : pDimArray->SbxArray::Clear();
1062 0 : bClearValues = false;
1063 : }
1064 : else
1065 : {
1066 0 : pDimArray->Clear(); // clear Dims
1067 : }
1068 : }
1069 0 : if ( bClearValues )
1070 : {
1071 0 : SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
1072 0 : if ( pArray )
1073 : {
1074 0 : pArray->Clear();
1075 : }
1076 : }
1077 : }
1078 : else
1079 : {
1080 : // Arrays have on an erase to VB quite a complex behaviour. Here are
1081 : // only the type problems at REDIM (#26295) removed at first:
1082 : // Set type hard onto the array-type, because a variable with array is
1083 : // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
1084 : // the original type is lost -> runtime error
1085 0 : lcl_clearImpl( refVar, eType );
1086 : }
1087 : }
1088 0 : else if( refVar->IsFixed() )
1089 : {
1090 0 : refVar->Clear();
1091 : }
1092 : else
1093 : {
1094 0 : refVar->SetType( SbxEMPTY );
1095 : }
1096 0 : }
1097 :
1098 : // delete variable
1099 : // TOS = variable
1100 :
1101 0 : void SbiRuntime::StepERASE()
1102 : {
1103 0 : SbxVariableRef refVar = PopVar();
1104 0 : lcl_eraseImpl( refVar, bVBAEnabled );
1105 0 : }
1106 :
1107 0 : void SbiRuntime::StepERASE_CLEAR()
1108 : {
1109 0 : refRedim = PopVar();
1110 0 : }
1111 :
1112 0 : void SbiRuntime::StepARRAYACCESS()
1113 : {
1114 0 : if( !refArgv )
1115 : {
1116 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1117 : }
1118 0 : SbxVariableRef refVar = PopVar();
1119 0 : refVar->SetParameters( refArgv );
1120 0 : PopArgv();
1121 0 : PushVar( CheckArray( refVar ) );
1122 0 : }
1123 :
1124 0 : void SbiRuntime::StepBYVAL()
1125 : {
1126 : // Copy variable on stack to break call by reference
1127 0 : SbxVariableRef pVar = PopVar();
1128 0 : SbxDataType t = pVar->GetType();
1129 :
1130 0 : SbxVariable* pCopyVar = new SbxVariable( t );
1131 0 : pCopyVar->SetFlag( SBX_READWRITE );
1132 0 : *pCopyVar = *pVar;
1133 :
1134 0 : PushVar( pCopyVar );
1135 0 : }
1136 :
1137 : // establishing an argv
1138 : // nOp1 stays as it is -> 1st element is the return value
1139 :
1140 2 : void SbiRuntime::StepARGC()
1141 : {
1142 2 : PushArgv();
1143 2 : refArgv = new SbxArray;
1144 2 : nArgc = 1;
1145 2 : }
1146 :
1147 : // storing an argument in Argv
1148 :
1149 4 : void SbiRuntime::StepARGV()
1150 : {
1151 4 : if( !refArgv )
1152 : {
1153 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1154 : }
1155 : else
1156 : {
1157 4 : SbxVariableRef pVal = PopVar();
1158 :
1159 : // Before fix of #94916:
1160 4 : if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
1161 : {
1162 : // evaluate methods and properties!
1163 0 : SbxVariable* pRes = new SbxVariable( *pVal );
1164 0 : pVal = pRes;
1165 : }
1166 4 : refArgv->Put( pVal, nArgc++ );
1167 : }
1168 4 : }
1169 :
1170 : // Input to Variable. The variable is on TOS and is
1171 : // is removed afterwards.
1172 0 : void SbiRuntime::StepINPUT()
1173 : {
1174 0 : OUStringBuffer sin;
1175 0 : OUString s;
1176 0 : char ch = 0;
1177 : SbError err;
1178 : // Skip whitespace
1179 0 : while( ( err = pIosys->GetError() ) == 0 )
1180 : {
1181 0 : ch = pIosys->Read();
1182 0 : if( ch != ' ' && ch != '\t' && ch != '\n' )
1183 : {
1184 0 : break;
1185 : }
1186 : }
1187 0 : if( !err )
1188 : {
1189 : // Scan until comma or whitespace
1190 0 : char sep = ( ch == '"' ) ? ch : 0;
1191 0 : if( sep )
1192 : {
1193 0 : ch = pIosys->Read();
1194 : }
1195 0 : while( ( err = pIosys->GetError() ) == 0 )
1196 : {
1197 0 : if( ch == sep )
1198 : {
1199 0 : ch = pIosys->Read();
1200 0 : if( ch != sep )
1201 : {
1202 0 : break;
1203 : }
1204 : }
1205 0 : else if( !sep && (ch == ',' || ch == '\n') )
1206 : {
1207 0 : break;
1208 : }
1209 0 : sin.append( ch );
1210 0 : ch = pIosys->Read();
1211 : }
1212 : // skip whitespace
1213 0 : if( ch == ' ' || ch == '\t' )
1214 : {
1215 0 : while( ( err = pIosys->GetError() ) == 0 )
1216 : {
1217 0 : if( ch != ' ' && ch != '\t' && ch != '\n' )
1218 : {
1219 0 : break;
1220 : }
1221 0 : ch = pIosys->Read();
1222 : }
1223 : }
1224 : }
1225 0 : if( !err )
1226 : {
1227 0 : s = sin.makeStringAndClear();
1228 0 : SbxVariableRef pVar = GetTOS();
1229 : // try to fill the variable with a numeric value first,
1230 : // then with a string value
1231 0 : if( !pVar->IsFixed() || pVar->IsNumeric() )
1232 : {
1233 0 : sal_uInt16 nLen = 0;
1234 0 : if( !pVar->Scan( s, &nLen ) )
1235 : {
1236 0 : err = SbxBase::GetError();
1237 0 : SbxBase::ResetError();
1238 : }
1239 : // the value has to be scanned in completely
1240 0 : else if( nLen != s.getLength() && !pVar->PutString( s ) )
1241 : {
1242 0 : err = SbxBase::GetError();
1243 0 : SbxBase::ResetError();
1244 : }
1245 0 : else if( nLen != s.getLength() && pVar->IsNumeric() )
1246 : {
1247 0 : err = SbxBase::GetError();
1248 0 : SbxBase::ResetError();
1249 0 : if( !err )
1250 : {
1251 0 : err = SbERR_CONVERSION;
1252 : }
1253 : }
1254 : }
1255 : else
1256 : {
1257 0 : pVar->PutString( s );
1258 0 : err = SbxBase::GetError();
1259 0 : SbxBase::ResetError();
1260 0 : }
1261 : }
1262 0 : if( err == SbERR_USER_ABORT )
1263 : {
1264 0 : Error( err );
1265 : }
1266 0 : else if( err )
1267 : {
1268 0 : if( pRestart && !pIosys->GetChannel() )
1269 : {
1270 0 : pCode = pRestart;
1271 : }
1272 : else
1273 : {
1274 0 : Error( err );
1275 : }
1276 : }
1277 : else
1278 : {
1279 0 : PopVar();
1280 0 : }
1281 0 : }
1282 :
1283 : // Line Input to Variable. The variable is on TOS and is
1284 : // deleted afterwards.
1285 :
1286 0 : void SbiRuntime::StepLINPUT()
1287 : {
1288 0 : OString aInput;
1289 0 : pIosys->Read( aInput );
1290 0 : Error( pIosys->GetError() );
1291 0 : SbxVariableRef p = PopVar();
1292 0 : p->PutString(rtl::OStringToOUString(aInput, osl_getThreadTextEncoding()));
1293 0 : }
1294 :
1295 : // end of program
1296 :
1297 0 : void SbiRuntime::StepSTOP()
1298 : {
1299 0 : pInst->Stop();
1300 0 : }
1301 :
1302 :
1303 0 : void SbiRuntime::StepINITFOR()
1304 : {
1305 0 : PushFor();
1306 0 : }
1307 :
1308 0 : void SbiRuntime::StepINITFOREACH()
1309 : {
1310 0 : PushForEach();
1311 0 : }
1312 :
1313 : // increment FOR-variable
1314 :
1315 0 : void SbiRuntime::StepNEXT()
1316 : {
1317 0 : if( !pForStk )
1318 : {
1319 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1320 0 : return;
1321 : }
1322 0 : if( pForStk->eForType == FOR_TO )
1323 : {
1324 0 : pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
1325 : }
1326 : }
1327 :
1328 : // beginning CASE: TOS in CASE-stack
1329 :
1330 0 : void SbiRuntime::StepCASE()
1331 : {
1332 0 : if( !refCaseStk.Is() )
1333 : {
1334 0 : refCaseStk = new SbxArray;
1335 : }
1336 0 : SbxVariableRef xVar = PopVar();
1337 0 : refCaseStk->Put( xVar, refCaseStk->Count() );
1338 0 : }
1339 :
1340 : // end CASE: free variable
1341 :
1342 0 : void SbiRuntime::StepENDCASE()
1343 : {
1344 0 : if( !refCaseStk || !refCaseStk->Count() )
1345 : {
1346 0 : StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1347 : }
1348 : else
1349 : {
1350 0 : refCaseStk->Remove( refCaseStk->Count() - 1 );
1351 : }
1352 0 : }
1353 :
1354 :
1355 0 : void SbiRuntime::StepSTDERROR()
1356 : {
1357 0 : pError = NULL; bError = true;
1358 0 : pInst->aErrorMsg = OUString();
1359 0 : pInst->nErr = 0L;
1360 0 : pInst->nErl = 0;
1361 0 : nError = 0L;
1362 0 : SbxErrObject::getUnoErrObject()->Clear();
1363 0 : }
1364 :
1365 0 : void SbiRuntime::StepNOERROR()
1366 : {
1367 0 : pInst->aErrorMsg = OUString();
1368 0 : pInst->nErr = 0L;
1369 0 : pInst->nErl = 0;
1370 0 : nError = 0L;
1371 0 : SbxErrObject::getUnoErrObject()->Clear();
1372 0 : bError = false;
1373 0 : }
1374 :
1375 : // leave UP
1376 :
1377 7 : void SbiRuntime::StepLEAVE()
1378 : {
1379 7 : bRun = false;
1380 : // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
1381 7 : if ( bInError && pError )
1382 : {
1383 0 : SbxErrObject::getUnoErrObject()->Clear();
1384 : }
1385 7 : }
1386 :
1387 0 : void SbiRuntime::StepCHANNEL() // TOS = channel number
1388 : {
1389 0 : SbxVariableRef pChan = PopVar();
1390 0 : short nChan = pChan->GetInteger();
1391 0 : pIosys->SetChannel( nChan );
1392 0 : Error( pIosys->GetError() );
1393 0 : }
1394 :
1395 0 : void SbiRuntime::StepCHANNEL0()
1396 : {
1397 0 : pIosys->ResetChannel();
1398 0 : }
1399 :
1400 0 : void SbiRuntime::StepPRINT() // print TOS
1401 : {
1402 0 : SbxVariableRef p = PopVar();
1403 0 : OUString s1 = p->GetOUString();
1404 0 : OUString s;
1405 0 : if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
1406 : {
1407 0 : s = " "; // one blank before
1408 : }
1409 0 : s += s1;
1410 0 : OString aByteStr(rtl::OUStringToOString(s, osl_getThreadTextEncoding()));
1411 0 : pIosys->Write( aByteStr );
1412 0 : Error( pIosys->GetError() );
1413 0 : }
1414 :
1415 0 : void SbiRuntime::StepPRINTF() // print TOS in field
1416 : {
1417 0 : SbxVariableRef p = PopVar();
1418 0 : OUString s1 = p->GetOUString();
1419 0 : OUStringBuffer s;
1420 0 : if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
1421 : {
1422 0 : s.append(' ');
1423 : }
1424 0 : s.append(s1);
1425 0 : comphelper::string::padToLength(s, 14, ' ');
1426 0 : OString aByteStr(OUStringToOString(s.makeStringAndClear(), osl_getThreadTextEncoding()));
1427 0 : pIosys->Write( aByteStr );
1428 0 : Error( pIosys->GetError() );
1429 0 : }
1430 :
1431 0 : void SbiRuntime::StepWRITE() // write TOS
1432 : {
1433 0 : SbxVariableRef p = PopVar();
1434 : // Does the string have to be encapsulated?
1435 0 : char ch = 0;
1436 0 : switch (p->GetType() )
1437 : {
1438 0 : case SbxSTRING: ch = '"'; break;
1439 : case SbxCURRENCY:
1440 : case SbxBOOL:
1441 0 : case SbxDATE: ch = '#'; break;
1442 0 : default: break;
1443 : }
1444 0 : OUString s;
1445 0 : if( ch )
1446 : {
1447 0 : s += OUString(ch);
1448 : }
1449 0 : s += p->GetOUString();
1450 0 : if( ch )
1451 : {
1452 0 : s += OUString(ch);
1453 : }
1454 0 : OString aByteStr(rtl::OUStringToOString(s, osl_getThreadTextEncoding()));
1455 0 : pIosys->Write( aByteStr );
1456 0 : Error( pIosys->GetError() );
1457 0 : }
1458 :
1459 0 : void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
1460 : {
1461 0 : SbxVariableRef pTos1 = PopVar();
1462 0 : SbxVariableRef pTos = PopVar();
1463 0 : OUString aDest = pTos1->GetOUString();
1464 0 : OUString aSource = pTos->GetOUString();
1465 :
1466 0 : if( hasUno() )
1467 : {
1468 0 : implStepRenameUCB( aSource, aDest );
1469 : }
1470 : else
1471 : {
1472 0 : implStepRenameOSL( aSource, aDest );
1473 0 : }
1474 0 : }
1475 :
1476 : // TOS = Prompt
1477 :
1478 0 : void SbiRuntime::StepPROMPT()
1479 : {
1480 0 : SbxVariableRef p = PopVar();
1481 0 : rtl::OString aStr(rtl::OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
1482 0 : pIosys->SetPrompt( aStr );
1483 0 : }
1484 :
1485 : // Set Restart point
1486 :
1487 0 : void SbiRuntime::StepRESTART()
1488 : {
1489 0 : pRestart = pCode;
1490 0 : }
1491 :
1492 : // empty expression on stack for missing parameter
1493 :
1494 0 : void SbiRuntime::StepEMPTY()
1495 : {
1496 : // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
1497 : // This is represented by the value 448 (SbERR_NAMED_NOT_FOUND) of the type error
1498 : // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
1499 : // to simplify matters.
1500 0 : SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
1501 0 : xVar->PutErr( 448 );
1502 0 : PushVar( xVar );
1503 0 : }
1504 :
1505 : // TOS = error code
1506 :
1507 0 : void SbiRuntime::StepERROR()
1508 : {
1509 0 : SbxVariableRef refCode = PopVar();
1510 0 : sal_uInt16 n = refCode->GetUShort();
1511 0 : SbError error = StarBASIC::GetSfxFromVBError( n );
1512 0 : if ( bVBAEnabled )
1513 : {
1514 0 : pInst->Error( error );
1515 : }
1516 : else
1517 : {
1518 0 : Error( error );
1519 0 : }
1520 0 : }
1521 :
1522 : /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
|
