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:
VbaTimer()64 VbaTimer() : m_aTimer("VbaTimer")
65 {}
66
~VbaTimer()67 ~VbaTimer()
68 {
69 m_aTimer.Stop();
70 }
71
72 VbaTimer(const VbaTimer&) = delete;
73 VbaTimer& operator=(const VbaTimer&) = delete;
74
GetNow()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
GetTimerMilliseconds(double nFrom,double nTo)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
Start(const::rtl::Reference<VbaApplicationBase> & xBase,const OUString & aFunction,double nFrom,double nTo)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( u"Unexpected arguments!"_ustr );
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
IMPL_LINK_NOARG(VbaTimer,MacroCallHdl,Timer *,void)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 {
operator ()__anonf9b5292e0211::VbaTimerInfoHash138 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
VbaApplicationBase_ImplVbaApplicationBase_Impl158 VbaApplicationBase_Impl() : mbVisible( true ) {}
159 };
160
VbaApplicationBase(const uno::Reference<uno::XComponentContext> & xContext)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
~VbaApplicationBase()167 VbaApplicationBase::~VbaApplicationBase()
168 {
169 }
170
171 sal_Bool SAL_CALL
getScreenUpdating()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
setScreenUpdating(sal_Bool bUpdate)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
getDisplayStatusBar()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( u"LayoutManager"_ustr), uno::UNO_QUERY_THROW );
196 if( xLayoutManager->isElementVisible( u"private:resource/statusbar/statusbar"_ustr ) ){
197 return true;
198 }
199 return false;
200 }
201
202 void SAL_CALL
setDisplayStatusBar(sal_Bool bDisplayStatusBar)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( u"LayoutManager"_ustr ), uno::UNO_QUERY_THROW );
210 OUString url( u"private:resource/statusbar/statusbar"_ustr );
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
getInteractive()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
setInteractive(sal_Bool bInteractive)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
getVisible()250 sal_Bool SAL_CALL VbaApplicationBase::getVisible()
251 {
252 return m_pImpl->mbVisible; // dummy implementation
253 }
254
setVisible(sal_Bool bVisible)255 void SAL_CALL VbaApplicationBase::setVisible( sal_Bool bVisible )
256 {
257 m_pImpl->mbVisible = bVisible; // dummy implementation
258 }
259
getCaption()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
setCaption(const OUString & sCaption)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
OnKey(const OUString & Key,const uno::Any & Procedure)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
CommandBars(const uno::Any & aIndex)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
getVersion()326 VbaApplicationBase::getVersion()
327 {
328 return OFFICEVERSION;
329 }
330
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)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( u"The macro doesn't exist"_ustr );
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
OnTime(const uno::Any & aEarliestTime,const OUString & aFunction,const uno::Any & aLatestTime,const uno::Any & aSchedule)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( u"Unexpected function name!"_ustr );
384
385 double nEarliestTime = 0;
386 double nLatestTime = 0;
387 if ( !( aEarliestTime >>= nEarliestTime )
388 || ( aLatestTime.hasValue() && !( aLatestTime >>= nLatestTime ) ) )
389 throw uno::RuntimeException( u"Only double is supported as time for now!"_ustr );
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
getVBE()410 uno::Any SAL_CALL VbaApplicationBase::getVBE()
411 {
412 try // return empty object on error
413 {
414 // "VBE" object does not have a parent, but pass document model to be able to determine application type
415 uno::Sequence< uno::Any > aArgs{ uno::Any(getCurrentDocument()) };
416 uno::Reference< lang::XMultiComponentFactory > xServiceManager( mxContext->getServiceManager(), uno::UNO_SET_THROW );
417 uno::Reference< uno::XInterface > xVBE = xServiceManager->createInstanceWithArgumentsAndContext(
418 u"ooo.vba.vbide.VBE"_ustr , aArgs, mxContext );
419 return uno::Any( xVBE );
420 }
421 catch( const uno::Exception& )
422 {
423 }
424 return uno::Any();
425 }
426
427 OUString
getServiceImplName()428 VbaApplicationBase::getServiceImplName()
429 {
430 return u"VbaApplicationBase"_ustr;
431 }
432
433 uno::Sequence<OUString>
getServiceNames()434 VbaApplicationBase::getServiceNames()
435 {
436 static uno::Sequence< OUString > const aServiceNames
437 {
438 u"ooo.vba.VbaApplicationBase"_ustr
439 };
440 return aServiceNames;
441 }
442
Undo()443 void SAL_CALL VbaApplicationBase::Undo()
444 {
445 uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_SET_THROW );
446 dispatchRequests( xModel, u".uno:Undo"_ustr );
447 }
448
Quit()449 void VbaApplicationBase::Quit()
450 {
451 // need to stop basic
452 SbMethod* pMeth = StarBASIC::GetActiveMethod();
453 if ( pMeth )
454 {
455 SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() );
456 if ( pMod )
457 {
458 StarBASIC* pBasic = dynamic_cast< StarBASIC* >( pMod->GetParent() );
459 if ( pBasic )
460 pBasic->QuitAndExitApplication();
461 }
462 }
463 else
464 {
465 // This is the case of a call from an (OLE) Automation client.
466
467 // TODO: Probably we should just close any document windows open by the "application"
468 // (Writer or Calc) the call being handled is for. And only then, if no document windows
469 // are left open, quit the actual LibreOffice application.
470 Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ) );
471 }
472 }
473
474 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
475
