basic/source/classes/sbxmod.cxx

   1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
   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
  21 #include <vcl/svapp.hxx>
  22 #include <tools/stream.hxx>
  23 #include <tools/diagnose_ex.h>
  24 #include <svl/SfxBroadcaster.hxx>
  25 #include <basic/codecompletecache.hxx>
  26 #include <basic/sbx.hxx>
  27 #include <basic/sbuno.hxx>
  28 #include <sbjsmeth.hxx>
  29 #include <sbjsmod.hxx>
  30 #include <sbintern.hxx>
  31 #include <sbprop.hxx>
  32 #include <image.hxx>
  33 #include <opcodes.hxx>
  34 #include <runtime.hxx>
  35 #include <token.hxx>
  36 #include <sbunoobj.hxx>
  37
  38 #include <sal/log.hxx>
  39
  40 #include <basic/sberrors.hxx>
  41 #include <sbobjmod.hxx>
  42 #include <basic/vbahelper.hxx>
  43 #include <comphelper/sequence.hxx>
  44 #include <cppuhelper/implbase.hxx>
  45 #include <unotools/eventcfg.hxx>
  46 #include <com/sun/star/lang/XServiceInfo.hpp>
  47 #include <com/sun/star/script/ModuleType.hpp>
  48 #include <com/sun/star/script/vba/XVBACompatibility.hpp>
  49 #include <com/sun/star/script/vba/VBAScriptEventId.hpp>
  50 #include <com/sun/star/beans/XPropertySet.hpp>
  51 #include <com/sun/star/document/XDocumentEventBroadcaster.hpp>
  52 #include <com/sun/star/document/XDocumentEventListener.hpp>
  53
  54 #ifdef UNX
  55 #include <sys/resource.h>
  56 #endif
  57
  58 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
  59 #include <comphelper/processfactory.hxx>
  60 #include <comphelper/asyncquithandler.hxx>
  61 #include <map>
  62 #include <com/sun/star/reflection/ProxyFactory.hpp>
  63 #include <com/sun/star/uno/XAggregation.hpp>
  64 #include <com/sun/star/script/XInvocation.hpp>
  65
  66 #include <com/sun/star/awt/DialogProvider.hpp>
  67 #include <com/sun/star/awt/XTopWindow.hpp>
  68 #include <com/sun/star/awt/XWindow.hpp>
  69 #include <ooo/vba/VbQueryClose.hpp>
  70 #include <memory>
  71 #include <sbxmod.hxx>
  72 #include <parser.hxx>
  73
  74 #include <limits>
  75
  76 using namespace com::sun::star;
  77 using namespace com::sun::star::lang;
  78 using namespace com::sun::star::reflection;
  79 using namespace com::sun::star::beans;
  80 using namespace com::sun::star::script;
  81 using namespace com::sun::star::uno;
  82
  83 typedef ::cppu::WeakImplHelper< XInvocation > DocObjectWrapper_BASE;
  84 typedef std::map< sal_Int16, Any > OutParamMap;
  85
  86 namespace {
  87
  88 class DocObjectWrapper : public DocObjectWrapper_BASE
  89 {
  90     Reference< XAggregation >  m_xAggProxy;
  91     Reference< XInvocation >  m_xAggInv;
  92     Reference< XTypeProvider > m_xAggregateTypeProv;
  93     Sequence< Type >           m_Types;
  94     SbModule*                m_pMod;
  95     /// @throws css::uno::RuntimeException
  96     SbMethodRef getMethod( const OUString& aName );
  97     /// @throws css::uno::RuntimeException
  98     SbPropertyRef getProperty( const OUString& aName );
  99
 100 public:
 101     explicit DocObjectWrapper( SbModule* pMod );
 102
 103     virtual Sequence< sal_Int8 > SAL_CALL getImplementationId() override
 104     {
 105         return css::uno::Sequence<sal_Int8>();
 106     }
 107
 108     virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection(  ) override;
 109
 110     virtual Any SAL_CALL invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) override;
 111     virtual void SAL_CALL setValue( const OUString& aPropertyName, const Any& aValue ) override;
 112     virtual Any SAL_CALL getValue( const OUString& aPropertyName ) override;
 113     virtual sal_Bool SAL_CALL hasMethod( const OUString& aName ) override;
 114     virtual sal_Bool SAL_CALL hasProperty( const OUString& aName ) override;
 115     virtual  Any SAL_CALL queryInterface( const Type& aType ) override;
 116
 117     virtual Sequence< Type > SAL_CALL getTypes() override;
 118 };
 119
 120 }
 121
 122 DocObjectWrapper::DocObjectWrapper( SbModule* pVar ) : m_pMod( pVar )
 123 {
 124     SbObjModule* pMod = dynamic_cast<SbObjModule*>( pVar );
 125     if ( !pMod )
 126         return;
 127
 128     if ( pMod->GetModuleType() != ModuleType::DOCUMENT )
 129         return;
 130
 131     // Use proxy factory service to create aggregatable proxy.
 132     SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pMod->GetObject()  );
 133     Reference< XInterface > xIf;
 134     if ( pUnoObj )
 135     {
 136            Any aObj = pUnoObj->getUnoAny();
 137            aObj >>= xIf;
 138            if ( xIf.is() )
 139            {
 140                m_xAggregateTypeProv.set( xIf, UNO_QUERY );
 141                m_xAggInv.set( xIf, UNO_QUERY );
 142            }
 143     }
 144     if ( xIf.is() )
 145     {
 146         try
 147         {
 148             Reference< XProxyFactory > xProxyFac = ProxyFactory::create( comphelper::getProcessComponentContext() );
 149             m_xAggProxy = xProxyFac->createProxy( xIf );
 150         }
 151         catch(const Exception& )
 152         {
 153             TOOLS_WARN_EXCEPTION( "basic", "DocObjectWrapper::DocObjectWrapper" );
 154         }
 155     }
 156
 157     if ( !m_xAggProxy.is() )
 158         return;
 159
 160     osl_atomic_increment( &m_refCount );
 161
 162     /* i35609 - Fix crash on Solaris. The setDelegator call needs
 163         to be in its own block to ensure that all temporary Reference
 164         instances that are acquired during the call are released
 165         before m_refCount is decremented again */
 166     {
 167         m_xAggProxy->setDelegator( static_cast< cppu::OWeakObject * >( this ) );
 168     }
 169
 170     osl_atomic_decrement( &m_refCount );
 171 }
 172
 173 Sequence< Type > SAL_CALL DocObjectWrapper::getTypes()
 174 {
 175     if ( !m_Types.hasElements() )
 176     {
 177         Sequence< Type > sTypes;
 178         if ( m_xAggregateTypeProv.is() )
 179         {
 180             sTypes = m_xAggregateTypeProv->getTypes();
 181         }
 182         m_Types = comphelper::concatSequences(sTypes,
 183             Sequence { cppu::UnoType<XInvocation>::get() });
 184     }
 185     return m_Types;
 186 }
 187
 188 Reference< XIntrospectionAccess > SAL_CALL
 189 DocObjectWrapper::getIntrospection(  )
 190 {
 191     return nullptr;
 192 }
 193
 194 Any SAL_CALL
 195 DocObjectWrapper::invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam )
 196 {
 197     if ( m_xAggInv.is() &&  m_xAggInv->hasMethod( aFunctionName ) )
 198             return m_xAggInv->invoke( aFunctionName, aParams, aOutParamIndex, aOutParam );
 199     SbMethodRef pMethod = getMethod( aFunctionName );
 200     if ( !pMethod.is() )
 201         throw RuntimeException();
 202     // check number of parameters
 203     sal_Int32 nParamsCount = aParams.getLength();
 204     SbxInfo* pInfo = pMethod->GetInfo();
 205     if ( pInfo )
 206     {
 207         sal_Int32 nSbxOptional = 0;
 208         sal_uInt16 n = 1;
 209         for ( const SbxParamInfo* pParamInfo = pInfo->GetParam( n ); pParamInfo; pParamInfo = pInfo->GetParam( ++n ) )
 210         {
 211             if ( pParamInfo->nFlags & SbxFlagBits::Optional )
 212                 ++nSbxOptional;
 213             else
 214                 nSbxOptional = 0;
 215         }
 216         sal_Int32 nSbxCount = n - 1;
 217         if ( nParamsCount < nSbxCount - nSbxOptional )
 218         {
 219             throw RuntimeException( "wrong number of parameters!" );
 220         }
 221     }
 222     // set parameters
 223     SbxArrayRef xSbxParams;
 224     if ( nParamsCount > 0 )
 225     {
 226         xSbxParams = new SbxArray;
 227         const Any* pParams = aParams.getConstArray();
 228         for ( sal_Int32 i = 0; i < nParamsCount; ++i )
 229         {
 230             SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
 231             unoToSbxValue( xSbxVar.get(), pParams[i] );
 232             xSbxParams->Put(xSbxVar.get(), static_cast<sal_uInt32>(i) + 1);
 233
 234             // Enable passing by ref
 235             if ( xSbxVar->GetType() != SbxVARIANT )
 236                 xSbxVar->SetFlag( SbxFlagBits::Fixed );
 237         }
 238     }
 239     if ( xSbxParams.is() )
 240         pMethod->SetParameters( xSbxParams.get() );
 241
 242     // call method
 243     SbxVariableRef xReturn = new SbxVariable;
 244
 245     pMethod->Call( xReturn.get() );
 246     Any aReturn;
 247     // get output parameters
 248     if ( xSbxParams.is() )
 249     {
 250         SbxInfo* pInfo_ = pMethod->GetInfo();
 251         if ( pInfo_ )
 252         {
 253             OutParamMap aOutParamMap;
 254             for (sal_uInt32 n = 1, nCount = xSbxParams->Count(); n < nCount; ++n)
 255             {
 256                 assert(n <= std::numeric_limits<sal_uInt16>::max());
 257                 const SbxParamInfo* pParamInfo = pInfo_->GetParam( sal::static_int_cast<sal_uInt16>(n) );
 258                 if ( pParamInfo && ( pParamInfo->eType & SbxBYREF ) != 0 )
 259                 {
 260                     SbxVariable* pVar = xSbxParams->Get(n);
 261                     if ( pVar )
 262                     {
 263                         SbxVariableRef xVar = pVar;
 264                         aOutParamMap.emplace( n - 1, sbxToUnoValue( xVar.get() ) );
 265                     }
 266                 }
 267             }
 268             sal_Int32 nOutParamCount = aOutParamMap.size();
 269             aOutParamIndex.realloc( nOutParamCount );
 270             aOutParam.realloc( nOutParamCount );
 271             sal_Int16* pOutParamIndex = aOutParamIndex.getArray();
 272             Any* pOutParam = aOutParam.getArray();
 273             for (auto const& outParam : aOutParamMap)
 274             {
 275                 *pOutParamIndex = outParam.first;
 276                 *pOutParam = outParam.second;
 277                 ++pOutParamIndex;
 278                 ++pOutParam;
 279             }
 280         }
 281     }
 282
 283     // get return value
 284     aReturn = sbxToUnoValue( xReturn.get() );
 285
 286     pMethod->SetParameters( nullptr );
 287
 288     return aReturn;
 289 }
 290
 291 void SAL_CALL
 292 DocObjectWrapper::setValue( const OUString& aPropertyName, const Any& aValue )
 293 {
 294     if ( m_xAggInv.is() &&  m_xAggInv->hasProperty( aPropertyName ) )
 295             return m_xAggInv->setValue( aPropertyName, aValue );
 296
 297     SbPropertyRef pProperty = getProperty( aPropertyName );
 298     if ( !pProperty.is() )
 299        throw UnknownPropertyException(aPropertyName);
 300     unoToSbxValue( pProperty.get(), aValue );
 301 }
 302
 303 Any SAL_CALL
 304 DocObjectWrapper::getValue( const OUString& aPropertyName )
 305 {
 306     if ( m_xAggInv.is() &&  m_xAggInv->hasProperty( aPropertyName ) )
 307             return m_xAggInv->getValue( aPropertyName );
 308
 309     SbPropertyRef pProperty = getProperty( aPropertyName );
 310     if ( !pProperty.is() )
 311        throw UnknownPropertyException(aPropertyName);
 312
 313     SbxVariable* pProp = pProperty.get();
 314     if ( pProp->GetType() == SbxEMPTY )
 315         pProperty->Broadcast( SfxHintId::BasicDataWanted );
 316
 317     Any aRet = sbxToUnoValue( pProp );
 318     return aRet;
 319 }
 320
 321 sal_Bool SAL_CALL
 322 DocObjectWrapper::hasMethod( const OUString& aName )
 323 {
 324     if ( m_xAggInv.is() && m_xAggInv->hasMethod( aName ) )
 325         return true;
 326     return getMethod( aName ).is();
 327 }
 328
 329 sal_Bool SAL_CALL
 330 DocObjectWrapper::hasProperty( const OUString& aName )
 331 {
 332     bool bRes = false;
 333     if ( m_xAggInv.is() && m_xAggInv->hasProperty( aName ) )
 334         bRes = true;
 335     else bRes = getProperty( aName ).is();
 336     return bRes;
 337 }
 338
 339 Any SAL_CALL DocObjectWrapper::queryInterface( const Type& aType )
 340 {
 341     Any aRet = DocObjectWrapper_BASE::queryInterface( aType );
 342     if ( aRet.hasValue() )
 343         return aRet;
 344     else if ( m_xAggProxy.is() )
 345         aRet = m_xAggProxy->queryAggregation( aType );
 346     return aRet;
 347 }
 348
 349 SbMethodRef DocObjectWrapper::getMethod( const OUString& aName )
 350 {
 351     SbMethodRef pMethod;
 352     if ( m_pMod )
 353     {
 354         SbxFlagBits nSaveFlgs = m_pMod->GetFlags();
 355         // Limit search to this module
 356         m_pMod->ResetFlag( SbxFlagBits::GlobalSearch );
 357         pMethod = dynamic_cast<SbMethod*>(m_pMod->SbModule::Find(aName,  SbxClassType::Method));
 358         m_pMod->SetFlags( nSaveFlgs );
 359     }
 360
 361     return pMethod;
 362 }
 363
 364 SbPropertyRef DocObjectWrapper::getProperty( const OUString& aName )
 365 {
 366     SbPropertyRef pProperty;
 367     if ( m_pMod )
 368     {
 369         SbxFlagBits nSaveFlgs = m_pMod->GetFlags();
 370         // Limit search to this module.
 371         m_pMod->ResetFlag( SbxFlagBits::GlobalSearch );
 372         pProperty = dynamic_cast<SbProperty*>(m_pMod->SbModule::Find(aName,  SbxClassType::Property));
 373         m_pMod->SetFlag( nSaveFlgs );
 374     }
 375
 376     return pProperty;
 377 }
 378
 379
 380 uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
 381 {
 382     uno::Reference< frame::XModel > xModel;
 383     if( pb && pb->IsDocBasic() )
 384     {
 385         uno::Any aDoc;
 386         if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
 387             xModel.set( aDoc, uno::UNO_QUERY );
 388     }
 389     return xModel;
 390 }
 391
 392 static uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
 393 {
 394     uno::Reference< vba::XVBACompatibility > xVBACompat;
 395     try
 396     {
 397         uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
 398         xVBACompat.set( xModelProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY );
 399     }
 400     catch(const uno::Exception& )
 401     {
 402     }
 403     return xVBACompat;
 404 }
 405
 406 static bool getDefaultVBAMode( StarBASIC* pb )
 407 {
 408     uno::Reference< frame::XModel > xModel( getDocumentModel( pb ) );
 409     if (!xModel.is())
 410         return false;
 411     uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( xModel );
 412     return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
 413 }
 414
 415 // A Basic module has set EXTSEARCH, so that the elements, that the module contains,
 416 // could be found from other module.
 417
 418 SbModule::SbModule( const OUString& rName, bool bVBACompat )
 419          : SbxObject( "StarBASICModule" ),
 420            pBreaks(nullptr), mbVBACompat( bVBACompat ), bIsProxyModule( false )
 421 {
 422     SetName( rName );
 423     SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::GlobalSearch );
 424     SetModuleType( script::ModuleType::NORMAL );
 425
 426     // #i92642: Set name property to initial name
 427     SbxVariable* pNameProp = pProps->Find( "Name", SbxClassType::Property );
 428     if( pNameProp != nullptr )
 429     {
 430         pNameProp->PutString( GetName() );
 431     }
 432 }
 433
 434 SbModule::~SbModule()
 435 {
 436     SAL_INFO("basic","Module named " << GetName() << " is destructing");
 437     pImage.reset();
 438     delete pBreaks;
 439     pClassData.reset();
 440     mxWrapper = nullptr;
 441 }
 442
 443 uno::Reference< script::XInvocation > const &
 444 SbModule::GetUnoModule()
 445 {
 446     if ( !mxWrapper.is() )
 447         mxWrapper = new DocObjectWrapper( this );
 448
 449     SAL_INFO("basic","Module named " << GetName() << " returning wrapper mxWrapper (0x" << mxWrapper.get() <<")" );
 450     return mxWrapper;
 451 }
 452
 453 bool SbModule::IsCompiled() const
 454 {
 455     return pImage != nullptr;
 456 }
 457
 458 const SbxObject* SbModule::FindType( const OUString& aTypeName ) const
 459 {
 460     return pImage ? pImage->FindType( aTypeName ) : nullptr;
 461 }
 462
 463
 464 // From the code generator: deletion of images and the opposite of validation for entries
 465
 466 void SbModule::StartDefinitions()
 467 {
 468     pImage.reset();
 469     if( pClassData )
 470         pClassData->clear();
 471
 472     // methods and properties persist, but they are invalid;
 473     // at least are the information under certain conditions clogged
 474     sal_uInt32 i;
 475     for (i = 0; i < pMethods->Count(); i++)
 476     {
 477         SbMethod* p = dynamic_cast<SbMethod*>(pMethods->Get(i));
 478         if( p )
 479             p->bInvalid = true;
 480     }
 481     for (i = 0; i < pProps->Count();)
 482     {
 483         SbProperty* p = dynamic_cast<SbProperty*>(pProps->Get(i));
 484         if( p )
 485             pProps->Remove( i );
 486         else
 487             i++;
 488     }
 489 }
 490
 491 // request/create method
 492
 493 SbMethod* SbModule::GetMethod( const OUString& rName, SbxDataType t )
 494 {
 495     SbxVariable* p = pMethods->Find( rName, SbxClassType::Method );
 496     SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
 497     if( p && !pMeth )
 498     {
 499         pMethods->Remove( p );
 500     }
 501     if( !pMeth )
 502     {
 503         pMeth = new SbMethod( rName, t, this );
 504         pMeth->SetParent( this );
 505         pMeth->SetFlags( SbxFlagBits::Read );
 506         pMethods->Put(pMeth, pMethods->Count());
 507         StartListening(pMeth->GetBroadcaster(), DuplicateHandling::Prevent);
 508     }
 509     // The method is per default valid, because it could be
 510     // created from the compiler (code generator) as well.
 511     pMeth->bInvalid = false;
 512     pMeth->ResetFlag( SbxFlagBits::Fixed );
 513     pMeth->SetFlag( SbxFlagBits::Write );
 514     pMeth->SetType( t );
 515     pMeth->ResetFlag( SbxFlagBits::Write );
 516     if( t != SbxVARIANT )
 517     {
 518         pMeth->SetFlag( SbxFlagBits::Fixed );
 519     }
 520     return pMeth;
 521 }
 522
 523 SbMethod* SbModule::FindMethod( const OUString& rName, SbxClassType t )
 524 {
 525     return dynamic_cast<SbMethod*> (pMethods->Find( rName, t ));
 526 }
 527
 528
 529 // request/create property
 530
 531 SbProperty* SbModule::GetProperty( const OUString& rName, SbxDataType t )
 532 {
 533     SbxVariable* p = pProps->Find( rName, SbxClassType::Property );
 534     SbProperty* pProp = dynamic_cast<SbProperty*>( p );
 535     if( p && !pProp )
 536     {
 537         pProps->Remove( p );
 538     }
 539     if( !pProp )
 540     {
 541         pProp = new SbProperty( rName, t, this );
 542         pProp->SetFlag( SbxFlagBits::ReadWrite );
 543         pProp->SetParent( this );
 544         pProps->Put(pProp, pProps->Count());
 545         StartListening(pProp->GetBroadcaster(), DuplicateHandling::Prevent);
 546     }
 547     return pProp;
 548 }
 549
 550 void SbModule::GetProcedureProperty( const OUString& rName, SbxDataType t )
 551 {
 552     SbxVariable* p = pProps->Find( rName, SbxClassType::Property );
 553     SbProcedureProperty* pProp = dynamic_cast<SbProcedureProperty*>( p );
 554     if( p && !pProp )
 555     {
 556         pProps->Remove( p );
 557     }
 558     if( !pProp )
 559     {
 560         tools::SvRef<SbProcedureProperty> pNewProp = new SbProcedureProperty( rName, t );
 561         pNewProp->SetFlag( SbxFlagBits::ReadWrite );
 562         pNewProp->SetParent( this );
 563         pProps->Put(pNewProp.get(), pProps->Count());
 564         StartListening(pNewProp->GetBroadcaster(), DuplicateHandling::Prevent);
 565     }
 566 }
 567
 568 void SbModule::GetIfaceMapperMethod( const OUString& rName, SbMethod* pImplMeth )
 569 {
 570     SbxVariable* p = pMethods->Find( rName, SbxClassType::Method );
 571     SbIfaceMapperMethod* pMapperMethod = dynamic_cast<SbIfaceMapperMethod*>( p );
 572     if( p && !pMapperMethod )
 573     {
 574         pMethods->Remove( p );
 575     }
 576     if( !pMapperMethod )
 577     {
 578         pMapperMethod = new SbIfaceMapperMethod( rName, pImplMeth );
 579         pMapperMethod->SetParent( this );
 580         pMapperMethod->SetFlags( SbxFlagBits::Read );
 581         pMethods->Put(pMapperMethod, pMethods->Count());
 582     }
 583     pMapperMethod->bInvalid = false;
 584 }
 585
 586 SbIfaceMapperMethod::~SbIfaceMapperMethod()
 587 {
 588 }
 589
 590
 591 // From the code generator: remove invalid entries
 592
 593 void SbModule::EndDefinitions( bool bNewState )
 594 {
 595     for (sal_uInt32 i = 0; i < pMethods->Count();)
 596     {
 597         SbMethod* p = dynamic_cast<SbMethod*>(pMethods->Get(i));
 598         if( p )
 599         {
 600             if( p->bInvalid )
 601             {
 602                 pMethods->Remove( p );
 603             }
 604             else
 605             {
 606                 p->bInvalid = bNewState;
 607                 i++;
 608             }
 609         }
 610         else
 611             i++;
 612     }
 613     SetModified( true );
 614 }
 615
 616 void SbModule::Clear()
 617 {
 618     pImage.reset();
 619     if( pClassData )
 620         pClassData->clear();
 621     SbxObject::Clear();
 622 }
 623
 624
 625 SbxVariable* SbModule::Find( const OUString& rName, SbxClassType t )
 626 {
 627     // make sure a search in an uninstantiated class module will fail
 628     SbxVariable* pRes = SbxObject::Find( rName, t );
 629     if ( bIsProxyModule && !GetSbData()->bRunInit )
 630     {
 631         return nullptr;
 632     }
 633     if( !pRes && pImage )
 634     {
 635         SbiInstance* pInst = GetSbData()->pInst;
 636         if( pInst && pInst->IsCompatibility() )
 637         {
 638             // Put enum types as objects into module,
 639             // allows MyEnum.First notation
 640             SbxArrayRef xArray = pImage->GetEnums();
 641             if( xArray.is() )
 642             {
 643                 SbxVariable* pEnumVar = xArray->Find( rName, SbxClassType::DontCare );
 644                 SbxObject* pEnumObject = dynamic_cast<SbxObject*>( pEnumVar  );
 645                 if( pEnumObject )
 646                 {
 647                     bool bPrivate = pEnumObject->IsSet( SbxFlagBits::Private );
 648                     OUString aEnumName = pEnumObject->GetName();
 649
 650                     pRes = new SbxVariable( SbxOBJECT );
 651                     pRes->SetName( aEnumName );
 652                     pRes->SetParent( this );
 653                     pRes->SetFlag( SbxFlagBits::Read );
 654                     if( bPrivate )
 655                     {
 656                         pRes->SetFlag( SbxFlagBits::Private );
 657                     }
 658                     pRes->PutObject( pEnumObject );
 659                 }
 660             }
 661         }
 662     }
 663     return pRes;
 664 }
 665
 666 // Parent and BASIC are one!
 667
 668 void SbModule::SetParent( SbxObject* p )
 669 {
 670     pParent = p;
 671 }
 672
 673 void SbModule::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
 674 {
 675     const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
 676     if( !pHint )
 677         return;
 678
 679     SbxVariable* pVar = pHint->GetVar();
 680     SbProperty* pProp = dynamic_cast<SbProperty*>( pVar );
 681     SbMethod* pMeth = dynamic_cast<SbMethod*>( pVar );
 682     SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( pVar  );
 683     if( pProcProperty )
 684     {
 685
 686         if( pHint->GetId() == SfxHintId::BasicDataWanted )
 687         {
 688             OUString aProcName = "Property Get "
 689                                + pProcProperty->GetName();
 690
 691             SbxVariable* pMethVar = Find( aProcName, SbxClassType::Method );
 692             if( pMethVar )
 693             {
 694                 SbxValues aVals;
 695                 aVals.eType = SbxVARIANT;
 696
 697                 SbxArray* pArg = pVar->GetParameters();
 698                 sal_uInt32 nVarParCount = (pArg != nullptr) ? pArg->Count() : 0;
 699                 if( nVarParCount > 1 )
 700                 {
 701                     auto xMethParameters = tools::make_ref<SbxArray>();
 702                     xMethParameters->Put(pMethVar, 0); // Method as parameter 0
 703                     for( sal_uInt32 i = 1 ; i < nVarParCount ; ++i )
 704                     {
 705                         SbxVariable* pPar = pArg->Get(i);
 706                         xMethParameters->Put(pPar, i);
 707                     }
 708
 709                     pMethVar->SetParameters( xMethParameters.get() );
 710                     pMethVar->Get( aVals );
 711                     pMethVar->SetParameters( nullptr );
 712                 }
 713                 else
 714                 {
 715                     pMethVar->Get( aVals );
 716                 }
 717
 718                 pVar->Put( aVals );
 719             }
 720         }
 721         else if( pHint->GetId() == SfxHintId::BasicDataChanged )
 722         {
 723             SbxVariable* pMethVar = nullptr;
 724
 725             bool bSet = pProcProperty->isSet();
 726             if( bSet )
 727             {
 728                 pProcProperty->setSet( false );
 729
 730                 OUString aProcName = "Property Set "
 731                                    + pProcProperty->GetName();
 732                 pMethVar = Find( aProcName, SbxClassType::Method );
 733             }
 734             if( !pMethVar ) // Let
 735             {
 736                 OUString aProcName = "Property Let "
 737                                    + pProcProperty->GetName();
 738                 pMethVar = Find( aProcName, SbxClassType::Method );
 739             }
 740
 741             if( pMethVar )
 742             {
 743                 // Setup parameters
 744                 SbxArrayRef xArray = new SbxArray;
 745                 xArray->Put(pMethVar, 0); // Method as parameter 0
 746                 xArray->Put(pVar, 1);
 747                 pMethVar->SetParameters( xArray.get() );
 748
 749                 SbxValues aVals;
 750                 pMethVar->Get( aVals );
 751                 pMethVar->SetParameters( nullptr );
 752             }
 753         }
 754     }
 755     if( pProp )
 756     {
 757         if( pProp->GetModule() != this )
 758             SetError( ERRCODE_BASIC_BAD_ACTION );
 759     }
 760     else if( pMeth )
 761     {
 762         if( pHint->GetId() == SfxHintId::BasicDataWanted )
 763         {
 764             if( pMeth->bInvalid && !Compile() )
 765             {
 766                 // auto compile has not worked!
 767                 StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
 768             }
 769             else
 770             {
 771                 // Call of a subprogram
 772                 SbModule* pOld = GetSbData()->pMod;
 773                 GetSbData()->pMod = this;
 774                 Run( static_cast<SbMethod*>(pVar) );
 775                 GetSbData()->pMod = pOld;
 776             }
 777         }
 778     }
 779     else
 780     {
 781         // #i92642: Special handling for name property to avoid
 782         // side effects when using name as variable implicitly
 783         bool bForwardToSbxObject = true;
 784
 785         const SfxHintId nId = pHint->GetId();
 786         if( (nId == SfxHintId::BasicDataWanted || nId == SfxHintId::BasicDataChanged) &&
 787             pVar->GetName().equalsIgnoreAsciiCase( "name" ) )
 788         {
 789                 bForwardToSbxObject = false;
 790         }
 791         if( bForwardToSbxObject )
 792         {
 793             SbxObject::Notify( rBC, rHint );
 794         }
 795     }
 796 }
 797
 798 // The setting of the source makes the image invalid
 799 // and scans the method definitions newly in
 800
 801 void SbModule::SetSource32( const OUString& r )
 802 {
 803     // Default basic mode to library container mode, but... allow Option VBASupport 0/1 override
 804     SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
 805     aOUSource = r;
 806     StartDefinitions();
 807     SbiTokenizer aTok( r );
 808     aTok.SetCompatible( IsVBACompat() );
 809
 810     while( !aTok.IsEof() )
 811     {
 812         SbiToken eEndTok = NIL;
 813
 814         // Searching for SUB or FUNCTION
 815         SbiToken eLastTok = NIL;
 816         while( !aTok.IsEof() )
 817         {
 818             // #32385: not by declare
 819             SbiToken eCurTok = aTok.Next();
 820             if( eLastTok != DECLARE )
 821             {
 822                 if( eCurTok == SUB )
 823                 {
 824                     eEndTok = ENDSUB; break;
 825                 }
 826                 if( eCurTok == FUNCTION )
 827                 {
 828                     eEndTok = ENDFUNC; break;
 829                 }
 830                 if( eCurTok == PROPERTY )
 831                 {
 832                     eEndTok = ENDPROPERTY; break;
 833                 }
 834                 if( eCurTok == OPTION )
 835                 {
 836                     eCurTok = aTok.Next();
 837                     if( eCurTok == COMPATIBLE )
 838                     {
 839                         aTok.SetCompatible( true );
 840                     }
 841                     else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) )
 842                     {
 843                         bool bIsVBA = ( aTok.GetDbl()== 1 );
 844                         SetVBACompat( bIsVBA );
 845                         aTok.SetCompatible( bIsVBA );
 846                     }
 847                 }
 848             }
 849             eLastTok = eCurTok;
 850         }
 851         // Definition of the method
 852         SbMethod* pMeth = nullptr;
 853         if( eEndTok != NIL )
 854         {
 855             sal_uInt16 nLine1 = aTok.GetLine();
 856             if( aTok.Next() == SYMBOL )
 857             {
 858                 OUString aName_( aTok.GetSym() );
 859                 SbxDataType t = aTok.GetType();
 860                 if( t == SbxVARIANT && eEndTok == ENDSUB )
 861                 {
 862                     t = SbxVOID;
 863                 }
 864                 pMeth = GetMethod( aName_, t );
 865                 pMeth->nLine1 = pMeth->nLine2 = nLine1;
 866                 // The method is for a start VALID
 867                 pMeth->bInvalid = false;
 868             }
 869             else
 870             {
 871                 eEndTok = NIL;
 872             }
 873         }
 874         // Skip up to END SUB/END FUNCTION
 875         if( eEndTok != NIL )
 876         {
 877             while( !aTok.IsEof() )
 878             {
 879                 if( aTok.Next() == eEndTok )
 880                 {
 881                     pMeth->nLine2 = aTok.GetLine();
 882                     break;
 883                 }
 884             }
 885             if( aTok.IsEof() )
 886             {
 887                 pMeth->nLine2 = aTok.GetLine();
 888             }
 889         }
 890     }
 891     EndDefinitions( true );
 892 }
 893
 894 // Broadcast of a hint to all Basics
 895
 896 static void SendHint_( SbxObject* pObj, SfxHintId nId, SbMethod* p )
 897 {
 898     // Self a BASIC?
 899     if( dynamic_cast<const StarBASIC *>(pObj) != nullptr && pObj->IsBroadcaster() )
 900         pObj->GetBroadcaster().Broadcast( SbxHint( nId, p ) );
 901     // Then ask for the subobjects
 902     SbxArray* pObjs = pObj->GetObjects();
 903     for (sal_uInt32 i = 0; i < pObjs->Count(); i++)
 904     {
 905         SbxVariable* pVar = pObjs->Get(i);
 906         if( dynamic_cast<const SbxObject *>(pVar) != nullptr )
 907             SendHint_( dynamic_cast<SbxObject*>( pVar), nId, p  );
 908     }
 909 }
 910
 911 static void SendHint( SbxObject* pObj, SfxHintId nId, SbMethod* p )
 912 {
 913     while( pObj->GetParent() )
 914         pObj = pObj->GetParent();
 915     SendHint_( pObj, nId, p );
 916 }
 917
 918 // #57841 Clear Uno-Objects, which were helt in RTL functions,
 919 // at the end of the program, so that nothing were helt.
 920 static void ClearUnoObjectsInRTL_Impl_Rek( StarBASIC* pBasic )
 921 {
 922     // delete the return value of CreateUnoService
 923     SbxVariable* pVar = pBasic->GetRtl()->Find( "CreateUnoService", SbxClassType::Method );
 924     if( pVar )
 925     {
 926         pVar->SbxValue::Clear();
 927     }
 928     // delete the return value of CreateUnoDialog
 929     pVar = pBasic->GetRtl()->Find( "CreateUnoDialog", SbxClassType::Method );
 930     if( pVar )
 931     {
 932         pVar->SbxValue::Clear();
 933     }
 934     // delete the return value of CDec
 935     pVar = pBasic->GetRtl()->Find( "CDec", SbxClassType::Method );
 936     if( pVar )
 937     {
 938         pVar->SbxValue::Clear();
 939     }
 940     // delete return value of CreateObject
 941     pVar = pBasic->GetRtl()->Find( "CreateObject", SbxClassType::Method );
 942     if( pVar )
 943     {
 944         pVar->SbxValue::Clear();
 945     }
 946     // Go over all Sub-Basics
 947     SbxArray* pObjs = pBasic->GetObjects();
 948     sal_uInt32 nCount = pObjs->Count();
 949     for( sal_uInt32 i = 0 ; i < nCount ; i++ )
 950     {
 951         SbxVariable* pObjVar = pObjs->Get(i);
 952         StarBASIC* pSubBasic = dynamic_cast<StarBASIC*>( pObjVar  );
 953         if( pSubBasic )
 954         {
 955             ClearUnoObjectsInRTL_Impl_Rek( pSubBasic );
 956         }
 957     }
 958 }
 959
 960 static void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
 961 {
 962     // #67781 Delete return values of the Uno-methods
 963     clearUnoMethods();
 964
 965     ClearUnoObjectsInRTL_Impl_Rek( pBasic );
 966
 967     // Search for the topmost Basic
 968     SbxObject* p = pBasic;
 969     while( p->GetParent() )
 970         p = p->GetParent();
 971     if( static_cast<StarBASIC*>(p) != pBasic )
 972         ClearUnoObjectsInRTL_Impl_Rek( static_cast<StarBASIC*>(p) );
 973 }
 974
 975
 976 void SbModule::SetVBACompat( bool bCompat )
 977 {
 978     if( mbVBACompat == bCompat )
 979         return;
 980
 981     mbVBACompat = bCompat;
 982     // initialize VBA document API
 983     if( mbVBACompat ) try
 984     {
 985         StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
 986         uno::Reference< lang::XMultiServiceFactory > xFactory( getDocumentModel( pBasic ), uno::UNO_QUERY_THROW );
 987         xFactory->createInstance( "ooo.vba.VBAGlobals" );
 988     }
 989     catch( Exception& )
 990     {
 991     }
 992 }
 993
 994 namespace
 995 {
 996     class RunInitGuard
 997     {
 998     protected:
 999         std::unique_ptr<SbiRuntime> m_xRt;
1000         SbiGlobals* m_pSbData;
1001         SbModule* m_pOldMod;
1002     public:
1003         RunInitGuard(SbModule* pModule, SbMethod* pMethod, sal_uInt32 nArg, SbiGlobals* pSbData)
1004             : m_xRt(new SbiRuntime(pModule, pMethod, nArg))
1005             , m_pSbData(pSbData)
1006             , m_pOldMod(pSbData->pMod)
1007         {
1008             m_xRt->pNext = pSbData->pInst->pRun;
1009             m_pSbData->pMod = pModule;
1010             m_pSbData->pInst->pRun = m_xRt.get();
1011         }
1012         void run()
1013         {
1014             while (m_xRt->Step()) {}
1015         }
1016         virtual ~RunInitGuard()
1017         {
1018             m_pSbData->pInst->pRun = m_xRt->pNext;
1019             m_pSbData->pMod = m_pOldMod;
1020             m_xRt.reset();
1021         }
1022     };
1023
1024     class RunGuard : public RunInitGuard
1025     {
1026     private:
1027         bool m_bDelInst;
1028     public:
1029         RunGuard(SbModule* pModule, SbMethod* pMethod, sal_uInt32 nArg, SbiGlobals* pSbData, bool bDelInst)
1030             : RunInitGuard(pModule, pMethod, nArg, pSbData)
1031             , m_bDelInst(bDelInst)
1032         {
1033             if (m_xRt->pNext)
1034                 m_xRt->pNext->block();
1035         }
1036         virtual ~RunGuard() override
1037         {
1038             if (m_xRt->pNext)
1039                 m_xRt->pNext->unblock();
1040
1041             // #63710 It can happen by an another thread handling at events,
1042             // that the show call returns to a dialog (by closing the
1043             // dialog per UI), before a by an event triggered further call returned,
1044             // which stands in Basic more top in the stack and that had been run on
1045             // a  Basic-Breakpoint. Then would the instance below destroyed. And if the Basic,
1046             // that stand still in the call, further runs, there is a GPF.
1047             // Thus here had to be wait until the other call comes back.
1048             if (m_bDelInst)
1049             {
1050                 // Compare here with 1 instead of 0, because before nCallLvl--
1051                 while (m_pSbData->pInst->nCallLvl != 1 && !Application::IsQuit())
1052                     Application::Yield();
1053             }
1054
1055             m_pSbData->pInst->nCallLvl--;          // Call-Level down again
1056
1057             // Exist an higher-ranking runtime instance?
1058             // Then take over BasicDebugFlags::Break, if set
1059             SbiRuntime* pRtNext = m_xRt->pNext;
1060             if (pRtNext && (m_xRt->GetDebugFlags() & BasicDebugFlags::Break))
1061                 pRtNext->SetDebugFlags(BasicDebugFlags::Break);
1062         }
1063     };
1064 }
1065
1066 // Run a Basic-subprogram
1067 void SbModule::Run( SbMethod* pMeth )
1068 {
1069     SAL_INFO("basic","About to run " << pMeth->GetName() << ", vba compatmode is " << mbVBACompat );
1070
1071     static sal_uInt16 nMaxCallLevel = 0;
1072
1073     SbiGlobals* pSbData = GetSbData();
1074
1075     bool bDelInst = pSbData->pInst == nullptr;
1076     bool bQuit = false;
1077     StarBASICRef xBasic;
1078     uno::Reference< frame::XModel > xModel;
1079     uno::Reference< script::vba::XVBACompatibility > xVBACompat;
1080     if( bDelInst )
1081     {
1082         // #32779: Hold Basic during the execution
1083         xBasic = static_cast<StarBASIC*>( GetParent() );
1084
1085         pSbData->pInst = new SbiInstance( static_cast<StarBASIC*>(GetParent()) );
1086
1087         /*  If a VBA script in a document is started, get the VBA compatibility
1088             interface from the document Basic library container, and notify all
1089             VBA script listeners about the started script. */
1090         if( mbVBACompat )
1091         {
1092             StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1093             if( pBasic && pBasic->IsDocBasic() ) try
1094             {
1095                 xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
1096                 xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
1097                 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
1098             }
1099             catch(const uno::Exception& )
1100             {
1101             }
1102         }
1103
1104         // Launcher problem
1105         // i80726 The Find below will generate an error in Testtool so we reset it unless there was one before already
1106         bool bWasError = SbxBase::GetError() != ERRCODE_NONE;
1107         SbxVariable* pMSOMacroRuntimeLibVar = Find( "Launcher", SbxClassType::Object );
1108         if ( !bWasError && (SbxBase::GetError() == ERRCODE_BASIC_PROC_UNDEFINED) )
1109             SbxBase::ResetError();
1110         if( pMSOMacroRuntimeLibVar )
1111         {
1112             StarBASIC* pMSOMacroRuntimeLib = dynamic_cast<StarBASIC*>( pMSOMacroRuntimeLibVar );
1113             if( pMSOMacroRuntimeLib )
1114             {
1115                 SbxFlagBits nGblFlag = pMSOMacroRuntimeLib->GetFlags() & SbxFlagBits::GlobalSearch;
1116                 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::GlobalSearch );
1117                 SbxVariable* pAppSymbol = pMSOMacroRuntimeLib->Find( "Application", SbxClassType::Method );
1118                 pMSOMacroRuntimeLib->SetFlag( nGblFlag );
1119                 if( pAppSymbol )
1120                 {
1121                     pMSOMacroRuntimeLib->SetFlag( SbxFlagBits::ExtSearch );      // Could have been disabled before
1122                     pSbData->pMSOMacroRuntimLib = pMSOMacroRuntimeLib;
1123                 }
1124             }
1125         }
1126
1127         if( nMaxCallLevel == 0 )
1128         {
1129 #ifdef UNX
1130           struct rlimit rl;
1131           getrlimit ( RLIMIT_STACK, &rl );
1132 #endif
1133 #if defined LINUX
1134           // Empiric value, 900 = needed bytes/Basic call level
1135           // for Linux including 10% safety margin
1136           nMaxCallLevel = rl.rlim_cur / 900;
1137 #elif defined __sun
1138           // Empiric value, 1650 = needed bytes/Basic call level
1139           // for Solaris including 10% safety margin
1140           nMaxCallLevel = rl.rlim_cur / 1650;
1141 #elif defined _WIN32
1142           nMaxCallLevel = 5800;
1143 #else
1144           nMaxCallLevel = MAXRECURSION;
1145 #endif
1146         }
1147     }
1148
1149     // Recursion to deep?
1150     if( ++pSbData->pInst->nCallLvl <= nMaxCallLevel )
1151     {
1152         // Define a globale variable in all Mods
1153         GlobalRunInit( /* bBasicStart = */ bDelInst );
1154
1155         // Appeared a compiler error? Then we don't launch
1156         if( !pSbData->bGlobalInitErr )
1157         {
1158             if( bDelInst )
1159             {
1160                 SendHint( GetParent(), SfxHintId::BasicStart, pMeth );
1161
1162                 // 1996-10-16: #31460 New concept for StepInto/Over/Out
1163                 // For an explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
1164                 // Identify the BreakCallLevel
1165                 pSbData->pInst->CalcBreakCallLevel( pMeth->GetDebugFlags() );
1166             }
1167
1168             auto xRuntimeGuard(std::make_unique<RunGuard>(this, pMeth, pMeth->nStart, pSbData, bDelInst));
1169
1170             if ( mbVBACompat )
1171             {
1172                 pSbData->pInst->EnableCompatibility( true );
1173             }
1174
1175             xRuntimeGuard->run();
1176
1177             xRuntimeGuard.reset();
1178
1179             if( bDelInst )
1180             {
1181                 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1182                 // at the end of the program, so that nothing were helt.
1183                 ClearUnoObjectsInRTL_Impl( xBasic.get() );
1184
1185                 clearNativeObjectWrapperVector();
1186
1187                 SAL_WARN_IF(pSbData->pInst->nCallLvl != 0,"basic","BASIC-Call-Level > 0");
1188                 delete pSbData->pInst;
1189                 pSbData->pInst = nullptr;
1190                 bDelInst = false;
1191
1192                 // #i30690
1193                 SolarMutexGuard aSolarGuard;
1194                 SendHint( GetParent(), SfxHintId::BasicStop, pMeth );
1195
1196                 GlobalRunDeInit();
1197
1198                 if( xVBACompat.is() )
1199                 {
1200                     // notify all VBA script listeners about the stopped script
1201                     try
1202                     {
1203                         xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
1204                     }
1205                     catch(const uno::Exception& )
1206                     {
1207                     }
1208                     // VBA always ensures screenupdating is enabled after completing
1209                     ::basic::vba::lockControllersOfAllDocuments( xModel, false );
1210                     ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, true );
1211                 }
1212             }
1213         }
1214         else
1215             pSbData->pInst->nCallLvl--;           // Call-Level down again
1216     }
1217     else
1218     {
1219         pSbData->pInst->nCallLvl--;          // Call-Level down again
1220         StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
1221     }
1222
1223     StarBASIC* pBasic = dynamic_cast<StarBASIC*>( GetParent() );
1224     if( bDelInst )
1225     {
1226        // #57841 Clear Uno-Objects, which were helt in RTL functions,
1227        // the end of the program, so that nothing were helt.
1228         ClearUnoObjectsInRTL_Impl( xBasic.get() );
1229
1230         delete pSbData->pInst;
1231         pSbData->pInst = nullptr;
1232     }
1233     if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !pSbData->pInst )
1234             bQuit = true;
1235     if ( bQuit )
1236     {
1237         Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ) );
1238     }
1239 }
1240
1241 // Execute of the init method of a module after the loading
1242 // or the compilation
1243 void SbModule::RunInit()
1244 {
1245     if( !(pImage
1246      && !pImage->bInit
1247      && pImage->IsFlag( SbiImageFlags::INITCODE )) )
1248         return;
1249
1250     SbiGlobals* pSbData = GetSbData();
1251
1252     // Set flag, so that RunInit get active (Testtool)
1253     pSbData->bRunInit = true;
1254
1255     // The init code starts always here
1256     auto xRuntimeGuard(std::make_unique<RunInitGuard>(this, nullptr, 0, pSbData));
1257     xRuntimeGuard->run();
1258     xRuntimeGuard.reset();
1259
1260     pImage->bInit = true;
1261     pImage->bFirstInit = false;
1262
1263     // RunInit is not active anymore
1264     pSbData->bRunInit = false;
1265 }
1266
1267 // Delete with private/dim declared variables
1268
1269 void SbModule::AddVarName( const OUString& aName )
1270 {
1271     // see if the name is added already
1272     for ( const auto& rModuleVariableName: mModuleVariableNames )
1273     {
1274         if ( aName == rModuleVariableName )
1275             return;
1276     }
1277     mModuleVariableNames.push_back( aName );
1278 }
1279
1280 void SbModule::RemoveVars()
1281 {
1282     for ( const auto& rModuleVariableName: mModuleVariableNames )
1283     {
1284         // We don't want a Find being called in a derived class ( e.g.
1285         // SbUserform because it could trigger say an initialise event
1286         // which would cause basic to be re-run in the middle of the init ( and remember RemoveVars is called from compile and we don't want code to run as part of the compile )
1287         SbxVariableRef p = SbModule::Find( rModuleVariableName, SbxClassType::Property );
1288         if( p.is() )
1289             Remove( p.get() );
1290     }
1291 }
1292
1293 void SbModule::ClearPrivateVars()
1294 {
1295     for (sal_uInt32 i = 0; i < pProps->Count(); i++)
1296     {
1297         SbProperty* p = dynamic_cast<SbProperty*>(pProps->Get(i));
1298         if( p )
1299         {
1300             // Delete not the arrays, only their content
1301             if( p->GetType() & SbxARRAY )
1302             {
1303                 SbxArray* pArray = dynamic_cast<SbxArray*>( p->GetObject() );
1304                 if( pArray )
1305                 {
1306                     for (sal_uInt32 j = 0; j < pArray->Count(); j++)
1307                     {
1308                         SbxVariable* pj = pArray->Get(j);
1309                         pj->SbxValue::Clear();
1310                     }
1311                 }
1312             }
1313             else
1314             {
1315                 p->SbxValue::Clear();
1316             }
1317         }
1318     }
1319 }
1320
1321 void SbModule::implClearIfVarDependsOnDeletedBasic( SbxVariable* pVar, StarBASIC* pDeletedBasic )
1322 {
1323     if( pVar->SbxValue::GetType() != SbxOBJECT || dynamic_cast<const SbProcedureProperty*>( pVar) != nullptr )
1324         return;
1325
1326     SbxObject* pObj = dynamic_cast<SbxObject*>( pVar->GetObject() );
1327     if( pObj == nullptr )
1328         return;
1329
1330     SbxObject* p = pObj;
1331
1332     SbModule* pMod = dynamic_cast<SbModule*>( p  );
1333     if( pMod != nullptr )
1334         pMod->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
1335
1336     while( (p = p->GetParent()) != nullptr )
1337     {
1338         StarBASIC* pBasic = dynamic_cast<StarBASIC*>( p  );
1339         if( pBasic != nullptr && pBasic == pDeletedBasic )
1340         {
1341             pVar->SbxValue::Clear();
1342             break;
1343         }
1344     }
1345 }
1346
1347 void SbModule::ClearVarsDependingOnDeletedBasic( StarBASIC* pDeletedBasic )
1348 {
1349     for (sal_uInt32 i = 0; i < pProps->Count(); i++)
1350     {
1351         SbProperty* p = dynamic_cast<SbProperty*>(pProps->Get(i));
1352         if( p )
1353         {
1354             if( p->GetType() & SbxARRAY )
1355             {
1356                 SbxArray* pArray = dynamic_cast<SbxArray*>( p->GetObject() );
1357                 if( pArray )
1358                 {
1359                     for (sal_uInt32 j = 0; j < pArray->Count(); j++)
1360                     {
1361                         SbxVariable* pVar = pArray->Get(j);
1362                         implClearIfVarDependsOnDeletedBasic( pVar, pDeletedBasic );
1363                     }
1364                 }
1365             }
1366             else
1367             {
1368                 implClearIfVarDependsOnDeletedBasic( p, pDeletedBasic );
1369             }
1370         }
1371     }
1372 }
1373
1374 void StarBASIC::ClearAllModuleVars()
1375 {
1376     // Initialise the own module
1377     for (const auto& rModule: pModules)
1378     {
1379         // Initialise only, if the startcode was already executed
1380         if( rModule->pImage && rModule->pImage->bInit && !rModule->isProxyModule() && dynamic_cast<const SbObjModule*>( rModule.get()) == nullptr )
1381             rModule->ClearPrivateVars();
1382     }
1383
1384 }
1385
1386 // Execution of the init-code of all module
1387 void SbModule::GlobalRunInit( bool bBasicStart )
1388 {
1389     // If no Basic-Start, only initialise, if the module is not initialised
1390     if( !bBasicStart )
1391         if( !pImage || pImage->bInit )
1392             return;
1393
1394     // Initialise GlobalInitErr-Flag for Compiler-Error
1395     // With the help of this flags could be located in SbModule::Run() after the call of
1396     // GlobalRunInit, if at the initialising of the module
1397     // an error occurred. Then it will not be launched.
1398     GetSbData()->bGlobalInitErr = false;
1399
1400     // Parent of the module is a Basic
1401     StarBASIC *pBasic = dynamic_cast<StarBASIC*>( GetParent() );
1402     if( !pBasic )
1403         return;
1404
1405     pBasic->InitAllModules();
1406
1407     SbxObject* pParent_ = pBasic->GetParent();
1408     if( !pParent_ )
1409         return;
1410
1411     StarBASIC * pParentBasic = dynamic_cast<StarBASIC*>( pParent_ );
1412     if( !pParentBasic )
1413         return;
1414
1415     pParentBasic->InitAllModules( pBasic );
1416
1417     // #109018 Parent can also have a parent (library in doc)
1418     SbxObject* pParentParent = pParentBasic->GetParent();
1419     if( pParentParent )
1420     {
1421         StarBASIC * pParentParentBasic = dynamic_cast<StarBASIC*>( pParentParent );
1422         if( pParentParentBasic )
1423             pParentParentBasic->InitAllModules( pParentBasic );
1424     }
1425 }
1426
1427 void SbModule::GlobalRunDeInit()
1428 {
1429     StarBASIC *pBasic = dynamic_cast<StarBASIC*>( GetParent() );
1430     if( pBasic )
1431     {
1432         pBasic->DeInitAllModules();
1433
1434         SbxObject* pParent_ = pBasic->GetParent();
1435         if( pParent_ )
1436             pBasic = dynamic_cast<StarBASIC*>( pParent_ );
1437         if( pBasic )
1438             pBasic->DeInitAllModules();
1439     }
1440 }
1441
1442 // Search for the next STMNT-Command in the code. This was used from the STMNT-
1443 // Opcode to set the endcolumn.
1444
1445 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol ) const
1446 {
1447     return FindNextStmnt( p, nLine, nCol, false );
1448 }
1449
1450 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol,
1451     bool bFollowJumps, const SbiImage* pImg ) const
1452 {
1453     sal_uInt32 nPC = static_cast<sal_uInt32>( p - reinterpret_cast<const sal_uInt8*>(pImage->GetCode()) );
1454     while( nPC < pImage->GetCodeSize() )
1455     {
1456         SbiOpcode eOp = static_cast<SbiOpcode>( *p++ );
1457         nPC++;
1458         if( bFollowJumps && eOp == SbiOpcode::JUMP_ && pImg )
1459         {
1460             SAL_WARN_IF( !pImg, "basic", "FindNextStmnt: pImg==NULL with FollowJumps option" );
1461             sal_uInt32 nOp1 = *p++; nOp1 |= *p++ << 8;
1462             nOp1 |= *p++ << 16; nOp1 |= *p++ << 24;
1463             p = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
1464         }
1465         else if( eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END )
1466         {
1467             p += 4;
1468             nPC += 4;
1469         }
1470         else if( eOp == SbiOpcode::STMNT_ )
1471         {
1472             sal_uInt32 nl, nc;
1473             nl = *p++; nl |= *p++ << 8;
1474             nl |= *p++ << 16 ; nl |= *p++ << 24;
1475             nc = *p++; nc |= *p++ << 8;
1476             nc |= *p++ << 16 ; nc |= *p++ << 24;
1477             nLine = static_cast<sal_uInt16>(nl); nCol = static_cast<sal_uInt16>(nc);
1478             return p;
1479         }
1480         else if( eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END )
1481         {
1482             p += 8;
1483             nPC += 8;
1484         }
1485         else if( eOp < SbiOpcode::SbOP0_START || eOp > SbiOpcode::SbOP0_END )
1486         {
1487             StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1488             break;
1489         }
1490     }
1491     return nullptr;
1492 }
1493
1494 // Test, if a line contains STMNT-Opcodes
1495
1496 bool SbModule::IsBreakable( sal_uInt16 nLine ) const
1497 {
1498     if( !pImage )
1499         return false;
1500     const sal_uInt8* p = reinterpret_cast<const sal_uInt8*>(pImage->GetCode());
1501     sal_uInt16 nl, nc;
1502     while( ( p = FindNextStmnt( p, nl, nc ) ) != nullptr )
1503         if( nl == nLine )
1504             return true;
1505     return false;
1506 }
1507
1508 bool SbModule::IsBP( sal_uInt16 nLine ) const
1509 {
1510     if( pBreaks )
1511     {
1512         for( size_t i = 0; i < pBreaks->size(); i++ )
1513         {
1514             sal_uInt16 b = pBreaks->operator[]( i );
1515             if( b == nLine )
1516                 return true;
1517             if( b < nLine )
1518                 break;
1519         }
1520     }
1521     return false;
1522 }
1523
1524 bool SbModule::SetBP( sal_uInt16 nLine )
1525 {
1526     if( !IsBreakable( nLine ) )
1527         return false;
1528     if( !pBreaks )
1529         pBreaks = new SbiBreakpoints;
1530     auto it = std::find_if(pBreaks->begin(), pBreaks->end(),
1531         [&nLine](const sal_uInt16 b) { return b <= nLine; });
1532     if (it != pBreaks->end() && *it == nLine)
1533         return true;
1534     pBreaks->insert( it, nLine );
1535
1536     // #38568: Set during runtime as well here BasicDebugFlags::Break
1537     if( GetSbData()->pInst && GetSbData()->pInst->pRun )
1538         GetSbData()->pInst->pRun->SetDebugFlags( BasicDebugFlags::Break );
1539
1540     return IsBreakable( nLine );
1541 }
1542
1543 bool SbModule::ClearBP( sal_uInt16 nLine )
1544 {
1545     bool bRes = false;
1546     if( pBreaks )
1547     {
1548         auto it = std::find_if(pBreaks->begin(), pBreaks->end(),
1549             [&nLine](const sal_uInt16 b) { return b <= nLine; });
1550         bRes = (it != pBreaks->end()) && (*it == nLine);
1551         if (bRes)
1552         {
1553             pBreaks->erase(it);
1554         }
1555         if( pBreaks->empty() )
1556         {
1557             delete pBreaks;
1558             pBreaks = nullptr;
1559         }
1560     }
1561     return bRes;
1562 }
1563
1564 void SbModule::ClearAllBP()
1565 {
1566     delete pBreaks;
1567     pBreaks = nullptr;
1568 }
1569
1570 void
1571 SbModule::fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg ) const
1572 {
1573         if ( !pImg )
1574             pImg = pImage.get();
1575         for (sal_uInt32 i = 0; i < pMethods->Count(); i++)
1576         {
1577             SbMethod* pMeth = dynamic_cast<SbMethod*>(pMethods->Get(i));
1578             if( pMeth )
1579             {
1580                 //fixup method start positions
1581                 if ( bCvtToLegacy )
1582                     pMeth->nStart = pImg->CalcLegacyOffset( pMeth->nStart );
1583                 else
1584                     pMeth->nStart = pImg->CalcNewOffset( static_cast<sal_uInt16>(pMeth->nStart) );
1585             }
1586         }
1587
1588 }
1589
1590 bool SbModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1591 {
1592     Clear();
1593     if( !SbxObject::LoadData( rStrm, 1 ) )
1594         return false;
1595     // As a precaution...
1596     SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::GlobalSearch );
1597     sal_uInt8 bImage;
1598     rStrm.ReadUChar( bImage );
1599     if( bImage )
1600     {
1601         std::unique_ptr<SbiImage> p(new SbiImage);
1602         sal_uInt32 nImgVer = 0;
1603
1604         if( !p->Load( rStrm, nImgVer ) )
1605         {
1606             return false;
1607         }
1608         // If the image is in old format, we fix up the method start offsets
1609         if ( nImgVer < B_EXT_IMG_VERSION )
1610         {
1611             fixUpMethodStart( false, p.get() );
1612             p->ReleaseLegacyBuffer();
1613         }
1614         aComment = p->aComment;
1615         SetName( p->aName );
1616         if( p->GetCodeSize() )
1617         {
1618             aOUSource = p->aOUSource;
1619             // Old version: image away
1620             if( nVer == 1 )
1621             {
1622                 SetSource32( p->aOUSource );
1623             }
1624             else
1625                 pImage = std::move(p);
1626         }
1627         else
1628         {
1629             SetSource32( p->aOUSource );
1630         }
1631     }
1632     return true;
1633 }
1634
1635 bool SbModule::StoreData( SvStream& rStrm ) const
1636 {
1637     bool bFixup = ( pImage && !pImage->ExceedsLegacyLimits() );
1638     if ( bFixup )
1639         fixUpMethodStart( true );
1640     bool bRet = SbxObject::StoreData( rStrm );
1641     if ( !bRet )
1642         return false;
1643
1644     if( pImage )
1645     {
1646         pImage->aOUSource = aOUSource;
1647         pImage->aComment = aComment;
1648         pImage->aName = GetName();
1649         rStrm.WriteUChar( 1 );
1650         // # PCode is saved only for legacy formats only
1651         // It should be noted that it probably isn't necessary
1652         // It would be better not to store the image ( more flexible with
1653         // formats )
1654         bool bRes = pImage->Save( rStrm, B_LEGACYVERSION );
1655         if ( bFixup )
1656             fixUpMethodStart( false ); // restore method starts
1657         return bRes;
1658
1659     }
1660     else
1661     {
1662         SbiImage aImg;
1663         aImg.aOUSource = aOUSource;
1664         aImg.aComment = aComment;
1665         aImg.aName = GetName();
1666         rStrm.WriteUChar( 1 );
1667         return aImg.Save( rStrm );
1668     }
1669 }
1670
1671 bool SbModule::ExceedsLegacyModuleSize()
1672 {
1673     if ( !IsCompiled() )
1674         Compile();
1675     return pImage && pImage->ExceedsLegacyLimits();
1676 }
1677
1678 namespace {
1679
1680 class ErrorHdlResetter
1681 {
1682     Link<StarBASIC*,bool> mErrHandler;
1683     bool    mbError;
1684 public:
1685     ErrorHdlResetter()
1686         : mErrHandler(StarBASIC::GetGlobalErrorHdl()) // save error handler
1687         , mbError( false )
1688     {
1689         // set new error handler
1690         StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
1691     }
1692     ~ErrorHdlResetter()
1693     {
1694         // restore error handler
1695         StarBASIC::SetGlobalErrorHdl(mErrHandler);
1696     }
1697     DECL_LINK( BasicErrorHdl, StarBASIC *, bool );
1698     bool HasError() const { return mbError; }
1699 };
1700
1701 }
1702
1703 IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/, bool)
1704 {
1705     mbError = true;
1706     return false;
1707 }
1708
1709 void SbModule::GetCodeCompleteDataFromParse(CodeCompleteDataCache& aCache)
1710 {
1711     ErrorHdlResetter aErrHdl;
1712     SbxBase::ResetError();
1713
1714     auto pParser = std::make_unique<SbiParser>(static_cast<StarBASIC*>(GetParent()), this );
1715     pParser->SetCodeCompleting(true);
1716
1717     while( pParser->Parse() ) {}
1718     SbiSymPool* pPool = pParser->pPool;
1719     aCache.Clear();
1720     for( sal_uInt16 i = 0; i < pPool->GetSize(); ++i )
1721     {
1722         SbiSymDef* pSymDef = pPool->Get(i);
1723         //std::cerr << "i: " << i << ", type: " << pSymDef->GetType() << "; name:" << pSymDef->GetName() << std::endl;
1724         if( (pSymDef->GetType() != SbxEMPTY) && (pSymDef->GetType() != SbxNULL) )
1725             aCache.InsertGlobalVar( pSymDef->GetName(), pParser->aGblStrings.Find(pSymDef->GetTypeId()) );
1726
1727         SbiSymPool& rChildPool = pSymDef->GetPool();
1728         for(sal_uInt16 j = 0; j < rChildPool.GetSize(); ++j )
1729         {
1730             SbiSymDef* pChildSymDef = rChildPool.Get(j);
1731             //std::cerr << "j: " << j << ", type: " << pChildSymDef->GetType() << "; name:" << pChildSymDef->GetName() << std::endl;
1732             if( (pChildSymDef->GetType() != SbxEMPTY) && (pChildSymDef->GetType() != SbxNULL) )
1733                 aCache.InsertLocalVar( pSymDef->GetName(), pChildSymDef->GetName(), pParser->aGblStrings.Find(pChildSymDef->GetTypeId()) );
1734         }
1735     }
1736 }
1737
1738
1739 OUString SbModule::GetKeywordCase( const OUString& sKeyword )
1740 {
1741     return SbiParser::GetKeywordCase( sKeyword );
1742 }
1743
1744 bool SbModule::HasExeCode()
1745 {
1746     // And empty Image always has the Global Chain set up
1747     static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
1748     // lets be stricter for the moment than VBA
1749
1750     if (!IsCompiled())
1751     {
1752         ErrorHdlResetter aGblErrHdl;
1753         Compile();
1754         if (aGblErrHdl.HasError()) //assume unsafe on compile error
1755             return true;
1756     }
1757
1758     bool bRes = false;
1759     if (pImage && (pImage->GetCodeSize() != 5 || (memcmp(pImage->GetCode(), pEmptyImage, pImage->GetCodeSize()) != 0 )))
1760         bRes = true;
1761
1762     return bRes;
1763 }
1764
1765 // Store only image, no source
1766 void SbModule::StoreBinaryData( SvStream& rStrm )
1767 {
1768     if (!Compile())
1769         return;
1770
1771     if (!SbxObject::StoreData(rStrm))
1772         return;
1773
1774     pImage->aOUSource.clear();
1775     pImage->aComment = aComment;
1776     pImage->aName = GetName();
1777
1778     rStrm.WriteUChar(1);
1779     pImage->Save(rStrm);
1780
1781     pImage->aOUSource = aOUSource;
1782 }
1783
1784 // Called for >= OO 1.0 passwd protected libraries only
1785
1786 void SbModule::LoadBinaryData( SvStream& rStrm )
1787 {
1788     OUString aKeepSource = aOUSource;
1789     LoadData( rStrm, 2 );
1790     LoadCompleted();
1791     aOUSource = aKeepSource;
1792 }
1793
1794 bool SbModule::LoadCompleted()
1795 {
1796     SbxArray* p = GetMethods().get();
1797     sal_uInt32 i;
1798     for (i = 0; i < p->Count(); i++)
1799     {
1800         SbMethod* q = dynamic_cast<SbMethod*>(p->Get(i));
1801         if( q )
1802             q->pMod = this;
1803     }
1804     p = GetProperties();
1805     for (i = 0; i < p->Count(); i++)
1806     {
1807         SbProperty* q = dynamic_cast<SbProperty*>(p->Get(i));
1808         if( q )
1809             q->pMod = this;
1810     }
1811     return true;
1812 }
1813
1814 void SbModule::handleProcedureProperties( SfxBroadcaster& rBC, const SfxHint& rHint )
1815 {
1816     bool bDone = false;
1817
1818     const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
1819     if( pHint )
1820     {
1821         SbxVariable* pVar = pHint->GetVar();
1822         SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( pVar  );
1823         if( pProcProperty )
1824         {
1825             bDone = true;
1826
1827             if( pHint->GetId() == SfxHintId::BasicDataWanted )
1828             {
1829                 OUString aProcName = "Property Get "
1830                                    + pProcProperty->GetName();
1831
1832                 SbxVariable* pMeth = Find( aProcName, SbxClassType::Method );
1833                 if( pMeth )
1834                 {
1835                     SbxValues aVals;
1836                     aVals.eType = SbxVARIANT;
1837
1838                     SbxArray* pArg = pVar->GetParameters();
1839                     sal_uInt32 nVarParCount = (pArg != nullptr) ? pArg->Count() : 0;
1840                     if( nVarParCount > 1 )
1841                     {
1842                         SbxArrayRef xMethParameters = new SbxArray;
1843                         xMethParameters->Put(pMeth, 0); // Method as parameter 0
1844                         for( sal_uInt32 i = 1 ; i < nVarParCount ; ++i )
1845                         {
1846                             SbxVariable* pPar = pArg->Get(i);
1847                             xMethParameters->Put(pPar, i);
1848                         }
1849
1850                         pMeth->SetParameters( xMethParameters.get() );
1851                         pMeth->Get( aVals );
1852                         pMeth->SetParameters( nullptr );
1853                     }
1854                     else
1855                     {
1856                         pMeth->Get( aVals );
1857                     }
1858
1859                     pVar->Put( aVals );
1860                 }
1861             }
1862             else if( pHint->GetId() == SfxHintId::BasicDataChanged )
1863             {
1864                 SbxVariable* pMeth = nullptr;
1865
1866                 bool bSet = pProcProperty->isSet();
1867                 if( bSet )
1868                 {
1869                     pProcProperty->setSet( false );
1870
1871                     OUString aProcName = "Property Set "
1872                                        + pProcProperty->GetName();
1873                     pMeth = Find( aProcName, SbxClassType::Method );
1874                 }
1875                 if( !pMeth )    // Let
1876                 {
1877                     OUString aProcName = "Property Let "
1878                                        + pProcProperty->GetName();
1879                     pMeth = Find( aProcName, SbxClassType::Method );
1880                 }
1881
1882                 if( pMeth )
1883                 {
1884                     // Setup parameters
1885                     SbxArrayRef xArray = new SbxArray;
1886                     xArray->Put(pMeth, 0); // Method as parameter 0
1887                     xArray->Put(pVar, 1);
1888                     pMeth->SetParameters( xArray.get() );
1889
1890                     SbxValues aVals;
1891                     pMeth->Get( aVals );
1892                     pMeth->SetParameters( nullptr );
1893                 }
1894             }
1895         }
1896     }
1897
1898     if( !bDone )
1899         SbModule::Notify( rBC, rHint );
1900 }
1901
1902
1903 // Implementation SbJScriptModule (Basic module for JavaScript source code)
1904 SbJScriptModule::SbJScriptModule()
1905     :SbModule( "" )
1906 {
1907 }
1908
1909 bool SbJScriptModule::LoadData( SvStream& rStrm, sal_uInt16 )
1910 {
1911     Clear();
1912     if( !SbxObject::LoadData( rStrm, 1 ) )
1913         return false;
1914
1915     // Get the source string
1916     aOUSource = rStrm.ReadUniOrByteString( osl_getThreadTextEncoding() );
1917     return true;
1918 }
1919
1920 bool SbJScriptModule::StoreData( SvStream& rStrm ) const
1921 {
1922     if( !SbxObject::StoreData( rStrm ) )
1923         return false;
1924
1925     // Write the source string
1926     OUString aTmp = aOUSource;
1927     rStrm.WriteUniOrByteString( aTmp, osl_getThreadTextEncoding() );
1928     return true;
1929 }
1930
1931
1932 SbMethod::SbMethod( const OUString& r, SbxDataType t, SbModule* p )
1933         : SbxMethod( r, t ), pMod( p )
1934 {
1935     bInvalid     = true;
1936     nStart       = 0;
1937     nDebugFlags  = BasicDebugFlags::NONE;
1938     nLine1       = 0;
1939     nLine2       = 0;
1940     refStatics   = new SbxArray;
1941     mCaller      = nullptr;
1942     // HACK due to 'Reference could not be saved'
1943     SetFlag( SbxFlagBits::NoModify );
1944 }
1945
1946 SbMethod::SbMethod( const SbMethod& r )
1947     : SvRefBase( r ), SbxMethod( r )
1948 {
1949     pMod         = r.pMod;
1950     bInvalid     = r.bInvalid;
1951     nStart       = r.nStart;
1952     nDebugFlags  = r.nDebugFlags;
1953     nLine1       = r.nLine1;
1954     nLine2       = r.nLine2;
1955     refStatics = r.refStatics;
1956     mCaller          = r.mCaller;
1957     SetFlag( SbxFlagBits::NoModify );
1958 }
1959
1960 SbMethod::~SbMethod()
1961 {
1962 }
1963
1964 void SbMethod::ClearStatics()
1965 {
1966     refStatics = new SbxArray;
1967
1968 }
1969 SbxArray* SbMethod::GetStatics()
1970 {
1971     return refStatics.get();
1972 }
1973
1974 bool SbMethod::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1975 {
1976     if( !SbxMethod::LoadData( rStrm, 1 ) )
1977         return false;
1978
1979     sal_uInt16 nFlag;
1980     rStrm.ReadUInt16( nFlag );
1981
1982     sal_Int16 nTempStart = static_cast<sal_Int16>(nStart);
1983
1984     if( nVer == 2 )
1985     {
1986         rStrm.ReadUInt16( nLine1 ).ReadUInt16( nLine2 ).ReadInt16( nTempStart ).ReadCharAsBool( bInvalid );
1987         //tdf#94617
1988         if (nFlag & 0x8000)
1989         {
1990             sal_uInt16 nMult = nFlag & 0x7FFF;
1991             sal_Int16 const nMax = std::numeric_limits<sal_Int16>::max();
1992             nStart = nMult * nMax + nTempStart;
1993         }
1994         else
1995         {
1996             nStart = nTempStart;
1997         }
1998     }
1999     else
2000     {
2001         nStart = nTempStart;
2002     }
2003
2004     // HACK due to 'Reference could not be saved'
2005     SetFlag( SbxFlagBits::NoModify );
2006
2007     return true;
2008 }
2009
2010 bool SbMethod::StoreData( SvStream& rStrm ) const
2011 {
2012     if( !SbxMethod::StoreData( rStrm ) )
2013         return false;
2014
2015     //tdf#94617
2016     sal_Int16 nMax = std::numeric_limits<sal_Int16>::max();
2017     sal_Int16 nStartTemp = nStart % nMax;
2018     sal_uInt16 nDebugFlagsTemp = nStart / nMax;
2019     nDebugFlagsTemp |= 0x8000;
2020
2021     rStrm.WriteUInt16( nDebugFlagsTemp )
2022          .WriteInt16( nLine1 )
2023          .WriteInt16( nLine2 )
2024          .WriteInt16( nStartTemp )
2025          .WriteBool( bInvalid );
2026
2027     return true;
2028 }
2029
2030 void SbMethod::GetLineRange( sal_uInt16& l1, sal_uInt16& l2 )
2031 {
2032     l1 = nLine1; l2 = nLine2;
2033 }
2034
2035 // Could later be deleted
2036
2037 SbxInfo* SbMethod::GetInfo()
2038 {
2039     return pInfo.get();
2040 }
2041
2042 // Interface to execute a method of the applications
2043 // With special RefCounting, so that the Basic was not fired of by CloseDocument()
2044 // The return value will be delivered as string.
2045 ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
2046 {
2047     if ( pCaller )
2048     {
2049         SAL_INFO("basic", "SbMethod::Call Have been passed a caller 0x" << pCaller );
2050         mCaller = pCaller;
2051     }
2052     // Increment the RefCount of the module
2053     tools::SvRef<SbModule> pMod_ = static_cast<SbModule*>(GetParent());
2054
2055     tools::SvRef<StarBASIC> xHolder = static_cast<StarBASIC*>(pMod_->GetParent());
2056
2057     // Establish the values to get the return value
2058     SbxValues aVals;
2059     aVals.eType = SbxVARIANT;
2060
2061     // #104083: Compile BEFORE get
2062     if( bInvalid && !pMod_->Compile() )
2063         StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
2064
2065     // tdf#143582 - clear return value of the method before calling it
2066     const SbxFlagBits nSavFlags = GetFlags();
2067     SetFlag(SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast);
2068     Clear();
2069     SetFlags(nSavFlags);
2070
2071     Get( aVals );
2072     if ( pRet )
2073         pRet->Put( aVals );
2074
2075     // Was there an error
2076     ErrCode nErr = SbxBase::GetError();
2077     SbxBase::ResetError();
2078
2079     mCaller = nullptr;
2080     return nErr;
2081 }
2082
2083
2084 // #100883 Own Broadcast for SbMethod
2085 void SbMethod::Broadcast( SfxHintId nHintId )
2086 {
2087     if( !mpBroadcaster || IsSet( SbxFlagBits::NoBroadcast ) )
2088         return;
2089
2090     // Because the method could be called from outside, test here once again
2091     // the authorisation
2092     if( nHintId == SfxHintId::BasicDataWanted )
2093         if( !CanRead() )
2094             return;
2095     if( nHintId == SfxHintId::BasicDataChanged )
2096         if( !CanWrite() )
2097             return;
2098
2099     if( pMod && !pMod->IsCompiled() )
2100         pMod->Compile();
2101
2102     // Block broadcasts while creating new method
2103     std::unique_ptr<SfxBroadcaster> pSaveBroadcaster = std::move(mpBroadcaster);
2104     SbMethodRef xThisCopy = new SbMethod( *this );
2105     if( mpPar.is() )
2106     {
2107         // Enregister this as element 0, but don't reset the parent!
2108         if( GetType() != SbxVOID ) {
2109             mpPar->PutDirect( xThisCopy.get(), 0 );
2110         }
2111         SetParameters( nullptr );
2112     }
2113
2114     mpBroadcaster = std::move(pSaveBroadcaster);
2115     mpBroadcaster->Broadcast( SbxHint( nHintId, xThisCopy.get() ) );
2116
2117     SbxFlagBits nSaveFlags = GetFlags();
2118     SetFlag( SbxFlagBits::ReadWrite );
2119     pSaveBroadcaster = std::move(mpBroadcaster);
2120     Put( xThisCopy->GetValues_Impl() );
2121     mpBroadcaster = std::move(pSaveBroadcaster);
2122     SetFlags( nSaveFlags );
2123 }
2124
2125
2126 // Implementation of SbJScriptMethod (method class as a wrapper for JavaScript-functions)
2127
2128 SbJScriptMethod::SbJScriptMethod( SbxDataType t )
2129         : SbMethod( "", t, nullptr )
2130 {
2131 }
2132
2133 SbJScriptMethod::~SbJScriptMethod()
2134 {}
2135
2136
2137 SbObjModule::SbObjModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVbaCompatible )
2138     : SbModule( rName, bIsVbaCompatible )
2139 {
2140     SetModuleType( mInfo.ModuleType );
2141     if ( mInfo.ModuleType == script::ModuleType::FORM )
2142     {
2143         SetClassName( "Form" );
2144     }
2145     else if ( mInfo.ModuleObject.is() )
2146     {
2147         SetUnoObject( uno::Any( mInfo.ModuleObject ) );
2148     }
2149 }
2150
2151 SbObjModule::~SbObjModule()
2152 {
2153 }
2154
2155 void
2156 SbObjModule::SetUnoObject( const uno::Any& aObj )
2157 {
2158     SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pDocObject.get() );
2159     if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do
2160         return;
2161     pDocObject = new SbUnoObject( GetName(), aObj );
2162
2163     css::uno::Reference< css::lang::XServiceInfo > xServiceInfo( aObj, css::uno::UNO_QUERY_THROW );
2164     if( xServiceInfo->supportsService( "ooo.vba.excel.Worksheet" ) )
2165     {
2166         SetClassName( "Worksheet" );
2167     }
2168     else if( xServiceInfo->supportsService( "ooo.vba.excel.Workbook" ) )
2169     {
2170         SetClassName( "Workbook" );
2171     }
2172 }
2173
2174 SbxVariable*
2175 SbObjModule::GetObject()
2176 {
2177     return pDocObject.get();
2178 }
2179 SbxVariable*
2180 SbObjModule::Find( const OUString& rName, SbxClassType t )
2181 {
2182     SbxVariable* pVar = nullptr;
2183     if ( pDocObject )
2184         pVar = pDocObject->Find( rName, t );
2185     if ( !pVar )
2186         pVar = SbModule::Find( rName, t );
2187     return pVar;
2188 }
2189
2190 void SbObjModule::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
2191 {
2192     SbModule::handleProcedureProperties( rBC, rHint );
2193 }
2194
2195
2196 typedef ::cppu::WeakImplHelper<
2197     awt::XTopWindowListener,
2198     awt::XWindowListener,
2199     document::XDocumentEventListener > FormObjEventListener_BASE;
2200
2201 class FormObjEventListenerImpl:
2202     public FormObjEventListener_BASE
2203 {
2204     SbUserFormModule* mpUserForm;
2205     uno::Reference< lang::XComponent > mxComponent;
2206     uno::Reference< frame::XModel > mxModel;
2207     bool mbDisposed;
2208     bool mbOpened;
2209     bool mbActivated;
2210     bool mbShowing;
2211
2212 public:
2213     FormObjEventListenerImpl(const FormObjEventListenerImpl&) = delete;
2214     const FormObjEventListenerImpl& operator=(const FormObjEventListenerImpl&) = delete;
2215     FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent, const uno::Reference< frame::XModel >& xModel ) :
2216         mpUserForm( pUserForm ), mxComponent( xComponent), mxModel( xModel ),
2217         mbDisposed( false ), mbOpened( false ), mbActivated( false ), mbShowing( false )
2218     {
2219         if ( mxComponent.is() )
2220         {
2221             try
2222             {
2223                 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->addTopWindowListener( this );
2224             }
2225             catch(const uno::Exception& ) {}
2226             try
2227             {
2228                 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->addWindowListener( this );
2229             }
2230             catch(const uno::Exception& ) {}
2231         }
2232
2233         if ( mxModel.is() )
2234         {
2235             try
2236             {
2237                 uno::Reference< document::XDocumentEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->addDocumentEventListener( this );
2238             }
2239             catch(const uno::Exception& ) {}
2240         }
2241     }
2242
2243     virtual ~FormObjEventListenerImpl() override
2244     {
2245         removeListener();
2246     }
2247
2248     bool isShowing() const { return mbShowing; }
2249
2250     void removeListener()
2251     {
2252         if ( mxComponent.is() && !mbDisposed )
2253         {
2254             try
2255             {
2256                 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeTopWindowListener( this );
2257             }
2258             catch(const uno::Exception& ) {}
2259             try
2260             {
2261                 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeWindowListener( this );
2262             }
2263             catch(const uno::Exception& ) {}
2264         }
2265         mxComponent.clear();
2266
2267         if ( mxModel.is() && !mbDisposed )
2268         {
2269             try
2270             {
2271                 uno::Reference< document::XDocumentEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->removeDocumentEventListener( this );
2272             }
2273             catch(const uno::Exception& ) {}
2274         }
2275         mxModel.clear();
2276     }
2277
2278     virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) override
2279     {
2280         if ( mpUserForm )
2281         {
2282             mbOpened = true;
2283             mbShowing = true;
2284             if ( mbActivated )
2285             {
2286                 mbOpened = mbActivated = false;
2287                 mpUserForm->triggerActivateEvent();
2288             }
2289         }
2290     }
2291
2292
2293     virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) override
2294     {
2295 #ifdef IN_THE_FUTURE
2296         uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
2297         if ( xDialog.is() )
2298         {
2299             uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY );
2300             if ( xControl->getPeer().is() )
2301             {
2302                 uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
2303                 if ( xVbaMethodParameter.is() )
2304                 {
2305                     sal_Int8 nCancel = 0;
2306                     sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
2307
2308                     Sequence< Any > aParams;
2309                     aParams.realloc(2);
2310                     aParams[0] <<= nCancel;
2311                     aParams[1] <<= nCloseMode;
2312
2313                     mpUserForm->triggerMethod( "Userform_QueryClose", aParams);
2314                     return;
2315
2316                 }
2317             }
2318         }
2319
2320         mpUserForm->triggerMethod( "Userform_QueryClose" );
2321 #endif
2322     }
2323
2324
2325     virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) override
2326     {
2327         mbOpened = false;
2328         mbShowing = false;
2329     }
2330
2331     virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) override
2332     {
2333     }
2334
2335     virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) override
2336     {
2337     }
2338
2339     virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) override
2340     {
2341         if ( mpUserForm )
2342         {
2343             mbActivated = true;
2344             if ( mbOpened )
2345             {
2346                 mbOpened = mbActivated = false;
2347                 mpUserForm->triggerActivateEvent();
2348             }
2349         }
2350     }
2351
2352     virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) override
2353     {
2354         if ( mpUserForm )
2355             mpUserForm->triggerDeactivateEvent();
2356     }
2357
2358     virtual void SAL_CALL windowResized( const awt::WindowEvent& /*e*/ ) override
2359     {
2360         if ( mpUserForm )
2361         {
2362             mpUserForm->triggerResizeEvent();
2363             mpUserForm->triggerLayoutEvent();
2364         }
2365     }
2366
2367     virtual void SAL_CALL windowMoved( const awt::WindowEvent& /*e*/ ) override
2368     {
2369         if ( mpUserForm )
2370             mpUserForm->triggerLayoutEvent();
2371     }
2372
2373     virtual void SAL_CALL windowShown( const lang::EventObject& /*e*/ ) override
2374     {
2375     }
2376
2377     virtual void SAL_CALL windowHidden( const lang::EventObject& /*e*/ ) override
2378     {
2379     }
2380
2381     virtual void SAL_CALL documentEventOccured( const document::DocumentEvent& rEvent ) override
2382     {
2383         // early disposing on document event "OnUnload", to be sure Basic still exists when calling VBA "UserForm_Terminate"
2384         if( rEvent.EventName == GlobalEventConfig::GetEventName( GlobalEventId::CLOSEDOC ) )
2385         {
2386             removeListener();
2387             mbDisposed = true;
2388             if ( mpUserForm )
2389                 mpUserForm->ResetApiObj();   // will trigger "UserForm_Terminate"
2390         }
2391     }
2392
2393     virtual void SAL_CALL disposing( const lang::EventObject& /*Source*/ ) override
2394     {
2395         removeListener();
2396         mbDisposed = true;
2397         if ( mpUserForm )
2398             mpUserForm->ResetApiObj( false );   // pass false (too late to trigger VBA events here)
2399     }
2400 };
2401
2402 SbUserFormModule::SbUserFormModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsCompat )
2403     : SbObjModule( rName, mInfo, bIsCompat )
2404     , m_mInfo( mInfo )
2405     , mbInit( false )
2406 {
2407     m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
2408 }
2409
2410 SbUserFormModule::~SbUserFormModule()
2411 {
2412 }
2413
2414 void SbUserFormModule::ResetApiObj(  bool bTriggerTerminateEvent )
2415 {
2416     SAL_INFO("basic", " SbUserFormModule::ResetApiObj( " << (bTriggerTerminateEvent ? "true )" : "false )") );
2417     if ( bTriggerTerminateEvent && m_xDialog.is() ) // probably someone close the dialog window
2418     {
2419         triggerTerminateEvent();
2420     }
2421     pDocObject = nullptr;
2422     m_xDialog = nullptr;
2423 }
2424
2425 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun )
2426 {
2427     Sequence< Any > aArguments;
2428     triggerMethod( aMethodToRun, aArguments );
2429 }
2430
2431 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun, Sequence< Any >& aArguments )
2432 {
2433     SAL_INFO("basic", "trigger " << aMethodToRun);
2434     // Search method
2435     SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxClassType::Method );
2436     if( !pMeth )
2437         return;
2438
2439     if ( aArguments.hasElements() )   // Setup parameters
2440     {
2441         auto xArray = tools::make_ref<SbxArray>();
2442         xArray->Put(pMeth, 0); // Method as parameter 0
2443
2444         for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2445         {
2446             auto xSbxVar = tools::make_ref<SbxVariable>( SbxVARIANT );
2447             unoToSbxValue( xSbxVar.get(), aArguments[i] );
2448             xArray->Put(xSbxVar.get(), static_cast<sal_uInt32>(i) + 1);
2449
2450             // Enable passing by ref
2451             if ( xSbxVar->GetType() != SbxVARIANT )
2452                 xSbxVar->SetFlag( SbxFlagBits::Fixed );
2453         }
2454         pMeth->SetParameters( xArray.get() );
2455
2456         SbxValues aVals;
2457         pMeth->Get( aVals );
2458
2459         auto pArguments = aArguments.getArray();
2460         for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2461         {
2462             pArguments[i] = sbxToUnoValue(xArray->Get(static_cast<sal_uInt32>(i) + 1));
2463         }
2464         pMeth->SetParameters( nullptr );
2465     }
2466     else
2467     {
2468         SbxValues aVals;
2469         pMeth->Get( aVals );
2470     }
2471 }
2472
2473 void SbUserFormModule::triggerActivateEvent()
2474 {
2475     triggerMethod( "UserForm_Activate" );
2476 }
2477
2478 void SbUserFormModule::triggerDeactivateEvent()
2479 {
2480     triggerMethod( "Userform_Deactivate" );
2481 }
2482
2483 void SbUserFormModule::triggerInitializeEvent()
2484 {
2485     if ( mbInit )
2486         return;
2487     triggerMethod("Userform_Initialize");
2488     mbInit = true;
2489 }
2490
2491 void SbUserFormModule::triggerTerminateEvent()
2492 {
2493     triggerMethod("Userform_Terminate");
2494     mbInit=false;
2495 }
2496
2497 void SbUserFormModule::triggerLayoutEvent()
2498 {
2499     triggerMethod("Userform_Layout");
2500 }
2501
2502 void SbUserFormModule::triggerResizeEvent()
2503 {
2504     triggerMethod("Userform_Resize");
2505 }
2506
2507 SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
2508 {
2509     SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
2510     return pInstance;
2511 }
2512
2513 SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
2514     const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVBACompat )
2515         : SbUserFormModule( rName, mInfo, bIsVBACompat )
2516         , m_pParentModule( pParentModule )
2517 {
2518 }
2519
2520 bool SbUserFormModuleInstance::IsClass( const OUString& rName ) const
2521 {
2522     bool bParentNameMatches = m_pParentModule->GetName().equalsIgnoreAsciiCase( rName );
2523     bool bRet = bParentNameMatches || SbxObject::IsClass( rName );
2524     return bRet;
2525 }
2526
2527 SbxVariable* SbUserFormModuleInstance::Find( const OUString& rName, SbxClassType t )
2528 {
2529     SbxVariable* pVar = m_pParentModule->Find( rName, t );
2530     return pVar;
2531 }
2532
2533
2534 void SbUserFormModule::Load()
2535 {
2536     // forces a load
2537     if ( !pDocObject.is() )
2538         InitObject();
2539 }
2540
2541
2542 void SbUserFormModule::Unload()
2543 {
2544     sal_Int8 nCancel = 0;
2545
2546     Sequence< Any > aParams = { Any(nCancel), Any(sal_Int8(::ooo::vba::VbQueryClose::vbFormCode)) };
2547
2548     triggerMethod( "Userform_QueryClose", aParams);
2549
2550     aParams[0] >>= nCancel;
2551     // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
2552     // test against 0 ( false ) and assume anything else is true
2553     // ( Note: ) this used to work ( something changes somewhere )
2554     if (nCancel != 0)
2555     {
2556         return;
2557     }
2558
2559     if ( m_xDialog.is() )
2560     {
2561         triggerTerminateEvent();
2562     }
2563     // Search method
2564     SbxVariable* pMeth = SbObjModule::Find( "UnloadObject", SbxClassType::Method );
2565     if( !pMeth )
2566         return;
2567
2568     SAL_INFO("basic", "Attempting to run the UnloadObjectMethod");
2569     m_xDialog.clear(); //release ref to the uno object
2570     SbxValues aVals;
2571     bool bWaitForDispose = true; // assume dialog is showing
2572     if (m_DialogListener)
2573     {
2574         bWaitForDispose = m_DialogListener->isShowing();
2575         SAL_INFO("basic", "Showing " << bWaitForDispose );
2576     }
2577     pMeth->Get( aVals);
2578     if ( !bWaitForDispose )
2579     {
2580         // we've either already got a dispose or we are never going to get one
2581         ResetApiObj();
2582     } // else wait for dispose
2583     SAL_INFO("basic", "UnloadObject completed (we hope)");
2584 }
2585
2586
2587 void SbUserFormModule::InitObject()
2588 {
2589     try
2590     {
2591         SbUnoObject* pGlobs = static_cast<SbUnoObject*>(GetParent()->Find( "VBAGlobals", SbxClassType::DontCare ));
2592         if ( m_xModel.is() && pGlobs )
2593         {
2594             // broadcast INITIALIZE_USERFORM script event before the dialog is created
2595             Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
2596             xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
2597             uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
2598             uno::Reference< uno::XComponentContext > xContext = comphelper::getProcessComponentContext();
2599             OUString sDialogUrl( "vnd.sun.star.script:"  );
2600             OUString sProjectName( "Standard" );
2601
2602             try
2603             {
2604                 Reference< beans::XPropertySet > xProps( m_xModel, UNO_QUERY_THROW );
2605                 uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY_THROW );
2606                 sProjectName = xVBAMode->getProjectName();
2607             }
2608             catch(const Exception& ) {}
2609
2610             sDialogUrl += sProjectName + "." + GetName() + "?location=document";
2611
2612             uno::Reference< awt::XDialogProvider > xProvider = awt::DialogProvider::createWithModel( xContext, m_xModel  );
2613             m_xDialog = xProvider->createDialog( sDialogUrl );
2614
2615             // create vba api object
2616             uno::Sequence< uno::Any > aArgs
2617             {
2618                 uno::Any(),
2619                 makeAny(m_xDialog),
2620                 makeAny(m_xModel),
2621                 makeAny(GetParent()->GetName())
2622             };
2623             pDocObject = new SbUnoObject( GetName(), uno::Any( xVBAFactory->createInstanceWithArguments( "ooo.vba.msforms.UserForm", aArgs  ) ) );
2624
2625             uno::Reference< lang::XComponent > xComponent( m_xDialog, uno::UNO_QUERY_THROW );
2626
2627             // the dialog must be disposed at the end!
2628             StarBASIC* pParentBasic = nullptr;
2629             SbxObject* pCurObject = this;
2630             do
2631             {
2632                 SbxObject* pObjParent = pCurObject->GetParent();
2633                 pParentBasic = dynamic_cast<StarBASIC*>( pObjParent  );
2634                 pCurObject = pObjParent;
2635             }
2636             while( pParentBasic == nullptr && pCurObject != nullptr );
2637
2638             SAL_WARN_IF( pParentBasic == nullptr, "basic", "pParentBasic == NULL" );
2639             registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
2640
2641             // if old listener object exists, remove it from dialog and document model
2642             if( m_DialogListener.is() )
2643                 m_DialogListener->removeListener();
2644             m_DialogListener.set( new FormObjEventListenerImpl( this, xComponent, m_xModel ) );
2645
2646             triggerInitializeEvent();
2647         }
2648     }
2649     catch(const uno::Exception& )
2650     {
2651     }
2652
2653 }
2654
2655 SbxVariable*
2656 SbUserFormModule::Find( const OUString& rName, SbxClassType t )
2657 {
2658     if ( !pDocObject.is() && !GetSbData()->bRunInit && GetSbData()->pInst )
2659         InitObject();
2660     return SbObjModule::Find( rName, t );
2661 }
2662
2663 SbProperty::SbProperty( const OUString& r, SbxDataType t, SbModule* p )
2664         : SbxProperty( r, t ), pMod( p )
2665 {
2666 }
2667
2668 SbProperty::~SbProperty()
2669 {}
2670
2671
2672 SbProcedureProperty::~SbProcedureProperty()
2673 {}
2674
2675 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */