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