Quelle SF_Session.xba Sprache: unbekannt

<?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, a date or a boolean
'''   - a 1D array, a 2D array or an array of arrays combining those types
'''   - a com.sun.star.table.XCellRange UNO object
''' 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
Dim i As Long
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
' Force suitable arguments
For i = 0 To UBound(pvArgs)
  pvArgs(i) = SF_Array.ConvertToRange(pvArgs(i), Direction := "V")
Next i
' Error trapping and execution
If SF_Utils._ErrorHandling() Then 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 with case-sensitive comparison of keys
Set vDict = CreateScriptService("Dictionary", True)
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
''' Exceptions:
'''  UNKNOWNFILEERROR  Command could not be identified as a valid file
''' Examples:
'''  session.RunApplication("Notepad.exe")
'''  session.RunApplication("C:\myFolder\myDocument.odt")
'''  session.RunApplication("kate")       ' (Linux)
'''  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:
' Cfr. discussion tdf#160222
' 1) Try Shell(), always in not synchronized mode
' 2) If failure - check command existence as a valid file
'     - try com.sun.star.system.SystemShellExecute
sCommand = SF_FileSystem._ConvertFromUrl(Command)
On Local Error GoTo Step2
Shell(sCommand, , Parameters, False)
  Step2:
If Err > 0 Then
  On Error GoTo 0  ' Reset error status
  If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  If Not SF_FileSystem.FileExists(Command) Then GoTo CatchNotExists
  Set oShell = SF_Utils._GetUNOService("SystemShellExecute")
  sCommand = SF_FileSystem._ConvertToUrl(Command)
  oShell.execute(sCommand, Parameters, com.sun.star.system.SystemShellExecuteFlags.DEFAULTS)
End If

bReturn = True

Finally:
RunApplication = bReturn
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotExists:
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "Command", Command)
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>

Quelle SF_Session.xba Sprache: unbekannt

[ Dauer der Verarbeitung: 0.26 Sekunden (vorverarbeitet) ]