REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Session ''' ========== ''' Singleton class implementing the "ScriptForge.Session" service ''' Implemented as a usual Basic module ''' ''' Gathers diverse general-purpose properties and methods about : ''' - installation/execution environment ''' - UNO introspection utilities ''' - clipboard management ''' - invocation of external scripts or programs ''' ''' Service invocation example: ''' Dim session As Variant ''' session = CreateScriptService("Session") ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_session.html?DbPAR=BASIC ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS Const CALCFUNCERROR = "CALCFUNCERROR" ' Calc function execution failed Const NOSCRIPTERROR = "NOSCRIPTERROR" ' Script could not be located Const SCRIPTEXECERROR = "SCRIPTEXECERROR" ' Exception during script execution Const WRONGEMAILERROR = "WRONGEMAILERROR" ' Wrong email address Const SENDMAILERROR = "SENDMAILERROR" ' Mail could not be sent Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist REM ============================================================ MODULE CONSTANTS ''' Script locations ''' ================ ''' Use next constants as Scope argument when invoking next methods: ''' ExecuteBasicScript() ''' ExecutePythonScript() ''' Example: ''' session.ExecuteBasicScript(session.SCRIPTISEMBEDDED, "Standard.myModule.myFunc", etc) Const cstSCRIPTISEMBEDDED = "document" ' a library of the document (BASIC + PYTHON) Const cstSCRIPTISAPPLICATION = "application" ' a shared library (BASIC) Const cstSCRIPTISPERSONAL = "user" ' a library of My Macros (PYTHON) Const cstSCRIPTISPERSOXT = "user:uno_packages" ' an extension for the current user (PYTHON) Const cstSCRIPTISSHARED = "share" ' a library of LibreOffice Macros (PYTHON) Const cstSCRIPTISSHAROXT = "share:uno_packages" ' an extension for all users (PYTHON) Const cstSCRIPTISOXT = "uno_packages" ' an extension but install params are unknown (PYTHON) ''' To build or to parse scripting framework URI's Const cstScript1 = "vnd.sun.star.script:" Const cstScript2 = "?language=" Const cstScript3 = "&location=" REM ===================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Public Function Dispose() As Variant Set Dispose = Nothing End Function ' ScriptForge.SF_Array Explicit destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- Property Get ObjectType As String ''' Only to enable object representation ObjectType = "SF_Session" End Property ' ScriptForge.SF_Session.ObjectType REM ----------------------------------------------------------------------------- Property Get ServiceName As String ''' Internal use ServiceName = "ScriptForge.Session" End Property ' ScriptForge.SF_Array.ServiceName REM ----------------------------------------------------------------------------- Property Get SCRIPTISAPPLICATION As String ''' Convenient constants SCRIPTISAPPLICATION = cstSCRIPTISAPPLICATION End Property ' ScriptForge.SF_Session.SCRIPTISAPPLICATION REM ----------------------------------------------------------------------------- Property Get SCRIPTISEMBEDDED As String ''' Convenient constants SCRIPTISEMBEDDED = cstSCRIPTISEMBEDDED End Property ' ScriptForge.SF_Session.SCRIPTISEMBEDDED REM ----------------------------------------------------------------------------- Property Get SCRIPTISOXT As String ''' Convenient constants SCRIPTISOXT = cstSCRIPTISOXT End Property ' ScriptForge.SF_Session.SCRIPTISOXT REM ----------------------------------------------------------------------------- Property Get SCRIPTISPERSONAL As String ''' Convenient constants SCRIPTISPERSONAL = cstSCRIPTISPERSONAL End Property ' ScriptForge.SF_Session.SCRIPTISPERSONAL REM ----------------------------------------------------------------------------- Property Get SCRIPTISPERSOXT As String ''' Convenient constants SCRIPTISPERSOXT = cstSCRIPTISPERSOXT End Property ' ScriptForge.SF_Session.SCRIPTISPERSOXT REM ----------------------------------------------------------------------------- Property Get SCRIPTISSHARED As String ''' Convenient constants SCRIPTISSHARED = cstSCRIPTISSHARED End Property ' ScriptForge.SF_Session.SCRIPTISSHARED REM ----------------------------------------------------------------------------- Property Get SCRIPTISSHAROXT As String ''' Convenient constants SCRIPTISSHAROXT = cstSCRIPTISSHAROXT End Property ' ScriptForge.SF_Session.SCRIPTISSHAROXT REM ============================================================== PUBLIC METHODS REM ----------------------------------------------------------------------------- Public Function ExecuteBasicScript(Optional ByVal Scope As Variant _ , Optional ByVal Script As Variant _ , ParamArray pvArgs As Variant _ ) As Variant ''' Execute the Basic script given as a string and return the value returned by the script ''' Args: ''' Scope: "Application" (default) or "Document" (NOT case-sensitive) ''' (or use one of the SCRIPTIS... public constants above) ''' Script: library.module.method (Case sensitive) ''' library => The library may be not loaded yet ''' module => Must not be a class module ''' method => Sub or Function ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification ''' pvArgs: the arguments of the called script ''' Returns: ''' The value returned by the call to the script ''' Exceptions: ''' NOSCRIPTERROR The script could not be found ''' Examples: ''' session.ExecuteBasicScript(, "XrayTool._Main.Xray", someuno) ' Sub: no return expected Dim oScript As Object ' Script to be invoked Dim vReturn As Variant ' Returned value Const cstThisSub = "Session.ExecuteBasicScript" Const cstSubArgs = "[Scope], Script, arg0[, arg1] ..." If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch vReturn = Empty Check: If IsMissing(Scope) Or IsEmpty(Scope) Then Scope = SCRIPTISAPPLICATION If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(Scope, "Scope", V_STRING _ , Array(SCRIPTISAPPLICATION, SCRIPTISEMBEDDED)) Then GoTo Finally If Not SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Finally End If Try: ' Execute script Set oScript = SF_Session._GetScript("Basic", Scope, Script) On Local Error GoTo CatchExec If Not IsNull(oScript) Then vReturn = oScript.Invoke(pvArgs, Array(), Array()) Finally: ExecuteBasicScript = vReturn SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchExec: SF_Exception.RaiseFatal(SCRIPTEXECERROR, "Script", Script, Error$) GoTo Finally End Function ' ScriptForge.SF_Session.ExecuteBasicScript REM ----------------------------------------------------------------------------- Public Function ExecuteCalcFunction(Optional ByVal CalcFunction As Variant _ , ParamArray pvArgs As Variant _ ) As Variant ''' Execute a Calc function by its (english) name and based on the given arguments ''' Args: ''' CalcFunction: the english name of the function to execute ''' pvArgs: the arguments of the called function ''' Each argument must be either a string, a numeric value ''' or an array of arrays combining those types ''' Returns: ''' The (string or numeric) value or the array of arrays returned by the call to the function ''' When the arguments contain arrays, the function is executed as an array function ''' Wrong arguments generate an error ''' Exceptions: ''' CALCFUNCERROR ' Execution error in calc function ''' Examples: ''' session.ExecuteCalcFunction("AVERAGE", 1, 5, 3, 7) returns 4 ''' session.ExecuteCalcFunction("ABS", Array(Array(-1,2,3),Array(4,-5,6),Array(7,8,-9)))(2)(2) returns 9 ''' session.ExecuteCalcFunction("LN", -3) generates an error Dim oCalc As Object ' Give access to the com.sun.star.sheet.FunctionAccess service Dim vReturn As Variant ' Returned value Const cstThisSub = "Session.ExecuteCalcFunction" Const cstSubArgs = "CalcFunction, arg0[, arg1] ..." If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch vReturn = Empty Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(CalcFunction, "CalcFunction", V_STRING) Then GoTo Finally End If Try: ' Execute function Set oCalc = SF_Utils._GetUNOService("FunctionAccess") ' Intercept calls from Python when no arguments. Example NOW() If UBound(pvArgs) = 0 Then If IsEmpty(pvArgs(0)) Then pvArgs = Array() End If On Local Error GoTo CatchCall vReturn = oCalc.callFunction(UCase(CalcFunction), pvArgs()) Finally: ExecuteCalcFunction = vReturn SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchCall: SF_Exception.RaiseFatal(CALCFUNCERROR, CalcFunction) GoTo Finally End Function ' ScriptForge.SF_Session.ExecuteCalcFunction REM ----------------------------------------------------------------------------- Public Function ExecutePythonScript(Optional ByVal Scope As Variant _ , Optional ByVal Script As Variant _ , ParamArray pvArgs As Variant _ ) As Variant ''' Execute the Python script given as a string and return the value returned by the script ''' Args: ''' Scope: one of the SCRIPTIS... public constants above (default = "share") ''' Script: (Case sensitive) ''' "library/module.py$method" ''' or "module.py$method" ''' or "myExtension.oxt|myScript|module.py$method" ''' library => The library may be not loaded yet ''' myScript => The directory containing the python module ''' module.py => The python module ''' method => The python function ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification ''' pvArgs: the arguments of the called script ''' Date arguments are converted to iso format. However dates in arrays are not converted ''' Returns: ''' The value(s) returned by the call to the script. If >1 values, enclosed in an array ''' Exceptions: ''' NOSCRIPTERROR The script could not be found ''' Examples: ''' session.ExecutePythonScript(session.SCRIPTISSHARED, "Capitalise.py$getNewString", "Abc") returns "abc" Dim oScript As Object ' Script to be invoked Dim vArg As Variant ' Individual argument Dim vReturn As Variant ' Returned value Dim i As Long Const cstThisSub = "Session.ExecutePythonScript" Const cstSubArgs = "[Scope], Script, arg0[, arg1] ..." If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch vReturn = Empty Check: If IsError(Scope) Or IsMissing(Scope) Then Scope = SCRIPTISSHARED If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(Scope, "Scope", V_STRING _ , Array(SCRIPTISSHARED, SCRIPTISEMBEDDED, SCRIPTISPERSONAL, SCRIPTISSHAROXT, SCRIPTISPERSOXT, SCRIPTISOXT) _ ) Then GoTo Finally If Not SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Finally End If Try: ' Filter date arguments - NB: dates in arrays are not filtered For i = 0 To UBound(pvArgs) ' pvArgs always zero-based vArg = pvArgs(i) If VarType(vArg) = V_DATE Then pvArgs(i) = SF_Utils._CDateToIso(vArg) Next i ' Intercept alternate Python helpers file when relevant With _SF_ If SF_String.StartsWith(Script, .PythonHelper) And Len(.PythonHelper2) > 0 Then Scope = SCRIPTISPERSONAL Script = .PythonHelper2 & Mid(Script, Len(.PythonHelper) + 1) End If End With ' Find script Set oScript = SF_Session._GetScript("Python", Scope, Script) ' Execute script If Not IsNull(oScript) Then vReturn = oScript.Invoke(pvArgs(), Array(), Array()) ' Remove surrounding array when single returned value If IsArray(vReturn) Then If UBound(vReturn) = 0 Then vReturn = vReturn(0) End If End If Finally: ExecutePythonScript = vReturn SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.ExecutePythonScript REM ----------------------------------------------------------------------------- Public Function GetPDFExportOptions() As Variant ''' Return the actual values of the PDF export options ''' The PDF options are described on https://wiki.openoffice.org/wiki/API/Tutorials/PDF_export ''' PDF options are set at each use of the Export as ... PDF command by the user and kept ''' permanently until their reset by script or by a new export ''' Args: ''' Returns: ''' A ScriptForge dictionary instance listing the 40+ properties and their value ''' Examples: ''' Dim dict As Object ''' Set dict = session.GetPDFExportOptions() ''' MsgBox dict.Item("Quality") Dim vDict As Variant ' Returned value Dim oConfig As Object ' com.sun.star.configuration.ConfigurationProvider Dim oNodePath As Object ' com.sun.star.beans.PropertyValue Dim oOptions As Object ' configmgr.RootAccess Dim vOptionNames As Variant ' Array of PDF options names Dim vOptionValues As Variant ' Array of PDF options values Dim i As Long Const cstThisSub = "Session.GetPDFExportOptions" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set vDict = Nothing Check: SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Try: ' Get the (read-only) internal PDF options Set oConfig = SF_Utils._GetUNOService("ConfigurationProvider") Set oNodePath = SF_Utils._MakePropertyValue("nodepath", "/org.openoffice.Office.Common/Filter/PDF/Export/") Set oOptions = oConfig.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", Array(oNodePath)) ' Copy the options into a ScriptForge dictionary Set vDict = CreateScriptService("dictionary") vOptionNames = oOptions.getElementNames() vOptionValues = oOptions.getPropertyValues(vOptionNames) ' For i = 0 To UBound(vOptionNames) vDict.Add(vOptionNames(i), vOptionValues(i)) Next i Finally: GetPDFExportOptions = vDict SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.GetPDFExportOptions 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 ''' Exceptions ''' ARGUMENTERROR The property does not exist Const cstThisSub = "Session.GetProperty" Const cstSubArgs = "PropertyName" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch GetProperty = Null Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: Select Case UCase(PropertyName) Case Else End Select Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.GetProperty REM ----------------------------------------------------------------------------- Public Function HasUnoMethod(Optional ByRef UnoObject As Variant _ , Optional ByVal MethodName As Variant _ ) As Boolean ''' Returns True if a UNO object contains the given method ''' Code-snippet derived from XRAY ''' Args: ''' UnoObject: the object to identify ''' MethodName: the name of the method as a string. The search is case-sensitive ''' Returns: ''' False when the method is not found or when an argument is invalid Dim oIntrospect As Object ' com.sun.star.beans.Introspection Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess Dim bMethod As Boolean ' Return value Const cstThisSub = "Session.HasUnoMethod" Const cstSubArgs = "UnoObject, MethodName" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Check: bMethod = False If VarType(UnoObject) <> V_OBJECT Then GoTo Finally If IsNull(UnoObject) Then GoTo Finally If VarType(MethodName) <> V_STRING Then GoTo Finally If MethodName = Space(Len(MethodName)) Then GoTo Finally Try: On Local Error GoTo Catch Set oIntrospect = SF_Utils._GetUNOService("Introspection") Set oInspect = oIntrospect.inspect(UnoObject) bMethod = oInspect.hasMethod(MethodName, com.sun.star.beans.MethodConcept.ALL) Finally: HasUnoMethod = bMethod SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: On Local Error GoTo 0 GoTo Finally End Function ' ScriptForge.SF_Session.HasUnoMethod REM ----------------------------------------------------------------------------- Public Function HasUnoProperty(Optional ByRef UnoObject As Variant _ , Optional ByVal PropertyName As Variant _ ) As Boolean ''' Returns True if a UNO object contains the given property ''' Code-snippet derived from XRAY ''' Args: ''' UnoObject: the object to identify ''' PropertyName: the name of the property as a string. The search is case-sensitive ''' Returns: ''' False when the property is not found or when an argument is invalid Dim oIntrospect As Object ' com.sun.star.beans.Introspection Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess Dim bProperty As Boolean ' Return value Const cstThisSub = "Session.HasUnoProperty" Const cstSubArgs = "UnoObject, PropertyName" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Check: bProperty = False If VarType(UnoObject) <> V_OBJECT Then GoTo Finally If IsNull(UnoObject) Then GoTo Finally If VarType(PropertyName) <> V_STRING Then GoTo Finally If PropertyName = Space(Len(PropertyName)) Then GoTo Finally Try: On Local Error GoTo Catch Set oIntrospect = SF_Utils._GetUNOService("Introspection") Set oInspect = oIntrospect.inspect(UnoObject) bProperty = oInspect.hasProperty(PropertyName, com.sun.star.beans.PropertyConcept.ALL) Finally: HasUnoProperty = bProperty SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: On Local Error GoTo 0 GoTo Finally End Function ' ScriptForge.SF_Session.HasUnoProperty REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Session service as an array Methods = Array( _ "ExecuteBasicScript" _ , "ExecuteCalcFunction" _ , "ExecutePythonScript" _ , "HasUnoMethod" _ , "HasUnoProperty" _ , "OpenURLInBrowser" _ , "RunApplication" _ , "SendMail" _ , "UnoMethods" _ , "UnoObjectType" _ , "UnoProperties" _ , "WebService" _ ) End Function ' ScriptForge.SF_Session.Methods REM ----------------------------------------------------------------------------- Public Sub OpenURLInBrowser(Optional ByVal URL As Variant) ''' Opens a URL in the default browser ''' Args: ''' URL: The URL to open in the browser ''' Examples: ''' session.OpenURLInBrowser("https://docs.python.org/3/library/webbrowser.html") Const cstPyHelper = "$" & "_SF_Session__OpenURLInBrowser" Const cstThisSub = "Session.OpenURLInBrowser" Const cstSubArgs = "URL" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(URL, "URL", V_STRING) Then GoTo Finally End If Try: ExecutePythonScript(SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, URL) Finally: SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' ScriptForge.SF_Session.OpenURLInBrowser REM ----------------------------------------------------------------------------- Public Function Properties() As Variant ''' Return the list or properties as an array Properties = Array( _ ) End Function ' ScriptForge.SF_Session.Properties REM ----------------------------------------------------------------------------- Public Function RunApplication(Optional ByVal Command As Variant _ , Optional ByVal Parameters As Variant _ ) As Boolean ''' Executes an arbitrary system command ''' Args: ''' Command: The command to execute ''' This may be an executable file or a document which is registered with an application ''' so that the system knows what application to launch for that document ''' Parameters: a list of space separated parameters as a single string ''' The method does not validate the given parameters, but only passes them to the specified command ''' Returns: ''' True if success ''' Examples: ''' session.RunApplication("Notepad.exe") ''' session.RunApplication("C:\myFolder\myDocument.odt") ''' session.RunApplication("kate", "/home/me/install.txt") ' (Linux) Dim bReturn As Boolean ' Returned value Dim oShell As Object ' com.sun.star.system.SystemShellExecute Dim sCommand As String ' Command as an URL Const cstThisSub = "Session.RunApplication" Const cstSubArgs = "Command, [Parameters]" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bReturn = False Check: If IsMissing(Parameters) Then Parameters = "" If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._ValidateFile(Command, "Command") Then GoTo Finally If Not SF_Utils._Validate(Parameters, "Parameters", V_STRING) Then GoTo Finally End If Try: Set oShell = SF_Utils._GetUNOService("SystemShellExecute") sCommand = SF_FileSystem._ConvertToUrl(Command) oShell.execute(sCommand, Parameters, com.sun.star.system.SystemShellExecuteFlags.URIS_ONLY) bReturn = True Finally: RunApplication = bReturn SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.RunApplication REM ----------------------------------------------------------------------------- Public Sub SendMail(Optional ByVal Recipient As Variant _ , Optional ByRef Cc As Variant _ , Optional ByRef Bcc As Variant _ , Optional ByVal Subject As Variant _ , Optional ByRef Body As Variant _ , Optional ByVal FileNames As Variant _ , Optional ByVal EditMessage As Variant _ ) ''' Send a message (with or without attachments) to recipients from the user's mail client ''' The message may be edited by the user before sending or, alternatively, be sent immediately ''' Args: ''' Recipient: an email addresses (To recipient) ''' Cc: a comma-delimited list of email addresses (carbon copy) ''' Bcc: a comma-delimited list of email addresses (blind carbon copy) ''' Subject: the header of the message ''' FileNames: a comma-separated list of filenames to attach to the mail. SF_FileSystem naming conventions apply ''' Body: the unformatted text of the message ''' EditMessage: when True (default) the message is editable before being sent ''' Exceptions: ''' UNKNOWNFILEERROR File does not exist ''' WRONGEMAILERROR String not recognized as an email address ''' SENDMAILERROR System error, probably no mail client Dim sEmail As String ' An single email address Dim sFile As String ' A single file name Dim sArg As String ' Argument name Dim vCc As Variant ' Array alias of Cc Dim vBcc As Variant ' Array alias of Bcc Dim vFileNames As Variant ' Array alias of FileNames Dim oMailService As Object ' com.sun.star.system.SimpleCommandMail or com.sun.star.system.SimpleSystemMail Dim oMail As Object ' com.sun.star.system.XSimpleMailClient Dim oMessage As Object ' com.sun.star.system.XSimpleMailMessage Dim lFlag As Long ' com.sun.star.system.SimpleMailClientFlags.XXX Dim ARR As Object : ARR = ScriptForge.SF_Array Dim i As Long Const cstComma = ",", cstSemiColon = ";" Const cstThisSub = "Session.SendMail" Const cstSubArgs = "Recipient, [Cc=""""], [Bcc=""""], [Subject=""""], [FileNames=""""], [Body=""""], [EditMessage=True]" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(Cc) Or IsEmpty(Cc) Then Cc = "" If IsMissing(Bcc) Or IsEmpty(Bcc) Then Bcc = "" If IsMissing(Subject) Or IsEmpty(Subject) Then Subject = "" If IsMissing(FileNames) Or IsEmpty(FileNames) Then FileNames = "" If IsMissing(Body) Or IsEmpty(Body) Then Body = "" If IsMissing(EditMessage) Or IsEmpty(EditMessage) Then EditMessage = True If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(Recipient, "Recipient", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Cc, "Cc", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Bcc, "Bcc", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Subject, "Subject", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FileNames, "FileNames", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Body, "Body", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(EditMessage, "EditMessage", V_BOOLEAN) Then GoTo Finally End If ' Check email addresses sArg = "Recipient" : sEmail = Recipient If Not SF_String.IsEmail(sEmail) Then GoTo CatchEmail sArg = "Cc" : vCc = ARR.TrimArray(Split(Cc, cstComma)) For Each sEmail In vCc If Not SF_String.IsEmail(sEmail) Then GoTo CatchEmail Next sEmail sArg = "Bcc" : vBcc = ARR.TrimArray(Split(Bcc, cstComma)) For Each sEmail In vBcc If Not SF_String.IsEmail(sEmail) Then GoTo CatchEmail Next sEmail ' Check file existence If Len(FileNames) > 0 Then vFileNames = ARR.TrimArray(Split(FileNames, cstComma)) For i = 0 To UBound(vFileNames) sFile = vFileNames(i) If Not SF_Utils._ValidateFile(sFile, "FileNames") Then GoTo Finally If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists vFileNames(i) = ConvertToUrl(sFile) Next i Else vFileNames = Array() End If Try: ' Initialize the mail service Set oMailService = SF_Utils._GetUNOService("MailService") If IsNull(oMailService) Then GoTo CatchMail Set oMail = oMailService.querySimpleMailClient() If IsNull(oMail) Then GoTo CatchMail Set oMessage = oMail.createSimpleMailMessage() If IsNull(oMessage) Then GoTo CatchMail ' Feed the new mail message With oMessage .setRecipient(Recipient) If Subject <> "" Then .setSubject(Subject) If UBound(vCc) >= 0 Then .setCcRecipient(vCc) If UBound(vBcc) >= 0 Then .setBccRecipient(vBcc) .Body = Iif(Len(Body) = 0, " ", Body) ' Body must not be the empty string ?? .setAttachement(vFileNames) End With lFlag = Iif(EditMessage, com.sun.star.system.SimpleMailClientFlags.DEFAULTS, com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE) ' Send using the mail service oMail.sendSimpleMailMessage(oMessage, lFlag) Finally: SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally CatchEmail: SF_Exception.RaiseFatal(WRONGEMAILERROR, sArg, sEmail) GoTo Finally CatchNotExists: SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileNames", sFile) GoTo Finally CatchMail: SF_Exception.RaiseFatal(SENDMAILERROR) GoTo Finally End Sub ' ScriptForge.SF_Session.SendMail REM ----------------------------------------------------------------------------- Public Function SetPDFExportOptions(Optional ByRef PDFOptions As Variant) As Boolean ''' Modify the actual values of the PDF export options from an options dictionary ''' The PDF options are described on https://wiki.openoffice.org/wiki/API/Tutorials/PDF_export ''' PDF options are set at each use of the Export as ... PDF command by the user and kept ''' permanently until their reset by script (like this one) or by a new export ''' The changed options are applicable on any subsequent ExportToPDF user command or to any SaveAsPDF script execution ''' Args: ''' PDFOptions: a ScriptForge dictionary object ''' Returns: ''' True when successful ''' Examples: ''' Dim dict As Object ''' Set dict = session.GetPDFExportOptions() ''' dict.ReplaceItem("Quality", 50) ''' session.SetPDFExportOptions(dict) Dim bSetPDF As Boolean ' Returned value Dim oConfig As Object ' com.sun.star.configuration.ConfigurationProvider Dim oNodePath As Object ' com.sun.star.beans.PropertyValue Dim oOptions As Object ' configmgr.RootAccess Dim vOptionNames As Variant ' Array of PDF options names Dim vOptionValues As Variant ' Array of PDF options values Dim oDict As Object ' Alias of PDFOptions Dim i As Long Const cstThisSub = "Session.SetPDFExportOptions" Const cstSubArgs = "PDFOptions" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bSetPDF = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PDFOptions, "PDFOptions", V_OBJECT, , , "DICTIONARY") Then GoTo Finally End If Try: ' Get the (updatable) internal PDF options Set oConfig = SF_Utils._GetUNOService("ConfigurationProvider") Set oNodePath = SF_Utils._MakePropertyValue("nodepath", "/org.openoffice.Office.Common/Filter/PDF/Export/") Set oOptions = oConfig.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", Array(oNodePath)) ' Copy the options from the ScriptForge dictionary in argument to property values Set oDict = PDFOptions oOptions.setPropertyValues(oDict.Keys, oDict.Items) oOptions.commitChanges() bSetPDF = True Finally: SetPDFExportOptions = bSetPDF SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.SetPDFExportOptions REM ----------------------------------------------------------------------------- Public Function SetProperty(Optional ByVal PropertyName As Variant _ , Optional ByRef Value As Variant _ ) As Boolean ''' Set a new value to the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Value: its new value ''' Exceptions ''' ARGUMENTERROR The property does not exist Const cstThisSub = "Session.SetProperty" Const cstSubArgs = "PropertyName, Value" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch SetProperty = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: Select Case UCase(PropertyName) Case Else End Select Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.SetProperty REM ----------------------------------------------------------------------------- Public Function UnoMethods(Optional ByRef UnoObject As Variant) As Variant ''' Returns a list of the methods callable from an UNO object ''' Code-snippet derived from XRAY ''' Args: ''' UnoObject: the object to identify ''' Returns: ''' A zero-based sorted array. May be empty Dim oIntrospect As Object ' com.sun.star.beans.Introspection Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess Dim vMethods As Variant ' Array of com.sun.star.reflection.XIdlMethod Dim vMethod As Object ' com.sun.star.reflection.XIdlMethod Dim lMax As Long ' UBounf of vMethods Dim vMethodsList As Variant ' Return value Dim i As Long Const cstThisSub = "Session.UnoMethods" Const cstSubArgs = "UnoObject" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Check: vMethodsList = Array() If VarType(UnoObject) <> V_OBJECT Then GoTo Finally If IsNull(UnoObject) Then GoTo Finally Try: On Local Error GoTo Catch Set oIntrospect = SF_Utils._GetUNOService("Introspection") Set oInspect = oIntrospect.inspect(UnoObject) vMethods = oInspect.getMethods(com.sun.star.beans.MethodConcept.ALL) ' The names must be extracted from com.sun.star.reflection.XIdlMethod structures lMax = UBound(vMethods) If lMax >= 0 Then ReDim vMethodsList(0 To lMax) For i = 0 To lMax vMethodsList(i) = vMethods(i).Name Next i vMethodsList = SF_Array.Sort(vMethodsList, CaseSensitive := True) End If Finally: UnoMethods = vMethodsList SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: On Local Error GoTo 0 GoTo Finally End Function ' ScriptForge.SF_Session.UnoMethods REM ----------------------------------------------------------------------------- Public Function UnoObjectType(Optional ByRef UnoObject As Variant) As String ''' Identify the UNO type of an UNO object ''' Code-snippet derived from XRAY ''' Args: ''' UnoObject: the object to identify ''' Returns: ''' com.sun.star. ... as a string ''' a zero-length string if identification was not successful Dim oObjDesc As Object ' _ObjectDescriptor type Dim sObjectType As String ' Return value Const cstThisSub = "Session.UnoObjectType" Const cstSubArgs = "UnoObject" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Check: sObjectType = "" If VarType(UnoObject) <> V_OBJECT Then GoTo Finally If IsNull(UnoObject) Then GoTo Finally Try: Set oObjDesc = SF_Utils._VarTypeObj(UnoObject) If oObjDesc.iVarType = V_UNOOBJECT Then sObjectType = oObjDesc.sObjectType Finally: UnoObjectType = sObjectType SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Session.UnoObjectType REM ----------------------------------------------------------------------------- Public Function UnoProperties(Optional ByRef UnoObject As Variant) As Variant ''' Returns a list of the properties of an UNO object ''' Code-snippet derived from XRAY ''' Args: ''' UnoObject: the object to identify ''' Returns: ''' A zero-based sorted array. May be empty Dim oIntrospect As Object ' com.sun.star.beans.Introspection Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess Dim vProperties As Variant ' Array of com.sun.star.beans.Property Dim vProperty As Object ' com.sun.star.beans.Property Dim lMax As Long ' UBounf of vProperties Dim vPropertiesList As Variant ' Return value Dim i As Long Const cstThisSub = "Session.UnoProperties" Const cstSubArgs = "UnoObject" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Check: vPropertiesList = Array() If VarType(UnoObject) <> V_OBJECT Then GoTo Finally If IsNull(UnoObject) Then GoTo Finally Try: On Local Error GoTo Catch Set oIntrospect = SF_Utils._GetUNOService("Introspection") Set oInspect = oIntrospect.inspect(UnoObject) vProperties = oInspect.getProperties(com.sun.star.beans.PropertyConcept.ALL) ' The names must be extracted from com.sun.star.beans.Property structures lMax = UBound(vProperties) If lMax >= 0 Then ReDim vPropertiesList(0 To lMax) For i = 0 To lMax vPropertiesList(i) = vProperties(i).Name Next i vPropertiesList = SF_Array.Sort(vPropertiesList, CaseSensitive := True) End If Finally: UnoProperties = vPropertiesList SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: On Local Error GoTo 0 GoTo Finally End Function ' ScriptForge.SF_Session.UnoProperties REM ----------------------------------------------------------------------------- Public Function WebService(Optional ByVal URI As Variant) As String ''' Get some web content from a URI ''' Args: ''' URI: URI text of the web service ''' Returns: ''' The web page content of the URI ''' Exceptions: ''' CALCFUNCERROR ''' Examples: ''' session.WebService("wiki.documentfoundation.org/api.php?" _ ''' & "hidebots=1&days=7&limit=50&action=feedrecentchanges&feedformat=rss") Dim sReturn As String ' Returned value Const cstThisSub = "Session.WebService" Const cstSubArgs = "URI" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sReturn = "" Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(URI, "URI", V_STRING) Then GoTo Finally End If Try: sReturn = SF_Session.ExecuteCalcFunction("WEBSERVICE", URI) Finally: WebService = sReturn SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Session.WebService REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Function _ExecuteScript(ByVal psScript As String _ , Optional ByRef pvArg As Variant _ ) As Variant ''' Execute the script expressed in the scripting framework_URI notation ''' Args: ''' psScript: read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification ''' pvArg: the unique argument to pass to the called script. ''' It is often an event object that triggered the execution of the script. ''' Returns: ''' The return value after the script execution. May be ignored for events Dim sScope As String ' The scope part of the script URI Dim sLanguage As String ' The language part of the script URI Dim sScript As String ' The script part of the script URI Dim vStrings As Variant ' Array of strings: (script, language, scope) Const cstComma = "," Try: If ScriptForge.SF_String.StartsWith(psScript, cstScript1) Then ' Parse script vStrings = Split( _ Replace( _ Replace(Mid(psScript, Len(cstScript1) + 1), cstScript2, cstComma) _ , cstScript3, cstComma) _ , cstComma) sScript = vStrings(0) : sLanguage = vStrings(1) : sScope = vStrings(2) ' Execute script If UCase(sLanguage) = "BASIC" Then _ExecuteScript = ExecuteBasicScript(sScope, sScript, pvArg) Else ' Python _ExecuteScript = ExecutePythonScript(sScope, sScript, pvArg) End If End If End Function ' ScriptForge.SF_Session._ExecuteScript REM ----------------------------------------------------------------------------- Private Function _GetScript(ByVal psLanguage As String _ , ByVal psScope As String _ , ByVal psScript As String _ ) As Object ''' Get the adequate script provider and from there the requested script ''' Called by ExecuteBasicScript() and ExecutePythonScript() ''' The execution of the script is done by the caller ''' Args: ''' psLanguage: Basic or Python ''' psScope: one of the SCRIPTISxxx constants ''' The SCRIPTISOXT constant is an alias for 2 cases, extension either ''' installed for one user only, or for all users ''' Managed here by trial and error ''' psScript: Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification ''' Returns: ''' A com.sun.star.script.provider.XScript object Dim sScript As String ' The complete script string Dim oScriptProvider As Object ' Script provider singleton Dim oScript As Object ' Return value Try: ' Build script string sScript = cstScript1 & psScript & cstScript2 & psLanguage & cstScript3 & LCase(psScope) ' Find script Set oScript = Nothing ' Python only: installation of extension is determined by user => unknown to script author If psScope = SCRIPTISOXT Then ' => Trial and error On Local Error GoTo ForAllUsers sScript = cstScript1 & psScript & cstScript2 & psLanguage & cstScript3 & SCRIPTISPERSOXT Set oScriptProvider = SF_Utils._GetUNOService("ScriptProvider", SCRIPTISPERSOXT) Set oScript = oScriptProvider.getScript(sScript) End If ForAllUsers: On Local Error GoTo CatchNotFound If IsNull(oScript) Then If psScope = SCRIPTISOXT Then psScope = SCRIPTISSHAROXT Set oScriptProvider = SF_Utils._GetUNOService("ScriptProvider", psScope) Set oScript = oScriptProvider.getScript(sScript) End If Finally: _GetScript = oScript Exit Function CatchNotFound: SF_Exception.RaiseFatal(NOSCRIPTERROR, psLanguage, "Scope", psScope, "Script", psScript) GoTo Finally End Function ' ScriptForge.SF_Session._GetScript REM =============================================== END OF SCRIPTFORGE.SF_SESSION