1e1f63238SAndrew Rist /**************************************************************
2cdf0e10cSrcweir *
3e1f63238SAndrew Rist * Licensed to the Apache Software Foundation (ASF) under one
4e1f63238SAndrew Rist * or more contributor license agreements. See the NOTICE file
5e1f63238SAndrew Rist * distributed with this work for additional information
6e1f63238SAndrew Rist * regarding copyright ownership. The ASF licenses this file
7e1f63238SAndrew Rist * to you under the Apache License, Version 2.0 (the
8e1f63238SAndrew Rist * "License"); you may not use this file except in compliance
9e1f63238SAndrew Rist * with the License. You may obtain a copy of the License at
10e1f63238SAndrew Rist *
11e1f63238SAndrew Rist * http://www.apache.org/licenses/LICENSE-2.0
12e1f63238SAndrew Rist *
13e1f63238SAndrew Rist * Unless required by applicable law or agreed to in writing,
14e1f63238SAndrew Rist * software distributed under the License is distributed on an
15e1f63238SAndrew Rist * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16e1f63238SAndrew Rist * KIND, either express or implied. See the License for the
17e1f63238SAndrew Rist * specific language governing permissions and limitations
18e1f63238SAndrew Rist * under the License.
19e1f63238SAndrew Rist *
20e1f63238SAndrew Rist *************************************************************/
21e1f63238SAndrew Rist
22e1f63238SAndrew Rist
23cdf0e10cSrcweir
24cdf0e10cSrcweir // MARKER(update_precomp.py): autogen include statement, do not remove
25cdf0e10cSrcweir #include "precompiled_basic.hxx"
26cdf0e10cSrcweir #include <vcl/msgbox.hxx>
27cdf0e10cSrcweir #include <tools/fsys.hxx>
28cdf0e10cSrcweir
29cdf0e10cSrcweir #include "errobject.hxx"
30cdf0e10cSrcweir #include "runtime.hxx"
31cdf0e10cSrcweir #include "sbintern.hxx"
32cdf0e10cSrcweir #include "iosys.hxx"
33cdf0e10cSrcweir #include <sb.hrc>
34cdf0e10cSrcweir #include <basrid.hxx>
35cdf0e10cSrcweir #include "sbunoobj.hxx"
36cdf0e10cSrcweir #include "image.hxx"
37cdf0e10cSrcweir #include <com/sun/star/uno/Any.hxx>
38cdf0e10cSrcweir #include <com/sun/star/util/SearchOptions.hdl>
39cdf0e10cSrcweir #include <vcl/svapp.hxx>
40cdf0e10cSrcweir #include <unotools/textsearch.hxx>
41cdf0e10cSrcweir
42cdf0e10cSrcweir Reference< XInterface > createComListener( const Any& aControlAny, const ::rtl::OUString& aVBAType,
43cdf0e10cSrcweir const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj );
44cdf0e10cSrcweir
45cdf0e10cSrcweir #include <algorithm>
46cdf0e10cSrcweir #include <hash_map>
47cdf0e10cSrcweir
48cdf0e10cSrcweir SbxVariable* getDefaultProp( SbxVariable* pRef );
49cdf0e10cSrcweir
StepNOP()50cdf0e10cSrcweir void SbiRuntime::StepNOP()
51cdf0e10cSrcweir {}
52cdf0e10cSrcweir
StepArith(SbxOperator eOp)53cdf0e10cSrcweir void SbiRuntime::StepArith( SbxOperator eOp )
54cdf0e10cSrcweir {
55cdf0e10cSrcweir SbxVariableRef p1 = PopVar();
56cdf0e10cSrcweir TOSMakeTemp();
57cdf0e10cSrcweir SbxVariable* p2 = GetTOS();
58cdf0e10cSrcweir
59cdf0e10cSrcweir
60cdf0e10cSrcweir // This could & should be moved to the MakeTempTOS() method in runtime.cxx
61cdf0e10cSrcweir // In the code which this is cut'npaste from there is a check for a ref
62cdf0e10cSrcweir // count != 1 based on which the copy of the SbxVariable is done.
63cdf0e10cSrcweir // see orig code in MakeTempTOS ( and I'm not sure what the significance,
64cdf0e10cSrcweir // of that is )
65cdf0e10cSrcweir // here we alway seem to have a refcount of 1. Also it seems that
66cdf0e10cSrcweir // MakeTempTOS is called for other operation, so I hold off for now
67cdf0e10cSrcweir // until I have a better idea
68cdf0e10cSrcweir if ( bVBAEnabled
69cdf0e10cSrcweir && ( p2->GetType() == SbxOBJECT || p2->GetType() == SbxVARIANT )
70cdf0e10cSrcweir )
71cdf0e10cSrcweir {
72cdf0e10cSrcweir SbxVariable* pDflt = getDefaultProp( p2 );
73cdf0e10cSrcweir if ( pDflt )
74cdf0e10cSrcweir {
75cdf0e10cSrcweir pDflt->Broadcast( SBX_HINT_DATAWANTED );
76cdf0e10cSrcweir // replacing new p2 on stack causes object pointed by
77cdf0e10cSrcweir // pDft->pParent to be deleted, when p2->Compute() is
78cdf0e10cSrcweir // called below pParent is accessed ( but its deleted )
79cdf0e10cSrcweir // so set it to NULL now
80cdf0e10cSrcweir pDflt->SetParent( NULL );
81cdf0e10cSrcweir p2 = new SbxVariable( *pDflt );
82cdf0e10cSrcweir p2->SetFlag( SBX_READWRITE );
83cdf0e10cSrcweir refExprStk->Put( p2, nExprLvl - 1 );
84cdf0e10cSrcweir }
85cdf0e10cSrcweir }
86cdf0e10cSrcweir
87cdf0e10cSrcweir p2->ResetFlag( SBX_FIXED );
88cdf0e10cSrcweir p2->Compute( eOp, *p1 );
89cdf0e10cSrcweir
90cdf0e10cSrcweir checkArithmeticOverflow( p2 );
91cdf0e10cSrcweir }
92cdf0e10cSrcweir
StepUnary(SbxOperator eOp)93cdf0e10cSrcweir void SbiRuntime::StepUnary( SbxOperator eOp )
94cdf0e10cSrcweir {
95cdf0e10cSrcweir TOSMakeTemp();
96cdf0e10cSrcweir SbxVariable* p = GetTOS();
97cdf0e10cSrcweir p->Compute( eOp, *p );
98cdf0e10cSrcweir }
99cdf0e10cSrcweir
StepCompare(SbxOperator eOp)100cdf0e10cSrcweir void SbiRuntime::StepCompare( SbxOperator eOp )
101cdf0e10cSrcweir {
102cdf0e10cSrcweir SbxVariableRef p1 = PopVar();
103cdf0e10cSrcweir SbxVariableRef p2 = PopVar();
104cdf0e10cSrcweir
105cdf0e10cSrcweir // Make sure objects with default params have
106cdf0e10cSrcweir // values ( and type ) set as appropriate
107cdf0e10cSrcweir SbxDataType p1Type = p1->GetType();
108cdf0e10cSrcweir SbxDataType p2Type = p2->GetType();
109cdf0e10cSrcweir if ( p1Type == p2Type )
110cdf0e10cSrcweir {
111cdf0e10cSrcweir if ( p1Type == SbxEMPTY )
112cdf0e10cSrcweir {
113cdf0e10cSrcweir p1->Broadcast( SBX_HINT_DATAWANTED );
114cdf0e10cSrcweir p2->Broadcast( SBX_HINT_DATAWANTED );
115cdf0e10cSrcweir }
116cdf0e10cSrcweir // if both sides are an object and have default props
117cdf0e10cSrcweir // then we need to use the default props
118cdf0e10cSrcweir // we don't need to worry if only one side ( lhs, rhs ) is an
119cdf0e10cSrcweir // object ( object side will get coerced to correct type in
120cdf0e10cSrcweir // Compare )
121cdf0e10cSrcweir else if ( p1Type == SbxOBJECT )
122cdf0e10cSrcweir {
123cdf0e10cSrcweir SbxVariable* pDflt = getDefaultProp( p1 );
124cdf0e10cSrcweir if ( pDflt )
125cdf0e10cSrcweir {
126cdf0e10cSrcweir p1 = pDflt;
127cdf0e10cSrcweir p1->Broadcast( SBX_HINT_DATAWANTED );
128cdf0e10cSrcweir }
129cdf0e10cSrcweir pDflt = getDefaultProp( p2 );
130cdf0e10cSrcweir if ( pDflt )
131cdf0e10cSrcweir {
132cdf0e10cSrcweir p2 = pDflt;
133cdf0e10cSrcweir p2->Broadcast( SBX_HINT_DATAWANTED );
134cdf0e10cSrcweir }
135cdf0e10cSrcweir }
136cdf0e10cSrcweir
137cdf0e10cSrcweir }
138cdf0e10cSrcweir static SbxVariable* pTRUE = NULL;
139cdf0e10cSrcweir static SbxVariable* pFALSE = NULL;
140cdf0e10cSrcweir
141cdf0e10cSrcweir if( p2->Compare( eOp, *p1 ) )
142cdf0e10cSrcweir {
143cdf0e10cSrcweir if( !pTRUE )
144cdf0e10cSrcweir {
145cdf0e10cSrcweir pTRUE = new SbxVariable;
146cdf0e10cSrcweir pTRUE->PutBool( sal_True );
147cdf0e10cSrcweir pTRUE->AddRef();
148cdf0e10cSrcweir }
149cdf0e10cSrcweir PushVar( pTRUE );
150cdf0e10cSrcweir }
151cdf0e10cSrcweir else
152cdf0e10cSrcweir {
153cdf0e10cSrcweir if( !pFALSE )
154cdf0e10cSrcweir {
155cdf0e10cSrcweir pFALSE = new SbxVariable;
156cdf0e10cSrcweir pFALSE->PutBool( sal_False );
157cdf0e10cSrcweir pFALSE->AddRef();
158cdf0e10cSrcweir }
159cdf0e10cSrcweir PushVar( pFALSE );
160cdf0e10cSrcweir }
161cdf0e10cSrcweir }
162cdf0e10cSrcweir
StepEXP()163cdf0e10cSrcweir void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
StepMUL()164cdf0e10cSrcweir void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
StepDIV()165cdf0e10cSrcweir void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
StepIDIV()166cdf0e10cSrcweir void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
StepMOD()167cdf0e10cSrcweir void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
StepPLUS()168cdf0e10cSrcweir void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
StepMINUS()169cdf0e10cSrcweir void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
StepCAT()170cdf0e10cSrcweir void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
StepAND()171cdf0e10cSrcweir void SbiRuntime::StepAND() { StepArith( SbxAND ); }
StepOR()172cdf0e10cSrcweir void SbiRuntime::StepOR() { StepArith( SbxOR ); }
StepXOR()173cdf0e10cSrcweir void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
StepEQV()174cdf0e10cSrcweir void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
StepIMP()175cdf0e10cSrcweir void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
176cdf0e10cSrcweir
StepNEG()177cdf0e10cSrcweir void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
StepNOT()178cdf0e10cSrcweir void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
179cdf0e10cSrcweir
StepEQ()180cdf0e10cSrcweir void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
StepNE()181cdf0e10cSrcweir void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
StepLT()182cdf0e10cSrcweir void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
StepGT()183cdf0e10cSrcweir void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
StepLE()184cdf0e10cSrcweir void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
StepGE()185cdf0e10cSrcweir void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
186cdf0e10cSrcweir
187cdf0e10cSrcweir namespace
188cdf0e10cSrcweir {
NeedEsc(sal_Unicode cCode)189cdf0e10cSrcweir bool NeedEsc(sal_Unicode cCode)
190cdf0e10cSrcweir {
191cdf0e10cSrcweir String sEsc(RTL_CONSTASCII_USTRINGPARAM(".^$+\\|{}()"));
192cdf0e10cSrcweir return (STRING_NOTFOUND != sEsc.Search(cCode));
193cdf0e10cSrcweir }
194cdf0e10cSrcweir
VBALikeToRegexp(const String & rIn)195cdf0e10cSrcweir String VBALikeToRegexp(const String &rIn)
196cdf0e10cSrcweir {
197cdf0e10cSrcweir String sResult;
198cdf0e10cSrcweir const sal_Unicode *start = rIn.GetBuffer();
199cdf0e10cSrcweir const sal_Unicode *end = start + rIn.Len();
200cdf0e10cSrcweir
201cdf0e10cSrcweir int seenright = 0;
202cdf0e10cSrcweir
203cdf0e10cSrcweir sResult.Append('^');
204cdf0e10cSrcweir
205cdf0e10cSrcweir while (start < end)
206cdf0e10cSrcweir {
207cdf0e10cSrcweir switch (*start)
208cdf0e10cSrcweir {
209cdf0e10cSrcweir case '?':
210cdf0e10cSrcweir sResult.Append('.');
211cdf0e10cSrcweir start++;
212cdf0e10cSrcweir break;
213cdf0e10cSrcweir case '*':
214cdf0e10cSrcweir sResult.Append(String(RTL_CONSTASCII_USTRINGPARAM(".*")));
215cdf0e10cSrcweir start++;
216cdf0e10cSrcweir break;
217cdf0e10cSrcweir case '#':
218cdf0e10cSrcweir sResult.Append(String(RTL_CONSTASCII_USTRINGPARAM("[0-9]")));
219cdf0e10cSrcweir start++;
220cdf0e10cSrcweir break;
221cdf0e10cSrcweir case ']':
222cdf0e10cSrcweir sResult.Append('\\');
223cdf0e10cSrcweir sResult.Append(*start++);
224cdf0e10cSrcweir break;
225cdf0e10cSrcweir case '[':
226cdf0e10cSrcweir sResult.Append(*start++);
227cdf0e10cSrcweir seenright = 0;
228cdf0e10cSrcweir while (start < end && !seenright)
229cdf0e10cSrcweir {
230cdf0e10cSrcweir switch (*start)
231cdf0e10cSrcweir {
232cdf0e10cSrcweir case '[':
233cdf0e10cSrcweir case '?':
234cdf0e10cSrcweir case '*':
235cdf0e10cSrcweir sResult.Append('\\');
236cdf0e10cSrcweir sResult.Append(*start);
237cdf0e10cSrcweir break;
238cdf0e10cSrcweir case ']':
239cdf0e10cSrcweir sResult.Append(*start);
240cdf0e10cSrcweir seenright = 1;
241cdf0e10cSrcweir break;
242cdf0e10cSrcweir case '!':
243cdf0e10cSrcweir sResult.Append('^');
244cdf0e10cSrcweir break;
245cdf0e10cSrcweir default:
246cdf0e10cSrcweir if (NeedEsc(*start))
247cdf0e10cSrcweir sResult.Append('\\');
248cdf0e10cSrcweir sResult.Append(*start);
249cdf0e10cSrcweir break;
250cdf0e10cSrcweir }
251cdf0e10cSrcweir start++;
252cdf0e10cSrcweir }
253cdf0e10cSrcweir break;
254cdf0e10cSrcweir default:
255cdf0e10cSrcweir if (NeedEsc(*start))
256cdf0e10cSrcweir sResult.Append('\\');
257cdf0e10cSrcweir sResult.Append(*start++);
258cdf0e10cSrcweir }
259cdf0e10cSrcweir }
260cdf0e10cSrcweir
261cdf0e10cSrcweir sResult.Append('$');
262cdf0e10cSrcweir
263cdf0e10cSrcweir return sResult;
264cdf0e10cSrcweir }
265cdf0e10cSrcweir }
266cdf0e10cSrcweir
StepLIKE()267cdf0e10cSrcweir void SbiRuntime::StepLIKE()
268cdf0e10cSrcweir {
269cdf0e10cSrcweir SbxVariableRef refVar1 = PopVar();
270cdf0e10cSrcweir SbxVariableRef refVar2 = PopVar();
271cdf0e10cSrcweir
272cdf0e10cSrcweir String pattern = VBALikeToRegexp(refVar1->GetString());
273cdf0e10cSrcweir String value = refVar2->GetString();
274cdf0e10cSrcweir
275cdf0e10cSrcweir com::sun::star::util::SearchOptions aSearchOpt;
276cdf0e10cSrcweir
277cdf0e10cSrcweir aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
278cdf0e10cSrcweir
279cdf0e10cSrcweir aSearchOpt.Locale = Application::GetSettings().GetLocale();
280cdf0e10cSrcweir aSearchOpt.searchString = pattern;
281cdf0e10cSrcweir
282cdf0e10cSrcweir int bTextMode(1);
283cdf0e10cSrcweir bool bCompatibility = ( pINST && pINST->IsCompatibility() );
284cdf0e10cSrcweir if( bCompatibility )
285cdf0e10cSrcweir bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
286cdf0e10cSrcweir
287cdf0e10cSrcweir if( bTextMode )
288cdf0e10cSrcweir aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
289cdf0e10cSrcweir
290cdf0e10cSrcweir SbxVariable* pRes = new SbxVariable;
291cdf0e10cSrcweir utl::TextSearch aSearch(aSearchOpt);
292cdf0e10cSrcweir xub_StrLen nStart=0, nEnd=value.Len();
293cdf0e10cSrcweir int bRes = aSearch.SearchFrwrd(value, &nStart, &nEnd);
294cdf0e10cSrcweir pRes->PutBool( bRes != 0 );
295cdf0e10cSrcweir
296cdf0e10cSrcweir PushVar( pRes );
297cdf0e10cSrcweir }
298cdf0e10cSrcweir
299cdf0e10cSrcweir // TOS und TOS-1 sind beides Objektvariable und enthalten den selben Pointer
300cdf0e10cSrcweir
StepIS()301cdf0e10cSrcweir void SbiRuntime::StepIS()
302cdf0e10cSrcweir {
303cdf0e10cSrcweir SbxVariableRef refVar1 = PopVar();
304cdf0e10cSrcweir SbxVariableRef refVar2 = PopVar();
305cdf0e10cSrcweir
306cdf0e10cSrcweir SbxDataType eType1 = refVar1->GetType();
307cdf0e10cSrcweir SbxDataType eType2 = refVar2->GetType();
308cdf0e10cSrcweir if ( eType1 == SbxEMPTY )
309cdf0e10cSrcweir {
310cdf0e10cSrcweir refVar1->Broadcast( SBX_HINT_DATAWANTED );
311cdf0e10cSrcweir eType1 = refVar1->GetType();
312cdf0e10cSrcweir }
313cdf0e10cSrcweir if ( eType2 == SbxEMPTY )
314cdf0e10cSrcweir {
315cdf0e10cSrcweir refVar2->Broadcast( SBX_HINT_DATAWANTED );
316cdf0e10cSrcweir eType2 = refVar2->GetType();
317cdf0e10cSrcweir }
318cdf0e10cSrcweir
319cdf0e10cSrcweir sal_Bool bRes = sal_Bool( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
320cdf0e10cSrcweir if ( bVBAEnabled && !bRes )
321cdf0e10cSrcweir Error( SbERR_INVALID_USAGE_OBJECT );
322cdf0e10cSrcweir bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
323cdf0e10cSrcweir SbxVariable* pRes = new SbxVariable;
324cdf0e10cSrcweir pRes->PutBool( bRes );
325cdf0e10cSrcweir PushVar( pRes );
326cdf0e10cSrcweir }
327cdf0e10cSrcweir
328cdf0e10cSrcweir // Aktualisieren des Wertes von TOS
329cdf0e10cSrcweir
StepGET()330cdf0e10cSrcweir void SbiRuntime::StepGET()
331cdf0e10cSrcweir {
332cdf0e10cSrcweir SbxVariable* p = GetTOS();
333cdf0e10cSrcweir p->Broadcast( SBX_HINT_DATAWANTED );
334cdf0e10cSrcweir }
335cdf0e10cSrcweir
336cdf0e10cSrcweir // #67607 Uno-Structs kopieren
checkUnoStructCopy(SbxVariableRef & refVal,SbxVariableRef & refVar)337cdf0e10cSrcweir inline void checkUnoStructCopy( SbxVariableRef& refVal, SbxVariableRef& refVar )
338cdf0e10cSrcweir {
339cdf0e10cSrcweir SbxDataType eVarType = refVar->GetType();
340cdf0e10cSrcweir if( eVarType != SbxOBJECT )
341cdf0e10cSrcweir return;
342cdf0e10cSrcweir
343cdf0e10cSrcweir SbxObjectRef xValObj = (SbxObject*)refVal->GetObject();
344cdf0e10cSrcweir if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
345cdf0e10cSrcweir return;
346cdf0e10cSrcweir
347cdf0e10cSrcweir // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
348cdf0e10cSrcweir if( refVar->ISA(SbProcedureProperty) )
349cdf0e10cSrcweir return;
350cdf0e10cSrcweir
351cdf0e10cSrcweir SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject();
352cdf0e10cSrcweir SbxDataType eValType = refVal->GetType();
353cdf0e10cSrcweir if( eValType == SbxOBJECT && xVarObj == xValObj )
354cdf0e10cSrcweir {
355cdf0e10cSrcweir SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxObject*)xVarObj);
356cdf0e10cSrcweir if( pUnoObj )
357cdf0e10cSrcweir {
358cdf0e10cSrcweir Any aAny = pUnoObj->getUnoAny();
359cdf0e10cSrcweir if( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
360cdf0e10cSrcweir {
361cdf0e10cSrcweir SbUnoObject* pNewUnoObj = new SbUnoObject( pUnoObj->GetName(), aAny );
362cdf0e10cSrcweir // #70324: ClassName uebernehmen
363cdf0e10cSrcweir pNewUnoObj->SetClassName( pUnoObj->GetClassName() );
364cdf0e10cSrcweir refVar->PutObject( pNewUnoObj );
365cdf0e10cSrcweir }
366cdf0e10cSrcweir }
367cdf0e10cSrcweir }
368cdf0e10cSrcweir }
369cdf0e10cSrcweir
370cdf0e10cSrcweir
371cdf0e10cSrcweir // Ablage von TOS in TOS-1
372cdf0e10cSrcweir
StepPUT()373cdf0e10cSrcweir void SbiRuntime::StepPUT()
374cdf0e10cSrcweir {
375cdf0e10cSrcweir SbxVariableRef refVal = PopVar();
376cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
377cdf0e10cSrcweir // Store auf die eigene Methode (innerhalb einer Function)?
378cdf0e10cSrcweir sal_Bool bFlagsChanged = sal_False;
379cdf0e10cSrcweir sal_uInt16 n = 0;
380cdf0e10cSrcweir if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
381cdf0e10cSrcweir {
382cdf0e10cSrcweir bFlagsChanged = sal_True;
383cdf0e10cSrcweir n = refVar->GetFlags();
384cdf0e10cSrcweir refVar->SetFlag( SBX_WRITE );
385cdf0e10cSrcweir }
386cdf0e10cSrcweir
387cdf0e10cSrcweir // if left side arg is an object or variant and right handside isn't
388cdf0e10cSrcweir // either an object or a variant then try and see if a default
389cdf0e10cSrcweir // property exists.
390cdf0e10cSrcweir // to use e.g. Range{"A1") = 34
391cdf0e10cSrcweir // could equate to Range("A1").Value = 34
392cdf0e10cSrcweir if ( bVBAEnabled )
393cdf0e10cSrcweir {
394cdf0e10cSrcweir if ( refVar->GetType() == SbxOBJECT )
395cdf0e10cSrcweir {
396cdf0e10cSrcweir SbxVariable* pDflt = getDefaultProp( refVar );
397cdf0e10cSrcweir if ( pDflt )
398cdf0e10cSrcweir refVar = pDflt;
399cdf0e10cSrcweir }
400cdf0e10cSrcweir if ( refVal->GetType() == SbxOBJECT )
401cdf0e10cSrcweir {
402cdf0e10cSrcweir SbxVariable* pDflt = getDefaultProp( refVal );
403cdf0e10cSrcweir if ( pDflt )
404cdf0e10cSrcweir refVal = pDflt;
405cdf0e10cSrcweir }
406cdf0e10cSrcweir }
407cdf0e10cSrcweir
408cdf0e10cSrcweir *refVar = *refVal;
409cdf0e10cSrcweir // lhs is a property who's value is currently null
410cdf0e10cSrcweir if ( !bVBAEnabled || ( bVBAEnabled && refVar->GetType() != SbxEMPTY ) )
411cdf0e10cSrcweir // #67607 Uno-Structs kopieren
412cdf0e10cSrcweir checkUnoStructCopy( refVal, refVar );
413cdf0e10cSrcweir if( bFlagsChanged )
414cdf0e10cSrcweir refVar->SetFlags( n );
415cdf0e10cSrcweir }
416cdf0e10cSrcweir
417cdf0e10cSrcweir
418cdf0e10cSrcweir // VBA Dim As New behavior handling, save init object information
419cdf0e10cSrcweir struct DimAsNewRecoverItem
420cdf0e10cSrcweir {
421cdf0e10cSrcweir String m_aObjClass;
422cdf0e10cSrcweir String m_aObjName;
423cdf0e10cSrcweir SbxObject* m_pObjParent;
424cdf0e10cSrcweir SbModule* m_pClassModule;
425cdf0e10cSrcweir
DimAsNewRecoverItemDimAsNewRecoverItem426cdf0e10cSrcweir DimAsNewRecoverItem( void )
427cdf0e10cSrcweir : m_pObjParent( NULL )
428cdf0e10cSrcweir , m_pClassModule( NULL )
429cdf0e10cSrcweir {}
430cdf0e10cSrcweir
DimAsNewRecoverItemDimAsNewRecoverItem431cdf0e10cSrcweir DimAsNewRecoverItem( const String& rObjClass, const String& rObjName,
432cdf0e10cSrcweir SbxObject* pObjParent, SbModule* pClassModule )
433cdf0e10cSrcweir : m_aObjClass( rObjClass )
434cdf0e10cSrcweir , m_aObjName( rObjName )
435cdf0e10cSrcweir , m_pObjParent( pObjParent )
436cdf0e10cSrcweir , m_pClassModule( pClassModule )
437cdf0e10cSrcweir {}
438cdf0e10cSrcweir
439cdf0e10cSrcweir };
440cdf0e10cSrcweir
441cdf0e10cSrcweir
442cdf0e10cSrcweir struct SbxVariablePtrHash
443cdf0e10cSrcweir {
operator ()SbxVariablePtrHash444cdf0e10cSrcweir size_t operator()( SbxVariable* pVar ) const
445cdf0e10cSrcweir { return (size_t)pVar; }
446cdf0e10cSrcweir };
447cdf0e10cSrcweir
448cdf0e10cSrcweir typedef std::hash_map< SbxVariable*, DimAsNewRecoverItem, SbxVariablePtrHash > DimAsNewRecoverHash;
449cdf0e10cSrcweir
450cdf0e10cSrcweir static DimAsNewRecoverHash GaDimAsNewRecoverHash;
451cdf0e10cSrcweir
removeDimAsNewRecoverItem(SbxVariable * pVar)452cdf0e10cSrcweir void removeDimAsNewRecoverItem( SbxVariable* pVar )
453cdf0e10cSrcweir {
454cdf0e10cSrcweir DimAsNewRecoverHash::iterator it = GaDimAsNewRecoverHash.find( pVar );
455cdf0e10cSrcweir if( it != GaDimAsNewRecoverHash.end() )
456cdf0e10cSrcweir GaDimAsNewRecoverHash.erase( it );
457cdf0e10cSrcweir }
458cdf0e10cSrcweir
459cdf0e10cSrcweir
460cdf0e10cSrcweir // Speichern Objektvariable
461cdf0e10cSrcweir // Nicht-Objekt-Variable fuehren zu Fehlern
462cdf0e10cSrcweir
463cdf0e10cSrcweir static const char pCollectionStr[] = "Collection";
464cdf0e10cSrcweir
StepSET_Impl(SbxVariableRef & refVal,SbxVariableRef & refVar,bool bHandleDefaultProp)465cdf0e10cSrcweir void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
466cdf0e10cSrcweir {
467cdf0e10cSrcweir // #67733 Typen mit Array-Flag sind auch ok
468cdf0e10cSrcweir
469cdf0e10cSrcweir // Check var, !object is no error for sure if, only if type is fixed
470cdf0e10cSrcweir SbxDataType eVarType = refVar->GetType();
471cdf0e10cSrcweir if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
472cdf0e10cSrcweir {
473cdf0e10cSrcweir Error( SbERR_INVALID_USAGE_OBJECT );
474cdf0e10cSrcweir return;
475cdf0e10cSrcweir }
476cdf0e10cSrcweir
477cdf0e10cSrcweir // Check value, !object is no error for sure if, only if type is fixed
478cdf0e10cSrcweir SbxDataType eValType = refVal->GetType();
479cdf0e10cSrcweir // bool bGetValObject = false;
480cdf0e10cSrcweir if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
481cdf0e10cSrcweir {
482cdf0e10cSrcweir Error( SbERR_INVALID_USAGE_OBJECT );
483cdf0e10cSrcweir return;
484cdf0e10cSrcweir }
485cdf0e10cSrcweir
486cdf0e10cSrcweir // Getting in here causes problems with objects with default properties
487cdf0e10cSrcweir // if they are SbxEMPTY I guess
488cdf0e10cSrcweir if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
489cdf0e10cSrcweir {
490cdf0e10cSrcweir // Auf refVal GetObject fuer Collections ausloesen
491cdf0e10cSrcweir SbxBase* pObjVarObj = refVal->GetObject();
492cdf0e10cSrcweir if( pObjVarObj )
493cdf0e10cSrcweir {
494cdf0e10cSrcweir SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
495cdf0e10cSrcweir
496cdf0e10cSrcweir // #67733 Typen mit Array-Flag sind auch ok
497cdf0e10cSrcweir if( refObjVal )
498cdf0e10cSrcweir refVal = refObjVal;
499cdf0e10cSrcweir else if( !(eValType & SbxARRAY) )
500cdf0e10cSrcweir refVal = NULL;
501cdf0e10cSrcweir }
502cdf0e10cSrcweir }
503cdf0e10cSrcweir
504cdf0e10cSrcweir // #52896 Wenn Uno-Sequences bzw. allgemein Arrays einer als
505cdf0e10cSrcweir // Object deklarierten Variable zugewiesen werden, kann hier
506cdf0e10cSrcweir // refVal ungueltig sein!
507cdf0e10cSrcweir if( !refVal )
508cdf0e10cSrcweir {
509cdf0e10cSrcweir Error( SbERR_INVALID_USAGE_OBJECT );
510cdf0e10cSrcweir }
511cdf0e10cSrcweir else
512cdf0e10cSrcweir {
513cdf0e10cSrcweir // Store auf die eigene Methode (innerhalb einer Function)?
514cdf0e10cSrcweir sal_Bool bFlagsChanged = sal_False;
515cdf0e10cSrcweir sal_uInt16 n = 0;
516cdf0e10cSrcweir if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
517cdf0e10cSrcweir {
518cdf0e10cSrcweir bFlagsChanged = sal_True;
519cdf0e10cSrcweir n = refVar->GetFlags();
520cdf0e10cSrcweir refVar->SetFlag( SBX_WRITE );
521cdf0e10cSrcweir }
522cdf0e10cSrcweir SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
523cdf0e10cSrcweir if( pProcProperty )
524cdf0e10cSrcweir pProcProperty->setSet( true );
525cdf0e10cSrcweir
526cdf0e10cSrcweir if ( bHandleDefaultProp )
527cdf0e10cSrcweir {
528cdf0e10cSrcweir // get default properties for lhs & rhs where necessary
529cdf0e10cSrcweir // SbxVariable* defaultProp = NULL; unused variable
530cdf0e10cSrcweir bool bLHSHasDefaultProp = false;
531cdf0e10cSrcweir // LHS try determine if a default prop exists
532cdf0e10cSrcweir if ( refVar->GetType() == SbxOBJECT )
533cdf0e10cSrcweir {
534cdf0e10cSrcweir SbxVariable* pDflt = getDefaultProp( refVar );
535cdf0e10cSrcweir if ( pDflt )
536cdf0e10cSrcweir {
537cdf0e10cSrcweir refVar = pDflt;
538cdf0e10cSrcweir bLHSHasDefaultProp = true;
539cdf0e10cSrcweir }
540cdf0e10cSrcweir }
541cdf0e10cSrcweir // RHS only get a default prop is the rhs has one
542cdf0e10cSrcweir if ( refVal->GetType() == SbxOBJECT )
543cdf0e10cSrcweir {
544cdf0e10cSrcweir // check if lhs is a null object
545cdf0e10cSrcweir // if it is then use the object not the default property
546cdf0e10cSrcweir SbxObject* pObj = NULL;
547cdf0e10cSrcweir
548cdf0e10cSrcweir
549cdf0e10cSrcweir pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
550cdf0e10cSrcweir
551cdf0e10cSrcweir // calling GetObject on a SbxEMPTY variable raises
552cdf0e10cSrcweir // object not set errors, make sure its an Object
553cdf0e10cSrcweir if ( !pObj && refVar->GetType() == SbxOBJECT )
554cdf0e10cSrcweir {
555cdf0e10cSrcweir SbxBase* pObjVarObj = refVar->GetObject();
556cdf0e10cSrcweir pObj = PTR_CAST(SbxObject,pObjVarObj);
557cdf0e10cSrcweir }
558cdf0e10cSrcweir SbxVariable* pDflt = NULL;
559cdf0e10cSrcweir if ( pObj || bLHSHasDefaultProp )
560cdf0e10cSrcweir // lhs is either a valid object || or has a defaultProp
561cdf0e10cSrcweir pDflt = getDefaultProp( refVal );
562cdf0e10cSrcweir if ( pDflt )
563cdf0e10cSrcweir refVal = pDflt;
564cdf0e10cSrcweir }
565cdf0e10cSrcweir }
566cdf0e10cSrcweir
567cdf0e10cSrcweir // Handle Dim As New
568cdf0e10cSrcweir sal_Bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
569cdf0e10cSrcweir SbxBaseRef xPrevVarObj;
570cdf0e10cSrcweir if( bDimAsNew )
571cdf0e10cSrcweir xPrevVarObj = refVar->GetObject();
572cdf0e10cSrcweir
573cdf0e10cSrcweir // Handle withevents
574cdf0e10cSrcweir sal_Bool bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
575cdf0e10cSrcweir if ( bWithEvents )
576cdf0e10cSrcweir {
577cdf0e10cSrcweir Reference< XInterface > xComListener;
578cdf0e10cSrcweir
579cdf0e10cSrcweir SbxBase* pObj = refVal->GetObject();
580cdf0e10cSrcweir SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
581cdf0e10cSrcweir if( pUnoObj != NULL )
582cdf0e10cSrcweir {
583cdf0e10cSrcweir Any aControlAny = pUnoObj->getUnoAny();
584cdf0e10cSrcweir String aDeclareClassName = refVar->GetDeclareClassName();
585cdf0e10cSrcweir ::rtl::OUString aVBAType = aDeclareClassName;
586cdf0e10cSrcweir ::rtl::OUString aPrefix = refVar->GetName();
587cdf0e10cSrcweir SbxObjectRef xScopeObj = refVar->GetParent();
588cdf0e10cSrcweir xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
589cdf0e10cSrcweir
590cdf0e10cSrcweir refVal->SetDeclareClassName( aDeclareClassName );
591cdf0e10cSrcweir refVal->SetComListener( xComListener, &rBasic ); // Hold reference
592cdf0e10cSrcweir }
593cdf0e10cSrcweir
594cdf0e10cSrcweir *refVar = *refVal;
595cdf0e10cSrcweir }
596cdf0e10cSrcweir else
597cdf0e10cSrcweir {
598cdf0e10cSrcweir *refVar = *refVal;
599cdf0e10cSrcweir }
600cdf0e10cSrcweir
601cdf0e10cSrcweir if ( bDimAsNew )
602cdf0e10cSrcweir {
603cdf0e10cSrcweir if( !refVar->ISA(SbxObject) )
604cdf0e10cSrcweir {
605cdf0e10cSrcweir SbxBase* pValObjBase = refVal->GetObject();
606cdf0e10cSrcweir if( pValObjBase == NULL )
607cdf0e10cSrcweir {
608cdf0e10cSrcweir if( xPrevVarObj.Is() )
609cdf0e10cSrcweir {
610cdf0e10cSrcweir // Object is overwritten with NULL, instantiate init object
611cdf0e10cSrcweir DimAsNewRecoverHash::iterator it = GaDimAsNewRecoverHash.find( refVar );
612cdf0e10cSrcweir if( it != GaDimAsNewRecoverHash.end() )
613cdf0e10cSrcweir {
614cdf0e10cSrcweir const DimAsNewRecoverItem& rItem = it->second;
615cdf0e10cSrcweir if( rItem.m_pClassModule != NULL )
616cdf0e10cSrcweir {
617cdf0e10cSrcweir SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
618cdf0e10cSrcweir pNewObj->SetName( rItem.m_aObjName );
619cdf0e10cSrcweir pNewObj->SetParent( rItem.m_pObjParent );
620cdf0e10cSrcweir refVar->PutObject( pNewObj );
621cdf0e10cSrcweir }
622cdf0e10cSrcweir else if( rItem.m_aObjClass.EqualsIgnoreCaseAscii( pCollectionStr ) )
623cdf0e10cSrcweir {
624cdf0e10cSrcweir BasicCollection* pNewCollection = new BasicCollection( String( RTL_CONSTASCII_USTRINGPARAM(pCollectionStr) ) );
625cdf0e10cSrcweir pNewCollection->SetName( rItem.m_aObjName );
626cdf0e10cSrcweir pNewCollection->SetParent( rItem.m_pObjParent );
627cdf0e10cSrcweir refVar->PutObject( pNewCollection );
628cdf0e10cSrcweir }
629cdf0e10cSrcweir }
630cdf0e10cSrcweir }
631cdf0e10cSrcweir }
632cdf0e10cSrcweir else
633cdf0e10cSrcweir {
634cdf0e10cSrcweir // Does old value exist?
635cdf0e10cSrcweir bool bFirstInit = !xPrevVarObj.Is();
636cdf0e10cSrcweir if( bFirstInit )
637cdf0e10cSrcweir {
638cdf0e10cSrcweir // Store information to instantiate object later
639cdf0e10cSrcweir SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
640cdf0e10cSrcweir if( pValObj != NULL )
641cdf0e10cSrcweir {
642cdf0e10cSrcweir String aObjClass = pValObj->GetClassName();
643cdf0e10cSrcweir
644cdf0e10cSrcweir SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
645cdf0e10cSrcweir if( pClassModuleObj != NULL )
646cdf0e10cSrcweir {
647cdf0e10cSrcweir SbModule* pClassModule = pClassModuleObj->getClassModule();
648cdf0e10cSrcweir GaDimAsNewRecoverHash[refVar] =
649cdf0e10cSrcweir DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
650cdf0e10cSrcweir }
651cdf0e10cSrcweir else if( aObjClass.EqualsIgnoreCaseAscii( "Collection" ) )
652cdf0e10cSrcweir {
653cdf0e10cSrcweir GaDimAsNewRecoverHash[refVar] =
654cdf0e10cSrcweir DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
655cdf0e10cSrcweir }
656cdf0e10cSrcweir }
657cdf0e10cSrcweir }
658cdf0e10cSrcweir }
659cdf0e10cSrcweir }
660cdf0e10cSrcweir }
661cdf0e10cSrcweir
662cdf0e10cSrcweir
663cdf0e10cSrcweir // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
664cdf0e10cSrcweir // in this case if there is a default prop involved the value of the
665cdf0e10cSrcweir // default property may infact be void so the type will also be SbxEMPTY
666cdf0e10cSrcweir // in this case we do not want to call checkUnoStructCopy 'cause that will
667cdf0e10cSrcweir // cause an error also
668cdf0e10cSrcweir if ( !bHandleDefaultProp || ( bHandleDefaultProp && ( refVar->GetType() != SbxEMPTY ) ) )
669cdf0e10cSrcweir // #67607 Uno-Structs kopieren
670cdf0e10cSrcweir checkUnoStructCopy( refVal, refVar );
671cdf0e10cSrcweir if( bFlagsChanged )
672cdf0e10cSrcweir refVar->SetFlags( n );
673cdf0e10cSrcweir }
674cdf0e10cSrcweir }
675cdf0e10cSrcweir
StepSET()676cdf0e10cSrcweir void SbiRuntime::StepSET()
677cdf0e10cSrcweir {
678cdf0e10cSrcweir SbxVariableRef refVal = PopVar();
679cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
680cdf0e10cSrcweir StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
681cdf0e10cSrcweir }
682cdf0e10cSrcweir
StepVBASET()683cdf0e10cSrcweir void SbiRuntime::StepVBASET()
684cdf0e10cSrcweir {
685cdf0e10cSrcweir SbxVariableRef refVal = PopVar();
686cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
687cdf0e10cSrcweir // don't handle default property
688cdf0e10cSrcweir StepSET_Impl( refVal, refVar, false ); // set obj = something
689cdf0e10cSrcweir }
690cdf0e10cSrcweir
691cdf0e10cSrcweir
692cdf0e10cSrcweir // JSM 07.10.95
StepLSET()693cdf0e10cSrcweir void SbiRuntime::StepLSET()
694cdf0e10cSrcweir {
695cdf0e10cSrcweir SbxVariableRef refVal = PopVar();
696cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
697cdf0e10cSrcweir if( refVar->GetType() != SbxSTRING
698cdf0e10cSrcweir || refVal->GetType() != SbxSTRING )
699cdf0e10cSrcweir Error( SbERR_INVALID_USAGE_OBJECT );
700cdf0e10cSrcweir else
701cdf0e10cSrcweir {
702cdf0e10cSrcweir // Store auf die eigene Methode (innerhalb einer Function)?
703cdf0e10cSrcweir sal_uInt16 n = refVar->GetFlags();
704cdf0e10cSrcweir if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
705cdf0e10cSrcweir refVar->SetFlag( SBX_WRITE );
706cdf0e10cSrcweir String aRefVarString = refVar->GetString();
707cdf0e10cSrcweir String aRefValString = refVal->GetString();
708cdf0e10cSrcweir
709cdf0e10cSrcweir sal_uInt16 nVarStrLen = aRefVarString.Len();
710cdf0e10cSrcweir sal_uInt16 nValStrLen = aRefValString.Len();
711cdf0e10cSrcweir String aNewStr;
712cdf0e10cSrcweir if( nVarStrLen > nValStrLen )
713cdf0e10cSrcweir {
714cdf0e10cSrcweir aRefVarString.Fill(nVarStrLen,' ');
715cdf0e10cSrcweir aNewStr = aRefValString.Copy( 0, nValStrLen );
716cdf0e10cSrcweir aNewStr += aRefVarString.Copy( nValStrLen, nVarStrLen - nValStrLen );
717cdf0e10cSrcweir }
718cdf0e10cSrcweir else
719cdf0e10cSrcweir {
720cdf0e10cSrcweir aNewStr = aRefValString.Copy( 0, nVarStrLen );
721cdf0e10cSrcweir }
722cdf0e10cSrcweir
723cdf0e10cSrcweir refVar->PutString( aNewStr );
724cdf0e10cSrcweir refVar->SetFlags( n );
725cdf0e10cSrcweir }
726cdf0e10cSrcweir }
727cdf0e10cSrcweir
728cdf0e10cSrcweir // JSM 07.10.95
StepRSET()729cdf0e10cSrcweir void SbiRuntime::StepRSET()
730cdf0e10cSrcweir {
731cdf0e10cSrcweir SbxVariableRef refVal = PopVar();
732cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
733cdf0e10cSrcweir if( refVar->GetType() != SbxSTRING
734cdf0e10cSrcweir || refVal->GetType() != SbxSTRING )
735cdf0e10cSrcweir Error( SbERR_INVALID_USAGE_OBJECT );
736cdf0e10cSrcweir else
737cdf0e10cSrcweir {
738cdf0e10cSrcweir // Store auf die eigene Methode (innerhalb einer Function)?
739cdf0e10cSrcweir sal_uInt16 n = refVar->GetFlags();
740cdf0e10cSrcweir if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
741cdf0e10cSrcweir refVar->SetFlag( SBX_WRITE );
742cdf0e10cSrcweir String aRefVarString = refVar->GetString();
743cdf0e10cSrcweir String aRefValString = refVal->GetString();
744cdf0e10cSrcweir
745cdf0e10cSrcweir sal_uInt16 nPos = 0;
746cdf0e10cSrcweir sal_uInt16 nVarStrLen = aRefVarString.Len();
747cdf0e10cSrcweir if( nVarStrLen > aRefValString.Len() )
748cdf0e10cSrcweir {
749cdf0e10cSrcweir aRefVarString.Fill(nVarStrLen,' ');
750cdf0e10cSrcweir nPos = nVarStrLen - aRefValString.Len();
751cdf0e10cSrcweir }
752cdf0e10cSrcweir aRefVarString = aRefVarString.Copy( 0, nPos );
753cdf0e10cSrcweir aRefVarString += aRefValString.Copy( 0, nVarStrLen - nPos );
754cdf0e10cSrcweir refVar->PutString(aRefVarString);
755cdf0e10cSrcweir
756cdf0e10cSrcweir refVar->SetFlags( n );
757cdf0e10cSrcweir }
758cdf0e10cSrcweir }
759cdf0e10cSrcweir
760cdf0e10cSrcweir // Ablage von TOS in TOS-1, dann ReadOnly-Bit setzen
761cdf0e10cSrcweir
StepPUTC()762cdf0e10cSrcweir void SbiRuntime::StepPUTC()
763cdf0e10cSrcweir {
764cdf0e10cSrcweir SbxVariableRef refVal = PopVar();
765cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
766cdf0e10cSrcweir refVar->SetFlag( SBX_WRITE );
767cdf0e10cSrcweir *refVar = *refVal;
768cdf0e10cSrcweir refVar->ResetFlag( SBX_WRITE );
769cdf0e10cSrcweir refVar->SetFlag( SBX_CONST );
770cdf0e10cSrcweir }
771cdf0e10cSrcweir
772cdf0e10cSrcweir // DIM
773cdf0e10cSrcweir // TOS = Variable fuer das Array mit Dimensionsangaben als Parameter
774cdf0e10cSrcweir
StepDIM()775cdf0e10cSrcweir void SbiRuntime::StepDIM()
776cdf0e10cSrcweir {
777cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
778cdf0e10cSrcweir DimImpl( refVar );
779cdf0e10cSrcweir }
780cdf0e10cSrcweir
781cdf0e10cSrcweir // #56204 DIM-Funktionalitaet in Hilfsmethode auslagern (step0.cxx)
DimImpl(SbxVariableRef refVar)782cdf0e10cSrcweir void SbiRuntime::DimImpl( SbxVariableRef refVar )
783cdf0e10cSrcweir {
784cdf0e10cSrcweir SbxArray* pDims = refVar->GetParameters();
785cdf0e10cSrcweir // Muss eine gerade Anzahl Argumente haben
786cdf0e10cSrcweir // Man denke daran, dass Arg[0] nicht zaehlt!
787cdf0e10cSrcweir if( pDims && !( pDims->Count() & 1 ) )
788cdf0e10cSrcweir StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
789cdf0e10cSrcweir else
790cdf0e10cSrcweir {
791cdf0e10cSrcweir SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
792cdf0e10cSrcweir SbxDimArray* pArray = new SbxDimArray( eType );
793cdf0e10cSrcweir // AB 2.4.1996, auch Arrays ohne Dimensionsangaben zulassen (VB-komp.)
794cdf0e10cSrcweir if( pDims )
795cdf0e10cSrcweir {
796cdf0e10cSrcweir refVar->ResetFlag( SBX_VAR_TO_DIM );
797cdf0e10cSrcweir
798cdf0e10cSrcweir for( sal_uInt16 i = 1; i < pDims->Count(); )
799cdf0e10cSrcweir {
800cdf0e10cSrcweir sal_Int32 lb = pDims->Get( i++ )->GetLong();
801cdf0e10cSrcweir sal_Int32 ub = pDims->Get( i++ )->GetLong();
802cdf0e10cSrcweir if( ub < lb )
803cdf0e10cSrcweir Error( SbERR_OUT_OF_RANGE ), ub = lb;
804cdf0e10cSrcweir pArray->AddDim32( lb, ub );
805cdf0e10cSrcweir if ( lb != ub )
806cdf0e10cSrcweir pArray->setHasFixedSize( true );
807cdf0e10cSrcweir }
808cdf0e10cSrcweir }
809cdf0e10cSrcweir else
810cdf0e10cSrcweir {
811cdf0e10cSrcweir // #62867 Beim Anlegen eines Arrays der Laenge 0 wie bei
812cdf0e10cSrcweir // Uno-Sequences der Laenge 0 eine Dimension anlegen
813cdf0e10cSrcweir pArray->unoAddDim( 0, -1 );
814cdf0e10cSrcweir }
815cdf0e10cSrcweir sal_uInt16 nSavFlags = refVar->GetFlags();
816cdf0e10cSrcweir refVar->ResetFlag( SBX_FIXED );
817cdf0e10cSrcweir refVar->PutObject( pArray );
818cdf0e10cSrcweir refVar->SetFlags( nSavFlags );
819cdf0e10cSrcweir refVar->SetParameters( NULL );
820cdf0e10cSrcweir }
821cdf0e10cSrcweir }
822cdf0e10cSrcweir
823cdf0e10cSrcweir // REDIM
824cdf0e10cSrcweir // TOS = Variable fuer das Array
825cdf0e10cSrcweir // argv = Dimensionsangaben
826cdf0e10cSrcweir
StepREDIM()827cdf0e10cSrcweir void SbiRuntime::StepREDIM()
828cdf0e10cSrcweir {
829cdf0e10cSrcweir // Im Moment ist es nichts anderes als Dim, da doppeltes Dim
830cdf0e10cSrcweir // bereits vom Compiler erkannt wird.
831cdf0e10cSrcweir StepDIM();
832cdf0e10cSrcweir }
833cdf0e10cSrcweir
834cdf0e10cSrcweir
835cdf0e10cSrcweir // Helper function for StepREDIMP
implCopyDimArray(SbxDimArray * pNewArray,SbxDimArray * pOldArray,short nMaxDimIndex,short nActualDim,sal_Int32 * pActualIndices,sal_Int32 * pLowerBounds,sal_Int32 * pUpperBounds)836cdf0e10cSrcweir void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
837cdf0e10cSrcweir short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
838cdf0e10cSrcweir {
839cdf0e10cSrcweir sal_Int32& ri = pActualIndices[nActualDim];
840cdf0e10cSrcweir for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
841cdf0e10cSrcweir {
842cdf0e10cSrcweir if( nActualDim < nMaxDimIndex )
843cdf0e10cSrcweir {
844cdf0e10cSrcweir implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
845cdf0e10cSrcweir pActualIndices, pLowerBounds, pUpperBounds );
846cdf0e10cSrcweir }
847cdf0e10cSrcweir else
848cdf0e10cSrcweir {
849cdf0e10cSrcweir SbxVariable* pSource = pOldArray->Get32( pActualIndices );
850cdf0e10cSrcweir SbxVariable* pDest = pNewArray->Get32( pActualIndices );
851cdf0e10cSrcweir if( pSource && pDest )
852cdf0e10cSrcweir *pDest = *pSource;
853cdf0e10cSrcweir }
854cdf0e10cSrcweir }
855cdf0e10cSrcweir }
856cdf0e10cSrcweir
857cdf0e10cSrcweir // REDIM PRESERVE
858cdf0e10cSrcweir // TOS = Variable fuer das Array
859cdf0e10cSrcweir // argv = Dimensionsangaben
860cdf0e10cSrcweir
StepREDIMP()861cdf0e10cSrcweir void SbiRuntime::StepREDIMP()
862cdf0e10cSrcweir {
863cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
864cdf0e10cSrcweir DimImpl( refVar );
865cdf0e10cSrcweir
866cdf0e10cSrcweir // Now check, if we can copy from the old array
867cdf0e10cSrcweir if( refRedimpArray.Is() )
868cdf0e10cSrcweir {
869cdf0e10cSrcweir SbxBase* pElemObj = refVar->GetObject();
870cdf0e10cSrcweir SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
871cdf0e10cSrcweir SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
872cdf0e10cSrcweir if( pNewArray )
873cdf0e10cSrcweir {
874cdf0e10cSrcweir short nDimsNew = pNewArray->GetDims();
875cdf0e10cSrcweir short nDimsOld = pOldArray->GetDims();
876cdf0e10cSrcweir short nDims = nDimsNew;
877cdf0e10cSrcweir sal_Bool bRangeError = sal_False;
878cdf0e10cSrcweir
879cdf0e10cSrcweir // Store dims to use them for copying later
880cdf0e10cSrcweir sal_Int32* pLowerBounds = new sal_Int32[nDims];
881cdf0e10cSrcweir sal_Int32* pUpperBounds = new sal_Int32[nDims];
882cdf0e10cSrcweir sal_Int32* pActualIndices = new sal_Int32[nDims];
883cdf0e10cSrcweir
884cdf0e10cSrcweir if( nDimsOld != nDimsNew )
885cdf0e10cSrcweir {
886cdf0e10cSrcweir bRangeError = sal_True;
887cdf0e10cSrcweir }
888cdf0e10cSrcweir else
889cdf0e10cSrcweir {
890cdf0e10cSrcweir // Compare bounds
891cdf0e10cSrcweir for( short i = 1 ; i <= nDims ; i++ )
892cdf0e10cSrcweir {
893cdf0e10cSrcweir sal_Int32 lBoundNew, uBoundNew;
894cdf0e10cSrcweir sal_Int32 lBoundOld, uBoundOld;
895cdf0e10cSrcweir pNewArray->GetDim32( i, lBoundNew, uBoundNew );
896cdf0e10cSrcweir pOldArray->GetDim32( i, lBoundOld, uBoundOld );
897cdf0e10cSrcweir
898cdf0e10cSrcweir /* #69094 Allow all dimensions to be changed
899cdf0e10cSrcweir although Visual Basic is not able to do so.
900cdf0e10cSrcweir // All bounds but the last have to be the same
901cdf0e10cSrcweir if( i < nDims && ( lBoundNew != lBoundOld || uBoundNew != uBoundOld ) )
902cdf0e10cSrcweir {
903cdf0e10cSrcweir bRangeError = sal_True;
904cdf0e10cSrcweir break;
905cdf0e10cSrcweir }
906cdf0e10cSrcweir else
907cdf0e10cSrcweir */
908cdf0e10cSrcweir {
909cdf0e10cSrcweir // #69094: if( i == nDims )
910cdf0e10cSrcweir {
911cdf0e10cSrcweir lBoundNew = std::max( lBoundNew, lBoundOld );
912cdf0e10cSrcweir uBoundNew = std::min( uBoundNew, uBoundOld );
913cdf0e10cSrcweir }
914cdf0e10cSrcweir short j = i - 1;
915cdf0e10cSrcweir pActualIndices[j] = pLowerBounds[j] = lBoundNew;
916cdf0e10cSrcweir pUpperBounds[j] = uBoundNew;
917cdf0e10cSrcweir }
918cdf0e10cSrcweir }
919cdf0e10cSrcweir }
920cdf0e10cSrcweir
921cdf0e10cSrcweir if( bRangeError )
922cdf0e10cSrcweir {
923cdf0e10cSrcweir StarBASIC::Error( SbERR_OUT_OF_RANGE );
924cdf0e10cSrcweir }
925cdf0e10cSrcweir else
926cdf0e10cSrcweir {
927cdf0e10cSrcweir // Copy data from old array by going recursively through all dimensions
928cdf0e10cSrcweir // (It would be faster to work on the flat internal data array of an
929cdf0e10cSrcweir // SbyArray but this solution is clearer and easier)
930cdf0e10cSrcweir implCopyDimArray( pNewArray, pOldArray, nDims - 1,
931cdf0e10cSrcweir 0, pActualIndices, pLowerBounds, pUpperBounds );
932cdf0e10cSrcweir }
933cdf0e10cSrcweir
934cdf0e10cSrcweir delete[] pUpperBounds;
935cdf0e10cSrcweir delete[] pLowerBounds;
936cdf0e10cSrcweir delete[] pActualIndices;
937cdf0e10cSrcweir refRedimpArray = NULL;
938cdf0e10cSrcweir }
939cdf0e10cSrcweir }
940cdf0e10cSrcweir
941cdf0e10cSrcweir //StarBASIC::FatalError( SbERR_NOT_IMPLEMENTED );
942cdf0e10cSrcweir }
943cdf0e10cSrcweir
944cdf0e10cSrcweir // REDIM_COPY
945cdf0e10cSrcweir // TOS = Array-Variable, Reference to array is copied
946cdf0e10cSrcweir // Variable is cleared as in ERASE
947cdf0e10cSrcweir
StepREDIMP_ERASE()948cdf0e10cSrcweir void SbiRuntime::StepREDIMP_ERASE()
949cdf0e10cSrcweir {
950cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
951cdf0e10cSrcweir SbxDataType eType = refVar->GetType();
952cdf0e10cSrcweir if( eType & SbxARRAY )
953cdf0e10cSrcweir {
954cdf0e10cSrcweir SbxBase* pElemObj = refVar->GetObject();
955cdf0e10cSrcweir SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
956cdf0e10cSrcweir if( pDimArray )
957cdf0e10cSrcweir {
958cdf0e10cSrcweir refRedimpArray = pDimArray;
959cdf0e10cSrcweir }
960cdf0e10cSrcweir
961cdf0e10cSrcweir // As in ERASE
962cdf0e10cSrcweir sal_uInt16 nSavFlags = refVar->GetFlags();
963cdf0e10cSrcweir refVar->ResetFlag( SBX_FIXED );
964cdf0e10cSrcweir refVar->SetType( SbxDataType(eType & 0x0FFF) );
965cdf0e10cSrcweir refVar->SetFlags( nSavFlags );
966cdf0e10cSrcweir refVar->Clear();
967cdf0e10cSrcweir }
968cdf0e10cSrcweir else
969cdf0e10cSrcweir if( refVar->IsFixed() )
970cdf0e10cSrcweir refVar->Clear();
971cdf0e10cSrcweir else
972cdf0e10cSrcweir refVar->SetType( SbxEMPTY );
973cdf0e10cSrcweir }
974cdf0e10cSrcweir
lcl_clearImpl(SbxVariableRef & refVar,SbxDataType & eType)975cdf0e10cSrcweir void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
976cdf0e10cSrcweir {
977cdf0e10cSrcweir sal_uInt16 nSavFlags = refVar->GetFlags();
978cdf0e10cSrcweir refVar->ResetFlag( SBX_FIXED );
979cdf0e10cSrcweir refVar->SetType( SbxDataType(eType & 0x0FFF) );
980cdf0e10cSrcweir refVar->SetFlags( nSavFlags );
981cdf0e10cSrcweir refVar->Clear();
982cdf0e10cSrcweir }
983cdf0e10cSrcweir
lcl_eraseImpl(SbxVariableRef & refVar,bool bVBAEnabled)984cdf0e10cSrcweir void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
985cdf0e10cSrcweir {
986cdf0e10cSrcweir SbxDataType eType = refVar->GetType();
987cdf0e10cSrcweir if( eType & SbxARRAY )
988cdf0e10cSrcweir {
989cdf0e10cSrcweir if ( bVBAEnabled )
990cdf0e10cSrcweir {
991cdf0e10cSrcweir SbxBase* pElemObj = refVar->GetObject();
992cdf0e10cSrcweir SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
993cdf0e10cSrcweir bool bClearValues = true;
994cdf0e10cSrcweir if( pDimArray )
995cdf0e10cSrcweir {
996cdf0e10cSrcweir if ( pDimArray->hasFixedSize() )
997cdf0e10cSrcweir {
998cdf0e10cSrcweir // Clear all Value(s)
999cdf0e10cSrcweir pDimArray->SbxArray::Clear();
1000cdf0e10cSrcweir bClearValues = false;
1001cdf0e10cSrcweir }
1002cdf0e10cSrcweir else
1003cdf0e10cSrcweir pDimArray->Clear(); // clear Dims
1004cdf0e10cSrcweir }
1005cdf0e10cSrcweir if ( bClearValues )
1006cdf0e10cSrcweir {
1007cdf0e10cSrcweir SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
1008cdf0e10cSrcweir if ( pArray )
1009cdf0e10cSrcweir pArray->Clear();
1010cdf0e10cSrcweir }
1011cdf0e10cSrcweir }
1012cdf0e10cSrcweir else
1013cdf0e10cSrcweir // AB 2.4.1996
1014cdf0e10cSrcweir // Arrays haben bei Erase nach VB ein recht komplexes Verhalten. Hier
1015cdf0e10cSrcweir // werden zunaechst nur die Typ-Probleme bei REDIM (#26295) beseitigt:
1016cdf0e10cSrcweir // Typ hart auf den Array-Typ setzen, da eine Variable mit Array
1017cdf0e10cSrcweir // SbxOBJECT ist. Bei REDIM entsteht dann ein SbxOBJECT-Array und
1018cdf0e10cSrcweir // der ursruengliche Typ geht verloren -> Laufzeitfehler
1019cdf0e10cSrcweir lcl_clearImpl( refVar, eType );
1020cdf0e10cSrcweir }
1021cdf0e10cSrcweir else
1022cdf0e10cSrcweir if( refVar->IsFixed() )
1023cdf0e10cSrcweir refVar->Clear();
1024cdf0e10cSrcweir else
1025cdf0e10cSrcweir refVar->SetType( SbxEMPTY );
1026cdf0e10cSrcweir }
1027cdf0e10cSrcweir
1028cdf0e10cSrcweir // Variable loeschen
1029cdf0e10cSrcweir // TOS = Variable
1030cdf0e10cSrcweir
StepERASE()1031cdf0e10cSrcweir void SbiRuntime::StepERASE()
1032cdf0e10cSrcweir {
1033cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
1034cdf0e10cSrcweir lcl_eraseImpl( refVar, bVBAEnabled );
1035cdf0e10cSrcweir }
1036cdf0e10cSrcweir
StepERASE_CLEAR()1037cdf0e10cSrcweir void SbiRuntime::StepERASE_CLEAR()
1038cdf0e10cSrcweir {
1039cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
1040cdf0e10cSrcweir lcl_eraseImpl( refVar, bVBAEnabled );
1041cdf0e10cSrcweir SbxDataType eType = refVar->GetType();
1042cdf0e10cSrcweir lcl_clearImpl( refVar, eType );
1043cdf0e10cSrcweir }
1044cdf0e10cSrcweir
StepARRAYACCESS()1045cdf0e10cSrcweir void SbiRuntime::StepARRAYACCESS()
1046cdf0e10cSrcweir {
1047cdf0e10cSrcweir if( !refArgv )
1048cdf0e10cSrcweir StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1049cdf0e10cSrcweir SbxVariableRef refVar = PopVar();
1050cdf0e10cSrcweir refVar->SetParameters( refArgv );
1051cdf0e10cSrcweir PopArgv();
1052cdf0e10cSrcweir PushVar( CheckArray( refVar ) );
1053cdf0e10cSrcweir }
1054cdf0e10cSrcweir
StepBYVAL()1055cdf0e10cSrcweir void SbiRuntime::StepBYVAL()
1056cdf0e10cSrcweir {
1057cdf0e10cSrcweir // Copy variable on stack to break call by reference
1058cdf0e10cSrcweir SbxVariableRef pVar = PopVar();
1059cdf0e10cSrcweir SbxDataType t = pVar->GetType();
1060cdf0e10cSrcweir
1061cdf0e10cSrcweir SbxVariable* pCopyVar = new SbxVariable( t );
1062cdf0e10cSrcweir pCopyVar->SetFlag( SBX_READWRITE );
1063cdf0e10cSrcweir *pCopyVar = *pVar;
1064cdf0e10cSrcweir
1065cdf0e10cSrcweir PushVar( pCopyVar );
1066cdf0e10cSrcweir }
1067cdf0e10cSrcweir
1068cdf0e10cSrcweir // Einrichten eines Argvs
1069cdf0e10cSrcweir // nOp1 bleibt so -> 1. Element ist Returnwert
1070cdf0e10cSrcweir
StepARGC()1071cdf0e10cSrcweir void SbiRuntime::StepARGC()
1072cdf0e10cSrcweir {
1073cdf0e10cSrcweir PushArgv();
1074cdf0e10cSrcweir refArgv = new SbxArray;
1075cdf0e10cSrcweir nArgc = 1;
1076cdf0e10cSrcweir }
1077cdf0e10cSrcweir
1078cdf0e10cSrcweir // Speichern eines Arguments in Argv
1079cdf0e10cSrcweir
StepARGV()1080cdf0e10cSrcweir void SbiRuntime::StepARGV()
1081cdf0e10cSrcweir {
1082cdf0e10cSrcweir if( !refArgv )
1083cdf0e10cSrcweir StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1084cdf0e10cSrcweir else
1085cdf0e10cSrcweir {
1086cdf0e10cSrcweir SbxVariableRef pVal = PopVar();
1087cdf0e10cSrcweir
1088cdf0e10cSrcweir // Before fix of #94916:
1089cdf0e10cSrcweir // if( pVal->ISA(SbxMethod) || pVal->ISA(SbxProperty) )
1090cdf0e10cSrcweir if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
1091cdf0e10cSrcweir {
1092cdf0e10cSrcweir // Methoden und Properties evaluieren!
1093cdf0e10cSrcweir SbxVariable* pRes = new SbxVariable( *pVal );
1094cdf0e10cSrcweir pVal = pRes;
1095cdf0e10cSrcweir }
1096cdf0e10cSrcweir refArgv->Put( pVal, nArgc++ );
1097cdf0e10cSrcweir }
1098cdf0e10cSrcweir }
1099cdf0e10cSrcweir
1100cdf0e10cSrcweir // Input to Variable. Die Variable ist auf TOS und wird
1101cdf0e10cSrcweir // anschliessend entfernt.
1102cdf0e10cSrcweir
StepINPUT()1103cdf0e10cSrcweir void SbiRuntime::StepINPUT()
1104cdf0e10cSrcweir {
1105cdf0e10cSrcweir String s;
1106cdf0e10cSrcweir char ch = 0;
1107cdf0e10cSrcweir SbError err;
1108cdf0e10cSrcweir // Skip whitespace
1109cdf0e10cSrcweir while( ( err = pIosys->GetError() ) == 0 )
1110cdf0e10cSrcweir {
1111cdf0e10cSrcweir ch = pIosys->Read();
1112cdf0e10cSrcweir if( ch != ' ' && ch != '\t' && ch != '\n' )
1113cdf0e10cSrcweir break;
1114cdf0e10cSrcweir }
1115cdf0e10cSrcweir if( !err )
1116cdf0e10cSrcweir {
1117cdf0e10cSrcweir // Scan until comma or whitespace
1118cdf0e10cSrcweir char sep = ( ch == '"' ) ? ch : 0;
1119cdf0e10cSrcweir if( sep ) ch = pIosys->Read();
1120cdf0e10cSrcweir while( ( err = pIosys->GetError() ) == 0 )
1121cdf0e10cSrcweir {
1122cdf0e10cSrcweir if( ch == sep )
1123cdf0e10cSrcweir {
1124cdf0e10cSrcweir ch = pIosys->Read();
1125cdf0e10cSrcweir if( ch != sep )
1126cdf0e10cSrcweir break;
1127cdf0e10cSrcweir }
1128cdf0e10cSrcweir else if( !sep && (ch == ',' || ch == '\n') )
1129cdf0e10cSrcweir break;
1130cdf0e10cSrcweir s += ch;
1131cdf0e10cSrcweir ch = pIosys->Read();
1132cdf0e10cSrcweir }
1133cdf0e10cSrcweir // skip whitespace
1134cdf0e10cSrcweir if( ch == ' ' || ch == '\t' )
1135cdf0e10cSrcweir while( ( err = pIosys->GetError() ) == 0 )
1136cdf0e10cSrcweir {
1137cdf0e10cSrcweir if( ch != ' ' && ch != '\t' && ch != '\n' )
1138cdf0e10cSrcweir break;
1139cdf0e10cSrcweir ch = pIosys->Read();
1140cdf0e10cSrcweir }
1141cdf0e10cSrcweir }
1142cdf0e10cSrcweir if( !err )
1143cdf0e10cSrcweir {
1144cdf0e10cSrcweir SbxVariableRef pVar = GetTOS();
1145cdf0e10cSrcweir // Zuerst versuchen, die Variable mit einem numerischen Wert
1146cdf0e10cSrcweir // zu fuellen, dann mit einem Stringwert
1147cdf0e10cSrcweir if( !pVar->IsFixed() || pVar->IsNumeric() )
1148cdf0e10cSrcweir {
1149cdf0e10cSrcweir sal_uInt16 nLen = 0;
1150cdf0e10cSrcweir if( !pVar->Scan( s, &nLen ) )
1151cdf0e10cSrcweir {
1152cdf0e10cSrcweir err = SbxBase::GetError();
1153cdf0e10cSrcweir SbxBase::ResetError();
1154cdf0e10cSrcweir }
1155cdf0e10cSrcweir // Der Wert muss komplett eingescant werden
1156cdf0e10cSrcweir else if( nLen != s.Len() && !pVar->PutString( s ) )
1157cdf0e10cSrcweir {
1158cdf0e10cSrcweir err = SbxBase::GetError();
1159cdf0e10cSrcweir SbxBase::ResetError();
1160cdf0e10cSrcweir }
1161cdf0e10cSrcweir else if( nLen != s.Len() && pVar->IsNumeric() )
1162cdf0e10cSrcweir {
1163cdf0e10cSrcweir err = SbxBase::GetError();
1164cdf0e10cSrcweir SbxBase::ResetError();
1165cdf0e10cSrcweir if( !err )
1166cdf0e10cSrcweir err = SbERR_CONVERSION;
1167cdf0e10cSrcweir }
1168cdf0e10cSrcweir }
1169cdf0e10cSrcweir else
1170cdf0e10cSrcweir {
1171cdf0e10cSrcweir pVar->PutString( s );
1172cdf0e10cSrcweir err = SbxBase::GetError();
1173cdf0e10cSrcweir SbxBase::ResetError();
1174cdf0e10cSrcweir }
1175cdf0e10cSrcweir }
1176cdf0e10cSrcweir if( err == SbERR_USER_ABORT )
1177cdf0e10cSrcweir Error( err );
1178cdf0e10cSrcweir else if( err )
1179cdf0e10cSrcweir {
1180cdf0e10cSrcweir if( pRestart && !pIosys->GetChannel() )
1181cdf0e10cSrcweir {
1182cdf0e10cSrcweir BasResId aId( IDS_SBERR_START + 4 );
1183cdf0e10cSrcweir String aMsg( aId );
1184cdf0e10cSrcweir
1185*7a164331Smseidel //****** DON'T CHECK IN, TEST ONLY *******
1186*7a164331Smseidel //****** DON'T CHECK IN, TEST ONLY *******
1187cdf0e10cSrcweir // ErrorBox( NULL, WB_OK, aMsg ).Execute();
1188*7a164331Smseidel //****** DON'T CHECK IN, TEST ONLY *******
1189*7a164331Smseidel //****** DON'T CHECK IN, TEST ONLY *******
1190cdf0e10cSrcweir
1191cdf0e10cSrcweir pCode = pRestart;
1192cdf0e10cSrcweir }
1193cdf0e10cSrcweir else
1194cdf0e10cSrcweir Error( err );
1195cdf0e10cSrcweir }
1196cdf0e10cSrcweir else
1197cdf0e10cSrcweir {
1198cdf0e10cSrcweir // pIosys->ResetChannel();
1199cdf0e10cSrcweir PopVar();
1200cdf0e10cSrcweir }
1201cdf0e10cSrcweir }
1202cdf0e10cSrcweir
1203cdf0e10cSrcweir // Line Input to Variable. Die Variable ist auf TOS und wird
1204cdf0e10cSrcweir // anschliessend entfernt.
1205cdf0e10cSrcweir
StepLINPUT()1206cdf0e10cSrcweir void SbiRuntime::StepLINPUT()
1207cdf0e10cSrcweir {
1208cdf0e10cSrcweir ByteString aInput;
1209cdf0e10cSrcweir pIosys->Read( aInput );
1210cdf0e10cSrcweir Error( pIosys->GetError() );
1211cdf0e10cSrcweir SbxVariableRef p = PopVar();
1212cdf0e10cSrcweir p->PutString( String( aInput, gsl_getSystemTextEncoding() ) );
1213cdf0e10cSrcweir // pIosys->ResetChannel();
1214cdf0e10cSrcweir }
1215cdf0e10cSrcweir
1216cdf0e10cSrcweir // Programmende
1217cdf0e10cSrcweir
StepSTOP()1218cdf0e10cSrcweir void SbiRuntime::StepSTOP()
1219cdf0e10cSrcweir {
1220cdf0e10cSrcweir pInst->Stop();
1221cdf0e10cSrcweir }
1222cdf0e10cSrcweir
1223cdf0e10cSrcweir // FOR-Variable initialisieren
1224cdf0e10cSrcweir
StepINITFOR()1225cdf0e10cSrcweir void SbiRuntime::StepINITFOR()
1226cdf0e10cSrcweir {
1227cdf0e10cSrcweir PushFor();
1228cdf0e10cSrcweir }
1229cdf0e10cSrcweir
StepINITFOREACH()1230cdf0e10cSrcweir void SbiRuntime::StepINITFOREACH()
1231cdf0e10cSrcweir {
1232cdf0e10cSrcweir PushForEach();
1233cdf0e10cSrcweir }
1234cdf0e10cSrcweir
1235cdf0e10cSrcweir // FOR-Variable inkrementieren
1236cdf0e10cSrcweir
StepNEXT()1237cdf0e10cSrcweir void SbiRuntime::StepNEXT()
1238cdf0e10cSrcweir {
1239cdf0e10cSrcweir if( !pForStk )
1240cdf0e10cSrcweir {
1241cdf0e10cSrcweir StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1242cdf0e10cSrcweir return;
1243cdf0e10cSrcweir }
1244cdf0e10cSrcweir if( pForStk->eForType == FOR_TO )
1245cdf0e10cSrcweir pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
1246cdf0e10cSrcweir }
1247cdf0e10cSrcweir
1248cdf0e10cSrcweir // Anfang CASE: TOS in CASE-Stack
1249cdf0e10cSrcweir
StepCASE()1250cdf0e10cSrcweir void SbiRuntime::StepCASE()
1251cdf0e10cSrcweir {
1252cdf0e10cSrcweir if( !refCaseStk.Is() )
1253cdf0e10cSrcweir refCaseStk = new SbxArray;
1254cdf0e10cSrcweir SbxVariableRef xVar = PopVar();
1255cdf0e10cSrcweir refCaseStk->Put( xVar, refCaseStk->Count() );
1256cdf0e10cSrcweir }
1257cdf0e10cSrcweir
1258cdf0e10cSrcweir // Ende CASE: Variable freigeben
1259cdf0e10cSrcweir
StepENDCASE()1260cdf0e10cSrcweir void SbiRuntime::StepENDCASE()
1261cdf0e10cSrcweir {
1262cdf0e10cSrcweir if( !refCaseStk || !refCaseStk->Count() )
1263cdf0e10cSrcweir StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1264cdf0e10cSrcweir else
1265cdf0e10cSrcweir refCaseStk->Remove( refCaseStk->Count() - 1 );
1266cdf0e10cSrcweir }
1267cdf0e10cSrcweir
1268cdf0e10cSrcweir // Standard-Fehlerbehandlung
1269cdf0e10cSrcweir
StepSTDERROR()1270cdf0e10cSrcweir void SbiRuntime::StepSTDERROR()
1271cdf0e10cSrcweir {
1272cdf0e10cSrcweir pError = NULL; bError = sal_True;
1273cdf0e10cSrcweir pInst->aErrorMsg = String();
1274cdf0e10cSrcweir pInst->nErr = 0L;
1275cdf0e10cSrcweir pInst->nErl = 0;
1276cdf0e10cSrcweir nError = 0L;
1277cdf0e10cSrcweir SbxErrObject::getUnoErrObject()->Clear();
1278cdf0e10cSrcweir }
1279cdf0e10cSrcweir
StepNOERROR()1280cdf0e10cSrcweir void SbiRuntime::StepNOERROR()
1281cdf0e10cSrcweir {
1282cdf0e10cSrcweir pInst->aErrorMsg = String();
1283cdf0e10cSrcweir pInst->nErr = 0L;
1284cdf0e10cSrcweir pInst->nErl = 0;
1285cdf0e10cSrcweir nError = 0L;
1286cdf0e10cSrcweir SbxErrObject::getUnoErrObject()->Clear();
1287cdf0e10cSrcweir bError = sal_False;
1288cdf0e10cSrcweir }
1289cdf0e10cSrcweir
1290cdf0e10cSrcweir // UP verlassen
1291cdf0e10cSrcweir
StepLEAVE()1292cdf0e10cSrcweir void SbiRuntime::StepLEAVE()
1293cdf0e10cSrcweir {
1294cdf0e10cSrcweir bRun = sal_False;
1295cdf0e10cSrcweir // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
1296cdf0e10cSrcweir if ( bInError && pError )
1297cdf0e10cSrcweir SbxErrObject::getUnoErrObject()->Clear();
1298cdf0e10cSrcweir }
1299cdf0e10cSrcweir
StepCHANNEL()1300cdf0e10cSrcweir void SbiRuntime::StepCHANNEL() // TOS = Kanalnummer
1301cdf0e10cSrcweir {
1302cdf0e10cSrcweir SbxVariableRef pChan = PopVar();
1303cdf0e10cSrcweir short nChan = pChan->GetInteger();
1304cdf0e10cSrcweir pIosys->SetChannel( nChan );
1305cdf0e10cSrcweir Error( pIosys->GetError() );
1306cdf0e10cSrcweir }
1307cdf0e10cSrcweir
StepCHANNEL0()1308cdf0e10cSrcweir void SbiRuntime::StepCHANNEL0()
1309cdf0e10cSrcweir {
1310cdf0e10cSrcweir pIosys->ResetChannel();
1311cdf0e10cSrcweir }
1312cdf0e10cSrcweir
StepPRINT()1313cdf0e10cSrcweir void SbiRuntime::StepPRINT() // print TOS
1314cdf0e10cSrcweir {
1315cdf0e10cSrcweir SbxVariableRef p = PopVar();
1316cdf0e10cSrcweir String s1 = p->GetString();
1317cdf0e10cSrcweir String s;
1318cdf0e10cSrcweir if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
1319cdf0e10cSrcweir s = ' '; // ein Blank davor
1320cdf0e10cSrcweir s += s1;
1321cdf0e10cSrcweir ByteString aByteStr( s, gsl_getSystemTextEncoding() );
1322cdf0e10cSrcweir pIosys->Write( aByteStr );
1323cdf0e10cSrcweir Error( pIosys->GetError() );
1324cdf0e10cSrcweir }
1325cdf0e10cSrcweir
StepPRINTF()1326cdf0e10cSrcweir void SbiRuntime::StepPRINTF() // print TOS in field
1327cdf0e10cSrcweir {
1328cdf0e10cSrcweir SbxVariableRef p = PopVar();
1329cdf0e10cSrcweir String s1 = p->GetString();
1330cdf0e10cSrcweir String s;
1331cdf0e10cSrcweir if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
1332cdf0e10cSrcweir s = ' '; // ein Blank davor
1333cdf0e10cSrcweir s += s1;
1334cdf0e10cSrcweir s.Expand( 14, ' ' );
1335cdf0e10cSrcweir ByteString aByteStr( s, gsl_getSystemTextEncoding() );
1336cdf0e10cSrcweir pIosys->Write( aByteStr );
1337cdf0e10cSrcweir Error( pIosys->GetError() );
1338cdf0e10cSrcweir }
1339cdf0e10cSrcweir
StepWRITE()1340cdf0e10cSrcweir void SbiRuntime::StepWRITE() // write TOS
1341cdf0e10cSrcweir {
1342cdf0e10cSrcweir SbxVariableRef p = PopVar();
1343cdf0e10cSrcweir // Muss der String gekapselt werden?
1344cdf0e10cSrcweir char ch = 0;
1345cdf0e10cSrcweir switch (p->GetType() )
1346cdf0e10cSrcweir {
1347cdf0e10cSrcweir case SbxSTRING: ch = '"'; break;
1348cdf0e10cSrcweir case SbxCURRENCY:
1349cdf0e10cSrcweir case SbxBOOL:
1350cdf0e10cSrcweir case SbxDATE: ch = '#'; break;
1351cdf0e10cSrcweir default: break;
1352cdf0e10cSrcweir }
1353cdf0e10cSrcweir String s;
1354cdf0e10cSrcweir if( ch )
1355cdf0e10cSrcweir s += ch;
1356cdf0e10cSrcweir s += p->GetString();
1357cdf0e10cSrcweir if( ch )
1358cdf0e10cSrcweir s += ch;
1359cdf0e10cSrcweir ByteString aByteStr( s, gsl_getSystemTextEncoding() );
1360cdf0e10cSrcweir pIosys->Write( aByteStr );
1361cdf0e10cSrcweir Error( pIosys->GetError() );
1362cdf0e10cSrcweir }
1363cdf0e10cSrcweir
StepRENAME()1364cdf0e10cSrcweir void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
1365cdf0e10cSrcweir {
1366cdf0e10cSrcweir SbxVariableRef pTos1 = PopVar();
1367cdf0e10cSrcweir SbxVariableRef pTos = PopVar();
1368cdf0e10cSrcweir String aDest = pTos1->GetString();
1369cdf0e10cSrcweir String aSource = pTos->GetString();
1370cdf0e10cSrcweir
1371cdf0e10cSrcweir // <-- UCB
1372cdf0e10cSrcweir if( hasUno() )
1373cdf0e10cSrcweir {
1374cdf0e10cSrcweir implStepRenameUCB( aSource, aDest );
1375cdf0e10cSrcweir }
1376cdf0e10cSrcweir else
1377cdf0e10cSrcweir // --> UCB
1378cdf0e10cSrcweir {
1379cdf0e10cSrcweir #ifdef _OLD_FILE_IMPL
1380cdf0e10cSrcweir DirEntry aSourceDirEntry( aSource );
1381cdf0e10cSrcweir if( aSourceDirEntry.Exists() )
1382cdf0e10cSrcweir {
1383cdf0e10cSrcweir if( aSourceDirEntry.MoveTo( DirEntry(aDest) ) != FSYS_ERR_OK )
1384cdf0e10cSrcweir StarBASIC::Error( SbERR_PATH_NOT_FOUND );
1385cdf0e10cSrcweir }
1386cdf0e10cSrcweir else
1387cdf0e10cSrcweir StarBASIC::Error( SbERR_PATH_NOT_FOUND );
1388cdf0e10cSrcweir #else
1389cdf0e10cSrcweir implStepRenameOSL( aSource, aDest );
1390cdf0e10cSrcweir #endif
1391cdf0e10cSrcweir }
1392cdf0e10cSrcweir }
1393cdf0e10cSrcweir
1394cdf0e10cSrcweir // TOS = Prompt
1395cdf0e10cSrcweir
StepPROMPT()1396cdf0e10cSrcweir void SbiRuntime::StepPROMPT()
1397cdf0e10cSrcweir {
1398cdf0e10cSrcweir SbxVariableRef p = PopVar();
1399cdf0e10cSrcweir ByteString aStr( p->GetString(), gsl_getSystemTextEncoding() );
1400cdf0e10cSrcweir pIosys->SetPrompt( aStr );
1401cdf0e10cSrcweir }
1402cdf0e10cSrcweir
1403cdf0e10cSrcweir // Set Restart point
1404cdf0e10cSrcweir
StepRESTART()1405cdf0e10cSrcweir void SbiRuntime::StepRESTART()
1406cdf0e10cSrcweir {
1407cdf0e10cSrcweir pRestart = pCode;
1408cdf0e10cSrcweir }
1409cdf0e10cSrcweir
1410cdf0e10cSrcweir // Leerer Ausdruck auf Stack fuer fehlenden Parameter
1411cdf0e10cSrcweir
StepEMPTY()1412cdf0e10cSrcweir void SbiRuntime::StepEMPTY()
1413cdf0e10cSrcweir {
1414cdf0e10cSrcweir // #57915 Die Semantik von StepEMPTY() ist die Repraesentation eines fehlenden
1415cdf0e10cSrcweir // Arguments. Dies wird in VB durch ein durch den Wert 448 (SbERR_NAMED_NOT_FOUND)
1416cdf0e10cSrcweir // vom Typ Error repraesentiert. StepEmpty jetzt muesste besser StepMISSING()
1417cdf0e10cSrcweir // heissen, aber der Name wird der Einfachkeit halber beibehalten.
1418cdf0e10cSrcweir SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
1419cdf0e10cSrcweir xVar->PutErr( 448 );
1420cdf0e10cSrcweir PushVar( xVar );
1421cdf0e10cSrcweir // ALT: PushVar( new SbxVariable( SbxEMPTY ) );
1422cdf0e10cSrcweir }
1423cdf0e10cSrcweir
1424cdf0e10cSrcweir // TOS = Fehlercode
1425cdf0e10cSrcweir
StepERROR()1426cdf0e10cSrcweir void SbiRuntime::StepERROR()
1427cdf0e10cSrcweir {
1428cdf0e10cSrcweir SbxVariableRef refCode = PopVar();
1429cdf0e10cSrcweir sal_uInt16 n = refCode->GetUShort();
1430cdf0e10cSrcweir SbError error = StarBASIC::GetSfxFromVBError( n );
1431cdf0e10cSrcweir if ( bVBAEnabled )
1432cdf0e10cSrcweir pInst->Error( error );
1433cdf0e10cSrcweir else
1434cdf0e10cSrcweir Error( error );
1435cdf0e10cSrcweir }
1436cdf0e10cSrcweir
1437