| blob | 6add0b15899041e6d9e4fd3570b9cad9c12687ea |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Exception" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option Explicit
11 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12 ''' Exception (aka SF_Exception)
13 ''' =========
14 ''' Generic singleton class for Basic code debugging and error handling
15 '''
16 ''' Errors may be generated by
17 ''' the Basic run-time error detection
20 ''' an error detection implemented
23 '''
24 ''' When a run-time error occurs, the properties of the Exception object are filled
25 ''' with information that uniquely identifies the error and information that can be used to handle it
26 ''' The SF_Exception object is in this context similar to the VBA Err object
27 ''' See https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/err-object
28 ''' The Number property identifies the error: it can be a numeric value or a string
30 '''
31 ''' The "console" logs events, actual variable values, errors, ... It is an easy mean
32 ''' to debug Basic programs especially when the IDE is not usable, f.i. in Calc user defined functions
33 ''' or during control events processing
35 '''
36 ''' The usual behaviour of the application when an error occurs is:
38 ''' 2, Inform the user about the error with either a standard or a customized message
40 '''
41 ''' Detailed user documentation:
42 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_exception.html?DbPAR=BASIC
43 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
45 REM ================================================================== EXCEPTIONS
47 ' SF_Utils
53 ' SF_Array
61 ' SF_Dictionary
66 ' SF_FileSystem
76 ' SF_Services
80 ' SF_Session
87 ' SF_TextStream
92 ' SF_UI
98 ' SF_Document
105 ' SF_Calc
112 ' SF_Chart
115 ' SF_Form
123 ' SF_Dialog
131 ' SF_Database
135 ' Python
138 ' SF_UnitTest
142 REM ============================================================= PRIVATE MEMBERS
144 ' User defined errors
145 Private _Number As Variant ' Error number/code (Integer or String)
146 Private _Source As Variant ' Where the error occurred: a module, a Sub/Function, ...
147 Private _Description As String ' The error message
149 ' System run-time errors
150 Private _SysNumber As Long ' Alias of Err
151 Private _SysSource As Long ' Alias of Erl
152 Private _SysDescription As String ' Alias of Error$
154 REM ============================================================ MODULE CONSTANTS
159 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
161 REM -----------------------------------------------------------------------------
162 Public Function Dispose() As Variant
163 Set Dispose = Nothing
164 End Function ' ScriptForge.SF_Exception Explicit destructor
166 REM ================================================================== PROPERTIES
168 REM -----------------------------------------------------------------------------
169 Property Get Description() As Variant
170 ''' Returns the description of the last error that has occurred
171 ''' Example:
172 ''' myException.Description
174 End Property ' ScriptForge.SF_Exception.Description (get)
176 REM -----------------------------------------------------------------------------
177 Property Let Description(ByVal pvDescription As Variant)
178 ''' Set the description of the last error that has occurred
179 ''' Example:
182 End Property ' ScriptForge.SF_Exception.Description (let)
184 REM -----------------------------------------------------------------------------
185 Property Get Number() As Variant
186 ''' Returns the code of the last error that has occurred
187 ''' Example:
188 ''' myException.Number
190 End Property ' ScriptForge.SF_Exception.Number (get)
192 REM -----------------------------------------------------------------------------
193 Property Let Number(ByVal pvNumber As Variant)
194 ''' Set the code of the last error that has occurred
195 ''' Example:
198 End Property ' ScriptForge.SF_Exception.Number (let)
200 REM -----------------------------------------------------------------------------
201 Property Get Source() As Variant
202 ''' Returns the location of the last error that has occurred
203 ''' Example:
204 ''' myException.Source
206 End Property ' ScriptForge.SF_Exception.Source (get)
208 REM -----------------------------------------------------------------------------
209 Property Let Source(ByVal pvSource As Variant)
210 ''' Set the location of the last error that has occurred
211 ''' Example:
214 End Property ' ScriptForge.SF_Exception.Source (let)
216 REM -----------------------------------------------------------------------------
217 Property Get ObjectType As String
218 ''' Only to enable object representation
220 End Property ' ScriptForge.SF_String.ObjectType
222 REM -----------------------------------------------------------------------------
223 Property Get ServiceName As String
224 ''' Internal use
226 End Property ' ScriptForge.SF_Exception.ServiceName
228 REM ===================================================================== METHODS
230 REM -----------------------------------------------------------------------------
231 Public Sub Clear()
232 ''' Reset the current error status and clear the SF_Exception object
233 ''' Args:
234 ''' Examples:
235 ''' On Local Error GoTo Catch
236 ''' ' ...
237 ''' Catch:
241 Const cstSubArgs = ""
243 Check:
245 Try:
246 With SF_Exception
247 ._Number = Empty
248 ._Source = Empty
249 ._Description = ""
250 ._SysNumber = 0
251 ._SysSource = 0
252 ._SysDescription = ""
253 End With
255 Finally:
256 On Error GoTo 0
257 Exit Sub
258 Catch:
259 GoTo Finally
260 End Sub ' ScriptForge.SF_Exception.Clear
262 REM -----------------------------------------------------------------------------
263 Public Sub Console(Optional ByVal Modal As Variant, _
264 Optional ByRef _Context As Variant _
265 )
266 ''' Display the console messages in a modal or non-modal dialog
267 ''' If the dialog is already active, when non-modal, it is brought to front
268 ''' Args:
269 ''' Modal: Boolean. Default = True
270 ''' _Context: From Python, the XComponentXontext (FOR INTERNAL USE ONLY)
271 ''' Example:
272 ''' SF_Exception.Console()
274 Dim bConsoleActive As Boolean ' When True, dialog is active
275 Dim oModalBtn As Object ' Modal close button
276 Dim oNonModalBtn As Object ' Non modal close button
280 If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing
282 Check:
283 If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
284 If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing
285 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
287 End If
289 Try:
290 With _SF_
291 bConsoleActive = False
292 If Not IsNull(.ConsoleDialog) Then bConsoleActive = .ConsoleDialog._IsStillAlive(False) ' False to not raise an error
293 If bConsoleActive And Modal = False Then
294 ' Bring to front
295 .ConsoleDialog.Activate()
296 Else
297 ' Initialize dialog and fill with actual data
298 ' The dual modes (modal and non-modal) require to have 2 close buttons o/w only 1 is visible
299 ' - a usual OK button
300 ' - a Default button triggering the Close action
301 Set .ConsoleDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgConsole", _Context)
302 ' Setup labels and visibility
305 oModalBtn.Visible = Modal
306 oNonModalBtn.Visible = CBool(Not Modal)
307 ' Load console lines
308 _ConsoleRefresh()
309 .ConsoleDialog.Execute(Modal)
310 ' Terminate the modal dialog
311 If Modal Then
312 Set .ConsoleControl = .ConsoleControl.Dispose()
313 Set .ConsoleDialog = .ConsoleDialog.Dispose()
314 End If
315 End If
316 End With
318 Finally:
319 SF_Utils._ExitFunction(cstThisSub)
320 Exit Sub
321 End Sub ' ScriptForge.SF_Exception.Console
323 REM -----------------------------------------------------------------------------
324 Public Sub ConsoleClear(Optional ByVal Keep)
325 ''' Clear the console keeping an optional number of recent messages
326 ''' Args:
327 ''' Keep: the number of messages to keep
328 ''' If Keep is bigger than the number of messages stored in the console,
329 ''' the console is not cleared
330 ''' Example:
333 Dim lConsole As Long ' UBound of ConsoleLines
337 If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing
339 Check:
340 If IsMissing(Keep) Or IsEmpty(Keep) Then Keep = 0
341 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
343 End If
345 Try:
346 With _SF_
348 .ConsoleLines = Array()
349 Else
350 lConsole = UBound(.ConsoleLines)
351 If Keep < lConsole + 1 Then .ConsoleLines = SF_Array.Slice(.ConsoleLines, lConsole - Keep + 1)
352 End If
353 End With
355 ' If active, the console dialog needs to be refreshed
356 _ConsoleRefresh()
358 Finally:
359 SF_Utils._ExitFunction(cstThisSub)
360 Exit Sub
361 End Sub ' ScriptForge.SF_Exception.ConsoleClear
363 REM -----------------------------------------------------------------------------
364 Public Function ConsoleToFile(Optional ByVal FileName As Variant) As Boolean
365 ''' Export the content of the console to a text file
366 ''' If the file exists and the console is not empty, it is overwritten without warning
367 ''' Args:
368 ''' FileName: the complete file name to export to. If it exists, is overwritten without warning
369 ''' Returns:
370 ''' True if the file could be created
371 ''' Examples:
374 Dim bExport As Boolean ' Return value
375 Dim oFile As Object ' Output file handler
376 Dim sLine As String ' A single line
380 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
381 bExport = False
383 Check:
384 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
386 End If
388 Try:
391 Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True)
392 If Not IsNull(oFile) Then
393 With oFile
394 For Each sLine In _SF_.ConsoleLines
395 .WriteLine(sLine)
396 Next sLine
397 .CloseFile()
398 End With
399 End If
400 bExport = True
401 End If
403 Finally:
404 If Not IsNull(oFile) Then Set oFile = oFile.Dispose()
405 ConsoleToFile = bExport
406 SF_Utils._ExitFunction(cstThisSub)
407 Exit Function
408 Catch:
409 GoTo Finally
410 End Function ' ScriptForge.SF_Exception.ConsoleToFile
412 REM -----------------------------------------------------------------------------
413 Public Sub DebugDisplay(ParamArray pvArgs() As Variant)
414 ''' Display the list of arguments in a readable form in a message box
415 ''' Arguments are separated by a LINEFEED character
417 ''' Args:
418 ''' Any number of arguments of any type
419 ''' Examples:
420 ''' SF_Exception.DebugDisplay(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
422 Dim sOutputMsg As String ' Line to display
423 Dim sOutputCon As String ' Line to write in console
424 Dim sArgMsg As String ' Single argument
425 Dim sArgCon As String ' Single argument
426 Dim i As Integer
427 Const cstTab = 4
428 Const cstMaxLength = 1024
432 If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
433 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
434 Try:
435 ' Build new console line
437 For i = 0 To UBound(pvArgs)
438 If IsError(pvArgs(i)) Then pvArgs(i) = ""
439 sArgMsg = Iif(i = 0, "", SF_String.sfNEWLINE) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent()
440 sArgCon = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength)
441 sOutputMsg = sOutputMsg & sArgMsg
442 sOutputCon = sOutputCon & sArgCon
443 Next i
445 ' Add to actual console
446 _SF_._AddToConsole(SF_String.ExpandTabs(sOutputCon, cstTab))
447 ' Display the message
450 Finally:
451 SF_Utils._ExitFunction(cstThisSub)
452 Exit Sub
453 End Sub ' ScriptForge.SF_Exception.DebugDisplay
455 REM -----------------------------------------------------------------------------
456 Public Sub DebugPrint(ParamArray pvArgs() As Variant)
457 ''' Print the list of arguments in a readable form in the console
458 ''' Arguments are separated by a TAB character (simulated by spaces)
460 ''' Args:
461 ''' Any number of arguments of any type
462 ''' Examples:
463 ''' SF_Exception.DebugPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
465 Dim sOutput As String ' Line to write in console
466 Dim sArg As String ' Single argument
467 Dim i As Integer
468 Const cstTab = 4
469 Const cstMaxLength = 1024
473 If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
474 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
475 Try:
476 ' Build new console line
477 sOutput = ""
478 For i = 0 To UBound(pvArgs)
479 If IsError(pvArgs(i)) Then pvArgs(i) = ""
480 sArg = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent()
481 sOutput = sOutput & sArg
482 Next i
484 ' Add to actual console
485 _SF_._AddToConsole(SF_String.ExpandTabs(sOutput, cstTab))
487 Finally:
488 SF_Utils._ExitFunction(cstThisSub)
489 Exit Sub
490 End Sub ' ScriptForge.SF_Exception.DebugPrint
492 REM -----------------------------------------------------------------------------
493 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
494 ''' Return the actual value of the given property
495 ''' Args:
496 ''' PropertyName: the name of the property as a string
497 ''' Returns:
498 ''' The actual value of the property
499 ''' If the property does not exist, returns Null
500 ''' Exceptions
501 ''' ARGUMENTERROR The property does not exist
502 ''' Examples:
506 Const cstSubArgs = ""
508 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
509 GetProperty = Null
511 Check:
512 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
513 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
514 End If
516 Try:
517 GetProperty = _PropertyGet(PropertyName)
519 Finally:
520 SF_Utils._ExitFunction(cstThisSub)
521 Exit Function
522 Catch:
523 GoTo Finally
524 End Function ' ScriptForge.SF_Exception.GetProperty
526 REM -----------------------------------------------------------------------------
527 Public Function Methods() As Variant
528 ''' Return the list of public methods of the Exception service as an array
530 Methods = Array( _
540 )
542 End Function ' ScriptForge.SF_Exception.Methods
544 REM -----------------------------------------------------------------------------
545 Public Function Properties() As Variant
546 ''' Return the list or properties of the Timer class as an array
548 Properties = Array( _
552 )
554 End Function ' ScriptForge.SF_Exception.Properties
556 REM -----------------------------------------------------------------------------
557 Public Sub PythonPrint(ParamArray pvArgs() As Variant)
558 ''' Display the list of arguments in a readable form in the Python console
559 ''' Arguments are separated by a TAB character (simulated by spaces)
561 ''' Args:
562 ''' Any number of arguments of any type
563 ''' Examples:
564 ''' SF_Exception.PythonPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
566 Dim sOutput As String ' Line to write in console
567 Dim sArg As String ' Single argument
568 Dim i As Integer
569 Const cstTab = 4
570 Const cstMaxLength = 1024
575 If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
576 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
577 Try:
578 ' Build new console line
579 sOutput = ""
580 For i = 0 To UBound(pvArgs)
581 If IsError(pvArgs(i)) Then pvArgs(i) = ""
583 sOutput = sOutput & sArg
584 Next i
586 ' Add to actual console
587 sOutput = SF_String.ExpandTabs(sOutput, cstTab)
588 _SF_._AddToConsole(sOutput)
589 ' Display the message in the Python shell console
590 With ScriptForge.SF_Session
591 .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, sOutput)
592 End With
594 Finally:
595 SF_Utils._ExitFunction(cstThisSub)
596 Exit Sub
597 End Sub ' ScriptForge.SF_Exception.PythonPrint
599 REM -----------------------------------------------------------------------------
600 Public Sub Raise(Optional ByVal Number As Variant _
601 , Optional ByVal Source As Variant _
602 , Optional ByVal Description As Variant _
603 )
604 ''' Generate a run-time error. An error message is displayed to the user and logged
605 ''' in the console. The execution is STOPPED
606 ''' Args:
607 ''' Number: the error number, may be numeric or string
608 ''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err)
609 ''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error
610 ''' Description: the error message to log in the console and to display to the user
611 ''' Examples:
612 ''' On Local Error GoTo Catch
613 ''' ' ...
614 ''' Catch:
617 ''' SF_Exception.Raise("MYAPPERROR", "myFunction", "Application error")
620 Dim sMessage As String ' Error message to log and to display
621 Dim L10N As Object ' Alias to LocalizedInterface
625 ' Save Err, Erl, .. values before any On Error ... statement
626 SF_Exception._CaptureSystemError()
627 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
629 Check:
630 If IsMissing(Number) Or IsEmpty(Number) Then Number = -1
631 If IsMissing(Source) Or IsEmpty(Source) Then Source = -1
632 If IsMissing(Description) Or IsEmpty(Description) Then Description = ""
633 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
634 If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
635 If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
637 End If
639 Try:
640 With SF_Exception
642 If VarType(Source) = V_STRING Then
645 .Source = Source
646 End If
649 ' Log and display
650 Set L10N = _SF_._GetLocalizedInterface()
652 .DebugPrint(sMessage)
656 , MB_OK + MB_ICONSTOP _
658 .Clear()
659 End With
661 Finally:
662 SF_Utils._ExitFunction(cstThisSub)
663 If _SF_.StopWhenError Then
664 _SF_._StackReset()
665 Stop
666 End If
667 Exit Sub
668 Catch:
669 GoTo Finally
670 End Sub ' ScriptForge.SF_Exception.Raise
672 REM -----------------------------------------------------------------------------
673 Public Sub RaiseAbort(Optional ByVal Source As Variant)
674 ''' Manage a run-time error that occurred inside the ScriptForge piece of software itself.
675 ''' The event is logged.
676 ''' The execution is STOPPED
677 ''' For INTERNAL USE only
678 ''' Args:
679 ''' Source: the line where the error occurred
681 Dim sLocation As String ' Common header in error messages: location of error
682 Dim vLocation As Variant ' Split array (library, module, method)
683 Dim sMessage As String ' Error message to log and to display
684 Dim L10N As Object ' Alias to LocalizedInterface
685 Const cstTabSize = 4
689 ' Save Err, Erl, .. values before any On Error ... statement
690 SF_Exception._CaptureSystemError()
691 On Local Error Resume Next
693 Check:
694 If IsMissing(Source) Or IsEmpty(Source) Then Source = ""
696 Try:
697 With SF_Exception
699 ' Prepare message header
700 Set L10N = _SF_._GetLocalizedInterface()
703 If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge")
704 sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), vLocation(1), vLocation(2)) & "\n\n\n"
705 Else
706 sLocation = ""
707 End If
709 ' Log and display
711 .DebugPrint(sMessage)
712 If _SF_.DisplayEnabled Then
713 sMessage = sLocation _
715 & L10N.GetText("ERRORLOCATION", Source & "/" & .Source) & SF_String.sfNewLine & .Description _
716 & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION")
717 MsgBox SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _
718 , MB_OK + MB_ICONSTOP _
720 End If
722 .Clear()
723 End With
725 Finally:
726 _SF_._StackReset()
727 If _SF_.StopWhenError Then Stop
728 Exit Sub
729 Catch:
730 GoTo Finally
731 End Sub ' ScriptForge.SF_Exception.RaiseAbort
733 REM -----------------------------------------------------------------------------
734 Public Sub RaiseFatal(Optional ByVal ErrorCode As Variant _
735 , ParamArray pvArgs _
736 )
737 ''' Generate a run-time error caused by an anomaly in a user script detected by ScriptForge
738 ''' The message is logged in the console. The execution is STOPPED
739 ''' For INTERNAL USE only
740 ''' Args:
741 ''' ErrorCode: as a string, the unique identifier of the error
742 ''' pvArgs: the arguments to insert in the error message
744 Dim sLocation As String ' Common header in error messages: location of error
745 Dim sService As String ' Service name having detected the error
746 Dim sMethod As String ' Method name having detected the error
747 Dim vLocation As Variant ' Split array (library, module, method)
748 Dim sMessage As String ' Message to log and display
749 Dim L10N As Object ' Alias of LocalizedInterface
750 Dim sAlt As String ' Alternative error messages
751 Dim iButtons As Integer ' MB_OK or MB_YESNO
752 Dim iMsgBox As Integer ' Return value of the message box
754 Const cstTabSize = 4
759 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
761 Check:
762 If IsMissing(ErrorCode) Or IsEmpty(ErrorCode) Then ErrorCode = ""
763 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
765 End If
767 Try:
768 Set L10N = _SF_._GetLocalizedInterface()
769 ' Location header common to all error messages
772 If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge")
773 sService = vLocation(1)
774 sMethod = vLocation(2)
776 & "\n" & L10N.GetText("VALIDATEARGS", _RightCaseArgs(_SF_.MainFunctionArgs))
777 Else
778 sService = ""
779 sMethod = ""
780 sLocation = ""
781 End If
783 With L10N
784 Select Case UCase(ErrorCode)
785 Case MISSINGARGERROR ' SF_Utils._Validate(Name)
787 sMessage = sLocation _
788 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
789 & "\n" & "\n" & .GetText("VALIDATEMISSING", pvArgs(0))
790 Case ARGUMENTERROR ' SF_Utils._Validate(Value, Name, Types, Values, Regex, Class)
792 sMessage = sLocation _
793 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
795 If Len(pvArgs(2)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATETYPES", pvArgs(1), pvArgs(2))
796 If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEVALUES", pvArgs(1), pvArgs(3))
797 If Len(pvArgs(4)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEREGEX", pvArgs(1), pvArgs(4))
798 If Len(pvArgs(5)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATECLASS", pvArgs(1), pvArgs(5))
799 sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
800 Case ARRAYERROR ' SF_Utils._ValidateArray(Value, Name, Dimensions, Types, NotNull)
802 sMessage = sLocation _
803 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
806 If pvArgs(2) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEDIMS", pvArgs(1), pvArgs(2))
807 If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEALLTYPES", pvArgs(1), pvArgs(3))
808 If pvArgs(4) Then sMessage = sMessage & "\n" & .GetText("VALIDATENOTNULL", pvArgs(1))
809 sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
810 Case FILEERROR ' SF_Utils._ValidateFile(Value, Name, WildCards)
812 sMessage = sLocation _
813 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
818 If pvArgs(2) Then sMessage = sMessage & "\n" & .GetText("VALIDATEWILDCARD", pvArgs(1))
819 sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
820 Case ARRAYSEQUENCEERROR ' SF_Array.RangeInit(From, UpTo, ByStep)
821 sMessage = sLocation _
822 & "\n" & "\n" & "\n" & .GetText("ARRAYSEQUENCE", pvArgs(0), pvArgs(1), pvArgs(2))
823 Case ARRAYINSERTERROR ' SF_Array.AppendColumn/Row/PrependColumn/Row(VectorName, Array_2D, Vector)
824 sMessage = sLocation _
825 & "\n" & "\n" & "\n" & .GetText("ARRAYINSERT", pvArgs(0), pvArgs(1), pvArgs(2))
826 Case ARRAYINDEX1ERROR ' SF_Array.ExtractColumn/Row(IndexName, Array_2D, Index)
827 sMessage = sLocation _
828 & "\n" & "\n" & "\n" & .GetText("ARRAYINDEX1", pvArgs(0), pvArgs(1), pvArgs(2))
829 Case ARRAYINDEX2ERROR ' SF_Array.Slice(From, UpTo)
830 sMessage = sLocation _
831 & "\n" & "\n" & "\n" & .GetText("ARRAYINDEX2", pvArgs(0), pvArgs(1), pvArgs(2))
832 Case CSVPARSINGERROR ' SF_Array.ImportFromCSVFile(FileName, LineNumber, Line)
833 sMessage = sLocation _
834 & "\n" & "\n" & "\n" & .GetText("CSVPARSING", pvArgs(0), pvArgs(1), pvArgs(2))
836 sMessage = sLocation _
837 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
838 & "\n" & "\n" & .GetText("DUPLICATEKEY", pvArgs(0), pvArgs(1))
840 sMessage = sLocation _
841 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
842 & "\n" & "\n" & .GetText("UNKNOWNKEY", pvArgs(0), pvArgs(1))
843 Case INVALIDKEYERROR ' SF_Dictionary.Add/ReplaceKey(Key)
844 sMessage = sLocation _
845 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
847 Case UNKNOWNFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile/CreateScriptService("L10N")(ArgName, Filename)
849 sMessage = sLocation _
850 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
851 & "\n" & "\n" & .GetText("UNKNOWNFILE", pvArgs(0), pvArgs(1))
852 Case UNKNOWNFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename)
854 sMessage = sLocation _
855 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
856 & "\n" & "\n" & .GetText("UNKNOWNFOLDER", pvArgs(0), pvArgs(1))
857 Case NOTAFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile(ArgName, Filename)
859 sMessage = sLocation _
860 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
861 & "\n" & "\n" & .GetText("NOTAFILE", pvArgs(0), pvArgs(1))
862 Case NOTAFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename)
864 sMessage = sLocation _
865 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
866 & "\n" & "\n" & .GetText("NOTAFOLDER", pvArgs(0), pvArgs(1))
867 Case OVERWRITEERROR ' SF_FileSystem.Copy+Move/File+Folder/CreateTextFile/OpenTextFile(ArgName, Filename)
869 sMessage = sLocation _
870 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
871 & "\n" & "\n" & .GetText("OVERWRITE", pvArgs(0), pvArgs(1))
872 Case READONLYERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename)
874 sMessage = sLocation _
875 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
876 & "\n" & "\n" & .GetText("READONLY", pvArgs(0), pvArgs(1))
877 Case NOFILEMATCHERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename)
879 sMessage = sLocation _
880 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
881 & "\n" & "\n" & .GetText("NOFILEMATCH", pvArgs(0), pvArgs(1))
882 Case FOLDERCREATIONERROR ' SF_FileSystem.CreateFolder(ArgName, Filename)
884 sMessage = sLocation _
885 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
886 & "\n" & "\n" & .GetText("FOLDERCREATION", pvArgs(0), pvArgs(1))
887 Case UNKNOWNSERVICEERROR ' SF_Services.CreateScriptService(ArgName, Value, Library, Service)
889 sMessage = sLocation _
890 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
891 & "\n" & "\n" & .GetText("UNKNOWNSERVICE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
892 Case SERVICESNOTLOADEDERROR ' SF_Services.CreateScriptService(ArgName, Value, Library)
894 sMessage = sLocation _
895 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
896 & "\n" & "\n" & .GetText("SERVICESNOTLOADED", pvArgs(0), pvArgs(1), pvArgs(2))
897 Case CALCFUNCERROR ' SF_Session.ExecuteCalcFunction(CalcFunction)
898 sMessage = sLocation _
899 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("CalcFunction")) _
901 Case NOSCRIPTERROR ' SF_Session._GetScript(Language, "Scope", Scope, "Script", Script)
903 sMessage = sLocation _
904 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("Script")) _
905 & "\n" & "\n" & .GetText("NOSCRIPT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4))
908 sMessage = sLocation _
909 & "\n" & "\n" & .GetText("SCRIPTEXEC", pvArgs(0), pvArgs(1), pvArgs(2))
910 Case WRONGEMAILERROR ' SF_Session.SendMail(Arg, Email)
912 sMessage = sLocation _
913 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
915 Case SENDMAILERROR ' SF_Session.SendMail()
916 sMessage = sLocation _
918 Case FILENOTOPENERROR ' SF_TextStream._IsFileOpen(FileName)
919 sMessage = sLocation _
921 Case FILEOPENMODEERROR ' SF_TextStream._IsFileOpen(FileName)
922 sMessage = sLocation _
923 & "\n" & "\n" & .GetText("FILEOPENMODE", pvArgs(0), pvArgs(1))
924 Case ENDOFFILEERROR ' SF_TextStream.ReadLine/ReadAll/SkipLine(FileName)
925 sMessage = sLocation _
927 Case DOCUMENTERROR ' SF_UI.GetDocument(ArgName, WindowName)
929 sMessage = sLocation _
930 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
931 & "\n" & "\n" & .GetText("DOCUMENT", pvArgs(0), pvArgs(1))
932 Case DOCUMENTCREATIONERROR ' SF_UI.Create(Arg1Name, DocumentType, Arg2Name, TemplateFile)
934 sMessage = sLocation _
935 & "\n" & "\n" & .GetText("DOCUMENTCREATION", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
936 Case DOCUMENTOPENERROR ' SF_UI.OpenDocument(Arg1Name, FileName, Arg2Name, Password, Arg3Name, FilterName)
937 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
938 sMessage = sLocation _
939 & "\n" & "\n" & .GetText("DOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
940 Case BASEDOCUMENTOPENERROR ' SF_UI.OpenBaseDocument(Arg1Name, FileName, Arg2Name, RegistrationName)
942 sMessage = sLocation _
943 & "\n" & "\n" & .GetText("BASEDOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
944 Case DOCUMENTDEADERROR ' SF_Document._IsStillAlive(FileName)
945 sMessage = sLocation _
947 Case DOCUMENTSAVEERROR ' SF_Document.Save(Arg1Name, FileName)
949 sMessage = sLocation _
950 & "\n" & "\n" & .GetText("DOCUMENTSAVE", pvArgs(0), pvArgs(1))
951 Case DOCUMENTSAVEASERROR ' SF_Document.SaveAs(Arg1Name, FileName, Arg2, Overwrite, Arg3, FilterName)
952 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
953 sMessage = sLocation _
954 & "\n" & "\n" & .GetText("DOCUMENTSAVEAS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
957 sMessage = sLocation _
958 & "\n" & "\n" & .GetText("DOCUMENTREADONLY", pvArgs(0), pvArgs(1))
959 Case DBCONNECTERROR ' SF_Base.GetDatabase("User", User, "Password", Password, FileName)
961 sMessage = sLocation _
962 & "\n" & "\n" & .GetText("DBCONNECT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4))
963 Case CALCADDRESSERROR ' SF_Calc._ParseAddress(Address, "Range"/"Sheet", Scope, Document)
965 sMessage = sLocation _
966 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
967 & "\n" & "\n" & .GetText("CALCADDRESS" & Iif(Left(pvArgs(0), 5) = "Sheet", "1", "2"), pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
968 Case DUPLICATESHEETERROR ' SF_Calc.InsertSheet(arg, SheetName, Document)
970 sMessage = sLocation _
971 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
972 & "\n" & "\n" & .GetText("DUPLICATESHEET", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
973 Case OFFSETADDRESSERROR ' SF_Calc.RangeOffset("Range", Range, "Rows", Rows, "Columns", Columns, "Height", Height, "Width", Width, "Document, Document)
974 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
975 pvArgs(6) = _RightCase(pvArgs(6)) : pvArgs(8) = _RightCase(pvArgs(8)) : pvArgs(10) = _RightCase(pvArgs(10))
976 sMessage = sLocation _
977 & "\n" & "\n" & .GetText("OFFSETADDRESS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _
979 Case DUPLICATECHARTERROR ' SF_Calc.CreateChart(chart, ChartName, sheet, SheetName, Document, file)
981 sMessage = sLocation _
982 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
983 & "\n" & "\n" & .GetText("DUPLICATECHART", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
984 Case RANGEEXPORTERROR ' SF_Calc.ExportRangeToFile(Arg1Name, FileName, Arg2, Overwrite)
986 sMessage = sLocation _
987 & "\n" & "\n" & .GetText("RANGEEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
988 Case CHARTEXPORTERROR ' SF_Chart.ExportToFile(Arg1Name, FileName, Arg2, Overwrite)
990 sMessage = sLocation _
991 & "\n" & "\n" & .GetText("CHARTEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
992 Case FORMDEADERROR ' SF_Form._IsStillAlive(FormName, DocumentName)
993 sMessage = sLocation _
994 & "\n" & "\n" & .GetText("FORMDEAD", pvArgs(0), pvArgs(1))
995 Case CALCFORMNOTFOUNDERROR ' SF_Calc.Forms(Index, SheetName, Document)
996 sMessage = sLocation _
997 & "\n" & "\n" & .GetText("CALCFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2))
998 Case WRITERFORMNOTFOUNDERROR ' SF_Document.Forms(Index, Document)
999 sMessage = sLocation _
1000 & "\n" & "\n" & .GetText("WRITERFORMNOTFOUND", pvArgs(0), pvArgs(1))
1001 Case BASEFORMNOTFOUNDERROR ' SF_Base.Forms(Index, FormDocument, BaseDocument)
1002 sMessage = sLocation _
1003 & "\n" & "\n" & .GetText("BASEFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2))
1004 Case SUBFORMNOTFOUNDERROR ' SF_Form.Subforms(Subform, Mainform)
1005 sMessage = sLocation _
1006 & "\n" & "\n" & .GetText("SUBFORMNOTFOUND", pvArgs(0), pvArgs(1))
1007 Case FORMCONTROLTYPEERROR ' SF_FormControl._SetProperty(ControlName, FormName, ControlType, Property)
1008 sMessage = sLocation _
1009 & "\n" & "\n" & .GetText("FORMCONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
1010 Case DIALOGNOTFOUNDERROR ' SF_Dialog._NewDialog(Service, DialogName, WindowName)
1011 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
1013 sMessage = sLocation _
1014 & "\n" & "\n" & .GetText("DIALOGNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _
1016 Case DIALOGDEADERROR ' SF_Dialog._IsStillAlive(DialogName)
1017 sMessage = sLocation _
1019 Case CONTROLTYPEERROR ' SF_DialogControl._SetProperty(ControlName, DialogName, ControlType, Property)
1020 sMessage = sLocation _
1021 & "\n" & "\n" & .GetText("CONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
1022 Case TEXTFIELDERROR ' SF_DialogControl.WriteLine(ControlName, DialogName)
1023 sMessage = sLocation _
1024 & "\n" & "\n" & .GetText("TEXTFIELD", pvArgs(0), pvArgs(1))
1025 Case PAGEMANAGERERROR ' SF_Dialog.SetPageManager(PilotsList, TabsList, WizardsList)
1026 sMessage = sLocation _
1027 & "\n" & "\n" & .GetText("PAGEMANAGER", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
1028 Case DUPLICATECONTROLERROR ' SF_Dialog.CreateControl(ControlName, DialogName)
1030 sMessage = sLocation _
1031 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
1032 & "\n" & "\n" & .GetText("DUPLICATECONTROL", pvArgs(0), pvArgs(1), pvArgs(2))
1033 Case DBREADONLYERROR ' SF_Database.RunSql()
1034 sMessage = sLocation _
1036 Case SQLSYNTAXERROR ' SF_Database._ExecuteSql(SQL)
1037 sMessage = sLocation _
1039 Case PYTHONSHELLERROR ' SF_Exception.PythonShell (Python only)
1040 sMessage = sLocation _
1042 Case UNITTESTLIBRARYERROR ' SFUnitTests._NewUnitTest(LibraryName)
1043 sMessage = sLocation _
1044 & "\n" & "\n" & .GetText("UNITTESTLIBRARY", pvArgs(0))
1045 Case UNITTESTMETHODERROR ' SFUnitTests.SF_UnitTest(Method)
1046 sMessage = sLocation _
1047 & "\n" & "\n" & .GetText("UNITTESTMETHOD", pvArgs(0))
1048 Case Else
1049 End Select
1050 End With
1052 ' Log fatal event
1053 _SF_._AddToConsole(sMessage)
1055 ' Display fatal event, if relevant (default)
1056 If _SF_.DisplayEnabled Then
1057 If _SF_.StopWhenError Then sMessage = sMessage & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION")
1058 ' Do you need more help ?
1060 sMessage = sMessage & "\n" & "\n" & L10N.GetText("NEEDMOREHELP", sMethod)
1061 iButtons = MB_YESNO + MB_DEFBUTTON2
1062 Else
1063 iButtons = MB_OK
1064 End If
1065 iMsgBox = MsgBox(SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _
1066 , iButtons + MB_ICONEXCLAMATION _
1068 )
1069 ' If more help needed ...
1070 If iMsgBox = IDYES Then _OpenHelpInBrowser(sService, sMethod)
1071 End If
1073 Finally:
1074 SF_Utils._ExitFunction(cstThisSub)
1075 _SF_._StackReset()
1076 If _SF_.StopWhenError Then Stop
1077 Exit Sub
1078 Catch:
1079 GoTo Finally
1080 End Sub ' ScriptForge.SF_Exception.RaiseFatal
1082 REM -----------------------------------------------------------------------------
1083 Public Sub RaiseWarning(Optional ByVal Number As Variant _
1084 , Optional ByVal Source As Variant _
1085 , Optional ByVal Description As Variant _
1086 )
1087 ''' Generate a run-time error. An error message is displayed to the user and logged
1088 ''' in the console. The execution is NOT STOPPED
1089 ''' Args:
1090 ''' Number: the error number, may be numeric or string
1091 ''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err)
1092 ''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error
1093 ''' Description: the error message to log in the console and to display to the user
1094 ''' Returns:
1095 ''' True if successful. Anyway, the execution continues
1096 ''' Examples:
1097 ''' On Local Error GoTo Catch
1098 ''' ' ...
1099 ''' Catch:
1102 ''' SF_Exception.RaiseWarning("MYAPPERROR", "myFunction", "Application error")
1103 ''' SF_Exception.RaiseWarning(,, "To divide by zero is not a good idea !")
1105 Dim bStop As Boolean ' Alias for stop switch
1109 ' Save Err, Erl, .. values before any On Error ... statement
1110 SF_Exception._CaptureSystemError()
1111 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1113 Check:
1114 If IsMissing(Number) Or IsEmpty(Number) Then Number = -1
1115 If IsMissing(Source) Or IsEmpty(Source) Then Source = -1
1116 If IsMissing(Description) Or IsEmpty(Description) Then Description = ""
1117 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1118 If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally
1119 If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally
1121 End If
1123 Try:
1124 bStop = _SF_.StopWhenError ' Store current value to reset it before leaving the Sub
1125 _SF_.StopWhenError = False
1126 SF_Exception.Raise(Number, Source, Description)
1128 Finally:
1129 SF_Utils._ExitFunction(cstThisSub)
1130 _SF_.StopWhenError = bStop
1131 Exit Sub
1132 Catch:
1133 GoTo Finally
1134 End Sub ' ScriptForge.SF_Exception.RaiseWarning
1136 REM -----------------------------------------------------------------------------
1137 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1138 , Optional ByRef Value As Variant _
1139 ) As Boolean
1140 ''' Set a new value to the given property
1141 ''' Args:
1142 ''' PropertyName: the name of the property as a string
1143 ''' Value: its new value
1144 ''' Exceptions
1145 ''' ARGUMENTERROR The property does not exist
1150 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1151 SetProperty = False
1153 Check:
1154 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1155 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1156 End If
1158 Try:
1159 SetProperty = _PropertySet(PropertyName, Value)
1161 Finally:
1162 SF_Utils._ExitFunction(cstThisSub)
1163 Exit Function
1164 Catch:
1165 GoTo Finally
1166 End Function ' ScriptForge.SF_Exception.SetProperty
1168 REM =========================================================== PRIVATE FUNCTIONS
1170 REM -----------------------------------------------------------------------------
1171 Private Sub _CaptureSystemError()
1172 ''' Store system error status in system error properties
1173 ''' Called at each invocation of an error management property or method
1174 ''' Reset by SF_Exception.Clear()
1177 _SysNumber = Err
1178 _SysSource = Erl
1179 _SysDescription = Error$
1180 End If
1182 End Sub ' ScriptForge.SF_Exception._CaptureSystemError
1184 REM -----------------------------------------------------------------------------
1185 Public Sub _CloseConsole(Optional ByRef poEvent As Object)
1186 ''' Close the console when opened in non-modal mode
1187 ''' Triggered by the CloseNonModalButton from the dlgConsole dialog
1189 On Local Error GoTo Finally
1191 Try:
1192 With _SF_
1193 If Not IsNull(.ConsoleDialog) Then
1194 If .ConsoleDialog._IsStillAlive(False) Then ' False to not raise an error
1195 Set .ConsoleControl = .ConsoleControl.Dispose()
1196 Set .ConsoleDialog = .ConsoleDialog.Dispose()
1197 End If
1198 End If
1199 End With
1201 Finally:
1202 Exit Sub
1203 End Sub ' ScriptForge.SF_Exception._CloseConsole
1205 REM -----------------------------------------------------------------------------
1206 Private Sub _ConsoleRefresh()
1207 ''' Reload the content of the console in the dialog
1208 ''' Needed when console first loaded or when totally or partially cleared
1210 With _SF_
1211 ' Do nothing if console inactive
1212 If IsNull(.ConsoleDialog) Then GoTo Finally
1213 If Not .ConsoleDialog._IsStillAlive(False) Then ' False to not generate an error when dead
1214 Set .ConsoleControl = .ConsoleControl.Dispose()
1215 Set .ConsoleDialog = Nothing
1216 GoTo Finally
1217 End If
1218 ' Store the relevant text in the control
1219 If IsNull(.ConsoleControl) Then Set .ConsoleControl = .ConsoleDialog.Controls(CONSOLENAME)
1220 .ConsoleControl.Value = ""
1221 If UBound(.ConsoleLines) >= 0 Then .ConsoleControl.WriteLine(Join(.ConsoleLines, SF_String.sfNEWLINE))
1222 End With
1224 Finally:
1225 Exit Sub
1226 End Sub ' ScriptForge.SF_Exception._ConsoleRefresh
1228 REM -----------------------------------------------------------------------------
1229 Private Sub _OpenHelpInBrowser(ByVal psService As String, ByVal psMethod As String)
1230 ''' Open the help page and help anchor related to the given ScriptForge service and method
1232 Dim sUrl As String ' URL to open
1233 Const cstURL = "https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_%1.html?&DbPAR=BASIC#%2"
1235 On Local Error GoTo Finally ' No reason to risk abort here
1236 Try:
1237 sUrl = SF_String.ReplaceStr(cstURL, Array("%1", "%2"), Array(LCase(psService), psMethod))
1238 SF_Session.OpenUrlInBrowser(sUrl)
1240 Finally:
1241 Exit Sub
1242 End Sub ' ScriptForge.SF_Exception._OpenHelpInBrowser
1244 REM -----------------------------------------------------------------------------
1245 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1246 ''' Return the value of the named property
1247 ''' Args:
1248 ''' psProperty: the name of the property
1250 Dim cstThisSub As String
1251 Const cstSubArgs = ""
1255 SF_Exception._CaptureSystemError()
1257 Select Case psProperty
1259 If _Description = "" Then _PropertyGet = _SysDescription Else _PropertyGet = _Description
1261 If IsEmpty(_Number) Then _PropertyGet = _SysNumber Else _PropertyGet = _Number
1263 If IsEmpty(_Source) Then _PropertyGet = _SysSource Else _PropertyGet = _Source
1264 Case Else
1265 _PropertyGet = Null
1266 End Select
1268 Finally:
1269 Exit Function
1270 End Function ' ScriptForge.SF_Exception._PropertyGet
1272 REM -----------------------------------------------------------------------------
1273 Private Function _PropertySet(Optional ByVal psProperty As String _
1274 , Optional ByVal pvValue As Variant _
1275 ) As Boolean
1276 ''' Set a new value to the named property
1277 ''' Applicable only to user defined errors
1278 ''' Args:
1279 ''' psProperty: the name of the property
1280 ''' pvValue: the new value
1282 Dim cstThisSub As String
1283 Const cstSubArgs = ""
1286 _PropertySet = False
1288 SF_Exception._CaptureSystemError()
1290 ' Argument validation must be manual to preserve system error status
1291 ' If wrong VarType then property set is ignored
1292 Select Case psProperty
1294 If VarType(pvValue) = V_STRING Then _Description = pvValue
1296 Select Case SF_Utils._VarTypeExt(pvValue)
1297 Case V_STRING
1298 _Number = pvValue
1299 Case V_NUMERIC
1300 _Number = CLng(pvValue)
1302 Case V_EMPTY
1303 _Number = Empty
1304 Case Else
1305 End Select
1307 Select Case SF_Utils._VarTypeExt(pvValue)
1308 Case V_STRING
1309 _Source = pvValue
1310 Case V_NUMERIC
1311 _Source = CLng(pvValue)
1312 Case Else
1313 End Select
1314 Case Else
1315 End Select
1317 _PropertySet = True
1319 Finally:
1320 Exit Function
1321 End Function ' ScriptForge.SF_Exception._PropertySet
1323 REM -----------------------------------------------------------------------------
1324 Private Function _Repr() As String
1325 ''' Convert the Exception instance to a readable string, typically for debugging purposes (DebugPrint ...)
1326 ''' Args:
1327 ''' Return:
1330 _Repr = "[Exception]: " & _Number & " (" & _Description & ")"
1332 End Function ' ScriptForge.SF_Exception._Repr
1334 REM -----------------------------------------------------------------------------
1335 Private Function _RightCase(psString As String) As String
1336 ''' Return the input argument in lower case only when the procedure in execution
1337 ''' has been triggered from a Python script
1338 ''' Indeed, Python requires lower case arguments
1339 ''' Args:
1340 ''' psString: probably an identifier in ProperCase
1341 ''' Return:
1342 ''' The input argument in lower case or left unchanged depending on the execution context
1344 Try:
1345 If _SF_.TriggeredByPython Then _RightCase = LCase(psString) Else _RightCase = psString
1347 Finally:
1348 Exit Function
1349 End Function ' ScriptForge.SF_Exception._RightCase
1351 REM -----------------------------------------------------------------------------
1352 Private Function _RightCaseArgs(psString As String) As String
1353 ''' Return the input argument unchanged when the execution context is Basic
1354 ''' When it is Python, the argument names are lowercased.
1355 ''' Args:
1356 ''' psString: one of the cstSubArgs strings located in each official method
1357 ''' Return:
1358 ''' The input string in which the argument names are put in lower case when called from Python scripts
1360 Dim sSubArgs As String ' Return value
1361 Dim vArgs As Variant ' Input string split on the comma character
1362 Dim sSingleArg As String ' Single vArgs item
1363 Dim vSingleArgs As Variant ' vSingleArg split on equal sign
1364 Dim i As Integer
1369 Try:
1370 If Len(psString) = 0 Then
1371 sSubArgs = ""
1372 ElseIf _SF_.TriggeredByPython Then
1373 vArgs = SF_String.SplitNotQuoted(psString, cstComma, QuoteChar := """")
1374 For i = 0 To UBound(vArgs)
1375 sSingleArg = vArgs(i)
1376 vSingleArgs = Split(sSingleArg, cstEqual)
1378 vArgs(i) = join(vSingleArgs, cstEqual)
1379 Next i
1380 sSubArgs = Join(vArgs, cstComma)
1381 Else
1382 sSubArgs = psString
1383 End If
1385 Finally:
1386 _RightCaseArgs = sSubArgs
1387 Exit Function
1388 End Function ' ScriptForge.SF_Exception._RightCaseArgs
1390 REM ============================================ END OF SCRIPTFORGE.SF_EXCEPTION
1391 </script:module>