diff options
Diffstat (limited to '')
| -rw-r--r-- | wizards/source/scriptforge/SF_Exception.xba | 1381 |
1 files changed, 1381 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_Exception.xba b/wizards/source/scriptforge/SF_Exception.xba new file mode 100644 index 000000000..11e97b02b --- /dev/null +++ b/wizards/source/scriptforge/SF_Exception.xba @@ -0,0 +1,1381 @@ +<?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" + +' 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" + +' SF_Database +Const DBREADONLYERROR = "DBREADONLYERROR" +Const SQLSYNTAXERROR = "SQLSYNTAXERROR" + +' 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 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(pvArgs(0) = "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 DBREADONLYERROR ' SF_Database.RunSql() + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DBREADONLY", vLocation(2)) + Case SQLSYNTAXERROR ' SF_Database._ExecuteSql(SQL) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("SQLSYNTAX", pvArgs(0)) + 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>
\ No newline at end of file |