diff options
Diffstat (limited to 'vbahelper/source/vbahelper/vbaapplicationbase.cxx')
| -rw-r--r-- | vbahelper/source/vbahelper/vbaapplicationbase.cxx | 293 |
1 files changed, 292 insertions, 1 deletions
diff --git a/vbahelper/source/vbahelper/vbaapplicationbase.cxx b/vbahelper/source/vbahelper/vbaapplicationbase.cxx index 54b635d2f08d..6d2c51066ca2 100644 --- a/vbahelper/source/vbahelper/vbaapplicationbase.cxx +++ b/vbahelper/source/vbahelper/vbaapplicationbase.cxx @@ -26,15 +26,24 @@ ************************************************************************/ #include "vbahelper/vbaapplicationbase.hxx" #include <com/sun/star/container/XIndexAccess.hpp> +#include <com/sun/star/lang/XMultiServiceFactory.hpp> //Michael E. Bohn +#include <com/sun/star/lang/XMultiComponentFactory.hpp> //Michael E. Bohn +#include <com/sun/star/lang/XComponent.hpp> //Michael E. Bohn +#include <com/sun/star/container/XEnumeration.hpp> //Michael E. Bohn #include <com/sun/star/frame/XLayoutManager.hpp> #include <com/sun/star/frame/XDesktop.hpp> #include <com/sun/star/container/XEnumerationAccess.hpp> #include <com/sun/star/document/XDocumentInfoSupplier.hpp> #include <com/sun/star/document/XDocumentProperties.hpp> #include <com/sun/star/document/XDocumentPropertiesSupplier.hpp> +#include <com/sun/star/document/XEmbeddedScripts.hpp> //Michael E. Bohn +#include <ooo/vba/XVBAAppService.hpp> //Michael E. Bohn +#include <com/sun/star/awt/XWindow2.hpp> + #include "vbacommandbars.hxx" #include <filter/msfilter/msvbahelper.hxx> +#include <tools/datetime.hxx> // start basic includes #include <basic/sbx.hxx> @@ -43,18 +52,141 @@ #include <basic/sbmeth.hxx> #include <basic/sbmod.hxx> // end basic includes + +#include <hash_map> + using namespace com::sun::star; using namespace ooo::vba; #define OFFICEVERSION "11.0" +// ====VbaTimerInfo================================== +typedef ::std::pair< ::rtl::OUString, ::std::pair< double, double > > VbaTimerInfo; + +// ====VbaTimer================================== +class VbaTimer +{ + Timer m_aTimer; + VbaTimerInfo m_aTimerInfo; + ::rtl::Reference< VbaApplicationBase > m_xBase; + + // the following declarations are here to prevent the usage of them + VbaTimer( const VbaTimer& ); + VbaTimer& operator=( const VbaTimer& ); + +public: + VbaTimer() + {} + + virtual ~VbaTimer() + { + m_aTimer.Stop(); + } + + static double GetNow() + { + Date aDateNow; + Time aTimeNow; + Date aRefDate( 1,1,1900 ); + long nDiffDays = (long)(aDateNow - aRefDate); + nDiffDays += 2; // Anpassung VisualBasic: 1.Jan.1900 == 2 + + long nDiffSeconds = aTimeNow.GetHour() * 3600 + aTimeNow.GetMin() * 60 + aTimeNow.GetSec(); + return (double)nDiffDays + ((double)nDiffSeconds)/(double)(24*3600); + } + + static sal_Int32 GetTimerMiliseconds( double nFrom, double nTo ) + { + double nResult = nTo - nFrom; + if ( nResult > 0 ) + nResult *= 24*3600*1000; + else + nResult = 50; + + return (sal_Int32) nResult; + } + + void Start( const ::rtl::Reference< VbaApplicationBase > xBase, const ::rtl::OUString& aFunction, double nFrom, double nTo ) + { + if ( !xBase.is() || !aFunction.getLength() ) + throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Unexpected arguments!" ) ), uno::Reference< uno::XInterface >() ); + + m_xBase = xBase; + m_aTimerInfo = VbaTimerInfo( aFunction, ::std::pair< double, double >( nFrom, nTo ) ); + m_aTimer.SetTimeoutHdl( LINK( this, VbaTimer, MacroCallHdl ) ); + m_aTimer.SetTimeout( GetTimerMiliseconds( GetNow(), nFrom ) ); + m_aTimer.Start(); + } + + DECL_LINK( MacroCallHdl, void* ); +}; + +IMPL_LINK( VbaTimer, MacroCallHdl, void*, EMPTYARG ) +{ + if ( m_aTimerInfo.second.second == 0 || GetNow() < m_aTimerInfo.second.second ) + { + uno::Any aDummyArg; + try + { + m_xBase->Run( m_aTimerInfo.first, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg, aDummyArg ); + } + catch( uno::Exception& ) + {} + } + + // mast be the last call in the method since it deletes the timer + try + { + m_xBase->OnTime( uno::makeAny( m_aTimerInfo.second.first ), m_aTimerInfo.first, uno::makeAny( m_aTimerInfo.second.second ), uno::makeAny( sal_False ) ); + } catch( uno::Exception& ) + {} + + return 0; +} + +// ====VbaTimerInfoHash================================== +struct VbaTimerInfoHash +{ + size_t operator()( const VbaTimerInfo& rTimerInfo ) const + { + return (size_t)rTimerInfo.first.hashCode() + + (size_t)rtl_str_hashCode_WithLength( (char*)&rTimerInfo.second.first, sizeof( double ) ) + + (size_t)rtl_str_hashCode_WithLength( (char*)&rTimerInfo.second.second, sizeof( double ) ); + } +}; + +// ====VbaTimerHashMap================================== +typedef ::std::hash_map< VbaTimerInfo, VbaTimer*, VbaTimerInfoHash, ::std::equal_to< VbaTimerInfo > > VbaTimerHashMap; + +// ====VbaApplicationBase_Impl================================== +struct VbaApplicationBase_Impl +{ + VbaTimerHashMap m_aTimerHash; + + virtual ~VbaApplicationBase_Impl() + { + // remove the remaining timers + for ( VbaTimerHashMap::iterator aIter = m_aTimerHash.begin(); + aIter != m_aTimerHash.end(); + aIter++ ) + { + delete aIter->second; + aIter->second = NULL; + } + } +}; + +// ====VbaApplicationBase================================== VbaApplicationBase::VbaApplicationBase( const uno::Reference< uno::XComponentContext >& xContext ) : ApplicationBase_BASE( uno::Reference< XHelperInterface >(), xContext ) + , m_pImpl( new VbaApplicationBase_Impl ) { } VbaApplicationBase::~VbaApplicationBase() { + m_pImpl = 0; + delete m_pImpl; } sal_Bool SAL_CALL @@ -116,6 +248,26 @@ VbaApplicationBase::setDisplayStatusBar(sal_Bool bDisplayStatusBar) throw (uno:: return; } +::sal_Bool SAL_CALL VbaApplicationBase::getInteractive() + throw (uno::RuntimeException) +{ + uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW ); + uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_QUERY_THROW ); + uno::Reference< awt::XWindow2 > xWindow( xFrame->getContainerWindow(), uno::UNO_QUERY_THROW ); + + return xWindow->isEnabled(); +} + +void SAL_CALL VbaApplicationBase::setInteractive( ::sal_Bool bInteractive ) + throw (uno::RuntimeException) +{ + uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW ); + uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_QUERY_THROW ); + uno::Reference< awt::XWindow > xWindow( xFrame->getContainerWindow(), uno::UNO_SET_THROW ); + + xWindow->setEnable( bInteractive ); +} + uno::Any SAL_CALL VbaApplicationBase::CommandBars( const uno::Any& aIndex ) throw (uno::RuntimeException) { @@ -133,7 +285,54 @@ VbaApplicationBase::getVersion() throw (uno::RuntimeException) void SAL_CALL VbaApplicationBase::Run( const ::rtl::OUString& MacroName, const uno::Any& varg1, const uno::Any& varg2, const uno::Any& varg3, const uno::Any& varg4, const uno::Any& varg5, const uno::Any& varg6, const uno::Any& varg7, const uno::Any& varg8, const uno::Any& varg9, const uno::Any& varg10, const uno::Any& varg11, const uno::Any& varg12, const uno::Any& varg13, const uno::Any& varg14, const uno::Any& varg15, const uno::Any& varg16, const uno::Any& varg17, const uno::Any& varg18, const uno::Any& varg19, const uno::Any& varg20, const uno::Any& varg21, const uno::Any& varg22, const uno::Any& varg23, const uno::Any& varg24, const uno::Any& varg25, const uno::Any& varg26, const uno::Any& varg27, const uno::Any& varg28, const uno::Any& varg29, const uno::Any& varg30 ) throw (uno::RuntimeException) { - VBAMacroResolvedInfo aMacroInfo = resolveVBAMacro( getSfxObjShell( getCurrentDocument() ), MacroName ); + ::rtl::OUString sSeparator = ::rtl::OUString::createFromAscii("/"); + ::rtl::OUString sMacroSeparator = ::rtl::OUString::createFromAscii("!"); + ::rtl::OUString sMacro_only_Name; + sal_Int32 Position_MacroSeparator = MacroName.indexOf(sMacroSeparator); + + uno::Reference< frame::XModel > aMacroDocumentModel; + if (-1 != Position_MacroSeparator) + { + uno::Reference< container::XEnumerationAccess > xComponentEnumAccess; + uno::Reference< lang::XMultiComponentFactory > xServiceManager = mxContext->getServiceManager(); + try + { + uno::Reference< frame::XDesktop > xDesktop (xServiceManager->createInstanceWithContext( ::rtl::OUString(RTL_CONSTASCII_USTRINGPARAM( "com.sun.star.frame.Desktop" )),mxContext ), uno::UNO_QUERY_THROW ); + xComponentEnumAccess = xDesktop->getComponents(); + } + catch(uno::Exception&) + { + } + + //rem look for the name of the document in the cmpoonents collection + uno::Reference < container::XEnumeration > xEnum = xComponentEnumAccess->createEnumeration(); + + // iterate through the collection by name + while (xEnum->hasMoreElements()) + { + // get the next element as a UNO Any + uno::Any aComponentHelper = xEnum->nextElement(); + uno::Reference <frame::XModel> xDocModel( aComponentHelper, uno::UNO_QUERY_THROW ); + + // get the name of the sheet from its XNamed interface + ::rtl::OUString aName = xDocModel->getURL(); + + + if (aName.match(MacroName.copy(0,Position_MacroSeparator-1),aName.lastIndexOf(sSeparator)+1)) + { + aMacroDocumentModel = xDocModel; + sMacro_only_Name = MacroName.copy(Position_MacroSeparator+1); + } + } + } + else + { + aMacroDocumentModel = getCurrentDocument(); + sMacro_only_Name = MacroName.copy(0); + } + + + VBAMacroResolvedInfo aMacroInfo = resolveVBAMacro( getSfxObjShell( aMacroDocumentModel ), sMacro_only_Name ); if( aMacroInfo.IsResolved() ) { // handle the arguments @@ -168,6 +367,39 @@ void SAL_CALL VbaApplicationBase::Run( const ::rtl::OUString& MacroName, const u } } +void SAL_CALL VbaApplicationBase::OnTime( const uno::Any& aEarliestTime, const ::rtl::OUString& aFunction, const uno::Any& aLatestTime, const uno::Any& aSchedule ) + throw ( uno::RuntimeException ) +{ + if ( !aFunction.getLength() ) + throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Unexpected function name!" ) ), uno::Reference< uno::XInterface >() ); + + double nEarliestTime = 0; + double nLatestTime = 0; + if ( !( aEarliestTime >>= nEarliestTime ) + || ( aLatestTime.hasValue() && !( aLatestTime >>= nLatestTime ) ) ) + throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Only double is supported as time for now!" ) ), uno::Reference< uno::XInterface >() ); + + sal_Bool bSetTimer = sal_True; + aSchedule >>= bSetTimer; + + VbaTimerInfo aTimerIndex( aFunction, ::std::pair< double, double >( nEarliestTime, nLatestTime ) ); + + VbaTimerHashMap::iterator aIter = m_pImpl->m_aTimerHash.find( aTimerIndex ); + if ( aIter != m_pImpl->m_aTimerHash.end() ) + { + delete aIter->second; + aIter->second = NULL; + m_pImpl->m_aTimerHash.erase( aIter ); + } + + if ( bSetTimer ) + { + VbaTimer* pTimer = new VbaTimer; + m_pImpl->m_aTimerHash[ aTimerIndex ] = pTimer; + pTimer->Start( this, aFunction, nEarliestTime, nLatestTime ); + } +} + float SAL_CALL VbaApplicationBase::CentimetersToPoints( float _Centimeters ) throw (uno::RuntimeException) { // i cm = 28.35 points @@ -175,6 +407,57 @@ float SAL_CALL VbaApplicationBase::CentimetersToPoints( float _Centimeters ) thr return ( _Centimeters * rate ); } +// inserted by Michael E. Bohn +uno::Any SAL_CALL VbaApplicationBase::getVBE() throw (uno::RuntimeException) +{ + uno::Any aAny; + uno::Reference< ::lang::XMultiComponentFactory > xServiceManager = mxContext->getServiceManager(); + try + { + uno::Reference < ::uno::XInterface > xInterface = xServiceManager->createInstanceWithContext( ::rtl::OUString(RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.VBAAppService" )),mxContext); + uno::Reference < ::ooo::vba::XVBAAppService > xVBAAppService (xInterface, ::uno::UNO_QUERY_THROW ); + if (xVBAAppService.is()){ + uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW ); + return xVBAAppService->getVBE( this, mxContext, xModel); + } + + }catch(uno::Exception* e) + { + } + return aAny; +} + +uno::Any SAL_CALL +VbaApplicationBase::getVBProjects() throw (uno::RuntimeException) +{ + uno::Any aAny; + uno::Reference< ::lang::XMultiComponentFactory > xServiceManager = mxContext->getServiceManager(); + try + { + uno::Reference < ::uno::XInterface > xInterface = xServiceManager->createInstanceWithContext( ::rtl::OUString(RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.VBAAppService" )),mxContext); + uno::Reference < ::ooo::vba::XVBAAppService > xVBAAppService (xInterface, ::uno::UNO_QUERY_THROW ); + if (xVBAAppService.is()){ + uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW ); + uno::Reference< document::XEmbeddedScripts > xEnbeddedScripts ( xModel, uno::UNO_QUERY_THROW ); + uno::Reference< script::XStorageBasedLibraryContainer > xMacroStorageBasedLibraryContainer = xEnbeddedScripts->getBasicLibraries(); + uno::Reference< script::XStorageBasedLibraryContainer > xDialogStorageBasedLibraryContainer = xEnbeddedScripts->getDialogLibraries(); + uno::Reference< script::XLibraryContainer > xMacroLibraryContainer ( xMacroStorageBasedLibraryContainer, uno::UNO_QUERY_THROW ); + uno::Reference< script::XLibraryContainer > xDialogLibraryContainer( xDialogStorageBasedLibraryContainer, uno::UNO_QUERY_THROW ); + return xVBAAppService->getVBProjects(this, mxContext, xModel, xMacroLibraryContainer, xDialogLibraryContainer); + } + + }catch(uno::Exception* e) + { + } + return aAny; + + + +} + + + + rtl::OUString& VbaApplicationBase::getServiceImplName() { @@ -193,6 +476,13 @@ VbaApplicationBase::getServiceNames() return aServiceNames; } +void SAL_CALL VbaApplicationBase::Undo() + throw (uno::RuntimeException) +{ + uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW ); + dispatchRequests( xModel, ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:Undo" ) ) ); +} + void VbaApplicationBase::Quit() throw (uno::RuntimeException) { // need to stop basic @@ -208,3 +498,4 @@ void VbaApplicationBase::Quit() throw (uno::RuntimeException) } } } + |