xref: /trunk/main/vbahelper/source/vbahelper/vbaapplicationbase.cxx (revision cdf0e10c4e3984b49a9502b011690b615761d4a3)
1 /*************************************************************************
2  *
3  * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
4  *
5  * Copyright 2000, 2010 Oracle and/or its affiliates.
6  *
7  * OpenOffice.org - a multi-platform office productivity suite
8  *
9  * This file is part of OpenOffice.org.
10  *
11  * OpenOffice.org is free software: you can redistribute it and/or modify
12  * it under the terms of the GNU Lesser General Public License version 3
13  * only, as published by the Free Software Foundation.
14  *
15  * OpenOffice.org is distributed in the hope that it will be useful,
16  * but WITHOUT ANY WARRANTY; without even the implied warranty of
17  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18  * GNU Lesser General Public License version 3 for more details
19  * (a copy is included in the LICENSE file that accompanied this code).
20  *
21  * You should have received a copy of the GNU Lesser General Public License
22  * version 3 along with OpenOffice.org.  If not, see
23  * <http://www.openoffice.org/license.html>
24  * for a copy of the LGPLv3 License.
25  *
26  ************************************************************************/
27 
28 #include "vbahelper/vbaapplicationbase.hxx"
29 
30 #include <com/sun/star/container/XIndexAccess.hpp>
31 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
32 #include <com/sun/star/lang/XMultiComponentFactory.hpp>
33 #include <com/sun/star/lang/XComponent.hpp>
34 #include <com/sun/star/container/XEnumeration.hpp>
35 #include <com/sun/star/frame/XLayoutManager.hpp>
36 #include <com/sun/star/frame/XDesktop.hpp>
37 #include <com/sun/star/container/XEnumerationAccess.hpp>
38 #include <com/sun/star/document/XDocumentInfoSupplier.hpp>
39 #include <com/sun/star/document/XDocumentProperties.hpp>
40 #include <com/sun/star/document/XDocumentPropertiesSupplier.hpp>
41 #include <com/sun/star/document/XEmbeddedScripts.hpp>
42 #include <com/sun/star/awt/XWindow2.hpp>
43 
44 #include <hash_map>
45 #include <filter/msfilter/msvbahelper.hxx>
46 #include <tools/datetime.hxx>
47 
48 #include <basic/sbx.hxx>
49 #include <basic/sbstar.hxx>
50 #include <basic/sbuno.hxx>
51 #include <basic/sbmeth.hxx>
52 #include <basic/sbmod.hxx>
53 #include <basic/vbahelper.hxx>
54 
55 #include "vbacommandbars.hxx"
56 
57 using namespace ::com::sun::star;
58 using namespace ::ooo::vba;
59 
60 #define OFFICEVERSION "11.0"
61 
62 // ====VbaTimerInfo==================================
63 typedef ::std::pair< ::rtl::OUString, ::std::pair< double, double > > VbaTimerInfo;
64 
65 // ====VbaTimer==================================
66 class VbaTimer
67 {
68     Timer m_aTimer;
69     VbaTimerInfo m_aTimerInfo;
70     ::rtl::Reference< VbaApplicationBase > m_xBase;
71 
72     // the following declarations are here to prevent the usage of them
73     VbaTimer( const VbaTimer& );
74     VbaTimer& operator=( const VbaTimer& );
75 
76 public:
77     VbaTimer()
78     {}
79 
80     virtual ~VbaTimer()
81     {
82         m_aTimer.Stop();
83     }
84 
85     static double GetNow()
86     {
87         Date aDateNow;
88         Time aTimeNow;
89         Date aRefDate( 1,1,1900 );
90         long nDiffDays = (long)(aDateNow - aRefDate);
91         nDiffDays += 2; // Anpassung VisualBasic: 1.Jan.1900 == 2
92 
93         long nDiffSeconds = aTimeNow.GetHour() * 3600 + aTimeNow.GetMin() * 60 + aTimeNow.GetSec();
94         return (double)nDiffDays + ((double)nDiffSeconds)/(double)(24*3600);
95     }
96 
97     static sal_Int32 GetTimerMiliseconds( double nFrom, double nTo )
98     {
99         double nResult = nTo - nFrom;
100         if ( nResult > 0 )
101             nResult *= 24*3600*1000;
102         else
103             nResult = 50;
104 
105         return (sal_Int32) nResult;
106     }
107 
108     void Start( const ::rtl::Reference< VbaApplicationBase > xBase, const ::rtl::OUString& aFunction, double nFrom, double nTo )
109     {
110         if ( !xBase.is() || !aFunction.getLength() )
111             throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Unexpected arguments!" ) ), uno::Reference< uno::XInterface >() );
112 
113         m_xBase = xBase;
114         m_aTimerInfo = VbaTimerInfo( aFunction, ::std::pair< double, double >( nFrom, nTo ) );
115         m_aTimer.SetTimeoutHdl( LINK( this, VbaTimer, MacroCallHdl ) );
116         m_aTimer.SetTimeout( GetTimerMiliseconds( GetNow(), nFrom ) );
117         m_aTimer.Start();
118     }
119 
120     DECL_LINK( MacroCallHdl, void* );
121 };
122 
123 IMPL_LINK( VbaTimer, MacroCallHdl, void*, EMPTYARG )
124 {
125     if ( m_aTimerInfo.second.second == 0 || GetNow() < m_aTimerInfo.second.second )
126     {
127         uno::Any aDummyArg;
128         try
129         {
130             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 );
131         }
132         catch( uno::Exception& )
133         {}
134     }
135 
136     // mast be the last call in the method since it deletes the timer
137     try
138     {
139         m_xBase->OnTime( uno::makeAny( m_aTimerInfo.second.first ), m_aTimerInfo.first, uno::makeAny( m_aTimerInfo.second.second ), uno::makeAny( sal_False ) );
140     } catch( uno::Exception& )
141     {}
142 
143     return 0;
144 }
145 
146 // ====VbaTimerInfoHash==================================
147 struct VbaTimerInfoHash
148 {
149     size_t operator()( const VbaTimerInfo& rTimerInfo ) const
150     {
151         return (size_t)rTimerInfo.first.hashCode()
152              + (size_t)rtl_str_hashCode_WithLength( (char*)&rTimerInfo.second.first, sizeof( double ) )
153              + (size_t)rtl_str_hashCode_WithLength( (char*)&rTimerInfo.second.second, sizeof( double ) );
154     }
155 };
156 
157 // ====VbaTimerHashMap==================================
158 typedef ::std::hash_map< VbaTimerInfo, VbaTimer*, VbaTimerInfoHash, ::std::equal_to< VbaTimerInfo > > VbaTimerHashMap;
159 
160 // ====VbaApplicationBase_Impl==================================
161 struct VbaApplicationBase_Impl
162 {
163     VbaTimerHashMap m_aTimerHash;
164     sal_Bool mbVisible;
165 
166     inline VbaApplicationBase_Impl() : mbVisible( sal_True ) {}
167 
168     virtual ~VbaApplicationBase_Impl()
169     {
170         // remove the remaining timers
171         for ( VbaTimerHashMap::iterator aIter = m_aTimerHash.begin();
172               aIter != m_aTimerHash.end();
173               aIter++ )
174         {
175             delete aIter->second;
176             aIter->second = NULL;
177         }
178     }
179 };
180 
181 // ====VbaApplicationBase==================================
182 VbaApplicationBase::VbaApplicationBase( const uno::Reference< uno::XComponentContext >& xContext )
183                     : ApplicationBase_BASE( uno::Reference< XHelperInterface >(), xContext )
184                     , m_pImpl( new VbaApplicationBase_Impl )
185 {
186 }
187 
188 VbaApplicationBase::~VbaApplicationBase()
189 {
190     delete m_pImpl;
191 }
192 
193 sal_Bool SAL_CALL
194 VbaApplicationBase::getScreenUpdating() throw (uno::RuntimeException)
195 {
196     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
197     return !xModel->hasControllersLocked();
198 }
199 
200 void SAL_CALL
201 VbaApplicationBase::setScreenUpdating(sal_Bool bUpdate) throw (uno::RuntimeException)
202 {
203     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
204     // #163808# use helper from module "basic" to lock all documents of this application
205     ::basic::vba::lockControllersOfAllDocuments( xModel, !bUpdate );
206 }
207 
208 sal_Bool SAL_CALL
209 VbaApplicationBase::getDisplayStatusBar() throw (uno::RuntimeException)
210 {
211     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
212     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_QUERY_THROW );
213     uno::Reference< beans::XPropertySet > xProps( xFrame, uno::UNO_QUERY_THROW );
214 
215     if( xProps.is() ){
216         uno::Reference< frame::XLayoutManager > xLayoutManager( xProps->getPropertyValue( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("LayoutManager")) ), uno::UNO_QUERY_THROW );
217         rtl::OUString url(RTL_CONSTASCII_USTRINGPARAM( "private:resource/statusbar/statusbar" ));
218         if( xLayoutManager.is() && xLayoutManager->isElementVisible( url ) ){
219             return sal_True;
220         }
221     }
222     return sal_False;
223 }
224 
225 void SAL_CALL
226 VbaApplicationBase::setDisplayStatusBar(sal_Bool bDisplayStatusBar) throw (uno::RuntimeException)
227 {
228     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
229     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_QUERY_THROW );
230     uno::Reference< beans::XPropertySet > xProps( xFrame, uno::UNO_QUERY_THROW );
231 
232     if( xProps.is() ){
233         uno::Reference< frame::XLayoutManager > xLayoutManager( xProps->getPropertyValue( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("LayoutManager")) ), uno::UNO_QUERY_THROW );
234         rtl::OUString url(RTL_CONSTASCII_USTRINGPARAM( "private:resource/statusbar/statusbar" ));
235         if( xLayoutManager.is() ){
236             if( bDisplayStatusBar && !xLayoutManager->isElementVisible( url ) ){
237                 if( !xLayoutManager->showElement( url ) )
238                     xLayoutManager->createElement( url );
239                 return;
240             }
241             else if( !bDisplayStatusBar && xLayoutManager->isElementVisible( url ) ){
242                 xLayoutManager->hideElement( url );
243                 return;
244             }
245         }
246     }
247     return;
248 }
249 
250 ::sal_Bool SAL_CALL VbaApplicationBase::getInteractive()
251     throw (uno::RuntimeException)
252 {
253     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
254     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_QUERY_THROW );
255     uno::Reference< awt::XWindow2 > xWindow( xFrame->getContainerWindow(), uno::UNO_QUERY_THROW );
256 
257     return xWindow->isEnabled();
258 }
259 
260 void SAL_CALL VbaApplicationBase::setInteractive( ::sal_Bool bInteractive )
261     throw (uno::RuntimeException)
262 {
263     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
264     // #163808# use helper from module "basic" to enable/disable all container windows of all documents of this application
265     ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, bInteractive );
266 }
267 
268 sal_Bool SAL_CALL VbaApplicationBase::getVisible() throw (uno::RuntimeException)
269 {
270     return m_pImpl->mbVisible;    // dummy implementation
271 }
272 
273 void SAL_CALL VbaApplicationBase::setVisible( sal_Bool bVisible ) throw (uno::RuntimeException)
274 {
275     m_pImpl->mbVisible = bVisible;  // dummy implementation
276 }
277 
278 uno::Any SAL_CALL
279 VbaApplicationBase::CommandBars( const uno::Any& aIndex ) throw (uno::RuntimeException)
280 {
281     uno::Reference< XCommandBars > xCommandBars( new ScVbaCommandBars( this, mxContext, uno::Reference< container::XIndexAccess >(), getCurrentDocument() ) );
282     if( aIndex.hasValue() )
283         return uno::makeAny( xCommandBars->Item( aIndex, uno::Any() ) );
284     return uno::makeAny( xCommandBars );
285 }
286 
287 ::rtl::OUString SAL_CALL
288 VbaApplicationBase::getVersion() throw (uno::RuntimeException)
289 {
290     return rtl::OUString(RTL_CONSTASCII_USTRINGPARAM(OFFICEVERSION));
291 }
292 
293 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)
294 {
295     ::rtl::OUString aMacroName = MacroName.trim();
296     if (0 == aMacroName.indexOf('!'))
297         aMacroName = aMacroName.copy(1).trim();
298 
299     uno::Reference< frame::XModel > xModel;
300     SbMethod* pMeth = StarBASIC::GetActiveMethod();
301     if ( pMeth )
302     {
303         SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
304         if ( pMod )
305             xModel = StarBASIC::GetModelFromBasic( pMod );
306     }
307 
308     if ( !xModel.is() )
309         xModel = getCurrentDocument();
310 
311     MacroResolvedInfo aMacroInfo = resolveVBAMacro( getSfxObjShell( xModel ), aMacroName );
312     if( aMacroInfo.mbFound )
313     {
314         // handle the arguments
315         const uno::Any* aArgsPtrArray[] = { &varg1, &varg2, &varg3, &varg4, &varg5, &varg6, &varg7, &varg8, &varg9, &varg10, &varg11, &varg12, &varg13, &varg14, &varg15, &varg16, &varg17, &varg18, &varg19, &varg20, &varg21, &varg22, &varg23, &varg24, &varg25, &varg26, &varg27, &varg28, &varg29, &varg30 };
316 
317         int nArg = sizeof( aArgsPtrArray ) / sizeof( aArgsPtrArray[0] );
318         uno::Sequence< uno::Any > aArgs( nArg );
319 
320         const uno::Any** pArg = aArgsPtrArray;
321         const uno::Any** pArgEnd = ( aArgsPtrArray + nArg );
322 
323         sal_Int32 nLastArgWithValue = 0;
324         sal_Int32 nArgProcessed = 0;
325 
326         for ( ; pArg != pArgEnd; ++pArg, ++nArgProcessed )
327         {
328             aArgs[ nArgProcessed ] =  **pArg;
329             if( (*pArg)->hasValue() )
330                 nLastArgWithValue = nArgProcessed;
331         }
332 
333         // resize array to position of last param with value
334         aArgs.realloc( nArgProcessed + 1 );
335 
336         uno::Any aRet;
337         uno::Any aDummyCaller;
338         executeMacro( aMacroInfo.mpDocContext, aMacroInfo.msResolvedMacro, aArgs, aRet, aDummyCaller );
339     }
340     else
341     {
342         throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("The macro doesn't exist") ), uno::Reference< uno::XInterface >() );
343     }
344 }
345 
346 void SAL_CALL VbaApplicationBase::OnTime( const uno::Any& aEarliestTime, const ::rtl::OUString& aFunction, const uno::Any& aLatestTime, const uno::Any& aSchedule )
347     throw ( uno::RuntimeException )
348 {
349     if ( !aFunction.getLength() )
350         throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Unexpected function name!" ) ), uno::Reference< uno::XInterface >() );
351 
352     double nEarliestTime = 0;
353     double nLatestTime = 0;
354     if ( !( aEarliestTime >>= nEarliestTime )
355       || ( aLatestTime.hasValue() && !( aLatestTime >>= nLatestTime ) ) )
356         throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Only double is supported as time for now!" ) ), uno::Reference< uno::XInterface >() );
357 
358     sal_Bool bSetTimer = sal_True;
359     aSchedule >>= bSetTimer;
360 
361     VbaTimerInfo aTimerIndex( aFunction, ::std::pair< double, double >( nEarliestTime, nLatestTime ) );
362 
363     VbaTimerHashMap::iterator aIter = m_pImpl->m_aTimerHash.find( aTimerIndex );
364     if ( aIter != m_pImpl->m_aTimerHash.end() )
365     {
366         delete aIter->second;
367         aIter->second = NULL;
368         m_pImpl->m_aTimerHash.erase( aIter );
369     }
370 
371     if ( bSetTimer )
372     {
373         VbaTimer* pTimer = new VbaTimer;
374         m_pImpl->m_aTimerHash[ aTimerIndex ] = pTimer;
375         pTimer->Start( this, aFunction, nEarliestTime, nLatestTime );
376     }
377 }
378 
379 float SAL_CALL VbaApplicationBase::CentimetersToPoints( float _Centimeters ) throw (uno::RuntimeException)
380 {
381     // i cm = 28.35 points
382     static const float rate = 28.35f;
383     return ( _Centimeters * rate );
384 }
385 
386 uno::Any SAL_CALL VbaApplicationBase::getVBE() throw (uno::RuntimeException)
387 {
388     try // return empty object on error
389     {
390         // "VBE" object does not have a parent, but pass document model to be able to determine application type
391         uno::Sequence< uno::Any > aArgs( 1 );
392         aArgs[ 0 ] <<= getCurrentDocument();
393         uno::Reference< lang::XMultiComponentFactory > xServiceManager( mxContext->getServiceManager(), uno::UNO_SET_THROW );
394         uno::Reference< uno::XInterface > xVBE = xServiceManager->createInstanceWithArgumentsAndContext(
395             ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.vbide.VBE" ) ), aArgs, mxContext );
396         return uno::Any( xVBE );
397     }
398     catch( uno::Exception& )
399     {
400     }
401     return uno::Any();
402 }
403 
404 rtl::OUString&
405 VbaApplicationBase::getServiceImplName()
406 {
407     static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("VbaApplicationBase") );
408     return sImplName;
409 }
410 
411 uno::Sequence<rtl::OUString>
412 VbaApplicationBase::getServiceNames()
413 {
414     static uno::Sequence< rtl::OUString > aServiceNames;
415     if ( aServiceNames.getLength() == 0 )
416     {
417         aServiceNames.realloc( 1 );
418         aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.VbaApplicationBase" ) );
419     }
420     return aServiceNames;
421 }
422 
423 void SAL_CALL VbaApplicationBase::Undo()
424     throw (uno::RuntimeException)
425 {
426     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW );
427     dispatchRequests( xModel, ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:Undo" ) ) );
428 }
429 
430 void VbaApplicationBase::Quit() throw (uno::RuntimeException)
431 {
432     // need to stop basic
433     SbMethod* pMeth = StarBASIC::GetActiveMethod();
434     if ( pMeth )
435     {
436         SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
437         if ( pMod )
438         {
439             StarBASIC* pBasic = dynamic_cast< StarBASIC* >( pMod->GetParent() );
440             if ( pBasic )
441                 pBasic->QuitAndExitApplication();
442         }
443     }
444 }
445 
446