xref: /trunk/main/basic/source/runtime/step0.cxx (revision 9f813b30a249a2ed1e0f5e3ff3c0b88a8924b427)

/**************************************************************
 *
 * Licensed to the Apache Software Foundation (ASF) under one
 * or more contributor license agreements.  See the NOTICE file
 * distributed with this work for additional information
 * regarding copyright ownership.  The ASF licenses this file
 * to you under the Apache License, Version 2.0 (the
 * "License"); you may not use this file except in compliance
 * with the License.  You may obtain a copy of the License at
 *
 *   http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing,
 * software distributed under the License is distributed on an
 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 * KIND, either express or implied.  See the License for the
 * specific language governing permissions and limitations
 * under the 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>
#include <hash_map>

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 );
            }
        }

    }
    static SbxVariable* pTRUE = NULL;
    static SbxVariable* pFALSE = NULL;

    if( p2->Compare( eOp, *p1 ) )
    {
        if( !pTRUE )
        {
            pTRUE = new SbxVariable;
            pTRUE->PutBool( sal_True );
            pTRUE->AddRef();
        }
        PushVar( pTRUE );
    }
    else
    {
        if( !pFALSE )
        {
            pFALSE = new SbxVariable;
            pFALSE->PutBool( sal_False );
            pFALSE->AddRef();
        }
        PushVar( pFALSE );
    }
}

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();
    }

    sal_Bool bRes = sal_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)?
    sal_Bool bFlagsChanged = sal_False;
    sal_uInt16 n = 0;
    if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
    {
        bFlagsChanged = sal_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 );
}


// VBA Dim As New behavior handling, save init object information
struct DimAsNewRecoverItem
{
    String          m_aObjClass;
    String          m_aObjName;
    SbxObject*      m_pObjParent;
    SbModule*       m_pClassModule;

    DimAsNewRecoverItem( void )
        : m_pObjParent( NULL )
        , m_pClassModule( NULL )
    {}

    DimAsNewRecoverItem( const String& rObjClass, const String& rObjName,
        SbxObject* pObjParent, SbModule* pClassModule )
            : m_aObjClass( rObjClass )
            , m_aObjName( rObjName )
            , m_pObjParent( pObjParent )
            , m_pClassModule( pClassModule )
    {}

};


struct SbxVariablePtrHash
{
    size_t operator()( SbxVariable* pVar ) const
        { return (size_t)pVar; }
};

typedef std::hash_map< SbxVariable*, DimAsNewRecoverItem, SbxVariablePtrHash >  DimAsNewRecoverHash;

static DimAsNewRecoverHash      GaDimAsNewRecoverHash;

void removeDimAsNewRecoverItem( SbxVariable* pVar )
{
    DimAsNewRecoverHash::iterator it = GaDimAsNewRecoverHash.find( pVar );
    if( it != GaDimAsNewRecoverHash.end() )
        GaDimAsNewRecoverHash.erase( it );
}


// Speichern Objektvariable
// Nicht-Objekt-Variable fuehren zu Fehlern

static const char pCollectionStr[] = "Collection";

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)?
        sal_Bool bFlagsChanged = sal_False;
        sal_uInt16 n = 0;
        if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
        {
            bFlagsChanged = sal_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 Dim As New
        sal_Bool bDimAsNew = bVBAEnabled && refVar->IsSet( SBX_DIM_AS_NEW );
        SbxBaseRef xPrevVarObj;
        if( bDimAsNew )
            xPrevVarObj = refVar->GetObject();

        // Handle withevents
        sal_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, &rBasic );        // Hold reference
            }

            *refVar = *refVal;
        }
        else
        {
            *refVar = *refVal;
        }

        if ( bDimAsNew )
        {
            if( !refVar->ISA(SbxObject) )
            {
                SbxBase* pValObjBase = refVal->GetObject();
                if( pValObjBase == NULL )
                {
                    if( xPrevVarObj.Is() )
                    {
                        // Object is overwritten with NULL, instantiate init object
                        DimAsNewRecoverHash::iterator it = GaDimAsNewRecoverHash.find( refVar );
                        if( it != GaDimAsNewRecoverHash.end() )
                        {
                            const DimAsNewRecoverItem& rItem = it->second;
                            if( rItem.m_pClassModule != NULL )
                            {
                                SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
                                pNewObj->SetName( rItem.m_aObjName );
                                pNewObj->SetParent( rItem.m_pObjParent );
                                refVar->PutObject( pNewObj );
                            }
                            else if( rItem.m_aObjClass.EqualsIgnoreCaseAscii( pCollectionStr ) )
                            {
                                BasicCollection* pNewCollection = new BasicCollection( String( RTL_CONSTASCII_USTRINGPARAM(pCollectionStr) ) );
                                pNewCollection->SetName( rItem.m_aObjName );
                                pNewCollection->SetParent( rItem.m_pObjParent );
                                refVar->PutObject( pNewCollection );
                            }
                        }
                    }
                }
                else
                {
                    // Does old value exist?
                    bool bFirstInit = !xPrevVarObj.Is();
                    if( bFirstInit )
                    {
                        // Store information to instantiate object later
                        SbxObject* pValObj = PTR_CAST(SbxObject,pValObjBase);
                        if( pValObj != NULL )
                        {
                            String aObjClass = pValObj->GetClassName();

                            SbClassModuleObject* pClassModuleObj = PTR_CAST(SbClassModuleObject,pValObjBase);
                            if( pClassModuleObj != NULL )
                            {
                                SbModule* pClassModule = pClassModuleObj->getClassModule();
                                GaDimAsNewRecoverHash[refVar] =
                                    DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
                            }
                            else if( aObjClass.EqualsIgnoreCaseAscii( "Collection" ) )
                            {
                                GaDimAsNewRecoverHash[refVar] =
                                    DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), NULL );
                            }
                        }
                    }
                }
            }
        }


        // 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)?
        sal_uInt16 n = refVar->GetFlags();
        if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
            refVar->SetFlag( SBX_WRITE );
        String aRefVarString = refVar->GetString();
        String aRefValString = refVal->GetString();

        sal_uInt16 nVarStrLen = aRefVarString.Len();
        sal_uInt16 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)?
        sal_uInt16 n = refVar->GetFlags();
        if( (SbxVariable*) refVar == (SbxVariable*) pMeth )
            refVar->SetFlag( SBX_WRITE );
        String aRefVarString = refVar->GetString();
        String aRefValString = refVal->GetString();

        sal_uInt16 nPos = 0;
        sal_uInt16 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 )
        {
            refVar->ResetFlag( SBX_VAR_TO_DIM );

            for( sal_uInt16 i = 1; i < pDims->Count(); )
            {
                sal_Int32 lb = pDims->Get( i++ )->GetLong();
                sal_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 );
        }
        sal_uInt16 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;
            sal_Bool bRangeError = sal_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 = sal_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 = sal_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
        sal_uInt16 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 )
{
    sal_uInt16 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() )
        {
            sal_uInt16 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 );

            //****** DON'T CHECK IN, TEST ONLY *******
            //****** DON'T CHECK IN, TEST ONLY *******
            // ErrorBox( NULL, WB_OK, aMsg ).Execute();
            //****** DON'T CHECK IN, TEST ONLY *******
            //****** DON'T 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 = sal_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 = sal_False;
}

// UP verlassen

void SbiRuntime::StepLEAVE()
{
    bRun = sal_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();
    sal_uInt16 n = refCode->GetUShort();
    SbError error = StarBASIC::GetSfxFromVBError( n );
    if ( bVBAEnabled )
        pInst->Error( error );
    else
        Error( error );
}