LibreOffice Module oox (master)  1
vbamodule.cxx
Go to the documentation of this file.
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 #include <oox/ole/vbamodule.hxx>
21 #include <com/sun/star/container/XNameContainer.hpp>
22 #include <com/sun/star/script/ModuleInfo.hpp>
23 #include <com/sun/star/script/ModuleType.hpp>
24 #include <com/sun/star/script/vba/XVBAModuleInfo.hpp>
25 #include <com/sun/star/awt/KeyEvent.hpp>
26 #include <osl/diagnose.h>
27 #include <rtl/character.hxx>
32 #include <oox/ole/vbahelper.hxx>
34 
35 namespace oox::ole {
36 
37 using namespace ::com::sun::star::lang;
38 using namespace ::com::sun::star::script::vba;
39 using namespace ::com::sun::star::uno;
40 using namespace ::com::sun::star;
41 
42 using ::com::sun::star::awt::KeyEvent;
43 
45  const Reference< frame::XModel >& rxDocModel,
46  const OUString& rName, rtl_TextEncoding eTextEnc, bool bExecutable ) :
47  mxContext( rxContext ),
48  mxDocModel( rxDocModel ),
49  maName( rName ),
50  meTextEnc( eTextEnc ),
51  mnType( script::ModuleType::UNKNOWN ),
52  mnOffset( SAL_MAX_UINT32 ),
53  mbReadOnly( false ),
54  mbPrivate( false ),
55  mbExecutable( bExecutable )
56 {
57 }
58 
60 {
61  sal_uInt16 nRecId = 0;
62  StreamDataSequence aRecData;
63  while( VbaHelper::readDirRecord( nRecId, aRecData, rDirStrm ) && (nRecId != VBA_ID_MODULEEND) )
64  {
65  SequenceInputStream aRecStrm( aRecData );
66  sal_Int32 nRecSize = aRecData.getLength();
67  switch( nRecId )
68  {
69 #define OOX_ENSURE_RECORDSIZE( cond ) OSL_ENSURE( cond, "VbaModule::importDirRecords - invalid record size" )
70  case VBA_ID_MODULENAME:
71  OSL_FAIL( "VbaModule::importDirRecords - unexpected MODULENAME record" );
72  maName = aRecStrm.readCharArrayUC( nRecSize, meTextEnc );
73  break;
75  break;
77  maStreamName = aRecStrm.readCharArrayUC( nRecSize, meTextEnc );
78  // Actually the stream name seems the best name to use
79  // the VBA_ID_MODULENAME name can sometimes be the wrong case
81  break;
83  break;
85  maDocString = aRecStrm.readCharArrayUC( nRecSize, meTextEnc );
86  break;
88  break;
90  OOX_ENSURE_RECORDSIZE( nRecSize == 4 );
91  mnOffset = aRecStrm.readuInt32();
92  break;
94  OOX_ENSURE_RECORDSIZE( nRecSize == 4 );
95  break;
97  OOX_ENSURE_RECORDSIZE( nRecSize == 2 );
98  break;
100  OOX_ENSURE_RECORDSIZE( nRecSize == 0 );
101  OSL_ENSURE( mnType == script::ModuleType::UNKNOWN, "VbaModule::importDirRecords - multiple module type records" );
102  mnType = script::ModuleType::NORMAL;
103  break;
105  OOX_ENSURE_RECORDSIZE( nRecSize == 0 );
106  OSL_ENSURE( mnType == script::ModuleType::UNKNOWN, "VbaModule::importDirRecords - multiple module type records" );
107  mnType = script::ModuleType::DOCUMENT;
108  break;
110  OOX_ENSURE_RECORDSIZE( nRecSize == 0 );
111  mbReadOnly = true;
112  break;
114  OOX_ENSURE_RECORDSIZE( nRecSize == 0 );
115  mbPrivate = true;
116  break;
117  default:
118  OSL_FAIL( "VbaModule::importDirRecords - unknown module record" );
119 #undef OOX_ENSURE_RECORDSIZE
120  }
121  }
122  OSL_ENSURE( !maName.isEmpty(), "VbaModule::importDirRecords - missing module name" );
123  OSL_ENSURE( !maStreamName.isEmpty(), "VbaModule::importDirRecords - missing module stream name" );
124  OSL_ENSURE( mnType != script::ModuleType::UNKNOWN, "VbaModule::importDirRecords - missing module type" );
125  OSL_ENSURE( mnOffset < SAL_MAX_UINT32, "VbaModule::importDirRecords - missing module stream offset" );
126 }
127 
129  const Reference< container::XNameContainer >& rxBasicLib,
130  const Reference< container::XNameAccess >& rxDocObjectNA ) const
131 {
132  OUString aVBASourceCode = readSourceCode( rVbaStrg );
133  createModule( aVBASourceCode, rxBasicLib, rxDocObjectNA );
134 }
135 
137  const Reference< container::XNameAccess >& rxDocObjectNA ) const
138 {
139  createModule( u"", rxBasicLib, rxDocObjectNA );
140 }
141 
142 OUString VbaModule::readSourceCode( StorageBase& rVbaStrg ) const
143 {
144  OUStringBuffer aSourceCode(512);
145  static const char sUnmatchedRemovedTag[] = "Rem removed unmatched Sub/End: ";
146  if( !maStreamName.isEmpty() && (mnOffset != SAL_MAX_UINT32) )
147  {
148  BinaryXInputStream aInStrm( rVbaStrg.openInputStream( maStreamName ), true );
149  OSL_ENSURE( !aInStrm.isEof(), "VbaModule::readSourceCode - cannot open module stream" );
150  // skip the 'performance cache' stored before the actual source code
151  aInStrm.seek( mnOffset );
152  // if stream is still valid, load the source code
153  if( !aInStrm.isEof() )
154  {
155  // decompression starts at current stream position of aInStrm
156  VbaInputStream aVbaStrm( aInStrm );
157  // load the source code line-by-line, with some more processing
158  TextInputStream aVbaTextStrm( mxContext, aVbaStrm, meTextEnc );
159 
160  struct ProcedurePair
161  {
162  bool bInProcedure;
163  sal_uInt32 nPos;
164  ProcedurePair() : bInProcedure( false ), nPos( 0 ) {};
165  } procInfo;
166 
167  while( !aVbaTextStrm.isEof() )
168  {
169  OUString aCodeLine = aVbaTextStrm.readLine();
170  if( aCodeLine.match( "Attribute " ) )
171  {
172  // attribute
173  int index = aCodeLine.indexOf( ".VB_ProcData.VB_Invoke_Func = " );
174  if ( index != -1 )
175  {
176  // format is
177  // 'Attribute Procedure.VB_ProcData.VB_Invoke_Func = "*\n14"'
178  // where 'Procedure' is the procedure name and '*' is the shortcut key
179  // note: his is only relevant for Excel, seems that
180  // word doesn't store the shortcut in the module
181  // attributes
182  int nSpaceIndex = aCodeLine.indexOf(' ');
183  OUString sProc = aCodeLine.copy( nSpaceIndex + 1, index - nSpaceIndex - 1);
184  // for Excel short cut key seems limited to cntrl+'a-z, A-Z'
185  OUString sKey = aCodeLine.copy( aCodeLine.lastIndexOf("= ") + 3, 1 );
186  // only alpha key valid for key shortcut, however the api will accept other keys
187  if ( rtl::isAsciiAlpha( sKey[ 0 ] ) )
188  {
189  // cntrl modifier is explicit ( but could be cntrl+shift ), parseKeyEvent
190  // will handle and uppercase letter appropriately
191  OUString sApiKey = "^" + sKey;
192  try
193  {
194  KeyEvent aKeyEvent = ooo::vba::parseKeyEvent( sApiKey );
195  ooo::vba::applyShortCutKeyBinding( mxDocModel, aKeyEvent, sProc );
196  }
197  catch (const Exception&)
198  {
199  }
200  }
201  }
202  }
203  else
204  {
205  // Hack here to weed out any unmatched End Sub / Sub Foo statements.
206  // The behaviour of the vba ide practically guarantees the case and
207  // spacing of Sub statement(s). However, indentation can be arbitrary hence
208  // the trim.
209  OUString trimLine( aCodeLine.trim() );
210  if ( mbExecutable && (
211  trimLine.match("Sub ") ||
212  trimLine.match("Public Sub ") ||
213  trimLine.match("Private Sub ") ||
214  trimLine.match("Static Sub ") ) )
215  {
216  // this should never happen, basic doesn't support nested procedures
217  // first Sub Foo must be bogus
218  if ( procInfo.bInProcedure )
219  {
220  // comment out the line
221  aSourceCode.insert( procInfo.nPos, sUnmatchedRemovedTag );
222  // mark location of this Sub
223  procInfo.nPos = aSourceCode.getLength();
224  }
225  else
226  {
227  procInfo.bInProcedure = true;
228  procInfo.nPos = aSourceCode.getLength();
229  }
230  }
231  else if ( mbExecutable && aCodeLine.trim().match("End Sub") )
232  {
233  // un-matched End Sub
234  if ( !procInfo.bInProcedure )
235  {
236  aSourceCode.append( sUnmatchedRemovedTag );
237  }
238  else
239  {
240  procInfo.bInProcedure = false;
241  procInfo.nPos = 0;
242  }
243  }
244  // normal source code line
245  if( !mbExecutable )
246  aSourceCode.append( "Rem " );
247  aSourceCode.append( aCodeLine ).append( '\n' );
248  }
249  }
250  }
251  }
252  return aSourceCode.makeStringAndClear();
253 }
254 
255 void VbaModule::createModule( std::u16string_view rVBASourceCode,
256  const Reference< container::XNameContainer >& rxBasicLib,
257  const Reference< container::XNameAccess >& rxDocObjectNA ) const
258 {
259  if( maName.isEmpty() )
260  return;
261 
262  // prepare the Basic module
263  script::ModuleInfo aModuleInfo;
264  aModuleInfo.ModuleType = mnType;
265  OUStringBuffer aSourceCode(512);
266  aSourceCode.append( "Rem Attribute VBA_ModuleType=" );
267  switch( mnType )
268  {
269  case script::ModuleType::NORMAL:
270  aSourceCode.append( "VBAModule" );
271  break;
272  case script::ModuleType::CLASS:
273  aSourceCode.append( "VBAClassModule" );
274  break;
275  case script::ModuleType::FORM:
276  aSourceCode.append( "VBAFormModule" );
277  // hack from old filter, document Basic should know the XModel, but it doesn't
278  aModuleInfo.ModuleObject.set( mxDocModel, UNO_QUERY );
279  break;
280  case script::ModuleType::DOCUMENT:
281  aSourceCode.append( "VBADocumentModule" );
282  // get the VBA implementation object associated to the document module
283  if( rxDocObjectNA.is() ) try
284  {
285  aModuleInfo.ModuleObject.set( rxDocObjectNA->getByName( maName ), UNO_QUERY );
286  }
287  catch (const Exception&)
288  {
289  }
290  break;
291  default:
292  aSourceCode.append( "VBAUnknown" );
293  }
294  aSourceCode.append( '\n' );
295  if( mbExecutable )
296  {
297  aSourceCode.append( "Option VBASupport 1\n" );
298  if( mnType == script::ModuleType::CLASS )
299  aSourceCode.append( "Option ClassModule\n" );
300  }
301  else
302  {
303  // add a subroutine named after the module itself
304  aSourceCode.append( "Sub " + maName.replace( ' ', '_' ) + "\n" );
305  }
306 
307  // append passed VBA source code
308  aSourceCode.append( rVBASourceCode );
309 
310  // close the subroutine named after the module
311  if( !mbExecutable )
312  aSourceCode.append( "End Sub\n" );
313 
314  // insert extended module info
315  try
316  {
317  Reference< XVBAModuleInfo > xVBAModuleInfo( rxBasicLib, UNO_QUERY_THROW );
318  xVBAModuleInfo->insertModuleInfo( maName, aModuleInfo );
319  }
320  catch (const Exception&)
321  {
322  }
323 
324  // insert the module into the passed Basic library
325  try
326  {
327  rxBasicLib->insertByName( maName, Any( aSourceCode.makeStringAndClear() ) );
328  }
329  catch (const Exception&)
330  {
331  OSL_FAIL( "VbaModule::createModule - cannot insert module into library" );
332  }
333 }
334 
335 } // namespace oox::ole
336 
337 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */
const sal_uInt16 VBA_ID_MODULENAME
Definition: vbahelper.hxx:38
const sal_uInt16 VBA_ID_MODULECOOKIE
Definition: vbahelper.hxx:33
Wraps a UNO input stream and provides convenient access functions.
#define OOX_ENSURE_RECORDSIZE(cond)
const sal_uInt16 VBA_ID_MODULEOFFSET
Definition: vbahelper.hxx:40
uno::Reference< uno::XComponentContext > mxContext
VbaModule(const css::uno::Reference< css::uno::XComponentContext > &rxContext, const css::uno::Reference< css::frame::XModel > &rxDocModel, const OUString &rName, rtl_TextEncoding eTextEnc, bool bExecutable)
Definition: vbamodule.cxx:44
sal_Int16 script
OUString maDocString
Definition: vbamodule.hxx:93
OUString readLine()
Reads a text line from the stream.
css::uno::Reference< css::uno::XComponentContext > mxContext
Component context with service manager.
Definition: vbamodule.hxx:88
#define SAL_MAX_UINT32
virtual void seek(sal_Int64 nPos) override
Seeks the stream to the passed position, if wrapped stream is seekable.
void createAndImportModule(StorageBase &rVbaStrg, const css::uno::Reference< css::container::XNameContainer > &rxBasicLib, const css::uno::Reference< css::container::XNameAccess > &rxDocObjectNA) const
Imports the VBA source code into the passed Basic library.
Definition: vbamodule.cxx:128
UNKNOWN
css::uno::Reference< css::frame::XModel > mxDocModel
Document model used to import/export the VBA project.
Definition: vbamodule.hxx:90
const sal_uInt16 VBA_ID_MODULEHELPCONTEXT
Definition: vbahelper.hxx:37
OUString readCharArrayUC(sal_Int32 nChars, rtl_TextEncoding eTextEnc)
Reads a byte character array and returns a Unicode string.
const sal_uInt16 VBA_ID_MODULEREADONLY
Definition: vbahelper.hxx:42
Interface for binary input stream classes.
Base class for storage access implementations.
Definition: storagebase.hxx:51
OUString readSourceCode(StorageBase &rVbaStrg) const
Reads and returns the VBA source code from the passed storage.
Definition: vbamodule.cxx:142
const sal_uInt16 VBA_ID_MODULEPRIVATE
Definition: vbahelper.hxx:41
css::uno::Sequence< sal_Int8 > StreamDataSequence
const sal_uInt16 VBA_ID_MODULESTREAMNAME
Definition: vbahelper.hxx:43
A non-seekable input stream that implements run-length decompression.
sal_Int32 mnType
float u
tuple index
css::uno::Reference< css::io::XInputStream > openInputStream(const OUString &rStreamName)
Opens and returns the specified input stream from the storage.
const sal_uInt16 VBA_ID_MODULEDOCSTRINGUNICODE
Definition: vbahelper.hxx:35
const sal_uInt16 VBA_ID_MODULEEND
Definition: vbahelper.hxx:36
rtl_TextEncoding meTextEnc
Definition: vbamodule.hxx:94
bool isEof() const
Returns true, if no more text is available in the stream.
awt::KeyEvent parseKeyEvent(const OUString &Key)
void createModule(std::u16string_view rVBASourceCode, const css::uno::Reference< css::container::XNameContainer > &rxBasicLib, const css::uno::Reference< css::container::XNameAccess > &rxDocObjectNA) const
Creates a new Basic module and inserts it into the passed Basic library.
Definition: vbamodule.cxx:255
void importDirRecords(BinaryInputStream &rDirStrm)
Imports all records for this module until the MODULEEND record.
Definition: vbamodule.cxx:59
const sal_uInt16 VBA_ID_MODULETYPEDOCUMENT
Definition: vbahelper.hxx:45
const sal_uInt16 VBA_ID_MODULESTREAMNAMEUNICODE
Definition: vbahelper.hxx:44
OUString maStreamName
Definition: vbamodule.hxx:92
const sal_uInt16 VBA_ID_MODULEDOCSTRING
Definition: vbahelper.hxx:34
void applyShortCutKeyBinding(const uno::Reference< frame::XModel > &rxModel, const awt::KeyEvent &rKeyEvent, const OUString &rMacroName)
bool readDirRecord(sal_uInt16 &rnRecId, StreamDataSequence &rRecData, BinaryInputStream &rInStrm)
Reads the next record from the VBA directory stream 'dir'.
Definition: vbahelper.cxx:28
Wraps a StreamDataSequence and provides convenient access functions.
OUString maName
Definition: dffdumper.cxx:160
void createEmptyModule(const css::uno::Reference< css::container::XNameContainer > &rxBasicLib, const css::uno::Reference< css::container::XNameAccess > &rxDocObjectNA) const
Creates an empty Basic module in the passed Basic library.
Definition: vbamodule.cxx:136
const sal_uInt16 VBA_ID_MODULETYPEPROCEDURAL
Definition: vbahelper.hxx:46
sal_uInt32 mnOffset
Definition: vbamodule.hxx:96
const sal_uInt16 VBA_ID_MODULENAMEUNICODE
Definition: vbahelper.hxx:39
sal_uInt16 nPos