summaryrefslogtreecommitdiff
path: root/basic/source/runtime/step0.cxx
diff options
context:
space:
mode:
Diffstat (limited to 'basic/source/runtime/step0.cxx')
-rw-r--r--basic/source/runtime/step0.cxx1332
1 files changed, 1332 insertions, 0 deletions
diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx
new file mode 100644
index 000000000000..06a8bb19af00
--- /dev/null
+++ b/basic/source/runtime/step0.cxx
@@ -0,0 +1,1332 @@
+/*************************************************************************
+ *
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * Copyright 2000, 2010 Oracle and/or its affiliates.
+ *
+ * OpenOffice.org - a multi-platform office productivity suite
+ *
+ * This file is part of OpenOffice.org.
+ *
+ * OpenOffice.org is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License version 3
+ * only, as published by the Free Software Foundation.
+ *
+ * OpenOffice.org is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License version 3 for more details
+ * (a copy is included in the LICENSE file that accompanied this code).
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * version 3 along with OpenOffice.org. If not, see
+ * <http://www.openoffice.org/license.html>
+ * for a copy of the LGPLv3 License.
+ *
+ ************************************************************************/
+
+// MARKER(update_precomp.py): autogen include statement, do not remove
+#include "precompiled_basic.hxx"
+#include <vcl/msgbox.hxx>
+#include <tools/fsys.hxx>
+
+#include "errobject.hxx"
+#include "runtime.hxx"
+#include "sbintern.hxx"
+#include "iosys.hxx"
+#include <sb.hrc>
+#include <basrid.hxx>
+#include "sbunoobj.hxx"
+#include "image.hxx"
+#include <com/sun/star/uno/Any.hxx>
+#include <com/sun/star/util/SearchOptions.hdl>
+#include <vcl/svapp.hxx>
+#include <unotools/textsearch.hxx>
+
+Reference< XInterface > createComListener( const Any& aControlAny, const ::rtl::OUString& aVBAType,
+ const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj );
+
+#include <algorithm>
+
+SbxVariable* getDefaultProp( SbxVariable* pRef );
+
+void SbiRuntime::StepNOP()
+{}
+
+void SbiRuntime::StepArith( SbxOperator eOp )
+{
+ SbxVariableRef p1 = PopVar();
+ TOSMakeTemp();
+ SbxVariable* p2 = GetTOS();
+
+
+ // This could & should be moved to the MakeTempTOS() method in runtime.cxx
+ // In the code which this is cut'npaste from there is a check for a ref
+ // count != 1 based on which the copy of the SbxVariable is done.
+ // see orig code in MakeTempTOS ( and I'm not sure what the significance,
+ // of that is )
+ // here we alway seem to have a refcount of 1. Also it seems that
+ // MakeTempTOS is called for other operation, so I hold off for now
+ // until I have a better idea
+ if ( bVBAEnabled
+ && ( p2->GetType() == SbxOBJECT || p2->GetType() == SbxVARIANT )
+ )
+ {
+ SbxVariable* pDflt = getDefaultProp( p2 );
+ if ( pDflt )
+ {
+ pDflt->Broadcast( SBX_HINT_DATAWANTED );
+ // replacing new p2 on stack causes object pointed by
+ // pDft->pParent to be deleted, when p2->Compute() is
+ // called below pParent is accessed ( but its deleted )
+ // so set it to NULL now
+ pDflt->SetParent( NULL );
+ p2 = new SbxVariable( *pDflt );
+ p2->SetFlag( SBX_READWRITE );
+ refExprStk->Put( p2, nExprLvl - 1 );
+ }
+ }
+
+ p2->ResetFlag( SBX_FIXED );
+ p2->Compute( eOp, *p1 );
+
+ checkArithmeticOverflow( p2 );
+}
+
+void SbiRuntime::StepUnary( SbxOperator eOp )
+{
+ TOSMakeTemp();
+ SbxVariable* p = GetTOS();
+ p->Compute( eOp, *p );
+}
+
+void SbiRuntime::StepCompare( SbxOperator eOp )
+{
+ SbxVariableRef p1 = PopVar();
+ SbxVariableRef p2 = PopVar();
+
+ // Make sure objects with default params have
+ // values ( and type ) set as appropriate
+ SbxDataType p1Type = p1->GetType();
+ SbxDataType p2Type = p2->GetType();
+ if ( p1Type == p2Type )
+ {
+ if ( p1Type == SbxEMPTY )
+ {
+ p1->Broadcast( SBX_HINT_DATAWANTED );
+ p2->Broadcast( SBX_HINT_DATAWANTED );
+ }
+ // if both sides are an object and have default props
+ // then we need to use the default props
+ // we don't need to worry if only one side ( lhs, rhs ) is an
+ // object ( object side will get coerced to correct type in
+ // Compare )
+ else if ( p1Type == SbxOBJECT )
+ {
+ SbxVariable* pDflt = getDefaultProp( p1 );
+ if ( pDflt )
+ {
+ p1 = pDflt;
+ p1->Broadcast( SBX_HINT_DATAWANTED );
+ }
+ pDflt = getDefaultProp( p2 );
+ if ( pDflt )
+ {
+ p2 = pDflt;
+ p2->Broadcast( SBX_HINT_DATAWANTED );
+ }
+ }
+
+ }
+#ifndef WIN
+ static SbxVariable* pTRUE = NULL;
+ static SbxVariable* pFALSE = NULL;
+
+ if( p2->Compare( eOp, *p1 ) )
+ {
+ if( !pTRUE )
+ {
+ pTRUE = new SbxVariable;
+ pTRUE->PutBool( TRUE );
+ pTRUE->AddRef();
+ }
+ PushVar( pTRUE );
+ }
+ else
+ {
+ if( !pFALSE )
+ {
+ pFALSE = new SbxVariable;
+ pFALSE->PutBool( FALSE );
+ pFALSE->AddRef();
+ }
+ PushVar( pFALSE );
+ }
+#else
+ BOOL bRes = p2->Compare( eOp, *p1 );
+ SbxVariable* pRes = new SbxVariable;
+ pRes->PutBool( bRes );
+ PushVar( pRes );
+#endif
+}
+
+void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
+void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
+void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
+void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
+void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
+void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
+void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
+void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
+void SbiRuntime::StepAND() { StepArith( SbxAND ); }
+void SbiRuntime::StepOR() { StepArith( SbxOR ); }
+void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
+void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
+void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
+
+void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
+void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
+
+void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
+void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
+void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
+void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
+void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
+void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
+
+namespace
+{
+ bool NeedEsc(sal_Unicode cCode)
+ {
+ String sEsc(RTL_CONSTASCII_USTRINGPARAM(".^$+\\|{}()"));
+ return (STRING_NOTFOUND != sEsc.Search(cCode));
+ }
+
+ String VBALikeToRegexp(const String &rIn)
+ {
+ String sResult;
+ const sal_Unicode *start = rIn.GetBuffer();
+ const sal_Unicode *end = start + rIn.Len();
+
+ int seenright = 0;
+
+ sResult.Append('^');
+
+ while (start < end)
+ {
+ switch (*start)
+ {
+ case '?':
+ sResult.Append('.');
+ start++;
+ break;
+ case '*':
+ sResult.Append(String(RTL_CONSTASCII_USTRINGPARAM(".*")));
+ start++;
+ break;
+ case '#':
+ sResult.Append(String(RTL_CONSTASCII_USTRINGPARAM("[0-9]")));
+ start++;
+ break;
+ case ']':
+ sResult.Append('\\');
+ sResult.Append(*start++);
+ break;
+ case '[':
+ sResult.Append(*start++);
+ seenright = 0;
+ while (start < end && !seenright)
+ {
+ switch (*start)
+ {
+ case '[':
+ case '?':
+ case '*':
+ sResult.Append('\\');
+ sResult.Append(*start);
+ break;
+ case ']':
+ sResult.Append(*start);
+ seenright = 1;
+ break;
+ case '!':
+ sResult.Append('^');
+ break;
+ default:
+ if (NeedEsc(*start))
+ sResult.Append('\\');
+ sResult.Append(*start);
+ break;
+ }
+ start++;
+ }
+ break;
+ default:
+ if (NeedEsc(*start))
+ sResult.Append('\\');
+ sResult.Append(*start++);
+ }
+ }
+
+ sResult.Append('$');
+
+ return sResult;
+ }
+}
+
+void SbiRuntime::StepLIKE()
+{
+ SbxVariableRef refVar1 = PopVar();
+ SbxVariableRef refVar2 = PopVar();
+
+ String pattern = VBALikeToRegexp(refVar1->GetString());
+ String value = refVar2->GetString();
+
+ com::sun::star::util::SearchOptions aSearchOpt;
+
+ aSearchOpt.algorithmType = com::sun::star::util::SearchAlgorithms_REGEXP;
+
+ aSearchOpt.Locale = Application::GetSettings().GetLocale();
+ aSearchOpt.searchString = pattern;
+
+ int bTextMode(1);
+ bool bCompatibility = ( pINST && pINST->IsCompatibility() );
+ if( bCompatibility )
+ bTextMode = GetImageFlag( SBIMG_COMPARETEXT );
+
+ if( bTextMode )
+ aSearchOpt.transliterateFlags |= com::sun::star::i18n::TransliterationModules_IGNORE_CASE;
+
+ SbxVariable* pRes = new SbxVariable;
+ utl::TextSearch aSearch(aSearchOpt);
+ xub_StrLen nStart=0, nEnd=value.Len();
+ int bRes = aSearch.SearchFrwrd(value, &nStart, &nEnd);
+ pRes->PutBool( bRes != 0 );
+
+ PushVar( pRes );
+}
+
+// TOS und TOS-1 sind beides Objektvariable und enthalten den selben Pointer
+
+void SbiRuntime::StepIS()
+{
+ SbxVariableRef refVar1 = PopVar();
+ SbxVariableRef refVar2 = PopVar();
+
+ SbxDataType eType1 = refVar1->GetType();
+ SbxDataType eType2 = refVar2->GetType();
+ if ( eType1 == SbxEMPTY )
+ {
+ refVar1->Broadcast( SBX_HINT_DATAWANTED );
+ eType1 = refVar1->GetType();
+ }
+ if ( eType2 == SbxEMPTY )
+ {
+ refVar2->Broadcast( SBX_HINT_DATAWANTED );
+ eType2 = refVar2->GetType();
+ }
+
+ BOOL bRes = BOOL( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
+ if ( bVBAEnabled && !bRes )
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
+ SbxVariable* pRes = new SbxVariable;
+ pRes->PutBool( bRes );
+ PushVar( pRes );
+}
+
+// Aktualisieren des Wertes von TOS
+
+void SbiRuntime::StepGET()
+{
+ SbxVariable* p = GetTOS();
+ p->Broadcast( SBX_HINT_DATAWANTED );
+}
+
+// #67607 Uno-Structs kopieren
+inline void checkUnoStructCopy( SbxVariableRef& refVal, SbxVariableRef& refVar )
+{
+ SbxDataType eVarType = refVar->GetType();
+ if( eVarType != SbxOBJECT )
+ return;
+
+ SbxObjectRef xValObj = (SbxObject*)refVal->GetObject();
+ if( !xValObj.Is() || xValObj->ISA(SbUnoAnyObject) )
+ return;
+
+ // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
+ if( refVar->ISA(SbProcedureProperty) )
+ return;
+
+ SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject();
+ SbxDataType eValType = refVal->GetType();
+ if( eValType == SbxOBJECT && xVarObj == xValObj )
+ {
+ SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxObject*)xVarObj);
+ if( pUnoObj )
+ {
+ Any aAny = pUnoObj->getUnoAny();
+ if( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
+ {
+ SbUnoObject* pNewUnoObj = new SbUnoObject( pUnoObj->GetName(), aAny );
+ // #70324: ClassName uebernehmen
+ pNewUnoObj->SetClassName( pUnoObj->GetClassName() );
+ refVar->PutObject( pNewUnoObj );
+ }
+ }
+ }
+}
+
+
+// Ablage von TOS in TOS-1
+
+void SbiRuntime::StepPUT()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ // Store auf die eigene Methode (innerhalb einer Function)?
+ BOOL bFlagsChanged = FALSE;
+ USHORT n = 0;
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ {
+ bFlagsChanged = TRUE;
+ n = refVar->GetFlags();
+ refVar->SetFlag( SBX_WRITE );
+ }
+
+ // if left side arg is an object or variant and right handside isn't
+ // either an object or a variant then try and see if a default
+ // property exists.
+ // to use e.g. Range{"A1") = 34
+ // could equate to Range("A1").Value = 34
+ if ( bVBAEnabled )
+ {
+ if ( refVar->GetType() == SbxOBJECT )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVar );
+ if ( pDflt )
+ refVar = pDflt;
+ }
+ if ( refVal->GetType() == SbxOBJECT )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVal );
+ if ( pDflt )
+ refVal = pDflt;
+ }
+ }
+
+ *refVar = *refVal;
+ // lhs is a property who's value is currently null
+ if ( !bVBAEnabled || ( bVBAEnabled && refVar->GetType() != SbxEMPTY ) )
+ // #67607 Uno-Structs kopieren
+ checkUnoStructCopy( refVal, refVar );
+ if( bFlagsChanged )
+ refVar->SetFlags( n );
+}
+
+
+// Speichern Objektvariable
+// Nicht-Objekt-Variable fuehren zu Fehlern
+
+void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
+{
+ // #67733 Typen mit Array-Flag sind auch ok
+
+ // Check var, !object is no error for sure if, only if type is fixed
+ SbxDataType eVarType = refVar->GetType();
+ if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ return;
+ }
+
+ // Check value, !object is no error for sure if, only if type is fixed
+ SbxDataType eValType = refVal->GetType();
+// bool bGetValObject = false;
+ if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ return;
+ }
+
+ // Getting in here causes problems with objects with default properties
+ // if they are SbxEMPTY I guess
+ if ( !bHandleDefaultProp || ( bHandleDefaultProp && eValType == SbxOBJECT ) )
+ {
+ // Auf refVal GetObject fuer Collections ausloesen
+ SbxBase* pObjVarObj = refVal->GetObject();
+ if( pObjVarObj )
+ {
+ SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj);
+
+ // #67733 Typen mit Array-Flag sind auch ok
+ if( refObjVal )
+ refVal = refObjVal;
+ else if( !(eValType & SbxARRAY) )
+ refVal = NULL;
+ }
+ }
+
+ // #52896 Wenn Uno-Sequences bzw. allgemein Arrays einer als
+ // Object deklarierten Variable zugewiesen werden, kann hier
+ // refVal ungueltig sein!
+ if( !refVal )
+ {
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ // Store auf die eigene Methode (innerhalb einer Function)?
+ BOOL bFlagsChanged = FALSE;
+ USHORT n = 0;
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ {
+ bFlagsChanged = TRUE;
+ n = refVar->GetFlags();
+ refVar->SetFlag( SBX_WRITE );
+ }
+ SbProcedureProperty* pProcProperty = PTR_CAST(SbProcedureProperty,(SbxVariable*)refVar);
+ if( pProcProperty )
+ pProcProperty->setSet( true );
+
+ if ( bHandleDefaultProp )
+ {
+ // get default properties for lhs & rhs where necessary
+ // SbxVariable* defaultProp = NULL; unused variable
+ bool bLHSHasDefaultProp = false;
+ // LHS try determine if a default prop exists
+ if ( refVar->GetType() == SbxOBJECT )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVar );
+ if ( pDflt )
+ {
+ refVar = pDflt;
+ bLHSHasDefaultProp = true;
+ }
+ }
+ // RHS only get a default prop is the rhs has one
+ if ( refVal->GetType() == SbxOBJECT )
+ {
+ // check if lhs is a null object
+ // if it is then use the object not the default property
+ SbxObject* pObj = NULL;
+
+
+ pObj = PTR_CAST(SbxObject,(SbxVariable*)refVar);
+
+ // calling GetObject on a SbxEMPTY variable raises
+ // object not set errors, make sure its an Object
+ if ( !pObj && refVar->GetType() == SbxOBJECT )
+ {
+ SbxBase* pObjVarObj = refVar->GetObject();
+ pObj = PTR_CAST(SbxObject,pObjVarObj);
+ }
+ SbxVariable* pDflt = NULL;
+ if ( pObj || bLHSHasDefaultProp )
+ // lhs is either a valid object || or has a defaultProp
+ pDflt = getDefaultProp( refVal );
+ if ( pDflt )
+ refVal = pDflt;
+ }
+ }
+
+ // Handle withevents
+ BOOL bWithEvents = refVar->IsSet( SBX_WITH_EVENTS );
+ if ( bWithEvents )
+ {
+ Reference< XInterface > xComListener;
+
+ SbxBase* pObj = refVal->GetObject();
+ SbUnoObject* pUnoObj = (pObj != NULL) ? PTR_CAST(SbUnoObject,pObj) : NULL;
+ if( pUnoObj != NULL )
+ {
+ Any aControlAny = pUnoObj->getUnoAny();
+ String aDeclareClassName = refVar->GetDeclareClassName();
+ ::rtl::OUString aVBAType = aDeclareClassName;
+ ::rtl::OUString aPrefix = refVar->GetName();
+ SbxObjectRef xScopeObj = refVar->GetParent();
+ xComListener = createComListener( aControlAny, aVBAType, aPrefix, xScopeObj );
+
+ refVal->SetDeclareClassName( aDeclareClassName );
+ refVal->SetComListener( xComListener ); // Hold reference
+ }
+
+ *refVar = *refVal;
+ }
+ else
+ {
+ *refVar = *refVal;
+ }
+
+ // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
+ // in this case if there is a default prop involved the value of the
+ // default property may infact be void so the type will also be SbxEMPTY
+ // in this case we do not want to call checkUnoStructCopy 'cause that will
+ // cause an error also
+ if ( !bHandleDefaultProp || ( bHandleDefaultProp && ( refVar->GetType() != SbxEMPTY ) ) )
+ // #67607 Uno-Structs kopieren
+ checkUnoStructCopy( refVal, refVar );
+ if( bFlagsChanged )
+ refVar->SetFlags( n );
+ }
+}
+
+void SbiRuntime::StepSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assigment
+}
+
+void SbiRuntime::StepVBASET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ // don't handle default property
+ StepSET_Impl( refVal, refVar, false ); // set obj = something
+}
+
+
+// JSM 07.10.95
+void SbiRuntime::StepLSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ if( refVar->GetType() != SbxSTRING
+ || refVal->GetType() != SbxSTRING )
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ else
+ {
+ // Store auf die eigene Methode (innerhalb einer Function)?
+ USHORT n = refVar->GetFlags();
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ refVar->SetFlag( SBX_WRITE );
+ String aRefVarString = refVar->GetString();
+ String aRefValString = refVal->GetString();
+
+ USHORT nVarStrLen = aRefVarString.Len();
+ USHORT nValStrLen = aRefValString.Len();
+ String aNewStr;
+ if( nVarStrLen > nValStrLen )
+ {
+ aRefVarString.Fill(nVarStrLen,' ');
+ aNewStr = aRefValString.Copy( 0, nValStrLen );
+ aNewStr += aRefVarString.Copy( nValStrLen, nVarStrLen - nValStrLen );
+ }
+ else
+ {
+ aNewStr = aRefValString.Copy( 0, nVarStrLen );
+ }
+
+ refVar->PutString( aNewStr );
+ refVar->SetFlags( n );
+ }
+}
+
+// JSM 07.10.95
+void SbiRuntime::StepRSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ if( refVar->GetType() != SbxSTRING
+ || refVal->GetType() != SbxSTRING )
+ Error( SbERR_INVALID_USAGE_OBJECT );
+ else
+ {
+ // Store auf die eigene Methode (innerhalb einer Function)?
+ USHORT n = refVar->GetFlags();
+ if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
+ refVar->SetFlag( SBX_WRITE );
+ String aRefVarString = refVar->GetString();
+ String aRefValString = refVal->GetString();
+
+ USHORT nPos = 0;
+ USHORT nVarStrLen = aRefVarString.Len();
+ if( nVarStrLen > aRefValString.Len() )
+ {
+ aRefVarString.Fill(nVarStrLen,' ');
+ nPos = nVarStrLen - aRefValString.Len();
+ }
+ aRefVarString = aRefVarString.Copy( 0, nPos );
+ aRefVarString += aRefValString.Copy( 0, nVarStrLen - nPos );
+ refVar->PutString(aRefVarString);
+
+ refVar->SetFlags( n );
+ }
+}
+
+// Ablage von TOS in TOS-1, dann ReadOnly-Bit setzen
+
+void SbiRuntime::StepPUTC()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ refVar->SetFlag( SBX_WRITE );
+ *refVar = *refVal;
+ refVar->ResetFlag( SBX_WRITE );
+ refVar->SetFlag( SBX_CONST );
+}
+
+// DIM
+// TOS = Variable fuer das Array mit Dimensionsangaben als Parameter
+
+void SbiRuntime::StepDIM()
+{
+ SbxVariableRef refVar = PopVar();
+ DimImpl( refVar );
+}
+
+// #56204 DIM-Funktionalitaet in Hilfsmethode auslagern (step0.cxx)
+void SbiRuntime::DimImpl( SbxVariableRef refVar )
+{
+ SbxArray* pDims = refVar->GetParameters();
+ // Muss eine gerade Anzahl Argumente haben
+ // Man denke daran, dass Arg[0] nicht zaehlt!
+ if( pDims && !( pDims->Count() & 1 ) )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ else
+ {
+ SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
+ SbxDimArray* pArray = new SbxDimArray( eType );
+ // AB 2.4.1996, auch Arrays ohne Dimensionsangaben zulassen (VB-komp.)
+ if( pDims )
+ {
+ for( USHORT i = 1; i < pDims->Count(); )
+ {
+ INT32 lb = pDims->Get( i++ )->GetLong();
+ INT32 ub = pDims->Get( i++ )->GetLong();
+ if( ub < lb )
+ Error( SbERR_OUT_OF_RANGE ), ub = lb;
+ pArray->AddDim32( lb, ub );
+ if ( lb != ub )
+ pArray->setHasFixedSize( true );
+ }
+ }
+ else
+ {
+ // #62867 Beim Anlegen eines Arrays der Laenge 0 wie bei
+ // Uno-Sequences der Laenge 0 eine Dimension anlegen
+ pArray->unoAddDim( 0, -1 );
+ }
+ USHORT nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SBX_FIXED );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nSavFlags );
+ refVar->SetParameters( NULL );
+ }
+}
+
+// REDIM
+// TOS = Variable fuer das Array
+// argv = Dimensionsangaben
+
+void SbiRuntime::StepREDIM()
+{
+ // Im Moment ist es nichts anderes als Dim, da doppeltes Dim
+ // bereits vom Compiler erkannt wird.
+ StepDIM();
+}
+
+
+// Helper function for StepREDIMP
+void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, short nMaxDimIndex,
+ short nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
+{
+ sal_Int32& ri = pActualIndices[nActualDim];
+ for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
+ {
+ if( nActualDim < nMaxDimIndex )
+ {
+ implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
+ pActualIndices, pLowerBounds, pUpperBounds );
+ }
+ else
+ {
+ SbxVariable* pSource = pOldArray->Get32( pActualIndices );
+ SbxVariable* pDest = pNewArray->Get32( pActualIndices );
+ if( pSource && pDest )
+ *pDest = *pSource;
+ }
+ }
+}
+
+// REDIM PRESERVE
+// TOS = Variable fuer das Array
+// argv = Dimensionsangaben
+
+void SbiRuntime::StepREDIMP()
+{
+ SbxVariableRef refVar = PopVar();
+ DimImpl( refVar );
+
+ // Now check, if we can copy from the old array
+ if( refRedimpArray.Is() )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pNewArray = PTR_CAST(SbxDimArray,pElemObj);
+ SbxDimArray* pOldArray = (SbxDimArray*)(SbxArray*)refRedimpArray;
+ if( pNewArray )
+ {
+ short nDimsNew = pNewArray->GetDims();
+ short nDimsOld = pOldArray->GetDims();
+ short nDims = nDimsNew;
+ BOOL bRangeError = FALSE;
+
+ // Store dims to use them for copying later
+ sal_Int32* pLowerBounds = new sal_Int32[nDims];
+ sal_Int32* pUpperBounds = new sal_Int32[nDims];
+ sal_Int32* pActualIndices = new sal_Int32[nDims];
+
+ if( nDimsOld != nDimsNew )
+ {
+ bRangeError = TRUE;
+ }
+ else
+ {
+ // Compare bounds
+ for( short i = 1 ; i <= nDims ; i++ )
+ {
+ sal_Int32 lBoundNew, uBoundNew;
+ sal_Int32 lBoundOld, uBoundOld;
+ pNewArray->GetDim32( i, lBoundNew, uBoundNew );
+ pOldArray->GetDim32( i, lBoundOld, uBoundOld );
+
+ /* #69094 Allow all dimensions to be changed
+ although Visual Basic is not able to do so.
+ // All bounds but the last have to be the same
+ if( i < nDims && ( lBoundNew != lBoundOld || uBoundNew != uBoundOld ) )
+ {
+ bRangeError = TRUE;
+ break;
+ }
+ else
+ */
+ {
+ // #69094: if( i == nDims )
+ {
+ lBoundNew = std::max( lBoundNew, lBoundOld );
+ uBoundNew = std::min( uBoundNew, uBoundOld );
+ }
+ short j = i - 1;
+ pActualIndices[j] = pLowerBounds[j] = lBoundNew;
+ pUpperBounds[j] = uBoundNew;
+ }
+ }
+ }
+
+ if( bRangeError )
+ {
+ StarBASIC::Error( SbERR_OUT_OF_RANGE );
+ }
+ else
+ {
+ // Copy data from old array by going recursively through all dimensions
+ // (It would be faster to work on the flat internal data array of an
+ // SbyArray but this solution is clearer and easier)
+ implCopyDimArray( pNewArray, pOldArray, nDims - 1,
+ 0, pActualIndices, pLowerBounds, pUpperBounds );
+ }
+
+ delete[] pUpperBounds;
+ delete[] pLowerBounds;
+ delete[] pActualIndices;
+ refRedimpArray = NULL;
+ }
+ }
+
+ //StarBASIC::FatalError( SbERR_NOT_IMPLEMENTED );
+}
+
+// REDIM_COPY
+// TOS = Array-Variable, Reference to array is copied
+// Variable is cleared as in ERASE
+
+void SbiRuntime::StepREDIMP_ERASE()
+{
+ SbxVariableRef refVar = PopVar();
+ SbxDataType eType = refVar->GetType();
+ if( eType & SbxARRAY )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
+ if( pDimArray )
+ {
+ refRedimpArray = pDimArray;
+ }
+
+ // As in ERASE
+ USHORT nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SBX_FIXED );
+ refVar->SetType( SbxDataType(eType & 0x0FFF) );
+ refVar->SetFlags( nSavFlags );
+ refVar->Clear();
+ }
+ else
+ if( refVar->IsFixed() )
+ refVar->Clear();
+ else
+ refVar->SetType( SbxEMPTY );
+}
+
+void lcl_clearImpl( SbxVariableRef& refVar, SbxDataType& eType )
+{
+ USHORT nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SBX_FIXED );
+ refVar->SetType( SbxDataType(eType & 0x0FFF) );
+ refVar->SetFlags( nSavFlags );
+ refVar->Clear();
+}
+
+void lcl_eraseImpl( SbxVariableRef& refVar, bool bVBAEnabled )
+{
+ SbxDataType eType = refVar->GetType();
+ if( eType & SbxARRAY )
+ {
+ if ( bVBAEnabled )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj);
+ bool bClearValues = true;
+ if( pDimArray )
+ {
+ if ( pDimArray->hasFixedSize() )
+ {
+ // Clear all Value(s)
+ pDimArray->SbxArray::Clear();
+ bClearValues = false;
+ }
+ else
+ pDimArray->Clear(); // clear Dims
+ }
+ if ( bClearValues )
+ {
+ SbxArray* pArray = PTR_CAST(SbxArray,pElemObj);
+ if ( pArray )
+ pArray->Clear();
+ }
+ }
+ else
+ // AB 2.4.1996
+ // Arrays haben bei Erase nach VB ein recht komplexes Verhalten. Hier
+ // werden zunaechst nur die Typ-Probleme bei REDIM (#26295) beseitigt:
+ // Typ hart auf den Array-Typ setzen, da eine Variable mit Array
+ // SbxOBJECT ist. Bei REDIM entsteht dann ein SbxOBJECT-Array und
+ // der ursruengliche Typ geht verloren -> Laufzeitfehler
+ lcl_clearImpl( refVar, eType );
+ }
+ else
+ if( refVar->IsFixed() )
+ refVar->Clear();
+ else
+ refVar->SetType( SbxEMPTY );
+}
+
+// Variable loeschen
+// TOS = Variable
+
+void SbiRuntime::StepERASE()
+{
+ SbxVariableRef refVar = PopVar();
+ lcl_eraseImpl( refVar, bVBAEnabled );
+}
+
+void SbiRuntime::StepERASE_CLEAR()
+{
+ SbxVariableRef refVar = PopVar();
+ lcl_eraseImpl( refVar, bVBAEnabled );
+ SbxDataType eType = refVar->GetType();
+ lcl_clearImpl( refVar, eType );
+}
+
+void SbiRuntime::StepARRAYACCESS()
+{
+ if( !refArgv )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ SbxVariableRef refVar = PopVar();
+ refVar->SetParameters( refArgv );
+ PopArgv();
+ PushVar( CheckArray( refVar ) );
+}
+
+void SbiRuntime::StepBYVAL()
+{
+ // Copy variable on stack to break call by reference
+ SbxVariableRef pVar = PopVar();
+ SbxDataType t = pVar->GetType();
+
+ SbxVariable* pCopyVar = new SbxVariable( t );
+ pCopyVar->SetFlag( SBX_READWRITE );
+ *pCopyVar = *pVar;
+
+ PushVar( pCopyVar );
+}
+
+// Einrichten eines Argvs
+// nOp1 bleibt so -> 1. Element ist Returnwert
+
+void SbiRuntime::StepARGC()
+{
+ PushArgv();
+ refArgv = new SbxArray;
+ nArgc = 1;
+}
+
+// Speichern eines Arguments in Argv
+
+void SbiRuntime::StepARGV()
+{
+ if( !refArgv )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ else
+ {
+ SbxVariableRef pVal = PopVar();
+
+ // Before fix of #94916:
+ // if( pVal->ISA(SbxMethod) || pVal->ISA(SbxProperty) )
+ if( pVal->ISA(SbxMethod) || pVal->ISA(SbUnoProperty) || pVal->ISA(SbProcedureProperty) )
+ {
+ // Methoden und Properties evaluieren!
+ SbxVariable* pRes = new SbxVariable( *pVal );
+ pVal = pRes;
+ }
+ refArgv->Put( pVal, nArgc++ );
+ }
+}
+
+// Input to Variable. Die Variable ist auf TOS und wird
+// anschliessend entfernt.
+
+void SbiRuntime::StepINPUT()
+{
+ String s;
+ char ch = 0;
+ SbError err;
+ // Skip whitespace
+ while( ( err = pIosys->GetError() ) == 0 )
+ {
+ ch = pIosys->Read();
+ if( ch != ' ' && ch != '\t' && ch != '\n' )
+ break;
+ }
+ if( !err )
+ {
+ // Scan until comma or whitespace
+ char sep = ( ch == '"' ) ? ch : 0;
+ if( sep ) ch = pIosys->Read();
+ while( ( err = pIosys->GetError() ) == 0 )
+ {
+ if( ch == sep )
+ {
+ ch = pIosys->Read();
+ if( ch != sep )
+ break;
+ }
+ else if( !sep && (ch == ',' || ch == '\n') )
+ break;
+ s += ch;
+ ch = pIosys->Read();
+ }
+ // skip whitespace
+ if( ch == ' ' || ch == '\t' )
+ while( ( err = pIosys->GetError() ) == 0 )
+ {
+ if( ch != ' ' && ch != '\t' && ch != '\n' )
+ break;
+ ch = pIosys->Read();
+ }
+ }
+ if( !err )
+ {
+ SbxVariableRef pVar = GetTOS();
+ // Zuerst versuchen, die Variable mit einem numerischen Wert
+ // zu fuellen, dann mit einem Stringwert
+ if( !pVar->IsFixed() || pVar->IsNumeric() )
+ {
+ USHORT nLen = 0;
+ if( !pVar->Scan( s, &nLen ) )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ // Der Wert muss komplett eingescant werden
+ else if( nLen != s.Len() && !pVar->PutString( s ) )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ else if( nLen != s.Len() && pVar->IsNumeric() )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ if( !err )
+ err = SbERR_CONVERSION;
+ }
+ }
+ else
+ {
+ pVar->PutString( s );
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ }
+ if( err == SbERR_USER_ABORT )
+ Error( err );
+ else if( err )
+ {
+ if( pRestart && !pIosys->GetChannel() )
+ {
+ BasResId aId( IDS_SBERR_START + 4 );
+ String aMsg( aId );
+
+ //****** DONT CHECK IN, TEST ONLY *******
+ //****** DONT CHECK IN, TEST ONLY *******
+ // ErrorBox( NULL, WB_OK, aMsg ).Execute();
+ //****** DONT CHECK IN, TEST ONLY *******
+ //****** DONT CHECK IN, TEST ONLY *******
+
+ pCode = pRestart;
+ }
+ else
+ Error( err );
+ }
+ else
+ {
+ // pIosys->ResetChannel();
+ PopVar();
+ }
+}
+
+// Line Input to Variable. Die Variable ist auf TOS und wird
+// anschliessend entfernt.
+
+void SbiRuntime::StepLINPUT()
+{
+ ByteString aInput;
+ pIosys->Read( aInput );
+ Error( pIosys->GetError() );
+ SbxVariableRef p = PopVar();
+ p->PutString( String( aInput, gsl_getSystemTextEncoding() ) );
+ // pIosys->ResetChannel();
+}
+
+// Programmende
+
+void SbiRuntime::StepSTOP()
+{
+ pInst->Stop();
+}
+
+// FOR-Variable initialisieren
+
+void SbiRuntime::StepINITFOR()
+{
+ PushFor();
+}
+
+void SbiRuntime::StepINITFOREACH()
+{
+ PushForEach();
+}
+
+// FOR-Variable inkrementieren
+
+void SbiRuntime::StepNEXT()
+{
+ if( !pForStk )
+ {
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ return;
+ }
+ if( pForStk->eForType == FOR_TO )
+ pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
+}
+
+// Anfang CASE: TOS in CASE-Stack
+
+void SbiRuntime::StepCASE()
+{
+ if( !refCaseStk.Is() )
+ refCaseStk = new SbxArray;
+ SbxVariableRef xVar = PopVar();
+ refCaseStk->Put( xVar, refCaseStk->Count() );
+}
+
+// Ende CASE: Variable freigeben
+
+void SbiRuntime::StepENDCASE()
+{
+ if( !refCaseStk || !refCaseStk->Count() )
+ StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
+ else
+ refCaseStk->Remove( refCaseStk->Count() - 1 );
+}
+
+// Standard-Fehlerbehandlung
+
+void SbiRuntime::StepSTDERROR()
+{
+ pError = NULL; bError = TRUE;
+ pInst->aErrorMsg = String();
+ pInst->nErr = 0L;
+ pInst->nErl = 0;
+ nError = 0L;
+ SbxErrObject::getUnoErrObject()->Clear();
+}
+
+void SbiRuntime::StepNOERROR()
+{
+ pInst->aErrorMsg = String();
+ pInst->nErr = 0L;
+ pInst->nErl = 0;
+ nError = 0L;
+ SbxErrObject::getUnoErrObject()->Clear();
+ bError = FALSE;
+}
+
+// UP verlassen
+
+void SbiRuntime::StepLEAVE()
+{
+ bRun = FALSE;
+ // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
+ if ( bInError && pError )
+ SbxErrObject::getUnoErrObject()->Clear();
+}
+
+void SbiRuntime::StepCHANNEL() // TOS = Kanalnummer
+{
+ SbxVariableRef pChan = PopVar();
+ short nChan = pChan->GetInteger();
+ pIosys->SetChannel( nChan );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepCHANNEL0()
+{
+ pIosys->ResetChannel();
+}
+
+void SbiRuntime::StepPRINT() // print TOS
+{
+ SbxVariableRef p = PopVar();
+ String s1 = p->GetString();
+ String s;
+ if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
+ s = ' '; // ein Blank davor
+ s += s1;
+ ByteString aByteStr( s, gsl_getSystemTextEncoding() );
+ pIosys->Write( aByteStr );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepPRINTF() // print TOS in field
+{
+ SbxVariableRef p = PopVar();
+ String s1 = p->GetString();
+ String s;
+ if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
+ s = ' '; // ein Blank davor
+ s += s1;
+ s.Expand( 14, ' ' );
+ ByteString aByteStr( s, gsl_getSystemTextEncoding() );
+ pIosys->Write( aByteStr );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepWRITE() // write TOS
+{
+ SbxVariableRef p = PopVar();
+ // Muss der String gekapselt werden?
+ char ch = 0;
+ switch (p->GetType() )
+ {
+ case SbxSTRING: ch = '"'; break;
+ case SbxCURRENCY:
+ case SbxBOOL:
+ case SbxDATE: ch = '#'; break;
+ default: break;
+ }
+ String s;
+ if( ch )
+ s += ch;
+ s += p->GetString();
+ if( ch )
+ s += ch;
+ ByteString aByteStr( s, gsl_getSystemTextEncoding() );
+ pIosys->Write( aByteStr );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
+{
+ SbxVariableRef pTos1 = PopVar();
+ SbxVariableRef pTos = PopVar();
+ String aDest = pTos1->GetString();
+ String aSource = pTos->GetString();
+
+ // <-- UCB
+ if( hasUno() )
+ {
+ implStepRenameUCB( aSource, aDest );
+ }
+ else
+ // --> UCB
+ {
+#ifdef _OLD_FILE_IMPL
+ DirEntry aSourceDirEntry( aSource );
+ if( aSourceDirEntry.Exists() )
+ {
+ if( aSourceDirEntry.MoveTo( DirEntry(aDest) ) != FSYS_ERR_OK )
+ StarBASIC::Error( SbERR_PATH_NOT_FOUND );
+ }
+ else
+ StarBASIC::Error( SbERR_PATH_NOT_FOUND );
+#else
+ implStepRenameOSL( aSource, aDest );
+#endif
+ }
+}
+
+// TOS = Prompt
+
+void SbiRuntime::StepPROMPT()
+{
+ SbxVariableRef p = PopVar();
+ ByteString aStr( p->GetString(), gsl_getSystemTextEncoding() );
+ pIosys->SetPrompt( aStr );
+}
+
+// Set Restart point
+
+void SbiRuntime::StepRESTART()
+{
+ pRestart = pCode;
+}
+
+// Leerer Ausdruck auf Stack fuer fehlenden Parameter
+
+void SbiRuntime::StepEMPTY()
+{
+ // #57915 Die Semantik von StepEMPTY() ist die Repraesentation eines fehlenden
+ // Arguments. Dies wird in VB durch ein durch den Wert 448 (SbERR_NAMED_NOT_FOUND)
+ // vom Typ Error repraesentiert. StepEmpty jetzt muesste besser StepMISSING()
+ // heissen, aber der Name wird der Einfachkeit halber beibehalten.
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ xVar->PutErr( 448 );
+ PushVar( xVar );
+ // ALT: PushVar( new SbxVariable( SbxEMPTY ) );
+}
+
+// TOS = Fehlercode
+
+void SbiRuntime::StepERROR()
+{
+ SbxVariableRef refCode = PopVar();
+ USHORT n = refCode->GetUShort();
+ SbError error = StarBASIC::GetSfxFromVBError( n );
+ if ( bVBAEnabled )
+ pInst->Error( error );
+ else
+ Error( error );
+}
+