| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010 |
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
- <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Document" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
- REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
- REM === The SFDocuments library is one of the associated libraries. ===
- REM === Full documentation is available on https://help.libreoffice.org/ ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- ''' SF_Document
- ''' ===========
- '''
- ''' The SFDocuments library gathers a number of methods and properties making easy
- ''' the management and several manipulations of LibreOffice documents
- '''
- ''' Some methods are generic for all types of documents: they are combined in the
- ''' current SF_Document module
- ''' - saving, closing documents
- ''' - accessing their standard or custom properties
- ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Writer, ...
- '''
- ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary
- ''' Each subclass MUST implement also the generic methods and properties, even if they only call
- ''' the parent methods and properties implemented below
- ''' They should also duplicate some generic private members as a subset of their own set of members
- '''
- ''' The current module is closely related to the "UI" and "FileSystem" services
- ''' of the ScriptForge library
- '''
- ''' Service invocation examples:
- ''' 1) From the UI service
- ''' Dim ui As Object, oDoc As Object
- ''' Set ui = CreateScriptService("UI")
- ''' Set oDoc = ui.GetDocument("Untitled 1")
- ''' ' or Set oDoc = ui.CreateDocument("Calc", ...)
- ''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.odt")
- ''' 2) Directly if the document is already opened
- ''' Dim oDoc As Object
- ''' Set oDoc = CreateScriptService("SFDocuments.Document", "Untitled 1") ' Default = ActiveWindow
- ''' ' The substring "SFDocuments." in the service name is optional
- '''
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- REM ================================================================== EXCEPTIONS
- Private Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR"
- Private Const DOCUMENTSAVEERROR = "DOCUMENTSAVEERROR"
- Private Const DOCUMENTSAVEASERROR = "DOCUMENTSAVEASERROR"
- Private Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR"
- REM ============================================================= PRIVATE MEMBERS
- Private [Me] As Object
- Private [_Parent] As Object
- Private ObjectType As String ' Must be DOCUMENT
- Private ServiceName As String
- ' Window description
- Private _Component As Object ' com.sun.star.lang.XComponent
- Private _Frame As Object ' com.sun.star.comp.framework.Frame
- Private _WindowName As String ' Object Name
- Private _WindowTitle As String ' Only mean to identify new documents
- Private _WindowFileName As String ' URL of file name
- Private _DocumentType As String ' Writer, Calc, ...
- ' Properties (work variables - real properties could have been set manually by user)
- Private _DocumentProperties As Object ' Dictionary of document properties
- Private _CustomProperties As Object ' Dictionary of custom properties
- REM ============================================================ MODULE CONSTANTS
- REM ===================================================== CONSTRUCTOR/DESTRUCTOR
- REM -----------------------------------------------------------------------------
- Private Sub Class_Initialize()
- Set [Me] = Nothing
- Set [_Parent] = Nothing
- ObjectType = "DOCUMENT"
- ServiceName = "SFDocuments.Document"
- Set _Component = Nothing
- Set _Frame = Nothing
- _WindowName = ""
- _WindowTitle = ""
- _WindowFileName = ""
- _DocumentType = ""
- Set _DocumentProperties = Nothing
- Set _CustomProperties = Nothing
- End Sub ' SFDocuments.SF_Document Constructor
- REM -----------------------------------------------------------------------------
- Private Sub Class_Terminate()
- Call Class_Initialize()
- End Sub ' SFDocuments.SF_Document Destructor
- REM -----------------------------------------------------------------------------
- Public Function Dispose() As Variant
- Call Class_Terminate()
- Set Dispose = Nothing
- End Function ' SFDocuments.SF_Document Explicit Destructor
- REM ================================================================== PROPERTIES
- REM -----------------------------------------------------------------------------
- Property Get CustomProperties() As Variant
- ''' Returns a dictionary of all custom properties of the document
- CustomProperties = _PropertyGet("CustomProperties")
- End Property ' SFDocuments.SF_Document.CustomProperties
- REM -----------------------------------------------------------------------------
- Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
- ''' Sets the updatable custom properties
- ''' The argument is a dictionary
- Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim vCustomProperties As Variant ' Alias of argument
- Dim oUserdefinedProperties As Object ' Custom properties object
- Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties
- Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues
- Dim sProperty As String ' Property name
- Dim vKeys As Variant ' Array of dictionary keys
- Dim vItems As Variant ' Array of dictionary items
- Dim vValue As Variant ' Value to store in property
- Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE
- Dim i As Long
- Const cstThisSub = "SFDocuments.Document.setCustomProperties"
- Const cstSubArgs = "CustomProperties"
- On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally
- End If
- Try:
- Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties
- Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error
- With vCustomProperties
- ' All existing custom properties must first be removed to avoid type conflicts
- vOldPropertyValues = oUserDefinedProperties.getPropertyValues
- For Each oProperty In vOldPropertyValues
- sProperty = oProperty.Name
- oUserDefinedProperties.removeProperty(sProperty)
- Next oProperty
- ' Insert new properties one by one after type adjustment (dates, arrays, numbers)
- vKeys = .Keys
- vItems = .Items
- iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE
- For i = 0 To UBound(vKeys)
- If VarType(vItems(i)) = V_DATE Then
- vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i))
- ElseIf IsArray(vItems(i)) Then
- vValue = Null
- ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then
- vValue = CreateUnoValue("double", vItems(i))
- Else
- vValue = vItems(i)
- End If
- oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue)
- Next i
- ' Declare the document as changed
- _Component.setModified(True)
- End With
- ' Reload custom properties in current object instance
- _PropertyGet("CustomProperties")
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Property
- Catch:
- GoTo Finally
- End Property ' SFDocuments.SF_Document.CustomProperties
- REM -----------------------------------------------------------------------------
- Property Get Description() As Variant
- ''' Returns the updatable document property Description
- Description = _PropertyGet("Description")
- End Property ' SFDocuments.SF_Document.Description
- REM -----------------------------------------------------------------------------
- Property Let Description(Optional ByVal pvDescription As Variant)
- ''' Sets the updatable document property Description
- ''' If multilined, separate lines by "\n" escape sequence or by hard breaks
- Dim sDescription As String ' Alias of pvDescription
- Const cstThisSub = "SFDocuments.Document.setDescription"
- Const cstSubArgs = "Description"
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Update in UNO component object and in current instance
- sDescription = Replace(pvDescription, "\n", ScriptForge.SF_String.sfNEWLINE)
- _Component.DocumentProperties.Description = sDescription
- If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Property
- End Property ' SFDocuments.SF_Document.Description
- REM -----------------------------------------------------------------------------
- Property Get DocumentProperties() As Variant
- ''' Returns a dictionary of all standard document properties, custom properties are excluded
- DocumentProperties = _PropertyGet("DocumentProperties")
- End Property ' SFDocuments.SF_Document.DocumentProperties
- REM -----------------------------------------------------------------------------
- Property Get DocumentType() As String
- ''' Returns "Base", "Calc", "Draw", ... or "Writer"
- DocumentType = _PropertyGet("DocumentType")
- End Property ' SFDocuments.SF_Document.DocumentType
- REM -----------------------------------------------------------------------------
- Property Get IsBase() As Boolean
- IsBase = _PropertyGet("IsBase")
- End Property ' SFDocuments.SF_Document.IsBase
- REM -----------------------------------------------------------------------------
- Property Get IsCalc() As Boolean
- IsCalc = _PropertyGet("IsCalc")
- End Property ' SFDocuments.SF_Document.IsCalc
- REM -----------------------------------------------------------------------------
- Property Get IsDraw() As Boolean
- IsDraw = _PropertyGet("IsDraw")
- End Property ' SFDocuments.SF_Document.IsDraw
- REM -----------------------------------------------------------------------------
- Property Get IsImpress() As Boolean
- IsImpress = _PropertyGet("IsImpress")
- End Property ' SFDocuments.SF_Document.IsImpress
- REM -----------------------------------------------------------------------------
- Property Get IsMath() As Boolean
- IsMath = _PropertyGet("IsMath")
- End Property ' SFDocuments.SF_Document.IsMath
- REM -----------------------------------------------------------------------------
- Property Get IsWriter() As Boolean
- IsWriter = _PropertyGet("IsWriter")
- End Property ' SFDocuments.SF_Document.IsWriter
- REM -----------------------------------------------------------------------------
- Property Get Keywords() As Variant
- ''' Returns the updatable document property Keywords
- Keywords = _PropertyGet("Keywords")
- End Property ' SFDocuments.SF_Document.Keywords
- REM -----------------------------------------------------------------------------
- Property Let Keywords(Optional ByVal pvKeywords As Variant)
- ''' Sets the updatable document property Keywords
- Dim vKeywords As Variant ' Alias of pvKeywords
- Const cstThisSub = "SFDocuments.Document.setKeywords"
- Const cstSubArgs = "Keywords"
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Update in UNO component object and in current instance
- vKeywords = ScriptForge.SF_Array.TrimArray(Split(pvKeywords, ","))
- _Component.DocumentProperties.Keywords = vKeywords
- If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", "))
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Property
- End Property ' SFDocuments.SF_Document.Keywords
- REM -----------------------------------------------------------------------------
- Property Get Readonly() As Boolean
- ''' Returns True if the document must not be modified
- Readonly = _PropertyGet("Readonly")
- End Property ' SFDocuments.SF_Document.Readonly
- REM -----------------------------------------------------------------------------
- Property Get Subject() As Variant
- ''' Returns the updatable document property Subject
- Subject = _PropertyGet("Subject")
- End Property ' SFDocuments.SF_Document.Subject
- REM -----------------------------------------------------------------------------
- Property Let Subject(Optional ByVal pvSubject As Variant)
- ''' Sets the updatable document property Subject
- Const cstThisSub = "SFDocuments.Document.setSubject"
- Const cstSubArgs = "Subject"
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Update in UNO component object and in current instance
- _Component.DocumentProperties.Subject = pvSubject
- If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Property
- End Property ' SFDocuments.SF_Document.Subject
- REM -----------------------------------------------------------------------------
- Property Get Title() As Variant
- ''' Returns the updatable document property Title
- Title = _PropertyGet("Title")
- End Property ' SFDocuments.SF_Document.Title
- REM -----------------------------------------------------------------------------
- Property Let Title(Optional ByVal pvTitle As Variant)
- ''' Sets the updatable document property Title
- Const cstThisSub = "SFDocuments.Document.setTitle"
- Const cstSubArgs = "Title"
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(pvTitle, "Title", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Update in UNO component object and in current instance
- _Component.DocumentProperties.Title = pvTitle
- If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Property
- End Property ' SFDocuments.SF_Document.Title
- REM -----------------------------------------------------------------------------
- Property Get XComponent() As Variant
- ''' Returns the com.sun.star.lang.XComponent UNO object representing the document
- XComponent = _PropertyGet("XComponent")
- End Property ' SFDocuments.SF_Document.XComponent
- REM ===================================================================== METHODS
- REM -----------------------------------------------------------------------------
- Public Function Activate() As Boolean
- ''' Make the current document active
- ''' Args:
- ''' Returns:
- ''' True if the document could be activated
- ''' Otherwise, there is no change in the actual user interface
- ''' Examples:
- ''' oDoc.Activate()
- Dim bActivate As Boolean ' Return value
- Dim oContainer As Object ' com.sun.star.awt.XWindow
- Const cstThisSub = "SFDocuments.Document.Activate"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bActivate = False
- Check:
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not _IsStillAlive() Then GoTo Finally
- Try:
- Set oContainer = _Frame.ContainerWindow
- With oContainer
- If .isVisible() = False Then .setVisible(True)
- .IsMinimized = False
- .setFocus()
- .toFront() ' Force window change in Linux
- Wait 1 ' Bypass desynchro issue in Linux
- End With
- bActivate = True
- Finally:
- Activate = bActivate
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Document.Activate
- REM -----------------------------------------------------------------------------
- Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
- ''' Close the document. Does nothing if the document is already closed
- ''' regardless of how the document was closed, manually or by program
- ''' Args:
- ''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk
- ''' No effect if the document was not modified
- ''' Returns:
- ''' False if the user declined to close
- ''' Examples:
- ''' If oDoc.CloseDocument() Then
- ''' ' ...
- Dim bClosed As Boolean ' return value
- Dim oDispatch ' com.sun.star.frame.DispatchHelper
- Const cstThisSub = "SFDocuments.Document.CloseDocument"
- Const cstSubArgs = "[SaveAsk=True]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bClosed = False
- Check:
- If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", V_BOOLEAN) Then GoTo Finally
- End If
- Try:
- If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command
- Activate()
- RunCommand("CloseDoc")
- bClosed = _IsStillAlive(, False) ' Do not raise error
- Else
- _Frame.close(True)
- _Frame.dispose()
- bClosed = True
- End If
- Finally:
- If bClosed Then Dispose()
- CloseDocument = bClosed
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Document.CloseDocument
- REM -----------------------------------------------------------------------------
- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
- ''' Return the actual value of the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' Returns:
- ''' The actual value of the property
- ''' If the property does not exist, returns Null
- ''' Exceptions:
- ''' see the exceptions of the individual properties
- ''' Examples:
- ''' myModel.GetProperty("MyProperty")
- Const cstThisSub = "SFDocuments.Document.GetProperty"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- GetProperty = Null
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- End If
- Try:
- GetProperty = _PropertyGet(PropertyName)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Document.GetProperty
- REM -----------------------------------------------------------------------------
- Public Function Methods() As Variant
- ''' Return the list of public methods of the Model service as an array
- Methods = Array( _
- "Activate" _
- , "CloseDocument" _
- , "RunCommand" _
- , "Save" _
- , "SaveAs" _
- , "SaveCopyAs" _
- )
- End Function ' SFDocuments.SF_Document.Methods
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the Timer class as an array
- Properties = Array( _
- "CustomProperties" _
- , "Description" _
- , "DocumentProperties" _
- , "DocumentType" _
- , "IsBase" _
- , "IsCalc" _
- , "IsDraw " _
- , "IsImpress" _
- , "IsMath" _
- , "IsWriter" _
- , "Keywords" _
- , "Readonly" _
- , "Subject" _
- , "Title" _
- , "XComponent" _
- )
- End Function ' SFDocuments.SF_Document.Properties
- REM -----------------------------------------------------------------------------
- Public Sub RunCommand(Optional ByVal Command As Variant)
- ''' Run on the document the given menu command. The command is executed without arguments
- ''' A few typical commands:
- ''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ...
- ''' Dozens can be found in the directory $install/share/config/soffice.cfg/modules
- ''' Args:
- ''' Command: Case-sensitive. The command itself is not checked.
- ''' If nothing happens, then the command is probably wrong
- ''' Returns:
- ''' Examples:
- ''' oDoc.RunCommand("About")
- Dim oDispatch ' com.sun.star.frame.DispatchHelper
- Const cstThisSub = "SFDocuments.Document.RunCommand"
- Const cstSubArgs = "Command"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally
- End If
- Try:
- Set oDispatch = ScriptForge.SF_Utils._GetUNOService("DispatchHelper")
- oDispatch.executeDispatch(_Frame, ".uno:" & Command, "", 0, Array())
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- End Sub ' SFDocuments.SF_Document.RunCommand
- REM -----------------------------------------------------------------------------
- Public Function Save() As Boolean
- ''' Store the document to the file location from which it was loaded
- ''' Ignored if the document was not modified
- ''' Args:
- ''' Returns:
- ''' False if the document could not be saved
- ''' Exceptions:
- ''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved
- ''' Examples:
- ''' If Not oDoc.Save() Then
- ''' ' ...
- Dim bSaved As Boolean ' return value
- Const cstThisSub = "SFDocuments.Document.Save"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bSaved = False
- Check:
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not _IsStillAlive() Then GoTo Finally
- bSaved = False
- Try:
- With _Component
- If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly
- If .IsModified() Then
- .store()
- bSaved = True
- End If
- End With
- Finally:
- Save = bSaved
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchReadonly:
- ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEERROR, "FileName", _FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Document.Save
- REM -----------------------------------------------------------------------------
- Public Function SaveAs(Optional ByVal FileName As Variant _
- , Optional ByVal Overwrite As Variant _
- , Optional ByVal Password As Variant _
- , Optional ByVal FilterName As Variant _
- , Optional ByVal FilterOptions As Variant _
- ) As Boolean
- ''' Store the document to the given file location
- ''' The new location becomes the new file name on which simple Save method calls will be applied
- ''' Args:
- ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
- ''' Overwrite: True if the destination file may be overwritten (default = False)
- ''' Password: Use to protect the document
- ''' FilterName: the name of a filter that should be used for saving the document
- ''' If present, the filter must exist
- ''' FilterOptions: an optional string of options associated with the filter
- ''' Returns:
- ''' False if the document could not be saved
- ''' Exceptions:
- ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
- ''' Examples:
- ''' oDoc.SaveAs("C:\Me\Copy2.odt", Overwrite := True)
- Dim bSaved As Boolean ' return value
- Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
- Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
- Dim sFile As String ' Alias of FileName
- Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim FSO As Object ' SF_FileSystem
- Const cstThisSub = "SFDocuments.Document.SaveAs"
- Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
- bSaved = False
- Check:
- If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
- If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
- If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
- If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
- If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
- If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally
- If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
- End If
- ' Check that the filter exists
- If Len(FilterName) > 0 Then
- Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory")
- If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
- End If
- ' Check destination file overwriting
- Set FSO = CreateScriptService("FileSystem")
- sFile = FSO._ConvertToUrl(FileName)
- If FSO.FileExists(FileName) Then
- If Overwrite = False Then GoTo CatchError
- Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess")
- If oSfa.isReadonly(sFile) Then GoTo CatchError
- End If
- Try:
- ' Setup arguments
- If Len(Password) + Len(FilterName) = 0 Then
- vProperties = Array()
- Else
- vProperties = Array( _
- ScriptForge.SF_Utils._MakePropertyValue("FilterName", FilterName) _
- , ScriptForge.SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _
- )
- If Len(Password) > 0 Then ' Password is to add only if <> "" !?
- vProperties = ScriptForge.SF_Array.Append(vproperties _
- , ScriptForge.SF_Utils._MakePropertyValue("Password", Password))
- End If
- End If
- _Component.StoreAsURL(sFile, vProperties)
- ' Remind the new file name
- _WindowFileName = sFile
- _WindowName = FSO.GetName(FileName)
- bSaved = True
- Finally:
- SaveAs = bSaved
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchError:
- ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
- , "FilterName", FilterName)
- GoTo Finally
- End Function ' SFDocuments.SF_Document.SaveAs
- REM -----------------------------------------------------------------------------
- Public Function SaveCopyAs(Optional ByVal FileName As Variant _
- , Optional ByVal Overwrite As Variant _
- , Optional ByVal Password As Variant _
- , Optional ByVal FilterName As Variant _
- , Optional ByVal FilterOptions As Variant _
- ) As Boolean
- ''' Store a copy or export the document to the given file location
- ''' The actual location is unchanged
- ''' Args:
- ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
- ''' Overwrite: True if the destination file may be overwritten (default = False)
- ''' Password: Use to protect the document
- ''' FilterName: the name of a filter that should be used for saving the document
- ''' If present, the filter must exist
- ''' FilterOptions: an optional string of options associated with the filter
- ''' Returns:
- ''' False if the document could not be saved
- ''' Exceptions:
- ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
- ''' Examples:
- ''' oDoc.SaveCopyAs("C:\Me\Copy2.odt", Overwrite := True)
- Dim bSaved As Boolean ' return value
- Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
- Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
- Dim sFile As String ' Alias of FileName
- Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim FSO As Object ' SF_FileSystem
- Const cstThisSub = "SFDocuments.Document.SaveCopyAs"
- Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
- bSaved = False
- Check:
- If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
- If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
- If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
- If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
- If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
- If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally
- If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
- End If
- ' Check that the filter exists
- If Len(FilterName) > 0 Then
- Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory")
- If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
- End If
- ' Check destination file overwriting
- Set FSO = CreateScriptService("FileSystem")
- sFile = FSO._ConvertToUrl(FileName)
- If FSO.FileExists(FileName) Then
- If Overwrite = False Then GoTo CatchError
- Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess")
- If oSfa.isReadonly(sFile) Then GoTo CatchError
- End If
- Try:
- ' Setup arguments
- If Len(Password) + Len(FilterName) = 0 Then
- vProperties = Array()
- Else
- vProperties = Array( _
- ScriptForge.SF_Utils._MakePropertyValue("FilterName", FilterName) _
- , ScriptForge.SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _
- )
- If Len(Password) > 0 Then ' Password is to add only if <> "" !?
- vProperties = ScriptForge.SF_Array.Append(vproperties _
- , ScriptForge.SF_Utils._MakePropertyValue("Password", Password))
- End If
- End If
- _Component.StoreToURL(sFile, vProperties)
- bSaved = True
- Finally:
- SaveCopyAs = bSaved
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchError:
- ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
- , "FilterName", FilterName)
- GoTo Finally
- End Function ' SFDocuments.SF_Document.SaveCopyAs
- REM -----------------------------------------------------------------------------
- Private Function SetProperty(Optional ByVal psProperty As String _
- , Optional ByVal pvValue As Variant _
- ) As Boolean
- ''' Set the new value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- ''' pvValue: the new value of the given property
- ''' Returns:
- ''' True if successful
- Dim bSet As Boolean ' Return value
- Static oSession As Object ' Alias of SF_Session
- Dim cstThisSub As String
- Const cstSubArgs = "Value"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bSet = False
- cstThisSub = "SFDocuments.Document.set" & psProperty
- If IsMissing(pvValue) Then pvValue = Empty
- 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
- If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
- bSet = True
- Select Case UCase(psProperty)
- Case UCase("CustomProperties")
- CustomProperties = pvValue
- Case UCase("Description")
- Description = pvValue
- Case UCase("Keywords")
- Keywords = pvValue
- Case UCase("Subject")
- Subject = pvValue
- Case UCase("Title")
- Title = pvValue
- Case Else
- bSet = False
- End Select
- Finally:
- SetProperty = bSet
- 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Document.SetProperty
- REM =========================================================== PRIVATE FUNCTIONS
- REM -----------------------------------------------------------------------------
- Private Function _FileIdent() As String
- ''' Returns a file identification from the information that is currently available
- ''' Useful e.g. for display in error messages
- _FileIdent = Iif(Len(_WindowFileName) > 0, SF_FileSystem._ConvertFromUrl(_WindowFileName), _WindowTitle)
- End Function ' SFDocuments.SF_Document._FileIdent
- REM -----------------------------------------------------------------------------
- Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
- , Optional ByVal pbError As Boolean _
- ) As Boolean
- ''' Returns True if the document has not been closed manually or incidentally since the last use
- ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
- ''' Args:
- ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
- ''' pbError: if True (default), raise a fatal error
- Dim bAlive As Boolean ' Return value
- Dim sFileName As String ' File identification used to display error message
- On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
- If IsMissing(pbForUpdate) Then pbForUpdate = False
- If IsMissing(pbError) Then pbError = True
- Try:
- ' Check existence of document
- bAlive = Not IsNull(_Frame)
- If bAlive Then bAlive = Not IsNull(_Component)
- If bAlive Then bAlive = Not IsNull(_Component.CurrentController)
- ' Check document is not read only
- If bAlive And pbForUpdate Then
- If _Component.isreadonly() Then GoTo CatchReadonly
- End If
- Finally:
- _IsStillAlive = bAlive
- Exit Function
- Catch:
- bAlive = False
- On Error GoTo 0
- sFileName = _FileIdent()
- Dispose()
- If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName)
- GoTo Finally
- CatchReadonly:
- bAlive = False
- If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Document._IsStillAlive
- REM -----------------------------------------------------------------------------
- Private Sub _LoadDocumentProperties()
- ''' Create dictionary with document properties as entries/ Custom properties are excluded
- ''' Document is presumed still alive
- ''' Special values:
- ''' Only valid dates are taken
- ''' Statistics are exploded in subitems. Subitems are specific to document type
- ''' Keywords are joined
- ''' Language is aligned on L10N convention la-CO
- Dim oProperties As Object ' Document properties
- Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue
- If IsNull(_DocumentProperties) Then
- Set oProperties = _Component.getDocumentProperties
- Set _DocumentProperties = CreateScriptService("Dictionary")
- With _DocumentProperties
- .Add("Author", oProperties.Author)
- .Add("AutoloadSecs", oProperties.AutoloadSecs)
- .Add("AutoloadURL", oProperties.AutoloadURL)
- If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate))
- .Add("DefaultTarget", oProperties.DefaultTarget)
- .Add("Description", oProperties.Description) ' The description can be multiline
- ' DocumentStatistics : number and names of statistics depend on document type
- For Each vNamedValue In oProperties.DocumentStatistics
- .Add(vNamedValue.Name, vNamedValue.Value)
- Next vNamedValue
- .Add("EditingDuration", oProperties.EditingDuration)
- .Add("Generator", oProperties.Generator)
- .Add("Keywords", Join(oProperties.Keywords, ", "))
- .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, ""))
- If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate))
- If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate))
- .Add("PrintedBy", oProperties.PrintedBy)
- .Add("Subject", oProperties.Subject)
- If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate))
- .Add("TemplateName", oProperties.TemplateName)
- .Add("TemplateURL", oProperties.TemplateURL)
- .Add("Title", oProperties.Title)
- End With
- End If
- End Sub ' SFDocuments.SF_Document._LoadDocumentProperties
- REM -----------------------------------------------------------------------------
- Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
- ''' Return the value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- Dim oProperties As Object ' Document or Custom properties
- Dim cstThisSub As String
- Const cstSubArgs = ""
- _PropertyGet = False
- Select Case _DocumentType
- Case "Calc" : cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty
- Case Else : cstThisSub = "SFDocuments.SF_Document.get" & psProperty
- End Select
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not _IsStillAlive() Then GoTo Finally
- Select Case psProperty
- Case "CustomProperties"
- _CustomProperties = CreateScriptService("Dictionary") ' Always reload as updates could have been done manually by user
- _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues)
- _PropertyGet = _CustomProperties
- Case "Description"
- _PropertyGet = _Component.DocumentProperties.Description
- Case "DocumentProperties"
- _LoadDocumentProperties() ' Always reload as updates could have been done manually by user
- Set _PropertyGet = _DocumentProperties
- Case "DocumentType"
- _PropertyGet = _DocumentType
- Case "IsBase", "IsCalc", "IsDraw", "IsImpress", "IsMath", "IsWriter"
- _PropertyGet = ( Mid(psProperty, 3) = _DocumentType )
- Case "Keywords"
- _PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ")
- Case "Readonly"
- _PropertyGet = _Component.isReadonly()
- Case "Subject"
- _PropertyGet = _Component.DocumentProperties.Subject
- Case "Title"
- _PropertyGet = _Component.DocumentProperties.Title
- Case "XComponent"
- Set _PropertyGet = _Component
- Case Else
- _PropertyGet = Null
- End Select
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- End Function ' SFDocuments.SF_Document._PropertyGet
- REM -----------------------------------------------------------------------------
- Private Function _Repr() As String
- ''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...)
- ''' Args:
- ''' Return:
- ''' "[DOCUMENT]: Type - File"
- _Repr = "[Document]: " & _DocumentType & " - " & _FileIdent()
- End Function ' SFDocuments.SF_Document._Repr
- REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT
- </script:module>
|