| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918 |
- <?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")
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- 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.myLib.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)
- 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.openoffice.org/wiki/Documentation/DevGuide/Scripting/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")
- 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.openoffice.org/wiki/Documentation/DevGuide/Scripting/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
- ' 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 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(Cc, "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
- 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 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 oService As Object ' com.sun.star.reflection.CoreReflection
- Dim vClass as Variant ' com.sun.star.reflection.XIdlClass
- 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:
- On Local Error Resume Next
- ' Try usual ImplementationName method
- sObjectType = UnoObject.getImplementationName()
- If sObjectType = "" Then
- ' Now try CoreReflection trick
- Set oService = SF_Utils._GetUNOService("CoreReflection")
- vClass = oService.getType(UnoObject)
- If vClass.TypeClass >= com.sun.star.uno.TypeClass.STRUCT Then sObjectType = vClass.Name
- End If
- 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 _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.openoffice.org/wiki/Documentation/DevGuide/Scripting/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
- Const cstScript1 = "vnd.sun.star.script:"
- Const cstScript2 = "?language="
- Const cstScript3 = "&location="
- 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>
|