summaryrefslogtreecommitdiff
path: root/basic/source/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'basic/source/runtime')
-rw-r--r--basic/source/runtime/methods.cxx68
-rw-r--r--basic/source/runtime/methods1.cxx11
-rw-r--r--basic/source/runtime/props.cxx18
-rwxr-xr-x[-rw-r--r--]basic/source/runtime/runtime.cxx101
-rw-r--r--basic/source/runtime/stdobj.cxx2
-rw-r--r--basic/source/runtime/step0.cxx11
-rw-r--r--basic/source/runtime/step1.cxx7
7 files changed, 189 insertions, 29 deletions
diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx
index 9a21e488d4aa..e963de871c32 100644
--- a/basic/source/runtime/methods.cxx
+++ b/basic/source/runtime/methods.cxx
@@ -61,6 +61,7 @@
#else
#include <osl/file.hxx>
#endif
+#include "errobject.hxx"
#ifdef _USE_UNO
#include <comphelper/processfactory.hxx>
@@ -120,6 +121,10 @@ using namespace com::sun::star::io;
#include <io.h>
#endif
+using namespace rtl;
+
+#include <basic/sbobjmod.hxx>
+
static void FilterWhiteSpace( String& rStr )
{
rStr.EraseAllChars( ' ' );
@@ -256,6 +261,7 @@ RTLFUNC(Error)
{
String aErrorMsg;
SbError nErr = 0L;
+ INT32 nCode = 0;
if( rPar.Count() == 1 )
{
nErr = StarBASIC::GetErrBasic();
@@ -263,14 +269,34 @@ RTLFUNC(Error)
}
else
{
- INT32 nCode = rPar.Get( 1 )->GetLong();
+ nCode = rPar.Get( 1 )->GetLong();
if( nCode > 65535L )
StarBASIC::Error( SbERR_CONVERSION );
else
nErr = StarBASIC::GetSfxFromVBError( (USHORT)nCode );
}
- pBasic->MakeErrorText( nErr, aErrorMsg );
- rPar.Get( 0 )->PutString( pBasic->GetErrorText() );
+
+ bool bVBA = SbiRuntime::isVBAEnabled();
+ String tmpErrMsg;
+ if( bVBA && aErrorMsg.Len() > 0 )
+ {
+ tmpErrMsg = aErrorMsg;
+ }
+ else
+ {
+ pBasic->MakeErrorText( nErr, aErrorMsg );
+ tmpErrMsg = pBasic->GetErrorText();
+ }
+ // If this rtlfunc 'Error' passed a errcode the same as the active Err Objects's
+ // current err then return the description for the error message if it is set
+ // ( complicated isn't it ? )
+ if ( bVBA && rPar.Count() > 1 )
+ {
+ com::sun::star::uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() );
+ if ( xErrObj.is() && xErrObj->getNumber() == nCode && xErrObj->getDescription().getLength() )
+ tmpErrMsg = xErrObj->getDescription();
+ }
+ rPar.Get( 0 )->PutString( tmpErrMsg );
}
}
@@ -4106,12 +4132,20 @@ RTLFUNC(Load)
// Diesen Call einfach an das Object weiterreichen
SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
- if( pObj && pObj->IsA( TYPE( SbxObject ) ) )
+ if ( pObj )
{
- SbxVariable* pVar = ((SbxObject*)pObj)->
- Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD );
- if( pVar )
- pVar->GetInteger();
+ if( pObj->IsA( TYPE( SbUserFormModule ) ) )
+ {
+ SbUserFormModule* pFormModule = ( SbUserFormModule* )pObj;
+ pFormModule->load();
+ }
+ else if( pObj->IsA( TYPE( SbxObject ) ) )
+ {
+ SbxVariable* pVar = ((SbxObject*)pObj)->
+ Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD );
+ if( pVar )
+ pVar->GetInteger();
+ }
}
}
@@ -4129,12 +4163,20 @@ RTLFUNC(Unload)
// Diesen Call einfach an das Object weitereichen
SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
- if( pObj && pObj->IsA( TYPE( SbxObject ) ) )
+ if ( pObj )
{
- SbxVariable* pVar = ((SbxObject*)pObj)->
- Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD );
- if( pVar )
- pVar->GetInteger();
+ if( pObj->IsA( TYPE( SbUserFormModule ) ) )
+ {
+ SbUserFormModule* pFormModule = ( SbUserFormModule* )pObj;
+ pFormModule->Unload();
+ }
+ else if( pObj->IsA( TYPE( SbxObject ) ) )
+ {
+ SbxVariable* pVar = ((SbxObject*)pObj)->
+ Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD );
+ if( pVar )
+ pVar->GetInteger();
+ }
}
}
diff --git a/basic/source/runtime/methods1.cxx b/basic/source/runtime/methods1.cxx
index e0501e5c0d94..b25c213a493d 100644
--- a/basic/source/runtime/methods1.cxx
+++ b/basic/source/runtime/methods1.cxx
@@ -61,6 +61,7 @@
#endif
#include <vcl/jobset.hxx>
+#include <basic/sbobjmod.hxx>
#include "sbintern.hxx"
#include "runtime.hxx"
@@ -2594,14 +2595,16 @@ RTLFUNC(Me)
SbModule* pActiveModule = pINST->GetActiveModule();
SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pActiveModule);
+ SbxVariableRef refVar = rPar.Get(0);
if( pClassModuleObject == NULL )
{
- StarBASIC::Error( SbERR_INVALID_USAGE_OBJECT );
+ SbObjModule* pMod = PTR_CAST(SbObjModule,pActiveModule);
+ if ( pMod )
+ refVar->PutObject( pMod );
+ else
+ StarBASIC::Error( SbERR_INVALID_USAGE_OBJECT );
}
else
- {
- SbxVariableRef refVar = rPar.Get(0);
refVar->PutObject( pClassModuleObject );
- }
}
diff --git a/basic/source/runtime/props.cxx b/basic/source/runtime/props.cxx
index 9b4b35f551e2..cec74444e7a2 100644
--- a/basic/source/runtime/props.cxx
+++ b/basic/source/runtime/props.cxx
@@ -31,6 +31,7 @@
#include "runtime.hxx"
#include "stdobj.hxx"
#include "rtlproto.hxx"
+#include "errobject.hxx"
// Properties und Methoden legen beim Get (bWrite = FALSE) den Returnwert
@@ -50,14 +51,21 @@ RTLFUNC(Err)
(void)pBasic;
(void)bWrite;
- if( bWrite )
+ if( SbiRuntime::isVBAEnabled() )
{
- INT32 nVal = rPar.Get( 0 )->GetLong();
- if( nVal <= 65535L )
- StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) );
+ rPar.Get( 0 )->PutObject( SbxErrObject::getErrObject() );
}
else
- rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) );
+ {
+ if( bWrite )
+ {
+ INT32 nVal = rPar.Get( 0 )->GetLong();
+ if( nVal <= 65535L )
+ StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) );
+ }
+ else
+ rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) );
+ }
}
RTLFUNC(False)
diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx
index 52aa76e2f2df..29e49b0ffde8 100644..100755
--- a/basic/source/runtime/runtime.cxx
+++ b/basic/source/runtime/runtime.cxx
@@ -43,13 +43,16 @@
#include <comphelper/processfactory.hxx>
#include <com/sun/star/container/XEnumerationAccess.hpp>
#include "sbunoobj.hxx"
+#include "errobject.hxx"
+
+using namespace ::com::sun::star;
bool SbiRuntime::isVBAEnabled()
{
bool result = false;
SbiInstance* pInst = pINST;
if ( pInst && pINST->pRun )
- result = pInst->pRun->GetImageFlag( SBIMG_VBASUPPORT );
+ result = pInst->pRun->bVBAEnabled;
return result;
}
@@ -60,6 +63,24 @@ void StarBASIC::StaticEnableReschedule( BOOL bReschedule )
{
bStaticGlobalEnableReschedule = bReschedule;
}
+void StarBASIC::SetVBAEnabled( BOOL bEnabled )
+{
+ if ( bDocBasic )
+ {
+ bVBAEnabled = bEnabled;
+ }
+}
+
+BOOL StarBASIC::isVBAEnabled()
+{
+ if ( bDocBasic )
+ {
+ if( SbiRuntime::isVBAEnabled() )
+ return TRUE;
+ return bVBAEnabled;
+ }
+ return FALSE;
+}
struct SbiArgvStack { // Argv stack:
@@ -422,6 +443,35 @@ void SbiInstance::Error( SbError n, const String& rMsg )
}
}
+void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const String& rMsg )
+{
+ if( !bWatchMode )
+ {
+ SbError n = StarBASIC::GetSfxFromVBError( static_cast< USHORT >( nVBNumber ) );
+ if ( !n )
+ n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
+
+ aErrorMsg = rMsg;
+ SbiRuntime::translateErrorToVba( n, aErrorMsg );
+
+ bool bVBATranslationAlreadyDone = true;
+ pRun->Error( SbERR_BASIC_COMPAT, bVBATranslationAlreadyDone );
+ }
+}
+
+void SbiInstance::setErrorVB( sal_Int32 nVBNumber, const String& rMsg )
+{
+ SbError n = StarBASIC::GetSfxFromVBError( static_cast< USHORT >( nVBNumber ) );
+ if( !n )
+ n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
+
+ aErrorMsg = rMsg;
+ SbiRuntime::translateErrorToVba( n, aErrorMsg );
+
+ nErr = n;
+}
+
+
void SbiInstance::FatalError( SbError n )
{
pRun->FatalError( n );
@@ -520,6 +570,7 @@ SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, UINT32 nStart )
nForLvl = 0;
nOps = 0;
refExprStk = new SbxArray;
+ SetVBAEnabled( pMod->IsVBACompat() );
#if defined GCC
SetParameters( pe ? pe->GetParameters() : (class SbxArray *)NULL );
#else
@@ -527,7 +578,6 @@ SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, UINT32 nStart )
#endif
pRefSaveList = NULL;
pItemStoreList = NULL;
- bVBAEnabled = isVBAEnabled();
}
SbiRuntime::~SbiRuntime()
@@ -546,6 +596,11 @@ SbiRuntime::~SbiRuntime()
}
}
+void SbiRuntime::SetVBAEnabled(bool bEnabled )
+{
+ bVBAEnabled = bEnabled;
+}
+
// Aufbau der Parameterliste. Alle ByRef-Parameter werden direkt
// uebernommen; von ByVal-Parametern werden Kopien angelegt. Falls
// ein bestimmter Datentyp verlangt wird, wird konvertiert.
@@ -791,10 +846,24 @@ BOOL SbiRuntime::Step()
return bRun;
}
-void SbiRuntime::Error( SbError n )
+void SbiRuntime::Error( SbError n, bool bVBATranslationAlreadyDone )
{
if( n )
+ {
nError = n;
+ if( isVBAEnabled() && !bVBATranslationAlreadyDone )
+ {
+ String aMsg = pInst->GetErrorMsg();
+ sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
+ SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject();
+ SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
+ if( pGlobErr != NULL )
+ pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
+
+ pInst->aErrorMsg = aMsg;
+ nError = SbERR_BASIC_COMPAT;
+ }
+ }
}
void SbiRuntime::Error( SbError _errCode, const String& _details )
@@ -826,6 +895,32 @@ void SbiRuntime::FatalError( SbError _errCode, const String& _details )
Error( _errCode, _details );
}
+sal_Int32 SbiRuntime::translateErrorToVba( SbError nError, String& rMsg )
+{
+ // If a message is defined use that ( in preference to
+ // the defined one for the error ) NB #TODO
+ // if there is an error defined it more than likely
+ // is not the one you want ( some are the same though )
+ // we really need a new vba compatible error list
+ if ( !rMsg.Len() )
+ {
+ // TEST, has to be vb here always
+#ifdef DBG_UTIL
+ SbError nTmp = StarBASIC::GetSfxFromVBError( nError );
+ DBG_ASSERT( nTmp, "No VB error!" );
+#endif
+
+ StarBASIC::MakeErrorText( nError, rMsg );
+ rMsg = StarBASIC::GetErrorText();
+ if ( !rMsg.Len() ) // no message for err no, need localized resource here
+ rMsg = String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") );
+ }
+ // no num? most likely then it *is* really a vba err
+ USHORT nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
+ sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? nError : nVBErrorCode;
+ return nVBAErrorNumber;
+}
+
//////////////////////////////////////////////////////////////////////////
//
// Parameter, Locals, Caller
diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx
index c0b4ffa3cd59..13bc8810144a 100644
--- a/basic/source/runtime/stdobj.cxx
+++ b/basic/source/runtime/stdobj.cxx
@@ -230,7 +230,7 @@ static Methods aMethods[] = {
{ "EOF", SbxBOOL, 1 | _FUNCTION, RTLNAME(EOF),0 },
{ "Channel", SbxINTEGER, 0,NULL,0 },
{ "Erl", SbxLONG, _ROPROP, RTLNAME( Erl ),0 },
-{ "Err", SbxLONG, _RWPROP, RTLNAME( Err ),0 },
+{ "Err", SbxVARIANT, _RWPROP, RTLNAME( Err ),0 },
{ "Error", SbxSTRING, 1 | _FUNCTION, RTLNAME( Error ),0 },
{ "code", SbxLONG, 0,NULL,0 },
{ "Exp", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Exp),0 },
diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx
index 33df854a4499..39af5ea4adc3 100644
--- a/basic/source/runtime/step0.cxx
+++ b/basic/source/runtime/step0.cxx
@@ -30,6 +30,7 @@
#include <vcl/msgbox.hxx>
#include <tools/fsys.hxx>
+#include "errobject.hxx"
#include "runtime.hxx"
#include "sbintern.hxx"
#include "iosys.hxx"
@@ -1116,6 +1117,7 @@ void SbiRuntime::StepSTDERROR()
pInst->nErr = 0L;
pInst->nErl = 0;
nError = 0L;
+ SbxErrObject::getUnoErrObject()->Clear();
}
void SbiRuntime::StepNOERROR()
@@ -1124,6 +1126,7 @@ void SbiRuntime::StepNOERROR()
pInst->nErr = 0L;
pInst->nErl = 0;
nError = 0L;
+ SbxErrObject::getUnoErrObject()->Clear();
bError = FALSE;
}
@@ -1132,6 +1135,9 @@ void SbiRuntime::StepNOERROR()
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
@@ -1265,6 +1271,9 @@ void SbiRuntime::StepERROR()
SbxVariableRef refCode = PopVar();
USHORT n = refCode->GetUShort();
SbError error = StarBASIC::GetSfxFromVBError( n );
- Error( error );
+ if ( bVBAEnabled )
+ pInst->Error( error );
+ else
+ Error( error );
}
diff --git a/basic/source/runtime/step1.cxx b/basic/source/runtime/step1.cxx
index 399257cf6ad3..c6f090048bf2 100644
--- a/basic/source/runtime/step1.cxx
+++ b/basic/source/runtime/step1.cxx
@@ -30,11 +30,13 @@
#include <stdlib.h>
#include <rtl/math.hxx>
+#include <basic/sbuno.hxx>
#include "runtime.hxx"
#include "sbintern.hxx"
#include "iosys.hxx"
#include "image.hxx"
#include "sbunoobj.hxx"
+#include "errobject.hxx"
bool checkUnoObjectType( SbUnoObject* refVal,
const String& aClass );
@@ -230,8 +232,6 @@ void SbiRuntime::StepRETURN( UINT32 nOp1 )
// FOR-Variable testen (+Endlabel)
-void unoToSbxValue( SbxVariable* pVar, const Any& aValue );
-
void SbiRuntime::StepTESTFOR( UINT32 nOp1 )
{
if( !pForStk )
@@ -360,6 +360,7 @@ void SbiRuntime::StepERRHDL( UINT32 nOp1 )
pInst->nErr = 0;
pInst->nErl = 0;
nError = 0;
+ SbxErrObject::getUnoErrObject()->Clear();
}
// Resume nach Fehlern (+0=statement, 1=next or Label)
@@ -380,6 +381,8 @@ void SbiRuntime::StepRESUME( UINT32 nOp1 )
}
else
pCode = pErrStmnt;
+ if ( pError ) // current in error handler ( and got a Resume Next statment )
+ SbxErrObject::getUnoErrObject()->Clear();
if( nOp1 > 1 )
StepJUMP( nOp1 );
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-25 12:06:07 +0000