summaryrefslogtreecommitdiff
path: root/basic/source/classes
diff options
context:
space:
mode:
Diffstat (limited to 'basic/source/classes')
-rw-r--r--basic/source/classes/sb.cxx38
-rwxr-xr-xbasic/source/classes/sbunoobj.cxx39
-rw-r--r--basic/source/classes/sbxmod.cxx116
3 files changed, 133 insertions, 60 deletions
diff --git a/basic/source/classes/sb.cxx b/basic/source/classes/sb.cxx
index f8ffa46d48a5..bf7b00e2a633 100644
--- a/basic/source/classes/sb.cxx
+++ b/basic/source/classes/sb.cxx
@@ -42,6 +42,7 @@
#include <tools/shl.hxx>
#include <tools/rc.hxx>
#include <vcl/svapp.hxx>
+#include <comphelper/processfactory.hxx>
#include "sbunoobj.hxx"
#include "sbjsmeth.hxx"
#include "sbjsmod.hxx"
@@ -136,6 +137,7 @@ void DocBasicItem::startListening()
Any aThisComp;
mrDocBasic.GetUNOConstant( "ThisComponent", aThisComp );
Reference< util::XCloseBroadcaster > xCloseBC( aThisComp, UNO_QUERY );
+ mbDisposed = !xCloseBC.is();
if( xCloseBC.is() )
try { xCloseBC->addCloseListener( this ); } catch( uno::Exception& ) {}
}
@@ -437,7 +439,20 @@ SbxObject* SbiFactory::CreateObject( const String& rClass )
return new BasicCollection( aCollectionName );
}
else
- return NULL;
+ if( rClass.EqualsIgnoreCaseAscii( "FileSystemObject" ) )
+ {
+ try
+ {
+ Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory(), UNO_SET_THROW );
+ ::rtl::OUString aServiceName( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.FileSystemObject" ) );
+ Reference< XInterface > xInterface( xFactory->createInstance( aServiceName ), UNO_SET_THROW );
+ return new SbUnoObject( aServiceName, uno::makeAny( xInterface ) );
+ }
+ catch( Exception& )
+ {}
+ }
+
+ return NULL;
}
@@ -934,8 +949,14 @@ void StarBASIC::SetModified( sal_Bool b )
SbxBase::SetModified( b );
}
+extern void lcl_closeTraceFile();
+
StarBASIC::~StarBASIC()
{
+#ifdef DBG_TRACE_BASIC
+ lcl_closeTraceFile();
+#endif
+
// Needs to be first action as it can trigger events
disposeComVariablesForBasic( this );
@@ -2273,7 +2294,22 @@ void BasicCollection::CollRemove( SbxArray* pPar_ )
SbxVariable* p = pPar_->Get( 1 );
sal_Int32 nIndex = implGetIndex( p );
if( nIndex >= 0 && nIndex < (sal_Int32)xItemArray->Count32() )
+ {
xItemArray->Remove32( nIndex );
+
+ // Correct for stack if necessary
+ SbiInstance* pInst = pINST;
+ SbiRuntime* pRT = pInst ? pInst->pRun : NULL;
+ if( pRT )
+ {
+ SbiForStack* pStack = pRT->FindForStackItemForCollection( this );
+ if( pStack != NULL )
+ {
+ if( pStack->nCurCollectionIndex >= nIndex )
+ --pStack->nCurCollectionIndex;
+ }
+ }
+ }
else
SetError( SbERR_BAD_ARGUMENT );
}
diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx
index 13ae406cb305..6f20a68a274f 100755
--- a/basic/source/classes/sbunoobj.cxx
+++ b/basic/source/classes/sbunoobj.cxx
@@ -1722,8 +1722,7 @@ String getBasicObjectTypeName( SbxObject* pObj )
return aName;
}
-bool checkUnoObjectType( SbUnoObject* pUnoObj,
- const String& aClass )
+bool checkUnoObjectType( SbUnoObject* pUnoObj, const ::rtl::OUString& rClass )
{
Any aToInspectObj = pUnoObj->getUnoAny();
TypeClass eType = aToInspectObj.getValueType().getTypeClass();
@@ -1740,6 +1739,21 @@ bool checkUnoObjectType( SbUnoObject* pUnoObj,
Reference< XTypeProvider > xTypeProvider( x, UNO_QUERY );
if( xTypeProvider.is() )
{
+ /* Although interfaces in the ooo.vba namespace obey the IDL rules and
+ have a leading 'X', in Basic we want to be able to do something
+ like 'Dim wb As Workbooks' or 'Dim lb As MSForms.Label'. Here we
+ add a leading 'X' to the class name and a leading dot to the entire
+ type name. This results e.g. in '.XWorkbooks' or '.MSForms.XLabel'
+ which matches the interface names 'ooo.vba.excel.XWorkbooks' or
+ 'ooo.vba.msforms.XLabel'.
+ */
+ ::rtl::OUString aClassName( sal_Unicode( '.' ) );
+ sal_Int32 nClassNameDot = rClass.lastIndexOf( '.' );
+ if( nClassNameDot >= 0 )
+ aClassName += rClass.copy( 0, nClassNameDot + 1 ) + ::rtl::OUString( sal_Unicode( 'X' ) ) + rClass.copy( nClassNameDot + 1 );
+ else
+ aClassName += ::rtl::OUString( sal_Unicode( 'X' ) ) + rClass;
+
Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
const Type* pTypeArray = aTypeSeq.getConstArray();
sal_uInt32 nIfaceCount = aTypeSeq.getLength();
@@ -1753,8 +1767,8 @@ bool checkUnoObjectType( SbUnoObject* pUnoObj,
DBG_ERROR("failed to get XIdlClass for type");
break;
}
- ::rtl::OUString sClassName = xClass->getName();
- if ( sClassName.equals( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.bridge.oleautomation.XAutomationObject" ) ) ) )
+ ::rtl::OUString aInterfaceName = xClass->getName();
+ if ( aInterfaceName.equals( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.bridge.oleautomation.XAutomationObject" ) ) ) )
{
// there is a hack in the extensions/source/ole/oleobj.cxx to return the typename of the automation object, lets check if it
// matches
@@ -1767,20 +1781,15 @@ bool checkUnoObjectType( SbUnoObject* pUnoObj,
// can't check type, leave it pass
result = true;
else
- result = sTypeName.equals( aClass );
+ result = sTypeName.equals( rClass );
}
break; // finished checking automation object
}
- OSL_TRACE("Checking if object implements %s",
- OUStringToOString( defaultNameSpace + aClass,
- RTL_TEXTENCODING_UTF8 ).getStr() );
- // although interfaces in the ooo.vba.vba namespace
- // obey the idl rules and have a leading X, in basic we
- // want to be able to do something like
- // 'dim wrkbooks as WorkBooks'
- // so test assumes the 'X' has been dropped
- sal_Int32 indexLastDot = sClassName.lastIndexOf('.');
- if ( indexLastDot > -1 && sClassName.copy( indexLastDot + 1).equalsIgnoreAsciiCase( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("X") ) + aClass ) )
+
+ // match interface name with passed class name
+ OSL_TRACE("Checking if object implements %s", OUStringToOString( aClassName, RTL_TEXTENCODING_UTF8 ).getStr() );
+ if ( (aClassName.getLength() < aInterfaceName.getLength()) &&
+ aInterfaceName.matchIgnoreAsciiCase( aClassName, aInterfaceName.getLength() - aClassName.getLength() ) )
{
result = true;
break;
diff --git a/basic/source/classes/sbxmod.cxx b/basic/source/classes/sbxmod.cxx
index c722e680fd8c..24b031e8f4e9 100644
--- a/basic/source/classes/sbxmod.cxx
+++ b/basic/source/classes/sbxmod.cxx
@@ -61,6 +61,7 @@
#include <com/sun/star/lang/XServiceInfo.hpp>
#include <com/sun/star/script/ModuleType.hpp>
#include <com/sun/star/script/vba/XVBACompatibility.hpp>
+#include <com/sun/star/script/vba/VBAScriptEventId.hpp>
#include <com/sun/star/beans/XPropertySet.hpp>
#include <com/sun/star/document/XEventBroadcaster.hpp>
#include <com/sun/star/document/XEventListener.hpp>
@@ -88,10 +89,8 @@ using namespace com::sun::star;
#include <cppuhelper/implbase1.hxx>
#include <basic/sbobjmod.hxx>
#include <com/sun/star/uno/XAggregation.hpp>
-#include <map>
#include <com/sun/star/script/XInvocation.hpp>
- using namespace ::com::sun::star;
using namespace com::sun::star::lang;
using namespace com::sun::star::reflection;
using namespace com::sun::star::beans;
@@ -107,6 +106,7 @@ using namespace com::sun::star::script;
#include <cppuhelper/implbase1.hxx>
#include <comphelper/anytostring.hxx>
#include <com/sun/star/beans/XPropertySet.hpp>
+#include <ooo/vba/VbQueryClose.hpp>
typedef ::cppu::WeakImplHelper1< XInvocation > DocObjectWrapper_BASE;
typedef ::std::map< sal_Int16, Any, ::std::less< sal_Int16 > > OutParamMap;
@@ -451,24 +451,36 @@ TYPEINIT1(SbUserFormModule,SbObjModule)
typedef std::vector<HighlightPortion> HighlightPortions;
-bool getDefaultVBAMode( StarBASIC* pb )
+uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
{
- bool bResult = false;
- if ( pb && pb->IsDocBasic() )
+ uno::Reference< frame::XModel > xModel;
+ if( pb && pb->IsDocBasic() )
{
uno::Any aDoc;
- if ( pb->GetUNOConstant( "ThisComponent", aDoc ) )
- {
- uno::Reference< beans::XPropertySet > xProp( aDoc, uno::UNO_QUERY );
- if ( xProp.is() )
- {
- uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProp->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("BasicLibraries") ) ), uno::UNO_QUERY );
- if ( xVBAMode.is() )
- bResult = xVBAMode->getVBACompatibilityMode() == sal_True;
- }
- }
+ if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
+ xModel.set( aDoc, uno::UNO_QUERY );
}
- return bResult;
+ return xModel;
+}
+
+uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
+{
+ uno::Reference< vba::XVBACompatibility > xVBACompat;
+ try
+ {
+ uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
+ xVBACompat.set( xModelProps->getPropertyValue( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "BasicLibraries" ) ) ), uno::UNO_QUERY );
+ }
+ catch( uno::Exception& )
+ {
+ }
+ return xVBACompat;
+}
+
+bool getDefaultVBAMode( StarBASIC* pb )
+{
+ uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( getDocumentModel( pb ) );
+ return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
}
class AsyncQuitHandler
@@ -501,20 +513,6 @@ IMPL_LINK( AsyncQuitHandler, OnAsyncQuit, void*, /*pNull*/ )
return 0L;
}
-void VBAUnlockDocuments( StarBASIC* pBasic )
-{
- if ( pBasic && pBasic->IsDocBasic() )
- {
- SbUnoObject* pGlobs = dynamic_cast< SbUnoObject* >( pBasic->Find( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "ThisComponent" ) ), SbxCLASS_DONTCARE ) );
- if ( pGlobs )
- {
- uno::Reference< frame::XModel > xModel( pGlobs->getUnoAny(), uno::UNO_QUERY );
- ::basic::vba::lockControllersOfAllDocuments( xModel, sal_False );
- ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, sal_True );
- }
- }
-}
-
/////////////////////////////////////////////////////////////////////////////
// Ein BASIC-Modul hat EXTSEARCH gesetzt, damit die im Modul enthaltenen
@@ -833,7 +831,7 @@ void SbModule::SetSource( const String& r )
void SbModule::SetSource32( const ::rtl::OUString& r )
{
// Default basic mode to library container mode, but.. allow Option VBASupport 0/1 override
- SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
+ SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
aOUSource = r;
StartDefinitions();
SbiTokenizer aTok( r );
@@ -1031,6 +1029,8 @@ sal_uInt16 SbModule::Run( SbMethod* pMeth )
sal_uInt16 nRes = 0;
sal_Bool bDelInst = sal_Bool( pINST == NULL );
StarBASICRef xBasic;
+ uno::Reference< frame::XModel > xModel;
+ uno::Reference< script::vba::XVBACompatibility > xVBACompat;
if( bDelInst )
{
#ifdef DBG_TRACE_BASIC
@@ -1041,6 +1041,23 @@ sal_uInt16 SbModule::Run( SbMethod* pMeth )
pINST = new SbiInstance( (StarBASIC*) GetParent() );
+ /* If a VBA script in a document is started, get the VBA compatibility
+ interface from the document Basic library container, and notify all
+ VBA script listeners about the started script. */
+ if( mbVBACompat )
+ {
+ StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
+ if( pBasic && pBasic->IsDocBasic() ) try
+ {
+ xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
+ xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
+ xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
+ }
+ catch( uno::Exception& )
+ {
+ }
+ }
+
// Launcher problem
// i80726 The Find below will genarate an error in Testtool so we reset it unless there was one before already
sal_Bool bWasError = SbxBase::GetError() != 0;
@@ -1183,9 +1200,20 @@ sal_uInt16 SbModule::Run( SbMethod* pMeth )
ResetCapturedAssertions();
#endif
- // VBA always ensures screenupdating is enabled after completing
- if ( mbVBACompat )
- VBAUnlockDocuments( PTR_CAST( StarBASIC, GetParent() ) );
+ if( xVBACompat.is() )
+ {
+ // notify all VBA script listeners about the stopped script
+ try
+ {
+ xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
+ }
+ catch( uno::Exception& )
+ {
+ }
+ // VBA always ensures screenupdating is enabled after completing
+ ::basic::vba::lockControllersOfAllDocuments( xModel, sal_False );
+ ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, sal_True );
+ }
#ifdef DBG_TRACE_BASIC
dbg_DeInitTrace();
@@ -2276,8 +2304,9 @@ public:
uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
if ( xVbaMethodParameter.is() )
{
+#endif
sal_Int8 nCancel = 0;
- sal_Int8 nCloseMode = 0;
+ sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
Sequence< Any > aParams;
aParams.realloc(2);
@@ -2286,14 +2315,13 @@ public:
mpUserForm->triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ),
aParams);
+#if IN_THE_FUTURE
xVbaMethodParameter->setVbaMethodParameter( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Cancel")), aParams[0]);
return;
}
}
}
-
- mpUserForm->triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ) );
#endif
}
//liuchen 2009-7-21
@@ -2403,15 +2431,14 @@ void SbUserFormModule::triggerMethod( const String& aMethodToRun )
Sequence< Any > aArguments;
triggerMethod( aMethodToRun, aArguments );
}
-void SbUserFormModule::triggerMethod( const String& aMethodToRun, Sequence< Any >& /*aArguments*/)
+
+void SbUserFormModule::triggerMethod( const String& aMethodToRun, Sequence< Any >& aArguments )
{
OSL_TRACE("*** trigger %s ***", rtl::OUStringToOString( aMethodToRun, RTL_TEXTENCODING_UTF8 ).getStr() );
// Search method
SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxCLASS_METHOD );
if( pMeth )
{
-#if IN_THE_FUTURE
- //liuchen 2009-7-21, support Excel VBA UserForm_QueryClose event with parameters
if ( aArguments.getLength() > 0 ) // Setup parameters
{
SbxArrayRef xArray = new SbxArray;
@@ -2439,8 +2466,6 @@ void SbUserFormModule::triggerMethod( const String& aMethodToRun, Sequence< Any
pMeth->SetParameters( NULL );
}
else
-//liuchen 2009-7-21
-#endif
{
SbxValues aVals;
pMeth->Get( aVals );
@@ -2532,7 +2557,7 @@ void SbUserFormModule::Unload()
OSL_TRACE("** Unload() ");
sal_Int8 nCancel = 0;
- sal_Int8 nCloseMode = 1;
+ sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormCode;
Sequence< Any > aParams;
aParams.realloc(2);
@@ -2542,7 +2567,7 @@ void SbUserFormModule::Unload()
triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ), aParams);
aParams[0] >>= nCancel;
- if (nCancel == 1)
+ if (nCancel != 0) // Basic returns -1 for "True"
{
return;
}
@@ -2585,6 +2610,9 @@ void SbUserFormModule::InitObject()
SbUnoObject* pGlobs = (SbUnoObject*)GetParent()->Find( aHook, SbxCLASS_DONTCARE );
if ( m_xModel.is() && pGlobs )
{
+ // broadcast INITIALIZE_USERFORM script event before the dialog is created
+ Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
+ xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
uno::Reference< lang::XMultiServiceFactory > xFactory = comphelper::getProcessServiceFactory();
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-16 22:09:23 +0000