| blob | f752e054f2b536963df442464fa7a7e35194477f |
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
130 ' SF_Database
134 ' Python
137 ' SF_UnitTest
141 REM ============================================================= PRIVATE MEMBERS
143 ' User defined errors
144 Private _Number As Variant ' Error number/code (Integer or String)
145 Private _Source As Variant ' Where the error occurred: a module, a Sub/Function, ...
146 Private _Description As String ' The error message
148 ' System run-time errors
149 Private _SysNumber As Long ' Alias of Err
150 Private _SysSource As Long ' Alias of Erl
151 Private _SysDescription As String ' Alias of Error$
153 REM ============================================================ MODULE CONSTANTS
158 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
160 REM -----------------------------------------------------------------------------
161 Public Function Dispose() As Variant
162 Set Dispose = Nothing
163 End Function ' ScriptForge.SF_Exception Explicit destructor
165 REM ================================================================== PROPERTIES
167 REM -----------------------------------------------------------------------------
168 Property Get Description() As Variant
169 ''' Returns the description of the last error that has occurred
170 ''' Example:
171 ''' myException.Description
173 End Property ' ScriptForge.SF_Exception.Description (get)
175 REM -----------------------------------------------------------------------------
176 Property Let Description(ByVal pvDescription As Variant)
177 ''' Set the description of the last error that has occurred
178 ''' Example:
181 End Property ' ScriptForge.SF_Exception.Description (let)
183 REM -----------------------------------------------------------------------------
184 Property Get Number() As Variant
185 ''' Returns the code of the last error that has occurred
186 ''' Example:
187 ''' myException.Number
189 End Property ' ScriptForge.SF_Exception.Number (get)
191 REM -----------------------------------------------------------------------------
192 Property Let Number(ByVal pvNumber As Variant)
193 ''' Set the code of the last error that has occurred
194 ''' Example:
197 End Property ' ScriptForge.SF_Exception.Number (let)
199 REM -----------------------------------------------------------------------------
200 Property Get Source() As Variant
201 ''' Returns the location of the last error that has occurred
202 ''' Example:
203 ''' myException.Source
205 End Property ' ScriptForge.SF_Exception.Source (get)
207 REM -----------------------------------------------------------------------------
208 Property Let Source(ByVal pvSource As Variant)
209 ''' Set the location of the last error that has occurred
210 ''' Example:
213 End Property ' ScriptForge.SF_Exception.Source (let)
215 REM -----------------------------------------------------------------------------
216 Property Get ObjectType As String
217 ''' Only to enable object representation
219 End Property ' ScriptForge.SF_String.ObjectType
221 REM -----------------------------------------------------------------------------
222 Property Get ServiceName As String
223 ''' Internal use
225 End Property ' ScriptForge.SF_Exception.ServiceName
227 REM ===================================================================== METHODS
229 REM -----------------------------------------------------------------------------
230 Public Sub Clear()
231 ''' Reset the current error status and clear the SF_Exception object
232 ''' Args:
233 ''' Examples:
234 ''' On Local Error GoTo Catch
235 ''' ' ...
236 ''' Catch:
240 Const cstSubArgs = ""
242 Check:
244 Try:
245 With SF_Exception
246 ._Number = Empty
247 ._Source = Empty
248 ._Description = ""
249 ._SysNumber = 0
250 ._SysSource = 0
251 ._SysDescription = ""
252 End With
254 Finally:
255 On Error GoTo 0
256 Exit Sub
257 Catch:
258 GoTo Finally
259 End Sub ' ScriptForge.SF_Exception.Clear
261 REM -----------------------------------------------------------------------------
262 Public Sub Console(Optional ByVal Modal As Variant, _
263 Optional ByRef _Context As Variant _
264 )
265 ''' Display the console messages in a modal or non-modal dialog
266 ''' If the dialog is already active, when non-modal, it is brought to front
267 ''' Args:
268 ''' Modal: Boolean. Default = True
269 ''' _Context: From Python, the XComponentXontext (FOR INTERNAL USE ONLY)
270 ''' Example:
271 ''' SF_Exception.Console()
273 Dim bConsoleActive As Boolean ' When True, dialog is active
274 Dim oModalBtn As Object ' Modal close button
275 Dim oNonModalBtn As Object ' Non modal close button
279 If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing
281 Check:
282 If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
283 If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing
284 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
286 End If
288 Try:
289 With _SF_
290 bConsoleActive = False
291 If Not IsNull(.ConsoleDialog) Then bConsoleActive = .ConsoleDialog._IsStillAlive(False) ' False to not raise an error
292 If bConsoleActive And Modal = False Then
293 ' Bring to front
294 .ConsoleDialog.Activate()
295 Else
296 ' Initialize dialog and fill with actual data
297 ' The dual modes (modal and non-modal) require to have 2 close buttons o/w only 1 is visible
298 ' - a usual OK button
299 ' - a Default button triggering the Close action
300 Set .ConsoleDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgConsole", _Context)
301 ' Setup labels and visibility
304 oModalBtn.Visible = Modal
305 oNonModalBtn.Visible = CBool(Not Modal)
306 ' Load console lines
307 _ConsoleRefresh()
308 .ConsoleDialog.Execute(Modal)
309 ' Terminate the modal dialog
310 If Modal Then
311 Set .ConsoleControl = .ConsoleControl.Dispose()
312 Set .ConsoleDialog = .ConsoleDialog.Dispose()
313 End If
314 End If
315 End With
317 Finally:
318 SF_Utils._ExitFunction(cstThisSub)
319 Exit Sub
320 End Sub ' ScriptForge.SF_Exception.Console
322 REM -----------------------------------------------------------------------------
323 Public Sub ConsoleClear(Optional ByVal Keep)
324 ''' Clear the console keeping an optional number of recent messages
325 ''' Args:
326 ''' Keep: the number of messages to keep
327 ''' If Keep is bigger than the number of messages stored in the console,
328 ''' the console is not cleared
329 ''' Example:
332 Dim lConsole As Long ' UBound of ConsoleLines
336 If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing
338 Check:
339 If IsMissing(Keep) Or IsEmpty(Keep) Then Keep = 0
340 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
342 End If
344 Try:
345 With _SF_
347 .ConsoleLines = Array()
348 Else
349 lConsole = UBound(.ConsoleLines)
350 If Keep < lConsole + 1 Then .ConsoleLines = SF_Array.Slice(.ConsoleLines, lConsole - Keep + 1)
351 End If
352 End With
354 ' If active, the console dialog needs to be refreshed
355 _ConsoleRefresh()
357 Finally:
358 SF_Utils._ExitFunction(cstThisSub)
359 Exit Sub
360 End Sub ' ScriptForge.SF_Exception.ConsoleClear
362 REM -----------------------------------------------------------------------------
363 Public Function ConsoleToFile(Optional ByVal FileName As Variant) As Boolean
364 ''' Export the content of the console to a text file
365 ''' If the file exists and the console is not empty, it is overwritten without warning
366 ''' Args:
367 ''' FileName: the complete file name to export to. If it exists, is overwritten without warning
368 ''' Returns:
369 ''' True if the file could be created
370 ''' Examples:
373 Dim bExport As Boolean ' Return value
374 Dim oFile As Object ' Output file handler
375 Dim sLine As String ' A single line
379 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
380 bExport = False
382 Check:
383 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
385 End If
387 Try:
390 Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True)
391 If Not IsNull(oFile) Then
392 With oFile
393 For Each sLine In _SF_.ConsoleLines
394 .WriteLine(sLine)
395 Next sLine
396 .CloseFile()
397 End With
398 End If
399 bExport = True
400 End If
402 Finally:
403 If Not IsNull(oFile) Then Set oFile = oFile.Dispose()
404 ConsoleToFile = bExport
405 SF_Utils._ExitFunction(cstThisSub)
406 Exit Function
407 Catch:
408 GoTo Finally
409 End Function ' ScriptForge.SF_Exception.ConsoleToFile
411 REM -----------------------------------------------------------------------------
412 Public Sub DebugDisplay(ParamArray pvArgs() As Variant)
413 ''' Display the list of arguments in a readable form in a message box
414 ''' Arguments are separated by a LINEFEED character
416 ''' Args:
417 ''' Any number of arguments of any type
418 ''' Examples:
419 ''' SF_Exception.DebugDisplay(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
421 Dim sOutputMsg As String ' Line to display
422 Dim sOutputCon As String ' Line to write in console
423 Dim sArgMsg As String ' Single argument
424 Dim sArgCon As String ' Single argument
425 Dim i As Integer
426 Const cstTab = 4
427 Const cstMaxLength = 1024
431 If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
432 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
433 Try:
434 ' Build new console line
436 For i = 0 To UBound(pvArgs)
437 If IsError(pvArgs(i)) Then pvArgs(i) = ""
438 sArgMsg = Iif(i = 0, "", SF_String.sfNEWLINE) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent()
439 sArgCon = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength)
440 sOutputMsg = sOutputMsg & sArgMsg
441 sOutputCon = sOutputCon & sArgCon
442 Next i
444 ' Add to actual console
445 _SF_._AddToConsole(SF_String.ExpandTabs(sOutputCon, cstTab))
446 ' Display the message
449 Finally:
450 SF_Utils._ExitFunction(cstThisSub)
451 Exit Sub
452 End Sub ' ScriptForge.SF_Exception.DebugDisplay
454 REM -----------------------------------------------------------------------------
455 Public Sub DebugPrint(ParamArray pvArgs() As Variant)
456 ''' Print the list of arguments in a readable form in the console
457 ''' Arguments are separated by a TAB character (simulated by spaces)
459 ''' Args:
460 ''' Any number of arguments of any type
461 ''' Examples:
462 ''' SF_Exception.DebugPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
464 Dim sOutput As String ' Line to write in console
465 Dim sArg As String ' Single argument
466 Dim i As Integer
467 Const cstTab = 4
468 Const cstMaxLength = 1024
472 If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
473 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
474 Try:
475 ' Build new console line
476 sOutput = ""
477 For i = 0 To UBound(pvArgs)
478 If IsError(pvArgs(i)) Then pvArgs(i) = ""
479 sArg = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent()
480 sOutput = sOutput & sArg
481 Next i
483 ' Add to actual console
484 _SF_._AddToConsole(SF_String.ExpandTabs(sOutput, cstTab))
486 Finally:
487 SF_Utils._ExitFunction(cstThisSub)
488 Exit Sub
489 End Sub ' ScriptForge.SF_Exception.DebugPrint
491 REM -----------------------------------------------------------------------------
492 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
493 ''' Return the actual value of the given property
494 ''' Args:
495 ''' PropertyName: the name of the property as a string
496 ''' Returns:
497 ''' The actual value of the property
498 ''' If the property does not exist, returns Null
499 ''' Exceptions
500 ''' ARGUMENTERROR The property does not exist
501 ''' Examples:
505 Const cstSubArgs = ""
507 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
508 GetProperty = Null
510 Check:
511 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
512 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
513 End If
515 Try:
516 GetProperty = _PropertyGet(PropertyName)
518 Finally:
519 SF_Utils._ExitFunction(cstThisSub)
520 Exit Function
521 Catch:
522 GoTo Finally
523 End Function ' ScriptForge.SF_Exception.GetProperty
525 REM -----------------------------------------------------------------------------
526 Public Function Methods() As Variant
527 ''' Return the list of public methods of the Exception service as an array
529 Methods = Array( _
539 )
541 End Function ' ScriptForge.SF_Exception.Methods
543 REM -----------------------------------------------------------------------------
544 Public Function Properties() As Variant
545 ''' Return the list or properties of the Timer class as an array
547 Properties = Array( _
551 )
553 End Function ' ScriptForge.SF_Exception.Properties
555 REM -----------------------------------------------------------------------------
556 Public Sub PythonPrint(ParamArray pvArgs() As Variant)
557 ''' Display the list of arguments in a readable form in the Python console
558 ''' Arguments are separated by a TAB character (simulated by spaces)
560 ''' Args:
561 ''' Any number of arguments of any type
562 ''' Examples:
563 ''' SF_Exception.PythonPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09))
565 Dim sOutput As String ' Line to write in console
566 Dim sArg As String ' Single argument
567 Dim i As Integer
568 Const cstTab = 4
569 Const cstMaxLength = 1024
574 If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing
575 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
576 Try:
577 ' Build new console line
578 sOutput = ""
579 For i = 0 To UBound(pvArgs)
580 If IsError(pvArgs(i)) Then pvArgs(i) = ""
582 sOutput = sOutput & sArg
583 Next i
585 ' Add to actual console
586 sOutput = SF_String.ExpandTabs(sOutput, cstTab)
587 _SF_._AddToConsole(sOutput)
588 ' Display the message in the Python shell console
589 With ScriptForge.SF_Session
590 .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, sOutput)
591 End With
593 Finally:
594 SF_Utils._ExitFunction(cstThisSub)
595 Exit Sub
596 End Sub ' ScriptForge.SF_Exception.PythonPrint
598 REM -----------------------------------------------------------------------------
599 Public Sub Raise(Optional ByVal Number As Variant _
600 , Optional ByVal Source As Variant _
601 , Optional ByVal Description As Variant _
602 )
603 ''' Generate a run-time error. An error message is displayed to the user and logged
604 ''' in the console. The execution is STOPPED
605 ''' Args:
606 ''' Number: the error number, may be numeric or string
607 ''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err)
608 ''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error
609 ''' Description: the error message to log in the console and to display to the user
610 ''' Examples:
611 ''' On Local Error GoTo Catch
612 ''' ' ...
613 ''' Catch:
616 ''' SF_Exception.Raise("MYAPPERROR", "myFunction", "Application error")
619 Dim sMessage As String ' Error message to log and to display
620 Dim L10N As Object ' Alias to LocalizedInterface
624 ' Save Err, Erl, .. values before any On Error ... statement
625 SF_Exception._CaptureSystemError()
626 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
628 Check:
629 If IsMissing(Number) Or IsEmpty(Number) Then Number = -1
630 If IsMissing(Source) Or IsEmpty(Source) Then Source = -1
631 If IsMissing(Description) Or IsEmpty(Description) Then Description = ""
632 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
633 If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
634 If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
636 End If
638 Try:
639 With SF_Exception
641 If VarType(Source) = V_STRING Then
644 .Source = Source
645 End If
648 ' Log and display
649 Set L10N = _SF_._GetLocalizedInterface()
651 .DebugPrint(sMessage)
655 , MB_OK + MB_ICONSTOP _
657 .Clear()
658 End With
660 Finally:
661 SF_Utils._ExitFunction(cstThisSub)
662 If _SF_.StopWhenError Then
663 _SF_._StackReset()
664 Stop
665 End If
666 Exit Sub
667 Catch:
668 GoTo Finally
669 End Sub ' ScriptForge.SF_Exception.Raise
671 REM -----------------------------------------------------------------------------
672 Public Sub RaiseAbort(Optional ByVal Source As Variant)
673 ''' Manage a run-time error that occurred inside the ScriptForge piece of software itself.
674 ''' The event is logged.
675 ''' The execution is STOPPED
676 ''' For INTERNAL USE only
677 ''' Args:
678 ''' Source: the line where the error occurred
680 Dim sLocation As String ' Common header in error messages: location of error
681 Dim vLocation As Variant ' Split array (library, module, method)
682 Dim sMessage As String ' Error message to log and to display
683 Dim L10N As Object ' Alias to LocalizedInterface
684 Const cstTabSize = 4
688 ' Save Err, Erl, .. values before any On Error ... statement
689 SF_Exception._CaptureSystemError()
690 On Local Error Resume Next
692 Check:
693 If IsMissing(Source) Or IsEmpty(Source) Then Source = ""
695 Try:
696 With SF_Exception
698 ' Prepare message header
699 Set L10N = _SF_._GetLocalizedInterface()
702 If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge")
703 sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), vLocation(1), vLocation(2)) & "\n\n\n"
704 Else
705 sLocation = ""
706 End If
708 ' Log and display
710 .DebugPrint(sMessage)
711 If _SF_.DisplayEnabled Then
712 sMessage = sLocation _
714 & L10N.GetText("ERRORLOCATION", Source & "/" & .Source) & SF_String.sfNewLine & .Description _
715 & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION")
716 MsgBox SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _
717 , MB_OK + MB_ICONSTOP _
719 End If
721 .Clear()
722 End With
724 Finally:
725 _SF_._StackReset()
726 If _SF_.StopWhenError Then Stop
727 Exit Sub
728 Catch:
729 GoTo Finally
730 End Sub ' ScriptForge.SF_Exception.RaiseAbort
732 REM -----------------------------------------------------------------------------
733 Public Sub RaiseFatal(Optional ByVal ErrorCode As Variant _
734 , ParamArray pvArgs _
735 )
736 ''' Generate a run-time error caused by an anomaly in a user script detected by ScriptForge
737 ''' The message is logged in the console. The execution is STOPPED
738 ''' For INTERNAL USE only
739 ''' Args:
740 ''' ErrorCode: as a string, the unique identifier of the error
741 ''' pvArgs: the arguments to insert in the error message
743 Dim sLocation As String ' Common header in error messages: location of error
744 Dim sService As String ' Service name having detected the error
745 Dim sMethod As String ' Method name having detected the error
746 Dim vLocation As Variant ' Split array (library, module, method)
747 Dim sMessage As String ' Message to log and display
748 Dim L10N As Object ' Alias of LocalizedInterface
749 Dim sAlt As String ' Alternative error messages
750 Dim iButtons As Integer ' MB_OK or MB_YESNO
751 Dim iMsgBox As Integer ' Return value of the message box
753 Const cstTabSize = 4
758 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
760 Check:
761 If IsMissing(ErrorCode) Or IsEmpty(ErrorCode) Then ErrorCode = ""
762 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
764 End If
766 Try:
767 Set L10N = _SF_._GetLocalizedInterface()
768 ' Location header common to all error messages
771 If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge")
772 sService = vLocation(1)
773 sMethod = vLocation(2)
775 & "\n" & L10N.GetText("VALIDATEARGS", _RightCaseArgs(_SF_.MainFunctionArgs))
776 Else
777 sService = ""
778 sMethod = ""
779 sLocation = ""
780 End If
782 With L10N
783 Select Case UCase(ErrorCode)
784 Case MISSINGARGERROR ' SF_Utils._Validate(Name)
786 sMessage = sLocation _
787 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
788 & "\n" & "\n" & .GetText("VALIDATEMISSING", pvArgs(0))
789 Case ARGUMENTERROR ' SF_Utils._Validate(Value, Name, Types, Values, Regex, Class)
791 sMessage = sLocation _
792 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
794 If Len(pvArgs(2)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATETYPES", pvArgs(1), pvArgs(2))
795 If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEVALUES", pvArgs(1), pvArgs(3))
796 If Len(pvArgs(4)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEREGEX", pvArgs(1), pvArgs(4))
797 If Len(pvArgs(5)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATECLASS", pvArgs(1), pvArgs(5))
798 sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
799 Case ARRAYERROR ' SF_Utils._ValidateArray(Value, Name, Dimensions, Types, NotNull)
801 sMessage = sLocation _
802 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
805 If pvArgs(2) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEDIMS", pvArgs(1), pvArgs(2))
806 If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEALLTYPES", pvArgs(1), pvArgs(3))
807 If pvArgs(4) Then sMessage = sMessage & "\n" & .GetText("VALIDATENOTNULL", pvArgs(1))
808 sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
809 Case FILEERROR ' SF_Utils._ValidateFile(Value, Name, WildCards)
811 sMessage = sLocation _
812 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _
817 If pvArgs(2) Then sMessage = sMessage & "\n" & .GetText("VALIDATEWILDCARD", pvArgs(1))
818 sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0))
819 Case ARRAYSEQUENCEERROR ' SF_Array.RangeInit(From, UpTo, ByStep)
820 sMessage = sLocation _
821 & "\n" & "\n" & "\n" & .GetText("ARRAYSEQUENCE", pvArgs(0), pvArgs(1), pvArgs(2))
822 Case ARRAYINSERTERROR ' SF_Array.AppendColumn/Row/PrependColumn/Row(VectorName, Array_2D, Vector)
823 sMessage = sLocation _
824 & "\n" & "\n" & "\n" & .GetText("ARRAYINSERT", pvArgs(0), pvArgs(1), pvArgs(2))
825 Case ARRAYINDEX1ERROR ' SF_Array.ExtractColumn/Row(IndexName, Array_2D, Index)
826 sMessage = sLocation _
827 & "\n" & "\n" & "\n" & .GetText("ARRAYINDEX1", pvArgs(0), pvArgs(1), pvArgs(2))
828 Case ARRAYINDEX2ERROR ' SF_Array.Slice(From, UpTo)
829 sMessage = sLocation _
830 & "\n" & "\n" & "\n" & .GetText("ARRAYINDEX2", pvArgs(0), pvArgs(1), pvArgs(2))
831 Case CSVPARSINGERROR ' SF_Array.ImportFromCSVFile(FileName, LineNumber, Line)
832 sMessage = sLocation _
833 & "\n" & "\n" & "\n" & .GetText("CSVPARSING", pvArgs(0), pvArgs(1), pvArgs(2))
835 sMessage = sLocation _
836 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
837 & "\n" & "\n" & .GetText("DUPLICATEKEY", pvArgs(0), pvArgs(1))
839 sMessage = sLocation _
840 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
841 & "\n" & "\n" & .GetText("UNKNOWNKEY", pvArgs(0), pvArgs(1))
842 Case INVALIDKEYERROR ' SF_Dictionary.Add/ReplaceKey(Key)
843 sMessage = sLocation _
844 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
846 Case UNKNOWNFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile/CreateScriptService("L10N")(ArgName, Filename)
848 sMessage = sLocation _
849 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
850 & "\n" & "\n" & .GetText("UNKNOWNFILE", pvArgs(0), pvArgs(1))
851 Case UNKNOWNFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename)
853 sMessage = sLocation _
854 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
855 & "\n" & "\n" & .GetText("UNKNOWNFOLDER", pvArgs(0), pvArgs(1))
856 Case NOTAFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile(ArgName, Filename)
858 sMessage = sLocation _
859 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
860 & "\n" & "\n" & .GetText("NOTAFILE", pvArgs(0), pvArgs(1))
861 Case NOTAFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename)
863 sMessage = sLocation _
864 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
865 & "\n" & "\n" & .GetText("NOTAFOLDER", pvArgs(0), pvArgs(1))
866 Case OVERWRITEERROR ' SF_FileSystem.Copy+Move/File+Folder/CreateTextFile/OpenTextFile(ArgName, Filename)
868 sMessage = sLocation _
869 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
870 & "\n" & "\n" & .GetText("OVERWRITE", pvArgs(0), pvArgs(1))
871 Case READONLYERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename)
873 sMessage = sLocation _
874 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
875 & "\n" & "\n" & .GetText("READONLY", pvArgs(0), pvArgs(1))
876 Case NOFILEMATCHERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename)
878 sMessage = sLocation _
879 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
880 & "\n" & "\n" & .GetText("NOFILEMATCH", pvArgs(0), pvArgs(1))
881 Case FOLDERCREATIONERROR ' SF_FileSystem.CreateFolder(ArgName, Filename)
883 sMessage = sLocation _
884 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
885 & "\n" & "\n" & .GetText("FOLDERCREATION", pvArgs(0), pvArgs(1))
886 Case UNKNOWNSERVICEERROR ' SF_Services.CreateScriptService(ArgName, Value, Library, Service)
888 sMessage = sLocation _
889 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
890 & "\n" & "\n" & .GetText("UNKNOWNSERVICE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
891 Case SERVICESNOTLOADEDERROR ' SF_Services.CreateScriptService(ArgName, Value, Library)
893 sMessage = sLocation _
894 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
895 & "\n" & "\n" & .GetText("SERVICESNOTLOADED", pvArgs(0), pvArgs(1), pvArgs(2))
896 Case CALCFUNCERROR ' SF_Session.ExecuteCalcFunction(CalcFunction)
897 sMessage = sLocation _
898 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("CalcFunction")) _
900 Case NOSCRIPTERROR ' SF_Session._GetScript(Language, "Scope", Scope, "Script", Script)
902 sMessage = sLocation _
903 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("Script")) _
904 & "\n" & "\n" & .GetText("NOSCRIPT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4))
907 sMessage = sLocation _
908 & "\n" & "\n" & .GetText("SCRIPTEXEC", pvArgs(0), pvArgs(1), pvArgs(2))
909 Case WRONGEMAILERROR ' SF_Session.SendMail(Arg, Email)
911 sMessage = sLocation _
912 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
914 Case SENDMAILERROR ' SF_Session.SendMail()
915 sMessage = sLocation _
917 Case FILENOTOPENERROR ' SF_TextStream._IsFileOpen(FileName)
918 sMessage = sLocation _
920 Case FILEOPENMODEERROR ' SF_TextStream._IsFileOpen(FileName)
921 sMessage = sLocation _
922 & "\n" & "\n" & .GetText("FILEOPENMODE", pvArgs(0), pvArgs(1))
923 Case ENDOFFILEERROR ' SF_TextStream.ReadLine/ReadAll/SkipLine(FileName)
924 sMessage = sLocation _
926 Case DOCUMENTERROR ' SF_UI.GetDocument(ArgName, WindowName)
928 sMessage = sLocation _
929 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
930 & "\n" & "\n" & .GetText("DOCUMENT", pvArgs(0), pvArgs(1))
931 Case DOCUMENTCREATIONERROR ' SF_UI.Create(Arg1Name, DocumentType, Arg2Name, TemplateFile)
933 sMessage = sLocation _
934 & "\n" & "\n" & .GetText("DOCUMENTCREATION", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
935 Case DOCUMENTOPENERROR ' SF_UI.OpenDocument(Arg1Name, FileName, Arg2Name, Password, Arg3Name, FilterName)
936 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
937 sMessage = sLocation _
938 & "\n" & "\n" & .GetText("DOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
939 Case BASEDOCUMENTOPENERROR ' SF_UI.OpenBaseDocument(Arg1Name, FileName, Arg2Name, RegistrationName)
941 sMessage = sLocation _
942 & "\n" & "\n" & .GetText("BASEDOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
943 Case DOCUMENTDEADERROR ' SF_Document._IsStillAlive(FileName)
944 sMessage = sLocation _
946 Case DOCUMENTSAVEERROR ' SF_Document.Save(Arg1Name, FileName)
948 sMessage = sLocation _
949 & "\n" & "\n" & .GetText("DOCUMENTSAVE", pvArgs(0), pvArgs(1))
950 Case DOCUMENTSAVEASERROR ' SF_Document.SaveAs(Arg1Name, FileName, Arg2, Overwrite, Arg3, FilterName)
951 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
952 sMessage = sLocation _
953 & "\n" & "\n" & .GetText("DOCUMENTSAVEAS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
956 sMessage = sLocation _
957 & "\n" & "\n" & .GetText("DOCUMENTREADONLY", pvArgs(0), pvArgs(1))
958 Case DBCONNECTERROR ' SF_Base.GetDatabase("User", User, "Password", Password, FileName)
960 sMessage = sLocation _
961 & "\n" & "\n" & .GetText("DBCONNECT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4))
962 Case CALCADDRESSERROR ' SF_Calc._ParseAddress(Address, "Range"/"Sheet", Scope, Document)
964 sMessage = sLocation _
965 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
966 & "\n" & "\n" & .GetText("CALCADDRESS" & Iif(Left(pvArgs(0), 5) = "Sheet", "1", "2"), pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
967 Case DUPLICATESHEETERROR ' SF_Calc.InsertSheet(arg, SheetName, Document)
969 sMessage = sLocation _
970 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
971 & "\n" & "\n" & .GetText("DUPLICATESHEET", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
972 Case OFFSETADDRESSERROR ' SF_Calc.RangeOffset("Range", Range, "Rows", Rows, "Columns", Columns, "Height", Height, "Width", Width, "Document, Document)
973 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
974 pvArgs(6) = _RightCase(pvArgs(6)) : pvArgs(8) = _RightCase(pvArgs(8)) : pvArgs(10) = _RightCase(pvArgs(10))
975 sMessage = sLocation _
976 & "\n" & "\n" & .GetText("OFFSETADDRESS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _
978 Case DUPLICATECHARTERROR ' SF_Calc.CreateChart(chart, ChartName, sheet, SheetName, Document, file)
980 sMessage = sLocation _
981 & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _
982 & "\n" & "\n" & .GetText("DUPLICATECHART", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
983 Case RANGEEXPORTERROR ' SF_Calc.ExportRangeToFile(Arg1Name, FileName, Arg2, Overwrite)
985 sMessage = sLocation _
986 & "\n" & "\n" & .GetText("RANGEEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
987 Case CHARTEXPORTERROR ' SF_Chart.ExportToFile(Arg1Name, FileName, Arg2, Overwrite)
989 sMessage = sLocation _
990 & "\n" & "\n" & .GetText("CHARTEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
991 Case FORMDEADERROR ' SF_Form._IsStillAlive(FormName, DocumentName)
992 sMessage = sLocation _
993 & "\n" & "\n" & .GetText("FORMDEAD", pvArgs(0), pvArgs(1))
994 Case CALCFORMNOTFOUNDERROR ' SF_Calc.Forms(Index, SheetName, Document)
995 sMessage = sLocation _
996 & "\n" & "\n" & .GetText("CALCFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2))
997 Case WRITERFORMNOTFOUNDERROR ' SF_Document.Forms(Index, Document)
998 sMessage = sLocation _
999 & "\n" & "\n" & .GetText("WRITERFORMNOTFOUND", pvArgs(0), pvArgs(1))
1000 Case BASEFORMNOTFOUNDERROR ' SF_Base.Forms(Index, FormDocument, BaseDocument)
1001 sMessage = sLocation _
1002 & "\n" & "\n" & .GetText("BASEFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2))
1003 Case SUBFORMNOTFOUNDERROR ' SF_Form.Subforms(Subform, Mainform)
1004 sMessage = sLocation _
1005 & "\n" & "\n" & .GetText("SUBFORMNOTFOUND", pvArgs(0), pvArgs(1))
1006 Case FORMCONTROLTYPEERROR ' SF_FormControl._SetProperty(ControlName, FormName, ControlType, Property)
1007 sMessage = sLocation _
1008 & "\n" & "\n" & .GetText("FORMCONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
1009 Case DIALOGNOTFOUNDERROR ' SF_Dialog._NewDialog(Service, DialogName, WindowName)
1010 pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4))
1012 sMessage = sLocation _
1013 & "\n" & "\n" & .GetText("DIALOGNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _
1015 Case DIALOGDEADERROR ' SF_Dialog._IsStillAlive(DialogName)
1016 sMessage = sLocation _
1018 Case CONTROLTYPEERROR ' SF_DialogControl._SetProperty(ControlName, DialogName, ControlType, Property)
1019 sMessage = sLocation _
1020 & "\n" & "\n" & .GetText("CONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3))
1021 Case TEXTFIELDERROR ' SF_DialogControl.WriteLine(ControlName, DialogName)
1022 sMessage = sLocation _
1023 & "\n" & "\n" & .GetText("TEXTFIELD", pvArgs(0), pvArgs(1))
1024 Case PAGEMANAGERERROR ' SF_Dialog.SetPageManager(PilotsList, TabsList, WizardsList)
1025 sMessage = sLocation _
1026 & "\n" & "\n" & .GetText("PAGEMANAGER", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5))
1027 Case DBREADONLYERROR ' SF_Database.RunSql()
1028 sMessage = sLocation _
1030 Case SQLSYNTAXERROR ' SF_Database._ExecuteSql(SQL)
1031 sMessage = sLocation _
1033 Case PYTHONSHELLERROR ' SF_Exception.PythonShell (Python only)
1034 sMessage = sLocation _
1036 Case UNITTESTLIBRARYERROR ' SFUnitTests._NewUnitTest(LibraryName)
1037 sMessage = sLocation _
1038 & "\n" & "\n" & .GetText("UNITTESTLIBRARY", pvArgs(0))
1039 Case UNITTESTMETHODERROR ' SFUnitTests.SF_UnitTest(Method)
1040 sMessage = sLocation _
1041 & "\n" & "\n" & .GetText("UNITTESTMETHOD", pvArgs(0))
1042 Case Else
1043 End Select
1044 End With
1046 ' Log fatal event
1047 _SF_._AddToConsole(sMessage)
1049 ' Display fatal event, if relevant (default)
1050 If _SF_.DisplayEnabled Then
1051 If _SF_.StopWhenError Then sMessage = sMessage & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION")
1052 ' Do you need more help ?
1054 sMessage = sMessage & "\n" & "\n" & L10N.GetText("NEEDMOREHELP", sMethod)
1055 iButtons = MB_YESNO + MB_DEFBUTTON2
1056 Else
1057 iButtons = MB_OK
1058 End If
1059 iMsgBox = MsgBox(SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _
1060 , iButtons + MB_ICONEXCLAMATION _
1062 )
1063 ' If more help needed ...
1064 If iMsgBox = IDYES Then _OpenHelpInBrowser(sService, sMethod)
1065 End If
1067 Finally:
1068 SF_Utils._ExitFunction(cstThisSub)
1069 _SF_._StackReset()
1070 If _SF_.StopWhenError Then Stop
1071 Exit Sub
1072 Catch:
1073 GoTo Finally
1074 End Sub ' ScriptForge.SF_Exception.RaiseFatal
1076 REM -----------------------------------------------------------------------------
1077 Public Sub RaiseWarning(Optional ByVal Number As Variant _
1078 , Optional ByVal Source As Variant _
1079 , Optional ByVal Description As Variant _
1080 )
1081 ''' Generate a run-time error. An error message is displayed to the user and logged
1082 ''' in the console. The execution is NOT STOPPED
1083 ''' Args:
1084 ''' Number: the error number, may be numeric or string
1085 ''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err)
1086 ''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error
1087 ''' Description: the error message to log in the console and to display to the user
1088 ''' Returns:
1089 ''' True if successful. Anyway, the execution continues
1090 ''' Examples:
1091 ''' On Local Error GoTo Catch
1092 ''' ' ...
1093 ''' Catch:
1096 ''' SF_Exception.RaiseWarning("MYAPPERROR", "myFunction", "Application error")
1097 ''' SF_Exception.RaiseWarning(,, "To divide by zero is not a good idea !")
1099 Dim bStop As Boolean ' Alias for stop switch
1103 ' Save Err, Erl, .. values before any On Error ... statement
1104 SF_Exception._CaptureSystemError()
1105 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1107 Check:
1108 If IsMissing(Number) Or IsEmpty(Number) Then Number = -1
1109 If IsMissing(Source) Or IsEmpty(Source) Then Source = -1
1110 If IsMissing(Description) Or IsEmpty(Description) Then Description = ""
1111 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1112 If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally
1113 If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally
1115 End If
1117 Try:
1118 bStop = _SF_.StopWhenError ' Store current value to reset it before leaving the Sub
1119 _SF_.StopWhenError = False
1120 SF_Exception.Raise(Number, Source, Description)
1122 Finally:
1123 SF_Utils._ExitFunction(cstThisSub)
1124 _SF_.StopWhenError = bStop
1125 Exit Sub
1126 Catch:
1127 GoTo Finally
1128 End Sub ' ScriptForge.SF_Exception.RaiseWarning
1130 REM -----------------------------------------------------------------------------
1131 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1132 , Optional ByRef Value As Variant _
1133 ) As Boolean
1134 ''' Set a new value to the given property
1135 ''' Args:
1136 ''' PropertyName: the name of the property as a string
1137 ''' Value: its new value
1138 ''' Exceptions
1139 ''' ARGUMENTERROR The property does not exist
1144 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1145 SetProperty = False
1147 Check:
1148 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1149 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1150 End If
1152 Try:
1153 SetProperty = _PropertySet(PropertyName, Value)
1155 Finally:
1156 SF_Utils._ExitFunction(cstThisSub)
1157 Exit Function
1158 Catch:
1159 GoTo Finally
1160 End Function ' ScriptForge.SF_Exception.SetProperty
1162 REM =========================================================== PRIVATE FUNCTIONS
1164 REM -----------------------------------------------------------------------------
1165 Private Sub _CaptureSystemError()
1166 ''' Store system error status in system error properties
1167 ''' Called at each invocation of an error management property or method
1168 ''' Reset by SF_Exception.Clear()
1171 _SysNumber = Err
1172 _SysSource = Erl
1173 _SysDescription = Error$
1174 End If
1176 End Sub ' ScriptForge.SF_Exception._CaptureSystemError
1178 REM -----------------------------------------------------------------------------
1179 Public Sub _CloseConsole(Optional ByRef poEvent As Object)
1180 ''' Close the console when opened in non-modal mode
1181 ''' Triggered by the CloseNonModalButton from the dlgConsole dialog
1183 On Local Error GoTo Finally
1185 Try:
1186 With _SF_
1187 If Not IsNull(.ConsoleDialog) Then
1188 If .ConsoleDialog._IsStillAlive(False) Then ' False to not raise an error
1189 Set .ConsoleControl = .ConsoleControl.Dispose()
1190 Set .ConsoleDialog = .ConsoleDialog.Dispose()
1191 End If
1192 End If
1193 End With
1195 Finally:
1196 Exit Sub
1197 End Sub ' ScriptForge.SF_Exception._CloseConsole
1199 REM -----------------------------------------------------------------------------
1200 Private Sub _ConsoleRefresh()
1201 ''' Reload the content of the console in the dialog
1202 ''' Needed when console first loaded or when totally or partially cleared
1204 With _SF_
1205 ' Do nothing if console inactive
1206 If IsNull(.ConsoleDialog) Then GoTo Finally
1207 If Not .ConsoleDialog._IsStillAlive(False) Then ' False to not generate an error when dead
1208 Set .ConsoleControl = .ConsoleControl.Dispose()
1209 Set .ConsoleDialog = Nothing
1210 GoTo Finally
1211 End If
1212 ' Store the relevant text in the control
1213 If IsNull(.ConsoleControl) Then Set .ConsoleControl = .ConsoleDialog.Controls(CONSOLENAME)
1214 .ConsoleControl.Value = ""
1215 If UBound(.ConsoleLines) >= 0 Then .ConsoleControl.WriteLine(Join(.ConsoleLines, SF_String.sfNEWLINE))
1216 End With
1218 Finally:
1219 Exit Sub
1220 End Sub ' ScriptForge.SF_Exception._ConsoleRefresh
1222 REM -----------------------------------------------------------------------------
1223 Private Sub _OpenHelpInBrowser(ByVal psService As String, ByVal psMethod As String)
1224 ''' Open the help page and help anchor related to the given ScriptForge service and method
1226 Dim sUrl As String ' URL to open
1227 Const cstURL = "https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_%1.html?&DbPAR=BASIC#%2"
1229 On Local Error GoTo Finally ' No reason to risk abort here
1230 Try:
1231 sUrl = SF_String.ReplaceStr(cstURL, Array("%1", "%2"), Array(LCase(psService), psMethod))
1232 SF_Session.OpenUrlInBrowser(sUrl)
1234 Finally:
1235 Exit Sub
1236 End Sub ' ScriptForge.SF_Exception._OpenHelpInBrowser
1238 REM -----------------------------------------------------------------------------
1239 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1240 ''' Return the value of the named property
1241 ''' Args:
1242 ''' psProperty: the name of the property
1244 Dim cstThisSub As String
1245 Const cstSubArgs = ""
1249 SF_Exception._CaptureSystemError()
1251 Select Case psProperty
1253 If _Description = "" Then _PropertyGet = _SysDescription Else _PropertyGet = _Description
1255 If IsEmpty(_Number) Then _PropertyGet = _SysNumber Else _PropertyGet = _Number
1257 If IsEmpty(_Source) Then _PropertyGet = _SysSource Else _PropertyGet = _Source
1258 Case Else
1259 _PropertyGet = Null
1260 End Select
1262 Finally:
1263 Exit Function
1264 End Function ' ScriptForge.SF_Exception._PropertyGet
1266 REM -----------------------------------------------------------------------------
1267 Private Function _PropertySet(Optional ByVal psProperty As String _
1268 , Optional ByVal pvValue As Variant _
1269 ) As Boolean
1270 ''' Set a new value to the named property
1271 ''' Applicable only to user defined errors
1272 ''' Args:
1273 ''' psProperty: the name of the property
1274 ''' pvValue: the new value
1276 Dim cstThisSub As String
1277 Const cstSubArgs = ""
1280 _PropertySet = False
1282 SF_Exception._CaptureSystemError()
1284 ' Argument validation must be manual to preserve system error status
1285 ' If wrong VarType then property set is ignored
1286 Select Case psProperty
1288 If VarType(pvValue) = V_STRING Then _Description = pvValue
1290 Select Case SF_Utils._VarTypeExt(pvValue)
1291 Case V_STRING
1292 _Number = pvValue
1293 Case V_NUMERIC
1294 _Number = CLng(pvValue)
1296 Case V_EMPTY
1297 _Number = Empty
1298 Case Else
1299 End Select
1301 Select Case SF_Utils._VarTypeExt(pvValue)
1302 Case V_STRING
1303 _Source = pvValue
1304 Case V_NUMERIC
1305 _Source = CLng(pvValue)
1306 Case Else
1307 End Select
1308 Case Else
1309 End Select
1311 _PropertySet = True
1313 Finally:
1314 Exit Function
1315 End Function ' ScriptForge.SF_Exception._PropertySet
1317 REM -----------------------------------------------------------------------------
1318 Private Function _Repr() As String
1319 ''' Convert the Exception instance to a readable string, typically for debugging purposes (DebugPrint ...)
1320 ''' Args:
1321 ''' Return:
1324 _Repr = "[Exception]: " & _Number & " (" & _Description & ")"
1326 End Function ' ScriptForge.SF_Exception._Repr
1328 REM -----------------------------------------------------------------------------
1329 Private Function _RightCase(psString As String) As String
1330 ''' Return the input argument in lower case only when the procedure in execution
1331 ''' has been triggered from a Python script
1332 ''' Indeed, Python requires lower case arguments
1333 ''' Args:
1334 ''' psString: probably an identifier in ProperCase
1335 ''' Return:
1336 ''' The input argument in lower case or left unchanged depending on the execution context
1338 Try:
1339 If _SF_.TriggeredByPython Then _RightCase = LCase(psString) Else _RightCase = psString
1341 Finally:
1342 Exit Function
1343 End Function ' ScriptForge.SF_Exception._RightCase
1345 REM -----------------------------------------------------------------------------
1346 Private Function _RightCaseArgs(psString As String) As String
1347 ''' Return the input argument unchanged when the execution context is Basic
1348 ''' When it is Python, the argument names are lowercased.
1349 ''' Args:
1350 ''' psString: one of the cstSubArgs strings located in each official method
1351 ''' Return:
1352 ''' The input string in which the argument names are put in lower case when called from Python scripts
1354 Dim sSubArgs As String ' Return value
1355 Dim vArgs As Variant ' Input string split on the comma character
1356 Dim sSingleArg As String ' Single vArgs item
1357 Dim vSingleArgs As Variant ' vSingleArg split on equal sign
1358 Dim i As Integer
1363 Try:
1364 If Len(psString) = 0 Then
1365 sSubArgs = ""
1366 ElseIf _SF_.TriggeredByPython Then
1367 vArgs = SF_String.SplitNotQuoted(psString, cstComma, QuoteChar := """")
1368 For i = 0 To UBound(vArgs)
1369 sSingleArg = vArgs(i)
1370 vSingleArgs = Split(sSingleArg, cstEqual)
1372 vArgs(i) = join(vSingleArgs, cstEqual)
1373 Next i
1374 sSubArgs = Join(vArgs, cstComma)
1375 Else
1376 sSubArgs = psString
1377 End If
1379 Finally:
1380 _RightCaseArgs = sSubArgs
1381 Exit Function
1382 End Function ' ScriptForge.SF_Exception._RightCaseArgs
1384 REM ============================================ END OF SCRIPTFORGE.SF_EXCEPTION
1385 </script:module>