1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; fill-column: 100 -*- */
2 /*
3  * This file is part of the LibreOffice project.
4  *
5  * This Source Code Form is subject to the terms of the Mozilla Public
6  * License, v. 2.0. If a copy of the MPL was not distributed with this
7  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
8  *
9  * This file incorporates work covered by the following license notice:
10  *
11  *   Licensed to the Apache Software Foundation (ASF) under one or more
12  *   contributor license agreements. See the NOTICE file distributed
13  *   with this work for additional information regarding copyright
14  *   ownership. The ASF licenses this file to you under the Apache
15  *   License, Version 2.0 (the "License"); you may not use this file
16  *   except in compliance with the License. You may obtain a copy of
17  *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
18  */
19 
20 #include <vbahelper/vbaapplicationbase.hxx>
21 #include <sal/macros.h>
22 
23 #include <com/sun/star/beans/XPropertySet.hpp>
24 #include <com/sun/star/container/XIndexAccess.hpp>
25 #include <com/sun/star/lang/XMultiComponentFactory.hpp>
26 #include <com/sun/star/frame/XLayoutManager.hpp>
27 #include <com/sun/star/awt/XWindow2.hpp>
28 
29 #include <filter/msfilter/msvbahelper.hxx>
30 #include <rtl/ref.hxx>
31 #include <tools/datetime.hxx>
32 #include <vcl/timer.hxx>
33 #include <vcl/svapp.hxx>
34 
35 #include <basic/sbstar.hxx>
36 #include <basic/sbmeth.hxx>
37 #include <basic/sbmod.hxx>
38 #include <basic/vbahelper.hxx>
39 
40 #include <comphelper/asyncquithandler.hxx>
41 
42 #include "vbacommandbars.hxx"
43 
44 #include <o3tl/hash_combine.hxx>
45 #include <o3tl/string_view.hxx>
46 #include <unordered_map>
47 
48 using namespace ::com::sun::star;
49 using namespace ::ooo::vba;
50 
51 constexpr OUStringLiteral OFFICEVERSION = u"11.0";
52 
53 typedef ::std::pair< OUString, ::std::pair< double, double > > VbaTimerInfo;
54 
55 namespace {
56 
57 class VbaTimer
58 {
59     Timer m_aTimer;
60     VbaTimerInfo m_aTimerInfo;
61     ::rtl::Reference< VbaApplicationBase > m_xBase;
62 
63 public:
64     VbaTimer() : m_aTimer("VbaTimer")
65     {}
66 
67     ~VbaTimer()
68     {
69         m_aTimer.Stop();
70     }
71 
72     VbaTimer(const VbaTimer&) = delete;
73     VbaTimer& operator=(const VbaTimer&) = delete;
74 
75     static double GetNow()
76     {
77         DateTime aNow( DateTime::SYSTEM );
78         Date aRefDate(1899'12'30);
79         tools::Long nDiffDays = aNow - aRefDate;
80 
81         tools::Long nDiffSeconds = aNow.GetHour() * 3600 + aNow.GetMin() * 60 + aNow.GetSec();
82         return static_cast<double>(nDiffDays) + static_cast<double>(nDiffSeconds)/double(24*3600);
83     }
84 
85     static sal_Int32 GetTimerMilliseconds( double nFrom, double nTo )
86     {
87         double nResult = nTo - nFrom;
88         if ( nResult > 0 )
89             nResult *= 24*3600*1000;
90         else
91             nResult = 50;
92 
93         return static_cast<sal_Int32>(nResult);
94     }
95 
96     void Start( const ::rtl::Reference< VbaApplicationBase >& xBase, const OUString& aFunction, double nFrom, double nTo )
97     {
98         if ( !xBase.is() || aFunction.isEmpty() )
99             throw uno::RuntimeException( "Unexpected arguments!" );
100 
101         m_xBase = xBase;
102         m_aTimerInfo = VbaTimerInfo( aFunction, ::std::pair< double, double >( nFrom, nTo ) );
103         m_aTimer.SetInvokeHandler( LINK( this, VbaTimer, MacroCallHdl ) );
104         m_aTimer.SetTimeout( GetTimerMilliseconds( GetNow(), nFrom ) );
105         m_aTimer.Start();
106     }
107 
108     DECL_LINK( MacroCallHdl, Timer*, void );
109 };
110 
111 }
112 
113 IMPL_LINK_NOARG(VbaTimer, MacroCallHdl, Timer *, void)
114 {
115     if ( m_aTimerInfo.second.second == 0 || GetNow() < m_aTimerInfo.second.second )
116     {
117         uno::Any aDummyArg;
118         try
119         {
120             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 );
121         }
122         catch( uno::Exception& )
123         {}
124     }
125 
126     // must be the last call in the method since it deletes the timer
127     try
128     {
129         m_xBase->OnTime( uno::Any( m_aTimerInfo.second.first ), m_aTimerInfo.first, uno::Any( m_aTimerInfo.second.second ), uno::Any( false ) );
130     } catch( uno::Exception& )
131     {}
132 }
133 
134 namespace {
135 
136 struct VbaTimerInfoHash
137 {
138     size_t operator()( const VbaTimerInfo& rTimerInfo ) const
139     {
140         std::size_t seed = 0;
141         o3tl::hash_combine(seed, rTimerInfo.first.hashCode());
142         o3tl::hash_combine(seed, rTimerInfo.second.first);
143         o3tl::hash_combine(seed, rTimerInfo.second.second);
144         return seed;
145     }
146 };
147 
148 }
149 
150 typedef std::unordered_map< VbaTimerInfo, std::unique_ptr<VbaTimer>, VbaTimerInfoHash > VbaTimerHashMap;
151 
152 struct VbaApplicationBase_Impl final
153 {
154     VbaTimerHashMap m_aTimerHash;
155     bool mbVisible;
156     OUString msCaption;
157 
158     VbaApplicationBase_Impl() : mbVisible( true ) {}
159 };
160 
161 VbaApplicationBase::VbaApplicationBase( const uno::Reference< uno::XComponentContext >& xContext )
162                     : ApplicationBase_BASE( uno::Reference< XHelperInterface >(), xContext )
163                     , m_pImpl( new VbaApplicationBase_Impl )
164 {
165 }
166 
167 VbaApplicationBase::~VbaApplicationBase()
168 {
169 }
170 
171 sal_Bool SAL_CALL
172 VbaApplicationBase::getScreenUpdating()
173 {
174     uno::Reference< frame::XModel > xModel = getCurrentDocument();
175     if (!xModel.is())
176         return true;
177     return !xModel->hasControllersLocked();
178 }
179 
180 void SAL_CALL
181 VbaApplicationBase::setScreenUpdating(sal_Bool bUpdate)
182 {
183     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
184     // #163808# use helper from module "basic" to lock all documents of this application
185     ::basic::vba::lockControllersOfAllDocuments( xModel, !bUpdate );
186 }
187 
188 sal_Bool SAL_CALL
189 VbaApplicationBase::getDisplayStatusBar()
190 {
191     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
192     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_SET_THROW );
193     uno::Reference< beans::XPropertySet > xProps( xFrame, uno::UNO_QUERY_THROW );
194 
195     uno::Reference< frame::XLayoutManager > xLayoutManager( xProps->getPropertyValue( "LayoutManager"), uno::UNO_QUERY_THROW );
196     if( xLayoutManager->isElementVisible( "private:resource/statusbar/statusbar" ) ){
197         return true;
198     }
199     return false;
200 }
201 
202 void SAL_CALL
203 VbaApplicationBase::setDisplayStatusBar(sal_Bool bDisplayStatusBar)
204 {
205     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
206     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_SET_THROW );
207     uno::Reference< beans::XPropertySet > xProps( xFrame, uno::UNO_QUERY_THROW );
208 
209     uno::Reference< frame::XLayoutManager > xLayoutManager( xProps->getPropertyValue( "LayoutManager" ), uno::UNO_QUERY_THROW );
210     OUString url( "private:resource/statusbar/statusbar" );
211     if( bDisplayStatusBar && !xLayoutManager->isElementVisible( url ) ){
212         if( !xLayoutManager->showElement( url ) )
213             xLayoutManager->createElement( url );
214         return;
215     }
216     else if( !bDisplayStatusBar && xLayoutManager->isElementVisible( url ) ){
217         xLayoutManager->hideElement( url );
218         return;
219     }
220 }
221 
222 sal_Bool SAL_CALL VbaApplicationBase::getInteractive()
223 {
224     uno::Reference< frame::XModel > xModel = getCurrentDocument();
225     if (!xModel.is())
226         return true;
227 
228     uno::Reference< frame::XController > xController( xModel->getCurrentController() );
229     if (!xController.is())
230         return true;
231 
232     uno::Reference< frame::XFrame > xFrame( xController->getFrame() );
233     if (!xFrame.is())
234         return true;
235 
236     uno::Reference< awt::XWindow2 > xWindow( xFrame->getContainerWindow(), uno::UNO_QUERY );
237     if (!xWindow.is())
238         return true;
239 
240     return xWindow->isEnabled();
241 }
242 
243 void SAL_CALL VbaApplicationBase::setInteractive( sal_Bool bInteractive )
244 {
245     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
246     // #163808# use helper from module "basic" to enable/disable all container windows of all documents of this application
247     ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, bInteractive );
248 }
249 
250 sal_Bool SAL_CALL VbaApplicationBase::getVisible()
251 {
252     return m_pImpl->mbVisible;    // dummy implementation
253 }
254 
255 void SAL_CALL VbaApplicationBase::setVisible( sal_Bool bVisible )
256 {
257     m_pImpl->mbVisible = bVisible;  // dummy implementation
258 }
259 
260 OUString SAL_CALL VbaApplicationBase::getCaption()
261 {
262     SbMethod* pMeth = StarBASIC::GetActiveMethod();
263     if (!pMeth)
264     {
265         // When called from Automation clients, we don't even try, as there doesn't seem to be any
266         // good way to get at the actual "caption" (title) of the application's window (any of them,
267         // if there are several). We just keep a copy of a fake caption in the VbaApplicationBase_Impl.
268         return m_pImpl->msCaption;
269     }
270 
271     // No idea if this code, which uses APIs that apparently are related to StarBasic (check
272     // getCurrentDoc() in vbahelper.cxx), actually works any better.
273     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
274     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_SET_THROW );
275     return xFrame->getName();
276 }
277 
278 void SAL_CALL VbaApplicationBase::setCaption( const OUString& sCaption )
279 {
280     // See comments in getCaption().
281 
282     SbMethod* pMeth = StarBASIC::GetActiveMethod();
283     if (!pMeth)
284     {
285         m_pImpl->msCaption = sCaption;
286         return;
287     }
288 
289     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
290     uno::Reference< frame::XFrame > xFrame( xModel->getCurrentController()->getFrame(), uno::UNO_SET_THROW );
291     xFrame->setName( sCaption );
292 }
293 
294 void SAL_CALL
295 VbaApplicationBase::OnKey( const OUString& Key, const uno::Any& Procedure )
296 {
297     // parse the Key & modifiers
298     awt::KeyEvent aKeyEvent = parseKeyEvent( Key );
299     OUString MacroName;
300     Procedure >>= MacroName;
301     uno::Reference< frame::XModel > xModel;
302     SbMethod* pMeth = StarBASIC::GetActiveMethod();
303     if ( pMeth )
304     {
305         SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
306         if ( pMod )
307             xModel = StarBASIC::GetModelFromBasic( pMod );
308     }
309 
310     if ( !xModel.is() )
311         xModel = getCurrentDocument();
312 
313     applyShortCutKeyBinding( xModel, aKeyEvent, MacroName );
314 }
315 
316 uno::Any SAL_CALL
317 VbaApplicationBase::CommandBars( const uno::Any& aIndex )
318 {
319     uno::Reference< XCommandBars > xCommandBars( new ScVbaCommandBars( this, mxContext, uno::Reference< container::XIndexAccess >(), getCurrentDocument() ) );
320     if( aIndex.hasValue() )
321         return xCommandBars->Item( aIndex, uno::Any() );
322     return uno::Any( xCommandBars );
323 }
324 
325 OUString SAL_CALL
326 VbaApplicationBase::getVersion()
327 {
328     return OFFICEVERSION;
329 }
330 
331 uno::Any SAL_CALL VbaApplicationBase::Run( const 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 )
332 {
333     OUString aMacroName = MacroName.trim();
334     if( aMacroName.startsWith("!") )
335         aMacroName = o3tl::trim(aMacroName.subView(1));
336 
337     uno::Reference< frame::XModel > xModel;
338     SbMethod* pMeth = StarBASIC::GetActiveMethod();
339     if ( pMeth )
340     {
341         SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
342         if ( pMod )
343             xModel = StarBASIC::GetModelFromBasic( pMod );
344     }
345 
346     if ( !xModel.is() )
347         xModel = getCurrentDocument();
348 
349     MacroResolvedInfo aMacroInfo = resolveVBAMacro( getSfxObjShell( xModel ), aMacroName );
350     if( !aMacroInfo.mbFound )
351     {
352         throw uno::RuntimeException( "The macro doesn't exist" );
353     }
354 
355     // handle the arguments
356     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 };
357 
358     int nArg = SAL_N_ELEMENTS( aArgsPtrArray );
359     uno::Sequence< uno::Any > aArgs( nArg );
360     auto pArgs = aArgs.getArray();
361 
362     const uno::Any** pArg = aArgsPtrArray;
363     const uno::Any** pArgEnd = aArgsPtrArray + nArg;
364 
365     sal_Int32 nArgProcessed = 0;
366 
367     for ( ; pArg != pArgEnd; ++pArg, ++nArgProcessed )
368         pArgs[ nArgProcessed ] =  **pArg;
369 
370     // resize array to position of last param with value
371     aArgs.realloc( nArgProcessed + 1 );
372 
373     uno::Any aRet;
374     uno::Any aDummyCaller;
375     executeMacro( aMacroInfo.mpDocContext, aMacroInfo.msResolvedMacro, aArgs, aRet, aDummyCaller );
376 
377     return aRet;
378 }
379 
380 void SAL_CALL VbaApplicationBase::OnTime( const uno::Any& aEarliestTime, const OUString& aFunction, const uno::Any& aLatestTime, const uno::Any& aSchedule )
381 {
382     if ( aFunction.isEmpty() )
383         throw uno::RuntimeException( "Unexpected function name!" );
384 
385     double nEarliestTime = 0;
386     double nLatestTime = 0;
387     if ( !( aEarliestTime >>= nEarliestTime )
388       || ( aLatestTime.hasValue() && !( aLatestTime >>= nLatestTime ) ) )
389         throw uno::RuntimeException( "Only double is supported as time for now!" );
390 
391     bool bSetTimer = true;
392     aSchedule >>= bSetTimer;
393 
394     VbaTimerInfo aTimerIndex( aFunction, ::std::pair< double, double >( nEarliestTime, nLatestTime ) );
395 
396     VbaTimerHashMap::iterator aIter = m_pImpl->m_aTimerHash.find( aTimerIndex );
397     if ( aIter != m_pImpl->m_aTimerHash.end() )
398     {
399         m_pImpl->m_aTimerHash.erase( aIter );
400     }
401 
402     if ( bSetTimer )
403     {
404         VbaTimer* pTimer = new VbaTimer;
405         m_pImpl->m_aTimerHash[ aTimerIndex ].reset(pTimer);
406         pTimer->Start( this, aFunction, nEarliestTime, nLatestTime );
407     }
408 }
409 
410 float SAL_CALL VbaApplicationBase::CentimetersToPoints( float Centimeters )
411 {
412     return o3tl::convert(Centimeters, o3tl::Length::cm, o3tl::Length::pt);
413 }
414 
415 uno::Any SAL_CALL VbaApplicationBase::getVBE()
416 {
417     try // return empty object on error
418     {
419         // "VBE" object does not have a parent, but pass document model to be able to determine application type
420         uno::Sequence< uno::Any > aArgs{ uno::Any(getCurrentDocument()) };
421         uno::Reference< lang::XMultiComponentFactory > xServiceManager( mxContext->getServiceManager(), uno::UNO_SET_THROW );
422         uno::Reference< uno::XInterface > xVBE = xServiceManager->createInstanceWithArgumentsAndContext(
423             "ooo.vba.vbide.VBE" , aArgs, mxContext );
424         return uno::Any( xVBE );
425     }
426     catch( const uno::Exception& )
427     {
428     }
429     return uno::Any();
430 }
431 
432 OUString
433 VbaApplicationBase::getServiceImplName()
434 {
435     return "VbaApplicationBase";
436 }
437 
438 uno::Sequence<OUString>
439 VbaApplicationBase::getServiceNames()
440 {
441     static uno::Sequence< OUString > const aServiceNames
442     {
443         "ooo.vba.VbaApplicationBase"
444     };
445     return aServiceNames;
446 }
447 
448 void SAL_CALL VbaApplicationBase::Undo()
449 {
450     uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
451     dispatchRequests( xModel, ".uno:Undo" );
452 }
453 
454 void VbaApplicationBase::Quit()
455 {
456     // need to stop basic
457     SbMethod* pMeth = StarBASIC::GetActiveMethod();
458     if ( pMeth )
459     {
460         SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
461         if ( pMod )
462         {
463             StarBASIC* pBasic = dynamic_cast< StarBASIC* >( pMod->GetParent() );
464             if ( pBasic )
465                 pBasic->QuitAndExitApplication();
466         }
467     }
468     else
469     {
470         // This is the case of a call from an (OLE) Automation client.
471 
472         // TODO: Probably we should just close any document windows open by the "application"
473         // (Writer or Calc) the call being handled is for. And only then, if no document windows
474         // are left open, quit the actual LibreOffice application.
475         Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ) );
476     }
477 }
478 
479 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
480