7b2a6f0444
A dataset represents a set of tabular data
stored/produced by a database.
To use datasets, the database instance must exist
but the Base document may not be open.
A Dataset instance is create either with
- the (new) database.CreateDataset() method
- from an existing dataset with the (new)
dataset.CreateDataset() method.
The proposed API supports next main purposes:
- browse for- and backward thru the dataset to get its content
- update any record with new values
- create new records or delete some.
In summary, the AKA "CRUD" operations
(create, read, update, delete).
The originality of the proposed API is the use
of a dense syntax to make insertions and updates
easy and readable:
Example:
(BASIC)
Dim newID As Long
newID = dataset.Insert("LastName", "Doe", "FirstName", "John")
' ... is equivalent to:
Dim dict As Object, newID As Long
Set dict = CreateScriptService("ScriptForge.Dictionary")
dict.Add("LastName", "Doe")
dict.Add("FirstName", "John")
newID = dataset.Insert(dict)
(PYTHON) - next statements are equivalent
newid = dataset.Insert('LastName', 'Doe', 'FirstName', 'John')
newid = dataset.Insert({'LastName': 'Doe', 'FirstName': 'John'})
newid = dataset.Insert(dict(LastName = 'Doe', FirstName = 'John'))
newid = dataset.Insert(LastName = 'Doe', FirstName = 'John')
You will notice that the returned value is the AutoValue primery
key (when it exists) which makes it reuse as a foreign key
immediate.
The API is fully available both in Basic and Python user scripts.
The new service will require its inclusion in the user documentation.
Change-Id: I4f834c4234e5b96ec8fddfffbad791ecf31899df
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/159325
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
1413 lines
No EOL
69 KiB
XML
1413 lines
No EOL
69 KiB
XML
<?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_Exception" 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
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' Exception (aka SF_Exception)
|
|
''' =========
|
|
''' Generic singleton class for Basic code debugging and error handling
|
|
'''
|
|
''' Errors may be generated by
|
|
''' the Basic run-time error detection
|
|
''' in the ScriptForge code => RaiseAbort()
|
|
''' in a user code => Raise()
|
|
''' an error detection implemented
|
|
''' in the ScriptForge code => RaiseFatal()
|
|
''' in a user code => Raise() or RaiseWarning()
|
|
'''
|
|
''' When a run-time error occurs, the properties of the Exception object are filled
|
|
''' with information that uniquely identifies the error and information that can be used to handle it
|
|
''' The SF_Exception object is in this context similar to the VBA Err object
|
|
''' See https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/err-object
|
|
''' The Number property identifies the error: it can be a numeric value or a string
|
|
''' Numeric values up to 2000 are considered Basic run-time errors
|
|
'''
|
|
''' The "console" logs events, actual variable values, errors, ... It is an easy mean
|
|
''' to debug Basic programs especially when the IDE is not usable, f.i. in Calc user defined functions
|
|
''' or during control events processing
|
|
''' => DebugPrint()
|
|
'''
|
|
''' The usual behaviour of the application when an error occurs is:
|
|
''' 1. Log the error in the console
|
|
''' 2, Inform the user about the error with either a standard or a customized message
|
|
''' 3. Optionally, stop the execution of the current macro
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_exception.html?DbPAR=BASIC
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
' SF_Utils
|
|
Const MISSINGARGERROR = "MISSINGARGERROR"
|
|
Const ARGUMENTERROR = "ARGUMENTERROR"
|
|
Const ARRAYERROR = "ARRAYERROR"
|
|
Const FILEERROR = "FILEERROR"
|
|
|
|
' SF_Array
|
|
Const ARRAYSEQUENCEERROR = "ARRAYSEQUENCEERROR"
|
|
Const ARRAYINSERTERROR = "ARRAYINSERTERROR"
|
|
Const ARRAYINDEX1ERROR = "ARRAYINDEX1ERROR"
|
|
Const ARRAYINDEX2ERROR = "ARRAYINDEX2ERROR"
|
|
Const CSVPARSINGERROR = "CSVPARSINGERROR"
|
|
Const CSVOVERFLOWWARNING = "CSVOVERFLOWWARNING"
|
|
|
|
' SF_Dictionary
|
|
Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR"
|
|
Const UNKNOWNKEYERROR = "UNKNOWNKEYERROR"
|
|
Const INVALIDKEYERROR = "INVALIDKEYERROR"
|
|
|
|
' SF_FileSystem
|
|
Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR"
|
|
Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR"
|
|
Const NOTAFILEERROR = "NOTAFILEERROR"
|
|
Const NOTAFOLDERERROR = "NOTAFOLDERERROR"
|
|
Const OVERWRITEERROR = "OVERWRITEERROR"
|
|
Const READONLYERROR = "READONLYERROR"
|
|
Const NOFILEMATCHERROR = "NOFILEMATCHFOUND"
|
|
Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR"
|
|
Const FILESYSTEMERROR = "FILESYSTEMERROR"
|
|
|
|
' SF_Services
|
|
Const UNKNOWNSERVICEERROR = "UNKNOWNSERVICEERROR"
|
|
Const SERVICESNOTLOADEDERROR = "SERVICESNOTLOADEDERROR"
|
|
|
|
' SF_Session
|
|
Const CALCFUNCERROR = "CALCFUNCERROR"
|
|
Const NOSCRIPTERROR = "NOSCRIPTERROR"
|
|
Const SCRIPTEXECERROR = "SCRIPTEXECERROR"
|
|
Const WRONGEMAILERROR = "WRONGEMAILERROR"
|
|
Const SENDMAILERROR = "SENDMAILERROR"
|
|
|
|
' SF_TextStream
|
|
Const FILENOTOPENERROR = "FILENOTOPENERROR"
|
|
Const FILEOPENMODEERROR = "FILEOPENMODEERROR"
|
|
Const ENDOFFILEERROR = "ENDOFFILEERROR"
|
|
|
|
' SF_UI
|
|
Const DOCUMENTERROR = "DOCUMENTERROR"
|
|
Const DOCUMENTCREATIONERROR = "DOCUMENTCREATIONERROR"
|
|
Const DOCUMENTOPENERROR = "DOCUMENTOPENERROR"
|
|
Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR"
|
|
|
|
' SF_Document
|
|
Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR"
|
|
Const DOCUMENTSAVEERROR = "DOCUMENTSAVEERROR"
|
|
Const DOCUMENTSAVEASERROR = "DOCUMENTSAVEASERROR"
|
|
Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR"
|
|
Const DBCONNECTERROR = "DBCONNECTERROR"
|
|
|
|
' SF_Calc
|
|
Const CALCADDRESSERROR = "CALCADDRESSERROR"
|
|
Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR"
|
|
Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR"
|
|
Const DUPLICATECHARTERROR = "DUPLICATECHARTERROR"
|
|
Const RANGEEXPORTERROR = "RANGEEXPORTERROR"
|
|
|
|
' SF_Chart
|
|
Const CHARTEXPORTERROR = "CHARTEXPORTERROR"
|
|
|
|
' SF_Form
|
|
Const FORMDEADERROR = "FORMDEADERROR"
|
|
Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR"
|
|
Const WRITERFORMNOTFOUNDERROR = "WRITERFORMNOTFOUNDERROR"
|
|
Const BASEFORMNOTFOUNDERROR = "BASEFORMNOTFOUNDERROR"
|
|
Const SUBFORMNOTFOUNDERROR = "SUBFORMNOTFOUNDERROR"
|
|
Const FORMCONTROLTYPEERROR = "FORMCONTROLTYPEERROR"
|
|
|
|
' SF_Dialog
|
|
Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR"
|
|
Const DIALOGDEADERROR = "DIALOGDEADERROR"
|
|
Const CONTROLTYPEERROR = "CONTROLTYPEERROR"
|
|
Const TEXTFIELDERROR = "TEXTFIELDERROR"
|
|
Const PAGEMANAGERERROR = "PAGEMANAGERERROR"
|
|
Const DUPLICATECONTROLERROR = "DUPLICATECONTROLERROR"
|
|
|
|
' SF_Database
|
|
Const DBREADONLYERROR = "DBREADONLYERROR"
|
|
Const SQLSYNTAXERROR = "SQLSYNTAXERROR"
|
|
Const SQLSYNTAX2ERROR = "SQLSYNTAX2ERROR"
|
|
Const NOCURRENTRECORDERROR = "NOCURRENTRECORDERROR"
|
|
Const RECORDUPDATEERROR = "RECORDUPDATEERROR"
|
|
Const FIELDEXPORTERROR = "FIELDEXPORTERROR"
|
|
|
|
' Python
|
|
Const PYTHONSHELLERROR = "PYTHONSHELLERROR"
|
|
|
|
' SF_UnitTest
|
|
Const UNITTESTLIBRARYERROR = "UNITTESTLIBRARYERROR"
|
|
Const UNITTESTMETHODERROR = "UNITTESTMETHODERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
' User defined errors
|
|
Private _Number As Variant ' Error number/code (Integer or String)
|
|
Private _Source As Variant ' Where the error occurred: a module, a Sub/Function, ...
|
|
Private _Description As String ' The error message
|
|
|
|
' System run-time errors
|
|
Private _SysNumber As Long ' Alias of Err
|
|
Private _SysSource As Long ' Alias of Erl
|
|
Private _SysDescription As String ' Alias of Error$
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Const RUNTIMEERRORS = 2000 ' Upper limit of Basic run-time errors
|
|
Const CONSOLENAME = "ConsoleLines" ' Name of control in the console dialog
|
|
|
|
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
Set Dispose = Nothing
|
|
End Function ' ScriptForge.SF_Exception Explicit destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Description() As Variant
|
|
''' Returns the description of the last error that has occurred
|
|
''' Example:
|
|
''' myException.Description
|
|
Description = _PropertyGet("Description")
|
|
End Property ' ScriptForge.SF_Exception.Description (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Description(ByVal pvDescription As Variant)
|
|
''' Set the description of the last error that has occurred
|
|
''' Example:
|
|
''' myException.Description = "Not smart to divide by zero"
|
|
_PropertySet "Description", pvDescription
|
|
End Property ' ScriptForge.SF_Exception.Description (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Number() As Variant
|
|
''' Returns the code of the last error that has occurred
|
|
''' Example:
|
|
''' myException.Number
|
|
Number = _PropertyGet("Number")
|
|
End Property ' ScriptForge.SF_Exception.Number (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Number(ByVal pvNumber As Variant)
|
|
''' Set the code of the last error that has occurred
|
|
''' Example:
|
|
''' myException.Number = 11 ' Division by 0
|
|
_PropertySet "Number", pvNumber
|
|
End Property ' ScriptForge.SF_Exception.Number (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Source() As Variant
|
|
''' Returns the location of the last error that has occurred
|
|
''' Example:
|
|
''' myException.Source
|
|
Source = _PropertyGet("Source")
|
|
End Property ' ScriptForge.SF_Exception.Source (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Source(ByVal pvSource As Variant)
|
|
''' Set the location of the last error that has occurred
|
|
''' Example:
|
|
''' myException.Source = 123 ' Line # 123. Source may also be a string
|
|
_PropertySet "Source", pvSource
|
|
End Property ' ScriptForge.SF_Exception.Source (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ObjectType As String
|
|
''' Only to enable object representation
|
|
ObjectType = "SF_Exception"
|
|
End Property ' ScriptForge.SF_String.ObjectType
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ServiceName As String
|
|
''' Internal use
|
|
ServiceName = "ScriptForge.Exception"
|
|
End Property ' ScriptForge.SF_Exception.ServiceName
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub Clear()
|
|
''' Reset the current error status and clear the SF_Exception object
|
|
''' Args:
|
|
''' Examples:
|
|
''' On Local Error GoTo Catch
|
|
''' ' ...
|
|
''' Catch:
|
|
''' SF_Exception.Clear() ' Deny the error
|
|
|
|
Const cstThisSub = "Exception.Clear"
|
|
Const cstSubArgs = ""
|
|
|
|
Check:
|
|
|
|
Try:
|
|
With SF_Exception
|
|
._Number = Empty
|
|
._Source = Empty
|
|
._Description = ""
|
|
._SysNumber = 0
|
|
._SysSource = 0
|
|
._SysDescription = ""
|
|
End With
|
|
|
|
Finally:
|
|
On Error GoTo 0
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_Exception.Clear
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub Console(Optional ByVal Modal As Variant, _
|
|
Optional ByRef _Context As Variant _
|
|
)
|
|
''' Display the console messages in a modal or non-modal dialog
|
|
''' If the dialog is already active, when non-modal, it is brought to front
|
|
''' Args:
|
|
''' Modal: Boolean. Default = True
|
|
''' _Context: From Python, the XComponentXontext (FOR INTERNAL USE ONLY)
|
|
''' Example:
|
|
''' SF_Exception.Console()
|
|
|
|
Dim bConsoleActive As Boolean ' When True, dialog is active
|
|
Dim oModalBtn As Object ' Modal close button
|
|
Dim oNonModalBtn As Object ' Non modal close button
|
|
Const cstThisSub = "Exception.Console"
|
|
Const cstSubArgs = "[Modal=True]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing
|
|
|
|
Check:
|
|
If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
|
|
If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Modal, "Modal", V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
With _SF_
|
|
bConsoleActive = False
|
|
If Not IsNull(.ConsoleDialog) Then bConsoleActive = .ConsoleDialog._IsStillAlive(False) ' False to not raise an error
|
|
If bConsoleActive And Modal = False Then
|
|
' Bring to front
|
|
.ConsoleDialog.Activate()
|
|
Else
|
|
' Initialize dialog and fill with actual data
|
|
' The dual modes (modal and non-modal) require to have 2 close buttons o/w only 1 is visible
|
|
' - a usual OK button
|
|
' - a Default button triggering the Close action
|
|
Set .ConsoleDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgConsole", _Context)
|
|
' Setup labels and visibility
|
|
Set oModalBtn = .ConsoleDialog.Controls("CloseModalButton")
|
|
Set oNonModalBtn = .ConsoleDialog.Controls("CloseNonModalButton")
|
|
oModalBtn.Visible = Modal
|
|
oNonModalBtn.Visible = CBool(Not Modal)
|
|
' Load console lines
|
|
_ConsoleRefresh()
|
|
.ConsoleDialog.Execute(Modal)
|
|
' Terminate the modal dialog
|
|
If Modal Then
|
|
Set .ConsoleControl = .ConsoleControl.Dispose()
|
|
Set .ConsoleDialog = .ConsoleDialog.Dispose()
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception.Console
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub ConsoleClear(Optional ByVal Keep)
|
|
''' Clear the console keeping an optional number of recent messages
|
|
''' Args:
|
|
''' Keep: the number of messages to keep
|
|
''' If Keep is bigger than the number of messages stored in the console,
|
|
''' the console is not cleared
|
|
''' Example:
|
|
''' SF_Exception.ConsoleClear(5)
|
|
|
|
Dim lConsole As Long ' UBound of ConsoleLines
|
|
Const cstThisSub = "Exception.ConsoleClear"
|
|
Const cstSubArgs = "[Keep=0]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing
|
|
|
|
Check:
|
|
If IsMissing(Keep) Or IsEmpty(Keep) Then Keep = 0
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Keep, "Keep", V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
With _SF_
|
|
If Keep <= 0 Then
|
|
.ConsoleLines = Array()
|
|
Else
|
|
lConsole = UBound(.ConsoleLines)
|
|
If Keep < lConsole + 1 Then .ConsoleLines = SF_Array.Slice(.ConsoleLines, lConsole - Keep + 1)
|
|
End If
|
|
End With
|
|
|
|
' If active, the console dialog needs to be refreshed
|
|
_ConsoleRefresh()
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception.ConsoleClear
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ConsoleToFile(Optional ByVal FileName As Variant) As Boolean
|
|
''' Export the content of the console to a text file
|
|
''' If the file exists and the console is not empty, it is overwritten without warning
|
|
''' Args:
|
|
''' FileName: the complete file name to export to. If it exists, is overwritten without warning
|
|
''' Returns:
|
|
''' True if the file could be created
|
|
''' Examples:
|
|
''' SF_Exception.ConsoleToFile("myFile.txt")
|
|
|
|
Dim bExport As Boolean ' Return value
|
|
Dim oFile As Object ' Output file handler
|
|
Dim sLine As String ' A single line
|
|
Const cstThisSub = "Exception.ConsoleToFile"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bExport = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
|
|
If UBound(_SF_.ConsoleLines) > -1 Then
|
|
Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True)
|
|
If Not IsNull(oFile) Then
|
|
With oFile
|
|
For Each sLine In _SF_.ConsoleLines
|
|
.WriteLine(sLine)
|
|
Next sLine
|
|
.CloseFile()
|
|
End With
|
|
End If
|
|
bExport = True
|
|
End If
|
|
|
|
Finally:
|
|
If Not IsNull(oFile) Then Set oFile = oFile.Dispose()
|
|
ConsoleToFile = bExport
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Exception.ConsoleToFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub DebugDisplay(ParamArray pvArgs() As Variant)
|
|
''' Display the list of arguments in a readable form in a message box
|
|
''' Arguments are separated by a LINEFEED character
|
|
''' The maximum length of each individual argument = 1024 characters
|
|
''' Args:
|
|
''' Any number of arguments of any type
|
|
''' Examples:
|
|
''' SF_Exception.DebugDisplay(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
|
|
|
|
Dim sOutputMsg As String ' Line to display
|
|
Dim sOutputCon As String ' Line to write in console
|
|
Dim sArgMsg As String ' Single argument
|
|
Dim sArgCon As String ' Single argument
|
|
Dim i As Integer
|
|
Const cstTab = 4
|
|
Const cstMaxLength = 1024
|
|
Const cstThisSub = "Exception.DebugDisplay"
|
|
Const cstSubArgs = "Arg0, [Arg1, ...]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
Try:
|
|
' Build new console line
|
|
sOutputMsg = "" : sOutputCon = ""
|
|
For i = 0 To UBound(pvArgs)
|
|
If IsError(pvArgs(i)) Then pvArgs(i) = ""
|
|
sArgMsg = Iif(i = 0, "", SF_String.sfNEWLINE) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent()
|
|
sArgCon = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength)
|
|
sOutputMsg = sOutputMsg & sArgMsg
|
|
sOutputCon = sOutputCon & sArgCon
|
|
Next i
|
|
|
|
' Add to actual console
|
|
_SF_._AddToConsole(SF_String.ExpandTabs(sOutputCon, cstTab))
|
|
' Display the message
|
|
MsgBox(sOutputMsg, MB_OK + MB_ICONINFORMATION, "DebugDisplay")
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception.DebugDisplay
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub DebugPrint(ParamArray pvArgs() As Variant)
|
|
''' Print the list of arguments in a readable form in the console
|
|
''' Arguments are separated by a TAB character (simulated by spaces)
|
|
''' The maximum length of each individual argument = 1024 characters
|
|
''' Args:
|
|
''' Any number of arguments of any type
|
|
''' Examples:
|
|
''' SF_Exception.DebugPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
|
|
|
|
Dim sOutput As String ' Line to write in console
|
|
Dim sArg As String ' Single argument
|
|
Dim i As Integer
|
|
Const cstTab = 4
|
|
Const cstMaxLength = 1024
|
|
Const cstThisSub = "Exception.DebugPrint"
|
|
Const cstSubArgs = "Arg0, [Arg1, ...]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
Try:
|
|
' Build new console line
|
|
sOutput = ""
|
|
For i = 0 To UBound(pvArgs)
|
|
If IsError(pvArgs(i)) Then pvArgs(i) = ""
|
|
sArg = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent()
|
|
sOutput = sOutput & sArg
|
|
Next i
|
|
|
|
' Add to actual console
|
|
_SF_._AddToConsole(SF_String.ExpandTabs(sOutput, cstTab))
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception.DebugPrint
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' If the property does not exist, returns Null
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
''' Examples:
|
|
''' myException.GetProperty("MyProperty")
|
|
|
|
Const cstThisSub = "Exception.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
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:
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Exception.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Exception service as an array
|
|
|
|
Methods = Array( _
|
|
"Clear" _
|
|
, "Console" _
|
|
, "ConsoleClear" _
|
|
, "ConsoleToFile" _
|
|
, "DebugPrint" _
|
|
, "Raise" _
|
|
, "RaiseAbort" _
|
|
, "RaiseFatal" _
|
|
, "RaiseWarning" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_Exception.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Timer class as an array
|
|
|
|
Properties = Array( _
|
|
"Description" _
|
|
, "Number" _
|
|
, "Source" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_Exception.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub PythonPrint(ParamArray pvArgs() As Variant)
|
|
''' Display the list of arguments in a readable form in the Python console
|
|
''' Arguments are separated by a TAB character (simulated by spaces)
|
|
''' The maximum length of each individual argument = 1024 characters
|
|
''' Args:
|
|
''' Any number of arguments of any type
|
|
''' Examples:
|
|
''' SF_Exception.PythonPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
|
|
|
|
Dim sOutput As String ' Line to write in console
|
|
Dim sArg As String ' Single argument
|
|
Dim i As Integer
|
|
Const cstTab = 4
|
|
Const cstMaxLength = 1024
|
|
Const cstPyHelper = "$" & "_SF_Exception__PythonPrint"
|
|
Const cstThisSub = "Exception.PythonPrint"
|
|
Const cstSubArgs = "Arg0, [Arg1, ...]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
Try:
|
|
' Build new console line
|
|
sOutput = ""
|
|
For i = 0 To UBound(pvArgs)
|
|
If IsError(pvArgs(i)) Then pvArgs(i) = ""
|
|
sArg = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength)
|
|
sOutput = sOutput & sArg
|
|
Next i
|
|
|
|
' Add to actual console
|
|
sOutput = SF_String.ExpandTabs(sOutput, cstTab)
|
|
_SF_._AddToConsole(sOutput)
|
|
' Display the message in the Python shell console
|
|
With ScriptForge.SF_Session
|
|
.ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, sOutput)
|
|
End With
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception.PythonPrint
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub Raise(Optional ByVal Number As Variant _
|
|
, Optional ByVal Source As Variant _
|
|
, Optional ByVal Description As Variant _
|
|
)
|
|
''' Generate a run-time error. An error message is displayed to the user and logged
|
|
''' in the console. The execution is STOPPED
|
|
''' Args:
|
|
''' Number: the error number, may be numeric or string
|
|
''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err)
|
|
''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error
|
|
''' Description: the error message to log in the console and to display to the user
|
|
''' Examples:
|
|
''' On Local Error GoTo Catch
|
|
''' ' ...
|
|
''' Catch:
|
|
''' SF_Exception.Raise() ' Standard behaviour
|
|
''' SF_Exception.Raise(11) ' Force division by zero
|
|
''' SF_Exception.Raise("MYAPPERROR", "myFunction", "Application error")
|
|
''' SF_Exception.Raise(,, "To divide by zero is not a good idea !")
|
|
|
|
Dim sMessage As String ' Error message to log and to display
|
|
Dim L10N As Object ' Alias to LocalizedInterface
|
|
Const cstThisSub = "Exception.Raise"
|
|
Const cstSubArgs = "[Number=Err], [Source=Erl], [Description]"
|
|
|
|
' Save Err, Erl, .. values before any On Error ... statement
|
|
SF_Exception._CaptureSystemError()
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Number) Or IsEmpty(Number) Then Number = -1
|
|
If IsMissing(Source) Or IsEmpty(Source) Then Source = -1
|
|
If IsMissing(Description) Or IsEmpty(Description) Then Description = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Description, "Description", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
With SF_Exception
|
|
If Number >= 0 Then .Number = Number
|
|
If VarType(Source) = V_STRING Then
|
|
If Len(Source) > 0 Then .Source = Source
|
|
ElseIf Source >= 0 Then ' -1 = Default => no change
|
|
.Source = Source
|
|
End If
|
|
If Len(Description) > 0 Then .Description = Description
|
|
|
|
' Log and display
|
|
Set L10N = _SF_._GetLocalizedInterface()
|
|
sMessage = L10N.GetText("LONGERRORDESC", .Number, .Source, .Description)
|
|
.DebugPrint(sMessage)
|
|
If _SF_.DisplayEnabled Then MsgBox L10N.GetText("ERRORNUMBER", .Number) _
|
|
& SF_String.sfNewLine & L10N.GetText("ERRORLOCATION", .Source) _
|
|
& SF_String.sfNewLine & .Description _
|
|
, MB_OK + MB_ICONSTOP _
|
|
, L10N.GetText("ERRORNUMBER", .Number)
|
|
.Clear()
|
|
End With
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
If _SF_.StopWhenError Then
|
|
_SF_._StackReset()
|
|
Stop
|
|
End If
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_Exception.Raise
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub RaiseAbort(Optional ByVal Source As Variant)
|
|
''' Manage a run-time error that occurred inside the ScriptForge piece of software itself.
|
|
''' The event is logged.
|
|
''' The execution is STOPPED
|
|
''' For INTERNAL USE only
|
|
''' Args:
|
|
''' Source: the line where the error occurred
|
|
|
|
Dim sLocation As String ' Common header in error messages: location of error
|
|
Dim vLocation As Variant ' Split array (library, module, method)
|
|
Dim sMessage As String ' Error message to log and to display
|
|
Dim L10N As Object ' Alias to LocalizedInterface
|
|
Const cstTabSize = 4
|
|
Const cstThisSub = "Exception.RaiseAbort"
|
|
Const cstSubArgs = "[Source=Erl]"
|
|
|
|
' Save Err, Erl, .. values before any On Error ... statement
|
|
SF_Exception._CaptureSystemError()
|
|
On Local Error Resume Next
|
|
|
|
Check:
|
|
If IsMissing(Source) Or IsEmpty(Source) Then Source = ""
|
|
|
|
Try:
|
|
With SF_Exception
|
|
|
|
' Prepare message header
|
|
Set L10N = _SF_._GetLocalizedInterface()
|
|
If Len(_SF_.MainFunction) > 0 Then ' MainFunction = [Library.]Module.Method
|
|
vLocation = Split(_SF_.MainFunction, ".")
|
|
If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge")
|
|
sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), vLocation(1), vLocation(2)) & "\n\n\n"
|
|
Else
|
|
sLocation = ""
|
|
End If
|
|
|
|
' Log and display
|
|
sMessage = L10N.GetText("LONGERRORDESC", .Number, .Source, .Description)
|
|
.DebugPrint(sMessage)
|
|
If _SF_.DisplayEnabled Then
|
|
sMessage = sLocation _
|
|
& L10N.GetText("INTERNALERROR") _
|
|
& L10N.GetText("ERRORLOCATION", Source & "/" & .Source) & SF_String.sfNewLine & .Description _
|
|
& "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION")
|
|
MsgBox SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _
|
|
, MB_OK + MB_ICONSTOP _
|
|
, L10N.GetText("ERRORNUMBER", .Number)
|
|
End If
|
|
|
|
.Clear()
|
|
End With
|
|
|
|
Finally:
|
|
_SF_._StackReset()
|
|
If _SF_.StopWhenError Then Stop
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_Exception.RaiseAbort
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub RaiseFatal(Optional ByVal ErrorCode As Variant _
|
|
, ParamArray pvArgs _
|
|
)
|
|
''' Generate a run-time error caused by an anomaly in a user script detected by ScriptForge
|
|
''' The message is logged in the console. The execution is STOPPED
|
|
''' For INTERNAL USE only
|
|
''' Args:
|
|
''' ErrorCode: as a string, the unique identifier of the error
|
|
''' pvArgs: the arguments to insert in the error message
|
|
|
|
Dim sLocation As String ' Common header in error messages: location of error
|
|
Dim sService As String ' Service name having detected the error
|
|
Dim sMethod As String ' Method name having detected the error
|
|
Dim vLocation As Variant ' Split array (library, module, method)
|
|
Dim sMessage As String ' Message to log and display
|
|
Dim L10N As Object ' Alias of LocalizedInterface
|
|
Dim sAlt As String ' Alternative error messages
|
|
Dim iButtons As Integer ' MB_OK or MB_YESNO
|
|
Dim iMsgBox As Integer ' Return value of the message box
|
|
|
|
Const cstTabSize = 4
|
|
Const cstThisSub = "Exception.RaiseFatal"
|
|
Const cstSubArgs = "ErrorCode, [Arg0[, Arg1 ...]]"
|
|
Const cstStop = "⏻" ' Chr(9211)
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ErrorCode) Or IsEmpty(ErrorCode) Then ErrorCode = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(ErrorCode, "ErrorCode", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set L10N = _SF_._GetLocalizedInterface()
|
|
' Location header common to all error messages
|
|
If Len(_SF_.MainFunction) > 0 Then ' MainFunction = [Library.]Module.Method
|
|
vLocation = Split(_SF_.MainFunction, ".")
|
|
If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge")
|
|
sService = vLocation(1)
|
|
sMethod = vLocation(2)
|
|
sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), sService, sMethod) _
|
|
& "\n" & L10N.GetText("VALIDATEARGS", _RightCaseArgs(_SF_.MainFunctionArgs))
|
|
Else
|
|
sService = ""
|
|
sMethod = ""
|
|
sLocation = ""
|
|
End If
|
|
|
|
With L10N
|
|
Select Case UCase(ErrorCode)
|
|
Case MISSINGARGERROR ' SF_Utils._Validate(Name)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("VALIDATEMISSING", pvArgs(0))
|
|
Case ARGUMENTERROR ' SF_Utils._Validate(Value, Name, Types, Values, Regex, Class)
|
|
pvArgs(1) = _RightCase(pvArgs(1))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
|
|
& "\n" & "\n" & .GetText("VALIDATIONRULES")
|
|
If Len(pvArgs(2)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATETYPES", pvArgs(1), pvArgs(2))
|
|
If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEVALUES", pvArgs(1), pvArgs(3))
|
|
If Len(pvArgs(4)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEREGEX", pvArgs(1), pvArgs(4))
|
|
If Len(pvArgs(5)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATECLASS", pvArgs(1), pvArgs(5))
|
|
sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
|
|
Case ARRAYERROR ' SF_Utils._ValidateArray(Value, Name, Dimensions, Types, NotNull)
|
|
pvArgs(1) = _RightCase(pvArgs(1))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
|
|
& "\n" & "\n" & .GetText("VALIDATIONRULES") _
|
|
& "\n" & .GetText("VALIDATEARRAY", pvArgs(1))
|
|
If pvArgs(2) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEDIMS", pvArgs(1), pvArgs(2))
|
|
If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEALLTYPES", pvArgs(1), pvArgs(3))
|
|
If pvArgs(4) Then sMessage = sMessage & "\n" & .GetText("VALIDATENOTNULL", pvArgs(1))
|
|
sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
|
|
Case FILEERROR ' SF_Utils._ValidateFile(Value, Name, WildCards)
|
|
pvArgs(1) = _RightCase(pvArgs(1))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
|
|
& "\n" & "\n" & .GetText("VALIDATIONRULES") _
|
|
& "\n" & "\n" & .GetText("VALIDATEFILE", pvArgs(1))
|
|
sAlt = "VALIDATEFILE" & SF_FileSystem.FileNaming
|
|
sMessage = sMessage & "\n" & .GetText(sAlt, pvArgs(1))
|
|
If pvArgs(2) Then sMessage = sMessage & "\n" & .GetText("VALIDATEWILDCARD", pvArgs(1))
|
|
sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
|
|
Case ARRAYSEQUENCEERROR ' SF_Array.RangeInit(From, UpTo, ByStep)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("ARRAYSEQUENCE", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case ARRAYINSERTERROR ' SF_Array.AppendColumn/Row/PrependColumn/Row(VectorName, Array_2D, Vector)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("ARRAYINSERT", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case ARRAYINDEX1ERROR ' SF_Array.ExtractColumn/Row(IndexName, Array_2D, Index)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("ARRAYINDEX1", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case ARRAYINDEX2ERROR ' SF_Array.Slice(From, UpTo)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("ARRAYINDEX2", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case CSVPARSINGERROR ' SF_Array.ImportFromCSVFile(FileName, LineNumber, Line)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("CSVPARSING", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case DUPLICATEKEYERROR ' SF_Dictionary.Add/ReplaceKey("Key", Key)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("DUPLICATEKEY", pvArgs(0), pvArgs(1))
|
|
Case UNKNOWNKEYERROR ' SF_Dictionary.Remove/ReplaceItem/ReplaceKey("Key", Key)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("UNKNOWNKEY", pvArgs(0), pvArgs(1))
|
|
Case INVALIDKEYERROR ' SF_Dictionary.Add/ReplaceKey(Key)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("INVALIDKEY")
|
|
Case UNKNOWNFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile/CreateScriptService("L10N")(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("UNKNOWNFILE", pvArgs(0), pvArgs(1))
|
|
Case UNKNOWNFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("UNKNOWNFOLDER", pvArgs(0), pvArgs(1))
|
|
Case NOTAFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("NOTAFILE", pvArgs(0), pvArgs(1))
|
|
Case NOTAFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("NOTAFOLDER", pvArgs(0), pvArgs(1))
|
|
Case OVERWRITEERROR ' SF_FileSystem.Copy+Move/File+Folder/CreateTextFile/OpenTextFile(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("OVERWRITE", pvArgs(0), pvArgs(1))
|
|
Case READONLYERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("READONLY", pvArgs(0), pvArgs(1))
|
|
Case NOFILEMATCHERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("NOFILEMATCH", pvArgs(0), pvArgs(1))
|
|
Case FOLDERCREATIONERROR ' SF_FileSystem.CreateFolder(ArgName, Filename)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("FOLDERCREATION", pvArgs(0), pvArgs(1))
|
|
Case FILESYSTEMERROR ' SF_FileSystem.---(ArgName, MethodName, ArgValue)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("FILESYSTEM", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case UNKNOWNSERVICEERROR ' SF_Services.CreateScriptService(ArgName, Value, Library, Service)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("UNKNOWNSERVICE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case SERVICESNOTLOADEDERROR ' SF_Services.CreateScriptService(ArgName, Value, Library)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("SERVICESNOTLOADED", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case CALCFUNCERROR ' SF_Session.ExecuteCalcFunction(CalcFunction)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("CalcFunction")) _
|
|
& "\n" & "\n" & .GetText("CALCFUNC", pvArgs(0))
|
|
Case NOSCRIPTERROR ' SF_Session._GetScript(Language, "Scope", Scope, "Script", Script)
|
|
pvArgs(1) = _RightCase(pvArgs(1)) : pvArgs(3) = _RightCase(pvArgs(3))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("Script")) _
|
|
& "\n" & "\n" & .GetText("NOSCRIPT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4))
|
|
Case SCRIPTEXECERROR ' SF_Session.ExecuteBasicScript("Script", Script, Cause)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("SCRIPTEXEC", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case WRONGEMAILERROR ' SF_Session.SendMail(Arg, Email)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("WRONGEMAIL", pvArgs(1))
|
|
Case SENDMAILERROR ' SF_Session.SendMail()
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("SENDMAIL")
|
|
Case FILENOTOPENERROR ' SF_TextStream._IsFileOpen(FileName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("FILENOTOPEN", pvArgs(0))
|
|
Case FILEOPENMODEERROR ' SF_TextStream._IsFileOpen(FileName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("FILEOPENMODE", pvArgs(0), pvArgs(1))
|
|
Case ENDOFFILEERROR ' SF_TextStream.ReadLine/ReadAll/SkipLine(FileName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("ENDOFFILE", pvArgs(0))
|
|
Case DOCUMENTERROR ' SF_UI.GetDocument(ArgName, WindowName)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("DOCUMENT", pvArgs(0), pvArgs(1))
|
|
Case DOCUMENTCREATIONERROR ' SF_UI.Create(Arg1Name, DocumentType, Arg2Name, TemplateFile)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DOCUMENTCREATION", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case DOCUMENTOPENERROR ' SF_UI.OpenDocument(Arg1Name, FileName, Arg2Name, Password, Arg3Name, FilterName)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
|
|
Case BASEDOCUMENTOPENERROR ' SF_UI.OpenBaseDocument(Arg1Name, FileName, Arg2Name, RegistrationName)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("BASEDOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case DOCUMENTDEADERROR ' SF_Document._IsStillAlive(FileName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DOCUMENTDEAD", pvArgs(0))
|
|
Case DOCUMENTSAVEERROR ' SF_Document.Save(Arg1Name, FileName)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DOCUMENTSAVE", pvArgs(0), pvArgs(1))
|
|
Case DOCUMENTSAVEASERROR ' SF_Document.SaveAs(Arg1Name, FileName, Arg2, Overwrite, Arg3, FilterName)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DOCUMENTSAVEAS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
|
|
Case DOCUMENTREADONLYERROR ' SF_Document.update property("Document", FileName)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DOCUMENTREADONLY", pvArgs(0), pvArgs(1))
|
|
Case DBCONNECTERROR ' SF_Base.GetDatabase("User", User, "Password", Password, FileName)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DBCONNECT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4))
|
|
Case CALCADDRESSERROR ' SF_Calc._ParseAddress(Address, "Range"/"Sheet", Scope, Document)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("CALCADDRESS" & Iif(Left(pvArgs(0), 5) = "Sheet", "1", "2"), pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case DUPLICATESHEETERROR ' SF_Calc.InsertSheet(arg, SheetName, Document)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("DUPLICATESHEET", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case OFFSETADDRESSERROR ' SF_Calc.RangeOffset("Range", Range, "Rows", Rows, "Columns", Columns, "Height", Height, "Width", Width, "Document, Document)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
|
|
pvArgs(6) = _RightCase(pvArgs(6)) : pvArgs(8) = _RightCase(pvArgs(8)) : pvArgs(10) = _RightCase(pvArgs(10))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("OFFSETADDRESS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _
|
|
, pvArgs(5), pvArgs(6), pvArgs(7), pvArgs(8), pvArgs(9), pvArgs(10), pvArgs(11))
|
|
Case DUPLICATECHARTERROR ' SF_Calc.CreateChart(chart, ChartName, sheet, SheetName, Document, file)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("DUPLICATECHART", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
|
|
Case RANGEEXPORTERROR ' SF_Calc.ExportRangeToFile(Arg1Name, FileName, Arg2, Overwrite)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("RANGEEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case CHARTEXPORTERROR ' SF_Chart.ExportToFile(Arg1Name, FileName, Arg2, Overwrite)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("CHARTEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case FORMDEADERROR ' SF_Form._IsStillAlive(FormName, DocumentName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("FORMDEAD", pvArgs(0), pvArgs(1))
|
|
Case CALCFORMNOTFOUNDERROR ' SF_Calc.Forms(Index, SheetName, Document)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("CALCFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case WRITERFORMNOTFOUNDERROR ' SF_Document.Forms(Index, Document)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("WRITERFORMNOTFOUND", pvArgs(0), pvArgs(1))
|
|
Case BASEFORMNOTFOUNDERROR ' SF_Base.Forms(Index, FormDocument, BaseDocument)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("BASEFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case SUBFORMNOTFOUNDERROR ' SF_Form.Subforms(Subform, Mainform)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("SUBFORMNOTFOUND", pvArgs(0), pvArgs(1))
|
|
Case FORMCONTROLTYPEERROR ' SF_FormControl._SetProperty(ControlName, FormName, ControlType, Property)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("FORMCONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case DIALOGNOTFOUNDERROR ' SF_Dialog._NewDialog(Service, DialogName, WindowName)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
|
|
pvArgs(6) = _RightCase(pvArgs(6))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DIALOGNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _
|
|
, pvArgs(5), pvArgs(6), pvArgs(7))
|
|
Case DIALOGDEADERROR ' SF_Dialog._IsStillAlive(DialogName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DIALOGDEAD", pvArgs(0))
|
|
Case CONTROLTYPEERROR ' SF_DialogControl._SetProperty(ControlName, DialogName, ControlType, Property)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("CONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case TEXTFIELDERROR ' SF_DialogControl.WriteLine(ControlName, DialogName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("TEXTFIELD", pvArgs(0), pvArgs(1))
|
|
Case PAGEMANAGERERROR ' SF_Dialog.SetPageManager(PilotsList, TabsList, WizardsList)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("PAGEMANAGER", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
|
|
Case DUPLICATECONTROLERROR ' SF_Dialog.CreateControl(ControlName, DialogName)
|
|
pvArgs(0) = _RightCase(pvArgs(0))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
|
|
& "\n" & "\n" & .GetText("DUPLICATECONTROL", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case DBREADONLYERROR ' SF_Database.RunSql(), SF_Dataset.Delete(), Insert(), Update()
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("DBREADONLY", vLocation(2))
|
|
Case SQLSYNTAXERROR ' SF_Database._ExecuteSql(SQL)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("SQLSYNTAX", pvArgs(0))
|
|
Case SQLSYNTAX2ERROR ' SF_Dataset.Reload/_Initialize(SQL, Filter, OrderBy)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("SQLSYNTAX2", pvArgs(0), pvArgs(1), pvArgs(2))
|
|
Case NOCURRENTRECORDERROR ' SF_Dataset.Insert/Update/GetValue/Delete
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("NOCURRENTRECORD")
|
|
Case RECORDUPDATEERROR ' SF_Dataset.Insert/Update(FieldName, FieldValue, FieldType)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("RECORDUPDATE", pvArgs(0), pvArgs(1), pvARgs(2))
|
|
Case FIELDEXPORTERROR ' SF_Dataset.ExportFieldToFile(Arg1Name, FileName, Arg2, Overwrite)
|
|
pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2))
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("FIELDEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
|
|
Case PYTHONSHELLERROR ' SF_Exception.PythonShell (Python only)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("PYTHONSHELL")
|
|
Case UNITTESTLIBRARYERROR ' SFUnitTests._NewUnitTest(LibraryName)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("UNITTESTLIBRARY", pvArgs(0))
|
|
Case UNITTESTMETHODERROR ' SFUnitTests.SF_UnitTest(Method)
|
|
sMessage = sLocation _
|
|
& "\n" & "\n" & .GetText("UNITTESTMETHOD", pvArgs(0))
|
|
Case Else
|
|
End Select
|
|
End With
|
|
|
|
' Log fatal event
|
|
_SF_._AddToConsole(sMessage)
|
|
|
|
' Display fatal event, if relevant (default)
|
|
If _SF_.DisplayEnabled Then
|
|
If _SF_.StopWhenError Then sMessage = sMessage & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION")
|
|
' Do you need more help ?
|
|
If Len(sMethod) > 0 Then
|
|
sMessage = sMessage & "\n" & "\n" & L10N.GetText("NEEDMOREHELP", sMethod)
|
|
iButtons = MB_YESNO + MB_DEFBUTTON2
|
|
Else
|
|
iButtons = MB_OK
|
|
End If
|
|
iMsgBox = MsgBox(SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _
|
|
, iButtons + MB_ICONEXCLAMATION _
|
|
, L10N.GetText("ERRORNUMBER", ErrorCode) _
|
|
)
|
|
' If more help needed ...
|
|
If iMsgBox = IDYES Then _OpenHelpInBrowser(sService, sMethod)
|
|
End If
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
_SF_._StackReset()
|
|
If _SF_.StopWhenError Then Stop
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_Exception.RaiseFatal
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub RaiseWarning(Optional ByVal Number As Variant _
|
|
, Optional ByVal Source As Variant _
|
|
, Optional ByVal Description As Variant _
|
|
)
|
|
''' Generate a run-time error. An error message is displayed to the user and logged
|
|
''' in the console. The execution is NOT STOPPED
|
|
''' Args:
|
|
''' Number: the error number, may be numeric or string
|
|
''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err)
|
|
''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error
|
|
''' Description: the error message to log in the console and to display to the user
|
|
''' Returns:
|
|
''' True if successful. Anyway, the execution continues
|
|
''' Examples:
|
|
''' On Local Error GoTo Catch
|
|
''' ' ...
|
|
''' Catch:
|
|
''' SF_Exception.RaiseWarning() ' Standard behaviour
|
|
''' SF_Exception.RaiseWarning(11) ' Force division by zero
|
|
''' SF_Exception.RaiseWarning("MYAPPERROR", "myFunction", "Application error")
|
|
''' SF_Exception.RaiseWarning(,, "To divide by zero is not a good idea !")
|
|
|
|
Dim bStop As Boolean ' Alias for stop switch
|
|
Const cstThisSub = "Exception.RaiseWarning"
|
|
Const cstSubArgs = "[Number=Err], [Source=Erl], [Description]"
|
|
|
|
' Save Err, Erl, .. values before any On Error ... statement
|
|
SF_Exception._CaptureSystemError()
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Number) Or IsEmpty(Number) Then Number = -1
|
|
If IsMissing(Source) Or IsEmpty(Source) Then Source = -1
|
|
If IsMissing(Description) Or IsEmpty(Description) Then Description = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Description, "Description", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bStop = _SF_.StopWhenError ' Store current value to reset it before leaving the Sub
|
|
_SF_.StopWhenError = False
|
|
SF_Exception.Raise(Number, Source, Description)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
_SF_.StopWhenError = bStop
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_Exception.RaiseWarning
|
|
|
|
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 = "Exception.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:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Exception.SetProperty
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _CaptureSystemError()
|
|
''' Store system error status in system error properties
|
|
''' Called at each invocation of an error management property or method
|
|
''' Reset by SF_Exception.Clear()
|
|
|
|
If Err > 0 And _SysNumber = 0 Then
|
|
_SysNumber = Err
|
|
_SysSource = Erl
|
|
_SysDescription = Error$
|
|
End If
|
|
|
|
End Sub ' ScriptForge.SF_Exception._CaptureSystemError
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _CloseConsole(Optional ByRef poEvent As Object)
|
|
''' Close the console when opened in non-modal mode
|
|
''' Triggered by the CloseNonModalButton from the dlgConsole dialog
|
|
|
|
On Local Error GoTo Finally
|
|
|
|
Try:
|
|
With _SF_
|
|
If Not IsNull(.ConsoleDialog) Then
|
|
If .ConsoleDialog._IsStillAlive(False) Then ' False to not raise an error
|
|
Set .ConsoleControl = .ConsoleControl.Dispose()
|
|
Set .ConsoleDialog = .ConsoleDialog.Dispose()
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception._CloseConsole
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _ConsoleRefresh()
|
|
''' Reload the content of the console in the dialog
|
|
''' Needed when console first loaded or when totally or partially cleared
|
|
|
|
With _SF_
|
|
' Do nothing if console inactive
|
|
If IsNull(.ConsoleDialog) Then GoTo Finally
|
|
If Not .ConsoleDialog._IsStillAlive(False) Then ' False to not generate an error when dead
|
|
Set .ConsoleControl = .ConsoleControl.Dispose()
|
|
Set .ConsoleDialog = Nothing
|
|
GoTo Finally
|
|
End If
|
|
' Store the relevant text in the control
|
|
If IsNull(.ConsoleControl) Then Set .ConsoleControl = .ConsoleDialog.Controls(CONSOLENAME)
|
|
.ConsoleControl.Value = ""
|
|
If UBound(.ConsoleLines) >= 0 Then .ConsoleControl.WriteLine(Join(.ConsoleLines, SF_String.sfNEWLINE))
|
|
End With
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception._ConsoleRefresh
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _OpenHelpInBrowser(ByVal psService As String, ByVal psMethod As String)
|
|
''' Open the help page and help anchor related to the given ScriptForge service and method
|
|
|
|
Dim sUrl As String ' URL to open
|
|
Const cstURL = "https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_%1.html?&DbPAR=BASIC#%2"
|
|
|
|
On Local Error GoTo Finally ' No reason to risk abort here
|
|
Try:
|
|
sUrl = SF_String.ReplaceStr(cstURL, Array("%1", "%2"), Array(LCase(psService), psMethod))
|
|
SF_Session.OpenUrlInBrowser(sUrl)
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' ScriptForge.SF_Exception._OpenHelpInBrowser
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
|
|
''' Return the value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SF_Exception.get" & psProperty
|
|
|
|
SF_Exception._CaptureSystemError()
|
|
|
|
Select Case psProperty
|
|
Case "Description"
|
|
If _Description = "" Then _PropertyGet = _SysDescription Else _PropertyGet = _Description
|
|
Case "Number"
|
|
If IsEmpty(_Number) Then _PropertyGet = _SysNumber Else _PropertyGet = _Number
|
|
Case "Source"
|
|
If IsEmpty(_Source) Then _PropertyGet = _SysSource Else _PropertyGet = _Source
|
|
Case Else
|
|
_PropertyGet = Null
|
|
End Select
|
|
|
|
Finally:
|
|
Exit Function
|
|
End Function ' ScriptForge.SF_Exception._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertySet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvValue As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the named property
|
|
''' Applicable only to user defined errors
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvValue: the new value
|
|
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SF_Exception.set" & psProperty
|
|
_PropertySet = False
|
|
|
|
SF_Exception._CaptureSystemError()
|
|
|
|
' Argument validation must be manual to preserve system error status
|
|
' If wrong VarType then property set is ignored
|
|
Select Case psProperty
|
|
Case "Description"
|
|
If VarType(pvValue) = V_STRING Then _Description = pvValue
|
|
Case "Number"
|
|
Select Case SF_Utils._VarTypeExt(pvValue)
|
|
Case V_STRING
|
|
_Number = pvValue
|
|
Case V_NUMERIC
|
|
_Number = CLng(pvValue)
|
|
If _Number <= RUNTIMEERRORS And Len(_Description) = 0 Then _Description = Error(_Number)
|
|
Case V_EMPTY
|
|
_Number = Empty
|
|
Case Else
|
|
End Select
|
|
Case "Source"
|
|
Select Case SF_Utils._VarTypeExt(pvValue)
|
|
Case V_STRING
|
|
_Source = pvValue
|
|
Case V_NUMERIC
|
|
_Source = CLng(pvValue)
|
|
Case Else
|
|
End Select
|
|
Case Else
|
|
End Select
|
|
|
|
_PropertySet = True
|
|
|
|
Finally:
|
|
Exit Function
|
|
End Function ' ScriptForge.SF_Exception._PropertySet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Exception instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[Exception]: A readable string"
|
|
|
|
_Repr = "[Exception]: " & _Number & " (" & _Description & ")"
|
|
|
|
End Function ' ScriptForge.SF_Exception._Repr
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _RightCase(psString As String) As String
|
|
''' Return the input argument in lower case only when the procedure in execution
|
|
''' has been triggered from a Python script
|
|
''' Indeed, Python requires lower case arguments
|
|
''' Args:
|
|
''' psString: probably an identifier in ProperCase
|
|
''' Return:
|
|
''' The input argument in lower case or left unchanged depending on the execution context
|
|
|
|
Try:
|
|
If _SF_.TriggeredByPython Then _RightCase = LCase(psString) Else _RightCase = psString
|
|
|
|
Finally:
|
|
Exit Function
|
|
End Function ' ScriptForge.SF_Exception._RightCase
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _RightCaseArgs(psString As String) As String
|
|
''' Return the input argument unchanged when the execution context is Basic
|
|
''' When it is Python, the argument names are lowercased.
|
|
''' Args:
|
|
''' psString: one of the cstSubArgs strings located in each official method
|
|
''' Return:
|
|
''' The input string in which the argument names are put in lower case when called from Python scripts
|
|
|
|
Dim sSubArgs As String ' Return value
|
|
Dim vArgs As Variant ' Input string split on the comma character
|
|
Dim sSingleArg As String ' Single vArgs item
|
|
Dim vSingleArgs As Variant ' vSingleArg split on equal sign
|
|
Dim i As Integer
|
|
|
|
Const cstComma = ","
|
|
Const cstEqual = "="
|
|
|
|
Try:
|
|
If Len(psString) = 0 Then
|
|
sSubArgs = ""
|
|
ElseIf _SF_.TriggeredByPython Then
|
|
vArgs = SF_String.SplitNotQuoted(psString, cstComma, QuoteChar := """")
|
|
For i = 0 To UBound(vArgs)
|
|
sSingleArg = vArgs(i)
|
|
vSingleArgs = Split(sSingleArg, cstEqual)
|
|
vSingleArgs(0) = LCase(vSingleArgs(0))
|
|
vArgs(i) = join(vSingleArgs, cstEqual)
|
|
Next i
|
|
sSubArgs = Join(vArgs, cstComma)
|
|
Else
|
|
sSubArgs = psString
|
|
End If
|
|
|
|
Finally:
|
|
_RightCaseArgs = sSubArgs
|
|
Exit Function
|
|
End Function ' ScriptForge.SF_Exception._RightCaseArgs
|
|
|
|
REM ============================================ END OF SCRIPTFORGE.SF_EXCEPTION
|
|
</script:module> |