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: 73 VbaTimer() 74 {} 75 76 virtual ~VbaTimer() 77 { 78 m_aTimer.Stop(); 79 } 80 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 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 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 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 { 145 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 162 inline VbaApplicationBase_Impl() : mbVisible( sal_True ) {} 163 164 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================================== 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 184 VbaApplicationBase::~VbaApplicationBase() 185 { 186 delete m_pImpl; 187 } 188 189 sal_Bool SAL_CALL 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 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 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 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 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 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 264 sal_Bool SAL_CALL VbaApplicationBase::getVisible() throw (uno::RuntimeException) 265 { 266 return m_pImpl->mbVisible; // dummy implementation 267 } 268 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 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 284 VbaApplicationBase::getVersion() throw (uno::RuntimeException) 285 { 286 return rtl::OUString(RTL_CONSTASCII_USTRINGPARAM(OFFICEVERSION)); 287 } 288 289 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) 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 } 336 else 337 { 338 throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("The macro doesn't exist") ), uno::Reference< uno::XInterface >() ); 339 } 340 } 341 342 void SAL_CALL VbaApplicationBase::OnTime( const uno::Any& aEarliestTime, const ::rtl::OUString& aFunction, const uno::Any& aLatestTime, const uno::Any& aSchedule ) 343 throw ( uno::RuntimeException ) 344 { 345 if ( !aFunction.getLength() ) 346 throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Unexpected function name!" ) ), uno::Reference< uno::XInterface >() ); 347 348 double nEarliestTime = 0; 349 double nLatestTime = 0; 350 if ( !( aEarliestTime >>= nEarliestTime ) 351 || ( aLatestTime.hasValue() && !( aLatestTime >>= nLatestTime ) ) ) 352 throw uno::RuntimeException( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Only double is supported as time for now!" ) ), uno::Reference< uno::XInterface >() ); 353 354 sal_Bool bSetTimer = sal_True; 355 aSchedule >>= bSetTimer; 356 357 VbaTimerInfo aTimerIndex( aFunction, ::std::pair< double, double >( nEarliestTime, nLatestTime ) ); 358 359 VbaTimerHashMap::iterator aIter = m_pImpl->m_aTimerHash.find( aTimerIndex ); 360 if ( aIter != m_pImpl->m_aTimerHash.end() ) 361 { 362 delete aIter->second; 363 aIter->second = NULL; 364 m_pImpl->m_aTimerHash.erase( aIter ); 365 } 366 367 if ( bSetTimer ) 368 { 369 VbaTimer* pTimer = new VbaTimer; 370 m_pImpl->m_aTimerHash[ aTimerIndex ] = pTimer; 371 pTimer->Start( this, aFunction, nEarliestTime, nLatestTime ); 372 } 373 } 374 375 float SAL_CALL VbaApplicationBase::CentimetersToPoints( float _Centimeters ) throw (uno::RuntimeException) 376 { 377 // i cm = 28.35 points 378 static const float rate = 28.35f; 379 return ( _Centimeters * rate ); 380 } 381 382 uno::Any SAL_CALL VbaApplicationBase::getVBE() throw (uno::RuntimeException) 383 { 384 try // return empty object on error 385 { 386 // "VBE" object does not have a parent, but pass document model to be able to determine application type 387 uno::Sequence< uno::Any > aArgs( 1 ); 388 aArgs[ 0 ] <<= getCurrentDocument(); 389 uno::Reference< lang::XMultiComponentFactory > xServiceManager( mxContext->getServiceManager(), uno::UNO_SET_THROW ); 390 uno::Reference< uno::XInterface > xVBE = xServiceManager->createInstanceWithArgumentsAndContext( 391 ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.vbide.VBE" ) ), aArgs, mxContext ); 392 return uno::Any( xVBE ); 393 } 394 catch( uno::Exception& ) 395 { 396 } 397 return uno::Any(); 398 } 399 400 rtl::OUString& 401 VbaApplicationBase::getServiceImplName() 402 { 403 static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("VbaApplicationBase") ); 404 return sImplName; 405 } 406 407 uno::Sequence<rtl::OUString> 408 VbaApplicationBase::getServiceNames() 409 { 410 static uno::Sequence< rtl::OUString > aServiceNames; 411 if ( aServiceNames.getLength() == 0 ) 412 { 413 aServiceNames.realloc( 1 ); 414 aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.VbaApplicationBase" ) ); 415 } 416 return aServiceNames; 417 } 418 419 void SAL_CALL VbaApplicationBase::Undo() 420 throw (uno::RuntimeException) 421 { 422 uno::Reference< frame::XModel > xModel( getCurrentDocument(), uno::UNO_QUERY_THROW ); 423 dispatchRequests( xModel, ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:Undo" ) ) ); 424 } 425 426 void VbaApplicationBase::Quit() throw (uno::RuntimeException) 427 { 428 // need to stop basic 429 SbMethod* pMeth = StarBASIC::GetActiveMethod(); 430 if ( pMeth ) 431 { 432 SbModule* pMod = dynamic_cast< SbModule* >( pMeth->GetParent() ); 433 if ( pMod ) 434 { 435 StarBASIC* pBasic = dynamic_cast< StarBASIC* >( pMod->GetParent() ); 436 if ( pBasic ) 437 pBasic->QuitAndExitApplication(); 438 } 439 } 440 } 441 442