Current File : //usr/lib/libreoffice/share/basic/ScriptForge/SF_Session.xba
<?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_Session" script:language="StarBasic" script:moduleType="normal">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.DEFAULTS)
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
</script:module>
Mini Shell