diff options
Diffstat (limited to 'wizards/source/scriptforge')
28 files changed, 25677 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_Array.xba b/wizards/source/scriptforge/SF_Array.xba new file mode 100644 index 000000000..49bdab147 --- /dev/null +++ b/wizards/source/scriptforge/SF_Array.xba @@ -0,0 +1,2608 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Array" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Array +''' ======== +''' Singleton class implementing the "ScriptForge.Array" service +''' Implemented as a usual Basic module +''' Only 1D or 2D arrays are considered. Arrays with more than 2 dimensions are rejected +''' With the noticeable exception of the CountDims method (>2 dims allowed) +''' The first argument of almost every method is the array to consider +''' It is always passed by reference and left unchanged +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_array.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const ARRAYSEQUENCEERROR = "ARRAYSEQUENCEERROR" ' Incoherent arguments +Const ARRAYINSERTERROR = "ARRAYINSERTERROR" ' Matrix and vector have incompatible sizes +Const ARRAYINDEX1ERROR = "ARRAYINDEX1ERROR" ' Given index does not fit in array bounds +Const ARRAYINDEX2ERROR = "ARRAYINDEX2ERROR" ' Given indexes do not fit in array bounds +Const CSVPARSINGERROR = "CSVPARSINGERROR" ' Parsing error detected while parsing a csv file +Const CSVOVERFLOWWARNING = "CSVOVERFLOWWARNING" ' Array becoming too big, import process of csv file is interrupted + +REM ============================================================ MODULE CONSTANTS + +Const MAXREPR = 50 ' Maximum length to represent an array in the console + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_Array Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_Array" +End Property ' ScriptForge.SF_Array.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Array" +End Property ' ScriptForge.SF_Array.ServiceName + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Function Append(Optional ByRef Array_1D As Variant _ + , ParamArray pvArgs() As Variant _ + ) As Variant +''' Append at the end of the input array the items listed as arguments +''' Arguments are appended blindly +''' each of them might be a scalar of any type or a subarray +''' Args +''' Array_1D: the pre-existing array, may be empty +''' pvArgs: a list of items to append to Array_1D +''' Return: +''' the new extended array. Its LBound is identical to that of Array_1D +''' Examples: +''' SF_Array.Append(Array(1, 2, 3), 4, 5) returns (1, 2, 3, 4, 5) + +Dim vAppend As Variant ' Return value +Dim lNbArgs As Long ' Number of elements to append +Dim lMax As Long ' UBound of input array +Dim i As Long +Const cstThisSub = "Array.Append" +Const cstSubArgs = "Array_1D, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vAppend = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + +Try: + lMax = UBound(Array_1D) + lNbArgs = UBound(pvArgs) + 1 ' pvArgs is always zero-based + If lMax < LBound(Array_1D) Then ' Initial array is empty + If lNbArgs > 0 Then + ReDim vAppend(0 To lNbArgs - 1) + End If + Else + vAppend() = Array_1D() + If lNbArgs > 0 Then + ReDim Preserve vAppend(LBound(Array_1D) To lMax + lNbArgs) + End If + End If + For i = 1 To lNbArgs + vAppend(lMax + i) = pvArgs(i - 1) + Next i + +Finally: + Append = vAppend() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Append + +REM ----------------------------------------------------------------------------- +Public Function AppendColumn(Optional ByRef Array_2D As Variant _ + , Optional ByRef Column As Variant _ + ) As Variant +''' AppendColumn appends to the right side of a 2D array a new Column +''' Args +''' Array_2D: the pre-existing array, may be empty +''' If the array has 1 dimension, it is considered as the 1st Column of the resulting 2D array +''' Column: a 1D array with as many items as there are rows in Array_2D +''' Returns: +''' the new extended array. Its LBounds are identical to that of Array_2D +''' Exceptions: +''' ARRAYINSERTERROR +''' Examples: +''' SF_Array.AppendColumn(Array(1, 2, 3), Array(4, 5, 6)) returns ((1, 4), (2, 5), (3, 6)) +''' x = SF_Array.AppendColumn(Array(), Array(1, 2, 3)) => ∀ i ∈ {0 ≤ i ≤ 2} : x(0, i) ≡ i + +Dim vAppendColumn As Variant ' Return value +Dim iDims As Integer ' Dimensions of Array_2D +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim lMin As Long ' LBound of Column array +Dim lMax As Long ' UBound of Column array +Dim i As Long +Dim j As Long +Const cstThisSub = "Array.AppendColumn" +Const cstSubArgs = "Array_2D, Column" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vAppendColumn = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D") Then GoTo Finally 'Initial check: not missing and array + If Not SF_Utils._ValidateArray(Column, "Column", 1) Then GoTo Finally + End If + iDims = SF_Array.CountDims(Array_2D) + If iDims > 2 Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally '2nd check to manage error + End If + +Try: + lMin = LBound(Column) + lMax = UBound(Column) + + ' Compute future dimensions of output array + Select Case iDims + Case 0 : lMin1 = lMin : lMax1 = lMax + lMin2 = 0 : lMax2 = -1 + Case 1 : lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = 0 : lMax2 = 0 + Case 2 : lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + End Select + If iDims > 0 And lMax - lMin <> lMax1 - lMin1 Then GoTo CatchColumn + ReDim vAppendColumn(lMin1 To lMax1, lMin2 To lMax2 + 1) + + ' Copy input array to output array + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + If iDims = 2 Then vAppendColumn(i, j) = Array_2D(i, j) Else vAppendColumn(i, j) = Array_2D(i) + Next j + Next i + ' Copy new Column + For i = lMin1 To lMax1 + vAppendColumn(i, lMax2 + 1) = Column(i) + Next i + +Finally: + AppendColumn = vAppendColumn() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchColumn: + SF_Exception.RaiseFatal(ARRAYINSERTERROR, "Column", SF_Array._Repr(Array_2D), SF_Utils._Repr(Column, MAXREPR)) + GoTo Finally +End Function ' ScriptForge.SF_Array.AppendColumn + +REM ----------------------------------------------------------------------------- +Public Function AppendRow(Optional ByRef Array_2D As Variant _ + , Optional ByRef Row As Variant _ + ) As Variant +''' AppendRow appends below a 2D array a new row +''' Args +''' Array_2D: the pre-existing array, may be empty +''' If the array has 1 dimension, it is considered as the 1st row of the resulting 2D array +''' Row: a 1D array with as many items as there are columns in Array_2D +''' Returns: +''' the new extended array. Its LBounds are identical to that of Array_2D +''' Exceptions: +''' ARRAYINSERTERROR +''' Examples: +''' SF_Array.AppendRow(Array(1, 2, 3), Array(4, 5, 6)) returns ((1, 2, 3), (4, 5, 6)) +''' x = SF_Array.AppendRow(Array(), Array(1, 2, 3)) => ∀ i ∈ {0 ≤ i ≤ 2} : x(i, 0) ≡ i + +Dim vAppendRow As Variant ' Return value +Dim iDims As Integer ' Dimensions of Array_2D +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim lMin As Long ' LBound of row array +Dim lMax As Long ' UBound of row array +Dim i As Long +Dim j As Long +Const cstThisSub = "Array.AppendRow" +Const cstSubArgs = "Array_2D, Row" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vAppendRow = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D") Then GoTo Finally 'Initial check: not missing and array + If Not SF_Utils._ValidateArray(Row, "Row", 1) Then GoTo Finally + End If + iDims = SF_Array.CountDims(Array_2D) + If iDims > 2 Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally '2nd check to manage error + End If + +Try: + lMin = LBound(Row) + lMax = UBound(Row) + + ' Compute future dimensions of output array + Select Case iDims + Case 0 : lMin1 = 0 : lMax1 = -1 + lMin2 = lMin : lMax2 = lMax + Case 1 : lMin1 = 0 : lMax1 = 0 + lMin2 = LBound(Array_2D, 1) : lMax2 = UBound(Array_2D, 1) + Case 2 : lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + End Select + If iDims > 0 And lMax - lMin <> lMax2 - lMin2 Then GoTo CatchRow + ReDim vAppendRow(lMin1 To lMax1 + 1, lMin2 To lMax2) + + ' Copy input array to output array + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + If iDims = 2 Then vAppendRow(i, j) = Array_2D(i, j) Else vAppendRow(i, j) = Array_2D(j) + Next j + Next i + ' Copy new row + For j = lMin2 To lMax2 + vAppendRow(lMax1 + 1, j) = Row(j) + Next j + +Finally: + AppendRow = vAppendRow() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchRow: + SF_Exception.RaiseFatal(ARRAYINSERTERROR, "Row", SF_Array._Repr(Array_2D), SF_Utils._Repr(Row, MAXREPR)) + GoTo Finally +End Function ' ScriptForge.SF_Array.AppendRow + +REM ----------------------------------------------------------------------------- +Public Function Contains(Optional ByRef Array_1D As Variant _ + , Optional ByVal ToFind As Variant _ + , Optional ByVal CaseSensitive As Variant _ + , Optional ByVal SortOrder As Variant _ + ) As Boolean +''' Check if a 1D array contains the ToFind number, string or date +''' The comparison between strings can be done case-sensitive or not +''' If the array is sorted then +''' the array must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' a binary search is done +''' Otherwise the array is scanned from top. Null or Empty items are simply ignored +''' Args: +''' Array_1D: the array to scan +''' ToFind: a number, a date or a string to find +''' CaseSensitive: Only for string comparisons, default = False +''' SortOrder: "ASC", "DESC" or "" (= not sorted, default) +''' Return: True when found +''' Result is unpredictable when array is announced sorted and is in reality not +''' Examples: +''' SF_Array.Contains(Array("A","B","c","D"), "C", SortOrder := "ASC") returns True +''' SF_Array.Contains(Array("A","B","c","D"), "C", CaseSensitive := True) returns False + +Dim bContains As Boolean ' Return value +Dim iToFindType As Integer ' VarType of ToFind +Const cstThisSub = "Array.Contains" +Const cstSubArgs = "Array_1D, ToFind, [CaseSensitive=False], [SortOrder=""""|""ASC""|""DESC""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + bContains = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(SortOrder, "SortOrder", V_STRING, Array("ASC", "DESC", "")) Then GoTo Finally + If Not SF_Utils._Validate(ToFind, "ToFind", Array(V_STRING, V_DATE, V_NUMERIC)) Then GoTo Finally + iToFindType = SF_Utils._VarTypeExt(ToFind) + If SortOrder <> "" Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1, iToFindType) Then GoTo Finally + Else + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + bContains = SF_Array._FindItem(Array_1D, ToFind, CaseSensitive, SortOrder)(0) + +Finally: + Contains = bContains + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Contains + +REM ----------------------------------------------------------------------------- +Public Function ConvertToDictionary(Optional ByRef Array_2D As Variant) As Variant +''' Store the content of a 2-columns array into a dictionary +''' Key found in 1st column, Item found in 2nd +''' Args: +''' Array_2D: 1st column must contain exclusively non zero-length strings +''' 1st column may not be sorted +''' Returns: +''' a ScriptForge dictionary object +''' Examples: +''' + +Dim oDict As Variant ' Return value +Dim i As Long +Const cstThisSub = "Dictionary.ConvertToArray" +Const cstSubArgs = "Array_2D" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2, V_STRING, True) Then GoTo Finally + End If + +Try: + Set oDict = SF_Services.CreateScriptService("Dictionary") + For i = LBound(Array_2D, 1) To UBound(Array_2D, 1) + oDict.Add(Array_2D(i, 0), Array_2D(i, 1)) + Next i + + ConvertToDictionary = oDict + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.ConvertToDictionary + +REM ----------------------------------------------------------------------------- +Public Function Copy(Optional ByRef Array_ND As Variant) As Variant +''' Duplicate a 1D or 2D array +''' A usual assignment copies an array by reference, i.e. shares the same memory location +''' Dim a, b +''' a = Array(1, 2, 3) +''' b = a +''' a(2) = 30 +''' MsgBox b(2) ' 30 +''' Args +''' Array_ND: the array to copy, may be empty +''' Return: +''' the copied array. Subarrays however still remain assigned by reference +''' Examples: +''' SF_Array.Copy(Array(1, 2, 3)) returns (1, 2, 3) + +Dim vCopy As Variant ' Return value +Dim iDims As Integer ' Number of dimensions of the input array +Const cstThisSub = "Array.Copy" +Const cstSubArgs = "Array_ND" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vCopy = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_ND, "Array_ND") Then GoTo Finally + iDims = SF_Array.CountDims(Array_ND) + If iDims > 2 Then + If Not SF_Utils._ValidateArray(Array_ND, "Array_ND", 2) Then GoTo Finally + End If + End If + +Try: + Select Case iDims + Case 0 + Case 1 + vCopy = Array_ND + ReDim Preserve vCopy(LBound(Array_ND) To UBound(Array_ND)) + Case 2 + vCopy = Array_ND + ReDim Preserve vCopy(LBound(Array_ND, 1) To UBound(Array_ND, 1), LBound(Array_ND, 2) To UBound(Array_ND, 2)) + End Select + +Finally: + Copy = vCopy() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Copy + +REM ----------------------------------------------------------------------------- +Public Function CountDims(Optional ByRef Array_ND As Variant) As Integer +''' Count the number of dimensions of an array - may be > 2 +''' Args: +''' Array_ND: the array to be examined +''' Return: the number of dimensions: -1 = not array, 0 = uninitialized array, else >= 1 +''' Examples: +''' Dim a(1 To 10, -3 To 12, 5) +''' CountDims(a) returns 3 + +Dim iDims As Integer ' Return value +Dim lMax As Long ' Storage for UBound of each dimension +Const cstThisSub = "Array.CountDims" +Const cstSubArgs = "Array_ND" + +Check: + iDims = -1 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If IsMissing(Array_ND) Then ' To have missing exception processed + If Not SF_Utils._ValidateArray(Array_ND, "Array_ND") Then GoTo Finally + End If + End If + +Try: + On Local Error Goto ErrHandler + ' Loop, increasing the dimension index (i) until an error occurs. + ' An error will occur when i exceeds the number of dimensions in the array. Returns i - 1. + iDims = 0 + If Not IsArray(Array_ND) Then + Else + Do + iDims = iDims + 1 + lMax = UBound(Array_ND, iDims) + Loop Until (Err <> 0) + End If + + ErrHandler: + On Local Error GoTo 0 + + iDims = iDims - 1 + If iDims = 1 Then + If LBound(Array_ND, 1) > UBound(Array_ND, 1) Then iDims = 0 + End If + +Finally: + CountDims = iDims + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Array.CountDims + +REM ----------------------------------------------------------------------------- +Public Function Difference(Optional ByRef Array1_1D As Variant _ + , Optional ByRef Array2_1D As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Build a set being the Difference of the two input arrays, i.e. items are contained in 1st array and NOT in 2nd +''' both input arrays must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' The comparison between strings is case sensitive or not +''' Args: +''' Array1_1D: a 1st input array +''' Array2_1D: a 2nd input array +''' CaseSensitive: default = False +''' Returns: a zero-based array containing unique items from the 1st array not present in the 2nd +''' The output array is sorted in ascending order +''' Examples: +''' SF_Array.Difference(Array("A", "C", "A", "b", "B"), Array("C", "Z", "b"), True) returns ("A", "B") + +Dim vDifference() As Variant ' Return value +Dim vSorted() As Variant ' The 2nd input array after sort +Dim iType As Integer ' VarType of elements in input arrays +Dim lMin1 As Long ' LBound of 1st input array +Dim lMax1 As Long ' UBound of 1st input array +Dim lMin2 As Long ' LBound of 2nd input array +Dim lMax2 As Long ' UBound of 2nd input array +Dim lSize As Long ' Number of Difference items +Dim vItem As Variant ' One single item in the array +Dim i As Long +Const cstThisSub = "Array.Difference" +Const cstSubArgs = "Array1_1D, Array2_1D, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vDifference = Array() + +Check: + If IsMissing(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array1_1D, "Array1_1D", 1, 0, True) Then GoTo Finally + iType = SF_Utils._VarTypeExt(Array1_1D(LBound(Array1_1D))) + If Not SF_Utils._ValidateArray(Array2_1D, "Array2_1D", 1, iType, True) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin1 = LBound(Array1_1D) : lMax1 = UBound(Array1_1D) + lMin2 = LBound(Array2_1D) : lMax2 = UBound(Array2_1D) + + ' If 1st array is empty, do nothing + If lMax1 < lMin1 Then + ElseIf lMax2 < lMin2 Then ' only 2nd array is empty + vUnion = SF_Array.Unique(Array1_1D, CaseSensitive) + Else + + ' First sort the 2nd array + vSorted = SF_Array.Sort(Array2_1D, "ASC", CaseSensitive) + + ' Resize the output array to the size of the 1st array + ReDim vDifference(0 To (lMax1 - lMin1)) + lSize = -1 + + ' Fill vDifference one by one with items present only in 1st set + For i = lMin1 To lMax1 + vItem = Array1_1D(i) + If Not SF_Array.Contains(vSorted, vItem, CaseSensitive, "ASC") Then + lSize = lSize + 1 + vDifference(lSize) = vItem + End If + Next i + + ' Remove unfilled entries and duplicates + If lSize >= 0 Then + ReDim Preserve vDifference(0 To lSize) + vDifference() = SF_Array.Unique(vDifference, CaseSensitive) + Else + vDifference = Array() + End If + End If + +Finally: + Difference = vDifference() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Difference + +REM ----------------------------------------------------------------------------- +Public Function ExportToTextFile(Optional ByRef Array_1D As Variant _ + , Optional ByVal FileName As Variant _ + , Optional ByVal Encoding As Variant _ + ) As Boolean +''' Write all items of the array sequentially to a text file +''' If the file exists already, it will be overwritten without warning +''' Args: +''' Array_1D: the array to export +''' FileName: the full name (path + file) in SF_FileSystem.FileNaming notation +''' Encoding: The character set that should be used +''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Note that LibreOffice does not implement all existing sets +''' Default = UTF-8 +''' Returns: +''' True if successful +''' Examples: +''' SF_Array.ExportToTextFile(Array("A","B","C","D"), "C:\Temp\A short file.txt") + +Dim bExport As Boolean ' Return value +Dim oFile As Object ' Output file handler +Dim sLine As String ' A single line +Const cstThisSub = "Array.ExportToTextFile" +Const cstSubArgs = "Array_1D, FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bExport = False + +Check: + If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1, V_STRING, True) Then GoTo Finally + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally + End If + +Try: + Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True, Encoding := Encoding) + If Not IsNull(oFile) Then + With oFile + For Each sLine In Array_1D + .WriteLine(sLine) + Next sLine + .CloseFile() + End With + End If + + bExport = True + +Finally: + If Not IsNull(oFile) Then Set oFile = oFile.Dispose() + ExportToTextFile = bExport + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.ExportToTextFile + +REM ----------------------------------------------------------------------------- +Public Function ExtractColumn(Optional ByRef Array_2D As Variant _ + , Optional ByVal ColumnIndex As Variant _ + ) As Variant +''' ExtractColumn extracts from a 2D array a specific column +''' Args +''' Array_2D: the array from which to extract +''' ColumnIndex: the column to extract - must be in the interval [LBound, UBound] +''' Returns: +''' the extracted column. Its LBound and UBound are identical to that of the 1st dimension of Array_2D +''' Exceptions: +''' ARRAYINDEX1ERROR +''' Examples: +''' |1, 2, 3| +''' SF_Array.ExtractColumn( |4, 5, 6|, 2) returns (3, 6, 9) +''' |7, 8, 9| + +Dim vExtractColumn As Variant ' Return value +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound1 of input array +Dim lMax2 As Long ' UBound1 of input array +Dim i As Long +Const cstThisSub = "Array.ExtractColumn" +Const cstSubArgs = "Array_2D, ColumnIndex" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vExtractColumn = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally + If Not SF_Utils._Validate(ColumnIndex, "ColumnIndex", V_NUMERIC) Then GoTo Finally + End If + +Try: + ' Compute future dimensions of output array + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + If ColumnIndex < lMin2 Or ColumnIndex > lMax2 Then GoTo CatchIndex + lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + ReDim vExtractColumn(lMin1 To lMax1) + + ' Copy Column of input array to output array + For i = lMin1 To lMax1 + vExtractColumn(i) = Array_2D(i, ColumnIndex) + Next i + +Finally: + ExtractColumn = vExtractColumn() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchIndex: + SF_Exception.RaiseFatal(ARRAYINDEX1ERROR, "ColumnIndex", SF_Array._Repr(Array_2D), ColumnIndex) + GoTo Finally +End Function ' ScriptForge.SF_Array.ExtractColumn + +REM ----------------------------------------------------------------------------- +Public Function ExtractRow(Optional ByRef Array_2D As Variant _ + , Optional ByVal RowIndex As Variant _ + ) As Variant +''' ExtractRow extracts from a 2D array a specific row +''' Args +''' Array_2D: the array from which to extract +''' RowIndex: the row to extract - must be in the interval [LBound, UBound] +''' Returns: +''' the extracted row. Its LBound and UBound are identical to that of the 2nd dimension of Array_2D +''' Exceptions: +''' ARRAYINDEX1ERROR +''' Examples: +''' |1, 2, 3| +''' SF_Array.ExtractRow(|4, 5, 6|, 2) returns (7, 8, 9) +''' |7, 8, 9| + +Dim vExtractRow As Variant ' Return value +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound1 of input array +Dim lMax2 As Long ' UBound1 of input array +Dim i As Long +Const cstThisSub = "Array.ExtractRow" +Const cstSubArgs = "Array_2D, RowIndex" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vExtractRow = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally + If Not SF_Utils._Validate(RowIndex, "RowIndex", V_NUMERIC) Then GoTo Finally + End If + +Try: + ' Compute future dimensions of output array + lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + If RowIndex < lMin1 Or RowIndex > lMax1 Then GoTo CatchIndex + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + ReDim vExtractRow(lMin2 To lMax2) + + ' Copy row of input array to output array + For i = lMin2 To lMax2 + vExtractRow(i) = Array_2D(RowIndex, i) + Next i + +Finally: + ExtractRow = vExtractRow() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchIndex: + SF_Exception.RaiseFatal(ARRAYINDEX1ERROR, "RowIndex", SF_Array._Repr(Array_2D), RowIndex) + GoTo Finally +End Function ' ScriptForge.SF_Array.ExtractRow + +REM ----------------------------------------------------------------------------- +Public Function Flatten(Optional ByRef Array_1D As Variant) As Variant +''' Stack all items and all items in subarrays into one array without subarrays +''' Args +''' Array_1D: the pre-existing array, may be empty +''' Return: +''' The new flattened array. Its LBound is identical to that of Array_1D +''' If one of the subarrays has a number of dimensions > 1 Then that subarray is left unchanged +''' Examples: +''' SF_Array.Flatten(Array(1, 2, Array(3, 4, 5)) returns (1, 2, 3, 4, 5) + +Dim vFlatten As Variant ' Return value +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim lIndex As Long ' Index in output array +Dim vItem As Variant ' Array single item +Dim iDims As Integer ' Array number of dimensions +Dim lEmpty As Long ' Number of empty subarrays +Dim i As Long +Dim j As Long +Const cstThisSub = "Array.Flatten" +Const cstSubArgs = "Array_1D" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vFlatten = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + +Try: + If UBound(Array_1D) >= LBound(Array_1D) Then + lMin = LBound(Array_1D) : lMax = UBound(Array_1D) + ReDim vFlatten(lMin To lMax) ' Initial minimal sizing + lEmpty = 0 + lIndex = lMin - 1 + For i = lMin To lMax + vItem = Array_1D(i) + If IsArray(vItem) Then + iDims = SF_Array.CountDims(vItem) + Select Case iDims + Case 0 ' Empty arrays are ignored + lEmpty = lEmpty + 1 + Case 1 ' Only 1D subarrays are flattened + ReDim Preserve vFlatten(lMin To UBound(vFlatten) + UBound(vItem) - LBound(vItem)) + For j = LBound(vItem) To UBound(vItem) + lIndex = lIndex + 1 + vFlatten(lIndex) = vItem(j) + Next j + Case > 1 ' Other arrays are left unchanged + lIndex = lIndex + 1 + vFlatten(lIndex) = vItem + End Select + Else + lIndex = lIndex + 1 + vFlatten(lIndex) = vItem + End If + Next i + End If + ' Reduce size of output if Array_1D is populated with some empty arrays + If lEmpty > 0 Then + If lIndex - lEmpty < lMin Then + vFlatten = Array() + Else + ReDim Preserve vFlatten(lMin To UBound(vFlatten) - lEmpty) + End If + End If + +Finally: + Flatten = vFlatten() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Flatten + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Array.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function ImportFromCSVFile(Optional ByRef FileName As Variant _ + , Optional ByVal Delimiter As Variant _ + , Optional ByVal DateFormat As Variant _ + , Optional ByVal _IsoDate As Variant _ + ) As Variant +''' Import the data contained in a comma-separated values (CSV) file +''' The comma may be replaced by any character +''' Each line in the file contains a full record +''' Line splitting is not allowed) +''' However sequences like \n, \t, ... are left unchanged. Use SF_String.Unescape() to manage them +''' A special mechanism is implemented to load dates +''' The applicable CSV format is described in https://tools.ietf.org/html/rfc4180 +''' Args: +''' FileName: the name of the text file containing the data expressed as given by the current FileNaming +''' property of the SF_FileSystem service. Default = both URL format or native format +''' Delimiter: Default = ",". Other usual options are ";" and the tab character +''' DateFormat: either YYYY-MM-DD, DD-MM-YYYY or MM-DD-YYYY +''' The dash (-) may be replaced by a dot (.), a slash (/) or a space +''' Other date formats will be ignored +''' If "" (default), dates will be considered as strings +''' _IsoDate: when True, the execution is initiated from Python, do not convert dates to Date variables. Internal use only +''' Returns: +''' A 2D-array with each row corresponding with a single record read in the file +''' and each column corresponding with a field of the record +''' No check is made about the coherence of the field types across columns +''' A best guess will be made to identify numeric and date types +''' If a line contains less or more fields than the first line in the file, +''' an exception will be raised. Empty lines however are simply ignored +''' If the size of the file exceeds the number of items limit, a warning is raised +''' and the array is truncated +''' Exceptions: +''' CSVPARSINGERROR Given file is not formatted as a csv file +''' CSVOVERFLOWWARNING Maximum number of allowed items exceeded + +Dim vArray As Variant ' Returned array +Dim lCol As Long ' Index of last column of vArray +Dim lRow As Long ' Index of current row of vArray +Dim lFileSize As Long ' Number of records found in the file +Dim vCsv As Object ' CSV file handler +Dim sLine As String ' Last read line +Dim vLine As Variant ' Array of fields of last read line +Dim sItem As String ' Individual item in the file +Dim vItem As Variant ' Individual item in the output array +Dim iPosition As Integer ' Date position in individual item +Dim iYear As Integer, iMonth As Integer, iDay As Integer + ' Date components +Dim i As Long +Const cstItemsLimit = 250000 ' Maximum number of admitted items +Const cstThisSub = "Array.ImportFromCSVFile" +Const cstSubArgs = "FileName, [Delimiter="",""], [DateFormat=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vArray = Array() + +Check: + If IsMissing(Delimiter) Or IsEmpty(Delimiter) Then Delimiter = "," + If IsMissing(DateFormat) Or IsEmpty(DateFormat) Then DateFormat = "" + If IsMissing(_IsoDate) Or IsEmpty(_IsoDate) Then _IsoDate = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Delimiter, "Delimiter", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(DateFormat, "DateFormat", V_STRING) Then GoTo Finally + End If + If Len(Delimiter) = 0 Then Delimiter = "," + +Try: + ' Counts the lines present in the file to size the final array + ' Very beneficial for large files, better than multiple ReDims + ' Small overhead for small files + lFileSize = SF_FileSystem._CountTextLines(FileName, False) + If lFileSize <= 0 Then GoTo Finally + + ' Reread file line by line + Set vCsv = SF_FileSystem.OpenTextFile(FileName, IOMode := SF_FileSystem.ForReading) + If IsNull(vCsv) Then GoTo Finally ' Open error + lRow = -1 + With vCsv + Do While Not .AtEndOfStream + sLine = .ReadLine() + If Len(sLine) > 0 Then ' Ignore empty lines + If InStr(sLine, """") > 0 Then vLine = SF_String.SplitNotQuoted(sLine, Delimiter) Else vLine = Split(sLine, Delimiter) ' Simple split when relevant + lRow = lRow + 1 + If lRow = 0 Then ' Initial sizing of output array + lCol = UBound(vLine) + ReDim vArray(0 To lFileSize - 1, 0 To lCol) + ElseIf UBound(vLine) <> lCol Then + GoTo CatchCSVFormat + End If + ' Check type and copy all items of the line + For i = 0 To lCol + If Left(vLine(i), 1) = """" Then sItem = SF_String.Unquote(vLine(i)) Else sItem = vLine(i) ' Unquote only when useful + ' Interpret the individual line item + Select Case True + Case IsNumeric(sItem) + If InStr(sItem, ".") + InStr(1, sItem, "e", 1) > 0 Then vItem = Val(sItem) Else vItem = CLng(sItem) + Case DateFormat <> "" And Len(sItem) = Len(DateFormat) + If SF_String.IsADate(sItem, DateFormat) Then + iPosition = InStr(DateFormat, "YYYY") : iYear = CInt(Mid(sItem, iPosition, 4)) + iPosition = InStr(DateFormat, "MM") : iMonth = CInt(Mid(sItem, iPosition, 2)) + iPosition = InStr(DateFormat, "DD") : iDay = CInt(Mid(sItem, iPosition, 2)) + vItem = DateSerial(iYear, iMonth, iDay) + If _IsoDate Then vItem = SF_Utils._CDateToIso(vItem) ' Called from Python + Else + vItem = sItem + End If + Case Else : vItem = sItem + End Select + vArray(lRow, i) = vItem + Next i + End If + ' Provision to avoid very large arrays and their sometimes erratic behaviour + If (lRow + 2) * (lCol + 1) > cstItemsLimit Then + ReDim Preserve vArray(0 To lRow, 0 To lCol) + GoTo CatchOverflow + End If + Loop + End With + +Finally: + If Not IsNull(vCsv) Then + vCsv.CloseFile() + Set vCsv = vCsv.Dispose() + End If + ImportFromCSVFile = vArray + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchCSVFormat: + SF_Exception.RaiseFatal(CSVPARSINGERROR, FileName, vCsv.Line, sLine) + GoTo Finally +CatchOverflow: + 'TODO SF_Exception.RaiseWarning(SF_Exception.CSVOVERFLOWWARNING, cstThisSub) + 'MsgBox "TOO MUCH LINES !!" + GoTo Finally +End Function ' ScriptForge.SF_Array.ImportFromCSVFile + +REM ----------------------------------------------------------------------------- +Public Function IndexOf(Optional ByRef Array_1D As Variant _ + , Optional ByVal ToFind As Variant _ + , Optional ByVal CaseSensitive As Variant _ + , Optional ByVal SortOrder As Variant _ + ) As Long +''' Finds in a 1D array the ToFind number, string or date +''' ToFind must exist within the array. +''' The comparison between strings can be done case-sensitively or not +''' If the array is sorted then +''' the array must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' a binary search is done +''' Otherwise the array is scanned from top. Null or Empty items are simply ignored +''' Args: +''' Array_1D: the array to scan +''' ToFind: a number, a date or a string to find +''' CaseSensitive: Only for string comparisons, default = False +''' SortOrder: "ASC", "DESC" or "" (= not sorted, default) +''' Return: the index of the found item, LBound - 1 if not found +''' Result is unpredictable when array is announced sorted and is in reality not +''' Examples: +''' SF_Array.IndexOf(Array("A","B","c","D"), "C", SortOrder := "ASC") returns 2 +''' SF_Array.IndexOf(Array("A","B","c","D"), "C", CaseSensitive := True) returns -1 + +Dim vFindItem As Variant ' 2-items array (0) = True if found, (1) = Index where found +Dim lIndex As Long ' Return value +Dim iToFindType As Integer ' VarType of ToFind +Const cstThisSub = "Array.IndexOf" +Const cstSubArgs = "Array_1D, ToFind, [CaseSensitive=False], [SortOrder=""""|""ASC""|""DESC""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + lIndex = -1 + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(SortOrder, "SortOrder", V_STRING, Array("ASC", "DESC", "")) Then GoTo Finally + If Not SF_Utils._Validate(ToFind, "ToFind", Array(V_STRING, V_DATE, V_NUMERIC)) Then GoTo Finally + iToFindType = SF_Utils._VarTypeExt(ToFind) + If SortOrder <> "" Then + If Not SF_Utils._ValidateArray(Array_1D, "Array", 1, iToFindType) Then GoTo Finally + Else + If Not SF_Utils._ValidateArray(Array_1D, "Array", 1) Then GoTo Finally + End If + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + vFindItem = SF_Array._FindItem(Array_1D, ToFind, CaseSensitive, SortOrder) + If vFindItem(0) = True Then lIndex = vFindItem(1) Else lIndex = LBound(Array_1D) - 1 + +Finally: + IndexOf = lIndex + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.IndexOf + +REM ----------------------------------------------------------------------------- +Public Function Insert(Optional ByRef Array_1D As Variant _ + , Optional ByVal Before As Variant _ + , ParamArray pvArgs() As Variant _ + ) As Variant +''' Insert before the index Before of the input array the items listed as arguments +''' Arguments are inserted blindly +''' each of them might be a scalar of any type or a subarray +''' Args +''' Array_1D: the pre-existing array, may be empty +''' Before: the index before which to insert; must be in the interval [LBound, UBound + 1] +''' pvArgs: a list of items to Insert inside Array_1D +''' Returns: +''' the new rxtended array. Its LBound is identical to that of Array_1D +''' Exceptions: +''' ARRAYINSERTERROR +''' Examples: +''' SF_Array.Insert(Array(1, 2, 3), 2, 4, 5) returns (1, 2, 4, 5, 3) + +Dim vInsert As Variant ' Return value +Dim lNbArgs As Long ' Number of elements to Insert +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim i As Long +Const cstThisSub = "Array.Insert" +Const cstSubArgs = "Array_1D, Before, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vInsert = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + If Not SF_Utils._Validate(Before, "Before", V_NUMERIC) Then GoTo Finally + If Before < LBound(Array_1D) Or Before > UBound(Array_1D) + 1 Then GoTo CatchArgument + End If + +Try: + lNbArgs = UBound(pvArgs) + 1 ' pvArgs is always zero-based + lMin = LBound(Array_1D) ' = LBound(vInsert) + lMax = UBound(Array_1D) ' <> UBound(vInsert) + If lNbArgs > 0 Then + ReDim vInsert(lMin To lMax + lNbArgs) + For i = lMin To UBound(vInsert) + If i < Before Then + vInsert(i) = Array_1D(i) + ElseIf i < Before + lNbArgs Then + vInsert(i) = pvArgs(i - Before) + Else + vInsert(i) = Array_1D(i - lNbArgs) + End If + Next i + Else + vInsert() = Array_1D() + End If + +Finally: + Insert = vInsert() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchArgument: + 'TODO SF_Exception.RaiseFatal(ARRAYINSERTERROR, cstThisSub) + MsgBox "INVALID ARGUMENT VALUE !!" + GoTo Finally +End Function ' ScriptForge.SF_Array.Insert + +REM ----------------------------------------------------------------------------- +Public Function InsertSorted(Optional ByRef Array_1D As Variant _ + , Optional ByVal Item As Variant _ + , Optional ByVal SortOrder As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Insert in a sorted array a new item on its place +''' the array must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' Args: +''' Array_1D: the array to sort +''' Item: the scalar value to insert, same type as the existing array items +''' SortOrder: "ASC" (default) or "DESC" +''' CaseSensitive: Default = False +''' Returns: the extended sorted array with same LBound as input array +''' Examples: +''' InsertSorted(Array("A", "C", "a", "b"), "B", CaseSensitive := True) returns ("A", "B", "C", "a", "b") + +Dim vSorted() As Variant ' Return value +Dim iType As Integer ' VarType of elements in input array +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim lIndex As Long ' Place where to insert new item +Const cstThisSub = "Array.InsertSorted" +Const cstSubArgs = "Array_1D, Item, [SortOrder=""ASC""|""DESC""], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSorted = Array() + +Check: + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = "ASC" + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1, 0) Then GoTo Finally + If LBound(Array_1D) <= UBound(Array_1D) Then + iType = SF_Utils._VarTypeExt(Array_1D(LBound(Array_1D))) + If Not SF_Utils._Validate(Item, "Item", iType) Then GoTo Finally + Else + If Not SF_Utils._Validate(Item, "Item", Array(V_STRING, V_DATE, V_NUMERIC)) Then GoTo Finally + End If + If Not SF_Utils._Validate(SortOrder, "SortOrder", V_STRING, Array("ASC","DESC")) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin = LBound(Array_1D) + lMax = UBound(Array_1D) + lIndex = SF_Array._FindItem(Array_1D, Item, CaseSensitive, SortOrder)(1) + vSorted = SF_Array.Insert(Array_1D, lIndex, Item) + +Finally: + InsertSorted = vSorted() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.InsertSorted + +REM ----------------------------------------------------------------------------- +Public Function Intersection(Optional ByRef Array1_1D As Variant _ + , Optional ByRef Array2_1D As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Build a set being the intersection of the two input arrays, i.e. items are contained in both arrays +''' both input arrays must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' The comparison between strings is case sensitive or not +''' Args: +''' Array1_1D: a 1st input array +''' Array2_1D: a 2nd input array +''' CaseSensitive: default = False +''' Returns: a zero-based array containing unique items stored in both input arrays +''' The output array is sorted in ascending order +''' Examples: +''' Intersection(Array("A", "C", "A", "b", "B"), Array("C", "Z", "b"), True) returns ("C", "b") + +Dim vIntersection() As Variant ' Return value +Dim vSorted() As Variant ' The shortest input array after sort +Dim iType As Integer ' VarType of elements in input arrays +Dim lMin1 As Long ' LBound of 1st input array +Dim lMax1 As Long ' UBound of 1st input array +Dim lMin2 As Long ' LBound of 2nd input array +Dim lMax2 As Long ' UBound of 2nd input array +Dim lMin As Long ' LBound of unsorted array +Dim lMax As Long ' UBound of unsorted array +Dim iShortest As Integer ' 1 or 2 depending on shortest input array +Dim lSize As Long ' Number of Intersection items +Dim vItem As Variant ' One single item in the array +Dim i As Long +Const cstThisSub = "Array.Intersection" +Const cstSubArgs = "Array1_1D, Array2_1D, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vIntersection = Array() + +Check: + If IsMissing(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array1_1D, "Array1_1D", 1, 0, True) Then GoTo Finally + iType = SF_Utils._VarTypeExt(Array1_1D(LBound(Array1_1D))) + If Not SF_Utils._ValidateArray(Array2_1D, "Array2_1D", 1, iType, True) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin1 = LBound(Array1_1D) : lMax1 = UBound(Array1_1D) + lMin2 = LBound(Array2_1D) : lMax2 = UBound(Array2_1D) + + ' If one of both arrays is empty, do nothing + If lMax1 >= lMin1 And lMax2 >= lMin2 Then + + ' First sort the shortest array + If lMax1 - lMin1 <= lMax2 - lMin2 Then + iShortest = 1 + vSorted = SF_Array.Sort(Array1_1D, "ASC", CaseSensitive) + lMin = lMin2 : lMax = lMax2 ' Bounds of unsorted array + Else + iShortest = 2 + vSorted = SF_Array.Sort(Array2_1D, "ASC", CaseSensitive) + lMin = lMin1 : lMax = lMax1 ' Bounds of unsorted array + End If + + ' Resize the output array to the size of the shortest array + ReDim vIntersection(0 To (lMax - lMin)) + lSize = -1 + + ' Fill vIntersection one by one only with items present in both sets + For i = lMin To lMax + If iShortest = 1 Then vItem = Array2_1D(i) Else vItem = Array1_1D(i) ' Pick in unsorted array + If SF_Array.Contains(vSorted, vItem, CaseSensitive, "ASC") Then + lSize = lSize + 1 + vIntersection(lSize) = vItem + End If + Next i + + ' Remove unfilled entries and duplicates + If lSize >= 0 Then + ReDim Preserve vIntersection(0 To lSize) + vIntersection() = SF_Array.Unique(vIntersection, CaseSensitive) + Else + vIntersection = Array() + End If + End If + +Finally: + Intersection = vIntersection() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Intersection + +REM ----------------------------------------------------------------------------- +Public Function Join2D(Optional ByRef Array_2D As Variant _ + , Optional ByVal ColumnDelimiter As Variant _ + , Optional ByVal RowDelimiter As Variant _ + , Optional ByVal Quote As Variant _ + ) As String +''' Join a two-dimensional array with two delimiters, one for columns, one for rows +''' Args: +''' Array_2D: each item must be either a String, a number, a Date or a Boolean +''' ColumnDelimiter: delimits each column (default = Tab/Chr(9)) +''' RowDelimiter: delimits each row (default = LineFeed/Chr(10)) +''' Quote: if True, protect strings with double quotes (default = False) +''' Return: +''' A string after conversion of numbers and dates +''' Invalid items are replaced by a zero-length string +''' Examples: +''' | 1, 2, "A", [2020-02-29], 5 | +''' SF_Array.Join_2D( | 6, 7, "this is a string", 9, 10 | , ",", "/") +''' ' "1,2,A,2020-02-29 00:00:00,5/6,7,this is a string,9,10" + +Dim sJoin As String ' The return value +Dim sItem As String ' The string representation of a single item +Dim vItem As Variant ' Single item +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim i As Long +Dim j As Long +Const cstThisSub = "Array.Join2D" +Const cstSubArgs = "Array_2D, [ColumnDelimiter=Chr(9)], [RowDelimiter=Chr(10)], [Quote=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJoin = "" + +Check: + If IsMissing(ColumnDelimiter) Or IsEmpty(ColumnDelimiter) Then ColumnDelimiter = Chr(9) + If IsMissing(RowDelimiter) Or IsEmpty(RowDelimiter) Then RowDelimiter = Chr(10) + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally + If Not SF_Utils._Validate(ColumnDelimiter, "ColumnDelimiter", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(RowDelimiter, "RowDelimiter", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Quote, "Quote", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + If lMin1 <= lMax1 Then + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + vItem = Array_2D(i, j) + Select Case SF_Utils._VarTypeExt(vItem) + Case V_STRING : If Quote Then sItem = SF_String.Quote(vItem) Else sItem = vItem + Case V_NUMERIC, V_DATE : sItem = SF_Utils._Repr(vItem) + Case V_BOOLEAN : sItem = Iif(vItem, "True", "False") 'TODO: L10N + Case Else : sItem = "" + End Select + sJoin = sJoin & sItem & Iif(j < lMax2, ColumnDelimiter, "") + Next j + sJoin = sJoin & Iif(i < lMax1, RowDelimiter, "") + Next i + End If + +Finally: + Join2D = sJoin + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Join2D + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Array service as an array + + Methods = Array( _ + "Append" _ + , "AppendColumn" _ + , "AppendRow" _ + , "Contains" _ + , "ConvertToDictionary" _ + , "CountDims" _ + , "Difference" _ + , "ExportToTextFile" _ + , "ExtractColumn" _ + , "ExtractRow" _ + , "Flatten" _ + , "ImportFromCSVFile" _ + , "IndexOf" _ + , "Insert" _ + , "InsertSorted" _ + , "Intersection" _ + , "Join2D" _ + , "Prepend" _ + , "PrependColumn" _ + , "PrependRow" _ + , "RangeInit" _ + , "Reverse" _ + , "Shuffle" _ + , "Sort" _ + , "SortColumns" _ + , "SortRows" _ + , "Transpose" _ + , "TrimArray" _ + , "Union" _ + , "Unique" _ + ) + +End Function ' ScriptForge.SF_Array.Methods + +REM ----------------------------------------------------------------------------- +Public Function Prepend(Optional ByRef Array_1D As Variant _ + , ParamArray pvArgs() As Variant _ + ) As Variant +''' Prepend at the beginning of the input array the items listed as arguments +''' Arguments are Prepended blindly +''' each of them might be a scalar of any type or a subarray +''' Args +''' Array_1D: the pre-existing array, may be empty +''' pvArgs: a list of items to Prepend to Array_1D +''' Return: the new rxtended array. Its LBound is identical to that of Array_1D +''' Examples: +''' SF_Array.Prepend(Array(1, 2, 3), 4, 5) returns (4, 5, 1, 2, 3) + +Dim vPrepend As Variant ' Return value +Dim lNbArgs As Long ' Number of elements to Prepend +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim i As Long +Const cstThisSub = "Array.Prepend" +Const cstSubArgs = "Array_1D, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vPrepend = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + +Try: + lNbArgs = UBound(pvArgs) + 1 ' pvArgs is always zero-based + lMin = LBound(Array_1D) ' = LBound(vPrepend) + lMax = UBound(Array_1D) ' <> UBound(vPrepend) + If lMax < LBound(Array_1D) And lNbArgs > 0 Then ' Initial array is empty + ReDim vPrepend(0 To lNbArgs - 1) + Else + ReDim vPrepend(lMin To lMax + lNbArgs) + End If + For i = lMin To UBound(vPrepend) + If i < lMin + lNbArgs Then vPrepend(i) = pvArgs(i - lMin) Else vPrepend(i) = Array_1D(i - lNbArgs) + Next i + +Finally: + Prepend = vPrepend + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Prepend + +REM ----------------------------------------------------------------------------- +Public Function PrependColumn(Optional ByRef Array_2D As Variant _ + , Optional ByRef Column As Variant _ + ) As Variant +''' PrependColumn prepends to the left side of a 2D array a new Column +''' Args +''' Array_2D: the pre-existing array, may be empty +''' If the array has 1 dimension, it is considered as the last Column of the resulting 2D array +''' Column: a 1D array with as many items as there are rows in Array_2D +''' Returns: +''' the new rxtended array. Its LBounds are identical to that of Array_2D +''' Exceptions: +''' ARRAYINSERTERROR +''' Examples: +''' SF_Array.PrependColumn(Array(1, 2, 3), Array(4, 5, 6)) returns ((4, 1), (5, 2), (6, 3)) +''' x = SF_Array.PrependColumn(Array(), Array(1, 2, 3)) => ∀ i ∈ {0 ≤ i ≤ 2} : x(0, i) ≡ i + +Dim vPrependColumn As Variant ' Return value +Dim iDims As Integer ' Dimensions of Array_2D +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim lMin As Long ' LBound of Column array +Dim lMax As Long ' UBound of Column array +Dim i As Long +Dim j As Long +Const cstThisSub = "Array.PrependColumn" +Const cstSubArgs = "Array_2D, Column" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vPrependColumn = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D") Then GoTo Finally 'Initial check: not missing and array + If Not SF_Utils._ValidateArray(Column, "Column", 1) Then GoTo Finally + End If + iDims = SF_Array.CountDims(Array_2D) + If iDims > 2 Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally '2nd check to manage error + End If + +Try: + lMin = LBound(Column) + lMax = UBound(Column) + + ' Compute future dimensions of output array + Select Case iDims + Case 0 : lMin1 = lMin : lMax1 = lMax + lMin2 = 0 : lMax2 = -1 + Case 1 : lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = 0 : lMax2 = 0 + Case 2 : lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + End Select + If iDims > 0 And lMax - lMin <> lMax1 - lMin1 Then GoTo CatchColumn + ReDim vPrependColumn(lMin1 To lMax1, lMin2 To lMax2 + 1) + + ' Copy input array to output array + For i = lMin1 To lMax1 + For j = lMin2 + 1 To lMax2 + 1 + If iDims = 2 Then vPrependColumn(i, j) = Array_2D(i, j - 1) Else vPrependColumn(i, j) = Array_2D(i) + Next j + Next i + ' Copy new Column + For i = lMin1 To lMax1 + vPrependColumn(i, lMin2) = Column(i) + Next i + +Finally: + PrependColumn = vPrependColumn() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchColumn: + SF_Exception.RaiseFatal(ARRAYINSERTERROR, "Column", SF_Array._Repr(Array_2D), SF_Utils._Repr(Column, MAXREPR)) + GoTo Finally +End Function ' ScriptForge.SF_Array.PrependColumn + +REM ----------------------------------------------------------------------------- +Public Function PrependRow(Optional ByRef Array_2D As Variant _ + , Optional ByRef Row As Variant _ + ) As Variant +''' PrependRow prepends on top of a 2D array a new row +''' Args +''' Array_2D: the pre-existing array, may be empty +''' If the array has 1 dimension, it is considered as the last row of the resulting 2D array +''' Row: a 1D array with as many items as there are columns in Array_2D +''' Returns: +''' the new rxtended array. Its LBounds are identical to that of Array_2D +''' Exceptions: +''' ARRAYINSERTERROR +''' Examples: +''' SF_Array.PrependRow(Array(1, 2, 3), Array(4, 5, 6)) returns ((4, 5, 6), (1, 2, 3)) +''' x = SF_Array.PrependColumn(Array(), Array(1, 2, 3) => ∀ i ∈ {0 ≤ i ≤ 2} : x(i, 0) ≡ i + +Dim vPrependRow As Variant ' Return value +Dim iDims As Integer ' Dimensions of Array_2D +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim lMin As Long ' LBound of row array +Dim lMax As Long ' UBound of row array +Dim i As Long +Dim j As Long +Const cstThisSub = "Array.PrependRow" +Const cstSubArgs = "Array_2D, Row" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vPrependRow = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D") Then GoTo Finally 'Initial check: not missing and array + If Not SF_Utils._ValidateArray(Row, "Row", 1) Then GoTo Finally + End If + iDims = SF_Array.CountDims(Array_2D) + If iDims > 2 Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally '2nd check to manage error + End If + +Try: + lMin = LBound(Row) + lMax = UBound(Row) + + ' Compute future dimensions of output array + Select Case iDims + Case 0 : lMin1 = 0 : lMax1 = -1 + lMin2 = lMin : lMax2 = lMax + Case 1 : lMin1 = 0 : lMax1 = 0 + lMin2 = LBound(Array_2D, 1) : lMax2 = UBound(Array_2D, 1) + Case 2 : lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + End Select + If iDims > 0 And lMax - lMin <> lMax2 - lMin2 Then GoTo CatchRow + ReDim vPrependRow(lMin1 To lMax1 + 1, lMin2 To lMax2) + + ' Copy input array to output array + For i = lMin1 + 1 To lMax1 + 1 + For j = lMin2 To lMax2 + If iDims = 2 Then vPrependRow(i, j) = Array_2D(i - 1, j) Else vPrependRow(i, j) = Array_2D(j) + Next j + Next i + ' Copy new row + For j = lMin2 To lMax2 + vPrependRow(lMin1, j) = Row(j) + Next j + +Finally: + PrependRow = vPrependRow() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchRow: + SF_Exception.RaiseFatal(ARRAYINSERTERROR, "Row", SF_Array._Repr(Array_2D), SF_Utils._Repr(Row, MAXREPR)) + GoTo Finally +End Function ' ScriptForge.SF_Array.PrependRow + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties as an array + + Properties = Array( _ + ) + +End Function ' ScriptForge.SF_Array.Properties + +REM ----------------------------------------------------------------------------- +Public Function RangeInit(Optional ByVal From As Variant _ + , Optional ByVal UpTo As Variant _ + , Optional ByVal ByStep As Variant _ + ) As Variant +''' Initialize a new zero-based array with numeric values +''' Args: all numeric +''' From: value of first item +''' UpTo: last item should not exceed UpTo +''' ByStep: difference between 2 successive items +''' Return: the new array +''' Exceptions: +''' ARRAYSEQUENCEERROR Wrong arguments, f.i. UpTo < From with ByStep > 0 +''' Examples: +''' SF_Array.RangeInit(10, 1, -1) returns (10, 9, 8, 7, 6, 5, 4, 3, 2, 1) + +Dim lIndex As Long ' Index of array +Dim lSize As Long ' UBound of resulting array +Dim vCurrentItem As Variant ' Last stored item +Dim vArray() ' The return value +Const cstThisSub = "Array.RangeInit" +Const cstSubArgs = "From, UpTo, [ByStep = 1]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vArray = Array() + +Check: + If IsMissing(ByStep) Or IsEmpty(ByStep) Then ByStep = 1 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(From, "From", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(UpTo, "UpTo", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(ByStep, "ByStep", V_NUMERIC) Then GoTo Finally + End If + If (From < UpTo And ByStep <= 0) Or (From > UpTo And ByStep >= 0) Then GoTo CatchSequence + +Try: + lSize = CLng(Abs((UpTo - From) / ByStep)) + ReDim vArray(0 To lSize) + For lIndex = 0 To lSize + vArray(lIndex) = From + lIndex * ByStep + Next lIndex + +Finally: + RangeInit = vArray + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchSequence: + SF_Exception.RaiseFatal(ARRAYSEQUENCEERROR, From, UpTo, ByStep) + GoTo Finally +End Function ' ScriptForge.SF_Array.RangeInit + +REM ----------------------------------------------------------------------------- +Public Function Reverse(Optional ByRef Array_1D As Variant) As Variant +''' Return the reversed 1D input array +''' Args: +''' Array_1D: the array to reverse +''' Returns: the reversed array +''' Examples: +''' SF_Array.Reverse(Array(1, 2, 3, 4)) returns (4, 3, 2, 1) + +Dim vReverse() As Variant ' Return value +Dim lHalf As Long ' Middle of array +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim i As Long, j As Long +Const cstThisSub = "Array.Reverse" +Const cstSubArgs = "Array_1D" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vReverse = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + +Try: + lMin = LBound(Array_1D) + lMax = UBound(Array_1D) + ReDim vReverse(lMin To lMax) + lHalf = Int((lMax + lMin) / 2) + j = lMax + For i = lMin To lHalf + vReverse(i) = Array_1D(j) + vReverse(j) = Array_1D(i) + j = j - 1 + Next i + ' Odd number of items + If IsEmpty(vReverse(lHalf + 1)) Then vReverse(lHalf + 1) = Array_1D(lHalf + 1) + +Finally: + Reverse = vReverse() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Reverse + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Array.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function Shuffle(Optional ByRef Array_1D As Variant) As Variant +''' Returns a random permutation of a 1D array +''' https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle +''' Args: +''' Array_1D: the array to shuffle +''' Returns: the shuffled array + +Dim vShuffle() As Variant ' Return value +Dim vSwapValue As Variant ' Intermediate value during swap +Dim lMin As Long ' LBound of Array_1D +Dim lCurrentIndex As Long ' Decremented from UBount to LBound +Dim lRandomIndex As Long ' Random between LBound and lCurrentIndex +Dim i As Long +Const cstThisSub = "Array.Shuffle" +Const cstSubArgs = "Array_1D" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vShuffle = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + +Try: + lMin = LBound(Array_1D) + lCurrentIndex = UBound(array_1D) + ' Initialize the output array + ReDim vShuffle(lMin To lCurrentIndex) + For i = lMin To lCurrentIndex + vShuffle(i) = Array_1D(i) + Next i + ' Now ... shuffle ! + Do While lCurrentIndex > lMin + lRandomIndex = Int(Rnd * (lCurrentIndex - lMin)) + lMin + vSwapValue = vShuffle(lCurrentIndex) + vShuffle(lCurrentIndex) = vShuffle(lRandomIndex) + vShuffle(lRandomIndex) = vSwapValue + lCurrentIndex = lCurrentIndex - 1 + Loop + +Finally: + Shuffle = vShuffle() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Shuffle + +REM ----------------------------------------------------------------------------- +Public Function Slice(Optional ByRef Array_1D As Variant _ + , Optional ByVal From As Variant _ + , Optional ByVal UpTo As Variant _ + ) As Variant +''' Returns a subset of a 1D array +''' Args: +''' Array_1D: the array to slice +''' From: the lower index of the subarray to extract (included) +''' UpTo: the upper index of the subarray to extract (included). Default = the last item of Array_1D +''' Returns: +''' The selected subarray with the same LBound as the input array. +''' If UpTo < From then the returned array is empty +''' Exceptions: +''' ARRAYINDEX2ERROR Wrong values for From and/or UpTo +''' Example: +''' SF_Array.Slice(Array(1, 2, 3, 4, 5), 1, 3) returns (2, 3, 4) + +Dim vSlice() As Variant ' Return value +Dim lMin As Long ' LBound of Array_1D +Dim lIndex As Long ' Current index in output array +Dim i As Long +Const cstThisSub = "Array.Slice" +Const cstSubArgs = "Array_1D, From, [UpTo = UBound(Array_1D)]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSlice = Array() + +Check: + If IsMissing(UpTo) Or IsEmpty(UpTo) Then UpTo = -1 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + If Not SF_Utils._Validate(From, "From", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(UpTo, "UpTo", V_NUMERIC) Then GoTo Finally + End If + If UpTo = -1 Then UpTo = UBound(Array_1D) + If From < LBound(Array_1D) Or From > UBound(Array_1D) _ + Or From > UpTo Or UpTo > UBound(Array_1D) Then GoTo CatchIndex + +Try: + If UpTo >= From Then + lMin = LBound(Array_1D) + ' Initialize the output array + ReDim vSlice(lMin To lMin + UpTo - From) + lIndex = lMin - 1 + For i = From To UpTo + lIndex = lIndex + 1 + vSlice(lIndex) = Array_1D(i) + Next i + End If + +Finally: + Slice = vSlice() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchIndex: + SF_Exception.RaiseFatal(ARRAYINDEX2ERROR, SF_Array._Repr(Array_1D), From, UpTo) + GoTo Finally +End Function ' ScriptForge.SF_Array.Slice + +REM ----------------------------------------------------------------------------- +Public Function Sort(Optional ByRef Array_1D As Variant _ + , Optional ByVal SortOrder As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Sort a 1D array in ascending or descending order. String comparisons can be case-sensitive or not +''' Args: +''' Array_1D: the array to sort +''' must be filled homogeneously by either strings, dates or numbers +''' Null and Empty values are allowed +''' SortOrder: "ASC" (default) or "DESC" +''' CaseSensitive: Default = False +''' Returns: the sorted array +''' Examples: +''' Sort(Array("a", "A", "b", "B", "C"), CaseSensitive := True) returns ("A", "B", "C", "a", "b") + +Dim vSort() As Variant ' Return value +Dim vIndexes() As Variant ' Indexes of sorted items +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim i As Long +Const cstThisSub = "Array.Sort" +Const cstSubArgs = "Array_1D, [SortOrder=""""|""ASC""|""DESC""], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSort = Array() + +Check: + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = "ASC" + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1, 0) Then GoTo Finally + If Not SF_Utils._Validate(SortOrder, "SortOrder", V_STRING, Array("ASC","DESC")) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin = LBound(Array_1D) + lMax = UBound(Array_1D) + vIndexes() = SF_Array._HeapSort(Array_1D, ( SortOrder = "ASC" ), CaseSensitive) + + ' Load output array + ReDim vSort(lMin To lMax) + For i = lMin To lMax + vSort(i) = Array_1D(vIndexes(i)) + Next i + +Finally: + Sort = vSort() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Sort + +REM ----------------------------------------------------------------------------- +Public Function SortColumns(Optional ByRef Array_2D As Variant _ + , Optional ByVal RowIndex As Variant _ + , Optional ByVal SortOrder As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Returns a permutation of the columns of a 2D array, sorted on the values of a given row +''' Args: +''' Array_2D: the input array +''' RowIndex: the index of the row to sort the columns on +''' the row must be filled homogeneously by either strings, dates or numbers +''' Null and Empty values are allowed +''' SortOrder: "ASC" (default) or "DESC" +''' CaseSensitive: Default = False +''' Returns: +''' the array with permuted columns, LBounds and UBounds are unchanged +''' Exceptions: +''' ARRAYINDEXERROR +''' Examples: +''' | 5, 7, 3 | | 7, 5, 3 | +''' SF_Array.SortColumns( | 1, 9, 5 |, 2, "ASC") returns | 9, 1, 5 | +''' | 6, 1, 8 | | 1, 6, 8 | + +Dim vSort() As Variant ' Return value +Dim vRow() As Variant ' The row on which to sort the array +Dim vIndexes() As Variant ' Indexes of sorted row +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim i As Long, j As Long +Const cstThisSub = "Array.SortColumn" +Const cstSubArgs = "Array_2D, RowIndex, [SortOrder=""""|""ASC""|""DESC""], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSort = Array() + +Check: + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = "ASC" + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally + If Not SF_Utils._Validate(RowIndex, "RowIndex", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(SortOrder, "SortOrder", V_STRING, Array("ASC","DESC")) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + If RowIndex < lMin1 Or RowIndex > lMax1 Then GoTo CatchIndex + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + + ' Extract and sort the RowIndex-th row + vRow = SF_Array.ExtractRow(Array_2D, RowIndex) + If Not SF_Utils._ValidateArray(vRow, "Row #" & CStr(RowIndex), 1, 0) Then GoTo Finally + vIndexes() = SF_Array._HeapSort(vRow, ( SortOrder = "ASC" ), CaseSensitive) + + ' Load output array + ReDim vSort(lMin1 To lMax1, lMin2 To lMax2) + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + vSort(i, j) = Array_2D(i, vIndexes(j)) + Next j + Next i + +Finally: + SortColumns = vSort() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchIndex: + 'TODO SF_Exception.RaiseFatal(ARRAYINDEXERROR, cstThisSub) + MsgBox "INVALID INDEX VALUE !!" + GoTo Finally +End Function ' ScriptForge.SF_Array.SortColumns + +REM ----------------------------------------------------------------------------- +Public Function SortRows(Optional ByRef Array_2D As Variant _ + , Optional ByVal ColumnIndex As Variant _ + , Optional ByVal SortOrder As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Returns a permutation of the rows of a 2D array, sorted on the values of a given column +''' Args: +''' Array_2D: the input array +''' ColumnIndex: the index of the column to sort the rows on +''' the column must be filled homogeneously by either strings, dates or numbers +''' Null and Empty values are allowed +''' SortOrder: "ASC" (default) or "DESC" +''' CaseSensitive: Default = False +''' Returns: +''' the array with permuted Rows, LBounds and UBounds are unchanged +''' Exceptions: +''' ARRAYINDEXERROR +''' Examples: +''' | 5, 7, 3 | | 1, 9, 5 | +''' SF_Array.SortRows( | 1, 9, 5 |, 0, "ASC") returns | 5, 7, 3 | +''' | 6, 1, 8 | | 6, 1, 8 | + +Dim vSort() As Variant ' Return value +Dim vCol() As Variant ' The column on which to sort the array +Dim vIndexes() As Variant ' Indexes of sorted row +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim i As Long, j As Long +Const cstThisSub = "Array.SortRow" +Const cstSubArgs = "Array_2D, ColumnIndex, [SortOrder=""""|""ASC""|""DESC""], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSort = Array() + +Check: + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = "ASC" + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally + If Not SF_Utils._Validate(ColumnIndex, "ColumnIndex", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(SortOrder, "SortOrder", V_STRING, Array("ASC","DESC")) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + If ColumnIndex < lMin2 Or ColumnIndex > lMax2 Then GoTo CatchIndex + lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + + ' Extract and sort the ColumnIndex-th column + vCol = SF_Array.ExtractColumn(Array_2D, ColumnIndex) + If Not SF_Utils._ValidateArray(vCol, "Column #" & CStr(ColumnIndex), 1, 0) Then GoTo Finally + vIndexes() = SF_Array._HeapSort(vCol, ( SortOrder = "ASC" ), CaseSensitive) + + ' Load output array + ReDim vSort(lMin1 To lMax1, lMin2 To lMax2) + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + vSort(i, j) = Array_2D(vIndexes(i), j) + Next j + Next i + +Finally: + SortRows = vSort() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchIndex: + 'TODO SF_Exception.RaiseFatal(ARRAYINDEXERROR, cstThisSub) + MsgBox "INVALID INDEX VALUE !!" + GoTo Finally +End Function ' ScriptForge.SF_Array.SortRows + +REM ----------------------------------------------------------------------------- +Public Function Transpose(Optional ByRef Array_2D As Variant) As Variant +''' Swaps rows and columns in a 2D array +''' Args: +''' Array_2D: the array to transpose +''' Returns: +''' The transposed array +''' Examples: +''' | 1, 2 | | 1, 3, 5 | +''' SF_Array.Transpose( | 3, 4 | ) returns | 2, 4, 6 | +''' | 5, 6 | + +Dim vTranspose As Variant ' Return value +Dim lIndex As Long ' vTranspose index +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim i As Long, j As Long +Const cstThisSub = "Array.Transpose" +Const cstSubArgs = "Array_2D" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vTranspose = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_2D, "Array_2D", 2) Then GoTo Finally + End If + +Try: + ' Resize the output array + lMin1 = LBound(Array_2D, 1) : lMax1 = UBound(Array_2D, 1) + lMin2 = LBound(Array_2D, 2) : lMax2 = UBound(Array_2D, 2) + If lMin1 <= lMax1 Then + ReDim vTranspose(lMin2 To lMax2, lMin1 To lMax1) + End If + + ' Transpose items + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + vTranspose(j, i) = Array_2D(i, j) + Next j + Next i + +Finally: + Transpose = vTranspose + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Transpose + +REM ----------------------------------------------------------------------------- +Public Function TrimArray(Optional ByRef Array_1D As Variant) As Variant +''' Remove from a 1D array all Null, Empty and zero-length entries +''' Strings are trimmed as well +''' Args: +''' Array_1D: the array to scan +''' Return: The trimmed array +''' Examples: +''' SF_Array.TrimArray(Array("A","B",Null," D ")) returns ("A","B","D") + +Dim vTrimArray As Variant ' Return value +Dim lIndex As Long ' vTrimArray index +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim vItem As Variant ' Single array item +Dim i As Long +Const cstThisSub = "Array.TrimArray" +Const cstSubArgs = "Array_1D" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vTrimArray = Array() + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1) Then GoTo Finally + End If + +Try: + lMin = LBound(Array_1D) + lMax = UBound(Array_1D) + If lMin <= lMax Then + ReDim vTrimArray(lMin To lMax) + End If + lIndex = lMin - 1 + + ' Load only valid items from Array_1D to vTrimArray + For i = lMin To lMax + vItem = Array_1D(i) + Select Case VarType(vItem) + Case V_EMPTY + Case V_NULL : vItem = Empty + Case V_STRING + vItem = Trim(vItem) + If Len(vItem) = 0 Then vItem = Empty + Case Else + End Select + If Not IsEmpty(vItem) Then + lIndex = lIndex + 1 + vTrimArray(lIndex) = vItem + End If + Next i + + 'Keep valid entries + If lMin <= lIndex Then + ReDim Preserve vTrimArray(lMin To lIndex) + Else + vTrimArray = Array() + End If + +Finally: + TrimArray = vTrimArray + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.TrimArray + +REM ----------------------------------------------------------------------------- +Public Function Union(Optional ByRef Array1_1D As Variant _ + , Optional ByRef Array2_1D As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Build a set being the Union of the two input arrays, i.e. items are contained in any of both arrays +''' both input arrays must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' The comparison between strings is case sensitive or not +''' Args: +''' Array1_1D: a 1st input array +''' Array2_1D: a 2nd input array +''' CaseSensitive: default = False +''' Returns: a zero-based array containing unique items stored in any of both input arrays +''' The output array is sorted in ascending order +''' Examples: +''' SF_Array.Union(Array("A", "C", "A", "b", "B"), Array("C", "Z", "b"), True) returns ("A", "B", "C", "Z", "b") + +Dim vUnion() As Variant ' Return value +Dim iType As Integer ' VarType of elements in input arrays +Dim lMin1 As Long ' LBound of 1st input array +Dim lMax1 As Long ' UBound of 1st input array +Dim lMin2 As Long ' LBound of 2nd input array +Dim lMax2 As Long ' UBound of 2nd input array +Dim lSize As Long ' Number of Union items +Dim i As Long +Const cstThisSub = "Array.Union" +Const cstSubArgs = "Array1_1D, Array2_1D, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vUnion = Array() + +Check: + If IsMissing(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array1_1D, "Array1_1D", 1, 0, True) Then GoTo Finally + iType = SF_Utils._VarTypeExt(Array1_1D(LBound(Array1_1D))) + If Not SF_Utils._ValidateArray(Array2_1D, "Array2_1D", 1, iType, True) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin1 = LBound(Array1_1D) : lMax1 = UBound(Array1_1D) + lMin2 = LBound(Array2_1D) : lMax2 = UBound(Array2_1D) + + ' If both arrays are empty, do nothing + If lMax1 < lMin1 And lMax2 < lMin2 Then + ElseIf lMax1 < lMin1 Then ' only 1st array is empty + vUnion = SF_Array.Unique(Array2_1D, CaseSensitive) + ElseIf lMax2 < lMin2 Then ' only 2nd array is empty + vUnion = SF_Array.Unique(Array1_1D, CaseSensitive) + Else + + ' Build union of both arrays + ReDim vUnion(0 To (lMax1 - lMin1) + (lMax2 - lMin2) + 1) + lSize = -1 + + ' Fill vUnion one by one only with items present in any set + For i = lMin1 To lMax1 + lSize = lSize + 1 + vUnion(lSize) = Array1_1D(i) + Next i + For i = lMin2 To lMax2 + lSize = lSize + 1 + vUnion(lSize) = Array2_1D(i) + Next i + + ' Remove duplicates + vUnion() = SF_Array.Unique(vUnion, CaseSensitive) + End If + +Finally: + Union = vUnion() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Union + +REM ----------------------------------------------------------------------------- +Public Function Unique(Optional ByRef Array_1D As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Variant +''' Build a set of unique values derived from the input array +''' the input array must be filled homogeneously, i.e. all items must be of the same type +''' Empty and Null items are forbidden +''' The comparison between strings is case sensitive or not +''' Args: +''' Array_1D: the input array with potential duplicates +''' CaseSensitive: default = False +''' Returns: the array without duplicates with same LBound as input array +''' The output array is sorted in ascending order +''' Examples: +''' Unique(Array("A", "C", "A", "b", "B"), True) returns ("A", "B", "C", "b") + +Dim vUnique() As Variant ' Return value +Dim vSorted() As Variant ' The input array after sort +Dim lMin As Long ' LBound of input array +Dim lMax As Long ' UBound of input array +Dim lUnique As Long ' Number of unique items +Dim vIndex As Variant ' Output of _FindItem() method +Dim vItem As Variant ' One single item in the array +Dim i As Long +Const cstThisSub = "Array.Unique" +Const cstSubArgs = "Array_1D, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vUnique = Array() + +Check: + If IsMissing(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(Array_1D, "Array_1D", 1, 0, True) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lMin = LBound(Array_1D) + lMax = UBound(Array_1D) + If lMax >= lMin Then + ' First sort the array + vSorted = SF_Array.Sort(Array_1D, "ASC", CaseSensitive) + ReDim vUnique(lMin To lMax) + lUnique = lMin + ' Fill vUnique one by one ignoring duplicates + For i = lMin To lMax + vItem = vSorted(i) + If i = lMin Then + vUnique(i) = vItem + Else + If SF_Array._ValCompare(vItem, vSorted(i - 1), CaseSensitive) = 0 Then ' Ignore item + Else + lUnique = lUnique + 1 + vUnique(lUnique) = vItem + End If + End If + Next i + ' Remove unfilled entries + ReDim Preserve vUnique(lMin To lUnique) + End If + +Finally: + Unique = vUnique() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.Unique + +REM ============================================================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Public Function _FindItem(ByRef pvArray_1D As Variant _ + , ByVal pvToFind As Variant _ + , ByVal pbCaseSensitive As Boolean _ + , ByVal psSortOrder As String _ + ) As Variant +''' Check if a 1D array contains the ToFind number, string or date and return its index +''' The comparison between strings can be done case-sensitively or not +''' If the array is sorted then a binary search is done +''' Otherwise the array is scanned from top. Null or Empty items are simply ignored +''' Args: +''' pvArray_1D: the array to scan +''' pvToFind: a number, a date or a string to find +''' pbCaseSensitive: Only for string comparisons, default = False +''' psSortOrder: "ASC", "DESC" or "" (= not sorted, default) +''' Return: a (0:1) array +''' (0) = True when found +''' (1) = if found: index of item +''' if not found: if sorted, index of next item in the array (might be = UBound + 1) +''' if not sorted, meaningless +''' Result is unpredictable when array is announced sorted and is in reality not +''' Called by Contains, IndexOf and InsertSorted. Also called by SF_Dictionary + +Dim bContains As Boolean ' True if match found +Dim iToFindType As Integer ' VarType of pvToFind +Dim lTop As Long, lBottom As Long ' Interval in scope of binary search +Dim lIndex As Long ' Index used in search +Dim iCompare As Integer ' Output of _ValCompare function +Dim lLoops As Long ' Count binary searches +Dim lMaxLoops As Long ' Max number of loops during binary search: to avoid infinite loops if array not sorted +Dim vFound(1) As Variant ' Returned array (Contains, Index) + + bContains = False + + If LBound(pvArray_1D) > UBound(pvArray_1D) Then ' Empty array, do nothing + Else + ' Search sequentially + If Len(psSortOrder) = 0 Then + For lIndex = LBound(pvArray_1D) To UBound(pvArray_1D) + bContains = ( SF_Array._ValCompare(pvToFind, pvArray_1D(lIndex), pbCaseSensitive) = 0 ) + If bContains Then Exit For + Next lIndex + Else + ' Binary search + If psSortOrder = "ASC" Then + lTop = UBound(pvArray_1D) + lBottom = lBound(pvArray_1D) + Else + lBottom = UBound(pvArray_1D) + lTop = lBound(pvArray_1D) + End If + lLoops = 0 + lMaxLoops = CLng((Log(UBound(pvArray_1D) - LBound(pvArray_1D) + 1.0) / Log(2.0))) + 1 + Do + lLoops = lLoops + 1 + lIndex = (lTop + lBottom) / 2 + iCompare = SF_Array._ValCompare(pvToFind, pvArray_1D(lIndex), pbCaseSensitive) + Select Case True + Case iCompare = 0 : bContains = True + Case iCompare < 0 And psSortOrder = "ASC" + lTop = lIndex - 1 + Case iCompare > 0 And psSortOrder = "DESC" + lBottom = lIndex - 1 + Case iCompare > 0 And psSortOrder = "ASC" + lBottom = lIndex + 1 + Case iCompare < 0 And psSortOrder = "DESC" + lTop = lIndex + 1 + End Select + Loop Until ( bContains ) Or ( lBottom > lTop And psSortOrder = "ASC" ) Or (lBottom < lTop And psSortOrder = "DESC" ) Or lLoops > lMaxLoops + ' Flag first next non-matching element + If Not bContains Then lIndex = Iif(psSortOrder = "ASC", lBottom, lTop) + End If + End If + + ' Build output array + vFound(0) = bContains + vFound(1) = lIndex + _FindItem = vFound + +End Function ' ScriptForge.SF_Array._FindItem + +REM ----------------------------------------------------------------------------- +Private Function _HeapSort(ByRef pvArray As Variant _ + , Optional ByVal pbAscending As Boolean _ + , Optional ByVal pbCaseSensitive As Boolean _ + ) As Variant +''' Sort an array: items are presumed all strings, all dates or all numeric +''' Null or Empty are allowed and are considered smaller than other items +''' https://en.wikipedia.org/wiki/Heapsort +''' http://www.vbforums.com/showthread.php?473677-VB6-Sorting-algorithms-(sort-array-sorting-arrays)&p=2909250#post2909250 +''' HeapSort preferred to QuickSort because not recursive (this routine returns an array of indexes !!) +''' Args: +''' pvArray: a 1D array +''' pbAscending: default = True +''' pbCaseSensitive: default = False +''' Returns +''' An array of Longs of same dimensions as the input array listing the indexes of the sorted items +''' An empty array if the sort failed +''' Examples: +''' _HeapSort(Array(4, 2, 6, 1) returns (3, 1, 0, 2) + +Dim vIndexes As Variant ' Return value +Dim i As Long +Dim lMin As Long, lMax As Long ' Array bounds +Dim lSwap As Long ' For index swaps + + If IsMissing(pbAscending) Then pbAscending = True + If IsMissing(pbCaseSensitive) Then pbCaseSensitive = False + vIndexes = Array() + lMin = LBound(pvArray, 1) + lMax = UBound(pvArray, 1) + + ' Initialize output array + ReDim vIndexes(lMin To lMax) + For i = lMin To lMax + vIndexes(i) = i + Next i + + ' Initial heapify + For i = (lMax + lMin) \ 2 To lMin Step -1 + SF_Array._HeapSort1(pvArray, vIndexes, i, lMin, lMax, pbCaseSensitive) + Next i + ' Next heapify + For i = lMax To lMin + 1 Step -1 + ' Only indexes as swapped, not the array items themselves + lSwap = vIndexes(i) + vIndexes(i) = vIndexes(lMin) + vIndexes(lMin) = lSwap + SF_Array._HeapSort1(pvArray, vIndexes, lMin, lMin, i - 1, pbCaseSensitive) + Next i + + If pbAscending Then _HeapSort = vIndexes() Else _HeapSort = SF_Array.Reverse(vIndexes()) + +End Function ' ScriptForge.SF_Array._HeapSort + +REM ----------------------------------------------------------------------------- +Private Sub _HeapSort1(ByRef pvArray As Variant _ + , ByRef pvIndexes As Variant _ + , ByVal plIndex As Long _ + , ByVal plMin As Long _ + , ByVal plMax As Long _ + , ByVal pbCaseSensitive As Boolean _ + ) +''' Sub called by _HeapSort only + + Dim lLeaf As Long + Dim lSwap As Long + + Do + lLeaf = plIndex + plIndex - (plMin - 1) + Select Case lLeaf + Case Is > plMax: Exit Do + Case Is < plMax + If SF_Array._ValCompare(pvArray(pvIndexes(lLeaf + 1)), pvArray(pvIndexes(lLeaf)), pbCaseSensitive) > 0 Then lLeaf = lLeaf + 1 + End Select + If SF_Array._ValCompare(pvArray(pvIndexes(plIndex)), pvArray(pvIndexes(lLeaf)), pbCaseSensitive) > 0 Then Exit Do + ' Only indexes as swapped, not the array items themselves + lSwap = pvIndexes(plIndex) + pvIndexes(plIndex) = pvIndexes(lLeaf) + pvIndexes(lLeaf) = lSwap + plIndex = lLeaf + Loop + +End Sub ' ScriptForge.SF_Array._HeapSort1 + +REM ----------------------------------------------------------------------------- +Private Function _Repr(ByRef pvArray As Variant) As String +''' Convert array to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' pvArray: the array to convert, individual items may be of any type, including arrays +''' Return: +''' "[ARRAY] (L:U[, L:U]...)" if # of Dims > 1 +''' "[ARRAY] (L:U) (item1,item2, ...)" if 1D array + +Dim iDims As Integer ' Number of dimensions of the array +Dim sArray As String ' Return value +Dim i As Long +Const cstArrayEmpty = "[ARRAY] ()" +Const cstArray = "[ARRAY]" +Const cstMaxLength = 50 ' Maximum length for items +Const cstSeparator = ", " + + _Repr = "" + iDims = SF_Array.CountDims(pvArray) + + Select Case iDims + Case -1 : Exit Function ' Not an array + Case 0 : sArray = cstArrayEmpty + Case Else + sArray = cstArray + For i = 1 To iDims + sArray = sArray & Iif(i = 1, " (", ", ") & CStr(LBound(pvArray, i)) & ":" & CStr(UBound(pvArray, i)) + Next i + sArray = sArray & ")" + ' List individual items of 1D arrays + If iDims = 1 Then + sArray = sArray & " (" + For i = LBound(pvArray) To UBound(pvArray) + sArray = sArray & SF_Utils._Repr(pvArray(i), cstMaxLength) & cstSeparator ' Recursive call + Next i + sArray = Left(sArray, Len(sArray) - Len(cstSeparator)) ' Suppress last comma + sArray = sArray & ")" + End If + End Select + + _Repr = sArray + +End Function ' ScriptForge.SF_Array._Repr + +REM ----------------------------------------------------------------------------- +Public Function _StaticType(ByRef pvArray As Variant) As Integer +''' If array is static, return its type +''' Args: +''' pvArray: array to examine +''' Return: +''' array type, -1 if not identified +''' All numeric types are aggregated into V_NUMERIC + +Dim iArrayType As Integer ' VarType of array +Dim iType As Integer ' VarType of items + + iArrayType = VarType(pvArray) + iType = iArrayType - V_ARRAY + Select Case iType + Case V_INTEGER, V_LONG, V_SINGLE, V_DOUBLE, V_CURRENCY, V_BIGINT, V_DECIMAL, V_BOOLEAN + _StaticType = V_NUMERIC + Case V_STRING, V_DATE + _StaticType = iType + Case Else + _StaticType = -1 + End Select + +End Function ' ScriptForge.SF_Utils._StaticType + +REM ----------------------------------------------------------------------------- +Private Function _ValCompare(ByVal pvValue1 As Variant _ + , pvValue2 As Variant _ + , Optional ByVal pbCaseSensitive As Boolean _ + ) As Integer +''' Compare 2 values : equality, greater than or smaller than +''' Args: +''' pvValue1 and pvValue2: values to compare. pvValues must be String, Number, Date, Empty or Null +''' By convention: Empty < Null < string, number or date +''' pbCaseSensitive: ignored when not String comparison +''' Return: -1 when pvValue1 < pvValue2 +''' +1 when pvValue1 > pvValue2 +''' 0 when pvValue1 = pvValue2 +''' -2 when comparison is nonsense + +Dim iCompare As Integer, iVarType1 As Integer, iVarType2 As Integer + + If IsMissing(pbCaseSensitive) Then pbCaseSensitive = False + iVarType1 = SF_Utils._VarTypeExt(pvValue1) + iVarType2 = SF_Utils._VarTypeExt(pvValue2) + + iCompare = -2 + If iVarType1 = V_OBJECT Or iVarType1 = V_BYTE Or iVarType1 >= V_ARRAY Then ' Nonsense + ElseIf iVarType2 = V_OBJECT Or iVarType2 = V_BYTE Or iVarType2 >= V_ARRAY Then ' Nonsense + ElseIf iVarType1 = V_STRING And iVarType2 = V_STRING Then + iCompare = StrComp(pvValue1, pvValue2, Iif(pbCaseSensitive, 1, 0)) + ElseIf iVarType1 = V_NULL Or iVarType1 = V_EMPTY Or iVarType2 = V_NULL Or iVarType2 = V_EMPTY Then + Select Case True + Case pvValue1 = pvValue2 : iCompare = 0 + Case iVarType1 = V_NULL And iVarType2 = V_EMPTY : iCompare = +1 + Case iVarType1 = V_EMPTY And iVarType2 = V_NULL : iCompare = -1 + Case iVarType1 = V_NULL Or iVarType1 = V_EMPTY : iCompare = -1 + Case iVarType2 = V_NULL Or iVarType2 = V_EMPTY : iCompare = +1 + End Select + ElseIf iVarType1 = iVarType2 Then + Select Case True + Case pvValue1 < pvValue2 : iCompare = -1 + Case pvValue1 = pvValue2 : iCompare = 0 + Case pvValue1 > pvValue2 : iCompare = +1 + End Select + End If + + _ValCompare = iCompare + +End Function ' ScriptForge.SF_Array._ValCompare + +REM ================================================= END OF SCRIPTFORGE.SF_ARRAY +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Dictionary.xba b/wizards/source/scriptforge/SF_Dictionary.xba new file mode 100644 index 000000000..22ada5148 --- /dev/null +++ b/wizards/source/scriptforge/SF_Dictionary.xba @@ -0,0 +1,959 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Dictionary" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Dictionary +''' ============= +''' Class for management of dictionaries +''' A dictionary is a collection of key-item pairs +''' The key is a not case-sensitive string +''' Items may be of any type +''' Keys, items can be retrieved, counted, etc. +''' +''' The implementation is based on +''' - one collection mapping keys and entries in the array +''' - one 1-column array: key + data +''' +''' Why a Dictionary class beside the builtin Collection class ? +''' A standard Basic collection does not support the retrieval of the keys +''' Additionally it may contain only simple data (strings, numbers, ...) +''' +''' Service instantiation example: +''' Dim myDict As Variant +''' myDict = CreateScriptService("Dictionary") ' Once per dictionary +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dictionary.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR" ' Key exists already +Const UNKNOWNKEYERROR = "UNKNOWNKEYERROR" ' Key not found +Const INVALIDKEYERROR = "INVALIDKEYERROR" ' Key contains only spaces + +REM ============================================================= PRIVATE MEMBERS + +' Defines an entry in the MapItems array +Type ItemMap + Key As String + Value As Variant +End Type + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be "DICTIONARY" +Private ServiceName As String +Private MapKeys As Variant ' To retain the original keys +Private MapItems As Variant ' Array of ItemMaps +Private _MapSize As Long ' Total number of entries in the dictionary +Private _MapRemoved As Long ' Number of inactive entries in the dictionary + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "DICTIONARY" + ServiceName = "ScriptForge.Dictionary" + Set MapKeys = New Collection + Set MapItems = Array() + _MapSize = 0 + _MapRemoved = 0 +End Sub ' ScriptForge.SF_Dictionary Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' ScriptForge.SF_Dictionary Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + RemoveAll() + Set Dispose = Nothing +End Function ' ScriptForge.SF_Dictionary Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Count() As Long +''' Actual number of entries in the dictionary +''' Example: +''' myDict.Count + + Count = _PropertyGet("Count") + +End Property ' ScriptForge.SF_Dictionary.Count + +REM ----------------------------------------------------------------------------- +Public Function Item(Optional ByVal Key As Variant) As Variant +''' Return the value of the item related to Key +''' Args: +''' Key: the key value (string) +''' Returns: +''' Empty if not found, otherwise the found value +''' Example: +''' myDict.Item("ThisKey") +''' NB: defined as a function to not disrupt the Basic IDE debugger + + Item = _PropertyGet("Item", Key) + +End Function ' ScriptForge.SF_Dictionary.Item + +REM ----------------------------------------------------------------------------- +Property Get Items() as Variant +''' Return the list of Items as a 1D array +''' The Items and Keys properties return their respective contents in the same order +''' The order is however not necessarily identical to the creation sequence +''' Returns: +''' The array is empty if the dictionary is empty +''' Examples +''' a = myDict.Items +''' For Each b In a ... + + Items = _PropertyGet("Items") + +End Property ' ScriptForge.SF_Dictionary.Items + +REM ----------------------------------------------------------------------------- +Property Get Keys() as Variant +''' Return the list of keys as a 1D array +''' The Keys and Items properties return their respective contents in the same order +''' The order is however not necessarily identical to the creation sequence +''' Returns: +''' The array is empty if the dictionary is empty +''' Examples +''' a = myDict.Keys +''' For each b In a ... + + Keys = _PropertyGet("Keys") + +End Property ' ScriptForge.SF_Dictionary.Keys + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Add(Optional ByVal Key As Variant _ + , Optional ByVal Item As Variant _ + ) As Boolean +''' Add a new key-item pair into the dictionary +''' Args: +''' Key: must not yet exist in the dictionary +''' Item: any value, including an array, a Basic object, a UNO object, ... +''' Returns: True if successful +''' Exceptions: +''' DUPLICATEKEYERROR: such a key exists already +''' INVALIDKEYERROR: zero-length string or only spaces +''' Examples: +''' myDict.Add("NewKey", NewValue) + +Dim oItemMap As ItemMap ' New entry in the MapItems array +Const cstThisSub = "Dictionary.Add" +Const cstSubArgs = "Key, Item" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Add = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch + If IsArray(Item) Then + If Not SF_Utils._ValidateArray(Item, "Item") Then GoTo Catch + Else + If Not SF_Utils._Validate(Item, "Item") Then GoTo Catch + End If + End If + If Key = Space(Len(Key)) Then GoTo CatchInvalid + If Exists(Key) Then GoTo CatchDuplicate + +Try: + _MapSize = _MapSize + 1 + MapKeys.Add(_MapSize, Key) + oItemMap.Key = Key + oItemMap.Value = Item + ReDim Preserve MapItems(1 To _MapSize) + MapItems(_MapSize) = oItemMap + Add = True + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchDuplicate: + SF_Exception.RaiseFatal(DUPLICATEKEYERROR, "Key", Key) + GoTo Finally +CatchInvalid: + SF_Exception.RaiseFatal(INVALIDKEYERROR, "Key") + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.Add + +REM ----------------------------------------------------------------------------- +Public Function ConvertToArray() As Variant +''' Store the content of the dictionary in a 2-columns array: +''' Key stored in 1st column, Item stored in 2nd +''' Args: +''' Returns: +''' a zero-based 2D array(0:Count - 1, 0:1) +''' an empty array if the dictionary is empty + +Dim vArray As Variant ' Return value +Dim sKey As String ' Tempry key +Dim vKeys As Variant ' Array of keys +Dim lCount As Long ' Counter +Const cstThisSub = "Dictionary.ConvertToArray" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + vArray = Array() + If Count = 0 Then + Else + ReDim vArray(0 To Count - 1, 0 To 1) + lCount = -1 + vKeys = Keys + For Each sKey in vKeys + lCount = lCount + 1 + vArray(lCount, 0) = sKey + vArray(lCount, 1) = Item(sKey) + Next sKey + End If + +Finally: + ConvertToArray = vArray() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ConvertToArray + +REM ----------------------------------------------------------------------------- +Public Function ConvertToJson(ByVal Optional Indent As Variant) As Variant +''' Convert the content of the dictionary to a JSON string +''' JSON = JavaScript Object Notation: https://en.wikipedia.org/wiki/JSON +''' Limitations +''' Allowed item types: String, Boolean, numbers, Null and Empty +''' Arrays containing above types are allowed +''' Dates are converted into strings (not within arrays) +''' Other types are converted to their string representation (cfr. SF_String.Represent) +''' Args: +''' Indent: +''' If indent is a non-negative integer or string, then JSON array elements and object members will be pretty-printed with that indent level. +''' An indent level <= 0 will only insert newlines. +''' "", (the default) selects the most compact representation. +''' Using a positive integer indent indents that many spaces per level. +''' If indent is a string (such as Chr(9)), that string is used to indent each level. +''' Returns: +''' the JSON string +''' Example: +''' myDict.Add("p0", 12.5) +''' myDict.Add("p1", "a string àé""ê") +''' myDict.Add("p2", DateSerial(2020,9,28)) +''' myDict.Add("p3", True) +''' myDict.Add("p4", Array(1,2,3)) +''' MsgBox a.ConvertToJson() ' {"p0": 12.5, "p1": "a string \u00e0\u00e9\"\u00ea", "p2": "2020-09-28", "p3": true, "p4": [1, 2, 3]} + +Dim sJson As String ' Return value +Dim vArray As Variant ' Array of property values +Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue +Dim sKey As String ' Tempry key +Dim vKeys As Variant ' Array of keys +Dim vItem As Variant ' Tempry item +Dim iVarType As Integer ' Extended VarType +Dim lCount As Long ' Counter +Dim vIndent As Variant ' Python alias of Indent +Const cstPyHelper = "$" & "_SF_Dictionary__ConvertToJson" + +Const cstThisSub = "Dictionary.ConvertToJson" +Const cstSubArgs = "[Indent=Null]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Indent) Or IsEmpty(INDENT) Then Indent = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Indent, "Indent", Array(V_STRING, V_NUMERIC)) Then GoTo Finally + End If + sJson = "" + +Try: + vArray = Array() + If Count = 0 Then + Else + ReDim vArray(0 To Count - 1) + lCount = -1 + vKeys = Keys + For Each sKey in vKeys + ' Check item type + vItem = Item(sKey) + iVarType = SF_Utils._VarTypeExt(vItem) + Select Case iVarType + Case V_STRING, V_BOOLEAN, V_NUMERIC, V_NULL, V_EMPTY + Case V_DATE + vItem = SF_Utils._CDateToIso(vItem) + Case >= V_ARRAY + Case Else + vItem = SF_Utils._Repr(vItem) + End Select + ' Build in each array entry a (Name, Value) pair + Set oPropertyValue = SF_Utils._MakePropertyValue(sKey, vItem) + lCount = lCount + 1 + Set vArray(lCount) = oPropertyValue + Next sKey + End If + + 'Pass array to Python script for the JSON conversion + With ScriptForge.SF_Session + vIndent = Indent + If VarType(Indent) = V_STRING Then + If Len(Indent) = 0 Then vIndent = Null + End If + sJson = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, vArray, vIndent) + End With + +Finally: + ConvertToJson = sJson + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ConvertToJson + +REM ----------------------------------------------------------------------------- +Public Function ConvertToPropertyValues() As Variant +''' Store the content of the dictionary in an array of PropertyValues +''' Key stored in Name, Item stored in Value +''' Args: +''' Returns: +''' a zero-based 1D array(0:Count - 1). Each entry is a com.sun.star.beans.PropertyValue +''' Name: the key in the dictionary +''' Value: +''' Dates are converted to UNO dates +''' Empty arrays are replaced by Null +''' an empty array if the dictionary is empty + +Dim vArray As Variant ' Return value +Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue +Dim sKey As String ' Tempry key +Dim vKeys As Variant ' Array of keys +Dim lCount As Long ' Counter +Const cstThisSub = "Dictionary.ConvertToPropertyValues" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + vArray = Array() + If Count = 0 Then + Else + ReDim vArray(0 To Count - 1) + lCount = -1 + vKeys = Keys + For Each sKey in vKeys + ' Build in each array entry a (Name, Value) pair + Set oPropertyValue = SF_Utils._MakePropertyValue(sKey, Item(sKey)) + lCount = lCount + 1 + Set vArray(lCount) = oPropertyValue + Next sKey + End If + +Finally: + ConvertToPropertyValues = vArray() + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ConvertToPropertyValues + +REM ----------------------------------------------------------------------------- +Public Function Exists(Optional ByVal Key As Variant) As Boolean +''' Determine if a key exists in the dictionary +''' Args: +''' Key: the key value (string) +''' Returns: True if key exists +''' Examples: +''' If myDict.Exists("SomeKey") Then ' don't add again + +Dim vItem As Variant ' Item part in MapKeys +Const cstThisSub = "Dictionary.Exists" +Const cstSubArgs = "Key" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Exists = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch + End If + +Try: + ' Dirty but preferred to go through whole collection + On Local Error GoTo NotFound + vItem = MapKeys(Key) + NotFound: + Exists = ( Not ( Err = 5 ) And vItem > 0 ) + On Local Error GoTo 0 + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.Exists + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByVal Key As Variant _ + ) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Key: mandatory if PropertyName = "Item", ignored otherwise +''' Returns: +''' The actual value of the property +''' Exceptions: +''' ARGUMENTERROR The property does not exist +''' Examples: +''' myDict.GetProperty("Count") + +Const cstThisSub = "Dictionary.GetProperty" +Const cstSubArgs = "PropertyName, [Key]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If IsMissing(Key) Or IsEmpty(Key) Then Key = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName, Key) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function ImportFromJson(Optional ByVal InputStr As Variant _ + , Optional ByVal Overwrite As Variant _ + ) As Boolean +''' Adds the content of a Json string into the current dictionary +''' JSON = JavaScript Object Notation: https://en.wikipedia.org/wiki/JSON +''' Limitations +''' The JSON string may contain numbers, strings, booleans, null values and arrays containing those types +''' It must not contain JSON objects, i.e. sub-dictionaries +''' An attempt is made to convert strings to dates if they fit one of next patterns: +''' YYYY-MM-DD, HH:MM:SS or YYYY-MM-DD HH:MM:SS +''' Args: +''' InputStr: the json string to import +''' Overwrite: when True entries with same name may exist in the dictionary and their values are overwritten +''' Default = False +''' Returns: +''' True if successful +''' Exceptions: +''' DUPLICATEKEYERROR: such a key exists already +''' INVALIDKEYERROR: zero-length string or only spaces +''' Example: +''' Dim s As String +''' s = "{'firstName': 'John','lastName': 'Smith','isAlive': true,'age': 66, 'birth': '1954-09-28 20:15:00'" _ +''' & ",'address': {'streetAddress': '21 2nd Street','city': 'New York','state': 'NY','postalCode': '10021-3100'}" _ +''' & ",'phoneNumbers': [{'type': 'home','number': '212 555-1234'},{'type': 'office','number': '646 555-4567'}]" _ +''' & ",'children': ['Q','M','G','T'],'spouse': null}" +''' s = Replace(s, "'", """") +''' myDict.ImportFromJson(s, OverWrite := True) +''' ' The (sub)-dictionaries "address" and "phoneNumbers(0) and (1) are reduced to Empty + +Dim bImport As Boolean ' Return value +Dim vArray As Variant ' JSON string converted to array +Dim vArrayEntry As Variant ' A single entry in vArray +Dim vKey As Variant ' Tempry key +Dim vItem As Variant ' Tempry item +Dim bExists As Boolean ' True when an entry exists +Dim dDate As Date ' String converted to Date +Const cstPyHelper = "$" & "_SF_Dictionary__ImportFromJson" + +Const cstThisSub = "Dictionary.ImportFromJson" +Const cstSubArgs = "InputStr, [Overwrite=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bImport = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoYo Finally + End If + +Try: + With ScriptForge.SF_Session + vArray = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, InputStr) + End With + If Not IsArray(vArray) Then GoTo Finally ' Conversion error or nothing to do + + ' vArray = Array of subarrays = 2D DataArray (cfr. Calc) + For Each vArrayEntry In vArray + vKey = vArrayEntry(0) + If VarType(vKey) = V_STRING Then ' Else skip + vItem = vArrayEntry(1) + If Overwrite Then bExists = Exists(vKey) Else bExists = False + ' When the item matches a date pattern, convert it to a date + If VarType(vItem) = V_STRING Then + dDate = SF_Utils._CStrToDate(vItem) + If dDate > -1 Then vItem = dDate + End If + If bExists Then + ReplaceItem(vKey, vItem) + Else + Add(vKey, vItem) ' Key controls are done in Add + End If + End If + Next vArrayEntry + + bImport = True + +Finally: + ImportFromJson = bImport + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ImportFromJson + +REM ----------------------------------------------------------------------------- +Public Function ImportFromPropertyValues(Optional ByVal PropertyValues As Variant _ + , Optional ByVal Overwrite As Variant _ + ) As Boolean +''' Adds the content of an array of PropertyValues into the current dictionary +''' Names contain Keys, Values contain Items +''' UNO dates are replaced by Basic dates +''' Args: +''' PropertyValues: a zero-based 1D array. Each entry is a com.sun.star.beans.PropertyValue +''' Overwrite: when True entries with same name may exist in the dictionary and their values are overwritten +''' Default = False +''' Returns: +''' True if successful +''' Exceptions: +''' DUPLICATEKEYERROR: such a key exists already +''' INVALIDKEYERROR: zero-length string or only spaces + +Dim bImport As Boolean ' Return value +Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue +Dim vItem As Variant ' Tempry item +Dim sObjectType As String ' UNO object type of dates +Dim bExists As Boolean ' True when an entry exists +Const cstThisSub = "Dictionary.ImportFromPropertyValues" +Const cstSubArgs = "PropertyValues, [Overwrite=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bImport = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If IsArray(PropertyValues) Then + If Not SF_Utils._ValidateArray(PropertyValues, "PropertyValues", 1, V_OBJECT, True) Then GoTo Finally + Else + If Not SF_Utils._Validate(PropertyValues, "PropertyValues", V_OBJECT) Then GoTo Finally + End If + If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoYo Finally + End If + +Try: + If Not IsArray(PropertyValues) Then PropertyValues = Array(PropertyValues) + With oPropertyValue + For Each oPropertyValue In PropertyValues + If Overwrite Then bExists = Exists(.Name) Else bExists = False + If SF_Session.UnoObjectType(oPropertyValue) = "com.sun.star.beans.PropertyValue" Then + If IsUnoStruct(.Value) Then + sObjectType = SF_Session.UnoObjectType(.Value) + Select Case sObjectType + Case "com.sun.star.util.DateTime" : vItem = CDateFromUnoDateTime(.Value) + Case "com.sun.star.util.Date" : vItem = CDateFromUnoDate(.Value) + Case "com.sun.star.util.Time" : vItem = CDateFromUnoTime(.Value) + Case Else : vItem = .Value + End Select + Else + vItem = .Value + End If + If bExists Then + ReplaceItem(.Name, vItem) + Else + Add(.Name, vItem) ' Key controls are done in Add + End If + End If + Next oPropertyValue + End With + bImport = True + +Finally: + ImportFromPropertyValues = bImport + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ImportFromPropertyValues + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list or methods of the Dictionary class as an array + + Methods = Array( _ + "Add" _ + , "ConvertToArray" _ + , "ConvertToJson" _ + , "ConvertToPropertyValues" _ + , "Exists" _ + , "ImportFromJson" _ + , "ImportFromPropertyValues" _ + , "Remove" _ + , "RemoveAll" _ + , "ReplaceItem" _ + , "ReplaceKey" _ + ) + +End Function ' ScriptForge.SF_Dictionary.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Dictionary class as an array + + Properties = Array( _ + "Count" _ + , "Item" _ + , "Items" _ + , "Keys" _ + ) + +End Function ' ScriptForge.SF_Dictionary.Properties + +REM ----------------------------------------------------------------------------- +Public Function Remove(Optional ByVal Key As Variant) As Boolean +''' Remove an existing dictionary entry based on its key +''' Args: +''' Key: must exist in the dictionary +''' Returns: True if successful +''' Exceptions: +''' UNKNOWNKEYERROR: the key does not exist +''' Examples: +''' myDict.Remove("OldKey") + +Dim lIndex As Long ' To remove entry in the MapItems array +Const cstThisSub = "Dictionary.Remove" +Const cstSubArgs = "Key" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Remove = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch + End If + If Not Exists(Key) Then GoTo CatchUnknown + +Try: + lIndex = MapKeys.Item(Key) + MapKeys.Remove(Key) + Erase MapItems(lIndex) ' Is now Empty + _MapRemoved = _MapRemoved + 1 + Remove = True + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchUnknown: + SF_Exception.RaiseFatal(UNKNOWNKEYERROR, "Key", Key) + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.Remove + +REM ----------------------------------------------------------------------------- +Public Function RemoveAll() As Boolean +''' Remove all the entries from the dictionary +''' Args: +''' Returns: True if successful +''' Examples: +''' myDict.RemoveAll() + +Dim vKeys As Variant ' Array of keys +Dim sColl As String ' A collection key in MapKeys +Const cstThisSub = "Dictionary.RemoveAll" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + RemoveAll = False + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + vKeys = Keys + For Each sColl In vKeys + MapKeys.Remove(sColl) + Next sColl + Erase MapKeys + Erase MapItems + ' Make dictionary ready to receive new entries + Call Class_Initialize() + RemoveAll = True + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.RemoveAll + +REM ----------------------------------------------------------------------------- +Public Function ReplaceItem(Optional ByVal Key As Variant _ + , Optional ByVal Value As Variant _ + ) As Boolean +''' Replace the item value +''' Args: +''' Key: must exist in the dictionary +''' Returns: True if successful +''' Exceptions: +''' UNKNOWNKEYERROR: the old key does not exist +''' Examples: +''' myDict.ReplaceItem("Key", NewValue) + +Dim oItemMap As ItemMap ' Content to update in the MapItems array +Dim lIndex As Long ' Entry in the MapItems array +Const cstThisSub = "Dictionary.ReplaceItem" +Const cstSubArgs = "Key, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + ReplaceItem = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch + If IsArray(Value) Then + If Not SF_Utils._ValidateArray(Value, "Value") Then GoTo Catch + Else + If Not SF_Utils._Validate(Value, "Value") Then GoTo Catch + End If + End If + If Not Exists(Key) Then GoTo CatchUnknown + +Try: + ' Find entry in MapItems and update it with the new value + lIndex = MapKeys.Item(Key) + oItemMap = MapItems(lIndex) + oItemMap.Value = Value + ReplaceItem = True + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchUnknown: + SF_Exception.RaiseFatal(UNKNOWNKEYERROR, "Key", Key) + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ReplaceItem + +REM ----------------------------------------------------------------------------- +Public Function ReplaceKey(Optional ByVal Key As Variant _ + , Optional ByVal Value As Variant _ + ) As Boolean +''' Replace existing key +''' Args: +''' Key: must exist in the dictionary +''' Value: must not exist in the dictionary +''' Returns: True if successful +''' Exceptions: +''' UNKNOWNKEYERROR: the old key does not exist +''' DUPLICATEKEYERROR: the new key exists +''' Examples: +''' myDict.ReplaceKey("OldKey", "NewKey") + +Dim oItemMap As ItemMap ' Content to update in the MapItems array +Dim lIndex As Long ' Entry in the MapItems array +Const cstThisSub = "Dictionary.ReplaceKey" +Const cstSubArgs = "Key, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + ReplaceKey = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch + If Not SF_Utils._Validate(Value, "Value", V_STRING) Then GoTo Catch + End If + If Not Exists(Key) Then GoTo CatchUnknown + If Value = Space(Len(Value)) Then GoTo CatchInvalid + If Exists(Value) Then GoTo CatchDuplicate + +Try: + ' Remove the Key entry and create a new one in MapKeys + With MapKeys + lIndex = .Item(Key) + .Remove(Key) + .Add(lIndex, Value) + End With + oItemMap = MapItems(lIndex) + oItemMap.Key = Value + ReplaceKey = True + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchUnknown: + SF_Exception.RaiseFatal(UNKNOWNKEYERROR, "Key", Key) + GoTo Finally +CatchDuplicate: + SF_Exception.RaiseFatal(DUPLICATEKEYERROR, "Value", Value) + GoTo Finally +CatchInvalid: + SF_Exception.RaiseFatal(INVALIDKEYERROR, "Key") + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.ReplaceKey + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Dictionary.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String _ + , Optional pvKey As Variant _ + ) +''' Return the named property +''' Args: +''' psProperty: the name of the property +''' pvKey: the key to retrieve, numeric or string + +Dim vItemMap As Variant ' Entry in the MapItems array +Dim vArray As Variant ' To get Keys or Values +Dim i As Long +Dim cstThisSub As String +Dim cstSubArgs As String + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + cstThisSub = "SF_Dictionary.get" & psProperty + If IsMissing(pvKey) Then cstSubArgs = "" Else cstSubArgs = "[Key]" + + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + + Select Case UCase(psProperty) + Case UCase("Count") + _PropertyGet = _MapSize - _MapRemoved + Case UCase("Item") + If Not SF_Utils._Validate(pvKey, "Key", V_STRING) Then GoTo Catch + If Exists(pvKey) Then _PropertyGet = MapItems(MapKeys(pvKey)).Value Else _PropertyGet = Empty + Case UCase("Keys"), UCase("Items") + vArray = Array() + If _MapSize - _MapRemoved - 1 >= 0 Then + ReDim vArray(0 To (_MapSize - _MapRemoved - 1)) + i = -1 + For each vItemMap In MapItems() + If Not IsEmpty(vItemMap) Then + i = i + 1 + If UCase(psProperty) = "KEYS" Then vArray(i) = vItemMap.Key Else vArray(i) = vItemMap.Value + End If + Next vItemMap + End If + _PropertyGet = vArray + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Dictionary._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Dictionary instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Dictionary] (key1:value1, key2:value2, ...) + +Dim sDict As String ' Return value +Dim vKeys As Variant ' Array of keys +Dim sKey As String ' Tempry key +Dim vItem As Variant ' Tempry item +Const cstDictEmpty = "[Dictionary] ()" +Const cstDict = "[Dictionary]" +Const cstMaxLength = 50 ' Maximum length for items +Const cstSeparator = ", " + + _Repr = "" + + If Count = 0 Then + sDict = cstDictEmpty + Else + sDict = cstDict & " (" + vKeys = Keys + For Each sKey in vKeys + vItem = Item(sKey) + sDict = sDict & sKey & ":" & SF_Utils._Repr(vItem, cstMaxLength) & cstSeparator + Next sKey + sDict = Left(sDict, Len(sDict) - Len(cstSeparator)) & ")" ' Suppress last comma + End If + + _Repr = sDict + +End Function ' ScriptForge.SF_Dictionary._Repr + +REM ============================================ END OF SCRIPTFORGE.SF_DICTIONARY +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Exception.xba b/wizards/source/scriptforge/SF_Exception.xba new file mode 100644 index 000000000..11e97b02b --- /dev/null +++ b/wizards/source/scriptforge/SF_Exception.xba @@ -0,0 +1,1381 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Exception" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' Exception (aka SF_Exception) +''' ========= +''' Generic singleton class for Basic code debugging and error handling +''' +''' Errors may be generated by +''' the Basic run-time error detection +''' in the ScriptForge code => RaiseAbort() +''' in a user code => Raise() +''' an error detection implemented +''' in the ScriptForge code => RaiseFatal() +''' in a user code => Raise() or RaiseWarning() +''' +''' When a run-time error occurs, the properties of the Exception object are filled +''' with information that uniquely identifies the error and information that can be used to handle it +''' The SF_Exception object is in this context similar to the VBA Err object +''' See https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/err-object +''' The Number property identifies the error: it can be a numeric value or a string +''' Numeric values up to 2000 are considered Basic run-time errors +''' +''' The "console" logs events, actual variable values, errors, ... It is an easy mean +''' to debug Basic programs especially when the IDE is not usable, f.i. in Calc user defined functions +''' or during control events processing +''' => DebugPrint() +''' +''' The usual behaviour of the application when an error occurs is: +''' 1. Log the error in the console +''' 2, Inform the user about the error with either a standard or a customized message +''' 3. Optionally, stop the execution of the current macro +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_exception.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +' SF_Utils +Const MISSINGARGERROR = "MISSINGARGERROR" +Const ARGUMENTERROR = "ARGUMENTERROR" +Const ARRAYERROR = "ARRAYERROR" +Const FILEERROR = "FILEERROR" + +' SF_Array +Const ARRAYSEQUENCEERROR = "ARRAYSEQUENCEERROR" +Const ARRAYINSERTERROR = "ARRAYINSERTERROR" +Const ARRAYINDEX1ERROR = "ARRAYINDEX1ERROR" +Const ARRAYINDEX2ERROR = "ARRAYINDEX2ERROR" +Const CSVPARSINGERROR = "CSVPARSINGERROR" +Const CSVOVERFLOWWARNING = "CSVOVERFLOWWARNING" + +' SF_Dictionary +Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR" +Const UNKNOWNKEYERROR = "UNKNOWNKEYERROR" +Const INVALIDKEYERROR = "INVALIDKEYERROR" + +' SF_FileSystem +Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" +Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" +Const NOTAFILEERROR = "NOTAFILEERROR" +Const NOTAFOLDERERROR = "NOTAFOLDERERROR" +Const OVERWRITEERROR = "OVERWRITEERROR" +Const READONLYERROR = "READONLYERROR" +Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" +Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" + +' SF_Services +Const UNKNOWNSERVICEERROR = "UNKNOWNSERVICEERROR" +Const SERVICESNOTLOADEDERROR = "SERVICESNOTLOADEDERROR" + +' SF_Session +Const CALCFUNCERROR = "CALCFUNCERROR" +Const NOSCRIPTERROR = "NOSCRIPTERROR" +Const SCRIPTEXECERROR = "SCRIPTEXECERROR" +Const WRONGEMAILERROR = "WRONGEMAILERROR" +Const SENDMAILERROR = "SENDMAILERROR" + +' SF_TextStream +Const FILENOTOPENERROR = "FILENOTOPENERROR" +Const FILEOPENMODEERROR = "FILEOPENMODEERROR" +Const ENDOFFILEERROR = "ENDOFFILEERROR" + +' SF_UI +Const DOCUMENTERROR = "DOCUMENTERROR" +Const DOCUMENTCREATIONERROR = "DOCUMENTCREATIONERROR" +Const DOCUMENTOPENERROR = "DOCUMENTOPENERROR" +Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR" + +' SF_Document +Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR" +Const DOCUMENTSAVEERROR = "DOCUMENTSAVEERROR" +Const DOCUMENTSAVEASERROR = "DOCUMENTSAVEASERROR" +Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR" +Const DBCONNECTERROR = "DBCONNECTERROR" + +' SF_Calc +Const CALCADDRESSERROR = "CALCADDRESSERROR" +Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR" +Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR" +Const DUPLICATECHARTERROR = "DUPLICATECHARTERROR" +Const RANGEEXPORTERROR = "RANGEEXPORTERROR" + +' SF_Chart +Const CHARTEXPORTERROR = "CHARTEXPORTERROR" + +' SF_Form +Const FORMDEADERROR = "FORMDEADERROR" +Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR" +Const WRITERFORMNOTFOUNDERROR = "WRITERFORMNOTFOUNDERROR" +Const BASEFORMNOTFOUNDERROR = "BASEFORMNOTFOUNDERROR" +Const SUBFORMNOTFOUNDERROR = "SUBFORMNOTFOUNDERROR" +Const FORMCONTROLTYPEERROR = "FORMCONTROLTYPEERROR" + +' SF_Dialog +Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR" +Const DIALOGDEADERROR = "DIALOGDEADERROR" +Const CONTROLTYPEERROR = "CONTROLTYPEERROR" +Const TEXTFIELDERROR = "TEXTFIELDERROR" + +' SF_Database +Const DBREADONLYERROR = "DBREADONLYERROR" +Const SQLSYNTAXERROR = "SQLSYNTAXERROR" + +' Python +Const PYTHONSHELLERROR = "PYTHONSHELLERROR" + +' SF_UnitTest +Const UNITTESTLIBRARYERROR = "UNITTESTLIBRARYERROR" +Const UNITTESTMETHODERROR = "UNITTESTMETHODERROR" + +REM ============================================================= PRIVATE MEMBERS + +' User defined errors +Private _Number As Variant ' Error number/code (Integer or String) +Private _Source As Variant ' Where the error occurred: a module, a Sub/Function, ... +Private _Description As String ' The error message + +' System run-time errors +Private _SysNumber As Long ' Alias of Err +Private _SysSource As Long ' Alias of Erl +Private _SysDescription As String ' Alias of Error$ + +REM ============================================================ MODULE CONSTANTS + +Const RUNTIMEERRORS = 2000 ' Upper limit of Basic run-time errors +Const CONSOLENAME = "ConsoleLines" ' Name of control in the console dialog + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_Exception Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Description() As Variant +''' Returns the description of the last error that has occurred +''' Example: +''' myException.Description + Description = _PropertyGet("Description") +End Property ' ScriptForge.SF_Exception.Description (get) + +REM ----------------------------------------------------------------------------- +Property Let Description(ByVal pvDescription As Variant) +''' Set the description of the last error that has occurred +''' Example: +''' myException.Description = "Not smart to divide by zero" + _PropertySet "Description", pvDescription +End Property ' ScriptForge.SF_Exception.Description (let) + +REM ----------------------------------------------------------------------------- +Property Get Number() As Variant +''' Returns the code of the last error that has occurred +''' Example: +''' myException.Number + Number = _PropertyGet("Number") +End Property ' ScriptForge.SF_Exception.Number (get) + +REM ----------------------------------------------------------------------------- +Property Let Number(ByVal pvNumber As Variant) +''' Set the code of the last error that has occurred +''' Example: +''' myException.Number = 11 ' Division by 0 + _PropertySet "Number", pvNumber +End Property ' ScriptForge.SF_Exception.Number (let) + +REM ----------------------------------------------------------------------------- +Property Get Source() As Variant +''' Returns the location of the last error that has occurred +''' Example: +''' myException.Source + Source = _PropertyGet("Source") +End Property ' ScriptForge.SF_Exception.Source (get) + +REM ----------------------------------------------------------------------------- +Property Let Source(ByVal pvSource As Variant) +''' Set the location of the last error that has occurred +''' Example: +''' myException.Source = 123 ' Line # 123. Source may also be a string + _PropertySet "Source", pvSource +End Property ' ScriptForge.SF_Exception.Source (let) + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_Exception" +End Property ' ScriptForge.SF_String.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Exception" +End Property ' ScriptForge.SF_Exception.ServiceName + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Sub Clear() +''' Reset the current error status and clear the SF_Exception object +''' Args: +''' Examples: +''' On Local Error GoTo Catch +''' ' ... +''' Catch: +''' SF_Exception.Clear() ' Deny the error + +Const cstThisSub = "Exception.Clear" +Const cstSubArgs = "" + +Check: + +Try: + With SF_Exception + ._Number = Empty + ._Source = Empty + ._Description = "" + ._SysNumber = 0 + ._SysSource = 0 + ._SysDescription = "" + End With + +Finally: + On Error GoTo 0 + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Exception.Clear + +REM ----------------------------------------------------------------------------- +Public Sub Console(Optional ByVal Modal As Variant, _ + Optional ByRef _Context As Variant _ + ) +''' Display the console messages in a modal or non-modal dialog +''' If the dialog is already active, when non-modal, it is brought to front +''' Args: +''' Modal: Boolean. Default = True +''' _Context: From Python, the XComponentXontext (FOR INTERNAL USE ONLY) +''' Example: +''' SF_Exception.Console() + +Dim bConsoleActive As Boolean ' When True, dialog is active +Dim oModalBtn As Object ' Modal close button +Dim oNonModalBtn As Object ' Non modal close button +Const cstThisSub = "Exception.Console" +Const cstSubArgs = "[Modal=True]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing + +Check: + If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True + If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Modal, "Modal", V_BOOLEAN) Then GoTo Finally + End If + +Try: + With _SF_ + bConsoleActive = False + If Not IsNull(.ConsoleDialog) Then bConsoleActive = .ConsoleDialog._IsStillAlive(False) ' False to not raise an error + If bConsoleActive And Modal = False Then + ' Bring to front + .ConsoleDialog.Activate() + Else + ' Initialize dialog and fill with actual data + ' The dual modes (modal and non-modal) require to have 2 close buttons o/w only 1 is visible + ' - a usual OK button + ' - a Default button triggering the Close action + Set .ConsoleDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgConsole", _Context) + ' Setup labels and visibility + Set oModalBtn = .ConsoleDialog.Controls("CloseModalButton") + Set oNonModalBtn = .ConsoleDialog.Controls("CloseNonModalButton") + oModalBtn.Visible = Modal + oNonModalBtn.Visible = CBool(Not Modal) + ' Load console lines + _ConsoleRefresh() + .ConsoleDialog.Execute(Modal) + ' Terminate the modal dialog + If Modal Then + Set .ConsoleControl = .ConsoleControl.Dispose() + Set .ConsoleDialog = .ConsoleDialog.Dispose() + End If + End If + End With + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +End Sub ' ScriptForge.SF_Exception.Console + +REM ----------------------------------------------------------------------------- +Public Sub ConsoleClear(Optional ByVal Keep) +''' Clear the console keeping an optional number of recent messages +''' Args: +''' Keep: the number of messages to keep +''' If Keep is bigger than the number of messages stored in the console, +''' the console is not cleared +''' Example: +''' SF_Exception.ConsoleClear(5) + +Dim lConsole As Long ' UBound of ConsoleLines +Const cstThisSub = "Exception.ConsoleClear" +Const cstSubArgs = "[Keep=0]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Finally ' Never interrupt processing + +Check: + If IsMissing(Keep) Or IsEmpty(Keep) Then Keep = 0 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Keep, "Keep", V_NUMERIC) Then GoTo Finally + End If + +Try: + With _SF_ + If Keep <= 0 Then + .ConsoleLines = Array() + Else + lConsole = UBound(.ConsoleLines) + If Keep < lConsole + 1 Then .ConsoleLines = SF_Array.Slice(.ConsoleLines, lConsole - Keep + 1) + End If + End With + + ' If active, the console dialog needs to be refreshed + _ConsoleRefresh() + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +End Sub ' ScriptForge.SF_Exception.ConsoleClear + +REM ----------------------------------------------------------------------------- +Public Function ConsoleToFile(Optional ByVal FileName As Variant) As Boolean +''' Export the content of the console to a text file +''' If the file exists and the console is not empty, it is overwritten without warning +''' Args: +''' FileName: the complete file name to export to. If it exists, is overwritten without warning +''' Returns: +''' True if the file could be created +''' Examples: +''' SF_Exception.ConsoleToFile("myFile.txt") + +Dim bExport As Boolean ' Return value +Dim oFile As Object ' Output file handler +Dim sLine As String ' A single line +Const cstThisSub = "Exception.ConsoleToFile" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bExport = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + +Try: + + If UBound(_SF_.ConsoleLines) > -1 Then + Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True) + If Not IsNull(oFile) Then + With oFile + For Each sLine In _SF_.ConsoleLines + .WriteLine(sLine) + Next sLine + .CloseFile() + End With + End If + bExport = True + End If + +Finally: + If Not IsNull(oFile) Then Set oFile = oFile.Dispose() + ConsoleToFile = bExport + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Exception.ConsoleToFile + +REM ----------------------------------------------------------------------------- +Public Sub DebugDisplay(ParamArray pvArgs() As Variant) +''' Display the list of arguments in a readable form in a message box +''' Arguments are separated by a LINEFEED character +''' The maximum length of each individual argument = 1024 characters +''' Args: +''' Any number of arguments of any type +''' Examples: +''' SF_Exception.DebugDisplay(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09)) + +Dim sOutputMsg As String ' Line to display +Dim sOutputCon As String ' Line to write in console +Dim sArgMsg As String ' Single argument +Dim sArgCon As String ' Single argument +Dim i As Integer +Const cstTab = 4 +Const cstMaxLength = 1024 +Const cstThisSub = "Exception.DebugDisplay" +Const cstSubArgs = "Arg0, [Arg1, ...]" + + If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) +Try: + ' Build new console line + sOutputMsg = "" : sOutputCon = "" + For i = 0 To UBound(pvArgs) + If IsError(pvArgs(i)) Then pvArgs(i) = "" + sArgMsg = Iif(i = 0, "", SF_String.sfNEWLINE) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent() + sArgCon = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength) + sOutputMsg = sOutputMsg & sArgMsg + sOutputCon = sOutputCon & sArgCon + Next i + + ' Add to actual console + _SF_._AddToConsole(SF_String.ExpandTabs(sOutputCon, cstTab)) + ' Display the message + MsgBox(sOutputMsg, MB_OK + MB_ICONINFORMATION, "DebugDisplay") + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +End Sub ' ScriptForge.SF_Exception.DebugDisplay + +REM ----------------------------------------------------------------------------- +Public Sub DebugPrint(ParamArray pvArgs() As Variant) +''' Print the list of arguments in a readable form in the console +''' Arguments are separated by a TAB character (simulated by spaces) +''' The maximum length of each individual argument = 1024 characters +''' Args: +''' Any number of arguments of any type +''' Examples: +''' SF_Exception.DebugPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09)) + +Dim sOutput As String ' Line to write in console +Dim sArg As String ' Single argument +Dim i As Integer +Const cstTab = 4 +Const cstMaxLength = 1024 +Const cstThisSub = "Exception.DebugPrint" +Const cstSubArgs = "Arg0, [Arg1, ...]" + + If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) +Try: + ' Build new console line + sOutput = "" + For i = 0 To UBound(pvArgs) + If IsError(pvArgs(i)) Then pvArgs(i) = "" + sArg = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength) 'Do not use SF_String.Represent() + sOutput = sOutput & sArg + Next i + + ' Add to actual console + _SF_._AddToConsole(SF_String.ExpandTabs(sOutput, cstTab)) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +End Sub ' ScriptForge.SF_Exception.DebugPrint + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions +''' ARGUMENTERROR The property does not exist +''' Examples: +''' myException.GetProperty("MyProperty") + +Const cstThisSub = "Exception.GetProperty" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Exception.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Exception service as an array + + Methods = Array( _ + "Clear" _ + , "Console" _ + , "ConsoleClear" _ + , "ConsoleToFile" _ + , "DebugPrint" _ + , "Raise" _ + , "RaiseAbort" _ + , "RaiseFatal" _ + , "RaiseWarning" _ + ) + +End Function ' ScriptForge.SF_Exception.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "Description" _ + , "Number" _ + , "Source" _ + ) + +End Function ' ScriptForge.SF_Exception.Properties + +REM ----------------------------------------------------------------------------- +Public Sub PythonPrint(ParamArray pvArgs() As Variant) +''' Display the list of arguments in a readable form in the Python console +''' Arguments are separated by a TAB character (simulated by spaces) +''' The maximum length of each individual argument = 1024 characters +''' Args: +''' Any number of arguments of any type +''' Examples: +''' SF_Exception.PythonPrint(a, Array(1, 2, 3), , "line1" & Chr(10) & "Line2", DateSerial(2020, 04, 09)) + +Dim sOutput As String ' Line to write in console +Dim sArg As String ' Single argument +Dim i As Integer +Const cstTab = 4 +Const cstMaxLength = 1024 +Const cstPyHelper = "$" & "_SF_Exception__PythonPrint" +Const cstThisSub = "Exception.PythonPrint" +Const cstSubArgs = "Arg0, [Arg1, ...]" + + If SF_Utils._ErrorHandling() Then On Local Error Goto Finally ' Never interrupt processing + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) +Try: + ' Build new console line + sOutput = "" + For i = 0 To UBound(pvArgs) + If IsError(pvArgs(i)) Then pvArgs(i) = "" + sArg = Iif(i = 0, "", SF_String.sfTAB) & SF_Utils._Repr(pvArgs(i), cstMaxLength) + sOutput = sOutput & sArg + Next i + + ' Add to actual console + sOutput = SF_String.ExpandTabs(sOutput, cstTab) + _SF_._AddToConsole(sOutput) + ' Display the message in the Python shell console + With ScriptForge.SF_Session + .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, sOutput) + End With + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +End Sub ' ScriptForge.SF_Exception.PythonPrint + +REM ----------------------------------------------------------------------------- +Public Sub Raise(Optional ByVal Number As Variant _ + , Optional ByVal Source As Variant _ + , Optional ByVal Description As Variant _ + ) +''' Generate a run-time error. An error message is displayed to the user and logged +''' in the console. The execution is STOPPED +''' Args: +''' Number: the error number, may be numeric or string +''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err) +''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error +''' Description: the error message to log in the console and to display to the user +''' Examples: +''' On Local Error GoTo Catch +''' ' ... +''' Catch: +''' SF_Exception.Raise() ' Standard behaviour +''' SF_Exception.Raise(11) ' Force division by zero +''' SF_Exception.Raise("MYAPPERROR", "myFunction", "Application error") +''' SF_Exception.Raise(,, "To divide by zero is not a good idea !") + +Dim sMessage As String ' Error message to log and to display +Dim L10N As Object ' Alias to LocalizedInterface +Const cstThisSub = "Exception.Raise" +Const cstSubArgs = "[Number=Err], [Source=Erl], [Description]" + + ' Save Err, Erl, .. values before any On Error ... statement + SF_Exception._CaptureSystemError() + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Number) Or IsEmpty(Number) Then Number = -1 + If IsMissing(Source) Or IsEmpty(Source) Then Source = -1 + If IsMissing(Description) Or IsEmpty(Description) Then Description = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC)) Then GoTo Finally + If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC)) Then GoTo Finally + If Not SF_Utils._Validate(Description, "Description", V_STRING) Then GoTo Finally + End If + +Try: + With SF_Exception + If Number >= 0 Then .Number = Number + If VarType(Source) = V_STRING Then + If Len(Source) > 0 Then .Source = Source + ElseIf Source >= 0 Then ' -1 = Default => no change + .Source = Source + End If + If Len(Description) > 0 Then .Description = Description + + ' Log and display + Set L10N = _SF_._GetLocalizedInterface() + sMessage = L10N.GetText("LONGERRORDESC", .Number, .Source, .Description) + .DebugPrint(sMessage) + If _SF_.DisplayEnabled Then MsgBox L10N.GetText("ERRORNUMBER", .Number) _ + & SF_String.sfNewLine & L10N.GetText("ERRORLOCATION", .Source) _ + & SF_String.sfNewLine & .Description _ + , MB_OK + MB_ICONSTOP _ + , L10N.GetText("ERRORNUMBER", .Number) + .Clear() + End With + +Finally: + SF_Utils._ExitFunction(cstThisSub) + If _SF_.StopWhenError Then + _SF_._StackReset() + Stop + End If + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Exception.Raise + +REM ----------------------------------------------------------------------------- +Public Sub RaiseAbort(Optional ByVal Source As Variant) +''' Manage a run-time error that occurred inside the ScriptForge piece of software itself. +''' The event is logged. +''' The execution is STOPPED +''' For INTERNAL USE only +''' Args: +''' Source: the line where the error occurred + +Dim sLocation As String ' Common header in error messages: location of error +Dim vLocation As Variant ' Split array (library, module, method) +Dim sMessage As String ' Error message to log and to display +Dim L10N As Object ' Alias to LocalizedInterface +Const cstTabSize = 4 +Const cstThisSub = "Exception.RaiseAbort" +Const cstSubArgs = "[Source=Erl]" + + ' Save Err, Erl, .. values before any On Error ... statement + SF_Exception._CaptureSystemError() + On Local Error Resume Next + +Check: + If IsMissing(Source) Or IsEmpty(Source) Then Source = "" + +Try: + With SF_Exception + + ' Prepare message header + Set L10N = _SF_._GetLocalizedInterface() + If Len(_SF_.MainFunction) > 0 Then ' MainFunction = [Library.]Module.Method + vLocation = Split(_SF_.MainFunction, ".") + If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge") + sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), vLocation(1), vLocation(2)) & "\n\n\n" + Else + sLocation = "" + End If + + ' Log and display + sMessage = L10N.GetText("LONGERRORDESC", .Number, .Source, .Description) + .DebugPrint(sMessage) + If _SF_.DisplayEnabled Then + sMessage = sLocation _ + & L10N.GetText("INTERNALERROR") _ + & L10N.GetText("ERRORLOCATION", Source & "/" & .Source) & SF_String.sfNewLine & .Description _ + & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION") + MsgBox SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _ + , MB_OK + MB_ICONSTOP _ + , L10N.GetText("ERRORNUMBER", .Number) + End If + + .Clear() + End With + +Finally: + _SF_._StackReset() + If _SF_.StopWhenError Then Stop + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Exception.RaiseAbort + +REM ----------------------------------------------------------------------------- +Public Sub RaiseFatal(Optional ByVal ErrorCode As Variant _ + , ParamArray pvArgs _ + ) +''' Generate a run-time error caused by an anomaly in a user script detected by ScriptForge +''' The message is logged in the console. The execution is STOPPED +''' For INTERNAL USE only +''' Args: +''' ErrorCode: as a string, the unique identifier of the error +''' pvArgs: the arguments to insert in the error message + +Dim sLocation As String ' Common header in error messages: location of error +Dim sService As String ' Service name having detected the error +Dim sMethod As String ' Method name having detected the error +Dim vLocation As Variant ' Split array (library, module, method) +Dim sMessage As String ' Message to log and display +Dim L10N As Object ' Alias of LocalizedInterface +Dim sAlt As String ' Alternative error messages +Dim iButtons As Integer ' MB_OK or MB_YESNO +Dim iMsgBox As Integer ' Return value of the message box + +Const cstTabSize = 4 +Const cstThisSub = "Exception.RaiseFatal" +Const cstSubArgs = "ErrorCode, [Arg0[, Arg1 ...]]" +Const cstStop = "⏻" ' Chr(9211) + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(ErrorCode) Or IsEmpty(ErrorCode) Then ErrorCode = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(ErrorCode, "ErrorCode", V_STRING) Then GoTo Finally + End If + +Try: + Set L10N = _SF_._GetLocalizedInterface() + ' Location header common to all error messages + If Len(_SF_.MainFunction) > 0 Then ' MainFunction = [Library.]Module.Method + vLocation = Split(_SF_.MainFunction, ".") + If UBound(vLocation) < 2 Then vLocation = SF_Array.Prepend(vLocation, "ScriptForge") + sService = vLocation(1) + sMethod = vLocation(2) + sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), sService, sMethod) _ + & "\n" & L10N.GetText("VALIDATEARGS", _RightCaseArgs(_SF_.MainFunctionArgs)) + Else + sService = "" + sMethod = "" + sLocation = "" + End If + + With L10N + Select Case UCase(ErrorCode) + Case MISSINGARGERROR ' SF_Utils._Validate(Name) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("VALIDATEMISSING", pvArgs(0)) + Case ARGUMENTERROR ' SF_Utils._Validate(Value, Name, Types, Values, Regex, Class) + pvArgs(1) = _RightCase(pvArgs(1)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _ + & "\n" & "\n" & .GetText("VALIDATIONRULES") + If Len(pvArgs(2)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATETYPES", pvArgs(1), pvArgs(2)) + If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEVALUES", pvArgs(1), pvArgs(3)) + If Len(pvArgs(4)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEREGEX", pvArgs(1), pvArgs(4)) + If Len(pvArgs(5)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATECLASS", pvArgs(1), pvArgs(5)) + sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0)) + Case ARRAYERROR ' SF_Utils._ValidateArray(Value, Name, Dimensions, Types, NotNull) + pvArgs(1) = _RightCase(pvArgs(1)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _ + & "\n" & "\n" & .GetText("VALIDATIONRULES") _ + & "\n" & .GetText("VALIDATEARRAY", pvArgs(1)) + If pvArgs(2) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEDIMS", pvArgs(1), pvArgs(2)) + If Len(pvArgs(3)) > 0 Then sMessage = sMessage & "\n" & .GetText("VALIDATEALLTYPES", pvArgs(1), pvArgs(3)) + If pvArgs(4) Then sMessage = sMessage & "\n" & .GetText("VALIDATENOTNULL", pvArgs(1)) + sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0)) + Case FILEERROR ' SF_Utils._ValidateFile(Value, Name, WildCards) + pvArgs(1) = _RightCase(pvArgs(1)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(1)) _ + & "\n" & "\n" & .GetText("VALIDATIONRULES") _ + & "\n" & "\n" & .GetText("VALIDATEFILE", pvArgs(1)) + sAlt = "VALIDATEFILE" & SF_FileSystem.FileNaming + sMessage = sMessage & "\n" & .GetText(sAlt, pvArgs(1)) + If pvArgs(2) Then sMessage = sMessage & "\n" & .GetText("VALIDATEWILDCARD", pvArgs(1)) + sMessage = sMessage & "\n" & "\n" & .GetText("VALIDATEACTUAL", pvArgs(1), pvArgs(0)) + Case ARRAYSEQUENCEERROR ' SF_Array.RangeInit(From, UpTo, ByStep) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("ARRAYSEQUENCE", pvArgs(0), pvArgs(1), pvArgs(2)) + Case ARRAYINSERTERROR ' SF_Array.AppendColumn/Row/PrependColumn/Row(VectorName, Array_2D, Vector) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("ARRAYINSERT", pvArgs(0), pvArgs(1), pvArgs(2)) + Case ARRAYINDEX1ERROR ' SF_Array.ExtractColumn/Row(IndexName, Array_2D, Index) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("ARRAYINDEX1", pvArgs(0), pvArgs(1), pvArgs(2)) + Case ARRAYINDEX2ERROR ' SF_Array.Slice(From, UpTo) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("ARRAYINDEX2", pvArgs(0), pvArgs(1), pvArgs(2)) + Case CSVPARSINGERROR ' SF_Array.ImportFromCSVFile(FileName, LineNumber, Line) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("CSVPARSING", pvArgs(0), pvArgs(1), pvArgs(2)) + Case DUPLICATEKEYERROR ' SF_Dictionary.Add/ReplaceKey("Key", Key) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("DUPLICATEKEY", pvArgs(0), pvArgs(1)) + Case UNKNOWNKEYERROR ' SF_Dictionary.Remove/ReplaceItem/ReplaceKey("Key", Key) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("UNKNOWNKEY", pvArgs(0), pvArgs(1)) + Case INVALIDKEYERROR ' SF_Dictionary.Add/ReplaceKey(Key) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("INVALIDKEY") + Case UNKNOWNFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile/CreateScriptService("L10N")(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("UNKNOWNFILE", pvArgs(0), pvArgs(1)) + Case UNKNOWNFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("UNKNOWNFOLDER", pvArgs(0), pvArgs(1)) + Case NOTAFILEERROR ' SF_FileSystem.CopyFile/MoveFile/DeleteFile(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("NOTAFILE", pvArgs(0), pvArgs(1)) + Case NOTAFOLDERERROR ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("NOTAFOLDER", pvArgs(0), pvArgs(1)) + Case OVERWRITEERROR ' SF_FileSystem.Copy+Move/File+Folder/CreateTextFile/OpenTextFile(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("OVERWRITE", pvArgs(0), pvArgs(1)) + Case READONLYERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("READONLY", pvArgs(0), pvArgs(1)) + Case NOFILEMATCHERROR ' SF_FileSystem.Copy+Move+Delete/File+Folder(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("NOFILEMATCH", pvArgs(0), pvArgs(1)) + Case FOLDERCREATIONERROR ' SF_FileSystem.CreateFolder(ArgName, Filename) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("FOLDERCREATION", pvArgs(0), pvArgs(1)) + Case UNKNOWNSERVICEERROR ' SF_Services.CreateScriptService(ArgName, Value, Library, Service) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("UNKNOWNSERVICE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case SERVICESNOTLOADEDERROR ' SF_Services.CreateScriptService(ArgName, Value, Library) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("SERVICESNOTLOADED", pvArgs(0), pvArgs(1), pvArgs(2)) + Case CALCFUNCERROR ' SF_Session.ExecuteCalcFunction(CalcFunction) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("CalcFunction")) _ + & "\n" & "\n" & .GetText("CALCFUNC", pvArgs(0)) + Case NOSCRIPTERROR ' SF_Session._GetScript(Language, "Scope", Scope, "Script", Script) + pvArgs(1) = _RightCase(pvArgs(1)) : pvArgs(3) = _RightCase(pvArgs(3)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", _RightCase("Script")) _ + & "\n" & "\n" & .GetText("NOSCRIPT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4)) + Case SCRIPTEXECERROR ' SF_Session.ExecuteBasicScript("Script", Script, Cause) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("SCRIPTEXEC", pvArgs(0), pvArgs(1), pvArgs(2)) + Case WRONGEMAILERROR ' SF_Session.SendMail(Arg, Email) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("WRONGEMAIL", pvArgs(1)) + Case SENDMAILERROR ' SF_Session.SendMail() + sMessage = sLocation _ + & "\n" & "\n" & .GetText("SENDMAIL") + Case FILENOTOPENERROR ' SF_TextStream._IsFileOpen(FileName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("FILENOTOPEN", pvArgs(0)) + Case FILEOPENMODEERROR ' SF_TextStream._IsFileOpen(FileName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("FILEOPENMODE", pvArgs(0), pvArgs(1)) + Case ENDOFFILEERROR ' SF_TextStream.ReadLine/ReadAll/SkipLine(FileName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("ENDOFFILE", pvArgs(0)) + Case DOCUMENTERROR ' SF_UI.GetDocument(ArgName, WindowName) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("DOCUMENT", pvArgs(0), pvArgs(1)) + Case DOCUMENTCREATIONERROR ' SF_UI.Create(Arg1Name, DocumentType, Arg2Name, TemplateFile) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DOCUMENTCREATION", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case DOCUMENTOPENERROR ' SF_UI.OpenDocument(Arg1Name, FileName, Arg2Name, Password, Arg3Name, FilterName) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5)) + Case BASEDOCUMENTOPENERROR ' SF_UI.OpenBaseDocument(Arg1Name, FileName, Arg2Name, RegistrationName) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("BASEDOCUMENTOPEN", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case DOCUMENTDEADERROR ' SF_Document._IsStillAlive(FileName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DOCUMENTDEAD", pvArgs(0)) + Case DOCUMENTSAVEERROR ' SF_Document.Save(Arg1Name, FileName) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DOCUMENTSAVE", pvArgs(0), pvArgs(1)) + Case DOCUMENTSAVEASERROR ' SF_Document.SaveAs(Arg1Name, FileName, Arg2, Overwrite, Arg3, FilterName) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DOCUMENTSAVEAS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5)) + Case DOCUMENTREADONLYERROR ' SF_Document.update property("Document", FileName) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DOCUMENTREADONLY", pvArgs(0), pvArgs(1)) + Case DBCONNECTERROR ' SF_Base.GetDatabase("User", User, "Password", Password, FileName) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DBCONNECT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4)) + Case CALCADDRESSERROR ' SF_Calc._ParseAddress(Address, "Range"/"Sheet", Scope, Document) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("CALCADDRESS" & Iif(pvArgs(0) = "Sheet", "1", "2"), pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case DUPLICATESHEETERROR ' SF_Calc.InsertSheet(arg, SheetName, Document) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("DUPLICATESHEET", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case OFFSETADDRESSERROR ' SF_Calc.RangeOffset("Range", Range, "Rows", Rows, "Columns", Columns, "Height", Height, "Width", Width, "Document, Document) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4)) + pvArgs(6) = _RightCase(pvArgs(6)) : pvArgs(8) = _RightCase(pvArgs(8)) : pvArgs(10) = _RightCase(pvArgs(10)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("OFFSETADDRESS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _ + , pvArgs(5), pvArgs(6), pvArgs(7), pvArgs(8), pvArgs(9), pvArgs(10), pvArgs(11)) + Case DUPLICATECHARTERROR ' SF_Calc.CreateChart(chart, ChartName, sheet, SheetName, Document, file) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("DUPLICATECHART", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5)) + Case RANGEEXPORTERROR ' SF_Calc.ExportRangeToFile(Arg1Name, FileName, Arg2, Overwrite) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("RANGEEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case CHARTEXPORTERROR ' SF_Chart.ExportToFile(Arg1Name, FileName, Arg2, Overwrite) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("CHARTEXPORT", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case FORMDEADERROR ' SF_Form._IsStillAlive(FormName, DocumentName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("FORMDEAD", pvArgs(0), pvArgs(1)) + Case CALCFORMNOTFOUNDERROR ' SF_Calc.Forms(Index, SheetName, Document) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("CALCFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2)) + Case WRITERFORMNOTFOUNDERROR ' SF_Document.Forms(Index, Document) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("WRITERFORMNOTFOUND", pvArgs(0), pvArgs(1)) + Case BASEFORMNOTFOUNDERROR ' SF_Base.Forms(Index, FormDocument, BaseDocument) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("BASEFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2)) + Case SUBFORMNOTFOUNDERROR ' SF_Form.Subforms(Subform, Mainform) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("SUBFORMNOTFOUND", pvArgs(0), pvArgs(1)) + Case FORMCONTROLTYPEERROR ' SF_FormControl._SetProperty(ControlName, FormName, ControlType, Property) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("FORMCONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case DIALOGNOTFOUNDERROR ' SF_Dialog._NewDialog(Service, DialogName, WindowName) + pvArgs(0) = _RightCase(pvArgs(0)) : pvArgs(2) = _RightCase(pvArgs(2)) : pvArgs(4) = _RightCase(pvArgs(4)) + pvArgs(6) = _RightCase(pvArgs(6)) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DIALOGNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _ + , pvArgs(5), pvArgs(6), pvArgs(7)) + Case DIALOGDEADERROR ' SF_Dialog._IsStillAlive(DialogName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DIALOGDEAD", pvArgs(0)) + Case CONTROLTYPEERROR ' SF_DialogControl._SetProperty(ControlName, DialogName, ControlType, Property) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("CONTROLTYPE", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3)) + Case TEXTFIELDERROR ' SF_DialogControl.WriteLine(ControlName, DialogName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("TEXTFIELD", pvArgs(0), pvArgs(1)) + Case DBREADONLYERROR ' SF_Database.RunSql() + sMessage = sLocation _ + & "\n" & "\n" & .GetText("DBREADONLY", vLocation(2)) + Case SQLSYNTAXERROR ' SF_Database._ExecuteSql(SQL) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("SQLSYNTAX", pvArgs(0)) + Case PYTHONSHELLERROR ' SF_Exception.PythonShell (Python only) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("PYTHONSHELL") + Case UNITTESTLIBRARYERROR ' SFUnitTests._NewUnitTest(LibraryName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("UNITTESTLIBRARY", pvArgs(0)) + Case UNITTESTMETHODERROR ' SFUnitTests.SF_UnitTest(Method) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("UNITTESTMETHOD", pvArgs(0)) + Case Else + End Select + End With + + ' Log fatal event + _SF_._AddToConsole(sMessage) + + ' Display fatal event, if relevant (default) + If _SF_.DisplayEnabled Then + If _SF_.StopWhenError Then sMessage = sMessage & "\n" & "\n" & "\n" & L10N.GetText("STOPEXECUTION") + ' Do you need more help ? + If Len(sMethod) > 0 Then + sMessage = sMessage & "\n" & "\n" & L10N.GetText("NEEDMOREHELP", sMethod) + iButtons = MB_YESNO + MB_DEFBUTTON2 + Else + iButtons = MB_OK + End If + iMsgBox = MsgBox(SF_String.ExpandTabs(SF_String.Unescape(sMessage), cstTabSize) _ + , iButtons + MB_ICONEXCLAMATION _ + , L10N.GetText("ERRORNUMBER", ErrorCode) _ + ) + ' If more help needed ... + If iMsgBox = IDYES Then _OpenHelpInBrowser(sService, sMethod) + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + _SF_._StackReset() + If _SF_.StopWhenError Then Stop + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Exception.RaiseFatal + +REM ----------------------------------------------------------------------------- +Public Sub RaiseWarning(Optional ByVal Number As Variant _ + , Optional ByVal Source As Variant _ + , Optional ByVal Description As Variant _ + ) +''' Generate a run-time error. An error message is displayed to the user and logged +''' in the console. The execution is NOT STOPPED +''' Args: +''' Number: the error number, may be numeric or string +''' If numeric and <= 2000, it is considered a LibreOffice Basic run-time error (default = Err) +''' Source: the line where the error occurred (default = Erl) or any string describing the location of the error +''' Description: the error message to log in the console and to display to the user +''' Returns: +''' True if successful. Anyway, the execution continues +''' Examples: +''' On Local Error GoTo Catch +''' ' ... +''' Catch: +''' SF_Exception.RaiseWarning() ' Standard behaviour +''' SF_Exception.RaiseWarning(11) ' Force division by zero +''' SF_Exception.RaiseWarning("MYAPPERROR", "myFunction", "Application error") +''' SF_Exception.RaiseWarning(,, "To divide by zero is not a good idea !") + +Dim bStop As Boolean ' Alias for stop switch +Const cstThisSub = "Exception.RaiseWarning" +Const cstSubArgs = "[Number=Err], [Source=Erl], [Description]" + + ' Save Err, Erl, .. values before any On Error ... statement + SF_Exception._CaptureSystemError() + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Number) Or IsEmpty(Number) Then Number = -1 + If IsMissing(Source) Or IsEmpty(Source) Then Source = -1 + If IsMissing(Description) Or IsEmpty(Description) Then Description = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally + If Not SF_Utils._Validate(Source, "Source", Array(V_STRING, V_NUMERIC, V_EMPTY)) Then GoTo Finally + If Not SF_Utils._Validate(Description, "Description", V_STRING) Then GoTo Finally + End If + +Try: + bStop = _SF_.StopWhenError ' Store current value to reset it before leaving the Sub + _SF_.StopWhenError = False + SF_Exception.Raise(Number, Source, Description) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + _SF_.StopWhenError = bStop + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Exception.RaiseWarning + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Exception.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + SetProperty = _PropertySet(PropertyName, Value) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Exception.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Sub _CaptureSystemError() +''' Store system error status in system error properties +''' Called at each invocation of an error management property or method +''' Reset by SF_Exception.Clear() + + If Err > 0 And _SysNumber = 0 Then + _SysNumber = Err + _SysSource = Erl + _SysDescription = Error$ + End If + +End Sub ' ScriptForge.SF_Exception._CaptureSystemError + +REM ----------------------------------------------------------------------------- +Public Sub _CloseConsole(Optional ByRef poEvent As Object) +''' Close the console when opened in non-modal mode +''' Triggered by the CloseNonModalButton from the dlgConsole dialog + + On Local Error GoTo Finally + +Try: + With _SF_ + If Not IsNull(.ConsoleDialog) Then + If .ConsoleDialog._IsStillAlive(False) Then ' False to not raise an error + Set .ConsoleControl = .ConsoleControl.Dispose() + Set .ConsoleDialog = .ConsoleDialog.Dispose() + End If + End If + End With + +Finally: + Exit Sub +End Sub ' ScriptForge.SF_Exception._CloseConsole + +REM ----------------------------------------------------------------------------- +Private Sub _ConsoleRefresh() +''' Reload the content of the console in the dialog +''' Needed when console first loaded or when totally or partially cleared + + With _SF_ + ' Do nothing if console inactive + If IsNull(.ConsoleDialog) Then GoTo Finally + If Not .ConsoleDialog._IsStillAlive(False) Then ' False to not generate an error when dead + Set .ConsoleControl = .ConsoleControl.Dispose() + Set .ConsoleDialog = Nothing + GoTo Finally + End If + ' Store the relevant text in the control + If IsNull(.ConsoleControl) Then Set .ConsoleControl = .ConsoleDialog.Controls(CONSOLENAME) + .ConsoleControl.Value = "" + If UBound(.ConsoleLines) >= 0 Then .ConsoleControl.WriteLine(Join(.ConsoleLines, SF_String.sfNEWLINE)) + End With + +Finally: + Exit Sub +End Sub ' ScriptForge.SF_Exception._ConsoleRefresh + +REM ----------------------------------------------------------------------------- +Private Sub _OpenHelpInBrowser(ByVal psService As String, ByVal psMethod As String) +''' Open the help page and help anchor related to the given ScriptForge service and method + +Dim sUrl As String ' URL to open +Const cstURL = "https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_%1.html?&DbPAR=BASIC#%2" + + On Local Error GoTo Finally ' No reason to risk abort here +Try: + sUrl = SF_String.ReplaceStr(cstURL, Array("%1", "%2"), Array(LCase(psService), psMethod)) + SF_Session.OpenUrlInBrowser(sUrl) + +Finally: + Exit Sub +End Sub ' ScriptForge.SF_Exception._OpenHelpInBrowser + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SF_Exception.get" & psProperty + + SF_Exception._CaptureSystemError() + + Select Case psProperty + Case "Description" + If _Description = "" Then _PropertyGet = _SysDescription Else _PropertyGet = _Description + Case "Number" + If IsEmpty(_Number) Then _PropertyGet = _SysNumber Else _PropertyGet = _Number + Case "Source" + If IsEmpty(_Source) Then _PropertyGet = _SysSource Else _PropertyGet = _Source + Case Else + _PropertyGet = Null + End Select + +Finally: + Exit Function +End Function ' ScriptForge.SF_Exception._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _PropertySet(Optional ByVal psProperty As String _ + , Optional ByVal pvValue As Variant _ + ) As Boolean +''' Set a new value to the named property +''' Applicable only to user defined errors +''' Args: +''' psProperty: the name of the property +''' pvValue: the new value + +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SF_Exception.set" & psProperty + _PropertySet = False + + SF_Exception._CaptureSystemError() + + ' Argument validation must be manual to preserve system error status + ' If wrong VarType then property set is ignored + Select Case psProperty + Case "Description" + If VarType(pvValue) = V_STRING Then _Description = pvValue + Case "Number" + Select Case SF_Utils._VarTypeExt(pvValue) + Case V_STRING + _Number = pvValue + Case V_NUMERIC + _Number = CLng(pvValue) + If _Number <= RUNTIMEERRORS And Len(_Description) = 0 Then _Description = Error(_Number) + Case V_EMPTY + _Number = Empty + Case Else + End Select + Case "Source" + Select Case SF_Utils._VarTypeExt(pvValue) + Case V_STRING + _Source = pvValue + Case V_NUMERIC + _Source = CLng(pvValue) + Case Else + End Select + Case Else + End Select + + _PropertySet = True + +Finally: + Exit Function +End Function ' ScriptForge.SF_Exception._PropertySet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Exception instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Exception]: A readable string" + + _Repr = "[Exception]: " & _Number & " (" & _Description & ")" + +End Function ' ScriptForge.SF_Exception._Repr + +REM ----------------------------------------------------------------------------- +Private Function _RightCase(psString As String) As String +''' Return the input argument in lower case only when the procedure in execution +''' has been triggered from a Python script +''' Indeed, Python requires lower case arguments +''' Args: +''' psString: probably an identifier in ProperCase +''' Return: +''' The input argument in lower case or left unchanged depending on the execution context + +Try: + If _SF_.TriggeredByPython Then _RightCase = LCase(psString) Else _RightCase = psString + +Finally: + Exit Function +End Function ' ScriptForge.SF_Exception._RightCase + +REM ----------------------------------------------------------------------------- +Private Function _RightCaseArgs(psString As String) As String +''' Return the input argument unchanged when the execution context is Basic +''' When it is Python, the argument names are lowercased. +''' Args: +''' psString: one of the cstSubArgs strings located in each official method +''' Return: +''' The input string in which the argument names are put in lower case when called from Python scripts + +Dim sSubArgs As String ' Return value +Dim vArgs As Variant ' Input string split on the comma character +Dim sSingleArg As String ' Single vArgs item +Dim vSingleArgs As Variant ' vSingleArg split on equal sign +Dim i As Integer + +Const cstComma = "," +Const cstEqual = "=" + +Try: + If Len(psString) = 0 Then + sSubArgs = "" + ElseIf _SF_.TriggeredByPython Then + vArgs = SF_String.SplitNotQuoted(psString, cstComma, QuoteChar := """") + For i = 0 To UBound(vArgs) + sSingleArg = vArgs(i) + vSingleArgs = Split(sSingleArg, cstEqual) + vSingleArgs(0) = LCase(vSingleArgs(0)) + vArgs(i) = join(vSingleArgs, cstEqual) + Next i + sSubArgs = Join(vArgs, cstComma) + Else + sSubArgs = psString + End If + +Finally: + _RightCaseArgs = sSubArgs + Exit Function +End Function ' ScriptForge.SF_Exception._RightCaseArgs + +REM ============================================ END OF SCRIPTFORGE.SF_EXCEPTION +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_FileSystem.xba b/wizards/source/scriptforge/SF_FileSystem.xba new file mode 100644 index 000000000..39ea4888e --- /dev/null +++ b/wizards/source/scriptforge/SF_FileSystem.xba @@ -0,0 +1,2128 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FileSystem" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_FileSystem +''' ============= +''' Class implementing the file system service +''' for common file and folder handling routines +''' Including copy and move of files and folders, with or without wildcards +''' The design choices are largely inspired by +''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object +''' The File and Folder classes have been found redundant with the current class and have not been implemented +''' The implementation is mainly based on the XSimpleFileAccess UNO interface +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1ucb_1_1XSimpleFileAccess.html +''' +''' Subclasses: +''' SF_TextStream +''' +''' Definitions: +''' File and folder names may be expressed either in the (preferable because portable) URL form +''' or in the more usual operating system notation (e.g. C:\... for Windows) +''' The notation, both for arguments and for returned values +''' is determined by the FileNaming property: either "URL" (default) or "SYS" +''' +''' FileName: the full name of the file including the path without any ending path separator +''' FolderName: the full name of the folder including the path and the ending path separator +''' Name: the last component of the File- or FolderName including its extension +''' BaseName: the last component of the File- or FolderName without its extension +''' NamePattern: any of the above names containing wildcards in its last component +''' Admitted wildcards are: the "?" represents any single character +''' the "*" represents zero, one, or multiple characters +''' +''' Service invocation example: +''' Dim FSO As Variant +''' Set FSO = CreateScriptService("FileSystem") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist +Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist +Const NOTAFILEERROR = "NOTAFILEERROR" ' Destination is a folder, not a file +Const NOTAFOLDERERROR = "NOTAFOLDERERROR" ' Destination is a file, not a folder +Const OVERWRITEERROR = "OVERWRITEERROR" ' Destination can not be overwritten +Const READONLYERROR = "READONLYERROR" ' Destination has its read-only attribute set +Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" ' No file matches Source containing wildcards +Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file + +REM ============================================================ MODULE CONSTANTS + +''' TextStream open modes +Const cstForReading = 1 +Const cstForWriting = 2 +Const cstForAppending = 8 + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_FileSystem Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ConfigFolder() As String +''' Return the configuration folder of LibreOffice + +Const cstThisSub = "FileSystem.getConfigFolder" + + SF_Utils._EnterFunction(cstThisSub) + ConfigFolder = SF_FileSystem._GetConfigFolder("user") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.ConfigFolder + +REM ----------------------------------------------------------------------------- +Property Get ExtensionsFolder() As String +''' Return the folder containing the extensions installed for the current user + +Dim oMacro As Object ' /singletons/com.sun.star.util.theMacroExpander +Const cstThisSub = "FileSystem.getExtensionsFolder" + + SF_Utils._EnterFunction(cstThisSub) + Set oMacro = SF_Utils._GetUNOService("MacroExpander") + ExtensionsFolder = SF_FileSystem._ConvertFromUrl(oMacro.ExpandMacros("$UNO_USER_PACKAGES_CACHE") & "/") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.ExtensionsFolder + +REM ----------------------------------------------------------------------------- +Property Get FileNaming() As Variant +''' Return the current files and folder notation, either "ANY", "URL" or "SYS" +''' "ANY": methods receive either URL or native file names, but always return URL file names +''' "URL": methods expect URL arguments and return URL strings (when relevant) +''' "SYS": idem but operating system notation + +Const cstThisSub = "FileSystem.getFileNaming" + SF_Utils._EnterFunction(cstThisSub) + FileNaming = _SF_.FileSystemNaming + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.FileNaming (get) + +REM ----------------------------------------------------------------------------- +Property Let FileNaming(ByVal pvNotation As Variant) +''' Set the files and folders notation: "ANY", "URL" or "SYS" + +Const cstThisSub = "FileSystem.setFileNaming" + SF_Utils._EnterFunction(cstThisSub) + If VarType(pvNotation) = V_STRING Then + Select Case UCase(pvNotation) + Case "ANY", "URL", "SYS" : _SF_.FileSystemNaming = UCase(pvNotation) + Case Else ' Unchanged + End Select + End If + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.FileNaming (let) + +REM ----------------------------------------------------------------------------- +Property Get ForAppending As Integer +''' Convenient constant (see documentation) + ForAppending = cstForAppending +End Property ' ScriptForge.SF_FileSystem.ForAppending + +REM ----------------------------------------------------------------------------- +Property Get ForReading As Integer +''' Convenient constant (see documentation) + ForReading = cstForReading +End Property ' ScriptForge.SF_FileSystem.ForReading + +REM ----------------------------------------------------------------------------- +Property Get ForWriting As Integer +''' Convenient constant (see documentation) + ForWriting = cstForWriting +End Property ' ScriptForge.SF_FileSystem.ForWriting + +REM ----------------------------------------------------------------------------- +Property Get HomeFolder() As String +''' Return the user home folder + +Const cstThisSub = "FileSystem.getHomeFolder" + + SF_Utils._EnterFunction(cstThisSub) + HomeFolder = SF_FileSystem._GetConfigFolder("home") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.HomeFolder + +REM ----------------------------------------------------------------------------- +Property Get InstallFolder() As String +''' Return the installation folder of LibreOffice + +Const cstThisSub = "FileSystem.getInstallFolder" + + SF_Utils._EnterFunction(cstThisSub) + InstallFolder = SF_FileSystem._GetConfigFolder("inst") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.InstallFolder + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_FileSystem" +End Property ' ScriptForge.SF_FileSystem.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.FileSystem" +End Property ' ScriptForge.SF_FileSystem.ServiceName + +REM ----------------------------------------------------------------------------- +Property Get TemplatesFolder() As String +''' Return the folder defined in the LibreOffice paths options as intended for templates files + +Dim sPath As String ' Template property of com.sun.star.util.PathSettings +Const cstThisSub = "FileSystem.getTemplatesFolder" + + SF_Utils._EnterFunction(cstThisSub) + sPath = SF_Utils._GetUNOService("PathSettings").Template + TemplatesFolder = SF_FileSystem._ConvertFromUrl(Split(sPath, ";")(0) & "/") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.TemplatesFolder + +REM ----------------------------------------------------------------------------- +Property Get TemporaryFolder() As String +''' Return the folder defined in the LibreOffice paths options as intended for temporary files + +Const cstThisSub = "FileSystem.getTemporaryFolder" + + SF_Utils._EnterFunction(cstThisSub) + TemporaryFolder = SF_FileSystem._GetConfigFolder("temp") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.TemporaryFolder + +REM ----------------------------------------------------------------------------- +Property Get UserTemplatesFolder() As String +''' Return the folder defined in the LibreOffice paths options as intended for User templates files + +Dim sPath As String ' Template_writable property of com.sun.star.util.PathSettings +Const cstThisSub = "FileSystem.getUserTemplatesFolder" + + SF_Utils._EnterFunction(cstThisSub) + sPath = SF_Utils._GetUNOService("PathSettings").Template_writable + UserTemplatesFolder = SF_FileSystem._ConvertFromUrl(sPath & "/") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.UserTemplatesFolder + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function BuildPath(Optional ByVal FolderName As Variant _ + , Optional ByVal Name As Variant _ + ) As String +''' Combines a folder path and the name of a file and returns the combination with a valid path separator +''' Inserts an additional path separator between the foldername and the name, only if necessary +''' Args: +''' FolderName: Path with which Name is combined. Path need not specify an existing folder +''' Name: To be appended to the existing path. +''' Returns: +''' The path concatenated with the file name after insertion of a path separator, if necessary +''' Example: +''' Dim a As String +''' FSO.FileNaming = "SYS" +''' a = FSO.BuildPath("C:\Windows", "Notepad.exe") returns C:\Windows\Notepad.exe + +Dim sBuild As String ' Return value +Dim sFile As String ' Alias for Name +Const cstFileProtocol = "file:///" +Const cstThisSub = "FileSystem.BuildPath" +Const cstSubArgs = "FolderName, Name" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sBuild = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally + If Not SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Finally + End If + FolderName = SF_FileSystem._ConvertToUrl(FolderName) + +Try: + ' Add separator if necessary. FolderName is now in URL notation + If Len(FolderName) > 0 Then + If Right(FolderName, 1) <> "/" Then sBuild = FolderName & "/" Else sBuild = FolderName + Else + sBuild = cstFileProtocol + End If + ' Encode the file name + sFile = ConvertToUrl(Name) + ' Some file names produce http://file.name.suffix/ + If Left(sFile, 7) = "http://" Then sFile = cstFileProtocol & Mid(sFile, 8, Len(sFile) - 8) + ' Combine both parts + If Left(sFile, Len(cstFileProtocol)) = cstFileProtocol Then sBuild = sBuild & Mid(sFile, Len(cstFileProtocol) + 1) Else sBuild = sBuild & sFile + +Finally: + BuildPath = SF_FileSystem._ConvertFromUrl(sBuild) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.BuildPath + +REM ----------------------------------------------------------------------------- +Public Function CompareFiles(Optional ByVal FileName1 As Variant _ + , Optional ByVal FileName2 As Variant _ + , Optional ByVal CompareContents As Variant _ + ) +''' Compare 2 files and return True if they seem identical +''' The comparison may be based on the file attributes, like modification time, +''' or on their contents. +''' Args: +''' FileName1: The 1st file to compare +''' FileName2: The 2nd file to compare +''' CompareContents: When True, the contents of the files are compared. Default = False +''' Returns: +''' True when the files seem identical +''' Exceptions: +''' UNKNOWNFILEERROR One of the files does not exist +''' Example: +''' FSO.FileNaming = "SYS" +''' MsgBox FSO.CompareFiles("C:\myFile1.txt", "C:\myFile2.txt", CompareContents := True) + +Dim bCompare As Boolean ' Return value +Dim sFile As String ' Alias of FileName1 and 2 +Dim iFile As Integer ' 1 or 2 +Const cstPyHelper = "$" & "_SF_FileSystem__CompareFiles" + +Const cstThisSub = "FileSystem.CompareFiles" +Const cstSubArgs = "FileName1, FileName2, [CompareContents=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCompare = False + +Check: + If IsMissing(CompareContents) Or IsEmpty(CompareContents) Then CompareContents = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName1, "FileName1", False) Then GoTo Finally + If Not SF_Utils._ValidateFile(FileName2, "FileName2", False) Then GoTo Finally + If Not SF_Utils._Validate(CompareContents, "CompareContents", V_BOOLEAN) Then GoTo Finally + End If + ' Do the files exist ? Otherwise raise error + sFile = FileName1 : iFile = 1 + If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists + sFile = FileName2 : iFile = 2 + If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists + +Try: + With ScriptForge.SF_Session + bCompare = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _ + , _ConvertFromUrl(FileName1) _ + , _ConvertFromUrl(FileName2) _ + , CompareContents) + End With + +Finally: + CompareFiles = bCompare + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName" & iFile, sFile) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.CompareFiles + +REM ----------------------------------------------------------------------------- +Public Function CopyFile(Optional ByVal Source As Variant _ + , Optional ByVal Destination As Variant _ + , Optional ByVal Overwrite As Variant _ + ) As Boolean +''' Copies one or more files from one location to another +''' Args: +''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be copied +''' Destination: FileName where the single Source file is to be copied +''' or FolderName where the multiple files from Source are to be copied +''' If FolderName does not exist, it is created +''' Anyway, wildcard characters are not allowed in Destination +''' Overwrite: If True (default), files may be overwritten +''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite. +''' Returns: +''' True if at least one file has been copied +''' False if an error occurred +''' An error also occurs if a source using wildcard characters doesn't match any files. +''' The method stops on the first error it encounters +''' No attempt is made to roll back or undo any changes made before an error occurs +''' Exceptions: +''' UNKNOWNFILEERROR Source does not exist +''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist +''' NOFILEMATCHERROR No file matches Source containing wildcards +''' NOTAFOLDERERROR Destination is a file, not a folder +''' NOTAFILEERROR Destination is a folder, not a file +''' OVERWRITEERROR Destination can not be overwritten +''' READONLYERROR Destination has its read-only attribute set +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.CopyFile("C:\Windows\*.*", "C:\Temp\", Overwrite := False) ' Only files are copied, subfolders are not + +Dim bCopy As Boolean ' Return value + +Const cstThisSub = "FileSystem.CopyFile" +Const cstSubArgs = "Source, Destination, [Overwrite=True]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCopy = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally + If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally + End If + +Try: + bCopy = SF_FileSystem._CopyMove("CopyFile", Source, Destination, Overwrite) + +Finally: + CopyFile = bCopy + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.CopyFile + +REM ----------------------------------------------------------------------------- +Public Function CopyFolder(Optional ByVal Source As Variant _ + , Optional ByVal Destination As Variant _ + , Optional ByVal Overwrite As Variant _ + ) As Boolean +''' Copies one or more folders from one location to another +''' Args: +''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be copied +''' Destination: FolderName where the single Source folder is to be copied +''' or FolderName where the multiple folders from Source are to be copied +''' If FolderName does not exist, it is created +''' Anyway, wildcard characters are not allowed in Destination +''' Overwrite: If True (default), folders and their content may be overwritten +''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite. +''' Returns: +''' True if at least one folder has been copied +''' False if an error occurred +''' An error also occurs if a source using wildcard characters doesn't match any folders. +''' The method stops on the first error it encounters +''' No attempt is made to roll back or undo any changes made before an error occurs +''' Exceptions: +''' UNKNOWNFILEERROR Source does not exist +''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist +''' NOFILEMATCHERROR No file matches Source containing wildcards +''' NOTAFOLDERERROR Destination is a file, not a folder +''' OVERWRITEERROR Destination can not be overwritten +''' READONLYERROR Destination has its read-only attribute set +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.CopyFolder("C:\Windows\*", "C:\Temp\", Overwrite := False) + +Dim bCopy As Boolean ' Return value + +Const cstThisSub = "FileSystem.CopyFolder" +Const cstSubArgs = "Source, Destination, [Overwrite=True]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCopy = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally + If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally + End If + +Try: + bCopy = SF_FileSystem._CopyMove("CopyFolder", Source, Destination, Overwrite) + +Finally: + CopyFolder = bCopy + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.CopyFolder + +REM ----------------------------------------------------------------------------- +Public Function CreateFolder(Optional ByVal FolderName As Variant) As Boolean +''' Return True if the given folder name could be created successfully +''' The parent folder does not need to exist beforehand +''' Args: +''' FolderName: a string representing the folder to create. It must not exist +''' Returns: +''' True if FolderName is a valid folder name, does not exist and creation was successful +''' False otherwise including when FolderName is a file +''' Exceptions: +''' FOLDERCREATIONERROR FolderName is an existing folder or file +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.CreateFolder("C:\NewFolder\") + +Dim bCreate As Boolean ' Return value +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess + +Const cstThisSub = "FileSystem.CreateFolder" +Const cstSubArgs = "FolderName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCreate = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally + End If + +Try: + Set oSfa = SF_Utils._GetUnoService("FileAccess") + If SF_FileSystem.FolderExists(FolderName) Then GoTo CatchExists + If SF_FileSystem.FileExists(FolderName) Then GoTo CatchExists + oSfa.createFolder(SF_FileSystem._ConvertToUrl(FolderName)) + bCreate = True + +Finally: + CreateFolder = bCreate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchExists: + SF_Exception.RaiseFatal(FOLDERCREATIONERROR, "FolderName", FolderName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.CreateFolder + +REM ----------------------------------------------------------------------------- +Public Function CreateTextFile(Optional ByVal FileName As Variant _ + , Optional ByVal Overwrite As Variant _ + , Optional ByVal Encoding As Variant _ + ) As Object +''' Creates a specified file and returns a TextStream object that can be used to write to the file +''' Args: +''' FileName: Identifies the file to create +''' Overwrite: Boolean value that indicates if an existing file can be overwritten (default = True) +''' Encoding: The character set that should be used +''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Note that LibreOffice does not implement all existing sets +''' Default = UTF-8 +''' Returns: +''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred +''' It doesn't check either if the given encoding is implemented in LibreOffice +''' Exceptions: +''' OVERWRITEERROR File exists, creation impossible +''' Example: +''' Dim myFile As Object +''' FSO.FileNaming = "SYS" +''' Set myFile = FSO.CreateTextFile("C:\Temp\ThisFile.txt", Overwrite := True) + +Dim oTextStream As Object ' Return value +Const cstThisSub = "FileSystem.CreateTextFile" +Const cstSubArgs = "FileName, [Overwrite=True], [Encoding=""UTF-8""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oTextStream = Nothing + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True + If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally + End If + + With SF_FileSystem + If .FileExists(FileName) Then + If Overwrite Then .DeleteFile(FileName) Else GoTo CatchOverWrite + End If + +Try: + Set oTextStream = .OpenTextFile(FileName, .ForWriting, Create := True, Encoding := Encoding) + End With + +Finally: + Set CreateTextFile = oTextStream + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchOverWrite: + SF_Exception.RaiseFatal(OVERWRITEERROR, "FileName", FileName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.CreateTextFile + +REM ----------------------------------------------------------------------------- +Public Function DeleteFile(Optional ByVal FileName As Variant) As Boolean +''' Deletes one or more files +''' Args: +''' FileName: FileName or NamePattern which can include wildcard characters, for one or more files to be deleted +''' Returns: +''' True if at least one file has been deleted +''' False if an error occurred +''' An error also occurs if a FileName using wildcard characters doesn't match any files. +''' The method stops on the first error it encounters +''' No attempt is made to roll back or undo any changes made before an error occurs +''' Exceptions: +''' UNKNOWNFILEERROR FileName does not exist +''' NOFILEMATCHERROR No file matches FileName containing wildcards +''' NOTAFILEERROR Argument is a folder, not a file +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.DeleteFile("C:\Temp\*.*") ' Only files are deleted, subfolders are not + +Dim bDelete As Boolean ' Return value + +Const cstThisSub = "FileSystem.DeleteFile" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bDelete = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName", True) Then GoTo Finally + End If + +Try: + bDelete = SF_FileSystem._Delete("DeleteFile", FileName) + +Finally: + DeleteFile = bDelete + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.DeleteFile + +REM ----------------------------------------------------------------------------- +Public Function DeleteFolder(Optional ByVal FolderName As Variant) As Boolean +''' Deletes one or more Folders +''' Args: +''' FolderName: FolderName or NamePattern which can include wildcard characters, for one or more Folders to be deleted +''' Returns: +''' True if at least one folder has been deleted +''' False if an error occurred +''' An error also occurs if a FolderName using wildcard characters doesn't match any folders. +''' The method stops on the first error it encounters +''' No attempt is made to roll back or undo any changes made before an error occurs +''' Exceptions: +''' UNKNOWNFOLDERERROR FolderName does not exist +''' NOFILEMATCHERROR No folder matches FolderName containing wildcards +''' NOTAFOLDERERROR Argument is a file, not a folder +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.DeleteFolder("C:\Temp\*") ' Only folders are deleted, files in the parent folder are not + +Dim bDelete As Boolean ' Return value + +Const cstThisSub = "FileSystem.DeleteFolder" +Const cstSubArgs = "FolderName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bDelete = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FolderName, "FolderName", True) Then GoTo Finally + End If + +Try: + bDelete = SF_FileSystem._Delete("DeleteFolder", FolderName) + +Finally: + DeleteFolder = bDelete + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.DeleteFolder + +REM ----------------------------------------------------------------------------- +Public Function ExtensionFolder(Optional ByVal Extension As Variant) As String +''' Return the folder where the given extension is installed. The argument must +''' be in the list of extensions provided by the SF_Platform.Extensions property +''' Args: +''' Extension: a valid extension name +''' Returns: +''' The requested folder using the FileNaming notation +''' Example: +''' MsgBox FSO.ExtensionFolder("apso.python.script.organizer") + +Dim sFolder As String ' Return value +Static vExtensions As Variant ' Cached list of existing extension names +Dim oPackage As Object ' /singletons/com.sun.star.deployment.PackageInformationProvider +Const cstThisSub = "FileSystem.ExtensionFolder" +Const cstSubArgs = "Extension" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFolder = "" + +Check: + If IsEmpty(vExtensions) Then vExtensions = SF_Platform.Extensions + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Extension, "Extension", V_STRING, vExtensions) Then GoTo Finally + End If + +Try: + ' Search an individual folder + Set oPackage = SF_Utils._GetUnoService("PackageInformationProvider") + sFolder = oPackage.getPackageLocation(Extension) + +Finally: + ExtensionFolder = SF_FileSystem._ConvertFromUrl(sFolder) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.ExtensionFolder + +REM ----------------------------------------------------------------------------- +Public Function FileExists(Optional ByVal FileName As Variant) As Boolean +''' Return True if the given file exists +''' Args: +''' FileName: a string representing a file +''' Returns: +''' True if FileName is a valid File name and it exists +''' False otherwise including when FileName is a folder +''' Example: +''' FSO.FileNaming = "SYS" +''' If FSO.FileExists("C:\Notepad.exe") Then ... + +Dim bExists As Boolean ' Return value +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess + +Const cstThisSub = "FileSystem.FileExists" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bExists = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + FileName = SF_FileSystem._ConvertToUrl(FileName) + +Try: + Set oSfa = SF_Utils._GetUnoService("FileAccess") + bExists = oSfa.exists(FileName) And Not oSfa.isFolder(FileName) + +Finally: + FileExists = bExists + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.FileExists + +REM ----------------------------------------------------------------------------- +Public Function Files(Optional ByVal FolderName As Variant _ + , Optional ByVal Filter As Variant _ + ) As Variant +''' Return an array of the FileNames stored in the given folder. The folder must exist +''' Args: +''' FolderName: the folder to explore +''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant files (default = "") +''' Returns: +''' An array of strings, each entry is the FileName of an existing file +''' Exceptions: +''' UNKNOWNFOLDERERROR Folder does not exist +''' NOTAFOLDERERROR FolderName is a file, not a folder +''' Example: +''' Dim a As Variant +''' FSO.FileNaming = "SYS" +''' a = FSO.Files("C:\Windows\") + +Dim vFiles As Variant ' Return value +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim sFolderName As String ' URL lias for FolderName +Dim sFile As String ' Single file +Dim i As Long + +Const cstThisSub = "FileSystem.Files" +Const cstSubArgs = "FolderName, [Filter=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vFiles = Array() + +Check: + If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally + If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally + End If + sFolderName = SF_FileSystem._ConvertToUrl(FolderName) + If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file + If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist + +Try: + ' Get files + Set oSfa = SF_Utils._GetUnoService("FileAccess") + vFiles = oSfa.getFolderContents(sFolderName, False) + ' Adjust notations + For i = 0 To UBound(vFiles) + sFile = SF_FileSystem._ConvertFromUrl(vFiles(i)) + vFiles(i) = sFile + Next i + ' Reduce list to those passing the filter + If Len(Filter) > 0 Then + For i = 0 To UBound(vFiles) + sFile = SF_FileSystem.GetName(vFiles(i)) + If Not SF_String.IsLike(sFile, Filter) Then vFiles(i) = "" + Next i + vFiles = Sf_Array.TrimArray(vFiles) + End If + +Finally: + Files = vFiles + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchFile: + SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", FolderName) + GoTo Finally +CatchFolder: + SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", FolderName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.Files + +REM ----------------------------------------------------------------------------- +Public Function FolderExists(Optional ByVal FolderName As Variant) As Boolean +''' Return True if the given folder name exists +''' Args: +''' FolderName: a string representing a folder +''' Returns: +''' True if FolderName is a valid folder name and it exists +''' False otherwise including when FolderName is a file +''' Example: +''' FSO.FileNaming = "SYS" +''' If FSO.FolderExists("C:\") Then ... + +Dim bExists As Boolean ' Return value +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess + +Const cstThisSub = "FileSystem.FolderExists" +Const cstSubArgs = "FolderName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bExists = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally + End If + FolderName = SF_FileSystem._ConvertToUrl(FolderName) + +Try: + Set oSfa = SF_Utils._GetUnoService("FileAccess") + bExists = oSfa.isFolder(FolderName) + +Finally: + FolderExists = bExists + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.FolderExists + +REM ----------------------------------------------------------------------------- +Public Function GetBaseName(Optional ByVal FileName As Variant) As String +''' Returns the BaseName part of the last component of a File- or FolderName, without its extension +''' The method does not check for the existence of the specified file or folder +''' Args: +''' FileName: Path and file name +''' Returns: +''' The BaseName of the given argument in native operating system format. May be empty +''' Example: +''' Dim a As String +''' FSO.FileNaming = "SYS" +''' a = FSO.GetBaseName("C:\Windows\Notepad.exe") returns Notepad + +Dim sBase As String ' Return value +Dim sExt As String ' Extension +Dim sName As String ' Last component of FileName +Dim vName As Variant ' Array of trunks of sName +Const cstThisSub = "FileSystem.GetBaseName" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sBase = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + +Try: + sName = SF_FileSystem.GetName(FileName) + If Len(sName) > 0 Then + If InStr(sName, ".") > 0 Then + vName = Split(sName, ".") + sExt = vName(UBound(vName)) + sBase = Left(sName, Len(sName) - Len(sExt) - 1) + Else + sBase = sName + End If + End If + +Finally: + GetBaseName = sBase + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetBaseName + +REM ----------------------------------------------------------------------------- +Public Function GetExtension(Optional ByVal FileName As Variant) As String +''' Returns the extension part of a File- or FolderName, without the dot (.). +''' The method does not check for the existence of the specified file or folder +''' Args: +''' FileName: Path and file name +''' Returns: +''' The extension without a leading dot. May be empty +''' Example: +''' Dim a As String +''' FSO.FileNaming = "SYS" +''' a = FSO.GetExtension("C:\Windows\Notepad.exe") returns exe + +Dim sExt As String ' Return value +Dim sName As String ' Last component of FileName +Dim vName As Variant ' Array of trunks of sName +Const cstThisSub = "FileSystem.GetExtension" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sExt = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + +Try: + sName = SF_FileSystem.GetName(FileName) + If Len(sName) > 0 And InStr(sName, ".") > 0 Then + vName = Split(sName, ".") + sExt = vName(UBound(vName)) + End If + +Finally: + GetExtension = sExt + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetExtension + +REM ----------------------------------------------------------------------------- +Public Function GetFileLen(Optional ByVal FileName As Variant) As Currency +''' Return file size in bytes with four decimals ''' +''' Args: +''' FileName: a string representing a file +''' Returns: +''' File size if FileName exists +''' Exceptions: +''' UNKNOWNFILEERROR The file does not exist of is a folder +''' Example: +''' Print SF_FileSystem.GetFileLen("C:\pagefile.sys") + +Dim curSize As Currency ' Return value +Const cstPyHelper = "$" & "_SF_FileSystem__GetFilelen" +Const cstThisSub = "FileSystem.GetFileLen" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + curSize = 0 + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + +Try: + If SF_FileSystem.FileExists(FileName) Then + With ScriptForge.SF_Session + curSize = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _ + , _ConvertFromUrl(FileName)) + End With + Else + GoTo CatchNotExists + End If + +Finally: + GetFileLen = curSize + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetFileLen + +REM ----------------------------------------------------------------------------- +Public Function GetFileModified(Optional ByVal FileName As Variant) As Variant +''' Returns the last modified date for the given file +''' Args: +''' FileName: a string representing an existing file +''' Returns: +''' The modification date and time as a Basic Date +''' Exceptions: +''' UNKNOWNFILEERROR The file does not exist of is a folder +''' Example: +''' Dim a As Date +''' FSO.FileNaming = "SYS" +''' a = FSO.GetFileModified("C:\Temp\myDoc.odt") + +Dim dModified As Date ' Return value +Dim oModified As New com.sun.star.util.DateTime +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess + +Const cstThisSub = "FileSystem.GetFileModified" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dModified = 0 + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + +Try: + Set oSfa = SF_Utils._GetUnoService("FileAccess") + If SF_FileSystem.FileExists(FileName) Then + FileName = SF_FileSystem._ConvertToUrl(FileName) + Set oModified = oSfa.getDateTimeModified(FileName) + dModified = CDateFromUnoDateTime(oModified) + Else + GoTo CatchNotExists + End If + +Finally: + GetFileModified = dModified + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetFileModified + +REM ----------------------------------------------------------------------------- +Public Function GetName(Optional ByVal FileName As Variant) As String +''' Returns the last component of a File- or FolderName +''' The method does not check for the existence of the specified file or folder +''' Args: +''' FileName: Path and file name +''' Returns: +''' The last component of the full file name in native operating system format +''' Example: +''' Dim a As String +''' FSO.FileNaming = "SYS" +''' a = FSO.GetName("C:\Windows\Notepad.exe") returns Notepad.exe + +Dim sName As String ' Return value +Dim vFile As Variant ' Array of components +Const cstThisSub = "FileSystem.GetName" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sName = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + FileName = SF_FileSystem._ConvertToUrl(FileName) + +Try: + If Len(FileName) > 0 Then + If Right(FileName, 1) = "/" Then FileName = Left(FileName, Len(FileName) - 1) + vFile = Split(FileName, "/") + sName = ConvertFromUrl(vFile(UBound(vFile))) ' Always in SYS format + End If + +Finally: + GetName = sName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetName + +REM ----------------------------------------------------------------------------- +Public Function GetParentFolderName(Optional ByVal FileName As Variant) As String +''' Returns a string containing the name of the parent folder of the last component in a specified File- or FolderName +''' The method does not check for the existence of the specified file or folder +''' Args: +''' FileName: Path and file name +''' Returns: +''' A FolderName including its final path separator +''' Example: +''' Dim a As String +''' FSO.FileNaming = "SYS" +''' a = FSO.GetParentFolderName("C:\Windows\Notepad.exe") returns C:\Windows\ + +Dim sFolder As String ' Return value +Dim sName As String ' Last component of FileName +Dim vFile As Variant ' Array of file components +Const cstThisSub = "FileSystem.GetParentFolderName" +Const cstSubArgs = "FileName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFolder = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + End If + FileName = SF_FileSystem._ConvertToUrl(FileName) + +Try: + If Right(FileName, 1) = "/" Then FileName = Left(FileName, Len(FileName) - 1) + vFile = Split(FileName, "/") + If UBound(vFile) >= 0 Then vFile(UBound(vFile)) = "" + sFolder = Join(vFile, "/") + If sFolder = "" Or Right(sFolder, 1) <> "/" Then sFolder = sFolder & "/" + +Finally: + GetParentFolderName = SF_FileSystem._ConvertFromUrl(sFolder) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetParentFolderName + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "FileSystem.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case UCase("ConfigFolder") : GetProperty = ConfigFolder + Case UCase("ExtensionsFolder") : GetProperty = ExtensionsFolder + Case UCase("FileNaming") : GetProperty = FileNaming + Case UCase("HomeFolder") : GetProperty = HomeFolder + Case UCase("InstallFolder") : GetProperty = InstallFolder + Case UCase("TemplatesFolder") : GetProperty = TemplatesFolder + Case UCase("TemporaryFolder") : GetProperty = TemporaryFolder + Case UCase("UserTemplatesFolder") : GetProperty = UserTemplatesFolder + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function GetTempName() As String +''' Returns a randomly generated temporary file name that is useful for performing +''' operations that require a temporary file : the method does not create any file +''' Args: +''' Returns: +''' A FileName as a String that can be used f.i. with CreateTextFile() +''' The FileName does not have any suffix +''' Example: +''' Dim a As String +''' FSO.FileNaming = "SYS" +''' a = FSO.GetTempName() & ".txt" + +Dim sFile As String ' Return value +Dim sTempDir As String ' The path to a temporary folder +Dim lRandom As Long ' Random integer + +Const cstThisSub = "FileSystem.GetTempName" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFile = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + lRandom = SF_Session.ExecuteCalcFunction("RANDBETWEEN", 1, 999999) + sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6) + +Finally: + GetTempName = SF_FileSystem._ConvertFromUrl(sFile) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.GetTempName + +REM ----------------------------------------------------------------------------- +Public Function HashFile(Optional ByVal FileName As Variant _ + , Optional ByVal Algorithm As Variant _ + ) As String +''' Return an hexadecimal string representing a checksum of the given file +''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512 +''' Args: +''' FileName: a string representing a file +''' Algorithm: The hashing algorithm to use +''' Returns: +''' The requested checksum as a string. Hexadecimal digits are lower-cased +''' A zero-length string when an error occurred +''' Exceptions: +''' UNKNOWNFILEERROR The file does not exist of is a folder +''' Example: +''' Print SF_FileSystem.HashFile("C:\pagefile.sys", "MD5") + +Dim sHash As String ' Return value +Const cstPyHelper = "$" & "_SF_FileSystem__HashFile" +Const cstThisSub = "FileSystem.HashFile" +Const cstSubArgs = "FileName, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512""" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sHash = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Algorithm, "Algorithm", V_STRING _ + , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally + End If + +Try: + If SF_FileSystem.FileExists(FileName) Then + With ScriptForge.SF_Session + sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _ + , _ConvertFromUrl(FileName), LCase(Algorithm)) + End With + Else + GoTo CatchNotExists + End If + +Finally: + HashFile = sHash + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.HashFile + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list or methods of the FileSystem service as an array + + Methods = Array("BuildPath" _ + , "CompareFiles" _ + , "CopyFile" _ + , "CopyFolder" _ + , "CreateFolder" _ + , "CreateTextFile" _ + , "DeleteFile" _ + , "DeleteFolder" _ + , "ExtensionFolder" _ + , "FileExists" _ + , "Files" _ + , "FolderExists" _ + , "GetBaseName" _ + , "GetExtension" _ + , "GetFileLen" _ + , "GetFileModified" _ + , "GetName" _ + , "GetParentFolderName" _ + , "GetTempName" _ + , "HashFile" _ + , "MoveFile" _ + , "MoveFolder" _ + , "OpenTextFile" _ + , "PickFile" _ + , "PickFolder" _ + , "SubFolders" _ + ) + +End Function ' ScriptForge.SF_FileSystem.Methods + +REM ----------------------------------------------------------------------------- +Public Function MoveFile(Optional ByVal Source As Variant _ + , Optional ByVal Destination As Variant _ + ) As Boolean +''' Moves one or more files from one location to another +''' Args: +''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved +''' Destination: FileName where the single Source file is to be moved +''' If Source and Destination have the same parent folder MoveFile amounts to renaming the Source +''' or FolderName where the multiple files from Source are to be moved +''' If FolderName does not exist, it is created +''' Anyway, wildcard characters are not allowed in Destination +''' Returns: +''' True if at least one file has been moved +''' False if an error occurred +''' An error also occurs if a source using wildcard characters doesn't match any files. +''' The method stops on the first error it encounters +''' No attempt is made to roll back or undo any changes made before an error occurs +''' Exceptions: +''' UNKNOWNFILEERROR Source does not exist +''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist +''' NOFILEMATCHERROR No file matches Source containing wildcards +''' NOTAFOLDERERROR Destination is a file, not a folder +''' NOTAFILEERROR Destination is a folder, not a file +''' OVERWRITEERROR Destination can not be overwritten +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\") ' Only files are moved, subfolders are not + +Dim bMove As Boolean ' Return value + +Const cstThisSub = "FileSystem.MoveFile" +Const cstSubArgs = "Source, Destination" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bMove = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally + If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally + End If + +Try: + bMove = SF_FileSystem._CopyMove("MoveFile", Source, Destination, False) + +Finally: + MoveFile = bMove + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.MoveFile + +REM ----------------------------------------------------------------------------- +Public Function MoveFolder(Optional ByVal Source As Variant _ + , Optional ByVal Destination As Variant _ + ) As Boolean +''' Moves one or more folders from one location to another +''' Args: +''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved +''' Destination: FolderName where the single Source folder is to be moved +''' FolderName must not exist +''' or FolderName where the multiple folders from Source are to be moved +''' If FolderName does not exist, it is created +''' Anyway, wildcard characters are not allowed in Destination +''' Returns: +''' True if at least one folder has been moved +''' False if an error occurred +''' An error also occurs if a source using wildcard characters doesn't match any folders. +''' The method stops on the first error it encounters +''' No attempt is made to roll back or undo any changes made before an error occurs +''' Exceptions: +''' UNKNOWNFILEERROR Source does not exist +''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist +''' NOFILEMATCHERROR No file matches Source containing wildcards +''' NOTAFOLDERERROR Destination is a file, not a folder +''' OVERWRITEERROR Destination can not be overwritten +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.MoveFolder("C:\Temp1\*", "C:\Temp2\") + +Dim bMove As Boolean ' Return value + +Const cstThisSub = "FileSystem.MoveFolder" +Const cstSubArgs = "Source, Destination" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bMove = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally + If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally + End If + +Try: + bMove = SF_FileSystem._CopyMove("MoveFolder", Source, Destination, False) + +Finally: + MoveFolder = bMove + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.MoveFolder + +REM ----------------------------------------------------------------------------- +Public Function OpenTextFile(Optional ByVal FileName As Variant _ + , Optional ByVal IOMode As Variant _ + , Optional ByVal Create As Variant _ + , Optional ByVal Encoding As Variant _ + ) As Object +''' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file +''' Args: +''' FileName: Identifies the file to open +''' IOMode: Indicates input/output mode. Can be one of three constants: ForReading, ForWriting, or ForAppending +''' Create: Boolean value that indicates whether a new file can be created if the specified filename doesn't exist. +''' The value is True if a new file and its parent folders may be created; False if they aren't created (default) +''' Encoding: The character set that should be used +''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Note that LibreOffice does not implement all existing sets +''' Default = UTF-8 +''' Returns: +''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred +''' The method does not check if the file is really a text file +''' It doesn't check either if the given encoding is implemented in LibreOffice nor if it is the right one +''' Exceptions: +''' UNKNOWNFILEERROR File does not exist +''' Example: +''' Dim myFile As Object +''' FSO.FileNaming = "SYS" +''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading) +''' If Not IsNull(myFile) Then ' ... Go ahead with reading text lines + +Dim oTextStream As Object ' Return value +Dim bExists As Boolean ' File to open does exist +Const cstThisSub = "FileSystem.OpenTextFile" +Const cstSubArgs = "FileName, [IOMode=1], [Create=False], [Encoding=""UTF-8""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oTextStream = Nothing + +Check: + With SF_FileSystem + If IsMissing(IOMode) Or IsEmpty(IOMode) Then IOMode = ForReading + If IsMissing(Create) Or IsEmpty(Create) Then Create = False + If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(IOMode, "IOMode", V_NUMERIC _ + , Array(ForReading, ForWriting, ForAppending)) _ + Then GoTo Finally + If Not SF_Utils._Validate(Create, "Create", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally + End If + + bExists = .FileExists(FileName) + Select Case IOMode + Case ForReading : If Not bExists Then GoTo CatchNotExists + Case Else : If Not bExists And Not Create Then GoTo CatchNotExists + End Select + + If IOMode = ForAppending And Not bExists Then IOMode = ForWriting + End With + +Try: + ' Create and initialize TextStream class instance + Set oTextStream = New SF_TextStream + With oTextStream + .[Me] = oTextStream + .[_Parent] = SF_FileSystem + ._FileName = SF_FileSystem._ConvertToUrl(FileName) + ._IOMode = IOMode + ._Encoding = Encoding + ._FileExists = bExists + ._Initialize() + End With + +Finally: + Set OpenTextFile = oTextStream + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.OpenTextFile + +REM ----------------------------------------------------------------------------- +Public Function PickFile(Optional ByVal DefaultFile As Variant _ + , Optional ByVal Mode As Variant _ + , Optional ByVal Filter As Variant _ + ) As String +''' Returns the file selected with a FilePicker dialog box +''' The mode, OPEN or SAVE, and the filter may be preset +''' If mode = SAVE and the picked file exists, a warning message will be displayed +''' Modified from Andrew Pitonyak's Base Macro Programming §10.4 +''' Args: +''' DefaultFile: Folder part: the FolderName from which to start. Default = the last selected folder +''' File part: the default file to open or save +''' Mode: "OPEN" (input file) or "SAVE" (output file) +''' Filter: by default only files having the given suffix will be displayed. Default = all suffixes +''' The filter combo box will contain the given SuffixFilter (if not "*") and "*.*" +''' Returns: +''' The selected FileName in URL format or "" if the dialog was cancelled +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.PickFile("C:\", "OPEN", "txt") ' Only *.txt files are displayed + +Dim oFileDialog As Object ' com.sun.star.ui.dialogs.FilePicker +Dim oFileAccess As object ' com.sun.star.ucb.SimpleFileAccess +Dim oPath As Object ' com.sun.star.util.PathSettings +Dim iAccept As Integer ' Result of dialog execution +Dim sInitPath As String ' Current working directory +Dim sBaseFile As String +Dim iMode As Integer ' Numeric alias for SelectMode +Dim sFile As String ' Return value + +Const cstThisSub = "FileSystem.PickFile" +Const cstSubArgs = "[DefaultFile=""""], [Mode=""OPEN""|""SAVE""],[Filter=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFile = "" + +Check: + If IsMissing(DefaultFile) Or IsEmpty(DefaultFile) Then DefaultFile = "" + If IsMissing(Mode) Or IsEmpty(Mode) Then Mode = "OPEN" + If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(DefaultFile, "DefaultFile", , True) Then GoTo Finally + If Not SF_Utils._Validate(Mode, "Mode", V_STRING, Array("OPEN", "SAVE")) Then GoTo Finally + If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally + End If + DefaultFile = SF_FileSystem._ConvertToUrl(DefaultFile) + +Try: + ' Derive numeric equivalent of the Mode argument: https://api.libreoffice.org/docs/idl/ref/TemplateDescription_8idl.html + With com.sun.star.ui.dialogs.TemplateDescription + If Mode = "OPEN" Then iMode = .FILEOPEN_SIMPLE Else iMode = .FILESAVE_AUTOEXTENSION + End With + + ' Activate the filepicker dialog + Set oFileDialog = SF_Utils._GetUNOService("FilePicker") + With oFileDialog + .Initialize(Array(iMode)) + + ' Set filters + If Len(Filter) > 0 Then .appendFilter("*." & Filter, "*." & Filter) ' Twice: required by API + .appendFilter("*.*", "*.*") + If Len(Filter) > 0 Then .setCurrentFilter("*." & Filter) Else .setCurrentFilter("*.*") + + ' Set initial folder + If Len(DefaultFile) = 0 Then ' TODO: SF_Session.WorkingFolder + Set oPath = SF_Utils._GetUNOService("PathSettings") + sInitPath = oPath.Work ' Probably My Documents + Else + sInitPath = SF_FileSystem._ParseUrl(ConvertToUrl(DefaultFile)).Path + End If + + ' Set default values + Set oFileAccess = SF_Utils._GetUNOService("FileAccess") + If oFileAccess.exists(sInitPath) Then .SetDisplayDirectory(sInitPath) + sBaseFile = SF_FileSystem.GetName(DefaultFile) + .setDefaultName(sBaseFile) + + ' Get selected file + iAccept = .Execute() + If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then sFile = .getSelectedFiles()(0) + End With + +Finally: + PickFile = SF_FileSystem._ConvertFromUrl(sFile) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.PickFile + +REM ----------------------------------------------------------------------------- +Public Function PickFolder(Optional ByVal DefaultFolder As Variant _ + , Optional ByVal FreeText As Variant _ + ) As String +''' Display a FolderPicker dialog box +''' Args: +''' DefaultFolder: the FolderName from which to start. Default = the last selected folder +''' FreeText: text to display in the dialog. Default = "" +''' Returns: +''' The selected FolderName in URL or operating system format +''' The zero-length string if the dialog was cancelled +''' Example: +''' FSO.FileNaming = "SYS" +''' FSO.PickFolder("C:\", "Choose a folder or press Cancel") + +Dim oFolderDialog As Object ' com.sun.star.ui.dialogs.FolderPicker +Dim iAccept As Integer ' Value returned by the dialog (OK, Cancel, ..) +Dim sFolder As String ' Return value ' + +Const cstThisSub = "FileSystem.PickFolder" +Const cstSubArgs = "[DefaultFolder=""""], [FreeText=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFolder = "" + +Check: + If IsMissing(DefaultFolder) Or IsEmpty(DefaultFolder) Then DefaultFolder = "" + If IsMissing(FreeText) Or IsEmpty(FreeText) Then FreeText = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(DefaultFolder, "DefaultFolder", , True) Then GoTo Finally + If Not SF_Utils._Validate(FreeText, "FreeText", V_STRING) Then GoTo Finally + End If + DefaultFolder = SF_FileSystem._ConvertToUrl(DefaultFolder) + +Try: + Set oFolderDialog = SF_Utils._GetUNOService("FolderPicker") + If Not IsNull(oFolderDialog) Then + With oFolderDialog + If Len(DefaultFolder) > 0 Then .DisplayDirectory = ConvertToUrl(DefaultFolder) + .Description = FreeText + iAccept = .Execute() + ' https://api.libreoffice.org/docs/idl/ref/ExecutableDialogResults_8idl.html + If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then + .DisplayDirectory = .Directory ' Set the next default initial folder to the selected one + sFolder = .Directory & "/" + End If + End With + End If + +Finally: + PickFolder = SF_FileSystem._ConvertFromUrl(sFolder) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.PickFolder + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the FileSystem module as an array + + Properties = Array( _ + "ConfigFolder" _ + , "ExtensionsFolder" _ + , "FileNaming" _ + , "HomeFolder" _ + , "InstallFolder" _ + , "TemplatesFolder" _ + , "TemporaryFolder" _ + , "UserTemplatesFolder" _ + ) + +End Function ' ScriptForge.SF_FileSystem.Properties + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "FileSystem.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case UCase("FileNaming") : FileNaming = Value + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function SubFolders(Optional ByVal FolderName As Variant _ + , Optional ByVal Filter As Variant _ + ) As Variant +''' Return an array of the FolderNames stored in the given folder. The folder must exist +''' Args: +''' FolderName: the folder to explore +''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "") +''' Returns: +''' An array of strings, each entry is the FolderName of an existing folder +''' Exceptions: +''' UNKNOWNFOLDERERROR Folder does not exist +''' NOTAFOLDERERROR FolderName is a file, not a folder +''' Example: +''' Dim a As Variant +''' FSO.FileNaming = "SYS" +''' a = FSO.SubFolders("C:\Windows\") + +Dim vSubFolders As Variant ' Return value +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim sFolderName As String ' URL lias for FolderName +Dim sFolder As String ' Single folder +Dim i As Long + +Const cstThisSub = "FileSystem.SubFolders" +Const cstSubArgs = "FolderName, [Filter=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSubFolders = Array() + +Check: + If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally + If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally + End If + sFolderName = SF_FileSystem._ConvertToUrl(FolderName) + If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file + If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist + +Try: + ' Get SubFolders + Set oSfa = SF_Utils._GetUnoService("FileAccess") + vSubFolders = oSfa.getFolderContents(sFolderName, True) + ' List includes files; remove them or adjust notations of folders + For i = 0 To UBound(vSubFolders) + sFolder = SF_FileSystem._ConvertFromUrl(vSubFolders(i) & "/") + If SF_FileSystem.FileExists(sFolder) Then vSubFolders(i) = "" Else vSubFolders(i) = sFolder + ' Reduce list to those passing the filter + If Len(Filter) > 0 And Len(vSubFolders(i)) > 0 Then + sFolder = SF_FileSystem.GetName(vSubFolders(i)) + If Not SF_String.IsLike(sFolder, Filter) Then vSubFolders(i) = "" + End If + Next i + vSubFolders = SF_Array.TrimArray(vSubFolders) + +Finally: + SubFolders = vSubFolders + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchFile: + SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", FolderName) + GoTo Finally +CatchFolder: + SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", FolderName) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem.SubFolders + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _ConvertFromUrl(psFile) As String +''' Execute the builtin ConvertFromUrl function only when relevant +''' i.e. when FileNaming (how arguments and return values are provided) = "SYS" +''' Called at the bottom of methods returning file names +''' Remark: psFile might contain wildcards + +Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards + + If SF_FileSystem.FileNaming = "SYS" Then + _ConvertFromUrl = Replace(Replace( _ + ConvertFromUrl(Replace(Replace(psFile, "?", cstQuestion), "*", cstStar)) _ + , cstQuestion, "?"), cstStar, "*") + Else + _ConvertFromUrl = psFile + End If + +End Function ' ScriptForge.FileSystem._ConvertFromUrl + +REM ----------------------------------------------------------------------------- +Private Function _ConvertToUrl(psFile) As String +''' Execute the builtin ConvertToUrl function only when relevant +''' i.e. when FileNaming (how arguments and return values are provided) = "SYS" +''' Called at the top of methods receiving file names as arguments +''' Remark: psFile might contain wildcards + + If SF_FileSystem.FileNaming = "URL" Then + _ConvertToUrl = psFile + Else + ' ConvertToUrl encodes "?" + _ConvertToUrl = Replace(ConvertToUrl(psFile), "%3F", "?") + End If + +End Function ' ScriptForge.FileSystem._ConvertToUrl + +REM ----------------------------------------------------------------------------- +Private Function _CopyMove(psMethod As String _ + , psSource As String _ + , psDestination As String _ + , pbOverWrite As Boolean _ + ) As Boolean +''' Checks the arguments and executes the given method +''' Args: +''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder +''' psSource: Either File/FolderName +''' or NamePattern which can include wildcard characters, for one or more files/folders to be copied +''' psDestination: FileName or FolderName for copy/move of a single file/folder +''' Otherwise a destination FolderName. If it does not exist, it is created +''' pbOverWrite: If True, files/folders may be overwritten +''' Must be False for Move operations +''' Next checks are done: +''' With wildcards (multiple files/folders): +''' - Parent folder of source must exist +''' - Destination must not be a file +''' - Parent folder of Destination must exist +''' - If the Destination folder does not exist a new folder is created, +''' - At least one file matches the wildcards expression +''' - Destination files/folder must not exist if pbOverWrite = False +''' - Destination files/folders must not have the read-only attribute set +''' - Destination files must not be folders, destination folders must not be files +''' Without wildcards (single file/folder): +''' - Source file/folder must exist and be a file/folder +''' - Parent folder of Destination must exist +''' - Destination must not be an existing folder/file +''' - Destination file/folder must not exist if pbOverWrite = False +''' - Destination file must not have the read-only attribute set + +Dim bCopyMove As Boolean ' Return value +Dim bCopy As Boolean ' True if Copy, False if Move +Dim bFile As Boolean ' True if File, False if Folder +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim bWildCards As Boolean ' True if wildcards found in Source +Dim bCreateFolder As Boolean ' True when the destination folder should be created +Dim bDestExists As Boolean ' True if destination exists +Dim sSourceUrl As String ' Alias for Source +Dim sDestinationUrl As String ' Alias for Destination +Dim sDestinationFile As String ' Destination FileName +Dim sParentFolder As String ' Parent folder of Source +Dim vFiles As Variant ' Array of candidates for copy/move +Dim sFile As String ' Single file/folder +Dim sName As String ' Name (last component) of file +Dim i As Long + + ' Error handling left to calling routine + bCopyMove = False + bCopy = ( Left(psMethod, 4) = "Copy" ) + bFile = ( Right(psMethod, 4) = "File" ) + bWildCards = ( InStr(psSource, "*") + InStr(psSource, "?") + InStr(psSource, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F" + bDestExists = False + + With SF_FileSystem + +Check: + If bWildCards Then + sParentFolder = .GetParentFolderName(psSource) + If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch + If .FileExists(psDestination) Then GoTo CatchFileNotFolder + If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists + bCreateFolder = Not .FolderExists(psDestination) + Else + Select Case bFile + Case True ' File + If Not .FileExists(psSource) Then GoTo CatchFileNotExists + If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchSourceFolderNotExists + If .FolderExists(psDestination) Then GoTo CatchFolderNotFile + bDestExists = .FileExists(psDestination) + If pbOverWrite = False And bDestExists = True Then GoTo CatchDestinationExists + bCreateFolder = False + Case False ' Folder + If Not .FolderExists(psSource) Then GoTo CatchSourceFolderNotExists + If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists + If .FileExists(psDestination) Then GoTo CatchFileNotFolder + bDestExists = .FolderExists(psDestination) + If pbOverWrite = False And bDestExists Then GoTo CatchDestinationExists + bCreateFolder = Not bDestExists + End Select + End If + +Try: + Set oSfa = SF_Utils._GetUnoService("FileAccess") + If bWildCards Then + If bFile Then vFiles = .Files(sParentFolder, .GetName(psSource)) Else vFiles = .SubFolders(sParentFolder, .GetName(psSource)) + If UBound(vFiles) < 0 Then GoTo CatchNoMatch + ' Go through the candidates + If bCreateFolder Then .CreateFolder(psDestination) + For i = 0 To UBound(vFiles) + sFile = vFiles(i) + sDestinationFile = .BuildPath(psDestination, .GetName(sFile)) + If bFile Then bDestExists = .FileExists(sDestinationFile) Else bDestExists = .FolderExists(sDestinationFile) + If pbOverWrite = False Then + If bDestExists Then GoTo CatchDestinationExists + If .FolderExists(sDestinationFile) Then GoTo CatchDestinationExists + End If + sSourceUrl = ._ConvertToUrl(sFile) + sDestinationUrl = ._ConvertToUrl(sDestinationFile) + If bDestExists Then + If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly + End If + Select Case bCopy + Case True : oSfa.copy(sSourceUrl, sDestinationUrl) + Case False : oSfa.move(sSourceUrl, sDestinationUrl) + End Select + Next i + Else + sSourceUrl = ._ConvertToUrl(psSource) + sDestinationUrl = ._ConvertToUrl(psDestination) + If bDestExists Then + If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly + End If + If bCreateFolder Then .CreateFolder(psDestination) + Select Case bCopy + Case True : oSfa.copy(sSourceUrl, sDestinationUrl) + Case False : oSfa.move(sSourceUrl, sDestinationUrl) + End Select + End If + + End With + + bCopyMove = True + +Finally: + _CopyMove = bCopyMove + Exit Function +CatchFileNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "Source", psSource) + GoTo Finally +CatchSourceFolderNotExists: + SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "Source", psSource) + GoTo Finally +CatchDestFolderNotExists: + SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "Destination", psDestination) + GoTo Finally +CatchFolderNotFile: + SF_Exception.RaiseFatal(NOTAFILEERROR, "Destination", psDestination) + GoTo Finally +CatchDestinationExists: + SF_Exception.RaiseFatal(OVERWRITEERROR, "Destination", psDestination) + GoTo Finally +CatchNoMatch: + SF_Exception.RaiseFatal(NOFILEMATCHERROR, "Source", psSource) + GoTo Finally +CatchFileNotFolder: + SF_Exception.RaiseFatal(NOTAFOLDERERROR, "Destination", psDestination) + GoTo Finally +CatchDestinationReadOnly: + SF_Exception.RaiseFatal(READONLYERROR, "Destination", Iif(bWildCards, sDestinationFile, psDestination)) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem._CopyMove + +REM ----------------------------------------------------------------------------- +Public Function _CountTextLines(ByVal psFileName As String _ + , Optional ByVal pbIncludeBlanks As Boolean _ + ) As Long +''' Convenient function to count the number of lines in a textfile +''' Args: +''' psFileName: the file in FileNaming notation +''' pbIncludeBlanks: if True (default), zero-length lines are included +''' Returns: +''' The number of lines, f.i. to ease array sizing. -1 if file reading error + +Dim lLines As Long ' Return value +Dim oFile As Object ' File handler +Dim sLine As String ' The last line read + +Try: + lLines = 0 + If IsMissing(pbIncludeBlanks) Then pbIncludeBlanks = True + Set oFile = SF_FileSystem.OpenTextFile(psFileName, ForReading) + With oFile + If Not IsNull(oFile) Then + Do While Not .AtEndOfStream + sLine = .ReadLine() + lLines = lLines + Iif(Len(sLine) > 0 Or pbIncludeBlanks, 1, 0) + Loop + End If + .CloseFile() + Set oFile = .Dispose() + End With + +Finally: + _CountTextLines = lLines + Exit Function +End Function ' ScriptForge.SF_FileSystem._CountTextLines + +REM ----------------------------------------------------------------------------- +Private Function _Delete(psMethod As String _ + , psFile As String _ + ) As Boolean +''' Checks the argument and executes the given psMethod +''' Args: +''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder +''' psFile: Either File/FolderName +''' or NamePattern which can include wildcard characters, for one or more files/folders to be deleted +''' Next checks are done: +''' With wildcards (multiple files/folders): +''' - Parent folder of File must exist +''' - At least one file matches the wildcards expression +''' - Files or folders to delete must not have the read-only attribute set +''' Without wildcards (single file/folder): +''' - File/folder must exist and be a file/folder +''' - A file or folder to delete must not have the read-only attribute set + +Dim bDelete As Boolean ' Return value +Dim bFile As Boolean ' True if File, False if Folder +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim bWildCards As Boolean ' True if wildcards found in File +Dim sFileUrl As String ' Alias for File +Dim sParentFolder As String ' Parent folder of File +Dim vFiles As Variant ' Array of candidates for deletion +Dim sFile As String ' Single file/folder +Dim sName As String ' Name (last component) of file +Dim i As Long + + ' Error handling left to calling routine + bDelete = False + bFile = ( Right(psMethod, 4) = "File" ) + bWildCards = ( InStr(psFile, "*") + InStr(psFile, "?") + InStr(psFile, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F" + + With SF_FileSystem + +Check: + If bWildCards Then + sParentFolder = .GetParentFolderName(psFile) + If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch + Else + Select Case bFile + Case True ' File + If .FolderExists(psFile) Then GoTo CatchFolderNotFile + If Not .FileExists(psFile) Then GoTo CatchFileNotExists + Case False ' Folder + If .FileExists(psFile) Then GoTo CatchFileNotFolder + If Not .FolderExists(psFile) Then GoTo CatchFolderNotExists + End Select + End If + +Try: + Set oSfa = SF_Utils._GetUnoService("FileAccess") + If bWildCards Then + If bFile Then vFiles = .Files(sParentFolder) Else vFiles = .SubFolders(sParentFolder) + ' Select candidates + For i = 0 To UBound(vFiles) + If Not SF_String.IsLike(.GetName(vFiles(i)), .GetName(psFile)) Then vFiles(i) = "" + Next i + vFiles = SF_Array.TrimArray(vFiles) + If UBound(vFiles) < 0 Then GoTo CatchNoMatch + ' Go through the candidates + For i = 0 To UBound(vFiles) + sFile = vFiles(i) + sFileUrl = ._ConvertToUrl(sFile) + If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly + oSfa.kill(sFileUrl) + Next i + Else + sFileUrl = ._ConvertToUrl(psFile) + If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly + oSfa.kill(sFileUrl) + End If + + End With + + bDelete = True + +Finally: + _Delete = bDelete + Exit Function +CatchFolderNotExists: + SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", psFile) + GoTo Finally +CatchFileNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", psFile) + GoTo Finally +CatchFolderNotFile: + SF_Exception.RaiseFatal(NOTAFILEERROR, "FileName", psFile) + GoTo Finally +CatchNoMatch: + SF_Exception.RaiseFatal(NOFILEMATCHERROR, Iif(bFile, "FileName", "FolderName"), psFile) + GoTo Finally +CatchFileNotFolder: + SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", psFile) + GoTo Finally +CatchReadOnly: + SF_Exception.RaiseFatal(READONLYERROR, Iif(bFile, "FileName", "FolderName"), Iif(bWildCards, sFile, psFile)) + GoTo Finally +End Function ' ScriptForge.SF_FileSystem._Delete + +REM ----------------------------------------------------------------------------- +Private Function _GetConfigFolder(ByVal psFolder As String) As String +''' Returns one of next configuration folders: see https://api.libreoffice.org/docs/idl/ref/servicecom_1_1sun_1_1star_1_1util_1_1PathSubstitution.html +''' inst => Installation path of LibreOffice +''' prog => Program path of LibreOffice +''' user => The user installation/config directory +''' work => The work directory of the user. Under Windows this would be the "MyDocuments" subdirectory. Under Unix this would be the home-directory +''' home => The home directory of the user. Under Unix this would be the home- directory. +''' Under Windows this would be the CSIDL_PERSONAL directory, for example "Documents and Settings\<username>\Documents" +''' temp => The current temporary directory + +Dim oSubst As Object ' com.sun.star.util.PathSubstitution +Dim sConfig As String ' Return value + + sConfig = "" + Set oSubst = SF_Utils._GetUNOService("PathSubstitution") + If Not IsNull(oSubst) Then sConfig = oSubst.getSubstituteVariableValue("$(" & psFolder & ")") & "/" + + _GetConfigFolder = SF_FileSystem._ConvertFromUrl(sConfig) + +End Function ' ScriptForge.FileSystem._GetConfigFolder + +REM ----------------------------------------------------------------------------- +Public Function _ParseUrl(psUrl As String) As Object +''' Returns a com.sun.star.util.URL structure based on the argument + +Dim oParse As Object ' com.sun.star.util.URLTransformer +Dim bParsed As Boolean ' True if parsing is successful +Dim oUrl As New com.sun.star.util.URL ' Return value + + oUrl.Complete = psUrl + Set oParse = SF_Utils._GetUNOService("URLTransformer") + bParsed = oParse.parseStrict(oUrl, "") + If bParsed Then oUrl.Path = ConvertToUrl(oUrl.Path) + + Set _ParseUrl = oUrl + +End Function ' ScriptForge.SF_FileSystem._ParseUrl + +REM ----------------------------------------------------------------------------- +Public Function _SFInstallFolder() As String +''' Returns the installation folder of the ScriptForge library +''' Either: +''' - The library is present in [My Macros & Dialogs] +''' ($config)/basic/ScriptForge +''' - The library is present in [LibreOffice Macros & Dialogs] +''' ($install)/share/basic/ScriptForge + +Dim sFolder As String ' Folder + + _SFInstallFolder = "" + + sFolder = BuildPath(ConfigFolder, "basic/ScriptForge") + If Not FolderExists(sFolder) Then + sFolder = BuildPath(InstallFolder, "share/basic/ScriptForge") + If Not FolderExists(sFolder) Then Exit Function + End If + + _SFInstallFolder = _ConvertFromUrl(sFolder) + +End Function ' ScriptForge.SF_FileSystem._SFInstallFolder + +REM ============================================ END OF SCRIPTFORGE.SF_FileSystem +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_L10N.xba b/wizards/source/scriptforge/SF_L10N.xba new file mode 100644 index 000000000..6bc6b236f --- /dev/null +++ b/wizards/source/scriptforge/SF_L10N.xba @@ -0,0 +1,825 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_L10N" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule +'Option Private Module + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' L10N (aka SF_L10N) +''' ==== +''' Implementation of a Basic class for providing a number of services +''' related to the translation of user interfaces into a huge number of languages +''' with a minimal impact on the program code itself +''' +''' The design choices of this module are based on so-called PO-files +''' PO-files (portable object files) have long been promoted in the free software industry +''' as a mean of providing multilingual UIs. This is accomplished through the use of human-readable +''' text files with a well defined structure that specifies, for any given language, +''' the source language string and the localized string +''' +''' To read more about the PO format and its ecosystem of associated toolsets: +''' https://www.gnu.org/software/gettext/manual/html_node/PO-Files.html#PO-Files +''' and, IMHO, a very good tutorial: +''' http://pology.nedohodnik.net/doc/user/en_US/ch-about.html +''' +''' The main advantage of the PO format is the complete dissociation between the two +''' very different profiles, i.e. the programmer and the translator(s). +''' Being independent text files, one per language to support, the programmer may give away +''' pristine PO template files (known as POT-files) for a translator to process. +''' +''' This class implements mainly 4 mechanisms: +''' 1. AddText: for the programmer to build a set of words or sentences +''' meant for being translated later +''' 2. AddTextsFromDialog: to automatically execute AddText() on each fixed text of a dialog +''' 3. ExportToPOTFile: All the above texts are exported into a pristine POT-file +''' 4. GetText: At runtime get the text in the user language +''' Note that the first two are optional: POT and PO-files may be built with a simple text editor +''' +''' Several instances of the L10N class may coexist +' The constraint however is that each instance should find its PO-files +''' in a separate directory +''' PO-files must be named with the targeted locale: f.i. "en-US.po" or "fr-BE.po" +''' +''' Service invocation syntax +''' CreateScriptService("L10N"[, FolderName[, Locale]]) +''' FolderName: the folder containing the PO-files (in SF_FileSystem.FileNaming notation) +''' Locale: in the form la-CO (language-COUNTRY) +''' Encoding: The character set that should be used (default = UTF-8) +''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US") +''' Encoding2: Encoding of the 2nd Locale file +''' Service invocation examples: +''' Dim myPO As Variant +''' myPO = CreateScriptService("L10N") ' AddText, AddTextsFromDialog and ExportToPOTFile are allowed +''' myPO = CreateScriptService("L10N", "C:\myPOFiles\", "fr-BE") +''' 'All functionalities are available +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_l10n.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM =============================================================== PRIVATE TYPES + +''' The recognized elements of an entry in a PO file are (other elements are ignored) : +''' #. Extracted comments (given by the programmer to the translator) +''' #, flag (the kde-format flag when the string contains tokens) +''' msgctxt Context (to store an acronym associated with the message, this is a distortion of the norm) +''' msgid untranslated-string +''' msgstr translated-string +''' NB: plural forms are not supported + +Type POEntry + Comment As String + Flag As String + Context As String + MsgId As String + MsgStr As String +End Type + +REM ================================================================== EXCEPTIONS + +Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be "L10N" +Private ServiceName As String +Private _POFolder As String ' PO files container +Private _Locale As String ' la-CO +Private _POFile As String ' PO file in URL format +Private _Encoding As String ' Used to open the PO file, default = UTF-8 +Private _Dictionary As Object ' SF_Dictionary + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "L10N" + ServiceName = "ScriptForge.L10N" + _POFolder = "" + _Locale = "" + _POFile = "" + Set _Dictionary = Nothing +End Sub ' ScriptForge.SF_L10N Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + + If Not IsNull(_Dictionary) Then Set _Dictionary = _Dictionary.Dispose() + Call Class_Initialize() +End Sub ' ScriptForge.SF_L10N Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' ScriptForge.SF_L10N Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Folder() As String +''' Returns the FolderName containing the PO-files expressed as given by the current FileNaming +''' property of the SF_FileSystem service. Default = URL format +''' May be empty +''' Example: +''' myPO.Folder + + Folder = _PropertyGet("Folder") + +End Property ' ScriptForge.SF_L10N.Folder + +REM ----------------------------------------------------------------------------- +Property Get Languages() As Variant +''' Returns a zero-based array listing all the BaseNames of the PO-files found in Folder, +''' Example: +''' myPO.Languages + + Languages = _PropertyGet("Languages") + +End Property ' ScriptForge.SF_L10N.Languages + +REM ----------------------------------------------------------------------------- +Property Get Locale() As String +''' Returns the currently active language-COUNTRY combination. May be empty +''' Example: +''' myPO.Locale + + Locale = _PropertyGet("Locale") + +End Property ' ScriptForge.SF_L10N.Locale + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function AddText(Optional ByVal Context As Variant _ + , Optional ByVal MsgId As Variant _ + , Optional ByVal Comment As Variant _ + , Optional ByVal MsgStr As Variant _ + ) As Boolean +''' Add a new entry in the list of localizable text strings +''' Args: +''' Context: when not empty, the key to retrieve the translated string via GetText. Default = "" +''' MsgId: the untranslated string, i.e. the text appearing in the program code. Must not be empty +''' The key to retrieve the translated string via GetText when Context is empty +''' May contain placeholders (%1 ... %9) for dynamic arguments to be inserted in the text at run-time +''' If the string spans multiple lines, insert escape sequences (\n) where relevant +''' Comment: the so-called "extracted-comments" intended to inform/help translators +''' If the string spans multiple lines, insert escape sequences (\n) where relevant +''' MsgStr: (internal use only) the translated string +''' If the string spans multiple lines, insert escape sequences (\n) where relevant +''' Returns: +''' True if successful +''' Exceptions: +''' DUPLICATEKEYERROR: such a key exists already +''' Examples: +''' myPO.AddText(, "This is a text to be included in a POT file") + +Dim bAdd As Boolean ' Output buffer +Dim sKey As String ' The key part of the new entry in the dictionary +Dim vItem As POEntry ' The item part of the new entry in the dictionary +Const cstPipe = "|" ' Pipe forbidden in MsgId's +Const cstThisSub = "L10N.AddText" +Const cstSubArgs = "[Context=""""], MsgId, [Comment=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAdd = False + +Check: + If IsMissing(Context) Or IsMissing(Context) Then Context = "" + If IsMissing(Comment) Or IsMissing(Comment) Then Comment = "" + If IsMissing(MsgStr) Or IsMissing(MsgStr) Then MsgStr = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Context, "Context", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(MsgId, "MsgId", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Comment, "Comment", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(MsgStr, "MsgStr", V_STRING) Then GoTo Finally + End If + If Len(MsgId) = 0 Then GoTo Finally + +Try: + If Len(Context) > 0 Then sKey = Context Else sKey = MsgId + If _Dictionary.Exists(sKey) Then GoTo CatchDuplicate + + With vItem + .Comment = Comment + If InStr(MsgId, "%") > 0 Then .Flag = "kde-format" Else .Flag = "" + .Context = Replace(Context, cstPipe, " ") + .MsgId = Replace(MsgId, cstPipe, " ") + .MsgStr = MsgStr + End With + _Dictionary.Add(sKey, vItem) + bAdd = True + +Finally: + AddText = bAdd + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchDuplicate: + SF_Exception.RaiseFatal(DUPLICATEKEYERROR, Iif(Len(Context) > 0, "Context", "MsgId"), sKey) + GoTo Finally +End Function ' ScriptForge.SF_L10N.AddText + +REM ----------------------------------------------------------------------------- +Public Function AddTextsFromDialog(Optional ByRef Dialog As Variant) As Boolean +''' Add all fixed text strings of a dialog to the list of localizable text strings +''' Added texts are: +''' - the title of the dialog +''' - the caption associated with next control types: Button, CheckBox, FixedLine, FixedText, GroupBox and RadioButton +''' - the content of list- and comboboxes +''' - the tip- or helptext displayed when the mouse is hovering the control +''' The current method has method SFDialogs.SF_Dialog.GetTextsFromL10N as counterpart +''' The targeted dialog must not be open when the current method is run +''' Args: +''' Dialog: a SFDialogs.Dialog service instance +''' Returns: +''' True when successful +''' Examples: +''' Dim myDialog As Object +''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "XrayTool", "DlgXray") +''' myPO.AddTextsFromDialog(myDialog) + +Dim bAdd As Boolean ' Return value +Dim vControls As Variant ' Array of control names +Dim sControl As String ' A single control name +Dim oControl As Object ' SFDialogs.DialogControl +Dim sText As String ' The text to insert in the dictionary +Dim sDialogComment As String ' The prefix in the comment to insert in the dictionary for the dialog +Dim sControlComment As String ' The prefix in the comment to insert in the dictionary for a control +Dim vSource As Variant ' RowSource property of dialog control as an array +Dim i As Long + +Const cstThisSub = "L10N.AddTextsFromDialog" +Const cstSubArgs = "Dialog" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAdd = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Dialog, "Dialog", V_OBJECT, , , "DIALOG") Then GoTo Finally + End If + +Try: + With Dialog + ' Store the title of the dialog + sDialogComment = "Dialog => " & ._Container & " : " & ._Library & " : " & ._Name & " : " + stext = .Caption + If Len(sText) > 0 Then + If Not _ReplaceText("", sText, sDialogComment & "Caption") Then GoTo Catch + End If + ' Scan all controls + vControls = .Controls() + For Each sControl In vControls + Set oControl = .Controls(sControl) + sControlComment = sDialogComment & sControl & "." + With oControl + ' Extract fixed texts + sText = .Caption + If Len(sText) > 0 Then + If Not _ReplaceText("", sText, sControlComment & "Caption") Then GoTo Catch + End If + vSource = .RowSource ' List and comboboxes only + If IsArray(vSource) Then + For i = 0 To UBound(vSource) + If Len(vSource(i)) > 0 Then + If Not _ReplaceText("", vSource(i), sControlComment & "RowSource[" & i & "]") Then GoTo Catch + End If + Next i + End If + sText = .TipText + If Len(sText) > 0 Then + If Not _ReplaceText("", sText, sControlComment & "TipText") Then GoTo Catch + End If + End With + Next sControl + End With + + bAdd = True + +Finally: + AddTextsFromDialog = bAdd + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N.AddTextsFromDialog + +REM ----------------------------------------------------------------------------- +Public Function ExportToPOTFile(Optional ByVal FileName As Variant _ + , Optional ByVal Header As Variant _ + , Optional ByVal Encoding As Variant _ + ) As Boolean +''' Export a set of untranslated strings as a POT file +''' The set of strings has been built either by a succession of AddText() methods +''' or by a successful invocation of the L10N service with the FolderName argument +''' The generated file should pass successfully the "msgfmt --check 'the pofile'" GNU command +''' Args: +''' FileName: the complete file name to export to. If it exists, is overwritten without warning +''' Header: Comments that will appear on top of the generated file. Do not include any leading "#" +''' If the string spans multiple lines, insert escape sequences (\n) where relevant +''' A standard header will be added anyway +''' Encoding: The character set that should be used +''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Note that LibreOffice probably does not implement all existing sets +''' Default = UTF-8 +''' Returns: +''' True if successful +''' Examples: +''' myPO.ExportToPOTFile("myFile.pot", Header := "Top comment\nSecond line of top comment") + +Dim bExport As Boolean ' Return value +Dim oFile As Object ' Generated file handler +Dim vLines As Variant ' Wrapped lines +Dim sLine As String ' A single line +Dim vItems As Variant ' Array of dictionary items +Dim vItem As Variant ' POEntry type +Const cstSharp = "# ", cstSharpDot = "#. ", cstFlag = "#, kde-format" +Const cstTabSize = 4 +Const cstWrap = 70 +Const cstThisSub = "L10N.ExportToPOTFile" +Const cstSubArgs = "FileName, [Header=""""], [Encoding=""UTF-8""" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bExport = False + +Check: + If IsMissing(Header) Or IsEmpty(Header) Then Header = "" + If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Header, "Header", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally + End If + +Try: + Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True, Encoding := Encoding) + If Not IsNull(oFile) Then + With oFile + ' Standard header + .WriteLine(cstSharp) + .WriteLine(cstSharp & "This pristine POT file has been generated by LibreOffice/ScriptForge") + .WriteLine(cstSharp & "Full documentation is available on https://help.libreoffice.org/") + ' User header + If Len(Header) > 0 Then + .WriteLine(cstSharp) + vLines = SF_String.Wrap(Header, cstWrap, cstTabSize) + For Each sLine In vLines + .WriteLine(cstSharp & Replace(sLine, SF_String.sfLF, "")) + Next sLine + End If + ' Standard header + .WriteLine(cstSharp) + .WriteLine("msgid """"") + .WriteLine("msgstr """"") + .WriteLine(SF_String.Quote("Project-Id-Version: PACKAGE VERSION\n")) + .WriteLine(SF_String.Quote("Report-Msgid-Bugs-To: " _ + & "https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n")) + .WriteLine(SF_String.Quote("POT-Creation-Date: " & SF_STring.Represent(Now()) & "\n")) + .WriteLine(SF_String.Quote("PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n")) + .WriteLine(SF_String.Quote("Last-Translator: FULL NAME <EMAIL@ADDRESS>\n")) + .WriteLine(SF_String.Quote("Language-Team: LANGUAGE <EMAIL@ADDRESS>\n")) + .WriteLine(SF_String.Quote("Language: en_US\n")) + .WriteLine(SF_String.Quote("MIME-Version: 1.0\n")) + .WriteLine(SF_String.Quote("Content-Type: text/plain; charset=" & Encoding & "\n")) + .WriteLine(SF_String.Quote("Content-Transfer-Encoding: 8bit\n")) + .WriteLine(SF_String.Quote("Plural-Forms: nplurals=2; plural=n > 1;\n")) + .WriteLine(SF_String.Quote("X-Generator: LibreOffice - ScriptForge\n")) + .WriteLine(SF_String.Quote("X-Accelerator-Marker: ~\n")) + ' Individual translatable strings + vItems = _Dictionary.Items() + For Each vItem in vItems + .WriteBlankLines(1) + ' Comments + vLines = Split(vItem.Comment, "\n") + For Each sLine In vLines + .WriteLine(cstSharpDot & SF_String.ExpandTabs(SF_String.Unescape(sLine), cstTabSize)) + Next sLine + ' Flag + If InStr(vItem.MsgId, "%") > 0 Then .WriteLine(cstFlag) + ' Context + If Len(vItem.Context) > 0 Then + .WriteLine("msgctxt " & SF_String.Quote(vItem.Context)) + End If + ' MsgId + vLines = SF_String.Wrap(vItem.MsgId, cstWrap, cstTabSize) + If UBound(vLines) = 0 Then + .WriteLine("msgid " & SF_String.Quote(SF_String.Escape(vLines(0)))) + Else + .WriteLine("msgid """"") + For Each sLine in vLines + .WriteLine(SF_String.Quote(SF_String.Escape(sLine))) + Next sLine + End If + ' MsgStr + .WriteLine("msgstr """"") + Next vItem + .CloseFile() + End With + End If + bExport = True + +Finally: + If Not IsNull(oFile) Then Set oFile = oFile.Dispose() + ExportToPOTFile = bExport + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N.ExportToPOTFile + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions: +''' ARGUMENTERROR The property does not exist +''' Examples: +''' myL10N.GetProperty("MyProperty") + +Const cstThisSub = "L10N.GetProperty" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function GetText(Optional ByVal MsgId As Variant _ + , ParamArray pvArgs As Variant _ + ) As String +''' Get the translated string corresponding with the given argument +''' Args: +''' MsgId: the identifier of the string or the untranslated string +''' Either - the untranslated text (MsgId) +''' - the reference to the untranslated text (Context) +''' - both (Context|MsgId) : the pipe character is essential +''' pvArgs(): a list of arguments present as %1, %2, ... in the (un)translated string) +''' to be substituted in the returned string +''' Any type is admitted but only strings, numbers or dates are relevant +''' Returns: +''' The translated string +''' If not found the MsgId string or the Context string +''' Anyway the substitution is done +''' Examples: +''' myPO.GetText("This is a text to be included in a POT file") +''' ' Ceci est un text à inclure dans un fichier POT + +Dim sText As String ' Output buffer +Dim sContext As String ' Context part of argument +Dim sMsgId As String ' MsgId part of argument +Dim vItem As POEntry ' Entry in the dictionary +Dim vMsgId As Variant ' MsgId split on pipe +Dim sKey As String ' Key of dictionary +Dim sPercent As String ' %1, %2, ... placeholders +Dim i As Long +Const cstPipe = "|" +Const cstThisSub = "L10N.GetText" +Const cstSubArgs = "MsgId, [Arg0, Arg1, ...]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sText = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(MsgId, "MsgId", V_STRING) Then GoTo Finally + End If + If Len(Trim(MsgId)) = 0 Then GoTo Finally + sText = MsgId + +Try: + ' Find and load entry from dictionary + If Left(MsgId, 1) = cstPipe then MsgId = Mid(MsgId, 2) + vMsgId = Split(MsgId, cstPipe) + sKey = vMsgId(0) + If Not _Dictionary.Exists(sKey) Then ' Not found + If UBound(vMsgId) = 0 Then sText = vMsgId(0) Else sText = Mid(MsgId, InStr(MsgId, cstPipe) + 1) + Else + vItem = _Dictionary.Item(sKey) + If Len(vItem.MsgStr) > 0 Then sText = vItem.MsgStr Else sText = vItem.MsgId + End If + + ' Substitute %i placeholders + For i = UBound(pvArgs) To 0 Step -1 ' Go downwards to not have a limit in number of args + sPercent = "%" & (i + 1) + sText = Replace(sText, sPercent, SF_String.Represent(pvArgs(i))) + Next i + +Finally: + GetText = sText + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N.GetText + +REM - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +Public Function _(Optional ByVal MsgId As Variant _ + , ParamArray pvArgs As Variant _ + ) As String +''' Get the translated string corresponding with the given argument +''' Alias of GetText() - See above +''' Examples: +''' myPO._("This is a text to be included in a POT file") +''' ' Ceci est un text à inclure dans un fichier POT + +Dim sText As String ' Output buffer +Dim sPercent As String ' %1, %2, ... placeholders +Dim i As Long +Const cstPipe = "|" +Const cstThisSub = "L10N._" +Const cstSubArgs = "MsgId, [Arg0, Arg1, ...]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sText = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(MsgId, "MsgId", V_STRING) Then GoTo Finally + End If + If Len(Trim(MsgId)) = 0 Then GoTo Finally + +Try: + ' Find and load entry from dictionary + sText = GetText(MsgId) + + ' Substitute %i placeholders - done here, not in GetText(), because # of arguments is undefined + For i = 0 To UBound(pvArgs) + sPercent = "%" & (i + 1) + sText = Replace(sText, sPercent, SF_String.Represent(pvArgs(i))) + Next i + +Finally: + _ = sText + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N._ + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the L10N service as an array + + Methods = Array( _ + "AddText" _ + , "ExportToPOTFile" _ + , "GetText" _ + , "AddTextsFromDialog" _ + , "_" _ + ) + +End Function ' ScriptForge.SF_L10N.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "Folder" _ + , "Languages" _ + , "Locale" _ + ) + +End Function ' ScriptForge.SF_L10N.Properties + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "L10N.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize(ByVal psPOFile As String _ + , ByVal Encoding As String _ + ) +''' Completes initialization of the current instance requested from CreateScriptService() +''' Load the POFile in the dictionary, otherwise leave the dictionary empty +''' Args: +''' psPOFile: the file to load the translated strings from +''' Encoding: The character set that should be used. Default = UTF-8 + +Dim oFile As Object ' PO file handler +Dim sContext As String ' Collected context string +Dim sMsgId As String ' Collected untranslated string +Dim sComment As String ' Collected comment string +Dim sMsgStr As String ' Collected translated string +Dim sLine As String ' Last line read +Dim iContinue As Integer ' 0 = None, 1 = MsgId, 2 = MsgStr +Const cstMsgId = 1, cstMsgStr = 2 + +Try: + ' Initialize dictionary anyway + Set _Dictionary = SF_Services.CreateScriptService("Dictionary") + Set _Dictionary.[_Parent] = [Me] + + ' Load PO file + If Len(psPOFile) > 0 Then + With SF_FileSystem + _POFolder = ._ConvertToUrl(.GetParentFolderName(psPOFile)) + _Locale = .GetBaseName(psPOFile) + _POFile = ._ConvertToUrl(psPOFile) + End With + ' Load PO file + Set oFile = SF_FileSystem.OpenTextFile(psPOFile, IOMode := SF_FileSystem.ForReading, Encoding := Encoding) + If Not IsNull(oFile) Then + With oFile + ' The PO file is presumed valid => syntax check is not very strict + sContext = "" : sMsgId = "" : sComment = "" : sMsgStr = "" + Do While Not .AtEndOfStream + sLine = Trim(.ReadLine()) + ' Trivial examination of line header + Select Case True + Case sLine = "" + If Len(sMsgId) > 0 Then AddText(sContext, sMsgId, sComment, sMsgStr) + sContext = "" : sMsgId = "" : sComment = "" : sMsgStr = "" + iContinue = 0 + Case Left(sLine, 3) = "#. " + sComment = sComment & Iif(Len(sComment) > 0, "\n", "") & Trim(Mid(sLine, 4)) + iContinue = 0 + Case Left(sLine, 8) = "msgctxt " + sContext = SF_String.Unquote(Trim(Mid(sLine, 9))) + iContinue = 0 + Case Left(sLine, 6) = "msgid " + sMsgId = SF_String.Unquote(Trim(Mid(sLine, 7))) + iContinue = cstMsgId + Case Left(sLine, 7) = "msgstr " + sMsgStr = sMsgStr & SF_String.Unquote(Trim(Mid(sLine, 8))) + iContinue = cstMsgStr + Case Left(sLine, 1) = """" + If iContinue = cstMsgId Then + sMsgId = sMsgId & SF_String.Unquote(sLine) + ElseIf iContinue = cstMsgStr Then + sMsgStr = sMsgStr & SF_String.Unquote(sLine) + Else + iContinue = 0 + End If + Case Else ' Skip line + iContinue = 0 + End Select + Loop + ' Be sure to store the last entry + If Len(sMsgId) > 0 Then AddText(sContext, sMsgId, sComment, sMsgStr) + .CloseFile() + Set oFile = .Dispose() + End With + End If + Else + _POFolder = "" + _Locale = "" + _POFile = "" + End If + +Finally: + Exit Sub +End Sub ' ScriptForge.SF_L10N._Initialize + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim vFiles As Variant ' Array of PO-files +Dim i As Long +Dim cstThisSub As String +Dim cstSubArgs As String + + cstThisSub = "SF_L10N.get" & psProperty + cstSubArgs = "" + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + + With SF_FileSystem + Select Case psProperty + Case "Folder" + If Len(_POFolder) > 0 Then _PropertyGet = ._ConvertFromUrl(_POFolder) Else _PropertyGet = "" + Case "Languages" + If Len(_POFolder) > 0 Then + vFiles = .Files(._ConvertFromUrl(_POFolder), "*.po") + For i = 0 To UBound(vFiles) + vFiles(i) = SF_FileSystem.GetBaseName(vFiles(i)) + Next i + Else + vFiles = Array() + End If + _PropertyGet = vFiles + Case "Locale" + _PropertyGet = _Locale + Case Else + _PropertyGet = Null + End Select + End With + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_L10N._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _ReplaceText(ByVal psContext As String _ + , ByVal psMsgId As String _ + , ByVal psComment As String _ + ) As Boolean +''' When the entry in the dictionary does not yet exist, equivalent to AddText +''' When it exists already, extend the existing comment with the psComment argument +''' Used from AddTextsFromDialog to manage identical strings without raising errors, +''' e.g. when multiple dialogs have the same "Close" button + +Dim bAdd As Boolean ' Return value +Dim sKey As String ' The key part of an entry in the dictionary +Dim vItem As POEntry ' The item part of the new entry in the dictionary + +Try: + bAdd = False + If Len(psContext) > 0 Then sKey = psContext Else sKey = psMsgId + If _Dictionary.Exists(sKey) Then + ' Load the entry, adapt comment and rewrite + vItem = _Dictionary.Item(sKey) + If Len(vItem.Comment) = 0 Then vItem.Comment = psComment Else vItem.Comment = vItem.Comment & "\n" & psComment + bAdd = _Dictionary.ReplaceItem(sKey, vItem) + Else + ' Add a new entry as usual + bAdd = AddText(psContext, psMsgId, psComment) + End If + +Finally: + _ReplaceText = bAdd + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_L10N._ReplaceText + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the L10N instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[L10N]: PO file" + + _Repr = "[L10N]: " & _POFile + +End Function ' ScriptForge.SF_L10N._Repr + +REM ============================================ END OF SCRIPTFORGE.SF_L10N +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Platform.xba b/wizards/source/scriptforge/SF_Platform.xba new file mode 100644 index 000000000..8403866ff --- /dev/null +++ b/wizards/source/scriptforge/SF_Platform.xba @@ -0,0 +1,451 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Platform" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Platform +''' =========== +''' Singleton class implementing the "ScriptForge.Platform" service +''' Implemented as a usual Basic module +''' +''' A collection of properties about the execution environment: +''' - HW platform +''' - Operating System +''' - current user +''' - LibreOffice version +''' +''' Service invocation example: +''' Dim platform As Variant +''' platform = CreateScriptService("Platform") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_platform.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_Array Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Architecture() As String +''' Returns the actual bit architecture +''' Example: +''' MsgBox platform.Architecture ' 64bit + Architecture = _PropertyGet("Architecture") +End Property ' ScriptForge.SF_Platform.Architecture (get) + +REM ----------------------------------------------------------------------------- +Property Get ComputerName() As String +''' Returns the computer's network name +''' Example: +''' MsgBox platform.ComputerName + ComputerName = _PropertyGet("ComputerName") +End Property ' ScriptForge.SF_Platform.ComputerName (get) + +REM ----------------------------------------------------------------------------- +Property Get CPUCount() As Integer +''' Returns the number of Central Processor Units +''' Example: +''' MsgBox platform.CPUCount ' 4 + CPUCount = _PropertyGet("CPUCount") +End Property ' ScriptForge.SF_Platform.CPUCount (get) + +REM ----------------------------------------------------------------------------- +Property Get CurrentUser() As String +''' Returns the name of logged in user +''' Example: +''' MsgBox platform.CurrentUser + CurrentUser = _PropertyGet("CurrentUser") +End Property ' ScriptForge.SF_Platform.CurrentUser (get) + +REM ----------------------------------------------------------------------------- +Property Get Extensions() As Variant +''' Returns the list of availableeExtensions as an unsorted array of unique strings +''' To get the list sorted, use SF_Array.Sort() +''' Example: +''' myExtensionsList = platform.Extensions + Extensions = _PropertyGet("Extensions") +End Property ' ScriptForge.SF_Platform.Extensions (get) + +REM ----------------------------------------------------------------------------- +Property Get FilterNames() As Variant +''' Returns the list of available document import and export filter names as an unsorted array of unique strings +''' To get the list sorted, use SF_Array.Sort() +''' Example: +''' myFilterNamesList = platform.FilterNames + FilterNames = _PropertyGet("FilterNames") +End Property ' ScriptForge.SF_Platform.FilterNames (get) + +REM ----------------------------------------------------------------------------- +Property Get Fonts() As Variant +''' Returns the list of available fonts as an unsorted array of unique strings +''' To get the list sorted, use SF_Array.Sort() +''' Example: +''' myFontsList = platform.Fonts + Fonts = _PropertyGet("Fonts") +End Property ' ScriptForge.SF_Platform.Fonts (get) + +REM ----------------------------------------------------------------------------- +Property Get FormatLocale() As String +''' Returns the locale used for number and date formats, combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox platform.FormatLocale + FormatLocale = _PropertyGet("FormatLocale") +End Property ' ScriptForge.SF_Platform.FormatLocale (get) + +REM ----------------------------------------------------------------------------- +Property Get Locale() As String +''' Returns the locale of the operating system, combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox platform.Locale + Locale = _PropertyGet("Locale") +End Property ' ScriptForge.SF_Platform.Locale (get) + +REM ----------------------------------------------------------------------------- +Property Get Machine() As String +''' Returns the machine type like 'i386' or 'x86_64' +''' Example: +''' MsgBox platform.Machine + Machine = _PropertyGet("Machine") +End Property ' ScriptForge.SF_Platform.Machine (get) + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_Platform" +End Property ' ScriptForge.SF_Platform.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get OfficeLocale() As String +''' Returns the locale of the user interface, combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox platform.OfficeLocale + OfficeLocale = _PropertyGet("OfficeLocale") +End Property ' ScriptForge.SF_Platform.OfficeLocale (get) + +REM ----------------------------------------------------------------------------- +Property Get OfficeVersion() As String +''' Returns the office software version in the form 'LibreOffice w.x.y.z (The Document Foundation)' +''' Example: +''' MsgBox platform.OfficeVersion + OfficeVersion = _PropertyGet("OfficeVersion") +End Property ' ScriptForge.SF_Platform.OfficeVersion (get) + +REM ----------------------------------------------------------------------------- +Property Get OSName() As String +''' Returns the name of the operating system like 'Linux' or 'Windows' +''' Example: +''' MsgBox platform.OSName + OSName = _PropertyGet("OSName") +End Property ' ScriptForge.SF_Platform.OSName (get) + +REM ----------------------------------------------------------------------------- +Property Get OSPlatform() As String +''' Returns a single string identifying the underlying platform with as much useful and human-readable information as possible +''' Example: +''' MsgBox platform.OSPlatform ' Linux-4.15.0-117-generic-x86_64-with-Ubuntu-18.04-bionic + OSPlatform = _PropertyGet("OSPlatform") +End Property ' ScriptForge.SF_Platform.OSPlatform (get) + +REM ----------------------------------------------------------------------------- +Property Get OSRelease() As String +''' Returns the operating system's release +''' Example: +''' MsgBox platform.OSRelease ' 4.15.0-117-generic + OSRelease = _PropertyGet("OSRelease") +End Property ' ScriptForge.SF_Platform.OSRelease (get) + +REM ----------------------------------------------------------------------------- +Property Get OSVersion() As String +''' Returns the name of the operating system build or version +''' Example: +''' MsgBox platform.OSVersion ' #118-Ubuntu SMP Fri Sep 4 20:02:41 UTC 2020 + OSVersion = _PropertyGet("OSVersion") +End Property ' ScriptForge.SF_Platform.OSVersion (get) + +REM ----------------------------------------------------------------------------- +Property Get Printers() As Variant +''' Returns the list of available printers type as a zero-based array +''' The default printer is put in the 1st position in the list (index = 0) +''' Example: +''' MsgBox join(platform.Printers, ",") + Printers = _PropertyGet("Printers") +End Property ' ScriptForge.SF_Platform.Printers (get) + +REM ----------------------------------------------------------------------------- +Property Get Processor() As String +''' Returns the (real) processor name, e.g. 'amdk6'. Might return the same value as Machine +''' Example: +''' MsgBox platform.Processor + Processor = _PropertyGet("Processor") +End Property ' ScriptForge.SF_Platform.Processor (get) + +REM ----------------------------------------------------------------------------- +Property Get PythonVersion() As String +''' Returns the Python version as string 'Python major.minor.patchlevel' +''' Example: +''' MsgBox platform.PythonVersion ' Python 3.7.7 + PythonVersion = _PropertyGet("PythonVersion") +End Property ' ScriptForge.SF_Platform.PythonVersion (get) + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Platform" +End Property ' ScriptForge.SF_Platform.ServiceName + +REM ----------------------------------------------------------------------------- +Property Get SystemLocale() As String +''' Returns the locale of the operating system, combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox platform.SystemLocale + SystemLocale = _PropertyGet("SystemLocale") +End Property ' ScriptForge.SF_Platform.SystemLocale (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions: +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Platform.GetProperty" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Platform.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + ) + +End Function ' ScriptForge.SF_Platform.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Platform class as an array + + Properties = Array( _ + "Architecture" _ + , "ComputerName" _ + , "CPUCount" _ + , "CurrentUser" _ + , "Extensions" _ + , "FilterNames" _ + , "Fonts" _ + , "FormatLocale" _ + , "Locale" _ + , "Machine" _ + , "OfficeLocale" _ + , "OfficeVersion" _ + , "OSName" _ + , "OSPlatform" _ + , "OSRelease" _ + , "OSVersion" _ + , "Printers" _ + , "Processor" _ + , "PythonVersion" _ + , "SystemLocale" _ + ) + +End Function ' ScriptForge.SF_Platform.Properties + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Function _GetPrinters() as Variant +''' Returns the list of available printers. +''' The default printer is put in the 1st position (index = 0) + +Dim oPrinterServer As Object ' com.sun.star.awt.PrinterServer +Dim vPrinters As Variant ' Array of printer names +Dim sDefaultPrinter As String ' The default printer +Dim lDefault As Long ' Initial position of the default printer in the list + + On Local Error GoTo Catch ' Prevent any error + vPrinters = Array() + +Try: + ' Find printers + Set oPrinterServer = SF_Utils._GetUNOService("PrinterServer") + With oPrinterServer + vPrinters = .getPrinterNames() + sDefaultPrinter = .getDefaultPrinterName() + End With + + ' Put the default printer on top of the list + If Len(sDefaultPrinter) > 0 Then + lDefault = SF_Array.IndexOf(vPrinters, sDefaultPrinter, CaseSensitive := True) + If lDefault > 0 Then ' Invert 2 printers + vPrinters(lDefault) = vPrinters(0) + vPrinters(0) = sDefaultPrinter + End If + End If + +Finally: + _GetPrinters() = vPrinters() + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Platform._GetPrinters + +REM ----------------------------------------------------------------------------- +Public Function _GetProductName() as String +''' Returns Office product and version numbers found in configuration registry +''' Derived from the Tools library + +Dim oProdNameAccess as Object ' configmgr.RootAccess +Dim sProdName as String +Dim sVersion as String +Dim sVendor As String + + On Local Error GoTo Catch ' Prevent any error + _GetProductName = "" + +Try: + Set oProdNameAccess = SF_Utils._GetRegistryKeyContent("org.openoffice.Setup/Product") + + sProdName = oProdNameAccess.ooName + sVersion = oProdNameAccess.ooSetupVersionAboutBox + sVendor = oProdNameAccess.ooVendor + + _GetProductName = sProdName & " " & sVersion & " (" & sVendor & ")" + +Finally: + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Platform._GetProductName + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim sOSName As String ' Operating system +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oPrinterServer As Object ' com.sun.star.awt.PrinterServer +Dim oToolkit As Object ' com.sun.star.awt.Toolkit +Dim oDevice As Object ' com.sun.star.awt.XDevice +Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory +Dim oFontDescriptors As Variant ' Array of com.sun.star.awt.FontDescriptor +Dim sFonts As String ' Comma-separated list of fonts +Dim sFont As String ' A single font name +Dim vExtensionsList As Variant ' Array of extension descriptors +Dim sExtensions As String ' Comma separated list of extensions +Dim sExtension As String ' A single extension name +Dim i As Long + +Const cstPyHelper = "$" & "_SF_Platform" +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "Platform.get" & psProperty + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + + Select Case psProperty + Case "Architecture", "ComputerName", "CPUCount", "CurrentUser", "Machine" _ + , "OSPlatform", "OSRelease", "OSVersion", "Processor", "PythonVersion" + With ScriptForge.SF_Session + _PropertyGet = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, psProperty) + End With + Case "Extensions" + Set vExtensionsList = SF_Utils._GetUnoService("PackageInformationProvider").ExtensionList + sExtensions = "" + For i = 0 To UBound(vExtensionsList) + sExtensions = sExtensions & "," & vExtensionsList(i)(0) + Next i + If Len(sExtensions) > 0 Then _PropertyGet = Split(Mid(sExtensions, 2), ",") Else _PropertyGet = Array() + Case "FilterNames" + Set oFilterFactory = SF_Utils._GetUNOService("FilterFactory") + _PropertyGet = oFilterFactory.getElementNames() + Case "Fonts" + Set oToolkit = SF_Utils._GetUnoService("Toolkit") + Set oDevice = oToolkit.createScreenCompatibleDevice(0, 0) + oFontDescriptors = oDevice.FontDescriptors() + sFonts = "," + ' Select only not yet registered fonts + For i = 0 To UBound(oFontDescriptors) + sFont = oFontDescriptors(i).Name + If InStr(1, sFonts, "," & sFont & ",", 0) = 0 Then sFonts = sFonts & sFont & "," ' Case-sensitive comparison + Next i + ' Remove leading and trailing commas + If Len(sFonts) > 1 Then _PropertyGet = Split(Mid(sFonts, 2, Len(sFonts) - 2), ",") Else _PropertyGet = Array() + Case "FormatLocale" + Set oLocale = SF_Utils._GetUNOService("FormatLocale") + _PropertyGet = oLocale.Language & "-" & oLocale.Country + Case "OfficeLocale" + Set oLocale = SF_Utils._GetUNOService("OfficeLocale") + _PropertyGet = oLocale.Language & "-" & oLocale.Country + Case "OfficeVersion" + _PropertyGet = _GetProductName() + Case "OSName" + ' Calc INFO function preferred to Python script to avoid ScriptForge initialization risks when Python is not installed + sOSName = _SF_.OSName + If sOSName = "" Then + sOSName = SF_Session.ExecuteCalcFunction("INFO", "system") + Select Case sOSName + Case "WNT" : sOSName = "Windows" + Case "MACOSX" : sOSName = "macOS" + Case "LINUX" : sOSName = "Linux" + Case "SOLARIS" : sOSName = "Solaris" + Case Else : sOSName = SF_String.Capitalize(sOSName) + End Select + EndIf + _PropertyGet = sOSName + Case "Printers" + _PropertyGet = _GetPrinters() + Case "SystemLocale", "Locale" + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + _PropertyGet = oLocale.Language & "-" & oLocale.Country + Case Else + _PropertyGet = Null + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Platform._PropertyGet + +REM ============================================ END OF SCRIPTFORGE.SF_PLATFORM +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_PythonHelper.xba b/wizards/source/scriptforge/SF_PythonHelper.xba new file mode 100644 index 000000000..99d9f86c6 --- /dev/null +++ b/wizards/source/scriptforge/SF_PythonHelper.xba @@ -0,0 +1,967 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_PythonHelper" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_PythonHelper (aka Basic) +''' =============== +''' Singleton class implementing the "ScriptForge.Basic" service +''' Implemented as a usual Basic module +''' +''' The "Basic" service must be called ONLY from a PYTHON script +''' Service invocations: Next Python code lines are equivalent: +''' bas = CreateScriptService('ScriptForge.Basic') +''' bas = CreateScriptService('Basic') +''' +''' This service proposes a collection of methods to be executed in a Python context +''' to simulate the exact behaviour of the identical Basic builtin method. +''' Typical example: +''' bas.MsgBox('This has to be displayed in a message box') +''' +''' The service includes also an agnostic "Python Dispatcher" function. +''' It dispatches Python script requests to execute Basic services to the +''' appropriate properties and methods via dynamic call techniques +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_PythonHelper Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_PythonHelper" +End Property ' ScriptForge.SF_PythonHelper.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Basic" +End Property ' ScriptForge.SF_PythonHelper.ServiceName + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Function PyCDate(ByVal DateArg As Variant) As Variant +''' Convenient function to replicate CDate() in Python scripts +''' Args: +''' DateArg: a date as a string or as a double +''' Returns: +''' The converted date as a UNO DateTime structure +''' If the input argument could not be recognized as a date, return the argument unchanged +''' Example: (Python code) +''' a = bas.CDate('2021-02-18') + +Dim vDate As Variant ' Return value +Const cstThisSub = "Basic.CDate" +Const cstSubArgs = "datearg" + + On Local Error GoTo Catch + vDate = Null + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + vDate = CDate(DateArg) + +Finally: + If VarType(vDate) = V_DATE Then PyCDate = CDateToUnoDateTime(vDate) Else PyCDate = DateArg + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyCDate + +REM ----------------------------------------------------------------------------- +Public Function PyConvertFromUrl(ByVal FileName As Variant) As String +''' Convenient function to replicate ConvertFromUrl() in Python scripts +''' Args: +''' FileName: a string representing a file in URL format +''' Returns: +''' The same file name in native operating system notation +''' Example: (Python code) +''' a = bas.ConvertFromUrl('file:////boot.sys') + +Dim sFileName As String ' Return value +Const cstThisSub = "Basic.ConvertFromUrl" +Const cstSubArgs = "filename" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFileName = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + sFileName = ConvertFromUrl(FileName) + +Finally: + PyConvertFromUrl = sFileName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyConvertFromUrl + +REM ----------------------------------------------------------------------------- +Public Function PyConvertToUrl(ByVal FileName As Variant) As String +''' Convenient function to replicate ConvertToUrl() in Python scripts +''' Args: +''' FileName: a string representing a file in native operating system notation +''' Returns: +''' The same file name in URL format +''' Example: (Python code) +''' a = bas.ConvertToUrl('C:\boot.sys') + +Dim sFileName As String ' Return value +Const cstThisSub = "Basic.ConvertToUrl" +Const cstSubArgs = "filename" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFileName = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + sFileName = ConvertToUrl(FileName) + +Finally: + PyConvertToUrl = sFileName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyConvertToUrl + +REM ----------------------------------------------------------------------------- +Public Function PyCreateUnoService(ByVal UnoService As Variant) As Variant +''' Convenient function to replicate CreateUnoService() in Python scripts +''' Args: +''' UnoService: a string representing the service to create +''' Returns: +''' A UNO object +''' Example: (Python code) +''' a = bas.CreateUnoService('com.sun.star.i18n.CharacterClassification') + +Dim vUno As Variant ' Return value +Const cstThisSub = "Basic.CreateUnoService" +Const cstSubArgs = "unoservice" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set vUno = Nothing + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + Set vUno = CreateUnoService(UnoService) + +Finally: + Set PyCreateUnoService = vUno + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyCreateUnoService + +REM ----------------------------------------------------------------------------- +Public Function PyDateAdd(ByVal Add As Variant _ + , ByVal Count As Variant _ + , ByVal DateArg As Variant _ + ) As Variant +''' Convenient function to replicate DateAdd() in Python scripts +''' Args: +''' Add: The unit to add +''' Count: how many times to add (might be negative) +''' DateArg: a date as a com.sun.star.util.DateTime UNO structure +''' Returns: +''' The new date as a string in iso format +''' Example: (Python code) +''' a = bas.DateAdd('d', 1, bas.Now()) ' Tomorrow + +Dim vNewDate As Variant ' Return value +Dim vDate As Date ' Alias of DateArg +Const cstThisSub = "Basic.DateAdd" +Const cstSubArgs = "add, count, datearg" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vNewDate = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If VarType(DateArg) = V_OBJECT Then + vDate = CDateFromUnoDateTime(DateArg) + Else + vDate = SF_Utils._CStrToDate(DateArg) + End If + vNewDate = DateAdd(Add, Count, vDate) + +Finally: + If VarType(vNewDate) = V_DATE Then PyDateAdd = CDateToUnoDateTime(vNewDate) Else PyDateAdd = vNewDate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyDateAdd + +REM ----------------------------------------------------------------------------- +Public Function PyDateDiff(ByVal Add As Variant _ + , ByVal Date1 As Variant _ + , ByVal Date2 As Variant _ + , ByVal WeekStart As Variant _ + , ByVal YearStart As Variant _ + ) As Long +''' Convenient function to replicate DateDiff() in Python scripts +''' Args: +''' Add: The unit of the date interval +''' Date1, Date2: the two dates to be compared +''' WeekStart: the starting day of a week +''' YearStart: the starting week of a year +''' Returns: +''' The number of intervals expressed in Adds +''' Example: (Python code) +''' a = bas.DateDiff('d', bas.DateAdd('d', 1, bas.Now()), bas.Now()) ' -1 day + +Dim lDiff As Long ' Return value +Dim vDate1 As Date ' Alias of Date1 +Dim vDate2 As Date ' Alias of Date2 +Const cstThisSub = "Basic.DateDiff" +Const cstSubArgs = "add, date1, date2, [weekstart=1], [yearstart=1]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + lDiff = 0 + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If VarType(Date1) = V_OBJECT Then + vDate1 = CDateFromUnoDateTime(Date1) + Else + vDate1 = SF_Utils._CStrToDate(Date1) + End If + If VarType(Date2) = V_OBJECT Then + vDate2 = CDateFromUnoDateTime(Date2) + Else + vDate2 = SF_Utils._CStrToDate(Date2) + End If + lDiff = DateDiff(Add, vDate1, vDate2, WeekStart, YearStart) + + +Finally: + PyDateDiff = lDiff + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyDateDiff + +REM ----------------------------------------------------------------------------- +Public Function PyDatePart(ByVal Add As Variant _ + , ByVal DateArg As Variant _ + , ByVal WeekStart As Variant _ + , ByVal YearStart As Variant _ + ) As Long +''' Convenient function to replicate DatePart() in Python scripts +''' Args: +''' Add: The unit of the date interval +''' DateArg: The date from which to extract a part +''' WeekStart: the starting day of a week +''' YearStart: the starting week of a year +''' Returns: +''' The specified part of the date +''' Example: (Python code) +''' a = bas.DatePart('y', bas.Now()) ' day of year + +Dim lPart As Long ' Return value +Dim vDate As Date ' Alias of DateArg +Const cstThisSub = "Basic.DatePart" +Const cstSubArgs = "add, datearg, [weekstart=1], [yearstart=1]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + lPart = 0 + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If VarType(DateArg) = V_OBJECT Then + vDate = CDateFromUnoDateTime(DateArg) + Else + vDate = SF_Utils._CStrToDate(DateArg) + End If + lPart = DatePart(Add, vDate, WeekStart, YearStart) + + +Finally: + PyDatePart = lPart + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyDatePart + +REM ----------------------------------------------------------------------------- +Public Function PyDateValue(ByVal DateArg As Variant) As Variant +''' Convenient function to replicate DateValue() in Python scripts +''' Args: +''' DateArg: a date as a string +''' Returns: +''' The converted date as a UNO DateTime structure +''' Example: (Python code) +''' a = bas.DateValue('2021-02-18') + +Dim vDate As Variant ' Return value +Const cstThisSub = "Basic.DateValue" +Const cstSubArgs = "datearg" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vDate = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + vDate = DateValue(DateArg) + +Finally: + If VarType(vDate) = V_DATE Then PyDateValue = CDateToUnoDateTime(vDate) Else PyDateValue = vDate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyDateValue + +REM ----------------------------------------------------------------------------- +Public Function PyFormat(ByVal Value As Variant _ + , ByVal Pattern As Variant _ + ) As String +''' Convenient function to replicate Format() in Python scripts +''' Args: +''' Value: a date or a number +''' Pattern: the format to apply +''' Returns: +''' The formatted value +''' Example: (Python code) +''' MsgBox bas.Format(6328.2, '##,##0.00') + +Dim sFormat As String ' Return value +Dim vValue As Variant ' Alias of Value +Const cstThisSub = "Basic.Format" +Const cstSubArgs = "value, pattern" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sFormat = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If VarType(Value) = V_OBJECT Then vValue = CDateFromUnoDateTime(Value) ELse vValue = Value + If IsEmpty(Pattern) Or Len(Pattern) = 0 Then sFormat = Str(vValue) Else sFormat = Format(vValue, Pattern) + + +Finally: + PyFormat = sFormat + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyFormat + +REM ----------------------------------------------------------------------------- +Public Function PyGetGuiType() As Integer +''' Convenient function to replicate GetGuiType() in Python scripts +''' Args: +''' Returns: +''' The GetGuiType value +''' Example: (Python code) +''' MsgBox bas.GetGuiType() + +Const cstThisSub = "Basic.GetGuiType" +Const cstSubArgs = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + PyGetGuiType = GetGuiType() + + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_PythonHelper.PyGetGuiType + +REM ----------------------------------------------------------------------------- +Public Function PyGetSystemTicks() As Long +''' Convenient function to replicate GetSystemTicks() in Python scripts +''' Args: +''' Returns: +''' The GetSystemTicks value +''' Example: (Python code) +''' MsgBox bas.GetSystemTicks() + +Const cstThisSub = "Basic.GetSystemTicks" +Const cstSubArgs = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + PyGetSystemTicks = GetSystemTicks() + + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_PythonHelper.PyGetSystemTicks + +REM ----------------------------------------------------------------------------- +Public Function PyGlobalScope(ByVal Library As Variant) As Object +''' Convenient function to replicate GlobalScope() in Python scripts +''' Args: +''' Library: "Basic" or "Dialog" +''' Returns: +''' The GlobalScope value +''' Example: (Python code) +''' MsgBox bas.GlobalScope.BasicLibraries() + +Const cstThisSub = "Basic.GlobalScope.BasicLibraries" ' or DialogLibraries +Const cstSubArgs = "" + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + Select Case Library + Case "Basic" + PyGlobalScope = GlobalScope.BasicLibraries() + Case "Dialog" + PyGlobalScope = GlobalScope.DialogLibraries() + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_PythonHelper.PyGlobalScope + +REM ----------------------------------------------------------------------------- +Public Function PyInputBox(ByVal Msg As Variant _ + , ByVal Title As Variant _ + , ByVal Default As Variant _ + , Optional ByVal XPosTwips As Variant _ + , Optional ByVal YPosTwips As Variant _ + ) As String +''' Convenient function to replicate InputBox() in Python scripts +''' Args: +''' Msg: String expression displayed as the message in the dialog box +''' Title: String expression displayed in the title bar of the dialog box +''' Default: String expression displayed in the text box as default if no other input is given +''' XPosTwips: Integer expression that specifies the horizontal position of the dialog +''' YPosTwips: Integer expression that specifies the vertical position of the dialog +''' If XPosTwips and YPosTwips are omitted, the dialog is centered on the screen +''' The position is specified in twips. +''' Returns: +''' The entered value or "" if the user pressed the Cancel button +''' Example: (Python code) +''' a = bas.InputBox ('Please enter a phrase:', 'Dear User') + +Dim sInput As String ' Return value +Const cstThisSub = "Basic.InputBox" +Const cstSubArgs = "msg, [title=''], [default=''], [xpostwips], [ypostwips]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sInput = "" + +Check: + If IsMissing(YPosTwips) Then YPosTwips = 1 + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If IsMissing(XPosTwips) Then + sInput = InputBox(Msg, Title, Default) + Else + sInput = InputBox(Msg, Title, Default, XPosTwips, YPosTwips) + End If + +Finally: + PyInputBox = sInput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyInputBox + +REM ----------------------------------------------------------------------------- +Public Function PyMsgBox(ByVal Text As Variant _ + , ByVal DialogType As Variant _ + , ByVal DialogTitle As Variant _ + ) As Integer +''' Convenient function to replicate MsgBox() in Python scripts +''' Args: +''' Text: String expression displayed as a message in the dialog box +''' DialogType: Any integer expression that defines the number and type of buttons or icons displayed +''' DialogTitle: String expression displayed in the title bar of the dialog +''' Returns: +''' The pressed button +''' Example: (Python code) +''' a = bas.MsgBox ('Please press a button:', bas.MB_EXCLAMATION, 'Dear User') + +Dim iMsg As Integer ' Return value +Const cstThisSub = "Basic.MsgBox" +Const cstSubArgs = "text, [dialogtype=0], [dialogtitle]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iMsg = -1 + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + iMsg = MsgBox(Text, DialogType, DialogTitle) + +Finally: + PyMsgBox = iMsg + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper.PyMsgBox + +REM ============================================================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Public Function _PythonDispatcher(ByRef BasicObject As Variant _ + , ByVal CallType As Variant _ + , ByVal Script As Variant _ + , ParamArray Args() As Variant _ + ) As Variant +''' Called from Python only +''' The method calls the method Script associated with the BasicObject class or module +''' with the given arguments +''' The invocation of the method can be a Property Get, Property Let or a usual call +''' NB: arguments and return values must not be 2D arrays +''' The implementation intends to be as AGNOSTIC as possible in terms of objects nature and methods called +''' Args: +''' BasicObject: a module or a class instance - May also be the reserved string: "SF_Services" +''' CallType: one of the constants applicable to a CallByName statement + optional protocol flags +''' Script: the name of the method or property +''' Args: the arguments to pass to the method. Input arguments can contain symbolic constants for Null, Missing, etc. +''' Returns: +''' A 1D array: +''' [0] The returned value - scalar, object or 1D array +''' [1] The VarType() of the returned value +''' Null, Empty and Nothing have different vartypes but return all None to Python +''' Additionally, when array: +''' [2] Number of dimensions in Basic +''' Additionally, when Basic object: +''' [2] Module (1), Class instance (2) or UNO (3) +''' [3] The object's ObjectType +''' [4] The object's service name +''' [5] The object's name +''' When an error occurs Python receives None as a scalar. This determines the occurrence of a failure + +Dim vReturn As Variant ' The value returned by the invoked property or method +Dim vReturnArray As Variant ' Return value +Dim vBasicObject As Variant ' Alias of BasicObject to avoid "Object reference not set" error +Dim iNbArgs As Integer ' Number of valid input arguments +Dim vArg As Variant ' Alias for a single argument +Dim vArgs() As Variant ' Alias for Args() +Dim sScript As String ' Argument of ExecuteBasicScript() +Dim vParams As Variant ' Array of arguments to pass to a ParamArray +Dim sObjectType As String ' Alias of object.ObjectType +Dim sServiceName As String ' Alias of BasicObject.ServiceName +Dim bBasicClass As Boolean ' True when BasicObject is a class +Dim sLibrary As String ' Library where the object belongs to +Dim bUno As Boolean ' Return value is a UNO object +Dim oObjDesc As Object ' _ObjectDescriptor type +Dim iDims As Integer ' # of dims of vReturn +Dim sess As Object : Set sess = ScriptForge.SF_Session +Dim i As Long, j As Long + +' Conventional special input or output values +Const cstNoArgs = "+++NOARGS+++", cstSymEmpty = "+++EMPTY+++", cstSymNull = "+++NULL+++", cstSymMissing = "+++MISSING+++" + +' https://support.office.com/en-us/article/CallByName-fonction-49ce9475-c315-4f13-8d35-e98cfe98729a +' Determines the CallType +Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8 +' Protocol flags +Const cstDateArg = 64 ' May contain a date argument +Const cstDateRet = 128 ' Return value can be a date +Const cstUno = 256 ' Return value can be a UNO object +Const cstArgArray = 512 ' Any argument can be a 2D array +Const cstRetArray = 1024 ' Return value can be an array +Const cstObject = 2048 ' 1st argument is a Basic object when numeric +Const cstHardCode = 4096 ' Method must not be executed with CallByName() +' Object nature in returned array +Const objMODULE = 1, objCLASS = 2, objUNO = 3 + +Check: + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + _PythonDispatcher = Null + + ' Ignore Null basic objects (Null = Null or Nothing) + If IsNull(BasicObject) Or IsEmpty(BasicObject) Then GoTo Catch + + ' Reinterpret arguments one by one into vArgs, convert UNO date/times and conventional NoArgs/Empty/Null/Missing values + iNbArgs = -1 + vArgs = Array() + + If UBound(Args) >= 0 Then + For i = 0 To UBound(Args) + vArg = Args(i) + ' Are there arguments ? + If i = 0 And VarType(vArg) = V_STRING Then + If vArg = cstNoArgs Then Exit For + End If + ' Is 1st argument a reference to a Basic object ? + If i = 0 And (( CallType And cstObject ) = cstObject) And SF_Utils._VarTypeExt(vArg) = V_NUMERIC Then + If vArg < 0 Or Not IsArray(_SF_.PythonStorage) Then GoTo Catch + If vArg > UBound(_SF_.PythonStorage) Then GoTo Catch + vArg = _SF_.PythonStorage(vArg) + ' Is argument a symbolic constant for Null, Empty, ... , or a date? + ElseIf VarType(vArg) = V_STRING Then + If Len(vArg) = 0 Then + ElseIf vArg = cstSymEmpty Then + vArg = Empty + ElseIf vArg = cstSymNull Then + vArg = Null + ElseIf vArg = cstSymMissing Then + Exit For ' Next arguments must be missing also + End If + ElseIf VarType(vArg) = V_OBJECT Then + If ( CallType And cstDateArg ) = cstDateArg Then vArg = CDateFromUnoDateTime(vArg) + End If + iNbArgs = iNbArgs + 1 + + ReDim Preserve vArgs(iNbArgs) + vArgs(iNbArgs) = vArg + Next i + End If + +Try: + ' Dispatching strategy: based on next constraints + ' (1) Bug https://bugs.documentfoundation.org/show_bug.cgi?id=138155 + ' The CallByName function fails when returning an array + ' (2) Python has tuples and tuple of tuples, not 2D arrays + ' (3) Passing 2D arrays through a script provider always transform it into a sequence of sequences + ' (4) The CallByName function takes exclusive control on the targeted object up to its exit + ' 1. Methods in usual modules are called by ExecuteBasicScript() except if they use a ParamArray + ' 2. Properties in any service are got and set with obj.GetProperty/SetProperty(...) + ' 3. Methods in class modules are invoked with CallByName + ' 4. Methods in class modules using a 2D array or returning arrays, or methods using ParamArray, +''' are hardcoded as exceptions or are not implemented + ' 5. Due to constraint (4), a predefined list of method calls must be hardcoded to avoid blocking use of CallByName + ' The concerned methods are flagged with cstHardCode + + With _SF_ + ' Initialize Python persistent storage at 1st call + If IsEmpty(.PythonStorage) Then ._InitPythonStorage() + ' Reset any error + ._Stackreset() + ' Set Python trigger to manage signatures in error messages + .TriggeredByPython = True + End With + + Select case VarType(BasicObject) + Case V_STRING + ' Special entry for CreateScriptService() + vBasicObject = BasicObject + If vBasicObject = "SF_Services" Then + If UBound(vArgs) = 0 Then vParams = Array() Else vParams = SF_Array.Slice(vArgs, 1) + Select Case UBound(vParams) + Case -1 : vReturn = SF_Services.CreateScriptService(vArgs(0)) + Case 0 : vReturn = SF_Services.CreateScriptService(vArgs(0), vParams(0)) + Case 1 : vReturn = SF_Services.CreateScriptService(vArgs(0), vParams(0), vParams(1)) + Case 2 : vReturn = SF_Services.CreateScriptService(vArgs(0), vParams(0), vParams(1), vParams(2)) + Case 3 : vReturn = SF_Services.CreateScriptService(vArgs(0), vParams(0), vParams(1), vParams(2), vParams(3)) + Case 4 : vReturn = SF_Services.CreateScriptService(vArgs(0), vParams(0), vParams(1), vParams(2), vParams(3), vParams(4)) + End Select + End If + If VarType(vReturn) = V_OBJECT And Not IsNull(vReturn) Then + vBasicObject = vReturn + sObjectType = vBasicObject.ObjectType + bBasicClass = ( Left(sObjectType, 3) <> "SF_" ) + End If + + ' Implement dispatching strategy + Case V_INTEGER + If BasicObject < 0 Or Not IsArray(_SF_.PythonStorage) Then GoTo Catch + If BasicObject > UBound(_SF_.PythonStorage) Then GoTo Catch + vBasicObject = _SF_.PythonStorage(BasicObject) + sObjectType = vBasicObject.ObjectType + sServiceName = vBasicObject.ServiceName + + ' Basic modules have type = "SF_*" + bBasicClass = ( Left(sObjectType, 3) <> "SF_" ) + sLibrary = Split(sServiceName, ".")(0) + + ' Methods in standard modules returning/passing a date are hardcoded as exceptions + If Not bBasicClass And ((CallType And vbMethod) = vbMethod) _ + And (((CallType And cstDateRet) = cstDateRet) Or ((CallType And cstDateArg) = cstDateArg)) Then + Select Case sServiceName + Case "ScriptForge.FileSystem" + If Script = "GetFileModified" Then vReturn = SF_FileSystem.GetFileModified(vArgs(0)) + Case "ScriptForge.Region" + Select Case Script + Case "DSTOffset" : vReturn = SF_Region.DSTOffset(vArgs(0), vArgs(1), vArgs(2)) + Case "LocalDateTime" : vReturn = SF_Region.LocalDateTime(vArgs(0), vArgs(1), vArgs(2)) + Case "UTCDateTime" : vReturn = SF_Region.UTCDateTime(vArgs(0), vArgs(1), vArgs(2)) + Case "UTCNow" : vReturn = SF_Region.UTCNow(vArgs(0), vArgs(1)) + Case Else + End Select + End Select + + ' Methods in usual modules using a 2D array or returning arrays are hardcoded as exceptions + ElseIf Not bBasicClass And _ + (((CallType And vbMethod) + (CallType And cstArgArray)) = vbMethod + cstArgArray Or _ + ((CallType And vbMethod) + (CallType And cstRetArray)) = vbMethod + cstRetArray) Then + ' Not service related + If Script = "Methods" Then + vReturn = vBasicObject.Methods() + ElseIf Script = "Properties" Then + vReturn = vBasicObject.Properties() + Else + Select Case sServiceName + Case "ScriptForge.Array" + If Script = "ImportFromCSVFile" Then vReturn = SF_Array.ImportFromCSVFile(vArgs(0), vArgs(1), vArgs(2), True) + End Select + End If + + ' Methods in usual modules are called by ExecuteBasicScript() except if they use a ParamArray + ElseIf Not bBasicClass And (CallType And vbMethod) = vbMethod Then + sScript = sLibrary & "." & sObjectType & "." & Script + ' Force validation in targeted function, not in ExecuteBasicScript() + _SF_.StackLevel = -1 + Select Case UBound(vArgs) + Case -1 : vReturn = sess.ExecuteBasicScript(, sScript) + Case 0 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0)) + Case 1 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1)) + Case 2 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1), vArgs(2)) + Case 3 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1), vArgs(2), vArgs(3)) + Case 4 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4)) + Case 5 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5)) + Case 6 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6)) + Case 7 : vReturn = sess.ExecuteBasicScript(, sScript, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7)) + End Select + _SF_.StackLevel = 0 + + ' Properties in any service are got and set with obj.GetProperty/SetProperty(...) + ElseIf (CallType And vbGet) = vbGet Then ' In some cases (Calc ...) GetProperty may have an argument + If UBound(vArgs) < 0 Then vReturn = vBasicObject.GetProperty(Script) Else vReturn = vBasicObject.GetProperty(Script, vArgs(0)) + ElseIf (CallType And vbLet) = vbLet Then + vReturn = vBasicObject.SetProperty(Script, vArgs(0)) + + ' Methods in class modules using a 2D array or returning arrays are hardcoded as exceptions. Bug #138155 + ElseIf ((CallType And vbMethod) + (CallType And cstArgArray)) = vbMethod + cstArgArray Or _ + ((CallType And vbMethod) + (CallType And cstRetArray)) = vbMethod + cstRetArray Then + If Script = "Methods" Then + vReturn = vBasicObject.Methods() + ElseIf Script = "Properties" Then + vReturn = vBasicObject.Properties() + Else + Select Case sServiceName + Case "SFDatabases.Database" + If Script = "GetRows" Then vReturn = vBasicObject.GetRows(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) + Case "SFDialogs.Dialog" + If Script = "Controls" Then vReturn = vBasicObject.Controls(vArgs(0)) + Case "SFDialogs.DialogControl" + If Script = "SetTableData" Then vReturn = vBasicObject.SetTableData(vArgs(0), vArgs(1), vArgs(2)) + Case "SFDocuments.Document" + If Script = "Forms" Then vReturn = vBasicObject.Forms(vArgs(0)) + Case "SFDocuments.Base" + Select Case Script + Case "FormDocuments" : vReturn = vBasicObject.FormDocuments() + Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0), vArgs(1)) + End Select + Case "SFDocuments.Calc" + Select Case Script + Case "Charts" : vReturn = vBasicObject.Charts(vArgs(0), vArgs(1)) + Case "Forms" : vReturn = vBasicObject.Forms(vArgs(0), vArgs(1)) + Case "GetFormula" : vReturn = vBasicObject.GetFormula(vArgs(0)) + Case "GetValue" : vReturn = vBasicObject.GetValue(vArgs(0)) + Case "SetArray" : vReturn = vBasicObject.SetArray(vArgs(0), vArgs(1)) + Case "SetFormula" : vReturn = vBasicObject.SetFormula(vArgs(0), vArgs(1)) + Case "SetValue" : vReturn = vBasicObject.SetValue(vArgs(0), vArgs(1)) + End Select + Case "SFDocuments.Form" + Select Case Script + Case "Controls" : vReturn = vBasicObject.Controls(vArgs(0)) + Case "Subforms" : vReturn = vBasicObject.Subforms(vArgs(0)) + End Select + Case "SFDocuments.FormControl" + If Script = "Controls" Then vReturn = vBasicObject.Controls(vArgs(0)) + End Select + End If + + ' Methods in class modules may better not be executed with CallByName() + ElseIf bBasicClass And ((CallType And vbMethod) + (CallType And cstHardCode)) = vbMethod + cstHardCode Then + Select Case sServiceName + Case "SFDialogs.Dialog" + Select Case Script + Case "Activate" : vReturn = vBasicObject.Activate() + Case "Center" + If UBound(vArgs) < 0 Then vReturn = vBasicObject.Center() Else vReturn = vBasicObject.Center(vArgs(0)) + Case "EndExecute" : vReturn = vBasicObject.EndExecute(vArgs(0)) + Case "Execute" : vReturn = vBasicObject.Execute(vArgs(0)) + Case "Resize" : vReturn = vBasicObject.Resize(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) + End Select + End Select + + ' Methods in class modules are invoked with CallByName + ElseIf bBasicClass And ((CallType And vbMethod) = vbMethod) Then + Select Case UBound(vArgs) + ' Dirty alternatives to process usual and ParamArray cases + ' But, up to ... how many ? + ' - The OFFSETADDRESSERROR has 12 arguments + ' - The ".uno:DataSort" command may have 14 property name-value pairs + Case -1 : vReturn = CallByName(vBasicObject, Script, vbMethod) + Case 0 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0)) + Case 1 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1)) + Case 2 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2)) + Case 3 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3)) + Case 4 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4)) + Case 5 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5)) + Case 6 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6)) + Case 7 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7)) + Case 8 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8)) + Case 9 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9)) + Case 10 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10)) + Case 11 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11)) + Case 12, 13 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12)) + Case 14, 15 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14)) + Case 16, 17 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16)) + Case 18, 19 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16), vArgs(17), vArgs(18)) + Case 20, 21 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16), vArgs(17), vArgs(18) _ + , vArgs(19), vArgs(20)) + Case 22, 23 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16), vArgs(17), vArgs(18) _ + , vArgs(19), vArgs(20), vArgs(21), vArgs(22)) + Case 24, 25 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16), vArgs(17), vArgs(18) _ + , vArgs(19), vArgs(20), vArgs(21), vArgs(22), vArgs(23), vArgs(24)) + Case 26, 27 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16), vArgs(17), vArgs(18) _ + , vArgs(19), vArgs(20), vArgs(21), vArgs(22), vArgs(23), vArgs(24), vArgs(25), vArgs(26)) + Case >= 28 : vReturn = CallByName(vBasicObject, Script, vbMethod, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7) _ + , vArgs(8), vArgs(9), vArgs(10), vArgs(11), vArgs(12), vArgs(13), vArgs(14), vArgs(15), vArgs(16), vArgs(17), vArgs(18) _ + , vArgs(19), vArgs(20), vArgs(21), vArgs(22), vArgs(23), vArgs(24), vArgs(25), vArgs(26), vArgs(27), vArgs(28)) + End Select + End If + + ' Post processing + If Script = "Dispose" Then + ' Special case: Dispose() must update the cache for class objects created in Python scripts + Set _SF_.PythonStorage(BasicObject) = Nothing + End If + Case Else + End Select + + ' Format the returned array + vReturnArray = Array() + ' Distinguish: Basic object + ' UNO object + ' Array + ' Scalar + If IsArray(vReturn) Then + ReDim vReturnArray(0 To 2) + iDims = SF_Array.CountDims(vReturn) + ' Replace dates by UNO format + If iDims = 1 Then + For i = LBound(vReturn) To UBound(vReturn) + If VarType(vReturn(i)) = V_DATE Then vReturn(i) = CDateToUnoDateTime(vReturn(i)) + Next i + ElseIf iDims = 2 Then + For i = LBound(vReturn, 1) To UBound(vReturn, 1) + For j = LBound(vReturn, 2) To UBound(vReturn, 2) + If VarType(vReturn(i, j)) = V_DATE Then vReturn(i, j) = CDateToUnoDateTime(vReturn(i, j)) + Next j + Next i + End If + vReturnArray(0) = vReturn ' 2D arrays are flattened by the script provider when returning to Python + vReturnArray(1) = VarType(vReturn) + vReturnArray(2) = iDims + ElseIf VarType(vReturn) = V_OBJECT And Not IsNull(vReturn) Then + ' Uno or not Uno ? + bUno = False + If (CallType And cstUno) = cstUno Then ' UNO considered only when pre-announced in CallType + Set oObjDesc = SF_Utils._VarTypeObj(vReturn) + bUno = ( oObjDesc.iVarType = V_UNOOBJECT ) + End If + If bUno Then + ReDim vReturnArray(0 To 2) + Set vReturnArray(0) = vReturn + Else + ReDim vReturnArray(0 To 5) + vReturnArray(0) = _SF_._AddToPythonSTorage(vReturn) + End If + vReturnArray(1) = V_OBJECT + vReturnArray(2) = Iif(bUno, objUNO, Iif(bBasicClass, objCLASS, objMODULE)) + If Not bUno Then + vReturnArray(3) = vReturn.ObjectType + vReturnArray(4) = vReturn.ServiceName + vReturnArray(5) = "" + If vReturn.ObjectType <> "SF_CalcReference" Then ' Calc references are implemented as a Type ... End Type data structure + If SF_Array.Contains(vReturn.Properties(), "Name", SortOrder := "ASC") Then vReturnArray(5) = vReturn.Name + End If + End If + Else ' Scalar or Nothing + ReDim vReturnArray(0 To 1) + If VarType(vReturn) = V_DATE Then vReturnArray(0) = CDateToUnoDateTime(vReturn) Else vReturnArray(0) = vReturn + vReturnArray(1) = VarType(vReturn) + End If + + _PythonDispatcher = vReturnArray + +Finally: + _SF_.TriggeredByPython = False ' Reset normal state + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_PythonHelper._PythonDispatcher + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Basic instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[PythonHelper]" + + _Repr = "[PythonHelper]" + +End Function ' ScriptForge.SF_PythonHelper._Repr + +REM ================================================= END OF SCRIPTFORGE.SF_PythonHelper +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Region.xba b/wizards/source/scriptforge/SF_Region.xba new file mode 100644 index 000000000..d3eacfae0 --- /dev/null +++ b/wizards/source/scriptforge/SF_Region.xba @@ -0,0 +1,861 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Region" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Region +''' ========= +''' Singleton class implementing the "ScriptForge.Region" service +''' Implemented as a usual Basic module +''' +''' A collection of functions about languages, countries and timezones +''' - Locales +''' - Currencies +''' - Numbers and dates formatting +''' - Calendars +''' - Timezones conversions +''' - Numbers transformed to text +''' +''' Definitions: +''' Locale or Region +''' A combination of a language (2 or 3 lower case characters) and a country (2 upper case characters) +''' Most properties and methods require a locale as argument. +''' Some of them accept either the complete locale or only the language or country parts. +''' When absent, the considered locale is the locale used in the LibreOffice user interface. +''' (see the SF_Platform.OfficeLocale property) +''' Timezone +''' Specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00". +''' The time offset between the timezone and the Greenwich Meridian Time (GMT) is expressed in minutes. +''' The Daylight Saving Time (DST) is an additional offset. +''' Both offsets can be positive or negative. +''' More info on +''' https://timezonedb.com/time-zones +''' https://en.wikipedia.org/wiki/Time_zone +''' +''' Service invocation example: +''' Dim regio As Object +''' Set regio = CreateScriptService("Region") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_region.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================= PRIVATE MEMBERS + +Private UserLocale As String ' platform.OfficeLocale + +' Reference tables +Private LocaleData As Variant ' com.sun.star.i18n.LocaleData +Private LocaleNames As Variant ' Array of all available "la-CO" strings + +Private UserIndex As Integer ' Index of UserLocale in reference tables + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_Region Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Country(Optional ByVal Region As Variant) As String +''' Returns the english country name applicable in the given region. +''' The region expressed either as a +''' - locale combining language-COUNTRY (la-CO) +''' - country only (CO) +''' Example: +''' MsgBox Regio.Country("IT") ' Italy + Country = _PropertyGet("Country", Region) +End Property ' ScriptForge.SF_Region.Country (get) + +REM ----------------------------------------------------------------------------- +Property Get Currency(Optional ByVal Region As Variant) As String +''' Returns the currency applicable in the given region. +''' The region is expressed either as a +''' - locale combining language-COUNTRY (la-CO) +''' - country only (CO) +''' Example: +''' MsgBox Regio.Currency("IT") ' EUR + Currency = _PropertyGet("Currency", Region) +End Property ' ScriptForge.SF_Region.Currency (get) + +REM ----------------------------------------------------------------------------- +Public Function DatePatterns(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of date acceptance patterns for the given region. +''' Patterns with input combinations that are accepted as incomplete date input, such as M/D or D.M +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.DatePatterns("it-IT"), ",") ' D/M/Y,D/M + DatePatterns = _PropertyGet("DatePatterns", Region) +End Function ' ScriptForge.SF_Region.DatePatterns (get) + +REM ----------------------------------------------------------------------------- +Property Get DateSeparator(Optional ByVal Region As Variant) As String +''' Returns the separator used in dates applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.DateSeparator("it-IT") ' / + DateSeparator = _PropertyGet("DateSeparator", Region) +End Property ' ScriptForge.SF_Region.DateSeparator (get) + +REM ----------------------------------------------------------------------------- +Public Function DayAbbrevNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of abbreviated names of weekdays applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. The 1st in the list [0] is the Monday. +''' Example: +''' MsgBox Join(Regio.DayAbbrevNames("it-IT"), ",") ' lun,mar,mer,gio,ven,sab,dom + DayAbbrevNames = _PropertyGet("DayAbbrevNames", Region) +End Function ' ScriptForge.SF_Region.DayAbbrevNames (get) + +REM ----------------------------------------------------------------------------- +Public Function DayNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of names of weekdays applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. The 1st in the list [0] is the Monday. +''' Example: +''' MsgBox Join(Regio.DayNames("it-IT"), ",") ' lunedì,martedì,mercoledì,giovedì,venerdì,sabato,domenica + DayNames = _PropertyGet("DayNames", Region) +End Function ' ScriptForge.SF_Region.DayNames (get) + +REM ----------------------------------------------------------------------------- +Public Function DayNarrowNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of initials of weekdays applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. The 1st in the list [0] is the Monday. +''' Example: +''' MsgBox Join(Regio.DayNarrowNames("it-IT"), ",") ' l,m,m,g,v,s,d + DayNarrowNames = _PropertyGet("DayNarrowNames", Region) +End Function ' ScriptForge.SF_Region.DayNarrowNames (get) + +REM ----------------------------------------------------------------------------- +Property Get DecimalPoint(Optional ByVal Region As Variant) As String +''' Returns the decimal separator used in numbers applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.DecimalPoint("it-IT") ' . + DecimalPoint = _PropertyGet("DecimalPoint", Region) +End Property ' ScriptForge.SF_Region.DecimalPoint (get) + +REM ----------------------------------------------------------------------------- +Property Get Language(Optional ByVal Region As Variant) As String +''' Returns the english Language name applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' Example: +''' MsgBox Regio.Language("it-IT") ' Italian + Language = _PropertyGet("Language", Region) +End Property ' ScriptForge.SF_Region.Language (get) + +REM ----------------------------------------------------------------------------- +Property Get ListSeparator(Optional ByVal Region As Variant) As String +''' Returns the separator used in lists applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.ListSeparator("it-IT") ' ; + ListSeparator = _PropertyGet("ListSeparator", Region) +End Property ' ScriptForge.SF_Region.ListSeparator (get) + +REM ----------------------------------------------------------------------------- +Public Function MonthAbbrevNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of abbreviated names of months applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.MonthAbbrevNames("it-IT"), ",") ' gen,feb,mar,apr,mag,giu,lug,ago,set,ott,nov,dic + MonthAbbrevNames = _PropertyGet("MonthAbbrevNames", Region) +End Function ' ScriptForge.SF_Region.MonthAbbrevNames (get) + +REM ----------------------------------------------------------------------------- +Public Function MonthNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of names of months applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.MonthNames("it-IT"), ",") ' gennaio,febbraio,marzo,aprile,maggio,giugno,luglio,agosto,settembre,ottobre,novembre,dicembre + MonthNames = _PropertyGet("MonthNames", Region) +End Function ' ScriptForge.SF_Region.MonthNames (get) + +REM ----------------------------------------------------------------------------- +Public Function MonthNarrowNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of initials of months applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.MonthNarrowNames("it-IT"), ",") ' g,f,m,a,m,g,l,a,s,o,n,d + MonthNarrowNames = _PropertyGet("MonthNarrowNames", Region) +End Function ' ScriptForge.SF_Region.MonthNarrowNames (get) + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_Region" +End Property ' ScriptForge.SF_Region.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Region" +End Property ' ScriptForge.SF_Region.ServiceName + +REM ----------------------------------------------------------------------------- +Property Get ThousandSeparator(Optional ByVal Region As Variant) As String +''' Returns the thousands separator used in numbers applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.ThousandSeparator("it-IT") ' . + ThousandSeparator = _PropertyGet("ThousandSeparator", Region) +End Property ' ScriptForge.SF_Region.ThousandSeparator (get) + +REM ----------------------------------------------------------------------------- +Property Get TimeSeparator(Optional ByVal Region As Variant) As String +''' Returns the separator used to format times applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.TimeSeparator("it-IT") ' : + TimeSeparator = _PropertyGet("TimeSeparator", Region) +End Property ' ScriptForge.SF_Region.TimeSeparator (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function DSTOffset(Optional ByVal LocalDateTime As Variant _ + , Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Integer +''' Computes the additional offset due to daylight saving ("summer time") +''' Args +''' LocalDateTime: local date and time as a Date. DST offset varies during the year. +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The offset in minutes +''' Examples: +''' regio.DSTOffset(DateSerial(2022, 8, 20) + TimeSerial(16, 58, 17), "Europe/Brussels", "fr-BE") ' 60 + +Dim iDSTOffset As Integer ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.DSTOffset" +Const cstSubArgs = "LocalDateTime, TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iDSTOffset = 0 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(LocalDateTime, "LocalDateTime", V_DATE) Then GoTo Finally + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setLocalDateTime(LocaldateTime) + iDSTOffset = .getValue(com.sun.star.i18n.CalendarFieldIndex.DST_OFFSET) + End With + +Finally: + DSTOffset = iDSTOffset + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.DSTOffset + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant _ + , Optional Region As Variant _ + ) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Region: the language-COUNTRY combination (la-CO) or the country (CO- or the language (la) +''' Returns: +''' The actual value of the property +''' Exceptions: +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Region.GetProperty" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If IsMissing(Region) Or IsEmpty(Region) Then Region = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Region, "Region", V_STRING) Then GoTo Catch + End If + +Try: + If Len(Region) = 0 Then + GetProperty = _PropertyGet(PropertyName) + Else + GetProperty = _PropertyGet(PropertyName, Region) + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function LocalDateTime(Optional ByVal UTCDateTime As Variant _ + , Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Date +''' Computes the local date and time from a UTC date and time +''' Args +''' UTCDateTime: the universal date and time to be converted to local time +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The local time converted from the corresponding UTC date and time as a Date +''' If the returned value is before 1900, it is likely that the Locale is not recognized +''' If the returned value matches the local time, it is likely that the timezone is not recognized +''' Examples: +''' regio.LocalDateTime(DateSerial(2022, 3, 20) + TimeSerial(16, 58, 17), "Europe/Brussels", "fr-BE") +''' ' 2022-03-20 17:58:17 + +Dim dLocalDateTime As Double ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.LocalDateTime" +Const cstSubArgs = "UTCDateTime, TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dLocalDateTime = -1 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(LocalDateTime, "LocalDateTime", V_DATE) Then GoTo Finally + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setDateTime(UTCDateTime) + dLocalDateTime = .getLocalDateTime() + End With + +Finally: + LocalDateTime = CDate(dLocalDateTime) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.LocalDateTime + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Region class as an array + + Methods = Array( _ + "DSTOffset" _ + , "LocalDateTime" _ + , "Number2Text" _ + , "TimeZoneOffset" _ + , "UTCDateTime" _ + , "UTCNow" _ + ) + +End Function ' ScriptForge.SF_Region.Methods + +REM ----------------------------------------------------------------------------- +Public Function Number2Text(Optional ByVal Number As Variant _ + , Optional ByVal Locale As Variant _ + ) As String +''' Convert numbers and money amounts in many languages into words +''' Args +''' Number: the number to spell out +''' Accepted types: strings or numeric values (integer or real numbers) +''' When a string, a variety of prefixes is supported +''' The string "help" provides helpful tips about allowed prefixes by language +''' Example for french +''' un, deux, trois +''' feminine: une, deux, trois +''' masculine: un, deux, trois +''' ordinal: premier, deuxième, troisième +''' ordinal-feminine: première, deuxième, troisième +''' ordinal-masculine: premier, deuxième, troisième +''' informal: onze-cents, douze-cents, treize-cents +''' Numbers may be prefixed by ISO currency codes (EUR, USD, ...) +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or language alone (la) +''' The list of supported languages can be found on +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1linguistic2_1_1XNumberText.html +''' Return: +''' The number or amount transformed in words +''' Examples: +''' regio.Number2Text("help", "fr") ' See above +''' regio.Number2Text("79,93", "fr-BE") ' septante-neuf virgule nonante-trois +''' regio.Number2Text(Pi(), "pt-BR") ' três vírgula um quatro um cinco nove dois seis cinco três cinco oito nove sete nove +''' regio.Number2Text("EUR 1234.56", "it") ' milleduecentotrentaquattro euro cinquantasei centesimi + +Dim sNumber2Text As String ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oNumber2Text As Object ' com.sun.star.linguistic2.NumberText +Const cstThisSub = "Region.Number2Text" +Const cstSubArgs = "Number, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sNumber2Text = "" + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC)) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbLanguage := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oNumber2Text = SF_Utils._GetUNOService("Number2Text") + sNumber2Text = oNumber2Text.getNumberText(Number, oLocale) + +Finally: + Number2Text = sNumber2Text + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.Number2Text + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Region class as an array + + Properties = Array( _ + "Country" _ + , "Currency" _ + , "DatePatterns" _ + , "DateSeparator" _ + , "DayAbbrevNames" _ + , "DayNames" _ + , "DayNarrowNames" _ + , "DecimalPoint" _ + , "Language" _ + , "ListSeparator" _ + , "MonthAbbrevNames" _ + , "MonthNames" _ + , "MonthNarrowNames" _ + , "ThousandSeparator" _ + , "TimeSeparator" _ + ) + +End Function ' ScriptForge.SF_Region.Properties + +REM ----------------------------------------------------------------------------- +Public Function TimeZoneOffset(Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Integer +''' Computes the offset between GMT and the given timezone and locale +''' Args +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The offset in minutes +''' Examples: +''' regio.TimeZoneOffset("Europe/Brussels", "fr-BE") ' 60 + +Dim iTimeZoneOffset As Integer ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.TimeZoneOffset" +Const cstSubArgs = "TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iTimeZoneOffset = 0 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + iTimeZoneOffset = .getValue(com.sun.star.i18n.CalendarFieldIndex.ZONE_OFFSET) + End With + +Finally: + TimeZoneOffset = iTimeZoneOffset + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.TimeZoneOffset + +REM ----------------------------------------------------------------------------- +Public Function UTCDateTime(Optional ByVal LocalDateTime As Variant _ + , Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Date +''' Computes the UTC date and time of a given local date and time +''' Args +''' LocalDateTime: the date and time measured in a given timezone +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The local time converted to the corresponding UTC date and time as a Date +''' If the returned value is before 1900, it is likely that the Locale is not recognized +''' If the returned value matches the local time, it is likely that the the timezone is not recognized +''' Examples: +''' regio.UTCDateTime(DateSerial(2022, 3, 20) + TimeSerial(17, 58, 17), "Europe/Brussels", "fr-BE") +''' ' 2022-03-20 16:58:17 + +Dim dUTCDateTime As Double ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.UTCDateTime" +Const cstSubArgs = "LocalDateTime, TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dUTCDateTime = -1 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(LocalDateTime, "LocalDateTime", V_DATE) Then GoTo Finally + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setLocalDateTime(LocalDateTime) + dUTCDateTime = .getDateTime() + End With + +Finally: + UTCDateTime = CDate(dUTCDateTime) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.UTCDateTime + +REM ----------------------------------------------------------------------------- +Public Function UTCNow(Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Date +''' Computes the actual UTC date and time +''' Args +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The actual UTC date and time as a Date +''' If the returned value is before 1900, it is likely that the Locale is not recognized +''' If the returned value matches the local time, it is likely that the the timezone is not recognized +''' Examples: +''' regio.UTCNow("Europe/Brussels", "fr-BE") ' 2022-03-20 16:58:17 + +Dim dUTCNow As Double ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.UTCNow" +Const cstSubArgs = "TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dUTCNow = -1 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setLocalDateTime(Now()) + dUTCNow = .getDateTime() + End With + +Finally: + UTCNow = CDate(dUTCNow) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.UTCNow + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _GetLocale(ByVal psLocale As String _ + , Optional ByVal pbCountry As Variant _ + , Optional ByVal pbLanguage As Variant _ + ) As Object +''' Convert a locale given as a string to a com.sun.star.lang.Locale object +''' Args: +''' psLocale: the input string, as "la-CO", "la" or "CO" +''' pbCountry: True when "CO" only is admitted +''' pbLanguage: True when "la" only is admitted +''' At most one out of pbLanguage or pbCountry may be True +''' Returns: +''' com.sun.star.lang.Locale + +Dim sLocale As String ' "la-CO" +Dim iLocale As Integer ' Index in reference tables +Dim oLocale As Object ' Return value com.sun.star.lang.Locale +Dim i As Integer + + If IsMissing(pbCountry) Or IsEmpty(pbCountry) Then pbCountry = False + If IsMissing(pbLanguage) Or IsEmpty(pbLanguage) Then pbLanguage = False + + _LoadAllLocales() ' Initialize locale reference tables + +Check: + ' The argument may be a language "la", a country "CO" or a Locale "la-CO" + ' Scan the reference tables to find a valid locale as a com.sun.star.lang.Locale + Set oLocale = Nothing : sLocale = "" : iLocale = -1 + If Len(psLocale) = 0 Then ' Default value is the office com.sun.star.i18n.Locale + sLocale = UserLocale + iLocale = UserIndex + ElseIf InStr(psLocale, "-") = 0 Then ' Language only or country only + Select Case True + Case pbLanguage + ' Find any locale having the argument as language + For i = 0 To UBound(LocaleNames) + ' A language is presumed 2 or 3 characters long + If Split(LocaleNames(i), "-")(0) = LCase(psLocale) Then + sLocale = LocaleNames(i) + iLocale = i + Exit For + End If + Next i + Case pbCountry + ' Find any locale having the argument as country + For i = 0 To UBound(LocaleNames) + ' A country is presumed exactly 2 characters long + If Right(LocaleNames(i), 2) = UCase(psLocale) Then + sLocale = LocaleNames(i) + iLocale = i + Exit For + End If + Next i + Case Else + End Select + Else ' A full locale is given + iLocale = SF_Array.IndexOf(LocaleNames, psLocale, CaseSensitive := False) + If iLocale >= 0 Then sLocale = LocaleNames(iLocale) + End If + +Try: + ' Build error message when relevant + If iLocale < 0 Then + If Not SF_Utils._Validate(psLocale, "Locale", V_STRING, LocaleNames) Then GoTo Finally + Else + Set oLocale = CreateUnoStruct("com.sun.star.lang.Locale") + oLocale.Language = Split(sLocale, "-")(0) ' A language is 2 or 3 characters long + oLocale.Country = Right(sLocale, 2) + End If + +Finally: + Set _GetLocale = oLocale + Exit Function +End Function ' ScriptForge.SF_Region._GetLocale + +REM ----------------------------------------------------------------------------- +Private Sub _LoadAllLocales() +''' Initialize the LocaleNames array = the list of all available locales in the LibreOffice installation + +Dim oOffice As Object ' com.sun.star.lang.Locale +Dim vLocales As Variant ' Array of com.sun.star.lang.Locale +Dim iTop As Integer ' Upper bound of LocaleNames +Dim i As Integer + +Try: + ' Office locale + If Len(UserLocale) = 0 Then + Set oOffice = SF_Utils._GetUNOService("OfficeLocale") + UserLocale = oOffice.Language & "-" & oOffice.Country + End If + + ' LocaleData, localeNames and UserIndex + If IsEmpty(LocaleData) Or IsNull(LocaleData) Or Not IsArray(LocaleNames) Then + LocaleData = SF_Utils._GetUNOService("LocaleData") + vLocales = LocaleData.getAllInstalledLocaleNames() + LocaleNames = Array() + iTop = UBound(vLocales) + ReDim LocaleNames(0 To iTop) + For i = 0 To iTop + LocaleNames(i) = vLocales(i).Language & "-" & vLocales(i).Country + If LocaleNames(i) = UserLocale Then UserIndex = i + Next i + End If + +End Sub ' ScriptForge.SF_Region._LoadAllLocales + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String _ + , Optional ByVal pvLocale As Variant) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property +''' pvLocale: a locale in the form language-COUNTRY (la-CO) or language only, or country only +''' When language or country only, any locale matching either the language or the country is selected + +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim vCurrencies As Variant ' Array of com.sun.star.i18n.Currency +Dim oCurrency As Object ' com.sun.star.i18n.Currency +Dim oLanguageCountryInfo As Object ' com.sun.star.i18n.LanguageCountryInfo +Dim oLocaleDataItem2 As Object ' com.sun.star.i18n.LocaleDataItem2 +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Dim oCalItem As Object ' com.sun.star.i18n.CalendarItem2 +Dim vCalItems() As Variant ' Array of days/months +Dim i As Integer, j As Integer + +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "Region.Get" & psProperty + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + If IsMissing(pvLocale) Or IsEmpty(pvLocale) Then pvLocale = "" + If Not SF_Utils._Validate(pvLocale, "Locale", V_STRING) Then GoTo Finally + + Select Case psProperty + Case "Currency", "Country" + Set oLocale = SF_Region._GetLocale(pvLocale, pbCountry := True) ' Country only is admitted + Case "Language", "DayNames", "DayAbbrevNames", "DayNarrowNames" _ + , "MonthNames", "MonthAbbrevNames", "MonthNarrowNames" + Set oLocale = SF_Region._GetLocale(pvLocale, pbLanguage := True) ' Language only is admitted + Case Else + Set oLocale = SF_Region._GetLocale(pvLocale) + End Select + If IsNull(oLocale) Then GoTo Finally + +Try: + Select Case psProperty + Case "Country", "Language" + Set oLanguageCountryInfo = LocaleData.getLanguageCountryInfo(oLocale) + With oLanguageCountryInfo + If psProperty = "Country" Then _PropertyGet = .CountryDefaultName Else _PropertyGet = .LanguageDefaultName + End With + Case "Currency" + vCurrencies = LocaleData.getAllCurrencies(oLocale) + _PropertyGet = "" + For Each oCurrency In vCurrencies + If oCurrency.Default Then + _PropertyGet = oCurrency.BankSymbol + Exit For + End If + Next oCurrency + Case "DatePatterns" + _PropertyGet = LocaleData.getDateAcceptancePatterns(oLocale) + Case "DateSeparator", "DecimalPoint", "ListSeparator", "ThousandSeparator", "TimeSeparator" + Set oLocaleDataItem2 = LocaleData.getLocaleItem2(oLocale) + With oLocaleDataItem2 + Select Case psProperty + Case "DateSeparator" : _PropertyGet = .dateSeparator + Case "DecimalPoint" : _PropertyGet = .decimalSeparator + Case "ListSeparator" : _PropertyGet = .listSeparator + Case "ThousandSeparator" : _PropertyGet = .thousandSeparator + Case "TimeSeparator" : _PropertyGet = .timeSeparator + End Select + End With + Case "DayAbbrevNames", "DayNames", "DayNarrowNames" + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendar(oLocale) + vCalItems = Array() : ReDim vCalItems(0 To 6) + For i = 0 To UBound(.Days2) + Set oCalItem = .Days2(i) + j = Iif(i = 0, 6, i - 1) + Select Case psProperty + Case "DayNames" : vCalItems(j) = oCalItem.FullName + Case "DayAbbrevNames" : vCalItems(j) = oCalItem.AbbrevName + Case "DayNarrowNames" : vCalItems(j) = oCalItem.NarrowName + End Select + Next i + _PropertyGet = vCalItems + End With + Case "MonthAbbrevNames", "MonthNames", "MonthNarrowNames" + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendar(oLocale) + vCalItems = Array() : ReDim vCalItems(0 To 11) + For i = 0 To UBound(.Months2) + Set oCalItem = .Months2(i) + Select Case psProperty + Case "MonthNames" : vCalItems(i) = oCalItem.FullName + Case "MonthAbbrevNames" : vCalItems(i) = oCalItem.AbbrevName + Case "MonthNarrowNames" : vCalItems(i) = oCalItem.NarrowName + End Select + Next i + _PropertyGet = vCalItems + End With + Case Else + _PropertyGet = "" + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Region._PropertyGet + +REM ================================================ END OF SCRIPTFORGE.SF_REGION +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Root.xba b/wizards/source/scriptforge/SF_Root.xba new file mode 100644 index 000000000..4db0efb42 --- /dev/null +++ b/wizards/source/scriptforge/SF_Root.xba @@ -0,0 +1,1070 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Root" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule +Option Private Module + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Root +''' ======= +''' FOR INTERNAL USE ONLY +''' Singleton class holding all persistent variables shared +''' by all the modules of the ScriptForge library +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ============================================================= PRIVATE MEMBERS + +' Internals +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be "ROOT" +Private MainFunction As String ' Name of method or property called by user script +Private MainFunctionArgs As String ' Syntax of method called by user script +Private StackLevel As Integer ' Depth of calls between internal methods + +' Error management +Private ErrorHandler As Boolean ' True = error handling active, False = internal debugging +Private ConsoleLines() As Variant ' Array of messages displayable in console +Private ConsoleDialog As Object ' SFDialogs.Dialog object +Private ConsoleControl As Object ' SFDialogs.DialogControl object +Private DisplayEnabled As Boolean ' When True, display of console or error messages is allowed +Private StopWhenError As Boolean ' When True, process stops after error > "WARNING" +Private TriggeredByPython As Boolean ' When True, the actual user script is a Python script +Private DebugMode As Boolean ' When True, log enter/exit each official Sub + +' Progress and status bars +Private ProgressBarDialog As Object ' SFDialogs.Dialog object +Private ProgressBarText As Object ' SFDialogs.DialogControl object +Private ProgressBarBar As Object ' SFDialogs.DialogControl object +Private Statusbar As Object + +' Services management +Private ServicesList As Variant ' Dictionary of provided services + +' Usual UNO services +Private FunctionAccess As Object ' com.sun.star.sheet.FunctionAccess +Private PathSettings As Object ' com.sun.star.util.PathSettings +Private PathSubstitution As Object ' com.sun.star.util.PathSubstitution +Private ScriptProvider As Object ' com.sun.star.script.provider.MasterScriptProviderFactory +Private SystemShellExecute As Object ' com.sun.star.system.SystemShellExecute +Private CoreReflection As Object ' com.sun.star.reflection.CoreReflection +Private DispatchHelper As Object ' com.sun.star.frame.DispatchHelper +Private TextSearch As Object ' com.sun.star.util.TextSearch +Private SearchOptions As Object ' com.sun.star.util.SearchOptions +Private SystemLocale As Object ' com.sun.star.lang.Locale +Private OfficeLocale As Object ' com.sun.star.lang.Locale +Private FormatLocale As Object ' com.sun.star.lang.Locale +Private LocaleData As Object ' com.sun.star.i18n.LocaleData +Private CalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Private Number2Text As Object ' com.sun.star.linguistic2.NumberText +Private PrinterServer As Object ' com.sun.star.awt.PrinterServer +Private CharacterClass As Object ' com.sun.star.i18n.CharacterClassification +Private FileAccess As Object ' com.sun.star.ucb.SimpleFileAccess +Private FilterFactory As Object ' com.sun.star.document.FilterFactory +Private FolderPicker As Object ' com.sun.star.ui.dialogs.FolderPicker +Private FilePicker As Object ' com.sun.star.ui.dialogs.FilePicker +Private URLTransformer As Object ' com.sun.star.util.URLTransformer +Private Introspection As Object ' com.sun.star.beans.Introspection +Private BrowseNodeFactory As Object ' com.sun.star.script.browse.BrowseNodeFactory +Private DatabaseContext As Object ' com.sun.star.sdb.DatabaseContext +Private ConfigurationProvider _ + As Object ' com.sun.star.configuration.ConfigurationProvider +Private PackageProvider As Object ' com.sun.star.comp.deployment.PackageInformationProvider +Private MailService As Object ' com.sun.star.system.SimpleCommandMail or com.sun.star.system.SimpleSystemMail +Private GraphicExportFilter As Object ' com.sun.star.drawing.GraphicExportFilter +Private Toolkit As Object ' com.sun.star.awt.Toolkit + +' Specific persistent services objects or properties +Private FileSystemNaming As String ' If "SYS", file and folder naming is based on operating system notation +Private PythonHelper As String ' File name of Python helper functions (stored in $(inst)/share/Scripts/python) +Private PythonHelper2 As String ' Alternate Python helper file name for test purposes +Private LocalizedInterface As Object ' ScriptForge own L10N service +Private OSName As String ' WIN, LINUX, MACOS +Private SFDialogs As Variant ' Persistent storage for the SFDialogs library +Private SFForms As Variant ' Persistent storage for the SF_Form class in the SFDocuments library +Private PythonStorage As Variant ' Persistent storage for the objects created and processed in Python +Private PythonPermanent As Long ' Number of permanent entries in PythonStorage containing standard module objects + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "ROOT" + MainFunction = "" + MainFunctionArgs = "" + StackLevel = 0 + ErrorHandler = True + ConsoleLines = Array() + Set ConsoleDialog = Nothing + Set ConsoleControl = Nothing + DisplayEnabled = True + StopWhenError = True + TriggeredByPython = False + DebugMode = False + Set ProgressBarDialog = Nothing + Set ProgressBarText = Nothing + Set progressBarBar = Nothing + Set Statusbar = Nothing + ServicesList = Empty + Set FunctionAccess = Nothing + Set PathSettings = Nothing + Set PathSubstitution = Nothing + Set ScriptProvider = Nothing + Set SystemShellExecute = Nothing + Set CoreReflection = Nothing + Set DispatchHelper = Nothing + Set TextSearch = Nothing + Set SearchOptions = Nothing + Set SystemLocale = Nothing + Set OfficeLocale = Nothing + Set FormatLocale = Nothing + Set LocaleData = Nothing + Set CalendarImpl = Nothing + Set Number2Text = Nothing + Set PrinterServer = Nothing + Set CharacterClass = Nothing + Set FileAccess = Nothing + Set FilterFactory = Nothing + Set FolderPicker = Nothing + Set FilePicker = Nothing + Set URLTransformer = Nothing + Set Introspection = Nothing + FileSystemNaming = "ANY" + PythonHelper = "ScriptForgeHelper.py" + PythonHelper2 = "" + Set LocalizedInterface = Nothing + Set BrowseNodeFactory = Nothing + Set DatabaseContext = Nothing + Set ConfigurationProvider = Nothing + Set PackageProvider = Nothing + Set MailService = Nothing + Set GraphicExportFilter = Nothing + Set Toolkit = Nothing + OSName = "" + SFDialogs = Empty + SFForms = Empty + PythonStorage = Empty + PythonPermanent = -1 +End Sub ' ScriptForge.SF_Root Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' ScriptForge.SF_Root Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' ScriptForge.SF_Root Explicit destructor + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Sub _AddToConsole(ByVal psLine As String) +''' Add a new line to the console +''' TAB characters are expanded before the insertion of the line +''' NB: Array redimensioning of a member of an object must be done in the class module +''' Args: +''' psLine: the line to add + +Dim lConsole As Long ' UBound of ConsoleLines +Dim sLine As String ' Alias of psLine + + ' Resize ConsoleLines + lConsole = UBound(ConsoleLines) + If lConsole < 0 Then + ReDim ConsoleLines(0) + Else + ReDim Preserve ConsoleLines(0 To lConsole + 1) + End If + + ' Add a timestamp to the line and insert it (without date) + sLine = Mid(SF_Utils._Repr(Now()), 12) & " -> " & psLine + ConsoleLines(lConsole + 1) = sLine + + ' Add the new line to the actual (probably non-modal) console, if active + If Not IsNull(ConsoleDialog) Then + If ConsoleDialog._IsStillAlive(False) Then ' False to not raise an error + If IsNull(ConsoleControl) Then Set ConsoleControl = ConsoleDialog.Controls(SF_Exception.CONSOLENAME) ' Should not happen ... + ConsoleControl.WriteLine(sLine) + End If + End If + +End Sub ' ScriptForge.SF_Root._AddToConsole + +REM ----------------------------------------------------------------------------- +Public Function _AddToPythonStorage(ByRef poObject As Object) As Long +''' Insert a newly created object in the Python persistent storage +''' and return the index of the used entry +''' The persistent storage is a simple array of objects +''' Args: +''' poObject: the object to insert + +Dim lIndex As Long ' Return value +Dim lSize As Long ' UBound of the persistent storage +Dim i As Long + +Check: + lIndex = -1 + If IsNull(poObject) Then Exit Function + On Local Error GoTo Finally + lSize = UBound(PythonStorage) + +Try: + ' Can an empty entry be reused ? + For i = PythonPermanent + 1 To lSize + If IsNull(PythonStorage(i)) Then + lIndex = i + Exit For + End If + Next i + + ' Resize Python storage if no empty space + If lIndex < 0 Then + lSize = lSize + 1 + ReDim Preserve PythonStorage(0 To lSize) + lIndex = lSize + End If + + ' Insert new object + Set PythonStorage(lIndex) = poObject + +Finally: + _AddToPythonStorage = lIndex + Exit Function +End Function ' ScriptForge.SF_Root._AddToPythonStorage + +REM ------------------------------------------------------------------------------ +Public Function _GetLocalizedInterface() As Object +''' Returns the LN object instance related to the ScriptForge internal localization +''' If not yet done, load it from the shipped po files +''' Makes that the localized user interface is loaded only when needed + +Try: + If IsNull(LocalizedInterface) Then _LoadLocalizedInterface() + +Finally: + Set _GetLocalizedInterface = LocalizedInterface + Exit Function +End Function ' ScriptForge.SF_Root._GetLocalizedInterface + +REM ----------------------------------------------------------------------------- +Public Sub _InitPythonStorage() +''' Make PythonStorage an array +''' In prevision to an abundant use of those objects in Python, hardcode to optimize the performance and memory : +''' Initialize the first entries with the standard module objects located in the ScriptForge library + +Try: + If Not IsArray(PythonStorage) Then + PythonPermanent = 8 + PythonStorage = Array() + ReDim PythonStorage(0 To PythonPermanent) + ' Initialize each entry + PythonStorage(0) = ScriptForge.SF_Array + PythonStorage(1) = ScriptForge.SF_Exception + PythonStorage(2) = ScriptForge.SF_FileSystem + PythonStorage(3) = ScriptForge.SF_Platform + PythonStorage(4) = ScriptForge.SF_Region + PythonStorage(5) = ScriptForge.SF_Services + PythonStorage(6) = ScriptForge.SF_Session + PythonStorage(7) = ScriptForge.SF_String + PythonStorage(8) = ScriptForge.SF_UI + End If + +Finally: + Exit Sub +End Sub ' ScriptForge.SF_Root._InitPythonStorage + +REM ----------------------------------------------------------------------------- +Public Sub _LoadLocalizedInterface(Optional ByVal psMode As String) +''' Build the user interface in a persistent L10N object +''' Executed - only once - at first request of a label inside the LocalizedInterface dictionary +''' Args: +''' psMode: ADDTEXT => the (english) labels are loaded from code below +''' POFILE => the localized labels are loaded from a PO file +''' the name of the file is "la.po" where la = language part of locale +''' (fallback to ADDTEXT mode if file does not exist) + +Dim sInstallFolder As String ' ScriptForge installation directory +Dim sPOFolder As String ' Folder containing the PO files +Dim sPOFile As String ' PO File to load +Dim sLocale As String ' Locale + + If ErrorHandler Then On Local Error GoTo Catch + +Try: + 'TODO: Modify default value + If IsMissing(psMode) Then psMode = "POFILE" + + If psMode = "POFILE" Then ' Use this mode in production + ' Build the po file name + With SF_FileSystem + sInstallFolder = ._SFInstallFolder() ' ScriptForge installation folder + sLocale = SF_Utils._GetUNOService("OfficeLocale").Language + sPOFolder = .BuildPath(sInstallFolder, "po") + sPOFile = .BuildPath(sPOFolder, sLocale & ".po") + If sLocale = "en" Then ' LocalizedInterface loaded by code i.o. read from po file + psMode = "ADDTEXT" + ElseIf Not .FileExists(sPOFile) Then ' File not found => load texts from code below + psMode = "ADDTEXT" + Else + Set LocalizedInterface = CreateScriptService("L10N", sPOFolder, sLocale) + End If + End With + End If + + If psMode = "ADDTEXT" Then ' Use this mode in development to prepare a new POT file + Set LocalizedInterface = CreateScriptService("L10N") + With LocalizedInterface + ' SF_Exception.Raise + .AddText( Context := "ERRORNUMBER" _ + , MsgId := "Error %1" _ + , Comment := "Title in error message box\n" _ + & "%1: an error number" _ + ) + .AddText( Context := "ERRORLOCATION" _ + , MsgId := "Location : %1" _ + , Comment := "Error message box\n" _ + & "%1: a line number" _ + ) + .AddText( Context := "LONGERRORDESC" _ + , MsgId := "Error %1 - Location = %2 - Description = %3" _ + , Comment := "Logfile record" _ + ) + .AddText( Context := "STOPEXECUTION" _ + , MsgId := "THE EXECUTION IS CANCELLED." _ + , Comment := "Any blocking error message" _ + ) + .AddText( Context := "NEEDMOREHELP" _ + , MsgId := "Do you want to receive more information about the '%1' method ?" _ + , Comment := "Any blocking error message\n" _ + & "%1: a method name" _ + ) + ' SF_Exception.RaiseAbort + .AddText( Context := "INTERNALERROR" _ + , MsgId := "The ScriptForge library has crashed. The reason is unknown.\n" _ + & "Maybe a bug that could be reported on\n" _ + & "\thttps://bugs.documentfoundation.org/\n\n" _ + & "More details : \n\n" _ + , Comment := "SF_Exception.RaiseAbort error message" _ + ) + ' SF_Utils._Validate + .AddText( Context := "VALIDATESOURCE" _ + , MsgId := "Library : \t%1\nService : \t%2\nMethod : \t%3" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: probably ScriptForge\n" _ + & "%2: service or module name\n" _ + & "%3: property or method name where the error occurred" _ + ) + .AddText( Context := "VALIDATEARGS" _ + , MsgId := "Arguments: %1" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: list of arguments of the method" _ + ) + .AddText( Context := "VALIDATEERROR" _ + , MsgId := "A serious error has been detected in your code on argument : « %1 »." _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name" _ + ) + .AddText( Context := "VALIDATIONRULES" _ + , MsgId := "\tValidation rules :", Comment := "SF_Utils.Validate error message" _ + ) + .AddText( Context := "VALIDATETYPES" _ + , MsgId := "\t\t« %1 » must have next type (or one of next types) : %2" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: Comma separated list of allowed types" _ + ) + .AddText( Context := "VALIDATEVALUES" _ + , MsgId := "\t\t« %1 » must contain one of next values : %2" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: Comma separated list of allowed values" _ + ) + .AddText( Context := "VALIDATEREGEX" _ + , MsgId := "\t\t« %1 » must match next regular expression : %2" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: A regular expression" _ + ) + .AddText( Context := "VALIDATECLASS" _ + , MsgId := "\t\t« %1 » must be a Basic object of class : %2" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: The name of a Basic class" _ + ) + .AddText( Context := "VALIDATEACTUAL" _ + , MsgId := "The actual value of « %1 » is : '%2'" _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: The value of the argument as a string" _ + ) + .AddText( Context := "VALIDATEMISSING" _ + , MsgId := "The « %1 » argument is mandatory, yet it is missing." _ + , Comment := "SF_Utils._Validate error message\n" _ + & "%1: Wrong argument name" _ + ) + ' SF_Utils._ValidateArray + .AddText( Context := "VALIDATEARRAY" _ + , MsgId := "\t\t« %1 » must be an array." _ + , Comment := "SF_Utils._ValidateArray error message\n" _ + & "%1: Wrong argument name" _ + ) + .AddText( Context := "VALIDATEDIMS" _ + , MsgId := "\t\t« %1 » must have exactly %2 dimension(s)." _ + , Comment := "SF_Utils._ValidateArray error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: Number of dimensions of the array" _ + ) + .AddText( Context := "VALIDATEALLTYPES" _ + , MsgId := "\t\t« %1 » must have all elements of the same type : %2" _ + , Comment := "SF_Utils._ValidateArray error message\n" _ + & "%1: Wrong argument name\n" _ + & "%2: Either one single type or 'String, Date, Numeric'" _ + ) + .AddText( Context := "VALIDATENOTNULL" _ + , MsgId := "\t\t« %1 » must not contain any NULL or EMPTY elements." _ + , Comment := "SF_Utils._ValidateArray error message\n" _ + & "%1: Wrong argument name\n" _ + & "NULL and EMPTY should not be translated" _ + ) + ' SF_Utils._ValidateFile + .AddText( Context := "VALIDATEFILE" _ + , MsgId := "\t\t« %1 » must be of type String." _ + , Comment := "SF_Utils._ValidateFile error message\n" _ + & "%1: Wrong argument name\n" _ + & "'String' should not be translated" _ + ) + .AddText( Context := "VALIDATEFILESYS" _ + , MsgId := "\t\t« %1 » must be a valid file or folder name expressed in the operating system native notation." _ + , Comment := "SF_Utils._ValidateFile error message\n" _ + & "%1: Wrong argument name" _ + ) + .AddText( Context := "VALIDATEFILEURL" _ + , MsgId := "\t\t« %1 » must be a valid file or folder name expressed in the portable URL notation." _ + , Comment := "SF_Utils._ValidateFile error message\n" _ + & "%1: Wrong argument name\n" _ + & "'URL' should not be translated" _ + ) + .AddText( Context := "VALIDATEFILEANY" _ + , MsgId := "\t\t« %1 » must be a valid file or folder name." _ + , Comment := "SF_Utils._ValidateFile error message\n" _ + & "%1: Wrong argument name" _ + ) + .AddText( Context := "VALIDATEWILDCARD" _ + , MsgId := "\t\t« %1 » may contain one or more wildcard characters (?, *) in its last path component only." _ + , Comment := "SF_Utils._ValidateFile error message\n" _ + & "%1: Wrong argument name\n" _ + & "'(?, *)' is to be left as is" _ + ) + ' SF_Array.RangeInit + .AddText( Context := "ARRAYSEQUENCE" _ + , MsgId := "The respective values of 'From', 'UpTo' and 'ByStep' are incoherent.\n\n" _ + & "\t« From » = %1\n" _ + & "\t« UpTo » = %2\n" _ + & "\t« ByStep » = %3" _ + , Comment := "SF_Array.RangeInit error message\n" _ + & "%1, %2, %3: Numeric values\n" _ + & "'From', 'UpTo', 'ByStep' should not be translated" _ + ) + ' SF_Array.AppendColumn, AppendRow, PrependColumn, PrependRow + .AddText( Context := "ARRAYINSERT" _ + , MsgId := "The array and the vector to insert have incompatible sizes.\n\n" _ + & "\t« Array_2D » = %2\n" _ + & "\t« %1 » = %3" _ + , Comment := "SF_Array.AppendColumn (...) error message\n" _ + & "%1: 'Column' or 'Row' of a matrix\n" _ + & "%2, %3: array contents\n" _ + & "'Array_2D' should not be translated" _ + ) + ' SF_Array.ExtractColumn, ExtractRow + .AddText( Context := "ARRAYINDEX1" _ + , MsgId := "The given index does not fit within the bounds of the array.\n\n" _ + & "\t« Array_2D » = %2\n" _ + & "\t« %1 » = %3" _ + , Comment := "SF_Array.ExtractColumn (...) error message\n" _ + & "%1: 'Column' or 'Row' of a matrix\n" _ + & "%2, %3: array contents\n" _ + & "'Array_2D' should not be translated" _ + ) + ' SF_Array.ExtractColumn, ExtractRow + .AddText( Context := "ARRAYINDEX2" _ + , MsgId := "The given slice limits do not fit within the bounds of the array.\n\n" _ + & "\t« Array_1D » = %1\n" _ + & "\t« From » = %2\n" _ + & "\t« UpTo » = %3" _ + , Comment := "SF_Array.ExtractColumn (...) error message\n" _ + & "%1: 'Column' or 'Row' of a matrix\n" _ + & "%2, %3: array contents\n" _ + & "'Array_1D', 'From' and 'UpTo' should not be translated" _ + ) + ' SF_Array.ImportFromCSVFile + .AddText( Context := "CSVPARSING" _ + , MsgId := "The given file could not be parsed as a valid CSV file.\n\n" _ + & "\t« File name » = %1\n" _ + & "\tLine number = %2\n" _ + & "\tContent = %3" _ + , Comment := "SF_Array.ImportFromCSVFile error message\n" _ + & "%1: a file name\n" _ + & "%2: numeric\n" _ + & "%3: a long string" _ + ) + ' SF_Dictionary.Add/ReplaceKey + .AddText( Context := "DUPLICATEKEY" _ + , MsgId := "The insertion of a new key " _ + & "into a dictionary failed because the key already exists.\n" _ + & "Note that the comparison between keys is NOT case-sensitive.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_Dictionary Add/ReplaceKey error message\n" _ + & "%1: An identifier" _ + & "%2: a (potentially long) string" _ + ) + ' SF_Dictionary.Remove/ReplaceKey/ReplaceItem + .AddText( Context := "UNKNOWNKEY" _ + , MsgId := "The requested key does not exist in the dictionary.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_Dictionary Remove/ReplaceKey/ReplaceItem error message\n" _ + & "%1: An identifier" _ + & "%2: a (potentially long) string" _ + ) + ' SF_Dictionary.Add/ReplaceKey + .AddText( Context := "INVALIDKEY" _ + , MsgId := "The insertion or the update of an entry " _ + & "into a dictionary failed because the given key contains only spaces." _ + , Comment := "SF_Dictionary Add/ReplaceKey error message\n" _ + ) + ' SF_FileSystem.CopyFile/MoveFile/DeleteFile/CreateScriptService("L10N") + .AddText( Context := "UNKNOWNFILE" _ + , MsgId := "The given file could not be found on your system.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/delete error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name" _ + ) + ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders + .AddText( Context := "UNKNOWNFOLDER" _ + , MsgId := "The given folder could not be found on your system.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/delete error message\n" _ + & "%1: An identifier\n" _ + & "%2: A folder name" _ + ) + ' SF_FileSystem.CopyFile/MoveFolder/DeleteFile + .AddText( Context := "NOTAFILE" _ + , MsgId := "« %1 » contains the name of an existing folder, not that of a file.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/delete error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name" _ + ) + ' SF_FileSystem.CopyFolder/MoveFolder/DeleteFolder/Files/SubFolders + .AddText( Context := "NOTAFOLDER" _ + , MsgId := "« %1 » contains the name of an existing file, not that of a folder.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/delete error message\n" _ + & "%1: An identifier\n" _ + & "%2: A folder name" _ + ) + ' SF_FileSystem.Copy+Move/File+Folder/CreateTextFile/OpenTextFile + .AddText( Context := "OVERWRITE" _ + , MsgId := "You tried to create a new file which already exists. Overwriting it has been rejected.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/... error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name" _ + ) + ' SF_FileSystem.Copy+Move+Delete/File+Folder + .AddText( Context := "READONLY" _ + , MsgId := "Copying or moving a file to a destination which has its read-only attribute set, or deleting such a file or folder is forbidden.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/delete error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name" _ + ) + ' SF_FileSystem.Copy+Move+Delete/File+Folder + .AddText( Context := "NOFILEMATCH" _ + , MsgId := "When « %1 » contains wildcards. at least one file or folder must match the given filter. Otherwise the operation is rejected.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem copy/move/delete error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file or folder name with wildcards" _ + ) + ' SF_FileSystem.CreateFolder + .AddText( Context := "FOLDERCREATION" _ + , MsgId := "« %1 » contains the name of an existing file or an existing folder. The operation is rejected.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_FileSystem CreateFolder error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file or folder name" _ + ) + ' SF_Services.CreateScriptService + .AddText( Context := "UNKNOWNSERVICE" _ + , MsgId := "No service named '%4' has been registered for the library '%3'.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_Services.CreateScriptService error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: A Basic library name\n" _ + & "%4: A service (1 word) name" _ + ) + ' SF_Services.CreateScriptService + .AddText( Context := "SERVICESNOTLOADED" _ + , MsgId := "The library '%3' and its services could not been loaded.\n" _ + & "The reason is unknown.\n" _ + & "However, checking the '%3.SF_Services.RegisterScriptServices()' function and its return value can be a good starting point.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_Services.CreateScriptService error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: A Basic library name" _ + ) + ' SF_Session.ExecuteCalcFunction + .AddText( Context := "CALCFUNC" _ + , MsgId := "The Calc '%1' function encountered an error. Either the given function does not exist or its arguments are invalid." _ + , Comment := "SF_Session.ExecuteCalcFunction error message\n" _ + & "'Calc' should not be translated" _ + ) + ' SF_Session._GetScript + .AddText( Context := "NOSCRIPT" _ + , MsgId := "The requested %1 script could not be located in the given libraries and modules.\n" _ + & "« %2 » = %3\n" _ + & "« %4 » = %5" _ + , Comment := "SF_Session._GetScript error message\n" _ + & "%1: 'Basic' or 'Python'\n" _ + & "%2: An identifier\n" _ + & "%3: A string\n" _ + & "%4: An identifier\n" _ + & "%5: A string" _ + ) + ' SF_Session.ExecuteBasicScript + .AddText( Context := "SCRIPTEXEC" _ + , MsgId := "An exception occurred during the execution of the Basic script.\n" _ + & "Cause: %3\n" _ + & "« %1 » = %2" _ + , Comment := "SF_Session.ExecuteBasicScript error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: A (long) string" _ + ) + ' SF_Session.SendMail + .AddText( Context := "WRONGEMAIL" _ + , MsgId := "One of the email addresses has been found invalid.\n" _ + & "Invalid mail = « %1 »" _ + , Comment := "SF_Session.SendMail error message\n" _ + & "%1 = a mail address" _ + ) + ' SF_Session.SendMail + .AddText( Context := "SENDMAIL" _ + , MsgId := "The message could not be sent due to a system error.\n" _ + & "A possible cause is that LibreOffice could not find any mail client." _ + , Comment := "SF_Session.SendMail error message" _ + ) + ' SF_TextStream._IsFileOpen + .AddText( Context := "FILENOTOPEN" _ + , MsgId := "The requested file operation could not be executed because the file was closed previously.\n\n" _ + & "File name = '%1'" _ + , Comment := "SF_TextStream._IsFileOpen error message\n" _ + & "%1: A file name" _ + ) + ' SF_TextStream._IsFileOpen + .AddText( Context := "FILEOPENMODE" _ + , MsgId := "The requested file operation could not be executed because it is incompatible with the mode in which the file was opened.\n\n" _ + & "File name = '%1'\n" _ + & "Open mode = %2" _ + , Comment := "SF_TextStream._IsFileOpen error message\n" _ + & "%1: A file name\n" _ + & "%2: READ, WRITE or APPEND" _ + ) + ' SF_TextStream.ReadLine, ReadAll, SkipLine + .AddText( Context := "ENDOFFILE" _ + , MsgId := "The requested file read operation could not be completed because an unexpected end-of-file was encountered.\n\n" _ + & "File name = '%1'" _ + , Comment := "SF_TextStream.ReadLine/ReadAll/SkipLine error message\n" _ + & "%1: A file name" _ + ) + ' SF_UI.Document + .AddText( Context := "DOCUMENT" _ + , MsgId := "The requested document could not be found.\n\n" _ + & "%1 = '%2'" _ + , Comment := "SF_UI.GetDocument error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string" _ + ) + ' SF_UI.Create + .AddText( Context := "DOCUMENTCREATION" _ + , MsgId := "The creation of a new document failed.\n" _ + & "Something must be wrong with some arguments.\n\n" _ + & "Either the document type is unknown, or no template file was given,\n" _ + & "or the given template file was not found on your system.\n\n" _ + & "%1 = '%2'\n" _ + & "%3 = '%4'" _ + , Comment := "SF_UI.GetDocument error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A string" _ + ) + ' SF_UI.OpenDocument + .AddText( Context := "DOCUMENTOPEN" _ + , MsgId := "The opening of the document failed.\n" _ + & "Something must be wrong with some arguments.\n\n" _ + & "Either the file does not exist, or the password is wrong, or the given filter is invalid.\n\n" _ + & "%1 = '%2'\n" _ + & "%3 = '%4'\n" _ + & "%5 = '%6'" _ + , Comment := "SF_UI.OpenDocument error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A string\n" _ + & "%5: An identifier\n" _ + & "%6: A string" _ + ) + ' SF_UI.OpenBaseDocument + .AddText( Context := "BASEDOCUMENTOPEN" _ + , MsgId := "The opening of the Base document failed.\n" _ + & "Something must be wrong with some arguments.\n\n" _ + & "Either the file does not exist, or the file is not registered under the given name.\n\n" _ + & "%1 = '%2'\n" _ + & "%3 = '%4'" _ + , Comment := "SF_UI.OpenDocument error message\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A string" _ + ) + ' SF_Document._IsStillAlive + .AddText( Context := "DOCUMENTDEAD" _ + , MsgId := "The requested action could not be executed because the document was closed inadvertently.\n\n" _ + & "The concerned document is '%1'" _ + , Comment := "SF_Document._IsStillAlive error message\n" _ + & "%1: A file name" _ + ) + ' SF_Document.Save + .AddText( Context := "DOCUMENTSAVE" _ + , MsgId := "The document could not be saved.\n" _ + & "Either the document has been opened read-only, or the destination file has a read-only attribute set, " _ + & "or the file where to save to is undefined.\n\n" _ + & "%1 = '%2'" _ + , Comment := "SF_Document.SaveAs error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name\n" _ + ) + ' SF_Document.SaveAs + .AddText( Context := "DOCUMENTSAVEAS" _ + , MsgId := "The document could not be saved.\n" _ + & "Either the document must not be overwritten, or the destination file has a read-only attribute set, " _ + & "or the given filter is invalid.\n\n" _ + & "%1 = '%2'\n" _ + & "%3 = %4\n" _ + & "%5 = '%6'" _ + , Comment := "SF_Document.SaveAs error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name\n" _ + & "%3: An identifier\n" _ + & "%4: True or False\n" _ + & "%5: An identifier\n" _ + & "%6: A string" _ + ) + ' SF_Document.any update + .AddText( Context := "DOCUMENTREADONLY" _ + , MsgId := "You tried to edit a document which is not modifiable. The document has not been changed.\n\n" _ + & "« %1 » = %2" _ + , Comment := "SF_Document any update\n" _ + & "%1: An identifier\n" _ + & "%2: A file name" _ + ) + ' SF_Base.GetDatabase + .AddText( Context := "DBCONNECT" _ + , MsgId := "The database related to the actual Base document could not be retrieved.\n" _ + & "Check the connection/login parameters.\n\n" _ + & "« %1 » = '%2'\n" _ + & "« %3 » = '%4'\n" _ + & "« Document » = %5" _ + , Comment := "SF_Base GetDatabase\n" _ + & "%1: An identifier\n" _ + & "%2: A user name\n" _ + & "%3: An identifier\n" _ + & "%4: A password\n" _ + & "%5: A file name" _ + ) + ' SF_Calc._ParseAddress (sheet) + .AddText( Context := "CALCADDRESS1" _ + , MsgId := "The given address does not correspond with a valid sheet name.\n\n" _ + & "« %1 » = %2\n" _ + & "« %3 » = %4" _ + , Comment := "SF_Calc _ParseAddress (sheet)\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A file name" _ + ) + ' SF_Calc._ParseAddress (range) + .AddText( Context := "CALCADDRESS2" _ + , MsgId := "The given address does not correspond with a valid range of cells.\n\n" _ + & "« %1 » = %2\n" _ + & "« %3 » = %4" _ + , Comment := "SF_Calc _ParseAddress (range)\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A file name" _ + ) + ' SF_Calc.InsertSheet + .AddText( Context := "DUPLICATESHEET" _ + , MsgId := "There exists already in the document a sheet with the same name.\n\n" _ + & "« %1 » = %2\n" _ + & "« %3 » = %4" _ + , Comment := "SF_Calc InsertSheet\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A file name" _ + ) + ' SF_Calc.Offset + .AddText( Context := "OFFSETADDRESS" _ + , MsgId := "The computed range falls beyond the sheet boundaries or is meaningless.\n\n" _ + & "« %1 » = %2\n" _ + & "« %3 » = %4\n" _ + & "« %5 » = %6\n" _ + & "« %7 » = %8\n" _ + & "« %9 » = %10\n" _ + & "« %11 » = %12" _ + , Comment := "SF_Calc Offset\n" _ + & "%1: An identifier\n" _ + & "%2: A Calc reference\n" _ + & "%3: An identifier\n" _ + & "%4: A number\n" _ + & "%5: An identifier\n" _ + & "%6: A number\n" _ + & "%7: An identifier\n" _ + & "%8: A number\n" _ + & "%9: An identifier\n" _ + & "%10: A number\n" _ + & "%11: An identifier\n" _ + & "%12: A file name" _ + ) + ' SF_Calc.CreateChart + .AddText( Context := "DUPLICATECHART" _ + , MsgId := "A chart with the same name exists already in the sheet.\n\n" _ + & "« %1 » = %2\n" _ + & "« %3 » = %4\n" _ + & "« %5 » = %6\n" _ + , Comment := "SF_Calc CreateChart\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A string\n" _ + & "%5: An identifier\n" _ + & "%6: A file name" _ + ) + ' SF_Calc.ExportRangeToFile + .AddText( Context := "RANGEEXPORT" _ + , MsgId := "The given range could not be exported.\n" _ + & "Either the destination file must not be overwritten, or it has a read-only attribute set.\n\n" _ + & "%1 = '%2'\n" _ + & "%3 = %4" _ + , Comment := "SF_Calc.ExportRangeToFile error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name\n" _ + & "%3: An identifier\n" _ + & "%4: True or False\n" _ + ) + ' SF_Chart.ExportToFile + .AddText( Context := "CHARTEXPORT" _ + , MsgId := "The chart could not be exported.\n" _ + & "Either the destination file must not be overwritten, or it has a read-only attribute set.\n\n" _ + & "%1 = '%2'\n" _ + & "%3 = %4" _ + , Comment := "SF_Chart.ExportToFile error message\n" _ + & "%1: An identifier\n" _ + & "%2: A file name\n" _ + & "%3: An identifier\n" _ + & "%4: True or False\n" _ + ) + ' SF_Form._IsStillAlive + .AddText( Context := "FORMDEAD" _ + , MsgId := "The requested action could not be executed because the form is not open or the document was closed inadvertently.\n\n" _ + & "The concerned form is '%1' in document '%2'." _ + , Comment := "SF_Dialog._IsStillAlive error message\n" _ + & "%1: An identifier" _ + & "%2: A file name" _ + ) + ' SF_Calc.Forms + .AddText( Context := "CALCFORMNOTFOUND" _ + , MsgId := "The requested form could not be found in the Calc sheet. The given index is off-limits.\n\n" _ + & "The concerned Calc document is '%3'.\n\n" _ + & "The name of the sheet = '%2'\n" _ + & "The index = %1." _ + , Comment := "SF_Form determination\n" _ + & "%1: A number\n" _ + & "%2: A sheet name\n" _ + & "%3: A file name" _ + ) + ' SF_Document.Forms + .AddText( Context := "WRITERFORMNOTFOUND" _ + , MsgId := "The requested form could not be found in the Writer document. The given index is off-limits.\n\n" _ + & "The concerned Writer document is '%2'.\n\n" _ + & "The index = %1." _ + , Comment := "SF_Form determination\n" _ + & "%1: A number\n" _ + & "%2: A file name" _ + ) + ' SF_Base.Forms + .AddText( Context := "BASEFORMNOTFOUND" _ + , MsgId := "The requested form could not be found in the form document '%2'. The given index is off-limits.\n\n" _ + & "The concerned Base document is '%3'.\n\n" _ + & "The index = %1." _ + , Comment := "SF_Form determination\n" _ + & "%1: A number\n" _ + & "%2: A string\n" _ + & "%3: A file name" _ + ) + ' SF_Form.Subforms + .AddText( Context := "SUBFORMNOTFOUND" _ + , MsgId := "The requested subform could not be found below the given main form.\n\n" _ + & "The main form = '%2'.\n" _ + & "The subform = '%1'." _ + , Comment := "SF_Form determination\n" _ + & "%1: A form name\n" _ + & "%2: A form name" _ + ) + ' SF_FormControl._SetProperty + .AddText( Context := "FORMCONTROLTYPE" _ + , MsgId := "The control '%1' in form '%2' is of type '%3'.\n" _ + & "The property or method '%4' is not applicable on that type of form controls." _ + , Comment := "SF_FormControl property setting\n" _ + & "%1: An identifier\n" _ + & "%2: An identifier\n" _ + & "%3: A string\n" _ + & "%4: An identifier" _ + ) + ' SF_Dialog._NewDialog + .AddText( Context := "DIALOGNOTFOUND" _ + , MsgId := "The requested dialog could not be located in the given container or library.\n" _ + & "« %1 » = %2\n" _ + & "« %3 » = %4\n" _ + & "« %5 » = %6\n" _ + & "« %7 » = %8" _ + , Comment := "SF_Dialog creation\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: An identifier\n" _ + & "%4: A file name\n" _ + & "%5: An identifier\n" _ + & "%6: A string\n" _ + & "%7: An identifier\n" _ + & "%8: A string" _ + ) + ' SF_Dialog._IsStillAlive + .AddText( Context := "DIALOGDEAD" _ + , MsgId := "The requested action could not be executed because the dialog was closed inadvertently.\n\n" _ + & "The concerned dialog is '%1'." _ + , Comment := "SF_Dialog._IsStillAlive error message\n" _ + & "%1: An identifier" _ + ) + ' SF_DialogControl._SetProperty + .AddText( Context := "CONTROLTYPE" _ + , MsgId := "The control '%1' in dialog '%2' is of type '%3'.\n" _ + & "The property or method '%4' is not applicable on that type of dialog controls." _ + , Comment := "SF_DialogControl property setting\n" _ + & "%1: An identifier\n" _ + & "%2: An identifier\n" _ + & "%3: A string\n" _ + & "%4: An identifier" _ + ) + ' SF_DialogControl.WriteLine + .AddText( Context := "TEXTFIELD" _ + , MsgId := "The control '%1' in dialog '%2' is not a multiline text field.\n" _ + & "The requested method could not be executed." _ + , Comment := "SF_DialogControl add line in textbox\n" _ + & "%1: An identifier\n" _ + & "%2: An identifier" _ + ) + ' SF_Database.RunSql + .AddText( Context := "DBREADONLY" _ + , MsgId := "The database has been opened in read-only mode.\n" _ + & "The '%1' method must not be executed in this context." _ + , Comment := "SF_Database when running update SQL statement\n" _ + & "%1: The concerned method" _ + ) + ' SF_Database._ExecuteSql + .AddText( Context := "SQLSYNTAX" _ + , MsgId := "An SQL statement could not be interpreted or executed by the database system.\n" _ + & "Check its syntax, table and/or field names, ...\n\n" _ + & "SQL Statement : « %1 »" _ + , Comment := "SF_Database can't interpret SQL statement\n" _ + & "%1: The statement" _ + ) + ' SF_Exception.PythonShell (Python only) + .AddText( Context := "PYTHONSHELL" _ + , MsgId := "The APSO extension could not be located in your LibreOffice installation." _ + , Comment := "SF_Exception.PythonShell error message" _ + & "APSO: to leave unchanged" _ + ) + ' SFUnitTests._NewUnitTest + .AddText( Context := "UNITTESTLIBRARY" _ + , MsgId := "The requested library could not be located.\n" _ + & "The UnitTest service has not been initialized.\n\n" _ + & "Library name : « %1 »" _ + , Comment := "SFUnitTest could not locate the library gven as argument\n" _ + & "%1: The name of the library" _ + ) + ' SFUnitTests.SF_UnitTest + .AddText( Context := "UNITTESTMETHOD" _ + , MsgId := "The method '%1' is unexpected in the current context.\n" _ + & "The UnitTest service cannot proceed further with the on-going test." _ + , Comment := "SFUnitTest finds a RunTest() call in a inappropriate location\n" _ + & "%1: The name of a method" _ + ) + End With + End If + +Finally: + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Root._LoadLocalizedInterface + +REM ----------------------------------------------------------------------------- +Public Function _Repr() As String +''' Convert the unique SF_Root instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Root] (MainFunction: xxx, Console: yyy lines, ServicesList)" + +Dim sRoot As String ' Return value +Const cstRoot = "[Root] (" + + sRoot = cstRoot & "MainFunction: " & MainFunction & ", Console: " & UBound(ConsoleLines) + 1 & " lines" _ + & ", Libraries:" & SF_Utils._Repr(ServicesList.Keys) _ + & ")" + + _Repr = sRoot + +End Function ' ScriptForge.SF_Root._Repr + +REM ----------------------------------------------------------------------------- +Public Sub _StackReset() +''' Reset private members after a fatal/abort error to leave +''' a stable persistent storage after an unwanted interrupt + + MainFunction = "" + MainFunctionArgs = "" + StackLevel = 0 + TriggeredByPython = False + +End Sub ' ScriptForge.SF_Root._StackReset + +REM ================================================== END OF SCRIPTFORGE.SF_ROOT +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Services.xba b/wizards/source/scriptforge/SF_Services.xba new file mode 100644 index 000000000..627dc4d2e --- /dev/null +++ b/wizards/source/scriptforge/SF_Services.xba @@ -0,0 +1,639 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Services" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Services +''' =========== +''' Singleton class implementing the "ScriptForge.Services" service +''' Implemented as a usual Basic module +''' The ScriptForge framework includes +''' the current ScriptForge library +''' a number of "associated" libraries +''' any user/contributor extension wanting to fit into the framework +''' The methods in this module constitute the kernel of the ScriptForge framework +''' - RegisterScriptServices +''' Register for a library the list of services it implements +''' Each library in the framework must implement its own RegisterScriptServices method +''' This method consists in a series of invocations of next 2 methods +''' - RegisterService +''' Register a single service +''' - RegisterEventManager +''' Register a single event manager +''' - CreateScriptService +''' Called by user scripts to get an object giving access to a service or to the event manager +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_services.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const UNKNOWNSERVICEERROR = "UNKNOWNSERVICEERROR" ' Service not found within the registered services of the given library +Const SERVICESNOTLOADEDERROR = "SERVICESNOTLOADEDERROR" ' Failure during the registering of the services of the given library +Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist + +REM ============================================================== PUBLIC MEMBERS + +' Defines an entry in in the services dictionary +Type _Service + ServiceName As String + ServiceType As Integer + ' 0 Undefined + ' 1 Basic module + ' 2 Method reference as a string + ServiceReference As Object + ServiceMethod As String + EventManager As Boolean ' True if registered item is an event manager +End Type + +Private vServicesArray As Variant ' List of services registered by a library + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Function CreateScriptService(Optional ByRef Service As Variant _ + , ParamArray pvArgs As Variant _ + ) As Variant +''' Create access to the services of a library for the benefit of a user script +''' A service is to understand either: +''' as a set of methods gathered in a Basic standard module +''' or a set of methods and properties gathered in a Basic class module +''' Args: +''' Service: the name of the service in 2 parts "library.service" +''' The library is a Basic library that must exist in the GlobalScope +''' (default = "ScriptForge") +''' The service is one of the services registered by the library +''' thru the RegisterScriptServices() routine +''' pvArgs: a set of arguments passed to the constructor of the service +''' This is only possible if the service refers to a Basic class module +''' Returns +''' The object containing either the reference of the Basic module +''' or of the Basic class instance +''' Both are Basic objects +''' Returns Nothing if an error occurred. +''' ==>> NOTE: The error can be within the user script creating the new class instance +''' Exceptions: +''' SERVICESNOTLOADEDERROR RegisterScriptService probable failure +''' UNKNOWNSERVICEERROR Service not found +''' Examples +''' CreateScriptService("Array") +''' => Refers to ScriptForge.Array or SF_Array +''' CreateScriptService("ScriptForge.Dictionary") +''' => Returns a new empty dictionary; "ScriptForge." is optional +''' CreateScriptService("SFDocuments.Calc") +''' => Refers to the Calc service, implemented in the SFDocuments library +''' CreateScriptService("Dialog", dlgName) +''' => Returns a Dialog instance referring to the dlgName dialog +''' CreateScriptService("SFDocuments.Event", oEvent) +''' => Refers to the Document service instance, implemented in the SFDocuments library, having triggered the event + +Dim vScriptService As Variant ' Return value +Dim vServiceItem As Variant ' A single service (see _Service type definition) +Dim vServicesList As Variant ' Output of RegisterScriptServices +Dim vSplit As Variant ' Array to split argument in +Dim sLibrary As String ' Library part of the argument +Dim sService As String ' Service part of the argument +Dim vLibrary As Variant ' Dictionary of libraries +Dim vService As Variant ' An individual service object +Const cstThisSub = "SF_Services.CreateScriptService" +Const cstSubArgs = "Service, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set vScriptService = Nothing + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Service, "Service", V_STRING) Then GoTo Catch + If Len(Service) = 0 Then GoTo CatchNotFound + End If + +Try: + ' Initialize the list of services when CreateScriptService called for the very 1st time + If IsEmpty(_SF_.ServicesList) Then _SF_.ServicesList = SF_Services._NewDictionary() + + ' Simple parsing of argument + vSplit = Split(Service, ".") + If UBound(vSplit) > 1 Then GoTo CatchNotFound + If UBound(vSplit) = 0 Then + sLibrary = "ScriptForge" ' Yes, the default value ! + sService = vSplit(0) + ' Accept other default values for associated libraries + Select Case LCase(sService) + Case "document", "calc", "writer", "base", "documentevent", "formevent" + sLibrary = "SFDocuments" + Case "dialog", "dialogevent" : sLibrary = "SFDialogs" + Case "database" : sLibrary = "SFDatabases" + Case "unittest" : sLibrary = "SFUnitTests" + Case "menu", "popupmenu" : sLibrary = "SFWidgets" + Case Else + End Select + Else + sLibrary = vSplit(0) + sService = vSplit(1) + End If + + With _SF_.ServicesList + + ' Load the set of services from the library, if not yet done + If Not .Exists(sLibrary) Then + If Not SF_Services._LoadLibraryServices(sLibrary) Then GoTo CatchNotLoaded + End If + + ' Find and return the requested service + vServicesList = .Item(sLibrary) + If Not vServicesList.Exists(sService) Then GoTo CatchNotFound + vServiceItem = vServicesList.Item(sService) + Select Case vServiceItem.ServiceType + Case 1 ' Basic module + vScriptService = vServiceItem.ServiceReference + Case 2 ' Method to call + If sLibrary = "ScriptForge" Then ' Direct call + Select Case UCase(sService) + Case "DICTIONARY" : vScriptService = SF_Services._NewDictionary() + Case "L10N" : vScriptService = SF_Services._NewL10N(pvArgs) + Case "TIMER" : vScriptService = SF_Services._NewTimer(pvArgs) + Case Else + End Select + Else ' Call via script provider + Set vService = SF_Session._GetScript("Basic", SF_Session.SCRIPTISAPPLICATION, vServiceItem.ServiceMethod) + vScriptService = vService.Invoke(Array(pvArgs()), Array(), Array()) + End If + Case Else + End Select + + End With + +Finally: + CreateScriptService = vScriptService + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotFound: + SF_Exception.RaiseFatal(UNKNOWNSERVICEERROR, "Service", Service, sLibrary, sService) + GoTo Finally +CatchNotLoaded: + SF_Exception.RaiseFatal(SERVICESNOTLOADEDERROR, "Service", Service, sLibrary) + GoTo Finally +End Function ' ScriptForge.SF_Services.CreateScriptService + +REM ----------------------------------------------------------------------------- +Public Function RegisterEventManager(Optional ByVal ServiceName As Variant _ + , Optional ByRef ServiceReference As Variant _ + ) As Boolean +''' Register into ScriptForge a new event entry for the library +''' from which this method is called +''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method +''' Usually the method should be called only once by library +''' Args: +''' ServiceName: the name of the service as a string. It the service exists +''' already for the library the method overwrites the existing entry +''' ServiceReference: the function which will identify the source of the triggered event +''' something like: "libraryname.modulename.function" +''' Returns: +''' True if successful +''' Example: +''' ' Code snippet stored in a module contained in the SFDocuments library +''' Sub RegisterScriptServices() +''' ' Register the events manager of the library +''' RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") +''' End Sub +''' ' Code snippet stored in a user script +''' Sub Trigger(poEvent As Object) ' Triggered by a DOCUMENTEVENT event +''' Dim myDoc As Object +''' ' To get the document concerned by the event: +''' Set myDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent) +''' End Sub + +Dim bRegister As Boolean ' Return value +Const cstThisSub = "SF_Services.RegisterEventManager" +Const cstSubArgs = "ServiceName, ServiceReference" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRegister = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(ServiceName, "ServiceName", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(ServiceReference, "ServiceReference",V_STRING) Then GoTo Finally + End If + +Try: + bRegister = _AddToServicesArray(ServiceName, ServiceReference, True) + +Finally: + RegisterEventManager = bRegister + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Services.RegisterEventManager + +REM ----------------------------------------------------------------------------- +Public Function RegisterService(Optional ByVal ServiceName As Variant _ + , Optional ByRef ServiceReference As Variant _ + ) As Boolean +''' Register into ScriptForge a new service entry for the library +''' from which this method is called +''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method +''' Args: +''' ServiceName: the name of the service as a string. It the service exists +''' already for the library the method overwrites the existing entry +''' ServiceReference: either +''' - the Basic module that implements the methods of the service +''' something like: GlobalScope.Library.Module +''' - an instance of the class implementing the methods and properties of the service +''' something like: "libraryname.modulename.function" +''' Returns: +''' True if successful + +Dim bRegister As Boolean ' Return value +Const cstThisSub = "SF_Services.RegisterService" +Const cstSubArgs = "ServiceName, ServiceReference" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRegister = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(ServiceName, "ServiceName", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(ServiceReference, "ServiceReference", Array(V_STRING, V_OBJECT)) Then GoTo Finally + End If + +Try: + bRegister = _AddToServicesArray(ServiceName, ServiceReference, False) + +Finally: + RegisterService = bRegister + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Services.RegisterService + +REM ----------------------------------------------------------------------------- +Public Sub RegisterScriptServices() As Variant +''' Register into ScriptForge the list of the services implemented by the current library +''' Each library pertaining to the framework must implement its own version of this method +''' This method may be stored in any standard (i.e. not class-) module +''' +''' Each individual service is registered by calling the RegisterService() method +''' +''' The current version is given as an example +''' + With GlobalScope.ScriptForge.SF_Services + .RegisterService("Array", GlobalScope.ScriptForge.SF_Array) ' Reference to the Basic module + .RegisterService("Dictionary", "ScriptForge.SF_Services._NewDictionary") ' Reference to the function initializing the service + .RegisterService("Exception", GlobalScope.ScriptForge.SF_Exception) + .RegisterService("FileSystem", GlobalScope.ScriptForge.SF_FileSystem) + .RegisterService("L10N", "ScriptForge.SF_Services._NewL10N") + .RegisterService("Platform", GlobalScope.ScriptForge.SF_Platform) + .RegisterService("Region", GlobalScope.ScriptForge.SF_Region) + .RegisterService("Session", GlobalScope.ScriptForge.SF_Session) + .RegisterService("String", GlobalScope.ScriptForge.SF_String) + .RegisterService("Timer", "ScriptForge.SF_Services._NewTimer") + .RegisterService("UI", GlobalScope.ScriptForge.SF_UI) + 'TODO + End With + +End Sub ' ScriptForge.SF_Services.RegisterScriptServices + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _AddToServicesArray(ByVal psServiceName As String _ + , ByRef pvServiceReference As Variant _ + , ByVal pbEvent As Boolean _ + ) As Boolean +''' Add the arguments as an additional row in vServicesArray (Public variable) +''' Called from RegisterService and RegisterEvent methods + +Dim bRegister As Boolean ' Return value +Dim lMax As Long ' Number of rows in vServicesArray + + bRegister = False + +Check: + ' Ignore when method is not called from RegisterScriptServices() + If IsEmpty(vServicesArray) Or IsNull(vServicesArray) Or Not IsArray(vServicesArray) Then GoTo Finally + +Try: + lMax = UBound(vServicesArray, 1) + 1 + If lMax <= 0 Then + ReDim vServicesArray(0 To 0, 0 To 2) + Else + ReDim Preserve vServicesArray(0 To lMax, 0 To 2) + End If + vServicesArray(lMax, 0) = psServiceName + vServicesArray(lMax, 1) = pvServiceReference + vServicesArray(lMax, 2) = pbEvent + bRegister = True + +Finally: + _AddToServicesArray = bRegister + Exit Function +End Function ' ScriptForge.SF_Services._AddToServicesArray + +REM ----------------------------------------------------------------------------- +Private Function _FindModuleFromMethod(ByVal psLibrary As String _ + , ByVal psMethod As String _ + ) As String +''' Find in the given library the name of the module containing +''' the method given as 2nd argument (usually RegisterScriptServices) +''' Args: +''' psLibrary: the name of the Basic library +''' psMethod: the method to locate +''' Returns: +''' The name of the module or a zero-length string if not found + +Dim vCategories As Variant ' "user" or "share" library categories +Dim sCategory As String +Dim vLanguages As Variant ' "Basic", "Python", ... programming languages +Dim sLanguage As String +Dim vLibraries As Variant ' Library names +Dim sLibrary As String +Dim vModules As Variant ' Module names +Dim sModule As String ' Return value +Dim vMethods As Variant ' Method/properties/subs/functions +Dim sMethod As String +Dim oRoot As Object ' com.sun.star.script.browse.BrowseNodeFactory +Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer + + _FindModuleFromMethod = "" + Set oRoot = SF_Utils._GetUNOService("BrowseNodeFactory").createView(com.sun.star.script.browse.BrowseNodeFactoryViewTypes.MACROORGANIZER) + + ' Exploration is done via tree nodes + If Not IsNull(oRoot) Then + If oRoot.hasChildNodes() Then + vCategories = oRoot.getChildNodes() + For i = 0 To UBound(vCategories) + sCategory = vCategories(i).getName() + ' Consider "My macros & Dialogs" and "LibreOffice Macros & Dialogs" only + If sCategory = "user" Or sCategory = "share" Then + If vCategories(i).hasChildNodes() Then + vLanguages = vCategories(i).getChildNodes() + For j = 0 To UBound(vLanguages) + sLanguage = vLanguages(j).getName() + ' Consider Basic libraries only + If sLanguage = "Basic" Then + If vLanguages(j).hasChildNodes() Then + vLibraries = vLanguages(j).getChildNodes() + For k = 0 To UBound(vLibraries) + sLibrary = vLibraries(k).getName() + ' Consider the given library only + If sLibrary = psLibrary Then + If vLibraries(k).hasChildNodes() Then + vModules = vLibraries(k).getChildNodes() + For l = 0 To UBound(vModules) + sModule = vModules(l).getName() + ' Check if the module contains the targeted method + If vModules(l).hasChildNodes() Then + vMethods = vModules(l).getChildNodes() + For m = 0 To UBound(vMethods) + sMethod = vMethods(m).getName() + If sMethod = psMethod Then + _FindModuleFromMethod = sModule + Exit Function + End If + Next m + End If + Next l + End If + End If + Next k + End If + End If + Next j + End If + End If + Next i + End If + End If + +End Function ' ScriptForge.SF_Services._FindModuleFromMethod + +REM ----------------------------------------------------------------------------- +Private Function _LoadLibraryServices(ByVal psLibrary As String) As Boolean +''' Execute psLibrary.RegisterScriptServices() and load its services into the persistent storage +''' Args: +''' psLibrary: the name of the Basic library +''' Library will be loaded if not yet done +''' Returns: +''' True if success +''' The list of services is loaded directly into the persistent storage + + +Dim vServicesList As Variant ' Dictionary of services +Dim vService As Variant ' Single service entry in dictionary +Dim vServiceItem As Variant ' Single service in vServicesArray +Dim sModule As String ' Name of module containing the RegisterScriptServices method +Dim i As Long +Const cstRegister = "RegisterScriptServices" + +Try: + _LoadLibraryServices = False + + vServicesArray = Array() + + If psLibrary = "ScriptForge" Then + ' Direct call + ScriptForge.SF_Services.RegisterScriptServices() + Else + ' Register services via script provider + If GlobalScope.BasicLibraries.hasByName(psLibrary) Then + If Not GlobalScope.BasicLibraries.isLibraryLoaded(psLibrary) Then + GlobalScope.BasicLibraries.LoadLibrary(psLibrary) + End If + Else + GoTo Finally + End If + sModule = SF_Services._FindModuleFromMethod(psLibrary, cstRegister) + If Len(sModule) = 0 Then GoTo Finally + SF_Session.ExecuteBasicScript(, psLibrary & "." & sModule & "." & cstRegister) + End If + + ' Store in persistent storage + ' - Create list of services for the current library + Set vServicesList = SF_Services._NewDictionary() + For i = 0 To UBound(vServicesArray, 1) + Set vService = New _Service + With vService + .ServiceName = vServicesArray(i, 0) + vServiceItem = vServicesArray(i, 1) + If VarType(vServiceItem) = V_STRING Then + .ServiceType = 2 + .ServiceMethod = vServiceItem + Set .ServiceReference = Nothing + Else ' OBJECT + .ServiceType = 1 + .ServiceMethod = "" + Set .ServiceReference = vServiceItem + End If + .EventManager = vServicesArray(i, 2) + End With + vServicesList.Add(vServicesArray(i, 0), vService) + Next i + ' - Add the new dictionary to the persistent dictionary + _SF_.ServicesList.Add(psLibrary, vServicesList) + _LoadLibraryServices = True + vServicesArray = Empty + +Finally: + Exit Function +End Function ' ScriptForge.SF_Services._LoadLibraryServices + +REM ----------------------------------------------------------------------------- +Public Function _NewDictionary() As Variant +''' Create a new instance of the SF_Dictionary class +''' Returns: the instance or Nothing + +Dim oDict As Variant + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + +Try: + Set oDict = New SF_Dictionary + Set oDict.[Me] = oDict + +Finally: + Set _NewDictionary = oDict + Exit Function +Catch: + Set oDict = Nothing + GoTo Finally +End Function ' ScriptForge.SF_Services._NewDictionary + +REM ----------------------------------------------------------------------------- +Public Function _NewL10N(Optional ByVal pvArgs As Variant) As Variant +''' Create a new instance of the SF_L10N class +' Args: +''' FolderName: the folder containing the PO files in SF_FileSystem.FileNaming notation +''' Locale: locale of user session (default) or any other valid la{nguage]-CO[UNTRY] combination +''' The country part is optional. Valid are f.i. "fr", "fr-CH", "en-US" +''' Encoding: The character set that should be used +''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Note that LibreOffice probably does not implement all existing sets +''' Default = UTF-8 +''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US") +''' Encoding2: Encoding of the 2nd Locale file +''' Returns: the instance or Nothing +''' Exceptions: +''' UNKNOWNFILEERROR The PO file does not exist + +Dim oL10N As Variant ' Return value +Dim sFolderName As String ' Folder containing the PO files +Dim sLocale As String ' Passed argument or that of the user session +Dim sLocale2 As String ' Alias for Locale2 +Dim oLocale As Variant ' com.sun.star.lang.Locale +Dim sPOFile As String ' PO file must exist +Dim sEncoding As String ' Alias for Encoding +Dim sEncoding2 As String ' Alias for Encoding2 + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(pvArgs) Then pvArgs = Array() + sPOFile = "" + sEncoding = "" + If UBound(pvArgs) >= 0 Then + If Not SF_Utils._ValidateFile(pvArgs(0), "Folder (Arg0)", , True) Then GoTo Catch + sFolderName = pvArgs(0) + sLocale = "" + If UBound(pvArgs) >= 1 Then + If Not SF_Utils._Validate(pvArgs(1), "Locale (Arg1)", V_STRING) Then GoTo Catch + sLocale = pvArgs(1) + End If + If Len(sLocale) = 0 Then ' Called from Python, the Locale argument may be the zero-length string + Set oLocale = SF_Utils._GetUNOService("OfficeLocale") + sLocale = oLocale.Language & "-" & oLocale.Country + End If + If UBound(pvArgs) >= 2 Then + If IsMissing(pvArgs(2)) Or IsEmpty(pvArgs(2)) Then pvArgs(2) = "UTF-8" + If Not SF_Utils._Validate(pvArgs(2), "Encoding (Arg2)", V_STRING) Then GoTo Catch + sEncoding = pvArgs(2) + Else + sEncoding = "UTF-8" + End If + sLocale2 = "" + If UBound(pvArgs) >= 3 Then + If Not SF_Utils._Validate(pvArgs(3), "Locale2 (Arg3)", V_STRING) Then GoTo Catch + sLocale2 = pvArgs(3) + End If + If UBound(pvArgs) >= 4 Then + If Not SF_Utils._Validate(pvArgs(4), "Encoding2 (Arg4)", V_STRING) Then GoTo Catch + sEncoding2 = pvArgs(4) + Else + sEncoding2 = "UTF-8" + End If + If Len(sFolderName) > 0 Then + sPOFile = SF_FileSystem.BuildPath(sFolderName, sLocale & ".po") + If Not SF_FileSystem.FileExists(sPOFile) Then + If Len(sLocale2) = 0 Then GoTo CatchNotExists ' No fallback => error + ' Try the fallback + sPOFile = SF_FileSystem.BuildPath(sFolderName, sLocale2 & ".po") + If Not SF_FileSystem.FileExists(sPOFile) Then GoTo CatchNotExists + sEncoding = sEncoding2 + End If + End If + End If + +Try: + Set oL10N = New SF_L10N + Set oL10N.[Me] = oL10N + oL10N._Initialize(sPOFile, sEncoding) + +Finally: + Set _NewL10N = oL10N + Exit Function +Catch: + Set oL10N = Nothing + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", sPOFile) + GoTo Finally +End Function ' ScriptForge.SF_Services._NewL10N + +REM ----------------------------------------------------------------------------- +Public Function _NewTimer(Optional ByVal pvArgs As Variant) As Variant +''' Create a new instance of the SF_Timer class +''' Args: +''' [0] : If True, start the timer immediately +''' Returns: the instance or Nothing + +Dim oTimer As Variant ' Return value +Dim bStart As Boolean ' Automatic start ? + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(pvArgs) Then pvArgs = Array() + If UBound(pvArgs) < 0 Then + bStart = False + Else + If Not SF_Utils._Validate(pvArgs(0), "Start (Arg0)", V_BOOLEAN) Then GoTo Catch + bStart = pvArgs(0) + End If +Try: + Set oTimer = New SF_Timer + Set oTimer.[Me] = oTimer + If bStart Then oTimer.Start() + +Finally: + Set _NewTimer = oTimer + Exit Function +Catch: + Set oTimer = Nothing + GoTo Finally +End Function ' ScriptForge.SF_Services._NewTimer + +REM ============================================== END OF SCRIPTFORGE.SF_SERVICES +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Session.xba b/wizards/source/scriptforge/SF_Session.xba new file mode 100644 index 000000000..b4292f36e --- /dev/null +++ b/wizards/source/scriptforge/SF_Session.xba @@ -0,0 +1,1076 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Session" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Session +''' ========== +''' Singleton class implementing the "ScriptForge.Session" service +''' Implemented as a usual Basic module +''' +''' Gathers diverse general-purpose properties and methods about : +''' - installation/execution environment +''' - UNO introspection utilities +''' - clipboard management +''' - invocation of external scripts or programs +''' +''' Service invocation example: +''' Dim session As Variant +''' session = CreateScriptService("Session") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_session.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const CALCFUNCERROR = "CALCFUNCERROR" ' Calc function execution failed +Const NOSCRIPTERROR = "NOSCRIPTERROR" ' Script could not be located +Const SCRIPTEXECERROR = "SCRIPTEXECERROR" ' Exception during script execution +Const WRONGEMAILERROR = "WRONGEMAILERROR" ' Wrong email address +Const SENDMAILERROR = "SENDMAILERROR" ' Mail could not be sent +Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist + +REM ============================================================ MODULE CONSTANTS + +''' Script locations +''' ================ +''' Use next constants as Scope argument when invoking next methods: +''' ExecuteBasicScript() +''' ExecutePythonScript() +''' Example: +''' session.ExecuteBasicScript(session.SCRIPTISEMBEDDED, "Standard.myModule.myFunc", etc) + +Const cstSCRIPTISEMBEDDED = "document" ' a library of the document (BASIC + PYTHON) +Const cstSCRIPTISAPPLICATION = "application" ' a shared library (BASIC) +Const cstSCRIPTISPERSONAL = "user" ' a library of My Macros (PYTHON) +Const cstSCRIPTISPERSOXT = "user:uno_packages" ' an extension for the current user (PYTHON) +Const cstSCRIPTISSHARED = "share" ' a library of LibreOffice Macros (PYTHON) +Const cstSCRIPTISSHAROXT = "share:uno_packages" ' an extension for all users (PYTHON) +Const cstSCRIPTISOXT = "uno_packages" ' an extension but install params are unknown (PYTHON) + +''' To build or to parse scripting framework URI's +Const cstScript1 = "vnd.sun.star.script:" +Const cstScript2 = "?language=" +Const cstScript3 = "&location=" + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_Array Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_Session" +End Property ' ScriptForge.SF_Session.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Session" +End Property ' ScriptForge.SF_Array.ServiceName + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISAPPLICATION As String +''' Convenient constants + SCRIPTISAPPLICATION = cstSCRIPTISAPPLICATION +End Property ' ScriptForge.SF_Session.SCRIPTISAPPLICATION + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISEMBEDDED As String +''' Convenient constants + SCRIPTISEMBEDDED = cstSCRIPTISEMBEDDED +End Property ' ScriptForge.SF_Session.SCRIPTISEMBEDDED + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISOXT As String +''' Convenient constants + SCRIPTISOXT = cstSCRIPTISOXT +End Property ' ScriptForge.SF_Session.SCRIPTISOXT + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISPERSONAL As String +''' Convenient constants + SCRIPTISPERSONAL = cstSCRIPTISPERSONAL +End Property ' ScriptForge.SF_Session.SCRIPTISPERSONAL + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISPERSOXT As String +''' Convenient constants + SCRIPTISPERSOXT = cstSCRIPTISPERSOXT +End Property ' ScriptForge.SF_Session.SCRIPTISPERSOXT + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISSHARED As String +''' Convenient constants + SCRIPTISSHARED = cstSCRIPTISSHARED +End Property ' ScriptForge.SF_Session.SCRIPTISSHARED + +REM ----------------------------------------------------------------------------- +Property Get SCRIPTISSHAROXT As String +''' Convenient constants + SCRIPTISSHAROXT = cstSCRIPTISSHAROXT +End Property ' ScriptForge.SF_Session.SCRIPTISSHAROXT + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Function ExecuteBasicScript(Optional ByVal Scope As Variant _ + , Optional ByVal Script As Variant _ + , ParamArray pvArgs As Variant _ + ) As Variant +''' Execute the Basic script given as a string and return the value returned by the script +''' Args: +''' Scope: "Application" (default) or "Document" (NOT case-sensitive) +''' (or use one of the SCRIPTIS... public constants above) +''' Script: library.module.method (Case sensitive) +''' library => The library may be not loaded yet +''' module => Must not be a class module +''' method => Sub or Function +''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' pvArgs: the arguments of the called script +''' Returns: +''' The value returned by the call to the script +''' Exceptions: +''' NOSCRIPTERROR The script could not be found +''' Examples: +''' session.ExecuteBasicScript(, "XrayTool._Main.Xray", someuno) ' Sub: no return expected + +Dim oScript As Object ' Script to be invoked +Dim vReturn As Variant ' Returned value + +Const cstThisSub = "Session.ExecuteBasicScript" +Const cstSubArgs = "[Scope], Script, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + vReturn = Empty + +Check: + If IsMissing(Scope) Or IsEmpty(Scope) Then Scope = SCRIPTISAPPLICATION + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Scope, "Scope", V_STRING _ + , Array(SCRIPTISAPPLICATION, SCRIPTISEMBEDDED)) Then GoTo Finally + If Not SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Finally + End If + +Try: + ' Execute script + Set oScript = SF_Session._GetScript("Basic", Scope, Script) + On Local Error GoTo CatchExec + If Not IsNull(oScript) Then vReturn = oScript.Invoke(pvArgs, Array(), Array()) + +Finally: + ExecuteBasicScript = vReturn + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchExec: + SF_Exception.RaiseFatal(SCRIPTEXECERROR, "Script", Script, Error$) + GoTo Finally +End Function ' ScriptForge.SF_Session.ExecuteBasicScript + +REM ----------------------------------------------------------------------------- +Public Function ExecuteCalcFunction(Optional ByVal CalcFunction As Variant _ + , ParamArray pvArgs As Variant _ + ) As Variant +''' Execute a Calc function by its (english) name and based on the given arguments +''' Args: +''' CalcFunction: the english name of the function to execute +''' pvArgs: the arguments of the called function +''' Each argument must be either a string, a numeric value +''' or an array of arrays combining those types +''' Returns: +''' The (string or numeric) value or the array of arrays returned by the call to the function +''' When the arguments contain arrays, the function is executed as an array function +''' Wrong arguments generate an error +''' Exceptions: +''' CALCFUNCERROR ' Execution error in calc function +''' Examples: +''' session.ExecuteCalcFunction("AVERAGE", 1, 5, 3, 7) returns 4 +''' session.ExecuteCalcFunction("ABS", Array(Array(-1,2,3),Array(4,-5,6),Array(7,8,-9)))(2)(2) returns 9 +''' session.ExecuteCalcFunction("LN", -3) generates an error + +Dim oCalc As Object ' Give access to the com.sun.star.sheet.FunctionAccess service +Dim vReturn As Variant ' Returned value +Const cstThisSub = "Session.ExecuteCalcFunction" +Const cstSubArgs = "CalcFunction, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vReturn = Empty + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(CalcFunction, "CalcFunction", V_STRING) Then GoTo Finally + End If + +Try: + ' Execute function + Set oCalc = SF_Utils._GetUNOService("FunctionAccess") + ' Intercept calls from Python when no arguments. Example NOW() + If UBound(pvArgs) = 0 Then + If IsEmpty(pvArgs(0)) Then pvArgs = Array() + End If + On Local Error GoTo CatchCall + vReturn = oCalc.callFunction(UCase(CalcFunction), pvArgs()) + +Finally: + ExecuteCalcFunction = vReturn + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchCall: + SF_Exception.RaiseFatal(CALCFUNCERROR, CalcFunction) + GoTo Finally +End Function ' ScriptForge.SF_Session.ExecuteCalcFunction + +REM ----------------------------------------------------------------------------- +Public Function ExecutePythonScript(Optional ByVal Scope As Variant _ + , Optional ByVal Script As Variant _ + , ParamArray pvArgs As Variant _ + ) As Variant +''' Execute the Python script given as a string and return the value returned by the script +''' Args: +''' Scope: one of the SCRIPTIS... public constants above (default = "share") +''' Script: (Case sensitive) +''' "library/module.py$method" +''' or "module.py$method" +''' or "myExtension.oxt|myScript|module.py$method" +''' library => The library may be not loaded yet +''' myScript => The directory containing the python module +''' module.py => The python module +''' method => The python function +''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' pvArgs: the arguments of the called script +''' Date arguments are converted to iso format. However dates in arrays are not converted +''' Returns: +''' The value(s) returned by the call to the script. If >1 values, enclosed in an array +''' Exceptions: +''' NOSCRIPTERROR The script could not be found +''' Examples: +''' session.ExecutePythonScript(session.SCRIPTISSHARED, "Capitalise.py$getNewString", "Abc") returns "abc" + +Dim oScript As Object ' Script to be invoked +Dim vArg As Variant ' Individual argument +Dim vReturn As Variant ' Returned value +Dim i As Long + +Const cstThisSub = "Session.ExecutePythonScript" +Const cstSubArgs = "[Scope], Script, arg0[, arg1] ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + vReturn = Empty + +Check: + If IsError(Scope) Or IsMissing(Scope) Then Scope = SCRIPTISSHARED + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Scope, "Scope", V_STRING _ + , Array(SCRIPTISSHARED, SCRIPTISEMBEDDED, SCRIPTISPERSONAL, SCRIPTISSHAROXT, SCRIPTISPERSOXT, SCRIPTISOXT) _ + ) Then GoTo Finally + If Not SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Finally + End If + +Try: + ' Filter date arguments - NB: dates in arrays are not filtered + For i = 0 To UBound(pvArgs) ' pvArgs always zero-based + vArg = pvArgs(i) + If VarType(vArg) = V_DATE Then pvArgs(i) = SF_Utils._CDateToIso(vArg) + Next i + + ' Intercept alternate Python helpers file when relevant + With _SF_ + If SF_String.StartsWith(Script, .PythonHelper) And Len(.PythonHelper2) > 0 Then + Scope = SCRIPTISPERSONAL + Script = .PythonHelper2 & Mid(Script, Len(.PythonHelper) + 1) + End If + End With + ' Find script + Set oScript = SF_Session._GetScript("Python", Scope, Script) + + ' Execute script + If Not IsNull(oScript) Then + vReturn = oScript.Invoke(pvArgs(), Array(), Array()) + ' Remove surrounding array when single returned value + If IsArray(vReturn) Then + If UBound(vReturn) = 0 Then vReturn = vReturn(0) + End If + End If + +Finally: + ExecutePythonScript = vReturn + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.ExecutePythonScript + +REM ----------------------------------------------------------------------------- +Public Function GetPDFExportOptions() As Variant +''' Return the actual values of the PDF export options +''' The PDF options are described on https://wiki.openoffice.org/wiki/API/Tutorials/PDF_export +''' PDF options are set at each use of the Export as ... PDF command by the user and kept +''' permanently until their reset by script or by a new export +''' Args: +''' Returns: +''' A ScriptForge dictionary instance listing the 40+ properties and their value +''' Examples: +''' Dim dict As Object +''' Set dict = session.GetPDFExportOptions() +''' MsgBox dict.Item("Quality") + +Dim vDict As Variant ' Returned value +Dim oConfig As Object ' com.sun.star.configuration.ConfigurationProvider +Dim oNodePath As Object ' com.sun.star.beans.PropertyValue +Dim oOptions As Object ' configmgr.RootAccess +Dim vOptionNames As Variant ' Array of PDF options names +Dim vOptionValues As Variant ' Array of PDF options values +Dim i As Long + +Const cstThisSub = "Session.GetPDFExportOptions" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set vDict = Nothing + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + ' Get the (read-only) internal PDF options + Set oConfig = SF_Utils._GetUNOService("ConfigurationProvider") + Set oNodePath = SF_Utils._MakePropertyValue("nodepath", "/org.openoffice.Office.Common/Filter/PDF/Export/") + Set oOptions = oConfig.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", Array(oNodePath)) + + ' Copy the options into a ScriptForge dictionary + Set vDict = CreateScriptService("dictionary") + vOptionNames = oOptions.getElementNames() + vOptionValues = oOptions.getPropertyValues(vOptionNames) + ' + For i = 0 To UBound(vOptionNames) + vDict.Add(vOptionNames(i), vOptionValues(i)) + Next i + + +Finally: + GetPDFExportOptions = vDict + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.GetPDFExportOptions + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Session.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function HasUnoMethod(Optional ByRef UnoObject As Variant _ + , Optional ByVal MethodName As Variant _ + ) As Boolean +''' Returns True if a UNO object contains the given method +''' Code-snippet derived from XRAY +''' Args: +''' UnoObject: the object to identify +''' MethodName: the name of the method as a string. The search is case-sensitive +''' Returns: +''' False when the method is not found or when an argument is invalid + +Dim oIntrospect As Object ' com.sun.star.beans.Introspection +Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess +Dim bMethod As Boolean ' Return value +Const cstThisSub = "Session.HasUnoMethod" +Const cstSubArgs = "UnoObject, MethodName" + + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + bMethod = False + If VarType(UnoObject) <> V_OBJECT Then GoTo Finally + If IsNull(UnoObject) Then GoTo Finally + If VarType(MethodName) <> V_STRING Then GoTo Finally + If MethodName = Space(Len(MethodName)) Then GoTo Finally + +Try: + On Local Error GoTo Catch + Set oIntrospect = SF_Utils._GetUNOService("Introspection") + Set oInspect = oIntrospect.inspect(UnoObject) + bMethod = oInspect.hasMethod(MethodName, com.sun.star.beans.MethodConcept.ALL) + +Finally: + HasUnoMethod = bMethod + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' ScriptForge.SF_Session.HasUnoMethod + +REM ----------------------------------------------------------------------------- +Public Function HasUnoProperty(Optional ByRef UnoObject As Variant _ + , Optional ByVal PropertyName As Variant _ + ) As Boolean +''' Returns True if a UNO object contains the given property +''' Code-snippet derived from XRAY +''' Args: +''' UnoObject: the object to identify +''' PropertyName: the name of the property as a string. The search is case-sensitive +''' Returns: +''' False when the property is not found or when an argument is invalid + +Dim oIntrospect As Object ' com.sun.star.beans.Introspection +Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess +Dim bProperty As Boolean ' Return value +Const cstThisSub = "Session.HasUnoProperty" +Const cstSubArgs = "UnoObject, PropertyName" + + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + bProperty = False + If VarType(UnoObject) <> V_OBJECT Then GoTo Finally + If IsNull(UnoObject) Then GoTo Finally + If VarType(PropertyName) <> V_STRING Then GoTo Finally + If PropertyName = Space(Len(PropertyName)) Then GoTo Finally + +Try: + On Local Error GoTo Catch + Set oIntrospect = SF_Utils._GetUNOService("Introspection") + Set oInspect = oIntrospect.inspect(UnoObject) + bProperty = oInspect.hasProperty(PropertyName, com.sun.star.beans.PropertyConcept.ALL) + +Finally: + HasUnoProperty = bProperty + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' ScriptForge.SF_Session.HasUnoProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Session service as an array + + Methods = Array( _ + "ExecuteBasicScript" _ + , "ExecuteCalcFunction" _ + , "ExecutePythonScript" _ + , "HasUnoMethod" _ + , "HasUnoProperty" _ + , "OpenURLInBrowser" _ + , "RunApplication" _ + , "SendMail" _ + , "UnoMethods" _ + , "UnoObjectType" _ + , "UnoProperties" _ + , "WebService" _ + ) + +End Function ' ScriptForge.SF_Session.Methods + +REM ----------------------------------------------------------------------------- +Public Sub OpenURLInBrowser(Optional ByVal URL As Variant) +''' Opens a URL in the default browser +''' Args: +''' URL: The URL to open in the browser +''' Examples: +''' session.OpenURLInBrowser("https://docs.python.org/3/library/webbrowser.html") + +Const cstPyHelper = "$" & "_SF_Session__OpenURLInBrowser" + +Const cstThisSub = "Session.OpenURLInBrowser" +Const cstSubArgs = "URL" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(URL, "URL", V_STRING) Then GoTo Finally + End If + +Try: + ExecutePythonScript(SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, URL) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_Session.OpenURLInBrowser + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties as an array + + Properties = Array( _ + ) + +End Function ' ScriptForge.SF_Session.Properties + +REM ----------------------------------------------------------------------------- +Public Function RunApplication(Optional ByVal Command As Variant _ + , Optional ByVal Parameters As Variant _ + ) As Boolean +''' Executes an arbitrary system command +''' Args: +''' Command: The command to execute +''' This may be an executable file or a document which is registered with an application +''' so that the system knows what application to launch for that document +''' Parameters: a list of space separated parameters as a single string +''' The method does not validate the given parameters, but only passes them to the specified command +''' Returns: +''' True if success +''' Examples: +''' session.RunApplication("Notepad.exe") +''' session.RunApplication("C:\myFolder\myDocument.odt") +''' session.RunApplication("kate", "/home/me/install.txt") ' (Linux) + +Dim bReturn As Boolean ' Returned value +Dim oShell As Object ' com.sun.star.system.SystemShellExecute +Dim sCommand As String ' Command as an URL +Const cstThisSub = "Session.RunApplication" +Const cstSubArgs = "Command, [Parameters]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bReturn = False + +Check: + If IsMissing(Parameters) Then Parameters = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(Command, "Command") Then GoTo Finally + If Not SF_Utils._Validate(Parameters, "Parameters", V_STRING) Then GoTo Finally + End If + +Try: + Set oShell = SF_Utils._GetUNOService("SystemShellExecute") + sCommand = SF_FileSystem._ConvertToUrl(Command) + oShell.execute(sCommand, Parameters, com.sun.star.system.SystemShellExecuteFlags.URIS_ONLY) + bReturn = True + +Finally: + RunApplication = bReturn + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.RunApplication + +REM ----------------------------------------------------------------------------- +Public Sub SendMail(Optional ByVal Recipient As Variant _ + , Optional ByRef Cc As Variant _ + , Optional ByRef Bcc As Variant _ + , Optional ByVal Subject As Variant _ + , Optional ByRef Body As Variant _ + , Optional ByVal FileNames As Variant _ + , Optional ByVal EditMessage As Variant _ + ) +''' Send a message (with or without attachments) to recipients from the user's mail client +''' The message may be edited by the user before sending or, alternatively, be sent immediately +''' Args: +''' Recipient: an email addresses (To recipient) +''' Cc: a comma-delimited list of email addresses (carbon copy) +''' Bcc: a comma-delimited list of email addresses (blind carbon copy) +''' Subject: the header of the message +''' FileNames: a comma-separated list of filenames to attach to the mail. SF_FileSystem naming conventions apply +''' Body: the unformatted text of the message +''' EditMessage: when True (default) the message is editable before being sent +''' Exceptions: +''' UNKNOWNFILEERROR File does not exist +''' WRONGEMAILERROR String not recognized as an email address +''' SENDMAILERROR System error, probably no mail client + +Dim sEmail As String ' An single email address +Dim sFile As String ' A single file name +Dim sArg As String ' Argument name +Dim vCc As Variant ' Array alias of Cc +Dim vBcc As Variant ' Array alias of Bcc +Dim vFileNames As Variant ' Array alias of FileNames +Dim oMailService As Object ' com.sun.star.system.SimpleCommandMail or com.sun.star.system.SimpleSystemMail +Dim oMail As Object ' com.sun.star.system.XSimpleMailClient +Dim oMessage As Object ' com.sun.star.system.XSimpleMailMessage +Dim lFlag As Long ' com.sun.star.system.SimpleMailClientFlags.XXX +Dim ARR As Object : ARR = ScriptForge.SF_Array +Dim i As Long +Const cstComma = ",", cstSemiColon = ";" +Const cstThisSub = "Session.SendMail" +Const cstSubArgs = "Recipient, [Cc=""""], [Bcc=""""], [Subject=""""], [FileNames=""""], [Body=""""], [EditMessage=True]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Cc) Or IsEmpty(Cc) Then Cc = "" + If IsMissing(Bcc) Or IsEmpty(Bcc) Then Bcc = "" + If IsMissing(Subject) Or IsEmpty(Subject) Then Subject = "" + If IsMissing(FileNames) Or IsEmpty(FileNames) Then FileNames = "" + If IsMissing(Body) Or IsEmpty(Body) Then Body = "" + If IsMissing(EditMessage) Or IsEmpty(EditMessage) Then EditMessage = True + + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Cc, "Recipient", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Cc, "Cc", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Bcc, "Bcc", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Subject, "Subject", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(FileNames, "FileNames", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Body, "Body", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(EditMessage, "EditMessage", V_BOOLEAN) Then GoTo Finally + End If + + ' Check email addresses + sArg = "Recipient" : sEmail = Recipient + If Not SF_String.IsEmail(sEmail) Then GoTo CatchEmail + sArg = "Cc" : vCc = ARR.TrimArray(Split(Cc, cstComma)) + For Each sEmail In vCc + If Not SF_String.IsEmail(sEmail) Then GoTo CatchEmail + Next sEmail + sArg = "Bcc" : vBcc = ARR.TrimArray(Split(Bcc, cstComma)) + For Each sEmail In vBcc + If Not SF_String.IsEmail(sEmail) Then GoTo CatchEmail + Next sEmail + + ' Check file existence + If Len(FileNames) > 0 Then + vFileNames = ARR.TrimArray(Split(FileNames, cstComma)) + For i = 0 To UBound(vFileNames) + sFile = vFileNames(i) + If Not SF_Utils._ValidateFile(sFile, "FileNames") Then GoTo Finally + If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists + vFileNames(i) = ConvertToUrl(sFile) + Next i + End If + +Try: + ' Initialize the mail service + Set oMailService = SF_Utils._GetUNOService("MailService") + If IsNull(oMailService) Then GoTo CatchMail + Set oMail = oMailService.querySimpleMailClient() + If IsNull(oMail) Then GoTo CatchMail + Set oMessage = oMail.createSimpleMailMessage() + If IsNull(oMessage) Then GoTo CatchMail + + ' Feed the new mail message + With oMessage + .setRecipient(Recipient) + If Subject <> "" Then .setSubject(Subject) + If UBound(vCc) >= 0 Then .setCcRecipient(vCc) + If UBound(vBcc) >= 0 Then .setBccRecipient(vBcc) + .Body = Iif(Len(Body) = 0, " ", Body) ' Body must not be the empty string ?? + .setAttachement(vFileNames) + End With + lFlag = Iif(EditMessage, com.sun.star.system.SimpleMailClientFlags.DEFAULTS, com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE) + + ' Send using the mail service + oMail.sendSimpleMailMessage(oMessage, lFlag) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +CatchEmail: + SF_Exception.RaiseFatal(WRONGEMAILERROR, sArg, sEmail) + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileNames", sFile) + GoTo Finally +CatchMail: + SF_Exception.RaiseFatal(SENDMAILERROR) + GoTo Finally +End Sub ' ScriptForge.SF_Session.SendMail + +REM ----------------------------------------------------------------------------- +Public Function SetPDFExportOptions(Optional ByRef PDFOptions As Variant) As Boolean +''' Modify the actual values of the PDF export options from an options dictionary +''' The PDF options are described on https://wiki.openoffice.org/wiki/API/Tutorials/PDF_export +''' PDF options are set at each use of the Export as ... PDF command by the user and kept +''' permanently until their reset by script (like this one) or by a new export +''' The changed options are applicable on any subsequent ExportToPDF user command or to any SaveAsPDF script execution +''' Args: +''' PDFOptions: a ScriptForge dictionary object +''' Returns: +''' True when successful +''' Examples: +''' Dim dict As Object +''' Set dict = session.GetPDFExportOptions() +''' dict.ReplaceItem("Quality", 50) +''' session.SetPDFExportOptions(dict) + +Dim bSetPDF As Boolean ' Returned value +Dim oConfig As Object ' com.sun.star.configuration.ConfigurationProvider +Dim oNodePath As Object ' com.sun.star.beans.PropertyValue +Dim oOptions As Object ' configmgr.RootAccess +Dim vOptionNames As Variant ' Array of PDF options names +Dim vOptionValues As Variant ' Array of PDF options values +Dim oDict As Object ' Alias of PDFOptions +Dim i As Long + +Const cstThisSub = "Session.SetPDFExportOptions" +Const cstSubArgs = "PDFOptions" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSetPDF = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PDFOptions, "PDFOptions", V_OBJECT, , , "DICTIONARY") Then GoTo Finally + End If + +Try: + ' Get the (updatable) internal PDF options + Set oConfig = SF_Utils._GetUNOService("ConfigurationProvider") + Set oNodePath = SF_Utils._MakePropertyValue("nodepath", "/org.openoffice.Office.Common/Filter/PDF/Export/") + Set oOptions = oConfig.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", Array(oNodePath)) + + ' Copy the options from the ScriptForge dictionary in argument to property values + Set oDict = PDFOptions + oOptions.setPropertyValues(oDict.Keys, oDict.Items) + oOptions.commitChanges() + + bSetPDF = True + +Finally: + SetPDFExportOptions = bSetPDF + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.SetPDFExportOptions + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Session.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function UnoMethods(Optional ByRef UnoObject As Variant) As Variant +''' Returns a list of the methods callable from an UNO object +''' Code-snippet derived from XRAY +''' Args: +''' UnoObject: the object to identify +''' Returns: +''' A zero-based sorted array. May be empty + +Dim oIntrospect As Object ' com.sun.star.beans.Introspection +Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess +Dim vMethods As Variant ' Array of com.sun.star.reflection.XIdlMethod +Dim vMethod As Object ' com.sun.star.reflection.XIdlMethod +Dim lMax As Long ' UBounf of vMethods +Dim vMethodsList As Variant ' Return value +Dim i As Long +Const cstThisSub = "Session.UnoMethods" +Const cstSubArgs = "UnoObject" + + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + vMethodsList = Array() + If VarType(UnoObject) <> V_OBJECT Then GoTo Finally + If IsNull(UnoObject) Then GoTo Finally + +Try: + On Local Error GoTo Catch + Set oIntrospect = SF_Utils._GetUNOService("Introspection") + Set oInspect = oIntrospect.inspect(UnoObject) + vMethods = oInspect.getMethods(com.sun.star.beans.MethodConcept.ALL) + + ' The names must be extracted from com.sun.star.reflection.XIdlMethod structures + lMax = UBound(vMethods) + If lMax >= 0 Then + ReDim vMethodsList(0 To lMax) + For i = 0 To lMax + vMethodsList(i) = vMethods(i).Name + Next i + vMethodsList = SF_Array.Sort(vMethodsList, CaseSensitive := True) + End If + +Finally: + UnoMethods = vMethodsList + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' ScriptForge.SF_Session.UnoMethods + +REM ----------------------------------------------------------------------------- +Public Function UnoObjectType(Optional ByRef UnoObject As Variant) As String +''' Identify the UNO type of an UNO object +''' Code-snippet derived from XRAY +''' Args: +''' UnoObject: the object to identify +''' Returns: +''' com.sun.star. ... as a string +''' a zero-length string if identification was not successful + +Dim oObjDesc As Object ' _ObjectDescriptor type +Dim sObjectType As String ' Return value +Const cstThisSub = "Session.UnoObjectType" +Const cstSubArgs = "UnoObject" + + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + sObjectType = "" + If VarType(UnoObject) <> V_OBJECT Then GoTo Finally + If IsNull(UnoObject) Then GoTo Finally + +Try: + Set oObjDesc = SF_Utils._VarTypeObj(UnoObject) + If oObjDesc.iVarType = V_UNOOBJECT Then sObjectType = oObjDesc.sObjectType + +Finally: + UnoObjectType = sObjectType + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Session.UnoObjectType + +REM ----------------------------------------------------------------------------- +Public Function UnoProperties(Optional ByRef UnoObject As Variant) As Variant +''' Returns a list of the properties of an UNO object +''' Code-snippet derived from XRAY +''' Args: +''' UnoObject: the object to identify +''' Returns: +''' A zero-based sorted array. May be empty + +Dim oIntrospect As Object ' com.sun.star.beans.Introspection +Dim oInspect As Object ' com.sun.star.beans.XIntrospectionAccess +Dim vProperties As Variant ' Array of com.sun.star.beans.Property +Dim vProperty As Object ' com.sun.star.beans.Property +Dim lMax As Long ' UBounf of vProperties +Dim vPropertiesList As Variant ' Return value +Dim i As Long +Const cstThisSub = "Session.UnoProperties" +Const cstSubArgs = "UnoObject" + + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + vPropertiesList = Array() + If VarType(UnoObject) <> V_OBJECT Then GoTo Finally + If IsNull(UnoObject) Then GoTo Finally + +Try: + On Local Error GoTo Catch + Set oIntrospect = SF_Utils._GetUNOService("Introspection") + Set oInspect = oIntrospect.inspect(UnoObject) + vProperties = oInspect.getProperties(com.sun.star.beans.PropertyConcept.ALL) + + ' The names must be extracted from com.sun.star.beans.Property structures + lMax = UBound(vProperties) + If lMax >= 0 Then + ReDim vPropertiesList(0 To lMax) + For i = 0 To lMax + vPropertiesList(i) = vProperties(i).Name + Next i + vPropertiesList = SF_Array.Sort(vPropertiesList, CaseSensitive := True) + End If + +Finally: + UnoProperties = vPropertiesList + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + On Local Error GoTo 0 + GoTo Finally +End Function ' ScriptForge.SF_Session.UnoProperties + +REM ----------------------------------------------------------------------------- +Public Function WebService(Optional ByVal URI As Variant) As String +''' Get some web content from a URI +''' Args: +''' URI: URI text of the web service +''' Returns: +''' The web page content of the URI +''' Exceptions: +''' CALCFUNCERROR +''' Examples: +''' session.WebService("wiki.documentfoundation.org/api.php?" _ +''' & "hidebots=1&days=7&limit=50&action=feedrecentchanges&feedformat=rss") + +Dim sReturn As String ' Returned value +Const cstThisSub = "Session.WebService" +Const cstSubArgs = "URI" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sReturn = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(URI, "URI", V_STRING) Then GoTo Finally + End If + +Try: + sReturn = SF_Session.ExecuteCalcFunction("WEBSERVICE", URI) + +Finally: + WebService = sReturn + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Session.WebService + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _ExecuteScript(ByVal psScript As String _ + , Optional ByRef pvArg As Variant _ + ) As Variant +''' Execute the script expressed in the scripting framework_URI notation +''' Args: +''' psScript: read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' pvArg: the unique argument to pass to the called script. +''' It is often an event object that triggered the execution of the script. +''' Returns: +''' The return value after the script execution. May be ignored for events + +Dim sScope As String ' The scope part of the script URI +Dim sLanguage As String ' The language part of the script URI +Dim sScript As String ' The script part of the script URI +Dim vStrings As Variant ' Array of strings: (script, language, scope) +Const cstComma = "," + +Try: + If ScriptForge.SF_String.StartsWith(psScript, cstScript1) Then + ' Parse script + vStrings = Split( _ + Replace( _ + Replace(Mid(psScript, Len(cstScript1) + 1), cstScript2, cstComma) _ + , cstScript3, cstComma) _ + , cstComma) + sScript = vStrings(0) : sLanguage = vStrings(1) : sScope = vStrings(2) + ' Execute script + If UCase(sLanguage) = "BASIC" Then + _ExecuteScript = ExecuteBasicScript(sScope, sScript, pvArg) + Else ' Python + _ExecuteScript = ExecutePythonScript(sScope, sScript, pvArg) + End If + End If + +End Function ' ScriptForge.SF_Session._ExecuteScript + +REM ----------------------------------------------------------------------------- +Private Function _GetScript(ByVal psLanguage As String _ + , ByVal psScope As String _ + , ByVal psScript As String _ + ) As Object +''' Get the adequate script provider and from there the requested script +''' Called by ExecuteBasicScript() and ExecutePythonScript() +''' The execution of the script is done by the caller +''' Args: +''' psLanguage: Basic or Python +''' psScope: one of the SCRIPTISxxx constants +''' The SCRIPTISOXT constant is an alias for 2 cases, extension either +''' installed for one user only, or for all users +''' Managed here by trial and error +''' psScript: Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' Returns: +''' A com.sun.star.script.provider.XScript object + +Dim sScript As String ' The complete script string +Dim oScriptProvider As Object ' Script provider singleton +Dim oScript As Object ' Return value + +Try: + ' Build script string + sScript = cstScript1 & psScript & cstScript2 & psLanguage & cstScript3 & LCase(psScope) + + ' Find script + Set oScript = Nothing + ' Python only: installation of extension is determined by user => unknown to script author + If psScope = SCRIPTISOXT Then ' => Trial and error + On Local Error GoTo ForAllUsers + sScript = cstScript1 & psScript & cstScript2 & psLanguage & cstScript3 & SCRIPTISPERSOXT + Set oScriptProvider = SF_Utils._GetUNOService("ScriptProvider", SCRIPTISPERSOXT) + Set oScript = oScriptProvider.getScript(sScript) + End If + ForAllUsers: + On Local Error GoTo CatchNotFound + If IsNull(oScript) Then + If psScope = SCRIPTISOXT Then psScope = SCRIPTISSHAROXT + Set oScriptProvider = SF_Utils._GetUNOService("ScriptProvider", psScope) + Set oScript = oScriptProvider.getScript(sScript) + End If + +Finally: + _GetScript = oScript + Exit Function +CatchNotFound: + SF_Exception.RaiseFatal(NOSCRIPTERROR, psLanguage, "Scope", psScope, "Script", psScript) + GoTo Finally +End Function ' ScriptForge.SF_Session._GetScript + +REM =============================================== END OF SCRIPTFORGE.SF_SESSION +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_String.xba b/wizards/source/scriptforge/SF_String.xba new file mode 100644 index 000000000..888cf672c --- /dev/null +++ b/wizards/source/scriptforge/SF_String.xba @@ -0,0 +1,2734 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_String" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_String +''' ========= +''' Singleton class implementing the "ScriptForge.String" service +''' Implemented as a usual Basic module +''' Focus on string manipulation, regular expressions, encodings and hashing algorithms +''' The first argument of almost every method is the string to consider +''' It is always passed by reference and left unchanged +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' Definitions +''' Line breaks: symbolic name(Ascii number) +''' LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30), +''' Next Line(133), Line separator(8232), Paragraph separator(8233) +''' Whitespaces: symbolic name(Ascii number) +''' Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160), +''' Line separator(8232), Paragraph separator(8233) +''' A quoted string: +''' The quoting character must be the double quote (") +''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character +''' => [str\"i""ng] means [str"i"ng] +''' Escape sequences: symbolic name(Ascii number) = escape sequence +''' Line feed(10) = "\n" +''' Carriage return(13) = "\r" +''' Horizontal tab(9) = "\t" +''' Double the backslash to ignore the sequence, e.g. "\\n" means "\n" (not "\" & Chr(10)). +''' Not printable characters: +''' Defined in the Unicode character database as “Other” or “Separator” +''' In particular, "control" characters (ascii code <= 0x1F) are not printable +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_string.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' Some references: +''' https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1i18n_1_1KCharacterType.html +''' com.sun.star.i18n.KCharacterType.### +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html +''' com.sun.star.i18n.XCharacterClassification + +REM ============================================================ MODULE CONSTANTS + +''' Most expressions below are derived from https://www.regular-expressions.info/ + +Const REGEXALPHA = "^[A-Za-z]+$" ' Not used +Const REGEXALPHANUM = "^[\w]+$" +Const REGEXDATEDAY = "(0[1-9]|[12][0-9]|3[01])" +Const REGEXDATEMONTH = "(0[1-9]|1[012])" +Const REGEXDATEYEAR = "(19|20)\d\d" +Const REGEXTIMEHOUR = "(0[1-9]|1[0-9]|2[0123])" +Const REGEXTIMEMIN = "([0-5][0-9])" +Const REGEXTIMESEC = REGEXTIMEMIN +Const REGEXDIGITS = "^[0-9]+$" +Const REGEXEMAIL = "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,}$" +Const REGEXFILELINUX = "^[^<>:;,?""*|\\]+$" +Const REGEXFILEWIN = "^([A-Z]|[a-z]:)?[^<>:;,?""*|]+$" +Const REGEXHEXA = "^(0X|&H)?[0-9A-F]+$" ' Includes 0xFF and &HFF +Const REGEXIPV4 = "^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$" +Const REGEXNUMBER = "^[-+]?(([0-9]+)?\.)?[0-9]+([eE][-+]?[0-9]+)?$" +Const REGEXURL = "^(https?|ftp)://[^\s/$.?#].[^\s]*$" +Const REGEXWHITESPACES = "^[\s]+$" +Const REGEXLTRIM = "^[\s]+" +Const REGEXRTRIM = "[\s]+$" +Const REGEXSPACES = "[\s]+" + +''' Accented characters substitution: https://docs.google.com/spreadsheets/d/1pJKSueZK8RkAcJFQIiKpYUamWSC1u1xVQchK7Z7BIwc/edit#gid=0 +''' (Many of them are in the list, but do not consider the list as closed vs. the Unicode database) + +Const cstCHARSWITHACCENT = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿŠšŸŽž" _ + & "ĂăĐđĨĩŨũƠơƯưẠạẢảẤấẦầẨẩẪẫẬậẮắẰằẲẳẴẵẶặẸẹẺẻẼẽẾếỀềỂểỄễỆệỈỉỊịỌọỎỏỐốỒồỔổỖỗỘộỚớỜờỞởỠỡỢợỤụỦủỨứỪừỬửỮữỰựỲỳỴỵỶỷỸỹ₫" +Const cstCHARSWITHOUTACCENT = "AAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyySsYZz" _ + & "AaDdIiUuOoUuAaAaAaAaAaAaAaAaAaAaAaAaEeEeEeEeEeEeEeEeIiIiOoOoOoOoOoOoOoOoOoOoOoOoUuUuUuUuUuUuUuYyYyYyYyd" + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_String Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CHARSWITHACCENT() As String +''' Latin accents + CHARSWITHACCENT = cstCHARSWITHACCENT +End Property ' ScriptForge.SF_String.CHARSWITHACCENT + +REM ----------------------------------------------------------------------------- +Property Get CHARSWITHOUTACCENT() As String +''' Latin accents + CHARSWITHOUTACCENT = cstCHARSWITHOUTACCENT +End Property ' ScriptForge.SF_String.CHARSWITHOUTACCENT + +''' Symbolic constants for linebreaks +REM ----------------------------------------------------------------------------- +Property Get sfCR() As Variant +''' Carriage return + sfCR = Chr(13) +End Property ' ScriptForge.SF_String.sfCR + +REM ----------------------------------------------------------------------------- +Property Get sfCRLF() As Variant +''' Carriage return + sfCRLF = Chr(13) & Chr(10) +End Property ' ScriptForge.SF_String.sfCRLF + +REM ----------------------------------------------------------------------------- +Property Get sfLF() As Variant +''' Linefeed + sfLF = Chr(10) +End Property ' ScriptForge.SF_String.sfLF + +REM ----------------------------------------------------------------------------- +Property Get sfNEWLINE() As Variant +''' Linefeed or Carriage return + Linefeed + sfNEWLINE = Iif(GetGuiType() = 1, Chr(13), "") & Chr(10) +End Property ' ScriptForge.SF_String.sfNEWLINE + +REM ----------------------------------------------------------------------------- +Property Get sfTAB() As Variant +''' Horizontal tabulation + sfTAB = Chr(9) +End Property ' ScriptForge.SF_String.sfTAB + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_String" +End Property ' ScriptForge.SF_String.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.String" +End Property ' ScriptForge.SF_String.ServiceName + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Function Capitalize(Optional ByRef InputStr As Variant) As String +''' Return the input string with the 1st character of each word in title case +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string with the 1st character of each word in title case +''' Examples: +''' SF_String.Capitalize("this is a title for jean-pierre") returns "This Is A Title For Jean-Pierre" + +Dim sCapital As String ' Return value +Dim lLength As Long ' Length of input string +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Const cstThisSub = "String.Capitalize" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCapital = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + sCapital = oChar.toTitle(InputStr, 0, lLength * 4, oLocale) ' length * 4 because length is expressed in bytes + End If + +Finally: + Capitalize = sCapital + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Capitalize + +REM ----------------------------------------------------------------------------- +Public Function Count(Optional ByRef InputStr As Variant _ + , Optional ByVal Substring As Variant _ + , Optional ByRef IsRegex As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Long +''' Counts the number of occurrences of a substring or a regular expression within a string +''' Args: +''' InputStr: the input stringto examine +''' Substring: the substring to identify +''' IsRegex: True if Substring is a regular expression (default = False) +''' CaseSensitive: default = False +''' Returns: +''' The number of occurrences as a Long +''' Examples: +''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", IsRegex := True, CaseSensitive := True) +''' returns 7 (the number of words in lower case) +''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "or", CaseSensitive := False) +''' returns 2 + + +Dim lOccurrences As Long ' Return value +Dim lStart As Long ' Start index of search +Dim sSubstring As String ' Substring to replace +Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive +Const cstThisSub = "String.Count" +Const cstSubArgs = "InputStr, Substring, [IsRegex=False], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + lOccurrences = 0 + +Check: + If IsMissing(IsRegex) Or IsEmpty(IsRegex) Then IsRegex = False + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(IsRegex, "IsRegex", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + iCaseSensitive = Iif(CaseSensitive, 0, 1) ' 1 = False ;) + lStart = 1 + + Do While lStart >= 1 And lStart <= Len(InputStr) + Select Case IsRegex + Case False ' Use InStr + lStart = InStr(lStart, InputStr, Substring, iCaseSensitive) + If lStart = 0 Then Exit Do + lStart = lStart + Len(Substring) + Case True ' Use FindRegex + sSubstring = SF_String.FindRegex(InputStr, Substring, lStart, CaseSensitive) + If lStart = 0 Then Exit Do + lStart = lStart + Len(sSubstring) + End Select + lOccurrences = lOccurrences + 1 + Loop + +Finally: + Count = lOccurrences + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Count + +REM ----------------------------------------------------------------------------- +Public Function EndsWith(Optional ByRef InputStr As Variant _ + , Optional ByVal Substring As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the last characters of InputStr are identical to Substring +''' Args: +''' InputStr: the input string +''' Substring: the suffixing characters +''' CaseSensitive: default = False +''' Returns: +''' True if the comparison is satisfactory +''' False if either InputStr or Substring have a length = 0 +''' False if Substr is longer than InputStr +''' Examples: +''' SF_String.EndsWith("abcdefg", "EFG") returns True +''' SF_String.EndsWith("abcdefg", "EFG", CaseSensitive := True) returns False + +Dim bEndsWith As Boolean ' Return value +Dim lSub As Long ' Length of SUbstring +Const cstThisSub = "String.EndsWith" +Const cstSubArgs = "InputStr, Substring, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bEndsWith = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lSub = Len(Substring) + If Len(InputStr) > 0 And lSub > 0 And lSub <= Len(InputStr) Then + bEndsWith = ( StrComp(Right(InputStr, lSub), Substring, Iif(CaseSensitive, 1, 0)) = 0 ) + End If + +Finally: + EndsWith = bEndsWith + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.EndsWith + +REM ----------------------------------------------------------------------------- +Public Function Escape(Optional ByRef InputStr As Variant) As String +''' Convert any hard line breaks or tabs by their escaped equivalent +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string after replacement of "\", Chr(10), Chr(13), Chr(9)characters +''' Examples: +''' SF_String.Escape("abc" & Chr(10) & Chr(9) & "def\n") returns "abc\n\tdef\\n" + +Dim sEscape As String ' Return value +Const cstThisSub = "String.Escape" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sEscape = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + sEscape = SF_String.ReplaceStr( InputStr _ + , Array("\", SF_String.sfLF, SF_String.sfCR, SF_String.sfTAB) _ + , Array("\\", "\n", "\r", "\t") _ + ) + +Finally: + Escape = sEscape + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Escape + +REM ----------------------------------------------------------------------------- +Public Function ExpandTabs(Optional ByRef InputStr As Variant _ + , Optional ByVal TabSize As Variant _ + ) As String +''' Return the input string with each TAB (Chr(9)) character replaced by the adequate number of spaces +''' Args: +''' InputStr: the input string +''' TabSize: defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1 +''' Default = 8 +''' Returns: +''' The input string with spaces replacing the TAB characters +''' If the input string contains line breaks, the TAB positions are reset +''' Examples: +''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & SF_String.sfTAB & "def", 4) returns "abc def" +''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & "def" & SF_String.sfLF & SF_String.sfTAB & "ghi") +''' returns "abc def" & SF_String.sfLF & " ghi" + +Dim sExpanded As String ' Return value +Dim lCharPosition As Long ' Position of current character in current line in expanded string +Dim lSpaces As Long ' Spaces counter +Dim sChar As String ' A single character +Dim i As Long +Const cstTabSize = 8 +Const cstThisSub = "String.ExpandTabs" +Const cstSubArgs = "InputStr, [TabSize=8]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sExpanded = "" + +Check: + If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = cstTabSize + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(TabSize, "TabSize", V_NUMERIC) Then GoTo Finally + End If + If TabSize <= 0 Then TabSize = cstTabSize + +Try: + lCharPosition = 0 + If Len(InputStr) > 0 Then + For i = 1 To Len(InputStr) + sChar = Mid(InputStr, i, 1) + Select Case sChar + Case SF_String.sfLF, Chr(12), SF_String.sfCR, Chr(28), Chr(29), Chr(30), Chr(133), Chr(8232), Chr(8233) + sExpanded = sExpanded & sChar + lCharPosition = 0 + Case SF_String.sfTAB + lSpaces = Int(lCharPosition / TabSize + 1) * TabSize - lCharPosition + sExpanded = sExpanded & Space(lSpaces) + lCharPosition = lCharPosition + lSpaces + Case Else + sExpanded = sExpanded & sChar + lCharPosition = lCharPosition + 1 + End Select + Next i + End If + +Finally: + ExpandTabs = sExpanded + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ExpandTabs + +REM ----------------------------------------------------------------------------- +Public Function FilterNotPrintable(Optional ByRef InputStr As Variant _ + , Optional ByVal ReplacedBy As Variant _ + ) As String +''' Return the input string in which all the not printable characters are replaced by ReplacedBy +''' Among others, control characters (Ascii <= 1F) are not printable +''' Args: +''' InputStr: the input string +''' ReplacedBy: zero, one or more characters replacing the found not printable characters +''' Default = the zero-length string +''' Returns: +''' The input string in which all the not printable characters are replaced by ReplacedBy +''' Examples: +''' SF_String.FilterNotPrintable("àén ΣlPµ" & Chr(10) & " Русский", "\n") returns "àén ΣlPµ\n Русский" + +Dim sPrintable As String ' Return value +Dim bPrintable As Boolean ' Is a single character printable ? +Dim lLength As Long ' Length of InputStr +Dim lReplace As Long ' Length of ReplacedBy +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim sChar As String ' A single character +Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE +Dim i As Long +Const cstThisSub = "String.FilterNotPrintable" +Const cstSubArgs = "InputStr, [ReplacedBy=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sPrintable = "" + +Check: + If IsMissing(ReplacedBy) Or IsEmpty(ReplacedBy) Then ReplacedBy = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(ReplacedBy, "ReplacedBy", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + lReplace = Len(ReplacedBy) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + sChar = Mid(InputStr, i + 1, 1) + lType = oChar.getCharacterType(sChar, 0, oLocale) + ' Parenthses (), [], {} have a KCharacterType = 0 + bPrintable = ( (lType And lPRINTABLE) = lPRINTABLE Or (lType = 0 And Asc(sChar) <= 127) ) + If Not bPrintable Then + If lReplace > 0 Then sPrintable = sPrintable & ReplacedBy + Else + sPrintable = sPrintable & sChar + End If + Next i + End If + +Finally: + FilterNotPrintable = sPrintable + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.FilterNotPrintable + +REM ----------------------------------------------------------------------------- +Public Function FindRegex(Optional ByRef InputStr As Variant _ + , Optional ByVal Regex As Variant _ + , Optional ByRef Start As Variant _ + , Optional ByVal CaseSensitive As Variant _ + , Optional ByVal Forward As Variant _ + ) As String +''' Find in InputStr a substring matching a given regular expression +''' Args: +''' InputStr: the input string to be searched for the expression +''' Regex: the regular expression +''' Start (passed by reference): where to start searching from +''' Should be = 1 (Forward = True) or = Len(InputStr) (Forward = False) the 1st time +''' After execution points to the first character of the found substring +''' CaseSensitive: default = False +''' Forward: True (default) or False (backward) +''' Returns: +''' The found substring matching the regular expression +''' A zero-length string if not found (Start is set to 0) +''' Examples: +''' Dim lStart As Long : lStart = 1 +''' SF_String.FindRegex("abCcdefghHij", "C.*H", lStart, CaseSensitive := True) returns "CcdefghH" +''' Above statement may be reexecuted for searching the same or another pattern +''' by starting from lStart + Len(matching string) + +Dim sOutput As String ' Return value +Dim oTextSearch As Object ' com.sun.star.util.TextSearch +Dim vOptions As Variant ' com.sun.star.util.SearchOptions +Dim lEnd As Long ' Upper limit of search area +Dim vResult As Object ' com.sun.star.util.SearchResult +Const cstThisSub = "String.FindRegex" +Const cstSubArgs = "InputStr, Regex, [Start=1], [CaseSensitive=False], [Forward=True]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If IsMissing(Start) Or IsEmpty(Start) Then Start = 1 + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If IsMissing(Forward) Or IsEmpty(Forward) Then Forward = True + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Start, "Start", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Forward, "Forward", V_BOOLEAN) Then GoTo Finally + End If + If Start <= 0 Or Start > Len(InputStr) Then GoTo Finally + +Try: + sOutput = "" + Set oTextSearch = SF_Utils._GetUNOService("TextSearch") + ' Set pattern search options + vOptions = SF_Utils._GetUNOService("SearchOptions") + With vOptions + .searchString = Regex + If CaseSensitive Then .transliterateFlags = 0 Else .transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE + End With + ' Run search + With oTextSearch + .setOptions(vOptions) + If Forward Then + lEnd = Len(InputStr) + vResult = .searchForward(InputStr, Start - 1, lEnd) + Else + lEnd = 1 + vResult = .searchBackward(InputStr, Start, lEnd - 1) + End If + End With + ' https://api.libreoffice.org/docs/idl/ref/structcom_1_1sun_1_1star_1_1util_1_1SearchResult.html + With vResult + If .subRegExpressions >= 1 Then + If Forward Then + Start = .startOffset(0) + 1 + lEnd = .endOffset(0) + 1 + Else + Start = .endOffset(0) + 1 + lEnd = .startOffset(0) + 1 + End If + sOutput = Mid(InputStr, Start, lEnd - Start) + Else + Start = 0 + End If + End With + +Finally: + FindRegex = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.FindRegex + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "String.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case "SFCR" : GetProperty = sfCR + Case "SFCRLF" : GetProperty = sfCRLF + Case "SFLF" : GetProperty = sfLF + Case "SFNEWLINE" : GetProperty = sfNEWLINE + Case "SFTAB" : GetProperty = sfTAB + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function HashStr(Optional ByVal InputStr As Variant _ + , Optional ByVal Algorithm As Variant _ + ) As String +''' Return an hexadecimal string representing a checksum of the given input string +''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512 +''' Args: +''' InputStr: the string to be hashed +''' Algorithm: The hashing algorithm to use +''' Returns: +''' The requested checksum as a string. Hexadecimal digits are lower-cased +''' A zero-length string when an error occurred +''' Example: +''' Print SF_String.HashStr("œ∑¡™£¢∞§¶•ªº–≠œ∑´®†¥¨ˆøπ“‘åß∂ƒ©˙∆˚¬", "MD5") ' 616eb9c513ad07cd02924b4d285b9987 + +Dim sHash As String ' Return value +Const cstPyHelper = "$" & "_SF_String__HashStr" +Const cstThisSub = "String.HashStr" +Const cstSubArgs = "InputStr, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512""" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sHash = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Algorithm, "Algorithm", V_STRING _ + , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally + End If + +Try: + With ScriptForge.SF_Session + sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _ + , InputStr, LCase(Algorithm)) + End With + +Finally: + HashStr = sHash + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.HashStr + +REM ----------------------------------------------------------------------------- +Public Function HtmlEncode(Optional ByRef InputStr As Variant) As String +''' &-encoding of the input string (e.g. "é" becomes "&eacute;" or numeric equivalent +''' Args: +''' InputStr: the input string +''' Returns: +''' the encoded string +''' Examples: +''' SF_String.HtmlEncode("<a href=""https://a.b.com"">From α to ω</a>") +''' returns "&lt;a href=&quot;https://a.b.com&quot;&gt;From &#945; to &#969;&lt;/a&gt;" + +Dim sEncode As String ' Return value +Dim lPos As Long ' Position in InputStr +Dim sChar As String ' A single character extracted from InputStr +Dim i As Long +Const cstThisSub = "String.HtmlEncode" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sEncode = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + lPos = 1 + sEncode = InputStr + Do While lPos <= Len(sEncode) + sChar = Mid(sEncode, lPos, 1) + ' Leave as is or encode every single char + Select Case sChar + Case """" : sChar = "&quot;" + Case "&" : sChar = "&amp;" + Case "<" : sChar = "&lt;" + Case ">" : sChar = "&gt;" + Case "'" : sChar = "&apos;" + Case ":", "/", "?", "#", "[", "]", "@" ' Reserved characters + Case SF_String.sfCR : sChar = "" ' Carriage return + Case SF_String.sfLF : sChar = "<br>" ' Line Feed + Case < Chr(126) + Case "€" : sChar = "&euro;" + Case Else : sChar = "&#" & Asc(sChar) & ";" + End Select + If Len(sChar) = 1 Then + Mid(sEncode, lPos, 1) = sChar + Else + sEncode = Left(sEncode, lPos - 1) & sChar & Mid(sEncode, lPos + 1) + End If + lPos = lPos + Len(sChar) + Loop + End If + +Finally: + HtmlEncode = sEncode + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.HtmlEncode + +REM ----------------------------------------------------------------------------- +Public Function IsADate(Optional ByRef InputStr As Variant _ + , Optional ByVal DateFormat _ + ) As Boolean +''' Return True if the string is a valid date respecting the given format +''' Args: +''' InputStr: the input string +''' DateFormat: either YYYY-MM-DD (default), DD-MM-YYYY or MM-DD-YYYY +''' The dash (-) may be replaced by a dot (.), a slash (/) or a space +''' Returns: +''' True if the string contains a valid date and there is at least one character +''' False otherwise or if the date format is invalid +''' Examples: +''' SF_String.IsADate("2019-12-31", "YYYY-MM-DD") returns True + +Dim bADate As Boolean ' Return value +Dim sFormat As String ' Alias for DateFormat +Dim iYear As Integer ' Alias of year in input string +Dim iMonth As Integer ' Alias of month in input string +Dim iDay As Integer ' Alias of day in input string +Dim dDate As Date ' Date value +Const cstFormat = "YYYY-MM-DD" ' Default date format +Const cstFormatRegex = "(YYYY[- /.]MM[- /.]DD|MM[- /.]DD[- /.]YYYY|DD[- /.]MM[- /.]YYYY)" + ' The regular expression the format must match +Const cstThisSub = "String.IsADate" +Const cstSubArgs = "InputStr, [DateFormat=""" & cstFormat & """]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bADate = False + +Check: + If IsMissing(DateFormat) Or IsEmpty(DateFormat) Then DateFormat = "YYYY-MM-DD" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(DateFormat, "DateFormat", V_STRING) Then GoTo Finally + End If + sFormat = UCase(DateFormat) + If Len(sFormat) <> Len(cstFormat)Then GoTo Finally + If sFormat <> cstFormat Then ' Do not check if default format + If Not SF_String.IsRegex(sFormat, cstFormatRegex) Then GoTo Finally + End If + +Try: + If Len(InputStr) = Len(DateFormat) Then + ' Extract the date components YYYY, MM, DD from the input string + iYear = CInt(Mid(InputStr, InStr(sFormat, "YYYY"), 4)) + iMonth = CInt(Mid(InputStr, InStr(sFormat, "MM"), 2)) + iDay = CInt(Mid(InputStr, InStr(sFormat, "DD"), 2)) + ' Check the validity of the date + On Local Error GoTo NotADate + dDate = DateSerial(iYear, iMonth, iDay) + bADate = True ' Statement reached only if no error + End If + +Finally: + IsADate = bADate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +NotADate: + On Error GoTo 0 ' Reset the error object + GoTo Finally +End Function ' ScriptForge.SF_String.IsADate + +REM ----------------------------------------------------------------------------- +Public Function IsAlpha(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are alphabetic +''' Alphabetic characters are those characters defined in the Unicode character database as “Letter” +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is alphabetic and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsAlpha("àénΣlPµ") returns True +''' Note: +''' Use SF_String.IsRegex("...", REGEXALPHA) to limit characters to latin alphabet + +Dim bAlpha As Boolean ' Return value +Dim lLength As Long ' Length of InputStr +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER +Dim i As Long +Const cstThisSub = "String.IsAlpha" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAlpha = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + lType = oChar.getCharacterType(InputStr, i, oLocale) + bAlpha = ( (lType And lLETTER) = lLETTER ) + If Not bAlpha Then Exit For + Next i + End If + +Finally: + IsAlpha = bAlpha + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsAlpha + +REM ----------------------------------------------------------------------------- +Public Function IsAlphaNum(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are alphabetic, digits or "_" (underscore) +''' The first character must not be a digit +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is alphanumeric and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsAlphaNum("_ABC_123456_abcàénΣlPµ") returns True + +Dim bAlphaNum As Boolean ' Return value +Dim sInputStr As String ' Alias of InputStr without underscores +Dim sFirst As String ' Leftmost character of InputStr +Dim lLength As Long ' Length of InputStr +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER +Dim lDIGIT As Long : lDIGIT = com.sun.star.i18n.KCharacterType.DIGIT +Dim i As Long +Const cstThisSub = "String.IsAlphaNum" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAlphaNum = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + sFirst = Left(InputStr, 1) + bAlphanum = ( sFirst < "0" Or sFirst > "9" ) + If bAlphaNum Then + sInputStr = Replace(InputStr, "_", "A") ' Replace by an arbitrary alphabetic character + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + lType = oChar.getCharacterType(sInputStr, i, oLocale) + bAlphaNum = ( (lType And lLETTER) = lLETTER _ + Or (lType And lDIGIT) = lDIGIT ) + If Not bAlphaNum Then Exit For + Next i + End If + End If + +Finally: + IsAlphaNum = bAlphaNum + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsAlphaNum + +REM ----------------------------------------------------------------------------- +Public Function IsAscii(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are Ascii characters +''' Ascii characters are those characters defined between &H00 and &H7F +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is Ascii and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsAscii("a%?,25") returns True + +Dim bAscii As Boolean ' Return value +Dim lLength As Long ' Length of InputStr +Dim sChar As String ' Single character +Dim i As Long +Const cstThisSub = "String.IsAscii" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAscii = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + For i = 1 To lLength + sChar = Mid(InputStr, i, 1) + bAscii = ( Asc(sChar) <= 127 ) + If Not bAscii Then Exit For + Next i + End If + +Finally: + IsAscii = bAscii + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsAscii + +REM ----------------------------------------------------------------------------- +Public Function IsDigit(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are digits +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only digits and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsDigit("123456") returns True + +Dim bDigit As Boolean ' Return value +Const cstThisSub = "String.IsDigit" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bDigit = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bDigit = SF_String.IsRegex(InputStr, REGEXDIGITS, CaseSensitive := False) + +Finally: + IsDigit = bDigit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsDigit + +REM ----------------------------------------------------------------------------- +Public Function IsEmail(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the string is a valid email address +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains an email address and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsEmail("first.last@something.org") returns True + +Dim bEmail As Boolean ' Return value +Const cstThisSub = "String.IsEmail" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bEmail = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bEmail = SF_String.IsRegex(InputStr, REGEXEMAIL, CaseSensitive := False) + +Finally: + IsEmail = bEmail + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsEmail + +REM ----------------------------------------------------------------------------- +Public Function IsFileName(Optional ByRef InputStr As Variant _ + , Optional ByVal OSName As Variant _ + ) As Boolean +''' Return True if the string is a valid filename in a given operating system +''' Args: +''' InputStr: the input string +''' OSName: Windows, Linux, macOS or Solaris +''' The default is the current operating system on which the script is run +''' Returns: +''' True if the string contains a valid filename and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsFileName("/home/a file name.odt", "LINUX") returns True + +Dim bFileName As Boolean ' Return value +Dim sRegex As String ' Regex to apply depending on OS +Const cstThisSub = "String.IsFileName" +Const cstSubArgs = "InputStr, [OSName=""Windows""|""Linux""|""macOS""|Solaris""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bFileName = False + +Check: + If IsMissing(OSName) Or IsEmpty(OSName) Then + If _SF_.OSname = "" Then _SF_.OSName = SF_Platform.OSName + OSName = _SF_.OSName + End If + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(OSName, "OSName", V_STRING, Array("Windows", "Linux", "macOS", "Solaris")) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + Select Case UCase(OSName) + Case "LINUX", "MACOS", "SOLARIS" : sRegex = REGEXFILELINUX + Case "WINDOWS" : sRegex = REGEXFILEWIN + End Select + bFileName = SF_String.IsRegex(InputStr, sRegex, CaseSensitive := False) + End If + +Finally: + IsFileName = bFileName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsFileName + +REM ----------------------------------------------------------------------------- +Public Function IsHexDigit(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are hexadecimal digits +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only hexadecimal igits and there is at least one character +''' The prefixes "0x" and "&H" are admitted +''' False otherwise +''' Examples: +''' SF_String.IsHexDigit("&H00FF") returns True + +Dim bHexDigit As Boolean ' Return value +Const cstThisSub = "String.IsHexDigit" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bHexDigit = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bHexDigit = SF_String.IsRegex(InputStr, REGEXHEXA, CaseSensitive := False) + +Finally: + IsHexDigit = bHexDigit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsHexDigit + +REM ----------------------------------------------------------------------------- +Public Function IsIBAN(Optional ByVal InputStr As Variant) As Boolean +''' Returns True if the input string is a valid International Bank Account Number +''' Read https://en.wikipedia.org/wiki/International_Bank_Account_Number +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains a valid IBAN number. The comparison is not case-sensitive +''' Examples: +''' SF_String.IsIBAN("BR15 0000 0000 0000 1093 2840 814 P2") returns True + +Dim bIBAN As Boolean ' Return value +Dim sIBAN As String ' Transformed input string +Dim sChar As String ' A single character +Dim sLetter As String ' Integer representation of letters +Dim iIndex As Integer ' Index in IBAN string +Dim sLong As String ' String representation of a Long +Dim iModulo97 As Integer ' Remainder of division by 97 +Dim i As Integer +Const cstThisSub = "String.IsIBAN" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bIBAN = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + sIBAN = "" + ' 1. Remove spaces. Check that the total IBAN length is correct as per the country. If not, the IBAN is invalid + ' NOT DONE: Country specific + sIBAN = Replace(InputStr, " ", "") + If Len(sIBAN) < 5 Or Len(sIBAN) > 34 Then GoTo Finally + + ' 2. Move the four initial characters to the end of the string. String is case-insensitive + sIBAN = UCase(Mid(sIBAN, 5) & Left(sIBAN, 4)) + + ' 3. Replace each letter in the string with two digits, thereby expanding the string, where A = 10, B = 11, ..., Z = 35 + iIndex = 1 + Do While iIndex < Len(sIBAN) + sChar = Mid(sIBAN, iIndex, 1) + If sChar >= "A" And sChar <= "Z" Then + sLetter = CStr(Asc(sChar) - Asc("A") + 10) + sIBAN = Left(sIBAN, iIndex - 1) & sLetter & Mid(sIBAN, iIndex + 1) + iIndex = iIndex + 2 + ElseIf sChar < "0" Or sChar > "9" Then ' Remove any non-alphanumeric character + GoTo Finally + Else + iIndex = iIndex + 1 + End If + Loop + + ' 4. Interpret the string as a decimal integer and compute the remainder of that number on division by 97 + ' Computation is done in chunks of 9 digits + iIndex = 3 + sLong = Left(sIBAN, 2) + Do While iIndex <= Len(sIBAN) + sLong = sLong & Mid(sIBAN, iIndex, 7) + iModulo97 = CLng(sLong) Mod 97 + iIndex = iIndex + Len(sLong) - 2 + sLong = Right("0" & CStr(iModulo97), 2) ' Force leading zero + Loop + + bIBAN = ( iModulo97 = 1 ) + +Finally: + IsIBAN = bIBAN + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsIBAN + +REM ----------------------------------------------------------------------------- +Public Function IsIPv4(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the string is a valid IPv4 address +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains a valid IPv4 address and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsIPv4("192.168.1.50") returns True + +Dim bIPv4 As Boolean ' Return value +Const cstThisSub = "String.IsIPv4" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bIPv4 = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bIPv4 = SF_String.IsRegex(InputStr, REGEXIPV4, CaseSensitive := False) + +Finally: + IsIPv4 = bIPv4 + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsIPv4 + +REM ----------------------------------------------------------------------------- +Public Function IsLike(Optional ByRef InputStr As Variant _ + , Optional ByVal Pattern As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the whole input string matches a given pattern containing wildcards +''' Args: +''' InputStr: the input string +''' Pattern: the pattern as a string +''' Admitted wildcard are: the "?" represents any single character +''' the "*" represents zero, one, or multiple characters +''' CaseSensitive: default = False +''' Returns: +''' True if a match is found +''' Zero-length input or pattern strings always return False +''' Examples: +''' SF_String.IsLike("aAbB", "?A*") returns True +''' SF_String.IsLike("C:\a\b\c\f.odb", "?:*.*") returns True + +Dim bLike As Boolean ' Return value +' Build an equivalent regular expression by escaping the special characters present in Pattern +Dim sRegex As String ' Equivalent regular expression +Const cstSpecialChars = "\,^,$,.,|,+,(,),[,{,?,*" ' List of special chars in regular expressions +Const cstEscapedChars = "\\,\^,\$,\.,\|,\+,\(,\),\[,\{,.,.*" + +Const cstThisSub = "String.IsLike" +Const cstSubArgs = "InputStr, Pattern, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bLike = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Pattern, "Pattern", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 And Len(Pattern) > 0 Then + ' Substitute special chars by escaped chars + sRegex = SF_String.ReplaceStr(Pattern, Split(cstSPecialChars, ","), Split(cstEscapedChars, ",")) + bLike = SF_String.IsRegex(InputStr, sRegex, CaseSensitive) + End If + +Finally: + IsLike = bLike + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsLike + +REM ----------------------------------------------------------------------------- +Public Function IsLower(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are in lower case +''' Non alphabetic characters are ignored +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only lower case characters and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsLower("abc'(-xyz") returns True + +Dim bLower As Boolean ' Return value +Const cstThisSub = "String.IsLower" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bLower = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bLower = ( StrComp(InputStr, LCase(InputStr), 1) = 0 ) + +Finally: + IsLower = bLower + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsLower + +REM ----------------------------------------------------------------------------- +Public Function IsPrintable(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are printable +''' In particular, control characters (Ascii <= 1F) are not printable +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is printable and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsPrintable("àén ΣlPµ Русский") returns True + +Dim bPrintable As Boolean ' Return value +Dim lLength As Long ' Length of InputStr +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim sChar As String ' A single character +Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE +Dim i As Long +Const cstThisSub = "String.IsPrintable" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bPrintable = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + sChar = Mid(InputStr, i + 1, 1) + lType = oChar.getCharacterType(sChar, 0, oLocale) + ' Parenthses (), [], {} have a KCharacterType = 0 + bPrintable = ( (lType And lPRINTABLE) = lPRINTABLE Or (lType = 0 And Asc(sChar) <= 127) ) + If Not bPrintable Then Exit For + Next i + End If + +Finally: + IsPrintable = bPrintable + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsPrintable + +REM ----------------------------------------------------------------------------- +Public Function IsRegex(Optional ByRef InputStr As Variant _ + , Optional ByVal Regex As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the whole input string matches a given regular expression +''' Args: +''' InputStr: the input string +''' Regex: the regular expression as a string +''' CaseSensitive: default = False +''' Returns: +''' True if a match is found +''' Zero-length input or regex strings always return False +''' Examples: +''' SF_String.IsRegex("aAbB", "[A-Za-z]+") returns True + +Dim bRegex As Boolean ' Return value +Dim lStart As Long ' Must be 1 +Dim sMatch As String ' Matching string +Const cstBegin = "^" ' Beginning of line symbol +Const cstEnd = "$" ' End of line symbol +Const cstThisSub = "String.IsRegex" +Const cstSubArgs = "InputStr, Regex, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRegex = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 And Len(Regex) > 0 Then + ' Whole string must match Regex + lStart = 1 + If Left(Regex, 1) <> cstBegin Then Regex = cstBegin & Regex + If Right(Regex, 1) <> cstEnd Then Regex = Regex & cstEnd + sMatch = SF_String.FindRegex(InputStr, Regex, lStart, CaseSensitive) + ' Match ? + bRegex = ( lStart = 1 And Len(sMatch) = Len(InputStr) ) + End If + +Finally: + IsRegex = bRegex + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsRegex + +REM ----------------------------------------------------------------------------- +Public Function IsSheetName(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the input string can serve as a valid Calc sheet name +''' The sheet name must not contain the characters [ ] * ? : / \ +''' or the character ' (apostrophe) as first or last character. + +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is validated as a potential Calc sheet name, False otherwise +''' Examples: +''' SF_String.IsSheetName("1àbc + ""def""") returns True + +Dim bSheetName As Boolean ' Return value +Const cstThisSub = "String.IsSheetName" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSheetName = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + If Left(InputStr, 1) = "'" Or Right(InputStr, 1) = "'" Then + ElseIf InStr(InputStr, "[") _ + + InStr(InputStr, "]") _ + + InStr(InputStr, "*") _ + + InStr(InputStr, "?") _ + + InStr(InputStr, ":") _ + + InStr(InputStr, "/") _ + + InStr(InputStr, "\") _ + = 0 Then + bSheetName = True + End If + End If + +Finally: + IsSheetName = bSheetName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsSheetName + +REM ----------------------------------------------------------------------------- +Public Function IsTitle(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the 1st character of every word is in upper case and the other characters are in lower case +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is capitalized and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsTitle("This Is A Title For Jean-Pierre") returns True + +Dim bTitle As Boolean ' Return value +Const cstThisSub = "String.IsTitle" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bTitle = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bTitle = ( StrComp(InputStr, SF_String.Capitalize(InputStr), 1) = 0 ) + +Finally: + IsTitle = bTitle + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsTitle + +REM ----------------------------------------------------------------------------- +Public Function IsUpper(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are in upper case +''' Non alphabetic characters are ignored +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only upper case characters and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsUpper("ABC'(-XYZ") returns True + +Dim bUpper As Boolean ' Return value +Const cstThisSub = "String.IsUpper" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bUpper = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bUpper = ( StrComp(InputStr, UCase(InputStr), 1) = 0 ) + +Finally: + IsUpper = bUpper + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsUpper + +REM ----------------------------------------------------------------------------- +Public Function IsUrl(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the string is a valid absolute URL (Uniform Resource Locator) +''' The parsing is done by the ParseStrict method of the URLTransformer UNO service +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1util_1_1XURLTransformer.html +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains a URL and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsUrl("http://foo.bar/?q=Test%20URL-encoded%20stuff") returns True + +Dim bUrl As Boolean ' Return value +Const cstThisSub = "String.IsUrl" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bUrl = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bUrl = ( Len(SF_FileSystem._ParseUrl(InputStr).Main) > 0 ) + +Finally: + IsUrl = bUrl + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsUrl + +REM ----------------------------------------------------------------------------- +Public Function IsWhitespace(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are whitespaces +''' Whitespaces include Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160), +''' Line separator(8232), Paragraph separator(8233) +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only whitespaces and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsWhitespace(" " & Chr(9) & Chr(10)) returns True + +Dim bWhitespace As Boolean ' Return value +Const cstThisSub = "String.IsWhitespace" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bWhitespace = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bWhitespace = SF_String.IsRegex(InputStr, REGEXWHITESPACES, CaseSensitive := False) + +Finally: + IsWhitespace = bWhitespace + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsWhitespace + +REM ----------------------------------------------------------------------------- +Public Function JustifyCenter(Optional ByRef InputStr As Variant _ + , Optional ByVal Length As Variant _ + , Optional ByVal Padding As Variant _ + ) As String +''' Return the input string center justified +''' Args: +''' InputStr: the input string +''' Length: the resulting string length (default = length of input string) +''' Padding: the padding (single) character (default = the ascii space) +''' Returns: +''' The input string without its leading and trailing white spaces +''' completed left and right up to a total length of Length with the character Padding +''' If the input string is empty, the returned string is empty too +''' If the requested length is shorter than the center justified input string, +''' then the returned string is truncated +''' Examples: +''' SF_String.JustifyCenter(" ABCDE ", Padding := "x") returns "xxABCDEFxx" + +Dim sJustify As String ' Return value +Dim lLength As Long ' Length of input string +Dim lJustLength As Long ' Length of trimmed input string +Dim sPadding As String ' Series of Padding characters +Const cstThisSub = "String.JustifyCenter" +Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJustify = "" + +Check: + If IsMissing(Length) Or IsEmpty(Length) Then Length = 0 + If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " " + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Length, "Length", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Padding, "Padding", V_STRING) Then GoTo Finally + End If + If Len(Padding) = 0 Then Padding = " " Else Padding = Left(Padding, 1) + +Try: + lLength = Len(InputStr) + If Length = 0 Then Length = lLength + If lLength > 0 Then + sJustify = SF_String.TrimExt(InputStr) ' Trim left and right + lJustLength = Len(sJustify) + If lJustLength > Length Then + sJustify = Mid(sJustify, Int((lJustLength - Length) / 2) + 1, Length) + ElseIf lJustLength < Length Then + sPadding = String(Int((Length - lJustLength) / 2), Padding) + sJustify = sPadding & sJustify & sPadding + If Len(sJustify) < Length Then sJustify = sJustify & Padding ' One Padding char is lacking when lJustLength is odd + End If + End If + +Finally: + JustifyCenter = sJustify + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.JustifyCenter + +REM ----------------------------------------------------------------------------- +Public Function JustifyLeft(Optional ByRef InputStr As Variant _ + , Optional ByVal Length As Variant _ + , Optional ByVal Padding As Variant _ + ) As String +''' Return the input string left justified +''' Args: +''' InputStr: the input string +''' Length: the resulting string length (default = length of input string) +''' Padding: the padding (single) character (default = the ascii space) +''' Returns: +''' The input string without its leading white spaces +''' filled up to a total length of Length with the character Padding +''' If the input string is empty, the returned string is empty too +''' If the requested length is shorter than the left justified input string, +''' then the returned string is truncated +''' Examples: +''' SF_String.JustifyLeft(" ABCDE ", Padding := "x") returns "ABCDE xxx" + +Dim sJustify As String ' Return value +Dim lLength As Long ' Length of input string +Const cstThisSub = "String.JustifyLeft" +Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJustify = "" + +Check: + If IsMissing(Length) Or IsEmpty(Length) Then Length = 0 + If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " " + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Length, "Length", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Padding, "Padding", V_STRING) Then GoTo Finally + End If + If Len(Padding) = 0 Then Padding = " " Else Padding = Left(Padding, 1) + +Try: + lLength = Len(InputStr) + If Length = 0 Then Length = lLength + If lLength > 0 Then + sJustify = SF_String.ReplaceRegex(InputStr, REGEXLTRIM, "") ' Trim left + If Len(sJustify) >= Length Then + sJustify = Left(sJustify, Length) + Else + sJustify = sJustify & String(Length - Len(sJustify), Padding) + End If + End If + +Finally: + JustifyLeft = sJustify + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.JustifyLeft + +REM ----------------------------------------------------------------------------- +Public Function JustifyRight(Optional ByRef InputStr As Variant _ + , Optional ByVal Length As Variant _ + , Optional ByVal Padding As Variant _ + ) As String +''' Return the input string right justified +''' Args: +''' InputStr: the input string +''' Length: the resulting string length (default = length of input string) +''' Padding: the padding (single) character (default = the ascii space) +''' Returns: +''' The input string without its trailing white spaces +''' preceded up to a total length of Length with the character Padding +''' If the input string is empty, the returned string is empty too +''' If the requested length is shorter than the right justified input string, +''' then the returned string is right-truncated +''' Examples: +''' SF_String.JustifyRight(" ABCDE ", Padding := "x") returns "x ABCDE" + +Dim sJustify As String ' Return value +Dim lLength As Long ' Length of input string +Const cstThisSub = "String.JustifyRight" +Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJustify = "" + +Check: + If IsMissing(Length) Or IsEmpty(Length) Then Length = 0 + If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " " + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Length, "Length", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Padding, "Padding", V_STRING) Then GoTo Finally + End If + If Len(Padding) = 0 Then Padding = " " Else Padding = Left(Padding, 1) + +Try: + lLength = Len(InputStr) + If Length = 0 Then Length = lLength + If lLength > 0 Then + sJustify = SF_String.ReplaceRegex(InputStr, REGEXRTRIM, "") ' Trim right + If Len(sJustify) >= Length Then + sJustify = Right(sJustify, Length) + Else + sJustify = String(Length - Len(sJustify), Padding) & sJustify + End If + End If + +Finally: + JustifyRight = sJustify + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.JustifyRight + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the String service as an array + + Methods = Array( _ + "Capitalize" _ + , "Count" _ + , "EndWith" _ + , "Escape" _ + , "ExpandTabs" _ + , "FilterNotPrintable" _ + , "FindRegex" _ + , "HashStr" _ + , "HtmlEncode" _ + , "IsADate" _ + , "IsAlpha" _ + , "IsAlphaNum" _ + , "IsAscii" _ + , "IsDigit" _ + , "IsEmail" _ + , "IsFileName" _ + , "IsHexDigit" _ + , "IsIPv4" _ + , "IsLike" _ + , "IsLower" _ + , "IsPrintable" _ + , "IsRegex" _ + , "IsSheetName" _ + , "IsTitle" _ + , "IsUpper" _ + , "IsUrl" _ + , "IsWhitespace" _ + , "JustifyCenter" _ + , "JustifyLeft" _ + , "JustifyRight" _ + , "Quote" _ + , "ReplaceChar" _ + , "ReplaceRegex" _ + , "ReplaceStr" _ + , "Represent" _ + , "Reverse" _ + , "SplitLines" _ + , "SplitNotQuoted" _ + , "StartsWith" _ + , "TrimExt" _ + , "Unescape" _ + , "Unquote" _ + , "Wrap" _ + ) + +End Function ' ScriptForge.SF_String.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties as an array + + Properties = Array( _ + "sfCR" _ + , "sfCRLF" _ + , "sfLF" _ + , "sfNEWLINE" _ + , "sfTAB" _ + ) + +End Function ' ScriptForge.SF_Session.Properties + +REM ----------------------------------------------------------------------------- +Public Function Quote(Optional ByRef InputStr As Variant _ + , Optional ByVal QuoteChar As String _ + ) As String +''' Return the input string surrounded with double quotes +''' Used f.i. to prepare a string field to be stored in a csv-like file +''' Args: +''' InputStr: the input string +''' QuoteChar: either " (default) or ' +''' Returns: +''' Existing - including leading and/or trailing - double quotes are doubled +''' Examples: +''' SF_String.Quote("àé""n ΣlPµ Русский") returns """àé""""n ΣlPµ Русский""" + +Dim sQuote As String ' Return value +Const cstDouble = """" : Const cstSingle = "'" +Const cstEscape = "\" +Const cstThisSub = "String.Quote" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sQuote = "" + +Check: + If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally + End If + +Try: + If QuoteChar = cstDouble Then + sQuote = cstDouble & Replace(InputStr, cstDouble, cstDouble & cstDouble) & cstDouble + Else + sQuote = Replace(InputStr, cstEscape, cstEscape & cstEscape) + sQuote = cstSingle & Replace(sQuote, cstSingle, cstEscape & cstSingle) & cstSingle + End If + +Finally: + Quote = sQuote + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Quote + +REM ----------------------------------------------------------------------------- +Public Function ReplaceChar(Optional ByRef InputStr As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal After As Variant _ + ) As String +''' Replace in InputStr all occurrences of any character from Before +''' by the corresponding character in After +''' Args: +''' InputStr: the input string on which replacements should occur +''' Before: a string of characters to replace 1 by 1 in InputStr +''' After: the replacing characters +''' Returns: +''' The new string after replacement of Nth character of Before by the Nth character of After +''' Replacements are done one by one => potential overlaps +''' If the length of Before is larger than the length of After, +''' the residual characters of Before are replaced by the last character of After +''' The input string when Before is the zero-length string +''' Examples: easily remove accents +''' SF_String.ReplaceChar("Protégez votre vie privée", "àâãçèéêëîïôöûüýÿ", "aaaceeeeiioouuyy") +''' returns "Protegez votre vie privee" +''' SF_String.ReplaceChar("Protégez votre vie privée", SF_String.CHARSWITHACCENT, SF_String.CHARSWITHOUTACCENT) + +Dim sOutput As String ' Return value +Dim iCaseSensitive As Integer ' Always 0 (True) +Dim sBefore As String ' A single character extracted from InputStr +Dim sAfter As String ' A single character extracted from After +Dim lInStr As Long ' Output of InStr() +Dim i As Long +Const cstThisSub = "String.ReplaceChar" +Const cstSubArgs = "InputStr, Before, After" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(After, "After", V_STRING) Then GoTo Finally + End If + +Try: + ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive) + sOutput = InputStr + iCaseSensitive = 0 + + ' Replace one by one up length of Before and After + If Len(Before) > 0 Then + i = 1 + Do While i <= Len(sOutput) + sBefore = Mid(sOutput, i, 1) + lInStr = InStr(1, Before, sBefore, iCaseSensitive) + If lInStr > 0 Then + If Len(After) = 0 Then + sAfter = "" + ElseIf lInStr > Len(After) Then + sAfter = Right(After, 1) + Else + sAfter = Mid(After, lInStr, 1) + End If + sOutput = Left(sOutput, i - 1) & Replace(sOutput, sBefore, sAfter, i, Empty, iCaseSensitive) + End If + i = i + 1 + Loop + End If + +Finally: + ReplaceChar = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ReplaceChar + +REM ----------------------------------------------------------------------------- +Public Function ReplaceRegex(Optional ByRef InputStr As Variant _ + , Optional ByVal Regex As Variant _ + , Optional ByRef NewStr As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As String +''' Replace in InputStr all occurrences of a given regular expression by NewStr +''' Args: +''' InputStr: the input string where replacements should occur +''' Regex: the regular expression +''' NewStr: the replacing string +''' CaseSensitive: default = False +''' Returns: +''' The new string after all replacements +''' Examples: +''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "[a-z]", "x", CaseSensitive := True) +''' returns "Lxxxx xxxxx xxxxx xxx xxxx, xxxxxxxxxxx xxxxxxxxxx xxxx." +''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", "x", CaseSensitive := False) +''' returns "x x x x x, x x x." (each word is replaced by x) + + +Dim sOutput As String ' Return value +Dim lStartOld As Long ' Previous start of search +Dim lStartNew As Long ' Next start of search +Dim sSubstring As String ' Substring to replace +Const cstThisSub = "String.ReplaceRegex" +Const cstSubArgs = "InputStr, Regex, NewStr, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(NewStr, "NewStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + sOutput = "" + lStartNew = 1 + lStartOld = 1 + + Do While lStartNew >= 1 And lStartNew <= Len(InputStr) + sSubstring = SF_String.FindRegex(InputStr, Regex, lStartNew, CaseSensitive) + If lStartNew = 0 Then ' Regex not found + ' Copy remaining substring of InputStr before leaving + sOutput = sOutput & Mid(InputStr, lStartOld) + Exit Do + End If + ' Append the interval between 2 occurrences and the replacing string + If lStartNew > lStartOld Then sOutput = sOutput & Mid(InputStr, lStartOld, lStartNew - lStartOld) + sOutput = sOutput & NewStr + lStartOld = lStartNew + Len(sSubstring) + lStartNew = lStartOld + Loop + +Finally: + ReplaceRegex = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ReplaceRegex + +REM ----------------------------------------------------------------------------- +Public Function ReplaceStr(Optional ByRef InputStr As Variant _ + , Optional ByVal OldStr As Variant _ + , Optional ByVal NewStr As Variant _ + , Optional ByVal Occurrences As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As String +''' Replace in InputStr some or all occurrences of OldStr by NewStr +''' Args: +''' InputStr: the input string on which replacements should occur +''' OldStr: the string to replace or a 1D array of strings to replace +''' Zero-length strings are ignored +''' NewStr: the replacing string or a 1D array of replacing strings +''' If OldStr is an array +''' each occurrence of any of the items of OldStr is replaced by NewStr +''' If OldStr and NewStr are arrays +''' replacements occur one by one up to the UBound of NewStr +''' remaining OldStr(ings) are replaced by the last element of NewStr +''' Occurrences: the maximum number of replacements (0, default, = all occurrences) +''' Is applied for each single replacement when OldStr is an array +''' CaseSensitive: True or False (default) +''' Returns: +''' The new string after replacements +''' Replacements are done one by one when OldStr is an array => potential overlaps +''' Examples: +''' SF_String.ReplaceStr("abCcdefghHij", Array("c", "h"), Array("Y", "Z"), CaseSensitive := False) returns "abYYdefgZZij" + +Dim sOutput As String ' Return value +Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive +Dim vOccurrences As Variant ' Variant alias for Integer Occurrences +Dim sNewStr As String ' Alias for a NewStr item +Dim i As Long, j As Long +Const cstThisSub = "String.ReplaceStr" +Const cstSubArgs = "InputStr, OldStr, NewStr, [Occurrences=0], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0 + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If IsArray(OldStr) Then + If Not SF_Utils._ValidateArray(OldStr, "OldStr", 1, V_STRING, True) Then GoTo Finally + Else + If Not SF_Utils._Validate(OldStr, "OldStr", V_STRING) Then GoTo Finally + End If + If IsArray(NewStr) Then + If Not SF_Utils._ValidateArray(NewStr, "NewStr", 1, V_STRING, True) Then GoTo Finally + Else + If Not SF_Utils._Validate(NewStr, "NewStr", V_STRING) Then GoTo Finally + End If + If Not SF_Utils._Validate(Occurrences, "Occurrences", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive) + sOutput = InputStr + iCaseSensitive = Iif(CaseSensitive, 0, 1) ' 1 = False ;) + vOccurrences = Iif(Occurrences = 0, Empty, Occurrences) ' Empty = no limit + If Not IsArray(OldStr) Then OldStr = Array(OldStr) + If Not IsArray(NewStr) Then NewStr = Array(NewStr) + + ' Replace one by one up to UBounds of Old and NewStr + j = LBound(NewStr) - 1 + For i = LBound(OldStr) To UBound(OldStr) + j = j + 1 + If j <= UBound(NewStr) Then sNewStr = NewStr(j) ' Else do not change + If StrComp(OldStr(i), sNewStr, 1) <> 0 Then + sOutput = Replace(sOutput, OldStr(i), sNewStr, 1, vOccurrences, iCaseSensitive) + End If + Next i + +Finally: + ReplaceStr = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ReplaceStr + +REM ----------------------------------------------------------------------------- +Public Function Represent(Optional ByRef AnyValue As Variant _ + , Optional ByVal MaxLength As Variant _ + ) As String +''' Return a readable (string) form of the argument, truncated at MaxLength +''' Args: +''' AnyValue: really any value (object, date, whatever) +''' MaxLength: the maximum length of the resulting string (Default = 0, unlimited) +''' Returns: +''' The argument converted or transformed into a string of a maximum length = MaxLength +''' Objects are surrounded with square brackets ([]) +''' In strings, tabs and line breaks are replaced by \t, \n or \r +''' If the effective length exceeds MaxLength, the final part of the string is replaced by " ... (N)" +''' where N = the total length of the string before truncation +''' Examples: +''' SF_String.Represent("this is a usual string") returns "this is a usual string" +''' SF_String.Represent("this is a usual string", 15) returns "this i ... (22)" +''' SF_String.Represent("this is a" & Chr(10) & " 2-lines string") returns "this is a\n 2-lines string" +''' SF_String.Represent(Empty) returns "[EMPTY]" +''' SF_String.Represent(Null) returns "[NULL]" +''' SF_String.Represent(Pi) returns "3.142" +''' SF_String.Represent(CreateUnoService("com.sun.star.util.PathSettings")) returns "[com.sun.star.comp.framework.PathSettings]" +''' SF_String.Represent(Array(1, 2, "Text" & Chr(9) & "here")) returns "[ARRAY] (0:2) (1, 2, Text\there)" +''' Dim myDict As Variant : myDict = CreateScriptService("Dictionary") +''' myDict.Add("A", 1) : myDict.Add("B", 2) +''' SF_String.Represent(myDict) returns "[Dictionary] ("A":1, "B":2)" + +Dim sRepr As String ' Return value +Const cstThisSub = "String.Represent" +Const cstSubArgs = "AnyValue, [MaxLength=0]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sRepr = "" + +Check: + If IsMissing(AnyValue) Then AnyValue = Empty + If IsMissing(MaxLength) Or IsEmpty(MaxLength) Then MaxLength = 0 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(MaxLength, "MaxLength", V_NUMERIC) Then GoTo Finally + End If + +Try: + sRepr = SF_Utils._Repr(AnyValue, MaxLength) + If MaxLength > 0 And MaxLength < Len(sRepr) Then sRepr = sRepr & " ... (" & Len(sRepr) & ")" + +Finally: + Represent = sRepr + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Represent + +REM ----------------------------------------------------------------------------- +Public Function Reverse(Optional ByRef InputStr As Variant) As String +''' Return the input string in reversed order +''' It is equivalent to the standard StrReverse Basic function +''' The latter requires the OpTion VBASupport 1 statement to be present in the module +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string in reversed order +''' Examples: +''' SF_String.Reverse("abcdefghij") returns "jihgfedcba" + +Dim sReversed As String ' Return value +Dim lLength As Long ' Length of input string +Dim i As Long +Const cstThisSub = "String.Reverse" +Const cstSubArgs = "InputSt" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sReversed = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + sReversed = Space(lLength) + For i = 1 To lLength + Mid(sReversed, i, 1) = Mid(InputStr, lLength - i + 1) + Next i + End If + +Finally: + Reverse = sReversed + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Reverse + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "String.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function SplitLines(Optional ByRef InputStr As Variant _ + , Optional ByVal KeepBreaks As Variant _ + ) As Variant +''' Return an array of the lines in a string, breaking at line boundaries +''' Line boundaries include LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30), +''' Next Line(133), Line separator(8232), Paragraph separator(8233) +''' Args: +''' InputStr: the input string +''' KeepBreaks: when True, line breaks are preserved in the output array (default = False) +''' Returns: +''' An array of all the individual lines +''' Examples: +''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3") returns ("Line1", "Line2", "Line3") +''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3" & Chr(10)) returns ("Line1", "Line2", "Line3", "") + +Dim vSplit As Variant ' Return value +Dim vLineBreaks As Variant ' Array of recognized line breaks +Dim vTokenizedBreaks As Variant ' Array of line breaks extended with tokens +Dim sAlias As String ' Alias for input string +' The procedure uses (dirty) placeholders to identify line breaks +' The used tokens are presumed unlikely present in text strings +Dim sTokenCRLF As String ' Token to identify combined CR + LF +Dim sToken As String ' Token to identify any line break +Dim i As Long +Const cstThisSub = "String.SplitLines" +Const cstSubArgs = "InputStr, [KeepBreaks=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSplit = Array() + +Check: + If IsMissing(KeepBreaks) Or IsEmpty(KeepBreaks) Then KeepBreaks = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(KeepBreaks, "KeepBreaks", V_BOOLEAN) Then GoTo Finally + End If + +Try: + ' In next list CR + LF must precede CR and LF + vLineBreaks = Array(SF_String.sfCRLF, SF_String.sfLF, Chr(12), SF_String.sfCR _ + , Chr(28), Chr(29), Chr(30), Chr(133), Chr(8232), Chr(8233)) + + If KeepBreaks = False Then + ' Replace line breaks by linefeeds and split on linefeeds + vSplit = Split(SF_String.ReplaceStr(InputStr, vLineBreaks, SF_String.sfLF, CaseSensitive := False), SF_String.sfLF) + Else + sTokenCRLF = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) + sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(2) + vTokenizedBreaks = Array() : ReDim vTokenizedBreaks(0 To UBound(vLineBreaks)) + ' Extend breaks with token + For i = 0 To UBound(vLineBreaks) + vTokenizedBreaks(i) = Iif(i = 0, sTokenCRLF, vLineBreaks(i)) & sToken + Next i + sAlias = SF_String.ReplaceStr(InputStr, vLineBreaks, vTokenizedBreaks, CaseSensitive := False) + ' Suppress CRLF tokens and split + vSplit = Split(Replace(sAlias, sTokenCRLF, SF_String.sfCRLF), sToken) + End If + +Finally: + SplitLines = vSplit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.SplitLines + +REM ----------------------------------------------------------------------------- +Public Function SplitNotQuoted(Optional ByRef InputStr As Variant _ + , Optional ByVal Delimiter As Variant _ + , Optional ByVal Occurrences As Variant _ + , Optional ByVal QuoteChar As Variant _ + ) As Variant +''' Split a string on Delimiter into an array. If Delimiter is part of a quoted (sub)string, it is ignored +''' (used f.i. for parsing of csv-like records) +''' Args: +''' InputStr: the input string +''' Might contain quoted substrings: +''' The quoting character must be the double quote (") +''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character +''' => [str\"i""ng] means [str"i"ng] +''' Delimiter: A string of one or more characters that is used to delimit the input string +''' The default is the space character +''' Occurrences: The number of substrings to return (Default = 0, meaning no limit) +''' QuoteChar: The quoting character, either " (default) or ' +''' Returns: +''' An array whose items are chunks of the input string, Delimiter not included +''' Examples: +''' SF_String.SplitNotQuoted("abc def ghi") returns ("abc", "def", "ghi") +''' SF_String.SplitNotQuoted("abc,""def,ghi""", ",") returns ("abc", """def,ghi""") +''' SF_String.SplitNotQuoted("abc,""def\"",ghi""", ",") returns ("abc", """def\"",ghi""") +''' SF_String.SplitNotQuoted("abc,""def\"",ghi"""",", ",") returns ("abc", """def\"",ghi""", "") + +Dim vSplit As Variant ' Return value +Dim lDelimLen As Long ' Length of Delimiter +Dim vStart As Variant ' Array of start positions of quoted strings +Dim vEnd As Variant ' Array of end positions of quoted strings +Dim lInStr As Long ' InStr() on input string +Dim lInStrPrev As Long ' Previous value of lInputStr +Dim lBound As Long ' UBound of vStart and vEnd +Dim lMin As Long ' Lower bound to consider when searching vStart and vEnd +Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oParse As Object ' com.sun.star.i18n.ParseResult +Dim sChunk As String ' Substring of InputStr +Dim bSplit As Boolean ' New chunk found or not +Dim i As Long +Const cstDouble = """" : Const cstSingle = "'" +Const cstThisSub = "String.SplitNotQuoted" +Const cstSubArgs = "InputStr, [Delimiter="" ""], [Occurrences=0], [QuoteChar=""" & cstDouble & """]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSplit = Array() + +Check: + If IsMissing(Delimiter) Or IsEmpty(Delimiter) Then Delimiter = " " + If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0 + If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Delimiter, "Delimiter", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Occurrences, "Occurrences", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally + End If + If Len(Delimiter) = 0 Then Delimiter = " " + +Try: + If Occurrences = 1 Or InStr(1, InputStr, Delimiter, 0) = 0 Then ' No reason to split + vSplit = Array(InputStr) + ElseIf InStr(1, InputStr, QuoteChar, 0) = 0 Then ' No reason to make a complex split + If Occurrences > 0 Then vSplit = Split(InputStr, Delimiter, Occurrences) Else vSplit = Split(InputStr, Delimiter) + Else + If Occurrences < 0 Then Occurrences = 0 + Set oCharacterClass = SF_Utils._GetUNOService("CharacterClass") + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + + ' Build an array of start/end positions of quoted strings containing at least 1x the Delimiter + vStart = Array() : vEnd = Array() + lInStr = InStr(1, InputStr, QuoteChar) + Do While lInStr > 0 + lBound = UBound(vStart) + ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b + Set oParse = oCharacterClass.parsePredefinedToken( _ + Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _ + , InputStr, lInStr - 1, oLocale, 0, "", 0, "") + If oParse.CharLen > 0 Then ' Is parsing successful ? + ' Is there some delimiter ? + If InStr(1, oParse.DequotedNameOrString, Delimiter, 0) > 0 Then + vStart = SF_Array.Append(vStart, lInStr + 0) + vEnd = SF_Array.Append(vEnd, lInStr + oParse.CharLen - 1) + End If + lInStr = InStr(lInStr + oParse.CharLen, InputStr, QuoteChar) + Else + lInStr = 0 + End If + Loop + + lBound = UBound(vStart) + lDelimLen = Len(Delimiter) + If lBound < 0 Then ' Usual split is applicable + vSplit = Split(InputStr, Delimiter, Occurrences) + Else + ' Split chunk by chunk + lMin = 0 + lInStrPrev = 0 + lInStr = InStr(1, InputStr, Delimiter, 0) + Do While lInStr > 0 + If Occurrences > 0 And Occurrences = UBound(vSplit) - 1 Then Exit Do + bSplit = False + ' Ignore found Delimiter if in quoted string + For i = lMin To lBound + If lInStr < vStart(i) Then + bSplit = True + Exit For + ElseIf lInStr > vStart(i) And lInStr < vEnd (i) Then + Exit For + Else + lMin = i + 1 + If i = lBound Then bSplit = True Else bSplit = ( lInStr < vStart(lMin) ) + End If + Next i + ' Build next chunk and store in split array + If bSplit Then + If lInStrPrev = 0 Then ' First chunk + sChunk = Left(InputStr, lInStr - 1) + Else + sChunk = Mid(InputStr, lInStrPrev + lDelimLen, lInStr - lInStrPrev - lDelimLen) + End If + vSplit = SF_Array.Append(vSplit, sChunk & "") + lInStrPrev = lInStr + End If + lInStr = InStr(lInStr + lDelimLen, InputStr, Delimiter, 0) + Loop + If Occurrences = 0 Or Occurrences > UBound(vSplit) + 1 Then + sChunk = Mid(InputStr, lInStrPrev + lDelimLen) ' Append last chunk + vSplit = SF_Array.Append(vSplit, sChunk & "") + End If + End If + End If + +Finally: + SplitNotQuoted = vSplit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.SplitNotQuoted + +REM ----------------------------------------------------------------------------- +Public Function StartsWith(Optional ByRef InputStr As Variant _ + , Optional ByVal Substring As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the first characters of InputStr are identical to Substring +''' Args: +''' InputStr: the input string +''' Substring: the prefixing characters +''' CaseSensitive: default = False +''' Returns: +''' True if the comparison is satisfactory +''' False if either InputStr or Substring have a length = 0 +''' False if Substr is longer than InputStr +''' Examples: +''' SF_String.StartsWith("abcdefg", "ABC") returns True +''' SF_String.StartsWith("abcdefg", "ABC", CaseSensitive := True) returns False + +Dim bStartsWith As Boolean ' Return value +Dim lSub As Long ' Length of SUbstring +Const cstThisSub = "String.StartsWith" +Const cstSubArgs = "InputStr, Substring, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bStartsWith = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lSub = Len(Substring) + If Len(InputStr) > 0 And lSub > 0 And lSub <= Len(InputStr) Then + bStartsWith = ( StrComp(Left(InputStr, lSub), Substring, Iif(CaseSensitive, 1, 0)) = 0 ) + End If + +Finally: + StartsWith = bStartsWith + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.StartsWith + +REM ----------------------------------------------------------------------------- +Public Function TrimExt(Optional ByRef InputStr As Variant) As String +''' Return the input string without its leading and trailing whitespaces +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string without its leading and trailing white spaces +''' Examples: +''' SF_String.TrimExt(" ABCDE" & Chr(9) & Chr(10) & Chr(13) & " ") returns "ABCDE" + +Dim sTrim As String ' Return value +Const cstThisSub = "String.TrimExt" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sTrim = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + sTrim = SF_String.ReplaceRegex(InputStr, REGEXLTRIM, "") ' Trim left + sTrim = SF_String.ReplaceRegex(sTrim, REGEXRTRIM, "") ' Trim right + End If + +Finally: + TrimExt = sTrim + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.TrimExt + +REM ----------------------------------------------------------------------------- +Public Function Unescape(Optional ByRef InputStr As Variant) As String +''' Convert any escaped characters in the input string +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string after replacement of \\, \n, \r, \t sequences +''' Examples: +''' SF_String.Unescape("abc\n\tdef\\n") returns "abc" & Chr(10) & Chr(9) & "def\n" + +Dim sUnescape As String ' Return value +Dim sToken As String ' Placeholder unlikely to be present in input string +Const cstThisSub = "String.Unescape" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sUnescape = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) ' Placeholder for "\\" + sUnescape = SF_String.ReplaceStr( InputStr _ + , Array("\\", "\n", "\r", "\t", sToken) _ + , Array(sToken, SF_String.sfLF, SF_String.sfCR, SF_String.sfTAB, "\") _ + ) + +Finally: + Unescape = sUnescape + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Unescape + +REM ----------------------------------------------------------------------------- +Public Function Unquote(Optional ByRef InputStr As Variant _ + , Optional ByVal QuoteChar As String _ + ) As String +''' Reset a quoted string to its original content +''' (used f.i. for parsing of csv-like records) +''' When the input string contains the quote character, the latter must be escaped: +''' - QuoteChar = double quote, by doubling it ("") +''' - QuoteChar = single quote, with a preceding backslash (\') +''' Args: +''' InputStr: the input string +''' QuoteChar: either " (default) or ' +''' Returns: +''' The input string after removal of leading/trailing quotes and escaped single/double quotes +''' The input string if not a quoted string +''' Examples: +''' SF_String.Unquote("""àé""""n ΣlPµ Русский""") returns "àé""n ΣlPµ Русский" + +Dim sUnquote As String ' Return value +Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oParse As Object ' com.sun.star.i18n.ParseResult +Const cstDouble = """" : Const cstSingle = "'" +Const cstThisSub = "String.Unquote" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sUnquote = "" + +Check: + If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally + End If + +Try: + If Left(InputStr, 1) <> QuoteChar Then ' No need to parse further + sUnquote = InputStr + Else + Set oCharacterClass = SF_Utils._GetUNOService("CharacterClass") + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + + ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b + Set oParse = oCharacterClass.parsePredefinedToken( _ + Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _ + , InputStr, 0, oLocale, 0, "", 0, "") + If oParse.CharLen > 0 Then ' Is parsing successful ? + sUnquote = oParse.DequotedNameOrString + Else + sUnquote = InputStr + End If + End If + +Finally: + Unquote = sUnquote + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Unquote + +REM ----------------------------------------------------------------------------- +Public Function Wrap(Optional ByRef InputStr As Variant _ + , Optional ByVal Width As Variant _ + , Optional ByVal TabSize As Variant _ + ) As Variant +''' Wraps every single paragraph in text (a string) so every line is at most Width characters long +''' Args: +''' InputStr: the input string +''' Width: the maximum number of characters in each line, default = 70 +''' TabSize: before wrapping the text, the existing TAB (Chr(9)) characters are replaced with spaces. +''' TabSize defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1 +''' Default = 8 +''' Returns: +''' Returns a zero-based array of output lines, without final newlines except the pre-existing line-breaks +''' Tabs are expanded. Symbolic line breaks are replaced by their hard equivalents +''' If the wrapped output has no content, the returned array is empty. +''' Examples: +''' SF_String.Wrap("Neque porro quisquam est qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit...", 20) + +Dim vWrap As Variant ' Return value +Dim vWrapLines ' Input string split on line breaks +Dim sWrap As String ' Intermediate string +Dim sLine As String ' Line after splitting on line breaks +Dim lPos As Long ' Position in sLine already wrapped +Dim lStart As Long ' Start position before and after regex search +Dim sSpace As String ' Next whitespace +Dim sChunk As String ' Next wrappable text chunk +Const cstThisSub = "String.Wrap" +Const cstSubArgs = "InputStr, [Width=70], [TabSize=8]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vWrap = Array() + +Check: + If IsMissing(Width) Or IsEmpty(Width) Then Width = 70 + If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = 8 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Width, "Width", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(TabSize, "TabSize", V_NUMERIC) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + sWrap = SF_String.Unescape(InputStr) ' Replace symbolic breaks + sWrap = SF_String.ExpandTabs(sWrap, TabSize) ' Interpret TABs to have a meaningful Width + ' First, split full string + vWrapLines = SF_String.SplitLines(sWrap, KeepBreaks := True) ' Keep pre-existing breaks + If UBound(vWrapLines) = 0 And Len(sWrap) <= Width Then ' Output a single line + vWrap = Array(sWrap) + Else + ' Second, split each line on Width + For Each sLine In vWrapLines + If Len(sLine) <= Width Then + If UBound(vWrap) < 0 Then vWrap = Array(sLine) Else vWrap = SF_Array.Append(vWrap, sLine) + Else + ' Scan sLine and accumulate found substrings up to Width + lStart = 1 + lPos = 0 + sWrap = "" + Do While lStart <= Len(sLine) + sSpace = SF_String.FindRegex(sLine, REGEXSPACES, lStart) + If lStart = 0 Then lStart = Len(sLine) + 1 + sChunk = Mid(sLine, lPos + 1, lStart - 1 - lPos + Len(sSpace)) + If Len(sWrap) + Len(sChunk) < Width Then ' Add chunk to current piece of line + sWrap = sWrap & sChunk + Else ' Save current line and initialize next one + If UBound(vWrap) < 0 Then vWrap = Array(sWrap) Else vWrap = SF_Array.Append(vWrap, sWrap) + sWrap = sChunk + End If + lPos = lPos + Len(sChunk) + lStart = lPos + 1 + Loop + ' Add last chunk + If Len(sWrap) > 0 Then + If UBound(vWrap) < 0 Then vWrap = Array(sWrap) Else vWrap = SF_Array.Append(vWrap, sWrap) + End If + End If + Next sLine + End If + End If + +Finally: + Wrap = vWrap + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Wrap + +REM ============================================================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Private Function _Repr(ByRef pvString As String) As String +''' Convert an arbitrary string to a readable string, typically for debugging purposes (DebugPrint ...) +''' Carriage Returns are replaced by \r. Other line breaks are replaced by \n +''' Tabs are replaced by \t +''' Backslashes are doubled +''' Other non printable characters are replaced by \x00 to \xFF or \x0000 to \xFFFF +''' Args: +''' pvString: the string to make readable +''' Return: +''' the converted string + +Dim sString As String ' Return value +Dim sChar As String ' A single character +Dim lAsc As Long ' Ascii value +Dim lPos As Long ' Position in sString +Dim i As Long + + ' Process TABs, CRs and LFs + sString = Replace(Replace(Replace(pvString, "\", "\\"), SF_String.sfCR, "\r"), SF_String.sfTAB, "\t") + sString = Join(SF_String.SplitLines(sString, KeepBreaks := False), "\n") + ' Process not printable characters + If Len(sString) > 0 Then + lPos = 1 + Do While lPos <= Len(sString) + sChar = Mid(sString, lPos, 1) + If Not SF_String.IsPrintable(sChar) Then + lAsc = Asc(sChar) + sChar = "\x" & Iif(lAsc < 255, Right("00" & Hex(lAsc), 2), Right("0000" & Hex(lAsc), 4)) + If lPos < Len(sString) Then + sString = Left(sString, lPos - 1) & sChar & Mid(sString, lPos + 1) + Else + sString = Left(sString, lPos - 1) & sChar + End If + End If + lPos = lPos + Len(sChar) + Loop + End If + + _Repr = sString + +End Function ' ScriptForge.SF_String._Repr + +REM ================================================ END OF SCRIPTFORGE.SF_STRING +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_TextStream.xba b/wizards/source/scriptforge/SF_TextStream.xba new file mode 100644 index 000000000..35f1b6fb2 --- /dev/null +++ b/wizards/source/scriptforge/SF_TextStream.xba @@ -0,0 +1,702 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_TextStream" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_TextStream +''' ============= +''' Class instantiated by the +''' SF_FileSystem.CreateTextFile +''' SF_FileSystem.OpenTextFile +''' methods to facilitate the sequential processing of text files +''' All open/read/write/close operations are presumed to happen during the same macro run +''' The encoding to be used may be chosen by the user +''' The list is in the Name column of https://www.iana.org/assignments/character-sets/character-sets.xhtml +''' Note that probably not all values are available +''' Line delimiters may be chosen by the user +''' In input, CR, LF or CR+LF are supported +''' In output, the default value is the usual newline on the actual operating system (see SF_FileSystem.sfNEWLINE) +''' +''' The design choices are largely inspired by +''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/textstream-object +''' The implementation is mainly based on the XTextInputStream and XTextOutputStream UNO interfaces +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1io_1_1XTextInputStream.html +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1io_1_1XTextOutputStream.html +''' +''' Instantiation example: +''' Dim FSO As Object, myFile As Object +''' Set FSO = CreateScriptService("FileSystem") +''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading) ' Once per file +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_textstream.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const FILENOTOPENERROR = "FILENOTOPENERROR" ' The file is already closed +Const FILEOPENMODEERROR = "FILEOPENMODEERROR" ' The file is open in incompatible mode +Const ENDOFFILEERROR = "ENDOFFILEERROR" ' When file was read, an end-of-file was encountered + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be TEXTSTREAM +Private ServiceName As String +Private _FileName As String ' File where it is about +Private _IOMode As Integer ' ForReading, ForWriting or ForAppending +Private _Encoding As String ' https://www.iana.org/assignments/character-sets/character-sets.xhtml +Private _NewLine As String ' Line break in write mode +Private _FileExists As Boolean ' True if file exists before open +Private _LineNumber As Long ' Number of lines read or written +Private _FileHandler As Object ' com.sun.star.io.XInputStream or + ' com.sun.star.io.XOutputStream or + ' com.sun.star.io.XStream +Private _InputStream As Object ' com.sun.star.io.TextInputStream +Private _OutputStream As Object ' com.sun.star.io.TextOutputStream +Private _ForceBlankLine As Boolean ' Workaround: XTextInputStream misses last line if file ends with newline + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "TEXTSTREAM" + ServiceName = "ScriptForge.TextStream" + _FileName = "" + _IOMode = -1 + _Encoding = "" + _NewLine = "" + _FileExists = False + _LineNumber = 0 + Set _FileHandler = Nothing + Set _InputStream = Nothing + Set _OutputStream = Nothing + _ForceBlankLine = False +End Sub ' ScriptForge.SF_TextStream Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' ScriptForge.SF_TextStream Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' ScriptForge.SF_TextStream Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get AtEndOfStream() As Boolean +''' In reading mode, True indicates that the end of the file has been reached +''' In write and append modes, or if the file is not ready => always True +''' The property should be invoked BEFORE each ReadLine() method: +''' A ReadLine() executed while AtEndOfStream is True will raise an error +''' Example: +''' Dim sLine As String +''' Do While Not myFile.AtEndOfStream +''' sLine = myFile.ReadLine() +''' ' ... +''' Loop + + AtEndOfStream = _PropertyGet("AtEndOfStream") + +End Property ' ScriptForge.SF_TextStream.AtEndOfStream + +REM ----------------------------------------------------------------------------- +Property Get Encoding() As String +''' Returns the name of the text file either in url or in native operating system format +''' Example: +''' Dim myFile As Object +''' FSO.FileNaming = "SYS" +''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt") +''' MsgBox myFile.Encoding ' UTF-8 + + Encoding = _PropertyGet("Encoding") + +End Property ' ScriptForge.SF_TextStream.Encoding + +REM ----------------------------------------------------------------------------- +Property Get FileName() As String +''' Returns the name of the text file either in url or in native operating system format +''' Example: +''' Dim myFile As Object +''' FSO.FileNaming = "SYS" +''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt") +''' MsgBox myFile.FileName ' C:\Temp\myFile.txt + + FileName = _PropertyGet("FileName") + +End Property ' ScriptForge.SF_TextStream.FileName + +REM ----------------------------------------------------------------------------- +Property Get IOMode() As String +''' Returns either "READ", "WRITE" or "APPEND" +''' Example: +''' Dim myFile As Object +''' FSO.FileNaming = "SYS" +''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt") +''' MsgBox myFile.IOMode ' READ + + IOMode = _PropertyGet("IOMode") + +End Property ' ScriptForge.SF_TextStream.IOMode + +REM ----------------------------------------------------------------------------- +Property Get Line() As Long +''' Returns the number of lines read or written so far +''' Example: +''' Dim myFile As Object +''' FSO.FileNaming = "SYS" +''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt", FSO.ForAppending) +''' MsgBox myFile.Line ' The number of lines already present in myFile + + Line = _PropertyGet("Line") + +End Property ' ScriptForge.SF_TextStream.Line + +REM ----------------------------------------------------------------------------- +Property Get NewLine() As Variant +''' Returns the current character string to be inserted between 2 successive written lines +''' The default value is the native line separator in the current operating system +''' Example: +''' MsgBox myFile.NewLine + + NewLine = _PropertyGet("NewLine") + +End Property ' ScriptForge.SF_TextStream.NewLine (get) + +REM ----------------------------------------------------------------------------- +Property Let NewLine(ByVal pvLineBreak As Variant) +''' Sets the current character string to be inserted between 2 successive written lines +''' Example: +''' myFile.NewLine = Chr(13) & Chr(10) + +Const cstThisSub = "TextStream.setNewLine" + + SF_Utils._EnterFunction(cstThisSub) + If VarType(pvLineBreak) = V_STRING Then _NewLine = pvLineBreak + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_TextStream.NewLine (let) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function CloseFile() As Boolean +''' Empties the output buffer if relevant. Closes the actual input or output stream +''' Args: +''' Returns: +''' True if the closure was successful +''' Exceptions: +''' FILENOTOPENERROR Nothing found to close +''' Examples: +''' myFile.CloseFile() + +Dim bClose As Boolean ' Return value +Const cstThisSub = "TextStream.CloseFile" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bClose = False + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsFileOpen() Then GoTo Finally + +Try: + If Not IsNull(_InputStream) Then _InputStream.closeInput() + If Not IsNull(_OutputStream) Then + _OutputStream.flush() + _OutputStream.closeOutput() + End If + Set _InputStream = Nothing + Set _OutputStream = Nothing + Set _FileHandler = Nothing + bClose = True + +Finally: + CloseFile = bClose + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_TextStream.CloseFile + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions: +''' see the exceptions of the individual properties +''' Examples: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "TextStream.GetProperty" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_TextStream.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "CloseFile" _ + , "ReadAll" _ + , "readLine" _ + , "SkipLine" _ + , "WriteBlankLines" _ + , "WriteLine" _ + ) + +End Function ' ScriptForge.SF_TextStream.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "AtEndOfStream" _ + , "Encoding" _ + , "FileName" _ + , "IOMode" _ + , "Line" _ + , "NewLine" _ + ) + +End Function ' ScriptForge.SF_TextStream.Properties + +REM ----------------------------------------------------------------------------- +Public Function ReadAll() As String +''' Returns all the remaining lines in the text stream as one string. Line breaks are NOT removed +''' The resulting string can be split in lines +''' either by using the usual Split Basic builtin function if the line delimiter is known +''' or with the SF_String.SplitLines method +''' For large files, using the ReadAll method wastes memory resources. +''' Other techniques should be used to input a file, such as reading a file line-by-line +''' Args: +''' Returns: +''' The read lines. The string may be empty. +''' Note that the Line property in incremented only by 1 +''' Exceptions: +''' FILENOTOPENERROR File not open or already closed +''' FILEOPENMODEERROR File opened in write or append modes +''' ENDOFFILEERROR Previous reads already reached the end of the file +''' Examples: +''' Dim a As String +''' a = myFile.ReadAll() + +Dim sRead As String ' Return value +Const cstThisSub = "TextStream.ReadAll" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sRead = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsFileOpen("READ") Then GoTo Finally + If _InputStream.isEOF() Then GoTo CatchEOF + End If + +Try: + sRead = _InputStream.readString(Array(), False) + _LineNumber = _LineNumber + 1 + +Finally: + ReadAll = sRead + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchEOF: + SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName) + GoTo Finally +End Function ' ScriptForge.SF_TextStream.ReadAll + +REM ----------------------------------------------------------------------------- +Public Function ReadLine() As String +''' Returns the next line in the text stream as a string. Line breaks are removed. +''' Args: +''' Returns: +''' The read line. The string may be empty. +''' Exceptions: +''' FILENOTOPENERROR File not open or already closed +''' FILEOPENMODEERROR File opened in write or append modes +''' ENDOFFILEERROR Previous reads already reached the end of the file +''' Examples: +''' Dim a As String +''' a = myFile.ReadLine() + +Dim sRead As String ' Return value +Dim iRead As Integer ' Length of line break +Const cstThisSub = "TextStream.ReadLine" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sRead = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsFileOpen("READ") Then GoTo Finally + If AtEndOfStream Then GoTo CatchEOF + End If + +Try: + ' When the text file ends with a line break, + ' XTextInputStream.readLine() returns the line break together with the last line + ' Hence the workaround to force a blank line at the end + If _ForceBlankLine Then + sRead = "" + _ForceBlankLine = False + Else + sRead = _InputStream.readLine() + ' The isEOF() is set immediately after having read the last line + If _InputStream.isEOF() And Len(sRead) > 0 Then + iRead = 0 + If SF_String.EndsWith(sRead, SF_String.sfCRLF) Then + iRead = 2 + ElseIf SF_String.EndsWith(sRead, SF_String.sfLF) Or SF_String.EndsWith(sRead, SF_String.sfCR) Then + iRead = 1 + End If + If iRead > 0 Then + sRead = Left(sRead, Len(sRead) - iRead) + _ForceBlankLine = True ' Provision for a last empty line at the next read loop + End If + End If + End If + _LineNumber = _LineNumber + 1 + +Finally: + ReadLine = sRead + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchEOF: + SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName) + GoTo Finally +End Function ' ScriptForge.SF_TextStream.ReadLine + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Dim bSet As Boolean ' Return value +Const cstThisSub = "TextStream.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSet = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + bSet = True + Select Case UCase(PropertyName) + Case "NEWLINE" + If Not SF_Utils._Validate(Value, "Value", V_STRING) Then GoTo Catch + NewLine = Value + Case Else + bSet = False + End Select + +Finally: + SetProperty = bSet + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_TextStream.SetProperty + +REM ----------------------------------------------------------------------------- +Public Sub SkipLine() +''' Skips the next line when reading a TextStream file. +''' Args: +''' Exceptions: +''' FILENOTOPENERROR File not open or already closed +''' FILEOPENMODEERROR File opened in write or append modes +''' ENDOFFILEERROR Previous reads already reached the end of the file +''' Examples: +''' myFile.SkipLine() + +Dim sRead As String ' Read buffer +Const cstThisSub = "TextStream.SkipLine" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsFileOpen("READ") Then GoTo Finally + If Not _ForceBlankLine Then ' The file ends with a newline => return one empty line more + If _InputStream.isEOF() Then GoTo CatchEOF + End If + End If + +Try: + sRead = ReadLine() + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +CatchEOF: + SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName) + GoTo Finally +End Sub ' ScriptForge.SF_TextStream.SkipLine + +REM ----------------------------------------------------------------------------- +Public Sub WriteBlankLines(Optional ByVal Lines As Variant) +''' Writes a number of empty lines in the output stream +''' Args: +''' Lines: the number of lines to write +''' Returns: +''' Exceptions: +''' FILENOTOPENERROR File not open or already closed +''' FILEOPENMODEERROR File opened in read mode +''' Examples: +''' myFile.WriteBlankLines(10) +Dim i As Long +Const cstThisSub = "TextStream.WriteBlankLines" +Const cstSubArgs = "Lines" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsFileOpen("WRITE") Then GoTo Finally + If Not SF_Utils._Validate(Lines, "Lines", V_NUMERIC) Then GoTo Finally + End If + +Try: + For i = 1 To Lines + _OutputStream.writeString(_NewLine) + Next i + _LineNumber = _LineNumber + Lines + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_TextStream.WriteBlankLines + +REM ----------------------------------------------------------------------------- +Public Sub WriteLine(Optional ByVal Line As Variant) +''' Writes the given line to the output stream. A newline is inserted if relevant +''' Args: +''' Line: the line to write, may be empty +''' Returns: +''' Exceptions: +''' FILENOTOPENERROR File not open or already closed +''' FILEOPENMODEERROR File opened in in read mode +''' Examples: +''' myFile.WriteLine("Next line") +Dim i As Long +Const cstThisSub = "TextStream.WriteLine" +Const cstSubArgs = "Line" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsFileOpen("WRITE") Then GoTo Finally + If Not SF_Utils._Validate(Line, "Line", V_STRING) Then GoTo Finally + End If + +Try: + _OutputStream.writeString(Iif(_LineNumber > 0, _NewLine, "") & Line) + _LineNumber = _LineNumber + 1 + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_TextStream.WriteLine + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize() +''' Opens file and setup input and/or output streams (ForAppending requires both) + +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess + + ' Default newline related to current operating system + _NewLine = SF_String.sfNEWLINE + + Set oSfa = SF_Utils._GetUNOService("FileAccess") + + ' Setup input and/or output streams based on READ/WRITE/APPEND IO modes + Select Case _IOMode + Case SF_FileSystem.ForReading + Set _FileHandler = oSfa.openFileRead(_FileName) + Set _InputStream = CreateUnoService("com.sun.star.io.TextInputStream") + _InputStream.setInputStream(_FileHandler) + Case SF_FileSystem.ForWriting + ' Output file is deleted beforehand + If _FileExists Then oSfa.kill(_FileName) + Set _FileHandler = oSfa.openFileWrite(_FileName) + Set _OutputStream = CreateUnoService("com.sun.star.io.TextOutputStream") + _OutputStream.setOutputStream(_FileHandler) + Case SF_FileSystem.ForAppending + Set _FileHandler = oSfa.openFileReadWrite(_FileName) + Set _InputStream = CreateUnoService("com.sun.star.io.TextInputStream") + Set _OutputStream = CreateUnoService("com.sun.star.io.TextOutputStream") + _InputStream.setInputStream(_FileHandler) + ' Position at end of file: Skip and count existing lines + _LineNumber = 0 + Do While Not _InputStream.isEOF() + _InputStream.readLine() + _LineNumber = _LineNumber + 1 + Loop + _OutputStream.setOutputStream(_FileHandler) + End Select + + If _Encoding = "" Then _Encoding = "UTF-8" + If Not IsNull(_InputStream) Then _InputStream.setEncoding(_Encoding) + If Not IsNull(_OutputStream) Then _OutputStream.setEncoding(_Encoding) + +End Sub ' ScriptForge.SF_TextStream._Initialize + +REM ----------------------------------------------------------------------------- +Private Function _IsFileOpen(Optional ByVal psMode As String) As Boolean +''' Checks if file is open with the right mode (READ or WRITE) +''' Raises an exception if the file is not open at all or not in the right mode +''' Args: +''' psMode: READ or WRITE or zero-length string +''' Exceptions: +''' FILENOTOPENERROR File not open or already closed +''' FILEOPENMODEERROR File opened in incompatible mode + + _IsFileOpen = False + If IsMissing(psMode) Then psMode = "" + If IsNull(_InputStream) And IsNull(_OutputStream) Then GoTo CatchNotOpen + Select Case psMode + Case "READ" + If IsNull(_InputStream) Then GoTo CatchOpenMode + If _IOMode <> SF_FileSystem.ForReading Then GoTo CatchOpenMode + Case "WRITE" + If IsNull(_OutputStream) Then GoTo CatchOpenMode + If _IOMode = SF_FileSystem.ForReading Then GoTo CatchOpenMode + Case Else + End Select + _IsFileOpen = True + +Finally: + Exit Function +CatchNotOpen: + SF_Exception.RaiseFatal(FILENOTOPENERROR, FileName) + GoTo Finally +CatchOpenMode: + SF_Exception.RaiseFatal(FILEOPENMODEERROR, FileName, IOMode) + GoTo Finally +End Function ' ScriptForge.SF_TextStream._IsFileOpen + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim cstThisSub As String +Dim cstSubArgs As String + + cstThisSub = "TextStream.get" & psProperty + cstSubArgs = "" + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + + Select Case UCase(psProperty) + Case UCase("AtEndOfStream") + Select Case _IOMode + Case SF_FileSystem.ForReading + If IsNull(_InputStream) Then _PropertyGet = True Else _PropertyGet = CBool(_InputStream.isEOF() And Not _ForceBlankLine) + Case Else : _PropertyGet = True + End Select + Case UCase("Encoding") + _PropertyGet = _Encoding + Case UCase("FileName") + _PropertyGet = SF_FileSystem._ConvertFromUrl(_FileName) ' Depends on FileNaming + Case UCase("IOMode") + With SF_FileSystem + Select Case _IOMode + Case .ForReading : _PropertyGet = "READ" + Case .ForWriting : _PropertyGet = "WRITE" + Case .ForAppending : _PropertyGet = "APPEND" + Case Else : _PropertyGet = "" + End Select + End With + Case UCase("Line") + _PropertyGet = _LineNumber + Case UCase("NewLine") + _PropertyGet = _NewLine + Case Else + _PropertyGet = Null + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_TextStream._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the TextStream instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[TextStream]: File name, IOMode, LineNumber" + + _Repr = "[TextStream]: " & FileName & "," & IOMode & "," & CStr(Line) + +End Function ' ScriptForge.SF_TextStream._Repr + +REM ============================================ END OF SCRIPTFORGE.SF_TextStream +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Timer.xba b/wizards/source/scriptforge/SF_Timer.xba new file mode 100644 index 000000000..2b3286e04 --- /dev/null +++ b/wizards/source/scriptforge/SF_Timer.xba @@ -0,0 +1,466 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Timer" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Timer +''' ======== +''' Class for management of scripts execution performance +''' A Timer measures durations. It can be suspended, resumed, restarted +''' Duration properties are expressed in seconds with a precision of 3 decimal digits +''' +''' Service invocation example: +''' Dim myTimer As Variant +''' myTimer = CreateScriptService("Timer") +''' myTimer = CreateScriptService("Timer", True) ' => To start timer immediately +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_timer.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be "TIMER" +Private ServiceName As String +Private _TimerStatus As Integer ' inactive, started, suspended or stopped +Private _StartTime As Double ' Moment when timer started, restarted +Private _EndTime As Double ' Moment when timer stopped +Private _SuspendTime As Double ' Moment when timer suspended +Private _SuspendDuration As Double ' Duration of suspended status as a difference of times + +REM ============================================================ MODULE CONSTANTS + +Private Const STATUSINACTIVE = 0 +Private Const STATUSSTARTED = 1 +Private Const STATUSSUSPENDED = 2 +Private Const STATUSSTOPPED = 3 + +Private Const DSECOND As Double = 1 / (24 * 60 * 60) ' Duration of 1 second as compared to 1.0 = 1 day + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "TIMER" + ServiceName = "ScriptForge.Timer" + _TimerStatus = STATUSINACTIVE + _StartTime = 0 + _EndTime = 0 + _SuspendTime = 0 + _SuspendDuration = 0 +End Sub ' ScriptForge.SF_Timer Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' ScriptForge.SF_Timer Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' ScriptForge.SF_Timer Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Public Function Duration() As Double +''' Returns the actual (out of suspensions) time elapsed since start or between start and stop +''' Args: +''' Returns: +''' A Double expressing the duration in seconds +''' Example: +''' myTimer.Duration returns 1.234 (1 sec, 234 ms) + + Duration = _PropertyGet("Duration") + +End Function ' ScriptForge.SF_Timer.Duration + +REM ----------------------------------------------------------------------------- +Property Get IsStarted() As Boolean +''' Returns True if timer is started or suspended +''' Example: +''' myTimer.IsStarted + + IsStarted = _PropertyGet("IsStarted") + +End Property ' ScriptForge.SF_Timer.IsStarted + +REM ----------------------------------------------------------------------------- +Property Get IsSuspended() As Boolean +''' Returns True if timer is started and suspended +''' Example: +''' myTimer.IsSuspended + + IsSuspended = _PropertyGet("IsSuspended") + +End Property ' ScriptForge.SF_Timer.IsSuspended + +REM ----------------------------------------------------------------------------- +Public Function SuspendDuration() As Double +''' Returns the actual time elapsed while suspended since start or between start and stop +''' Args: +''' Returns: +''' A Double expressing the duration in seconds +''' Example: +''' myTimer.SuspendDuration returns 1.234 (1 sec, 234 ms) + + SuspendDuration = _PropertyGet("SuspendDuration") + +End Function ' ScriptForge.SF_Timer.SuspendDuration + +REM ----------------------------------------------------------------------------- +Public Function TotalDuration() As Double +''' Returns the actual time elapsed (including suspensions) since start or between start and stop +''' Args: +''' Returns: +''' A Double expressing the duration in seconds +''' Example: +''' myTimer.TotalDuration returns 1.234 (1 sec, 234 ms) + + TotalDuration = _PropertyGet("TotalDuration") + +End Function ' ScriptForge.SF_Timer.TotalDuration + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Continue() As Boolean +''' Halt suspension of a running timer +''' Args: +''' Returns: +''' True if successful, False if the timer is not suspended +''' Examples: +''' myTimer.Continue() + +Const cstThisSub = "Timer.Continue" +Const cstSubArgs = "" + +Check: + Continue = False + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If _TimerStatus = STATUSSUSPENDED Then + _TimerStatus = STATUSSTARTED + _SuspendDuration = _SuspendDuration + _Now() - _SuspendTime + _SuspendTime = 0 + Continue = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Timer.Continue + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist +''' Examples: +''' myTimer.GetProperty("Duration") + +Const cstThisSub = "Timer.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Timer.Properties + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list or methods of the Timer class as an array + + Methods = Array( _ + "Continue" _ + , "Restart" _ + , "Start" _ + , "Suspend" _ + , "Terminate" _ + ) + +End Function ' ScriptForge.SF_Timer.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "Duration" _ + , "IsStarted" _ + , "IsSuspended" _ + , "SuspendDuration" _ + , "TotalDuration" _ + ) + +End Function ' ScriptForge.SF_Timer.Properties + +REM ----------------------------------------------------------------------------- +Public Function Restart() As Boolean +''' Terminate the timer and restart a new clean timer +''' Args: +''' Returns: +''' True if successful, False if the timer is inactive +''' Examples: +''' myTimer.Restart() + +Const cstThisSub = "Timer.Restart" +Const cstSubArgs = "" + +Check: + Restart = False + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If _TimerStatus <> STATUSINACTIVE Then + If _TimerStatus <> STATUSSTOPPED Then Terminate() + Start() + Restart = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Timer.Restart + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Timer.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Timer.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function Start() As Boolean +''' Start a new clean timer +''' Args: +''' Returns: +''' True if successful, False if the timer is already started +''' Examples: +''' myTimer.Start() + +Const cstThisSub = "Timer.Start" +Const cstSubArgs = "" + +Check: + Start = False + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If _TimerStatus = STATUSINACTIVE Or _TimerStatus = STATUSSTOPPED Then + _TimerStatus = STATUSSTARTED + _StartTime = _Now() + _EndTime = 0 + _SuspendTime = 0 + _SuspendDuration = 0 + Start = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Timer.Start + +REM ----------------------------------------------------------------------------- +Public Function Suspend() As Boolean +''' Suspend a running timer +''' Args: +''' Returns: +''' True if successful, False if the timer is not started or already suspended +''' Examples: +''' myTimer.Suspend() + +Const cstThisSub = "Timer.Suspend" +Const cstSubArgs = "" + +Check: + Suspend = False + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If _TimerStatus = STATUSSTARTED Then + _TimerStatus = STATUSSUSPENDED + _SuspendTime = _Now() + Suspend = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Timer.Suspend + +REM ----------------------------------------------------------------------------- +Public Function Terminate() As Boolean +''' Terminate a running timer +''' Args: +''' Returns: +''' True if successful, False if the timer is neither started nor suspended +''' Examples: +''' myTimer.Terminate() + +Const cstThisSub = "Timer.Terminate" +Const cstSubArgs = "" + +Check: + Terminate = False + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + If _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED Then + If _TimerSTatus = STATUSSUSPENDED Then Continue() + _TimerStatus = STATUSSTOPPED + _EndTime = _Now() + Terminate = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Timer.Terminate + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _Now() As Double +''' Returns the current date and time +''' Uses the Calc NOW() function to get a higher precision than the usual Basic Now() function +''' Args: +''' Returns: +''' The actual time as a number +''' The integer part represents the date, the decimal part represents the time + + _Now = SF_Session.ExecuteCalcFunction("NOW") + +End Function ' ScriptForge.SF_Timer._Now + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) +''' Return the named property +''' Args: +''' psProperty: the name of the property + +Dim dDuration As Double ' Computed duration +Dim cstThisSub As String +Dim cstSubArgs As String + + cstThisSub = "Timer.get" & psProperty + cstSubArgs = "" + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + + Select Case UCase(psProperty) + Case UCase("Duration") + Select Case _TimerStatus + Case STATUSINACTIVE : dDuration = 0.0 + Case STATUSSTARTED + dDuration = _Now() - _StartTime - _SuspendDuration + Case STATUSSUSPENDED + dDuration = _SuspendTime - _StartTime - _SuspendDuration + Case STATUSSTOPPED + dDuration = _EndTime - _StartTime - _SuspendDuration + End Select + _PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000 + Case UCase("IsStarted") + _PropertyGet = CBool( _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED ) + Case UCase("IsSuspended") + _PropertyGet = CBool( _TimerStatus = STATUSSUSPENDED ) + Case UCase("SuspendDuration") + Select Case _TimerStatus + Case STATUSINACTIVE : dDuration = 0.0 + Case STATUSSTARTED, STATUSSTOPPED + dDuration = _SuspendDuration + Case STATUSSUSPENDED + dDuration = _Now() - _SuspendTime + _SuspendDuration + End Select + _PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000 + Case UCase("TotalDuration") + Select Case _TimerStatus + Case STATUSINACTIVE : dDuration = 0.0 + Case STATUSSTARTED, STATUSSUSPENDED + dDuration = _Now() - _StartTime + Case STATUSSTOPPED + dDuration = _EndTime - _StartTime + End Select + _PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000 + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Timer._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Timer instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Timer] Duration:xxx.yyy + +Const cstTimer = "[Timer] Duration: " +Const cstMaxLength = 50 ' Maximum length for items + + _Repr = cstTimer & Replace(SF_Utils._Repr(Duration), ".", """") + +End Function ' ScriptForge.SF_Timer._Repr + +REM ============================================ END OF SCRIPTFORGE.SF_TIMER +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_UI.xba b/wizards/source/scriptforge/SF_UI.xba new file mode 100644 index 000000000..c8a7f9a8f --- /dev/null +++ b/wizards/source/scriptforge/SF_UI.xba @@ -0,0 +1,1350 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_UI" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_UI +''' ===== +''' Singleton class module for the identification and the manipulation of the +''' different windows composing the whole LibreOffice application: +''' - Windows selection +''' - Windows moving and resizing +''' - Statusbar settings +''' - Creation of new windows +''' - Access to the underlying "documents" +''' +''' WindowName: how to designate a window. It can be either +''' a full FileName given in the notation indicated by the current value of SF_FileSystem.FileNaming +''' or the last component of the full FileName or even only its BaseName +''' or the title of the window +''' or, for new documents, something like "Untitled 1" +''' or one of the special windows "BASICIDE" and "WELCOMESCREEN" +''' The window search is case-sensitive +''' +''' Service invocation example: +''' Dim ui As Variant +''' ui = CreateScriptService("UI") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_ui.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const DOCUMENTERROR = "DOCUMENTERROR" ' Requested document was not found +Const DOCUMENTCREATIONERROR = "DOCUMENTCREATIONERROR" ' Incoherent arguments, new document could not be created +Const DOCUMENTOPENERROR = "DOCUMENTOPENERROR" ' Document could not be opened, check the arguments +Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR" ' Id. for Base document +Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Calc datasource does not exist + +REM ============================================================= PRIVATE MEMBERS + +Type Window + Component As Object ' com.sun.star.lang.XComponent + Frame As Object ' com.sun.star.comp.framework.Frame + WindowName As String ' Object Name + WindowTitle As String ' Only mean to identify new documents + WindowFileName As String ' URL of file name + DocumentType As String ' Writer, Calc, ... +End Type + +' The progress/status bar of the active window +'Private oStatusBar As Object ' com.sun.star.task.XStatusIndicator + +REM ============================================================ MODULE CONSTANTS + +' Special windows +Const BASICIDE = "BASICIDE" +Const WELCOMESCREEN = "WELCOMESCREEN" + +' Document types (only if not 1 of the special windows) +Const BASEDOCUMENT = "Base" +Const CALCDOCUMENT = "Calc" +Const DRAWDOCUMENT = "Draw" +Const IMPRESSDOCUMENT = "Impress" +Const MATHDOCUMENT = "Math" +Const WRITERDOCUMENT = "Writer" + +' Window subtypes - Not supported yet +Const BASETABLE = "BASETABLE" +Const BASEQUERY = "BASEQUERY" +Const BASEREPORT = "BASEREPORT" +Const BASEDIAGRAM = "BASEDIAGRAM" + +' Macro execution modes +Const cstMACROEXECNORMAL = 0 ' Default, execution depends on user configuration and choice +Const cstMACROEXECNEVER = 1 ' Macros are not executed +Const cstMACROEXECALWAYS = 2 ' Macros are always executed + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_UI Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Public Function ActiveWindow() As String +''' Returns a valid WindowName for the currently active window +''' When "" is returned, the window could not be identified + +Dim vWindow As Window ' A component +Dim oComp As Object ' com.sun.star.lang.XComponent + + Set oComp = StarDesktop.CurrentComponent + If Not IsNull(oComp) Then + vWindow = SF_UI._IdentifyWindow(oComp) + With vWindow + If Len(.WindowFileName) > 0 Then + ActiveWindow = SF_FileSystem._ConvertFromUrl(.WindowFileName) + ElseIf Len(.WindowName) > 0 Then + ActiveWindow = .WindowName + ElseIf Len(.WindowTitle) > 0 Then + ActiveWindow = .WindowTitle + Else + ActiveWindow = "" + End If + End With + End If + +End Function ' ScriptForge.SF_UI.ActiveWindow + +REM ----------------------------------------------------------------------------- +Property Get Height() As Long +''' Returns the height of the active window +Dim oPosSize As Object ' com.sun.star.awt.Rectangle + Set oPosSize = SF_UI._PosSize() + If Not IsNull(oPosSize) Then Height = oPosSize.Height Else Height = -1 +End Property ' ScriptForge.SF_UI.Height + +REM ----------------------------------------------------------------------------- +Property Get MACROEXECALWAYS As Integer +''' Macros are always executed + MACROEXECALWAYS = cstMACROEXECALWAYS +End Property ' ScriptForge.SF_UI.MACROEXECALWAYS + +REM ----------------------------------------------------------------------------- +Property Get MACROEXECNEVER As Integer +''' Macros are not executed + MACROEXECNEVER = cstMACROEXECNEVER +End Property ' ScriptForge.SF_UI.MACROEXECNEVER + +REM ----------------------------------------------------------------------------- +Property Get MACROEXECNORMAL As Integer +''' Default, execution depends on user configuration and choice + MACROEXECNORMAL = cstMACROEXECNORMAL +End Property ' ScriptForge.SF_UI.MACROEXECNORMAL + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_UI" +End Property ' ScriptForge.SF_UI.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.UI" +End Property ' ScriptForge.SF_UI.ServiceName + +REM ----------------------------------------------------------------------------- +Property Get Width() As Long +''' Returns the width of the active window +Dim oPosSize As Object ' com.sun.star.awt.Rectangle + Set oPosSize = SF_UI._PosSize() + If Not IsNull(oPosSize) Then Width = oPosSize.Width Else Width = -1 +End Property ' ScriptForge.SF_UI.Width + +REM ----------------------------------------------------------------------------- +Property Get X() As Long +''' Returns the X coordinate of the active window +Dim oPosSize As Object ' com.sun.star.awt.Rectangle + Set oPosSize = SF_UI._PosSize() + If Not IsNull(oPosSize) Then X = oPosSize.X Else X = -1 +End Property ' ScriptForge.SF_UI.X + +REM ----------------------------------------------------------------------------- +Property Get Y() As Long +''' Returns the Y coordinate of the active window +Dim oPosSize As Object ' com.sun.star.awt.Rectangle + Set oPosSize = SF_UI._PosSize() + If Not IsNull(oPosSize) Then Y = oPosSize.Y Else Y = -1 +End Property ' ScriptForge.SF_UI.Y + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate(Optional ByVal WindowName As Variant) As Boolean +''' Make the specified window active +''' Args: +''' WindowName: see definitions +''' Returns: +''' True if the given window is found and can be activated +''' There is no change in the actual user interface if no window matches the selection +''' Examples: +''' ui.Activate("C:\Me\My file.odt") + +Dim bActivate As Boolean ' Return value +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim vWindow As Window ' A single component +Dim oContainer As Object ' com.sun.star.awt.XWindow +Const cstThisSub = "UI.Activate" +Const cstSubArgs = "WindowName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bActivate = False + +Check: + If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(WindowName, "WindowName") Then GoTo Finally + End If + +Try: + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements + Set oComp = oEnum.nextElement + vWindow = SF_UI._IdentifyWindow(oComp) + With vWindow + ' Does the current window match the arguments ? + If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem._ConvertToUrl(WindowName)) _ + Or (Len(.WindowName) > 0 And .WindowName = WindowName) _ + Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then + Set oContainer = vWindow.Frame.ContainerWindow + With oContainer + If .isVisible() = False Then .setVisible(True) + .IsMinimized = False + .setFocus() + .toFront() ' Force window change in Linux + Wait 1 ' Bypass desynchro issue in Linux + End With + bActivate = True + Exit Do + End If + End With + Loop + +Finally: + Activate = bActivate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_UI.Activate + +REM ----------------------------------------------------------------------------- +Public Function CreateBaseDocument(Optional ByVal FileName As Variant _ + , Optional ByVal EmbeddedDatabase As Variant _ + , Optional ByVal RegistrationName As Variant _ + , Optional ByVal CalcFileName As Variant _ + ) As Object +''' Create a new LibreOffice Base document embedding an empty database of the given type +''' Args: +''' FileName: Identifies the file to create. It must follow the SF_FileSystem.FileNaming notation +''' If the file already exists, it is overwritten without warning +''' EmbeddedDatabase: either "HSQLDB" (default) or "FIREBIRD" or "CALC" +''' RegistrationName: the name used to store the new database in the databases register +''' If "" (default), no registration takes place +''' If the name already exists it is overwritten without warning +''' CalcFileName: only when EmbedddedDatabase = "CALC", the name of the file containing the tables as Calc sheets +''' The name of the file must be given in SF_FileSystem.FileNaming notation +''' The file must exist +''' Returns: +''' A SFDocuments.SF_Document object or one of its subclasses +''' Exceptions +''' UNKNOWNFILEERROR Calc datasource does not exist +''' Examples: +''' Dim myBase As Object, myCalcBase As Object +''' Set myBase = ui.CreateBaseDocument("C:\Databases\MyBaseFile.odb", "FIREBIRD") +''' Set myCalcBase = ui.CreateBaseDocument("C:\Databases\MyCalcBaseFile.odb", "CALC", , "C:\Databases\MyCalcFile.ods") + +Dim oCreate As Variant ' Return value +Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext +Dim oDatabase As Object ' com.sun.star.comp.dba.ODatabaseSource +Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent +Dim sFileName As String ' Alias of FileName +Dim FSO As Object ' Alias for FileSystem service +Const cstDocType = "private:factory/s" +Const cstThisSub = "UI.CreateBaseDocument" +Const cstSubArgs = "FileName, [EmbeddedDatabase=""HSQLDB""|""FIREBIRD""|""CALC""], [RegistrationName=""""], [CalcFileName]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oCreate = Nothing + Set FSO = CreateScriptService("FileSystem") + +Check: + If IsMissing(EmbeddedDatabase) Or IsEmpty(EmbeddedDatabase) Then EmbeddedDatabase = "HSQLDB" + If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = "" + If IsMissing(CalcFileName) Or IsEmpty(CalcFileName) Then CalcFileName = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(EmbeddedDatabase, "EmbeddedDatabase", V_STRING, Array("CALC", "HSQLDB", "FIREBIRD")) Then GoTo Finally + If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally + If UCase(EmbeddedDatabase) = "CALC" Then + If Not SF_Utils._ValidateFile(CalcFileName, "CalcFileName") Then GoTo Finally + If Not FSO.FileExists(CalcFileName) Then GoTo CatchNotExists + End If + End If + +Try: + Set oDBContext = SF_Utils._GetUNOService("DatabaseContext") + With oDBContext + Set oDatabase = .createInstance() + ' Build the url link to the database + Select Case UCase(EmbeddedDatabase) + Case "HSQLDB", "FIREBIRD" + oDatabase.URL = "sdbc:embedded:" & LCase(EmbeddedDatabase) + Case "CALC" + oDatabase.URL = "sdbc:calc:" & FSO._ConvertToUrl(CalcFileName) + End Select + ' Create empty Base document + sFileName = FSO._ConvertToUrl(FileName) + ' An existing file is overwritten without warning + If FSO.FileExists(FileName) Then FSO.DeleteFile(FileName) + If FSO.FileExists(FileName & ".lck") Then FSO.DeleteFile(FileName & ".lck") + oDatabase.DatabaseDocument.storeAsURL(sFileName, Array(SF_Utils._MakePropertyValue("Overwrite", True))) + ' Register database if requested + If Len(RegistrationName) > 0 Then + If .hasRegisteredDatabase(RegistrationName) Then + .changeDatabaseLocation(RegistrationName, sFileName) + Else + .registerDatabaseLocation(RegistrationName, sFileName) + End If + End If + End With + + Set oCreate = OpenBaseDocument(FileName) + +Finally: + Set CreateBaseDocument = oCreate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "CalcFileName", CalcFileName) + GoTo Finally +End Function ' ScriptForge.SF_UI.CreateBaseDocument + +REM ----------------------------------------------------------------------------- +Public Function CreateDocument(Optional ByVal DocumentType As Variant _ + , Optional ByVal TemplateFile As Variant _ + , Optional ByVal Hidden As Variant _ + ) As Object +''' Create a new LibreOffice document of a given type or based on a given template +''' Args: +''' DocumentType: "Calc", "Writer", etc. If absent, a TemplateFile must be given +''' TemplateFile: the full FileName of the template to build the new document on +''' If the file does not exist, the argument is ignored +''' The "FileSystem" service provides the TemplatesFolder and UserTemplatesFolder +''' properties to help to build the argument +''' Hidden: if True, open in the background (default = False) +''' To use with caution: activation or closure can only happen programmatically +''' Returns: +''' A SFDocuments.SF_Document object or one of its subclasses +''' Exceptions: +''' DOCUMENTCREATIONERROR Wrong arguments +''' Examples: +''' Dim myDoc1 As Object, myDoc2 As Object, FSO As Object +''' Set myDoc1 = ui.CreateDocument("Calc") +''' Set FSO = CreateScriptService("FileSystem") +''' Set myDoc2 = ui.CreateDocument(, FSO.BuildPath(FSO.TemplatesFolder, "personal/CV.ott")) + +Dim oCreate As Variant ' Return value +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim bTemplateExists As Boolean ' True if TemplateFile is valid +Dim sNew As String ' File url +Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent +Const cstDocType = "private:factory/s" +Const cstThisSub = "UI.CreateDocument" +Const cstSubArgs = "[DocumentType=""""], [TemplateFile=""""], [Hidden=False]" + +'>>> If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oCreate = Nothing + +Check: + If IsMissing(DocumentType) Or IsEmpty(DocumentType) Then DocumentType = "" + If IsMissing(TemplateFile) Or IsEmpty(TemplateFile) Then TemplateFile = "" + If IsMissing(Hidden) Or IsEmpty(Hidden) Then Hidden = False + + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(DocumentType, "DocumentType", V_STRING _ + , Array("", BASEDOCUMENT, CALCDOCUMENT, DRAWDOCUMENT _ + , IMPRESSDOCUMENT, MATHDOCUMENT, WRITERDOCUMENT)) Then GoTo Finally + If Not SF_Utils._ValidateFile(TemplateFile, "TemplateFile", , True) Then GoTo Finally + If Not SF_Utils._Validate(Hidden, "Hidden", V_BOOLEAN) Then GoTo Finally + End If + + If Len(DocumentType) + Len(TemplateFile) = 0 Then GoTo CatchError + If Len(TemplateFile) > 0 Then bTemplateExists = SF_FileSystem.FileExists(TemplateFile) Else bTemplateExists = False + If Len(DocumentType) = 0 Then + If Not bTemplateExists Then GoTo CatchError + End If + +Try: + If bTemplateExists Then sNew = SF_FileSystem._ConvertToUrl(TemplateFile) Else sNew = cstDocType & LCase(DocumentType) + vProperties = Array( _ + SF_Utils._MakePropertyValue("AsTemplate", bTemplateExists) _ + , SF_Utils._MakePropertyValue("Hidden", Hidden) _ + ) + Set oComp = StarDesktop.loadComponentFromURL(sNew, "_blank", 0, vProperties) + If Not IsNull(oComp) Then Set oCreate = CreateScriptService("SFDocuments.Document", oComp) + +Finally: + Set CreateDocument = oCreate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchError: + SF_Exception.RaiseFatal(DOCUMENTCREATIONERROR, "DocumentType", DocumentType, "TemplateFile", TemplateFile) + GoTo Finally +End Function ' ScriptForge.SF_UI.CreateDocument + +REM ----------------------------------------------------------------------------- +Public Function Documents() As Variant +''' Returns the list of the currently open documents. Special windows are ignored. +''' Returns: +''' A zero-based 1D array of filenames (in SF_FileSystem.FileNaming notation) +''' or of window titles for unsaved documents +''' Examples: +''' Dim vDocs As Variant, sDoc As String +''' vDocs = ui.Documents() +''' For each sDoc In vDocs +''' ... + +Dim vDocuments As Variant ' Return value +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim vWindow As Window ' A single component +Const cstThisSub = "UI.Documents" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vDocuments = Array() + +Check: + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Try: + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements + Set oComp = oEnum.nextElement + vWindow = SF_UI._IdentifyWindow(oComp) + With vWindow + If Len(.WindowFileName) > 0 Then + vDocuments = SF_Array.Append(vDocuments, SF_FileSystem._ConvertFromUrl(.WindowFileName)) + ElseIf Len(.WindowTitle) > 0 Then + vDocuments = SF_Array.Append(vDocuments, .WindowTitle) + End If + End With + Loop + +Finally: + Documents = vDocuments + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_UI.Documents + +REM ----------------------------------------------------------------------------- +Public Function GetDocument(Optional ByVal WindowName As Variant) As Variant +''' Returns a SFDocuments.Document object referring to the active window or the given window +''' Args: +''' WindowName: when a string, see definitions. If absent the active window is considered. +''' when an object, must be a UNO object of types +''' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument +''' Exceptions: +''' DOCUMENTERROR The targeted window could not be found +''' Examples: +''' Dim oDoc As Object +''' Set oDoc = ui.GetDocument ' or Set oDoc = ui.GetDocument(ThisComponent) +''' oDoc.Save() + +Dim oDocument As Object ' Return value +Const cstThisSub = "UI.GetDocument" +Const cstSubArgs = "[WindowName]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oDocument = Nothing + +Check: + If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(WindowName, "WindowName", Array(V_STRING, V_OBJECT)) Then GoTo Finally + If VarType(WindowName) = V_STRING Then + If Not SF_Utils._ValidateFile(WindowName, "WindowName", , True) Then GoTo Finally + End If + End If + +Try: + Set oDocument = SF_Services.CreateScriptService("SFDocuments.Document", WindowName) + If IsNull(oDocument) Then GoTo CatchDeliver + +Finally: + Set GetDocument = oDocument + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchDeliver: + SF_Exception.RaiseFatal(DOCUMENTERROR, "WindowName", WindowName) + GoTo Finally +End Function ' ScriptForge.SF_UI.GetDocument + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "UI.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case "ACTIVEWINDOW" : GetProperty = ActiveWindow() + Case "HEIGHT" : GetProperty = SF_UI.Height + Case "WIDTH" : GetProperty = SF_UI.Width + Case "X" : GetProperty = SF_UI.X + Case "Y" : GetProperty = SF_UI.Y + + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_UI.GetProperty + +REM ----------------------------------------------------------------------------- +Public Sub Maximize(Optional ByVal WindowName As Variant) +''' Maximizes the active window or the given window +''' Args: +''' WindowName: see definitions. If absent the active window is considered +''' Examples: +''' ui.Maximize +''' ... + +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim vWindow As Window ' A single component +Dim oContainer As Object ' com.sun.star.awt.XWindow +Dim bFound As Boolean ' True if window found +Const cstThisSub = "UI.Maximize" +Const cstSubArgs = "[WindowName]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(WindowName, "WindowName", , True) Then GoTo Finally + End If + +Try: + bFound = False + If Len(WindowName) > 0 Then + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements And Not bFound + Set oComp = oEnum.nextElement + vWindow = SF_UI._IdentifyWindow(oComp) + With vWindow + ' Does the current window match the arguments ? + If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _ + Or (Len(.WindowName) > 0 And .WindowName = WindowName) _ + Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then bFound = True + End With + Loop + Else + vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent) + bFound = True + End If + + If bFound Then + Set oContainer = vWindow.Frame.ContainerWindow + oContainer.IsMaximized = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_UI.Maximize + +REM ----------------------------------------------------------------------------- +Public Sub Minimize(Optional ByVal WindowName As Variant) +''' Minimizes the current window or the given window +''' Args: +''' WindowName: see definitions. If absent the current window is considered +''' Examples: +''' ui.Minimize("myFile.ods") +''' ... + +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim vWindow As Window ' A single component +Dim oContainer As Object ' com.sun.star.awt.XWindow +Dim bFound As Boolean ' True if window found +Const cstThisSub = "UI.Minimize" +Const cstSubArgs = "[WindowName]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(WindowName, "WindowName", , True) Then GoTo Finally + End If + +Try: + bFound = False + If Len(WindowName) > 0 Then + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements And Not bFound + Set oComp = oEnum.nextElement + vWindow = SF_UI._IdentifyWindow(oComp) + With vWindow + ' Does the current window match the arguments ? + If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _ + Or (Len(.WindowName) > 0 And .WindowName = WindowName) _ + Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then bFound = True + End With + Loop + Else + vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent) + bFound = True + End If + + If bFound Then + Set oContainer = vWindow.Frame.ContainerWindow + oContainer.IsMinimized = True + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_UI.Minimize + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the UI service as an array + + Methods = Array("Activate" _ + , "CreateBaseDocument" _ + , "CreateDocument" _ + , "Documents" _ + , "GetDocument" _ + , "Maximize" _ + , "Minimize" _ + , "OpenBaseDocument" _ + , "OpenDocument" _ + , "Resize" _ + , "RunCommand" _ + , "SetStatusbar" _ + , "ShowProgressBar" _ + , "WindowExists" _ + ) + +End Function ' ScriptForge.SF_UI.Methods + +REM ----------------------------------------------------------------------------- +Public Function OpenBaseDocument(Optional ByVal FileName As Variant _ + , Optional ByVal RegistrationName As Variant _ + , Optional ByVal MacroExecution As Variant _ + ) As Object +''' Open an existing LibreOffice Base document and return a SFDocuments.Document object +''' Args: +''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation +''' RegistrationName: the name of a registered database +''' It is ignored if FileName <> "" +''' MacroExecution: one of the MACROEXECxxx constants +''' Returns: +''' A SFDocuments.SF_Base object +''' Null if the opening failed, including when due to a user decision +''' Exceptions: +''' BASEDOCUMENTOPENERROR Wrong arguments +''' Examples: +''' Dim mBasec As Object, FSO As Object +''' Set myBase = ui.OpenBaseDocument("C:\Temp\myDB.odb", MacroExecution := ui.MACROEXECNEVER) + +Dim oOpen As Variant ' Return value +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext +Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent +Dim sFile As String ' Alias for FileName +Dim iMacro As Integer ' Alias for MacroExecution +Const cstThisSub = "UI.OpenBaseDocument" +Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], [MacroExecution=0|1|2]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oOpen = Nothing + +Check: + If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = "" + If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = "" + If IsMissing(MacroExecution) Or IsEmpty(MacroExecution) Then MacroExecution = MACROEXECNORMAL + + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally + If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(MacroExecution, "MacroExecution", V_NUMERIC _ + , Array(MACROEXECNORMAL, MACROEXECNEVER, MACROEXECALWAYS)) Then GoTo Finally + End If + + ' Check the existence of FileName + If Len(FileName) = 0 Then ' FileName has precedence over RegistrationName + If Len(RegistrationName) = 0 Then GoTo CatchError + Set oDBContext = SF_Utils._GetUNOService("DatabaseContext") + If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError + FileName = SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName)) + End If + If Not SF_FileSystem.FileExists(FileName) Then GoTo CatchError + +Try: + With com.sun.star.document.MacroExecMode + Select Case MacroExecution + Case 0 : iMacro = .USE_CONFIG + Case 1 : iMacro = .NEVER_EXECUTE + Case 2 : iMacro = .ALWAYS_EXECUTE_NO_WARN + End Select + End With + + vProperties = Array(SF_Utils._MakePropertyValue("MacroExecutionMode", iMacro)) + + sFile = SF_FileSystem._ConvertToUrl(FileName) + Set oComp = StarDesktop.loadComponentFromURL(sFile, "_blank", 0, vProperties) + If Not IsNull(oComp) Then Set oOpen = CreateScriptService("SFDocuments.Document", oComp) + +Finally: + Set OpenBaseDocument = oOpen + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchError: + SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName) + GoTo Finally +End Function ' ScriptForge.SF_UI.OpenBaseDocument + +REM ----------------------------------------------------------------------------- +Public Function OpenDocument(Optional ByVal FileName As Variant _ + , Optional ByVal Password As Variant _ + , Optional ByVal ReadOnly As Variant _ + , Optional ByVal Hidden As Variant _ + , Optional ByVal MacroExecution As Variant _ + , Optional ByVal FilterName As Variant _ + , Optional ByVal FilterOptions As Variant _ + ) As Object +''' Open an existing LibreOffice document with the given options +''' Args: +''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation +''' Password: To use when the document is protected +''' If wrong or absent while the document is protected, the user will be prompted to enter a password +''' ReadOnly: Default = False +''' Hidden: if True, open in the background (default = False) +''' To use with caution: activation or closure can only happen programmatically +''' MacroExecution: one of the MACROEXECxxx constants +''' FilterName: the name of a filter that should be used for loading the document +''' If present, the filter must exist +''' FilterOptions: an optional string of options associated with the filter +''' Returns: +''' A SFDocuments.SF_Document object or one of its subclasses +''' Null if the opening failed, including when due to a user decision +''' Exceptions: +''' DOCUMENTOPENERROR Wrong arguments +''' Examples: +''' Dim myDoc As Object, FSO As Object +''' Set myDoc = ui.OpenDocument("C:\Temp\myFile.odt", MacroExecution := ui.MACROEXECNEVER) + +Dim oOpen As Variant ' Return value +Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent +Dim sFile As String ' Alias for FileName +Dim iMacro As Integer ' Alias for MacroExecution +Const cstThisSub = "UI.OpenDocument" +Const cstSubArgs = "FileName, [Password=""""], [ReadOnly=False], [Hidden=False], [MacroExecution=0|1|2], [FilterName=""""], [FilterOptions=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oOpen = Nothing + +Check: + If IsMissing(Password) Or IsEmpty(Password) Then Password = "" + If IsMissing(ReadOnly) Or IsEmpty(ReadOnly) Then ReadOnly = False + If IsMissing(Hidden) Or IsEmpty(Hidden) Then Hidden = False + If IsMissing(MacroExecution) Or IsEmpty(MacroExecution) Then MacroExecution = MACROEXECNORMAL + If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = "" + If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = "" + + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(ReadOnly, "ReadOnly", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Hidden, "Hidden", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(MacroExecution, "MacroExecution", V_NUMERIC _ + , Array(MACROEXECNORMAL, MACROEXECNEVER, MACROEXECALWAYS)) Then GoTo Finally + If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally + End If + + ' Check the existence of FileName and FilterName + If Not SF_FileSystem.FileExists(FileName) Then GoTo CatchError + If Len(FilterName) > 0 Then + Set oFilterFactory = SF_Utils._GetUNOService("FilterFactory") + If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError + End If + +Try: + With com.sun.star.document.MacroExecMode + Select Case MacroExecution + Case 0 : iMacro = .USE_CONFIG + Case 1 : iMacro = .NEVER_EXECUTE + Case 2 : iMacro = .ALWAYS_EXECUTE_NO_WARN + End Select + End With + + vProperties = Array( _ + SF_Utils._MakePropertyValue("ReadOnly", ReadOnly) _ + , SF_Utils._MakePropertyValue("Hidden", Hidden) _ + , SF_Utils._MakePropertyValue("MacroExecutionMode", iMacro) _ + , SF_Utils._MakePropertyValue("FilterName", FilterName) _ + , SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _ + ) + If Len(Password) > 0 Then ' Password is to add only if <> "" !? + vProperties = SF_Array.Append(vProperties, SF_Utils._MakePropertyValue("Password", Password)) + End If + + sFile = SF_FileSystem._ConvertToUrl(FileName) + Set oComp = StarDesktop.loadComponentFromURL(sFile, "_blank", 0, vProperties) + If Not IsNull(oComp) Then Set oOpen = CreateScriptService("SFDocuments.Document", oComp) + +Finally: + Set OpenDocument = oOpen + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchError: + SF_Exception.RaiseFatal(DOCUMENTOPENERROR, "FileName", FileName, "Password", Password, "FilterName", FilterName) + GoTo Finally +End Function ' ScriptForge.SF_UI.OpenDocument + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "ActiveWindow" _ + , "Height" _ + , "Width" _ + , "X" _ + , "Y" _ + ) + +End Function ' ScriptForge.SF_UI.Properties + +REM ----------------------------------------------------------------------------- +Public Sub Resize(Optional ByVal Left As Variant _ + , Optional ByVal Top As Variant _ + , Optional ByVal Width As Variant _ + , Optional ByVal Height As Variant _ + ) +''' Resizes and/or moves the active window. Negative arguments are ignored. +''' If the window was minimized or without arguments, it is restored +''' Args: +''' Left, Top: Distances from top and left edges of the screen +''' Width, Height: Dimensions of the window +''' Examples: +''' ui.Resize(10,,500) ' Top and Height are unchanged +''' ... + +Dim vWindow As Window ' A single component +Dim oContainer As Object ' com.sun.star.awt.XWindow +Dim iPosSize As Integer ' Computes which of the 4 arguments should be considered +Const cstThisSub = "UI.Resize" +Const cstSubArgs = "[Left], [Top], [Width], [Height]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Left) Or IsEmpty(Left) Then Left = -1 + If IsMissing(Top) Or IsEmpty(Top) Then Top = -1 + If IsMissing(Width) Or IsEmpty(Width) Then Width = -1 + If IsMissing(Height) Or IsEmpty(Height) Then Height = -1 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Left, "Left", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Top, "Top", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Width, "Width", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Height, "Height", V_NUMERIC) Then GoTo Finally + End If + +Try: + vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent) + If Not IsNull(vWindow.Frame) Then + Set oContainer = vWindow.Frame.ContainerWindow + iPosSize = 0 + If Left >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X + If Top >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y + If Width > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH + If Height > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT + With oContainer + .IsMaximized = False + .IsMinimized = False + .setPosSize(Left, Top, Width, Height, iPosSize) + End With + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_UI.Resize + +REM ----------------------------------------------------------------------------- +Public Sub RunCommand(Optional ByVal Command As Variant _ + , ParamArray Args As Variant _ + ) +''' Run on the current window the given menu command. The command is executed with or without arguments +''' A few typical commands: +''' About, Delete, Edit, Undo, Copy, Paste, ... +''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands +''' Args: +''' Command: Case-sensitive. The command itself is not checked. +''' If the command does not contain the ".uno:" prefix, it is added. +''' If nothing happens, then the command is probably wrong +''' Args: Pairs of arguments name (string), value (any) +''' Returns: +''' Examples: +''' ui.RunCommand("BasicIDEAppear", _ +''' "Document", "LibreOffice Macros & Dialogs", _ +''' "LibName", "ScriptForge", _ +''' "Name", "SF_Session", _ +''' "Line", 600) + +Dim oDispatch ' com.sun.star.frame.DispatchHelper +Dim vProps As Variant ' Array of PropertyValues +Dim vValue As Variant ' A single value argument +Dim sCommand As String ' Alias of Command +Dim i As Long +Const cstPrefix = ".uno:" + +Const cstThisSub = "UI.RunCommand" +Const cstSubArgs = "Command, [arg0Name, arg0Value], [arg1Name, arg1Value], ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally + If Not SF_Utils._ValidateArray(Args, "Args", 1) Then GoTo Finally + For i = 0 To UBound(Args) - 1 Step 2 + If Not SF_Utils._Validate(Args(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally + Next i + End If + +Try: + ' Build array of property values + vProps = Array() + For i = 0 To UBound(Args) - 1 Step 2 + If IsEmpty(Args(i + 1)) Then vValue = Null Else vValue = Args(i + 1) + vProps = SF_Array.Append(vProps, SF_Utils._MakePropertyValue(Args(i), vValue)) + Next i + Set oDispatch = SF_Utils._GetUNOService("DispatchHelper") + If SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command + oDispatch.executeDispatch(StarDesktop.ActiveFrame, sCommand, "", 0, vProps) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_UI.RunCommand + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "UI.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_UI.SetProperty + +REM ----------------------------------------------------------------------------- +Public Sub SetStatusbar(Optional ByVal Text As Variant _ + , Optional ByVal Percentage As Variant _ + ) +''' Display a text and a progressbar in the status bar of the active window +''' Any subsequent calls in the same macro run refer to the same status bar of the same window, +''' even if the window is not active anymore +''' A call without arguments resets the status bar to its normal state. +''' Args: +''' Text: the optional text to be displayed before the progress bar +''' Percentage: the optional degree of progress between 0 and 100 +''' Examples: +''' Dim i As Integer +''' For i = 0 To 100 +''' ui.SetStatusbar("Progress ...", i) +''' Wait 50 +''' Next i +''' ui.SetStatusbar + +Dim oComp As Object +Dim oControl As Object +Dim oStatusbar As Object +Const cstThisSub = "UI.SetStatusbar" +Const cstSubArgs = "[Text], [Percentage]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Text) Or IsEmpty(Text) Then Text = "" + If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Text, "Text", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Percentage, "Percentage", V_NUMERIC) Then GoTo Finally + End If + +Try: + Set oStatusbar = _SF_.Statusbar + With oStatusbar + If IsNull(oStatusbar) Then ' Initial call + Set oComp = StarDesktop.CurrentComponent + If Not IsNull(oComp) Then + Set oControl = Nothing + If SF_Session.HasUnoProperty(oComp, "CurrentController") Then Set oControl = oComp.CurrentController + If Not IsNull(oControl) Then + If SF_Session.HasUnoMethod(oControl, "getStatusIndicator") Then oStatusbar = oControl.getStatusIndicator() + End If + End If + If Not IsNull(oStatusbar) Then + .start("", 100) + End If + End If + If Not IsNull(oStatusbar) Then + If Len(Text) = 0 And Percentage = -1 Then + .end() + Set oStatusbar = Nothing + Else + If Len(Text) > 0 Then .setText(Text) + If Percentage >= 0 And Percentage <= 100 Then .setValue(Percentage) + End If + End If + End With + +Finally: + Set _SF_.Statusbar = oStatusbar + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_UI.SetStatusbar + +REM ----------------------------------------------------------------------------- +Public Sub ShowProgressBar(Optional Title As Variant _ + , Optional ByVal Text As Variant _ + , Optional ByVal Percentage As Variant _ + , Optional ByRef _Context As Variant _ + ) +''' Display a non-modal dialog box. Specify its title, an explicatory text and the progress on a progressbar +''' A call without arguments erases the progress bar dialog. +''' The box will anyway vanish at the end of the macro run. +''' Args: +''' Title: the title appearing on top of the dialog box (Default = "ScriptForge") +''' Text: the optional text to be displayed above the progress bar (default = zero-length string) +''' Percentage: the degree of progress between 0 and 100. Default = 0 +''' _Context: from Python, the XComponentXontext (FOR INTERNAL USE ONLY) +''' Examples: +''' Dim i As Integer +''' For i = 0 To 100 +''' ui.ShowProgressBar(, "Progress ... " & i & "/100", i) +''' Wait 50 +''' Next i +''' ui.ShowProgressBar + +Dim bFirstCall As Boolean ' True at first invocation of method +Dim oDialog As Object ' SFDialogs.Dialog object +Dim oFixedText As Object ' SFDialogs.DialogControl object +Dim oProgressBar As Object ' SFDialogs.DialogControl object +Dim sTitle As String ' Alias of Title +Const cstThisSub = "UI.ShowProgressBar" +Const cstSubArgs = "[Title], [Text], [Percentage]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Title) Or IsEmpty(Title) Then Title = "" + If IsMissing(Text) Or IsEmpty(Text) Then Text = "" + If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1 + If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Title, "Title", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Text, "Text", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Percentage, "Percentage", V_NUMERIC) Then GoTo Finally + End If + +Try: + With _SF_ + Set oDialog = .ProgressBarDialog + Set oFixedText = .ProgressBarText + Set oProgressBar = .ProgressBarBar + End With + With oDialog + bFirstCall = ( IsNull(oDialog) ) + If Not bFirstCall Then bFirstCall = Not ._IsStillAlive(False) ' False to not raise an error + If bFirstCall Then Set oDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgProgress", _Context) + + If Not IsNull(oDialog) Then + If Len(Title) = 0 And Len(Text) = 0 And Percentage = -1 Then + Set oDialog = .Dispose() + Else + .Caption = Iif(Len(Title) > 0, Title, "ScriptForge") + If bFirstCall Then + Set oFixedText = .Controls("ProgressText") + Set oProgressBar = .Controls("ProgressBar") + .Execute(Modal := False) + End If + If Len(Text) > 0 Then oFixedText.Caption = Text + oProgressBar.Value = Iif(Percentage >= 0 And Percentage <= 100, Percentage, 0) + End If + End If + End With + +Finally: + With _SF_ + Set .ProgressBarDialog = oDialog + Set .ProgressBarText = oFixedText + Set .ProgressBarBar = oProgressBar + End With + SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' ScriptForge.SF_UI.ShowProgressBar + +REM ----------------------------------------------------------------------------- +Public Function WindowExists(Optional ByVal WindowName As Variant) As Boolean +''' Returns True if the specified window exists +''' Args: +''' WindowName: see definitions +''' Returns: +''' True if the given window is found +''' Examples: +''' ui.WindowExists("C:\Me\My file.odt") + +Dim bWindowExists As Boolean ' Return value +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim vWindow As Window ' A single component +Dim oContainer As Object ' com.sun.star.awt.XWindow +Const cstThisSub = "UI.WindowExists" +Const cstSubArgs = "WindowName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bWindowExists = False + +Check: + If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateFile(WindowName, "WindowName") Then GoTo Finally + End If + +Try: + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements + Set oComp = oEnum.nextElement + vWindow = SF_UI._IdentifyWindow(oComp) + With vWindow + ' Does the current window match the arguments ? + If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _ + Or (Len(.WindowName) > 0 And .WindowName = WindowName) _ + Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then + bWindowExists = True + Exit Do + End If + End With + Loop + +Finally: + WindowExists = bWindowExists + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_UI.WindowExists + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Sub _CloseProgressBar(Optional ByRef poEvent As Object) +''' Triggered by the Close button in the dlgProgress dialog +''' to simply close the dialog + + ShowProgressBar() ' Without arguments => close the dialog + +End Sub ' ScriptForge.SF_UI._CloseProgressBar + +REM ----------------------------------------------------------------------------- +Public Function _IdentifyWindow(ByRef poComponent As Object) As Object +''' Return a Window object (definition on top of module) based on component given as argument +''' Is a shortcut to explore the most relevant properties or objects bound to a UNO component + +Dim oWindow As Window ' Return value +Dim sImplementation As String ' Component's implementationname +Dim sIdentifier As String ' Component's identifier +Dim vArg As Variant ' One single item of the Args UNO property +Dim FSO As Object ' Alias for SF_FileSystem + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set _IdentifyWindow = Nothing + sImplementation = "" : sIdentifier = "" + + Set FSO = SF_FileSystem + With oWindow + Set .Frame = Nothing + Set .Component = Nothing + .WindowName = "" + .WindowTitle = "" + .WindowFileName = "" + .DocumentType = "" + If IsNull(poComponent) Then GoTo Finally + If SF_Session.HasUnoProperty(poComponent, "ImplementationName") Then sImplementation = poComponent.ImplementationName + If SF_Session.HasUnoProperty(poComponent, "Identifier") Then sIdentifier = poComponent.Identifier + Set .Component = poComponent + Select Case sImplementation + Case "com.sun.star.comp.basic.BasicIDE" + .WindowName = BASICIDE + Case "com.sun.star.comp.dba.ODatabaseDocument" ' No identifier + .WindowFileName = SF_Utils._GetPropertyValue(poComponent.Args, "URL") + If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName)) + .DocumentType = BASEDOCUMENT + Case "org.openoffice.comp.dbu.ODatasourceBrowser" + Case "org.openoffice.comp.dbu.OTableDesign", "org.openoffice.comp.dbu.OQueryDesign" ' Table or Query in Edit mode + Case "org.openoffice.comp.dbu.ORelationDesign" + Case "com.sun.star.comp.sfx2.BackingComp" ' Welcome screen + Set .Frame = poComponent.Frame + .WindowName = WELCOMESCREEN + Case Else + If Len(sIdentifier) > 0 Then + ' Do not use URL : it contains the TemplateFile when new documents are created from a template + .WindowFileName = poComponent.Location + If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName)) + If SF_Session.HasUnoProperty(poComponent, "Title") Then .WindowTitle = poComponent.Title + Select Case sIdentifier + Case "com.sun.star.sdb.FormDesign" ' Form + Case "com.sun.star.sdb.TextReportDesign" ' Report + Case "com.sun.star.text.TextDocument" ' Writer + .DocumentType = WRITERDOCUMENT + Case "com.sun.star.sheet.SpreadsheetDocument" ' Calc + .DocumentType = CALCDOCUMENT + Case "com.sun.star.presentation.PresentationDocument" ' Impress + .DocumentType = IMPRESSDOCUMENT + Case "com.sun.star.drawing.DrawingDocument" ' Draw + .DocumentType = DRAWDOCUMENT + Case "com.sun.star.formula.FormulaProperties" ' Math + .DocumentType = MATHDOCUMENT + Case Else + End Select + End If + End Select + If IsNull(.Frame) Then + If Not IsNull(poComponent.CurrentController) Then Set .Frame = poComponent.CurrentController.Frame + End If + End With + +Finally: + Set _IdentifyWindow = oWindow + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_UI._IdentifyWindow + +REM ----------------------------------------------------------------------------- +Public Function _PosSize() As Object +''' Returns the PosSize structure of the active window + +Dim vWindow As Window ' A single component +Dim oContainer As Object ' com.sun.star.awt.XWindow +Dim oPosSize As Object ' com.sun.star.awt.Rectangle + + Set oPosSize = Nothing + +Try: + vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent) + If Not IsNull(vWindow.Frame) Then + Set oContainer = vWindow.Frame.ContainerWindow + Set oPosSize = oContainer.getPosSize() + End If + +Finally: + Set _PosSize = oPosSize + Exit Function +End Function ' ScriptForge.SF_UI._PosSize + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the UI instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[UI]" + + _Repr = "[UI]" + +End Function ' ScriptForge.SF_UI._Repr + +REM ============================================ END OF SCRIPTFORGE.SF_UI +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/SF_Utils.xba b/wizards/source/scriptforge/SF_Utils.xba new file mode 100644 index 000000000..91b703c46 --- /dev/null +++ b/wizards/source/scriptforge/SF_Utils.xba @@ -0,0 +1,1113 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Utils" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Explicit +Option Private Module + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Utils +''' ======== +''' FOR INTERNAL USE ONLY +''' Groups all private functions used by the official modules +''' Declares the Global variable _SF_ +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ===================================================================== GLOBALS + +Global _SF_ As Variant ' SF_Root (Basic) object) + +''' ScriptForge version +Const SF_Version = "7.4" + +''' Standard symbolic names for VarTypes +' V_EMPTY = 0 +' V_NULL = 1 +' V_INTEGER = 2 +' V_LONG = 3 +' V_SINGLE = 4 +' V_DOUBLE = 5 +' V_CURRENCY = 6 +' V_DATE = 7 +' V_STRING = 8 +''' Additional symbolic names for VarTypes +Global Const V_OBJECT = 9 +Global Const V_BOOLEAN = 11 +Global Const V_VARIANT = 12 +Global Const V_BYTE = 17 +Global Const V_USHORT = 18 +Global Const V_ULONG = 19 +Global Const V_BIGINT = 35 +Global Const V_DECIMAL = 37 +Global Const V_ARRAY = 8192 +''' Fictive VarTypes +Global Const V_NUMERIC = 99 ' Synonym of any numeric value [returned by _VarTypeExt()] +Global Const V_NOTHING = 101 ' Object categories [returned by _VarTypeObj()] Null object +Global Const V_UNOOBJECT = 102 ' Uno object or Uno structure +Global Const V_SFOBJECT = 103 ' ScriptForge object: has ObjectType and ServiceName properties +Global Const V_BASICOBJECT = 104 ' User Basic object + +Type _ObjectDescriptor ' Returned by the _VarTypeObj() method + iVarType As Integer ' One of the V_NOTHING, V_xxxOBJECT constants + sObjectType As String ' Either "" or "com.sun.star..." or a ScriptForge object type (ex. "SF_SESSION" or "DICTIONARY") + sServiceName As String ' Either "" or the service name of a ScriptForge object type (ex. "ScriptForge.Exception"- +End Type + +REM ================================================================== EXCEPTIONS + +Const MISSINGARGERROR = "MISSINGARGERROR" ' A mandatory argument is missing +Const ARGUMENTERROR = "ARGUMENTERROR" ' An argument does not pass the _Validate() validation +Const ARRAYERROR = "ARRAYERROR" ' An argument does not pass the _ValidateArray() validation +Const FILEERROR = "FILEERROR" ' An argument does not pass the _ValidateFile() validation + +REM =========================================pvA==================== PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Public Function _CDateToIso(pvDate As Variant) As Variant +''' Returns a string representation of the given Basic date +''' Dates as strings are essential in property values, where Basic dates are evil + +Dim sIsoDate As Variant ' Return value + + If VarType(pvDate) = V_DATE Then + If Year(pvDate) < 1900 Then ' Time only + sIsoDate = Right("0" & Hour(pvDate), 2) & ":" & Right("0" & Minute(pvDate), 2) & ":" & Right("0" & Second(pvDate), 2) + ElseIf Hour(pvDate) + Minute(pvDate) + Second(pvDate) = 0 Then ' Date only + sIsoDate = Year(pvDate) & "-" & Right("0" & Month(pvDate), 2) & "-" & Right("0" & Day(pvDate), 2) + Else + sIsoDate = Year(pvDate) & "-" & Right("0" & Month(pvDate), 2) & "-" & Right("0" & Day(pvDate), 2) _ + & " " & Right("0" & Hour(pvDate), 2) & ":" & Right("0" & Minute(pvDate), 2) _ + & ":" & Right("0" & Second(pvDate), 2) + End If + Else + sIsoDate = pvDate + End If + + _CDateToIso = sIsoDate + +End Function ' ScriptForge.SF_Utils._CDateToIso + +REM ----------------------------------------------------------------------------- +Public Function _CDateToUnoDate(pvDate As Variant) As Variant +''' Returns a UNO com.sun.star.util.DateTime/Date/Time object depending on the given date +''' by using the appropriate CDateToUnoDateXxx builtin function +''' UNO dates are essential in property values, where Basic dates are evil + +Dim vUnoDate As Variant ' Return value + + If VarType(pvDate) = V_DATE Then + If Year(pvDate) < 1900 Then + vUnoDate = CDateToUnoTime(pvDate) + ElseIf Hour(pvDate) + Minute(pvDate) + Second(pvDate) = 0 Then + vUnoDate = CDateToUnoDate(pvDate) + Else + vUnoDate = CDateToUnoDateTime(pvDate) + End If + Else + vUnoDate = pvDate + End If + + _CDateToUnoDate = vUnoDate + +End Function ' ScriptForge.SF_Utils._CDateToUnoDate + +REM ----------------------------------------------------------------------------- +Public Function _CPropertyValue(ByRef pvValue As Variant) As Variant +''' Set a value of a correct type in a com.sun.star.beans.PropertyValue +''' Date BASIC variables give error. Change them to UNO types +''' Empty arrays should be replaced by Null + +Dim vValue As Variant ' Return value + + If VarType(pvValue) = V_DATE Then + vValue = SF_Utils._CDateToUnoDate(pvValue) + ElseIf IsArray(pvValue) Then + If UBound(pvValue, 1) < LBound(pvValue, 1) Then vValue = Null Else vValue = pvValue + Else + vValue = pvValue + End If + _CPropertyValue() = vValue + +End Function ' ScriptForge.SF_Utils._CPropertyValue + +REM ----------------------------------------------------------------------------- +Public Function _CStrToDate(ByRef pvStr As String) As Date +''' Attempt to convert the input string to a Date variable with the CDate builtin function +''' If not successful, returns conventionally -1 (29/12/1899) +''' Date patterns: YYYY-MM-DD, HH:MM:DD and YYYY-MM-DD HH:MM:DD + +Dim dDate As Date ' Return value +Const cstNoDate = -1 + + dDate = cstNoDate +Try: + On Local Error Resume Next + dDate = CDate(pvStr) + +Finally: + _CStrToDate = dDate + Exit Function +End Function ' ScriptForge.SF_Utils._CStrToDate + +REM ----------------------------------------------------------------------------- +Public Function _EnterFunction(ByVal psSub As String, Optional ByVal psArgs As String) +''' Called on top of each public function +''' Used to trace routine in/outs (debug mode) +''' and to allow the explicit mention of the user call which caused an error +''' Args: +''' psSub = the called Sub/Function/Property, usually something like "service.sub" +''' Return: True when psSub is called from a user script +''' Used to bypass the validation of the arguments when unnecessary + + If IsEmpty(_SF_) Or IsNull(_SF_) Then SF_Utils._InitializeRoot() ' First use of ScriptForge during current LibO session + If IsMissing(psArgs) Then psArgs = "" + With _SF_ + If .StackLevel = 0 Then + .MainFunction = psSub + .MainFunctionArgs = psArgs + _EnterFunction = True + Else + _EnterFunction = False + End If + .StackLevel = .StackLevel + 1 + If .DebugMode Then ._AddToConsole("==> " & psSub & "(" & .StackLevel & ")") + End With + +End Function ' ScriptForge.SF_Utils._EnterFunction + +REM ----------------------------------------------------------------------------- +Public Function _ErrorHandling(Optional ByVal pbErrorHandler As Boolean) As Boolean +''' Error handling is normally ON and can be set OFF for debugging purposes +''' Each user visible routine starts with a call to this function to enable/disable +''' standard handling of internal errors +''' Args: +''' pbErrorHandler = if present, set its value +''' Return: the current value of the error handler + + If IsEmpty(_SF_) Or IsNull(_SF_) Then SF_Utils._InitializeRoot() ' First use of ScriptForge during current LibO session + If Not IsMissing(pbErrorHandler) Then _SF_.ErrorHandler = pbErrorHandler + _ErrorHandling = _SF_.ErrorHandler + +End Function ' ScriptForge.SF_Utils._ErrorHandling + +REM ----------------------------------------------------------------------------- +Public Sub _ExitFunction(ByVal psSub As String) +''' Called in the Finally block of each public function +''' Manage ScriptForge internal aborts +''' Resets MainFunction (root) when exiting the method called by a user script +''' Used to trace routine in/outs (debug mode) +''' Args: +''' psSub = the called Sub/Function/Property, usually something like "service.sub" + + If IsEmpty(_SF_) Or IsNull(_SF_) Then SF_Utils._InitializeRoot() ' Useful only when current module has been recompiled + With _SF_ + If Err > 0 Then + SF_Exception.RaiseAbort(psSub) + End If + If .StackLevel = 1 Then + .MainFunction = "" + .MainFunctionArgs = "" + End If + If .DebugMode Then ._AddToConsole("<== " & psSub & "(" & .StackLevel & ")") + If .StackLevel > 0 Then .StackLevel = .StackLevel - 1 + End With + +End Sub ' ScriptForge.SF_Utils._ExitFunction + +REM ----------------------------------------------------------------------------- +Public Sub _ExportScriptForgePOTFile(ByVal FileName As String) +''' Export the ScriptForge POT file related to its own user interface +''' Should be called only before issuing new ScriptForge releases only +''' Args: +''' FileName: the resulting file. If it exists, is overwritten without warning + +Dim sHeader As String ' The specific header to insert + + sHeader = "" _ + & "*********************************************************************\n" _ + & "*** The ScriptForge library and its associated libraries ***\n" _ + & "*** are part of the LibreOffice project. ***\n" _ + & "*********************************************************************\n" _ + & "\n" _ + & "ScriptForge Release " & SF_Version & "\n" _ + & "-----------------------" + +Try: + With _SF_ + If Not IsNull(.LocalizedInterface) Then .LocalizedInterface.Dispose() + ._LoadLocalizedInterface(psMode := "ADDTEXT") ' Force reload of labels from the code + .LocalizedInterface.ExportToPOTFile(FileName, Header := sHeader) + End With + +Finally: + Exit Sub +End Sub ' ScriptForge.SF_Utils._ExportScriptForgePOTFile + +REM ----------------------------------------------------------------------------- +Public Function _GetPropertyValue(ByRef pvArgs As Variant, ByVal psName As String) As Variant +''' Returns the Value corresponding to the given name +''' Args +''' pvArgs: a zero_based array of PropertyValues +''' psName: the comparison is not case-sensitive +''' Returns: +''' Zero-length string if not found + +Dim vValue As Variant ' Return value +Dim i As Long + + vValue = "" + If IsArray(pvArgs) Then + For i = LBound(pvArgs) To UBound(pvArgs) + If UCase(psName) = UCase(pvArgs(i).Name) Then + vValue = pvArgs(i).Value + Exit For + End If + Next i + End If + _GetPropertyValue = vValue + +End Function ' ScriptForge.SF_Utils._GetPropertyValue + +REM ----------------------------------------------------------------------------- +Public Function _GetRegistryKeyContent(ByVal psKeyName as string _ + , Optional pbForUpdate as Boolean _ + ) As Variant +''' Implement a ConfigurationProvider service +''' Derived from the Tools library +''' Args: +''' psKeyName: the name of the node in the configuration tree +''' pbForUpdate: default = False + +Dim oConfigProvider as Object ' com.sun.star.configuration.ConfigurationProvider +Dim vNodePath(0) as New com.sun.star.beans.PropertyValue +Dim sConfig As String ' One of next 2 constants +Const cstConfig = "com.sun.star.configuration.ConfigurationAccess" +Const cstConfigUpdate = "com.sun.star.configuration.ConfigurationUpdateAccess" + + Set oConfigProvider = _GetUNOService("ConfigurationProvider") + vNodePath(0).Name = "nodepath" + vNodePath(0).Value = psKeyName + + If IsMissing(pbForUpdate) Then pbForUpdate = False + If pbForUpdate Then sConfig = cstConfigUpdate Else sConfig = cstConfig + + Set _GetRegistryKeyContent = oConfigProvider.createInstanceWithArguments(sConfig, vNodePath()) + +End Function ' ScriptForge.SF_Utils._GetRegistryKeyContent + +REM ----------------------------------------------------------------------------- +Private Function _GetSetting(ByVal psPreference As String, psProperty As String) As Variant +''' Find in the configuration a specific setting based on its location in the +''' settings registry + +Dim oConfigProvider As Object ' com.sun.star.configuration.ConfigurationProvider +Dim vNodePath As Variant ' Array of com.sun.star.beans.PropertyValue + + ' Derived from the Tools library + Set oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") + vNodePath = Array(SF_Utils._MakePropertyValue("nodepath", psPreference)) + + _GetSetting = oConfigProvider.createInstanceWithArguments( _ + "com.sun.star.configuration.ConfigurationAccess", vNodePath()).getByName(psProperty) + +End Function ' ScriptForge.SF_Utils._GetSetting + +REM ----------------------------------------------------------------------------- +Public Function _GetUNOService(ByVal psService As String _ + , Optional ByVal pvArg As Variant _ + ) As Object +''' Create a UNO service +''' Each service is called only once +''' Args: +''' psService: shortcut to service +''' pvArg: some services might require an argument + +Dim sLocale As String ' fr-BE f.i. +Dim oDefaultContext As Object + + Set _GetUNOService = Nothing + With _SF_ + Select Case psService + Case "BrowseNodeFactory" + Set oDefaultContext = GetDefaultContext() + If Not IsNull(oDefaultContext) Then Set _GetUNOService = oDefaultContext.getValueByName("/singletons/com.sun.star.script.browse.theBrowseNodeFactory") + Case "CalendarImpl" + If IsEmpty(.CalendarImpl) Or IsNull(.CalendarImpl) Then + Set .CalendarImpl = CreateUnoService("com.sun.star.i18n.CalendarImpl") + End If + Set _GetUNOService = .CalendarImpl + Case "CharacterClass" + If IsEmpty(.CharacterClass) Or IsNull(.CharacterClass) Then + Set .CharacterClass = CreateUnoService("com.sun.star.i18n.CharacterClassification") + End If + Set _GetUNOService = .CharacterClass + Case "ConfigurationProvider" + If IsEmpty(.ConfigurationProvider) Or IsNull(.ConfigurationProvider) Then + Set .ConfigurationProvider = CreateUnoService("com.sun.star.configuration.ConfigurationProvider") + End If + Set _GetUNOService = .ConfigurationProvider + Case "CoreReflection" + If IsEmpty(.CoreReflection) Or IsNull(.CoreReflection) Then + Set .CoreReflection = CreateUnoService("com.sun.star.reflection.CoreReflection") + End If + Set _GetUNOService = .CoreReflection + Case "DatabaseContext" + If IsEmpty(.DatabaseContext) Or IsNull(.DatabaseContext) Then + Set .DatabaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") + End If + Set _GetUNOService = .DatabaseContext + Case "DispatchHelper" + If IsEmpty(.DispatchHelper) Or IsNull(.DispatchHelper) Then + Set .DispatchHelper = CreateUnoService("com.sun.star.frame.DispatchHelper") + End If + Set _GetUNOService = .DispatchHelper + Case "FileAccess" + If IsEmpty(.FileAccess) Or IsNull(.FileAccess) Then + Set .FileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") + End If + Set _GetUNOService = .FileAccess + Case "FilePicker" + If IsEmpty(.FilePicker) Or IsNull(.FilePicker) Then + Set .FilePicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") + End If + Set _GetUNOService = .FilePicker + Case "FilterFactory" + If IsEmpty(.FilterFactory) Or IsNull(.FilterFactory) Then + Set .FilterFactory = CreateUnoService("com.sun.star.document.FilterFactory") + End If + Set _GetUNOService = .FilterFactory + Case "FolderPicker" + If IsEmpty(.FolderPicker) Or IsNull(.FolderPicker) Then + Set .FolderPicker = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker") + End If + Set _GetUNOService = .FolderPicker + Case "FormatLocale" + If IsEmpty(.FormatLocale) Or IsNull(.FormatLocale) Then + .FormatLocale = CreateUnoStruct("com.sun.star.lang.Locale") + ' 1st and 2nd chance + sLocale = SF_Utils._GetSetting("org.openoffice.Setup/L10N", "ooSetupSystemLocale") + If Len(sLocale) = 0 Then sLocale = SF_Utils._GetSetting("org.openoffice.System/L10N", "UILocale") + .FormatLocale.Language = Split(sLocale, "-")(0) ' Language is most often 2 chars long, but not always + .FormatLocale.Country = Right(sLocale, 2) + End If + Set _GetUNOService = .FormatLocale + Case "FunctionAccess" + If IsEmpty(.FunctionAccess) Or IsNull(.FunctionAccess) Then + Set .FunctionAccess = CreateUnoService("com.sun.star.sheet.FunctionAccess") + End If + Set _GetUNOService = .FunctionAccess + Case "GraphicExportFilter" + If IsEmpty(.GraphicExportFilter) Or IsNull(.GraphicExportFilter) Then + Set .GraphicExportFilter = CreateUnoService("com.sun.star.drawing.GraphicExportFilter") + End If + Set _GetUNOService = .GraphicExportFilter + Case "Introspection" + If IsEmpty(.Introspection) Or IsNull(.Introspection) Then + Set .Introspection = CreateUnoService("com.sun.star.beans.Introspection") + End If + Set _GetUNOService = .Introspection + Case "LocaleData" + If IsEmpty(.LocaleData) Or IsNull(.LocaleData) Then + Set .LocaleData = CreateUnoService("com.sun.star.i18n.LocaleData") + End If + Set _GetUNOService = .LocaleData + Case "MacroExpander" + Set oDefaultContext = GetDefaultContext() + If Not IsNull(oDefaultContext) Then Set _GetUNOService = oDefaultContext.getValueByName("/singletons/com.sun.star.util.theMacroExpander") + Case "MailService" + If IsEmpty(.MailService) Or IsNull(.MailService) Then + If GetGuiType = 1 Then ' Windows + Set .MailService = CreateUnoService("com.sun.star.system.SimpleSystemMail") + Else + Set .MailService = CreateUnoService("com.sun.star.system.SimpleCommandMail") + End If + End If + Set _GetUNOService = .MailService + Case "Number2Text" + If IsEmpty(.Number2Text) Or IsNull(.Number2Text) Then + Set .Number2Text = CreateUnoService("com.sun.star.linguistic2.NumberText") + End If + Set _GetUNOService = .Number2Text + Case "OfficeLocale" + If IsEmpty(.OfficeLocale) Or IsNull(.OfficeLocale) Then + .OfficeLocale = CreateUnoStruct("com.sun.star.lang.Locale") + ' 1st and 2nd chance + sLocale = SF_Utils._GetSetting("org.openoffice.Setup/L10N", "ooLocale") + If Len(sLocale) = 0 Then sLocale = SF_Utils._GetSetting("org.openoffice.System/L10N", "UILocale") + .OfficeLocale.Language = Split(sLocale, "-")(0) ' Language is most often 2 chars long, but not always + .OfficeLocale.Country = Right(sLocale, 2) + End If + Set _GetUNOService = .OfficeLocale + Case "PackageInformationProvider" + If IsEmpty(.PackageProvider) Or IsNull(.PackageProvider) Then + Set .PackageProvider = GetDefaultContext.getByName("/singletons/com.sun.star.deployment.PackageInformationProvider") + End If + Set _GetUNOService = .PackageProvider + Case "PathSettings" + If IsEmpty(.PathSettings) Or IsNull(.PathSettings) Then + Set .PathSettings = CreateUnoService("com.sun.star.util.PathSettings") + End If + Set _GetUNOService = .PathSettings + Case "PathSubstitution" + If IsEmpty(.PathSubstitution) Or IsNull(.PathSubstitution) Then + Set .PathSubstitution = CreateUnoService("com.sun.star.util.PathSubstitution") + End If + Set _GetUNOService = .PathSubstitution + Case "PrinterServer" + If IsEmpty(.PrinterServer) Or IsNull(.PrinterServer) Then + Set .PrinterServer = CreateUnoService("com.sun.star.awt.PrinterServer") + End If + Set _GetUNOService = .PrinterServer + Case "ScriptProvider" + If IsMissing(pvArg) Then pvArg = SF_Session.SCRIPTISAPPLICATION + Select Case LCase(pvArg) + Case SF_Session.SCRIPTISEMBEDDED ' Document + If Not IsNull(ThisComponent) Then Set _GetUNOService = ThisComponent.getScriptProvider() + Case Else + If IsEmpty(.ScriptProvider) Or IsNull(.ScriptProvider) Then + Set .ScriptProvider = _ + CreateUnoService("com.sun.star.script.provider.MasterScriptProviderFactory").createScriptProvider("") + End If + Set _GetUNOService = .ScriptProvider + End Select + Case "SearchOptions" + If IsEmpty(.SearchOptions) Or IsNull(.SearchOptions) Then + Set .SearchOptions = New com.sun.star.util.SearchOptions + With .SearchOptions + .algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP + .searchFlag = 0 + End With + End If + Set _GetUNOService = .SearchOptions + Case "SystemLocale", "Locale" + If IsEmpty(.SystemLocale) Or IsNull(.SystemLocale) Then + .SystemLocale = CreateUnoStruct("com.sun.star.lang.Locale") + sLocale = SF_Utils._GetSetting("org.openoffice.System/L10N", "SystemLocale") + .SystemLocale.Language = Split(sLocale, "-")(0) ' Language is most often 2 chars long, but not always + .SystemLocale.Country = Right(sLocale, 2) + End If + Set _GetUNOService = .SystemLocale + Case "SystemShellExecute" + If IsEmpty(.SystemShellExecute) Or IsNull(.SystemShellExecute) Then + Set .SystemShellExecute = CreateUnoService("com.sun.star.system.SystemShellExecute") + End If + Set _GetUNOService = .SystemShellExecute + Case "TextSearch" + If IsEmpty(.TextSearch) Or IsNull(.TextSearch) Then + Set .TextSearch = CreateUnoService("com.sun.star.util.TextSearch") + End If + Set _GetUNOService = .TextSearch + Case "Toolkit" + If IsEmpty(.Toolkit) Or IsNull(.Toolkit) Then + Set .Toolkit = CreateUnoService("com.sun.star.awt.Toolkit") + End If + Set _GetUNOService = .Toolkit + Case "URLTransformer" + If IsEmpty(.URLTransformer) Or IsNull(.URLTransformer) Then + Set .URLTransformer = CreateUnoService("com.sun.star.util.URLTransformer") + End If + Set _GetUNOService = .URLTransformer + Case Else + End Select + End With + +End Function ' ScriptForge.SF_Utils._GetUNOService + +REM ----------------------------------------------------------------------------- +Public Sub _InitializeRoot(Optional ByVal pbForce As Boolean) +''' Initialize _SF_ as SF_Root basic object +''' Args: +''' pbForce = True forces the reinit (default = False) + + If IsMissing(pbForce) Then pbForce = False + If pbForce Then Set _SF_ = Nothing + If IsEmpty(_SF_) Or IsNull(_SF_) Then + Set _SF_ = New SF_Root + Set _SF_.[Me] = _SF_ + End If + +End Sub ' ScriptForge.SF_Utils._InitializeRoot + +REM ----------------------------------------------------------------------------- +Public Function _MakePropertyValue(ByVal psName As String _ + , ByRef pvValue As Variant _ + ) As com.sun.star.beans.PropertyValue +''' Create and return a new com.sun.star.beans.PropertyValue + +Dim oPropertyValue As New com.sun.star.beans.PropertyValue + + With oPropertyValue + .Name = psName + .Value = SF_Utils._CPropertyValue(pvValue) + End With + _MakePropertyValue() = oPropertyValue + +End Function ' ScriptForge.SF_Utils._MakePropertyValue + +REM ----------------------------------------------------------------------------- +Public Function _Repr(ByVal pvArg As Variant, Optional ByVal plMax As Long) As String +''' Convert pvArg into a readable string (truncated if length > plMax) +''' Args +''' pvArg: may be of any type +''' plMax: maximum length of the resulting string (default = 32K) + +Dim sArg As String ' Return value +Dim oObject As Object ' Alias of argument to avoid "Object variable not set" +Dim oObjectDesc As Object ' Object descriptor +Dim sLength As String ' String length as a string +Dim i As Long +Const cstBasicObject = "com.sun.star.script.NativeObjectWrapper" + +Const cstMaxLength = 2^15 - 1 ' 32767 +Const cstByteLength = 25 +Const cstEtc = " … " + + If IsMissing(plMax) Then plMax = cstMaxLength + If plMax = 0 Then plMax = cstMaxLength + If IsArray(pvArg) Then + sArg = SF_Array._Repr(pvArg) + Else + Select Case VarType(pvArg) + Case V_EMPTY : sArg = "[EMPTY]" + Case V_NULL : sArg = "[NULL]" + Case V_OBJECT + Set oObjectDesc = SF_Utils._VarTypeObj(pvArg) + With oObjectDesc + Select Case .iVarType + Case V_NOTHING : sArg = "[NOTHING]" + Case V_OBJECT, V_BASICOBJECT + sArg = "[OBJECT]" + Case V_UNOOBJECT : sArg = "[" & .sObjectType & "]" + Case V_SFOBJECT + If Left(.sObjectType, 3) = "SF_" Then ' Standard module + sArg = "[" & .sObjectType & "]" + Else ' Class module must have a _Repr() method + Set oObject = pvArg + sArg = oObject._Repr() + End If + End Select + End With + Case V_VARIANT : sArg = "[VARIANT]" + Case V_STRING + sArg = SF_String._Repr(pvArg) + Case V_BOOLEAN : sArg = Iif(pvArg, "[TRUE]", "[FALSE]") + Case V_BYTE : sArg = Right("00" & Hex(pvArg), 2) + Case V_SINGLE, V_DOUBLE, V_CURRENCY + sArg = Format(pvArg) + If InStr(1, sArg, "E", 1) = 0 Then sArg = Format(pvArg, "##0.0##") + sArg = Replace(sArg, ",", ".") 'Force decimal point + Case V_BIGINT : sArg = CStr(CLng(pvArg)) + Case V_DATE : sArg = _CDateToIso(pvArg) + Case Else : sArg = CStr(pvArg) + End Select + End If + If Len(sArg) > plMax Then + sLength = "(" & Len(sArg) & ")" + sArg = Left(sArg, plMax - Len(cstEtc) - Len(slength)) & cstEtc & sLength + End If + _Repr = sArg + +End Function ' ScriptForge.SF_Utils._Repr + +REM ----------------------------------------------------------------------------- +Private Function _ReprValues(Optional ByVal pvArgs As Variant _ + , Optional ByVal plMax As Long _ + ) As String +''' Convert an array of values to a comma-separated list of readable strings + +Dim sValues As String ' Return value +Dim sValue As String ' A single value +Dim vValue As Variant ' A single item in the argument +Dim i As Long ' Items counter +Const cstMax = 20 ' Maximum length of single string +Const cstContinue = "…" ' Unicode continuation char U+2026 + + _ReprValues = "" + If IsMissing(pvArgs) Then Exit Function + If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) + sValues = "" + For i = 0 To UBound(pvArgs) + vValue = pvArgs(i) + If i < plMax Then + If VarType(vValue) = V_STRING Then sValue = """" & vValue & """" Else sValue = SF_Utils._Repr(vValue, cstMax) + If Len(sValues) = 0 Then sValues = sValue Else sValues = sValues & ", " & sValue + ElseIf i < UBound(pvArgs) Then + sValues = sValues & ", " & cstContinue + Exit For + End If + Next i + _ReprValues = sValues + +End Function ' ScriptForge.SF_Utils._ReprValues + +REM ----------------------------------------------------------------------------- +Public Function _SetPropertyValue(ByVal pvPropertyValue As Variant _ + , ByVal psName As String _ + , ByRef pvValue As Variant _ + ) As Variant +''' Return the 1st argument (passed by reference), which is an array of property values +''' If the property psName exists, update it with pvValue, otherwise create it on top of the returned array + +Dim oPropertyValue As New com.sun.star.beans.PropertyValue +Dim lIndex As Long ' Found entry +Dim vValue As Variant ' Alias of pvValue +Dim vProperties As Variant ' Alias of pvPropertyValue +Dim i As Long + + lIndex = -1 + vProperties = pvPropertyValue + For i = 0 To UBound(vProperties) + If vProperties(i).Name = psName Then + lIndex = i + Exit For + End If + Next i + If lIndex < 0 Then ' Not found + lIndex = UBound(vProperties) + 1 + ReDim Preserve vProperties(0 To lIndex) + Set oPropertyValue = SF_Utils._MakePropertyValue(psName, pvValue) + vProperties(lIndex) = oPropertyValue + vProperties = vProperties + Else ' psName exists already in array of property values + vProperties(lIndex).Value = SF_Utils._CPropertyValue(pvValue) + End If + + _SetPropertyValue = vProperties + +End Function ' ScriptForge.SF_Utils._SetPropertyValue + +REM ----------------------------------------------------------------------------- +Private Function _TypeNames(Optional ByVal pvArgs As Variant) As String +''' Converts the array of VarTypes to a comma-separated list of TypeNames + +Dim sTypes As String ' Return value +Dim sType As String ' A single type +Dim iType As Integer ' A single item of the argument + + _TypeNames = "" + If IsMissing(pvArgs) Then Exit Function + If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) + sTypes = "" + For Each iType In pvArgs + Select Case iType + Case V_EMPTY : sType = "Empty" + Case V_NULL : sType = "Null" + Case V_INTEGER : sType = "Integer" + Case V_LONG : sType = "Long" + Case V_SINGLE : sType = "Single" + Case V_DOUBLE : sType = "Double" + Case V_CURRENCY : sType = "Currency" + Case V_DATE : sType = "Date" + Case V_STRING : sType = "String" + Case V_OBJECT : sType = "Object" + Case V_BOOLEAN : sType = "Boolean" + Case V_VARIANT : sType = "Variant" + Case V_DECIMAL : sType = "Decimal" + Case >= V_ARRAY : sType = "Array" + Case V_NUMERIC : sType = "Numeric" + End Select + If Len(sTypes) = 0 Then sTypes = sType Else sTypes = sTypes & ", " & sType + Next iType + _TypeNames = sTypes + +End Function ' ScriptForge.SF_Utils._TypeNames + +REM ----------------------------------------------------------------------------- +Public Function _Validate(Optional ByRef pvArgument As Variant _ + , ByVal psName As String _ + , Optional ByVal pvTypes As Variant _ + , Optional ByVal pvValues As Variant _ + , Optional ByVal pvRegex As Variant _ + , Optional ByVal pvObjectType As Variant _ + ) As Boolean +''' Validate the arguments set by user scripts +''' The arguments of the function define the validation rules +''' This function ignores arrays. Use _ValidateArray instead +''' Args: +''' pvArgument: the argument to (in)validate +''' psName: the documented name of the argument (can be inserted in an error message) +''' pvTypes: array of allowed VarTypes +''' pvValues: array of allowed values +''' pvRegex: regular expression to comply with +''' pvObjectType: mandatory Basic class +''' Return: True if validation OK +''' Otherwise an error is raised +''' Exceptions: +''' ARGUMENTERROR + +Dim iVarType As Integer ' Extended VarType of argument +Dim bValid As Boolean ' Returned value +Dim oObjectDescriptor As Object ' _ObjectDescriptor type +Const cstMaxLength = 256 ' Maximum length of readable value +Const cstMaxValues = 10 ' Maximum number of allowed items to list in an error message + + ' To avoid useless recursions, keep main function, only increase stack depth + _SF_.StackLevel = _SF_.StackLevel + 1 + On Local Error GoTo Finally ' Do never interrupt + +Try: + bValid = True + If IsMissing(pvArgument) Then GoTo CatchMissing + If IsMissing(pvRegex) Or IsEmpty(pvRegex) Then pvRegex = "" + If IsMissing(pvObjectType) Or IsEmpty(pvObjectType) Then pvObjectType = "" + iVarType = SF_Utils._VarTypeExt(pvArgument) + + ' Arrays NEVER pass validation + If iVarType >= V_ARRAY Then + bValid = False + Else + ' Check existence of argument + bValid = iVarType <> V_NULL And iVarType <> V_EMPTY + ' Check if argument's VarType is valid + If bValid And Not IsMissing(pvTypes) Then + If Not IsArray(pvTypes) Then bValid = ( pvTypes = iVarType ) Else bValid = SF_Array.Contains(pvTypes, iVarType) + End If + ' Check if argument's value is valid + If bValid And Not IsMissing(pvValues) Then + If Not IsArray(pvValues) Then pvValues = Array(pvValues) + bValid = SF_Array.Contains(pvValues, pvArgument, CaseSensitive := False) + End If + ' Check regular expression + If bValid And Len(pvRegex) > 0 And iVarType = V_STRING Then + If Len(pvArgument) > 0 Then bValid = SF_String.IsRegex(pvArgument, pvRegex, CaseSensitive := False) + End If + ' Check instance types + If bValid And Len(pvObjectType) > 0 And iVarType = V_OBJECT Then + 'Set oArgument = pvArgument + Set oObjectDescriptor = SF_Utils._VarTypeObj(pvArgument) + bValid = ( oObjectDescriptor.iVarType = V_SFOBJECT ) + If bValid Then bValid = ( oObjectDescriptor.sObjectType = pvObjectType ) + End If + End If + + If Not bValid Then + ''' Library: ScriptForge + ''' Service: Array + ''' Method: Contains + ''' Arguments: Array_1D, ToFind, [CaseSensitive=False], [SortOrder=""] + ''' A serious error has been detected on argument SortOrder + ''' Rules: SortOrder is of type String + ''' SortOrder must contain one of next values: "ASC", "DESC", "" + ''' Actual value: "Ascending" + SF_Exception.RaiseFatal(ARGUMENTERROR _ + , SF_Utils._Repr(pvArgument, cstMaxLength), psName, SF_Utils._TypeNames(pvTypes) _ + , SF_Utils._ReprValues(pvValues, cstMaxValues), pvRegex, pvObjectType _ + ) + End If + +Finally: + _Validate = bValid + _SF_.StackLevel = _SF_.StackLevel - 1 + Exit Function +CatchMissing: + bValid = False + SF_Exception.RaiseFatal(MISSINGARGERROR, psName) + GoTo Finally +End Function ' ScriptForge.SF_Utils._Validate + +REM ----------------------------------------------------------------------------- +Public Function _ValidateArray(Optional ByRef pvArray As Variant _ + , ByVal psName As String _ + , Optional ByVal piDimensions As Integer _ + , Optional ByVal piType As Integer _ + , Optional ByVal pbNotNull As Boolean _ + ) As Boolean +''' Validate the (array) arguments set by user scripts +''' The arguments of the function define the validation rules +''' This function ignores non-arrays. Use _Validate instead +''' Args: +''' pvArray: the argument to (in)validate +''' psName: the documented name of the array (can be inserted in an error message) +''' piDimensions: the # of dimensions the array must have. 0 = Any (default) +''' piType: (default = -1, i.e. not applicable) +''' For 2D arrays, the 1st column is checked +''' 0 => all items must be any out of next types: string, date or numeric, +''' but homogeneously: all strings or all dates or all numeric +''' V_STRING or V_DATE or V_NUMERIC => that specific type is required +''' pbNotNull: piType must be >=0, otherwise ignored +''' If True: Empty, Null items are rejected +''' Return: True if validation OK +''' Otherwise an error is raised +''' Exceptions: +''' ARRAYERROR + +Dim iVarType As Integer ' VarType of argument +Dim vItem As Variant ' Array item +Dim iItemType As Integer ' VarType of individual items of argument +Dim iDims As Integer ' Number of dimensions of the argument +Dim bValid As Boolean ' Returned value +Dim iArrayType As Integer ' Static array type +Dim iFirstItemType As Integer ' Type of 1st non-null/empty item +Dim sType As String ' Allowed item types as a string +Dim i As Long +Const cstMaxLength = 256 ' Maximum length of readable value + + ' To avoid useless recursions, keep main function, only increase stack depth + + _SF_.StackLevel = _SF_.StackLevel + 1 + On Local Error GoTo Finally ' Do never interrupt + +Try: + bValid = True + If IsMissing(pvArray) Then GoTo CatchMissing + If IsMissing(piDimensions) Then piDimensions = 0 + If IsMissing(piType) Then piType = -1 + If IsMissing(pbNotNull) Then pbNotNull = False + iVarType = VarType(pvArray) + + ' Scalars NEVER pass validation + If iVarType < V_ARRAY Then + bValid = False + Else + ' Check dimensions + iDims = SF_Array.CountDims(pvArray) + If iDims > 2 Then bValid = False ' Only 1D and 2D arrays + If bValid And piDimensions > 0 Then + bValid = ( iDims = piDimensions Or (iDims = 0 And piDimensions = 1) ) ' Allow empty vectors + End If + ' Check VarType and Empty/Null status of the array items + If bValid And iDims = 1 And piType >= 0 Then + iArrayType = SF_Array._StaticType(pvArray) + If (piType = 0 And iArrayType > 0) Or (piType > 0 And iArrayType = piType) Then + ' If static array of the right VarType ..., OK + Else + ' Go through array and check individual items + iFirstItemType = -1 + For i = LBound(pvArray, 1) To UBound(pvArray, 1) + If iDims = 1 Then vItem = pvArray(i) Else vItem = pvArray(i, LBound(pvArray, 2)) + iItemType = SF_Utils._VarTypeExt(vItem) + If iItemType > V_NULL Then ' Exclude Empty and Null + ' Initialization at first non-null item + If iFirstItemType < 0 Then + iFirstItemType = iItemType + If piType > 0 Then bValid = ( iFirstItemType = piType ) Else bValid = SF_Array.Contains(Array(V_STRING, V_DATE, V_NUMERIC), iFirstItemType) + Else + bValid = (iItemType = iFirstItemType) + End If + Else + bValid = Not pbNotNull + End If + If Not bValid Then Exit For + Next i + End If + End If + End If + + If Not bValid Then + ''' Library: ScriptForge + ''' Service: Array + ''' Method: Contains + ''' Arguments: Array_1D, ToFind, [CaseSensitive=False], [SortOrder=""|"ASC"|"DESC"] + ''' An error was detected on argument Array_1D + ''' Rules: Array_1D is of type Array + ''' Array_1D must have maximum 1 dimension + ''' Array_1D must have all elements of the same type: either String, Date or Numeric + ''' Actual value: (0:2, 0:3) + sType = "" + If piType = 0 Then + sType = "String, Date, Numeric" + ElseIf piType > 0 Then + sType = SF_Utils._TypeNames(piType) + End If + SF_Exception.RaiseFatal(ARRAYERROR _ + , SF_Utils._Repr(pvArray, cstMaxLength), psName, piDimensions, sType, pbNotNull) + End If + +Finally: + _ValidateArray = bValid + _SF_.StackLevel = _SF_.StackLevel - 1 + Exit Function +CatchMissing: + bValid = False + SF_Exception.RaiseFatal(MISSINGARGERROR, psName) + GoTo Finally +End Function ' ScriptForge.SF_Utils._ValidateArray + +REM ----------------------------------------------------------------------------- +Public Function _ValidateFile(Optional ByRef pvArgument As Variant _ + , ByVal psName As String _ + , Optional ByVal pbWildCards As Boolean _ + , Optional ByVal pbSpace As Boolean _ + ) +''' Validate the argument as a valid FileName +''' Args: +''' pvArgument: the argument to (in)validate +''' pbWildCards: if True, wildcard characters are accepted in the last component of the 1st argument +''' pbSpace: if True, the argument may be an empty string. Default = False +''' Return: True if validation OK +''' Otherwise an error is raised +''' Exceptions: +''' ARGUMENTERROR + +Dim iVarType As Integer ' VarType of argument +Dim sFile As String ' Alias for argument +Dim bValid As Boolean ' Returned value +Dim sFileNaming As String ' Alias of SF_FileSystem.FileNaming +Dim oArgument As Variant ' Workaround "Object variable not set" error on 1st executable statement +Const cstMaxLength = 256 ' Maximum length of readable value + + ' To avoid useless recursions, keep main function, only increase stack depth + + _SF_.StackLevel = _SF_.StackLevel + 1 + On Local Error GoTo Finally ' Do never interrupt + +Try: + bValid = True + If IsMissing(pvArgument) Then GoTo CatchMissing + If IsMissing(pbWildCards) Then pbWildCards = False + If IsMissing(pbSpace) Then pbSpace = False + iVarType = VarType(pvArgument) + + ' Arrays NEVER pass validation + If iVarType >= V_ARRAY Then + bValid = False + Else + ' Argument must be a string containing a valid file name + bValid = ( iVarType = V_STRING ) + If bValid Then + bValid = ( Len(pvArgument) > 0 Or pbSpace ) + If bValid And Len(pvArgument) > 0 Then + ' Wildcards are replaced by arbitrary alpha characters + If pbWildCards Then + sFile = Replace(Replace(pvArgument, "?", "Z"), "*", "A") + Else + sFile = pvArgument + bValid = ( InStr(sFile, "?") + InStr(sFile, "*") = 0 ) + End If + ' Check file format without wildcards + If bValid Then + With SF_FileSystem + sFileNaming = .FileNaming + Select Case sFileNaming + Case "ANY" : bValid = SF_String.IsUrl(ConvertToUrl(sFile)) + Case "URL" : bValid = SF_String.IsUrl(sFile) + Case "SYS" : bValid = SF_String.IsFileName(sFile) + End Select + End With + End If + ' Check that wildcards are only present in last component + If bValid And pbWildCards Then + sFile = SF_FileSystem.GetParentFolderName(pvArgument) + bValid = ( InStr(sFile, "*") + InStr(sFile, "?") + InStr(sFile,"%3F") = 0 ) ' ConvertToUrl replaces ? by %3F + End If + End If + End If + End If + + If Not bValid Then + ''' Library: ScriptForge + ''' Service: FileSystem + ''' Method: CopyFile + ''' Arguments: Source, Destination + ''' A serious error has been detected on argument Source + ''' Rules: Source is of type String + ''' Source must be a valid file name expressed in operating system notation + ''' Source may contain one or more wildcard characters in its last component + ''' Actual value: /home/jean-*/SomeFile.odt + SF_Exception.RaiseFatal(FILEERROR _ + , SF_Utils._Repr(pvArgument, cstMaxLength), psName, pbWildCards) + End If + +Finally: + _ValidateFile = bValid + _SF_.StackLevel = _SF_.StackLevel - 1 + Exit Function +CatchMissing: + bValid = False + SF_Exception.RaiseFatal(MISSINGARGERROR, psName) + GoTo Finally +End Function ' ScriptForge.SF_Utils._ValidateFile + +REM ----------------------------------------------------------------------------- +Public Function _VarTypeExt(ByRef pvValue As Variant) As Integer +''' Return the VarType of the argument but all numeric types are aggregated into V_NUMERIC +''' Args: +''' pvValue: value to examine +''' Return: +''' The extended VarType + +Dim iType As Integer ' VarType of argument + + iType = VarType(pvValue) + Select Case iType + Case V_INTEGER, V_LONG, V_SINGLE, V_DOUBLE, V_CURRENCY, V_BIGINT, V_DECIMAL + _VarTypeExt = V_NUMERIC + Case Else : _VarTypeExt = iType + End Select + +End Function ' ScriptForge.SF_Utils._VarTypeExt + +REM ----------------------------------------------------------------------------- +Public Function _VarTypeObj(ByRef pvValue As Variant) As Object +''' Inspect the argument that is supposed to be an Object +''' Return the internal type of object as one of the values +''' V_NOTHING Null object +''' V_UNOOBJECT Uno object or Uno structure +''' V_SFOBJECT ScriptForge object: has ObjectType and ServiceName properties +''' V_BASICOBJECT User Basic object +''' coupled with object type as a string ("com.sun.star..." or "SF_..." or "... ScriptForge class ...") +''' When the argument is not an Object, return the usual VarType() of the argument + +Dim oObjDesc As _ObjectDescriptor ' Return value +Dim oValue As Object ' Alias of pvValue used to avoid "Object variable not set" error +Dim sObjType As String ' The type of object is first derived as a string +Dim oReflection As Object ' com.sun.star.reflection.CoreReflection +Dim vClass As Variant ' com.sun.star.reflection.XIdlClass +Dim bUno As Boolean ' True when object recognized as UNO object + +Const cstBasicClass = "com.sun.star.script.NativeObjectWrapper" ' Way to recognize Basic objects + + On Local Error Resume Next ' Object type is established by trial and error + +Try: + With oObjDesc + .iVarType = VarType(pvValue) + .sObjectType = "" + .sServiceName = "" + bUno = False + If .iVarType = V_OBJECT Then + If IsNull(pvValue) Then + .iVarType = V_NOTHING + Else + Set oValue = pvValue + ' Try UNO type with usual ImplementationName property + .sObjectType = oValue.getImplementationName() + If .sObjectType = "" Then + ' Try UNO type with alternative CoreReflection trick + Set oReflection = SF_Utils._GetUNOService("CoreReflection") + vClass = oReflection.getType(oValue) + If vClass.TypeClass >= com.sun.star.uno.TypeClass.STRUCT Then + .sObjectType = vClass.Name + bUno = True + End If + Else + bUno = True + End If + ' Identify Basic objects + If .sObjectType = cstBasicClass Then + bUno = False + ' Try if the Basic object has an ObjectType property + .sObjectType = oValue.ObjectType + .sServiceName = oValue.ServiceName + End If + ' Derive the return value from the object type + Select Case True + Case Len(.sObjectType) = 0 ' Do nothing (return V_OBJECT) + Case .sObjectType = cstBasicClass : .iVarType = V_BASICOBJECT + Case bUno : .iVarType = V_UNOOBJECT + Case Else : .iVarType = V_SFOBJECT + End Select + End If + End If + End With + +Finally: + Set _VarTypeObj = oObjDesc + Exit Function +End Function ' ScriptForge.SF_Utils._VarTypeObj + +REM ================================================= END OF SCRIPTFORGE.SF_UTILS +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/_CodingConventions.xba b/wizards/source/scriptforge/_CodingConventions.xba new file mode 100644 index 000000000..71fb42c77 --- /dev/null +++ b/wizards/source/scriptforge/_CodingConventions.xba @@ -0,0 +1,100 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_CodingConventions" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +''' +' Conventions used in the coding of the *ScriptForge* library +' ----------------------------------------------------------- +''' +' Library and Modules +' =================== +' * Module names are all prefixed with "SF_". +' * The *Option Explicit* statement is mandatory in every module. +' * The *Option Private Module* statement is recommended in internal modules. +' * A standard header presenting the module/class is mandatory +' * An end of file (eof) comment line is mandatory +' * Every module lists the constants that are related to it and documented as return values, arguments, etc. +' They are defined as *Global Const*. +' The scope of global constants being limited to one single library, their invocation from user scripts shall be qualified. +' * The Basic reserved words are *Proper-Cased*. +''' +' Functions and Subroutines +' ========================= +' * LibreOffice ignores the Private/Public attribute in Functions or Subs declarations. +' Nevertheless the attribute must be present. +' Rules to recognize their scope are: +' * Public + name starts with a letter +' The Sub/Function belongs to the official ScriptForge API. +' As such it may be called from any user script. +' * Public + name starts with an underscore "_" +' The Sub/Function may be called only from within the ScriptForge library. +' As such it MUST NOT be called from another library or from a user script, +' as there is no guarantee about the arguments, the semantic or even the existence of that piece of code in a later release. +' * Private - The Sub/Function name must start with an underscore "_". +' The Sub/Function may be called only from the module in which it is located. +' * Functions and Subroutines belonging to the API (= "standard" functions/Subs) are defined in their module in alphabetical order. +' For class modules, all the properties precede the methods which precede the events. +' * Functions and Subroutines not belonging to the API are defined in their module in alphabetical order below the standard ones. +' * The return value of a function is always declared explicitly. +' * The parameters are always declared explicitly even if they're variants. +' * The Function and Sub declarations start at the 1st column of the line. +' * The End Function/Sub statement is followed by a comment reminding the name of the containing library.module and of the function or sub. +' If the Function/Sub is declared for the first time or modified in a release > initial public release, the actual release number is mentioned as well. +''' +' Variable declarations +' ===================== +' * Variable names use only alpha characters, the underscore and digits (no accented characters). +' Exceptionally, names of private variables may be embraced with `[` and `]` if `Option Compatible` is present. +' * The Global, Dim and Const statements always start in the first column of the line. +' * The type (*Dim ... As ...*, *Function ... As ...*) is always declared explicitly, even if the type is Variant. +' * Variables are *Proper-Cased*. They are always preceded by a lower-case letter indicating their type. +' With next exception: variables i, j, k, l, m and n must be declared as integers or longs. +' > b Boolean +' > d Date +' > v Variant +' > o Object +' > i Integer +' > l Long +' > s String +' Example: +' Dim sValue As String +' * Parameters are preceded by the letter *p* which itself precedes the single *typing letter*. +' In official methods, to match their published documentation, the *p* and the *typing letter* may be omitted. Like in: +' Private Function MyFunction(psValue As String) As Variant +' Public Function MyOfficialFunction(Value As String) As Variant +' * Global variables in the ScriptForge library are ALL preceded by an underscore "_" as NONE of them should be invoked from outside the library. +' * Constant values with a local scope are *Proper-Cased* and preceded by the letters *cst*. +' * Constants with a global scope are *UPPER-CASED*. +' Example: +' Global Const ACONSTANT = "This is a global constant" +' Function MyFunction(pocControl As Object, piValue) As Variant +' Dim iValue As Integer +' Const cstMyConstant = 3 +''' +' Indentation +' =========== +' Code shall be indented with TAB characters. +''' +' Goto/Gosub +' ========== +' The *GoSub* … *Return* statement is forbidden. +' The *GoTo* statement is forbidden. +' However *GoTo* is highly recommended for *error* and *exception* handling. +''' +' Comments (english only) +' ======== +' * Every public routine should be documented with a python-like "docstring": +' 1. Role of Sub/Function +' 2. List of arguments, mandatory/optional, role +' 3. Returned value(s) type and meaning +' 4. Examples when useful +' 5. Eventual specific exception codes +' * The "docstring" comments shall be marked by a triple (single) quote character at the beginning of the line +' * Meaningful variables shall be declared one per line. Comment on same line. +' * Comments about a code block should be left indented. +' If it concerns only the next line, no indent required (may also be put at the end of the line). +''' +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/_ModuleModel.xba b/wizards/source/scriptforge/_ModuleModel.xba new file mode 100644 index 000000000..135eced58 --- /dev/null +++ b/wizards/source/scriptforge/_ModuleModel.xba @@ -0,0 +1,221 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_ModuleModel" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule +'Option Private Module + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' ModuleModel (aka SF_Model) +''' =========== +''' Illustration of how the ScriptForge modules are structured +''' Copy and paste this code in an empty Basic module to start a new service +''' Comment in, comment out, erase what you want, but at the end respect the overall structure +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +''' FAKENEWSERROR + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object ' Should be initialized immediately after the New statement + ' Dim obj As Object : Set obj = New SF_Model + ' Set obj.[Me] = obj +Private [_Parent] As Object ' To keep trace of the instance having created a sub-instance + ' Set obj._Parent = [Me] +Private ObjectType As String ' Must be UNIQUE + +REM ============================================================ MODULE CONSTANTS + +Private Const SOMECONSTANT = 1 + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "MODEL" +End Sub ' ScriptForge.SF_Model Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' ScriptForge.SF_Model Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' ScriptForge.SF_Model Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get MyProperty() As Boolean +''' Returns True or False +''' Example: +''' myModel.MyProperty + + MyProperty = _PropertyGet("MyProperty") + +End Property ' ScriptForge.SF_Model.MyProperty + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions: +''' see the exceptions of the individual properties +''' Examples: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "Model.GetProperty" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Model.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "MyFunction" _ + , "etc" _ + ) + +End Function ' ScriptForge.SF_Model.Methods + +REM ----------------------------------------------------------------------------- +Public Function MyFunction(Optional ByVal Arg1 As Variant _ + , Optional ByVal Arg2 As Variant _ + ) As Variant +''' Fictive function that concatenates Arg1 Arg2 times +''' Args: +''' Arg1 String Text +''' Arg2 Numeric Number of times (default = 2) +''' Returns: +''' The new string +''' Exceptions: +''' FAKENEWSERROR +''' Examples: +''' MyFunction("value1") returns "value1value1" + +Dim sOutput As String ' Output buffer +Dim i As Integer +Const cstThisSub = "Model.myFunction" +Const cstSubArgs = "Arg1, [Arg2=2]" + + ' _ErrorHandling returns False when, for debugging, the standard error handling is preferred + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + myFunction = "" + +Check: + If IsMissing(Arg2) Then Arg2 = 2 + ' _EnterFunction returns True when current method is invoked from a user script + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + ' Check Arg1 is a string and Arg2 is a number. + ' Validation rules for scalars and arrays are described in SF_Utils + If Not SF_Utils._Validate(Arg1, "Arg1", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Arg2, "Arg2", V_NUMERIC) Then GoTo Finally + ' Fatal error ? + If Arg2 < 0 Then GoTo CatchFake + End If + +Try: + sOutput = "" + For i = 0 To Arg2 + sOutput = sOutput & Arg1 + Next i + myFunction = sOutput + +Finally: + ' _ExitFunction manages internal (On Local) errors + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchFake: + SF_Exception.RaiseFatal("FAKENEWSERROR", cstThisSub) + GoTo Finally +End Function ' ScriptForge.SF_Model.myFunction + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Model class as an array + + Properties = Array( _ + "MyProperty" _ + , "etc" _ + ) + +End Function ' ScriptForge.SF_Model.Properties + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SF_Model.get" & psProperty + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + + Select Case psProperty + Case "MyProperty" + _PropertyGet = TBD + Case Else + _PropertyGet = Null + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Model._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[MODEL]: A readable string" + + _Repr = "[MODEL]: A readable string" + +End Function ' ScriptForge.SF_Model._Repr + +REM ============================================ END OF SCRIPTFORGE.SF_MODEL +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/__License.xba b/wizards/source/scriptforge/__License.xba new file mode 100644 index 000000000..a81752525 --- /dev/null +++ b/wizards/source/scriptforge/__License.xba @@ -0,0 +1,25 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="__License" script:language="StarBasic" script:moduleType="normal"> +''' Copyright 2019-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE + +REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +''' ScriptForge is distributed in the hope that it will be useful, +''' but WITHOUT ANY WARRANTY; without even the implied warranty of +''' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +''' ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option): + +''' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not +''' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ . + +''' 2) The GNU Lesser General Public License as published by +''' the Free Software Foundation, either version 3 of the License, or +''' (at your option) any later version. If a copy of the LGPL was not +''' distributed with this file, see http://www.gnu.org/licenses/ . + +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/dialog.xlb b/wizards/source/scriptforge/dialog.xlb new file mode 100644 index 000000000..7b54d071c --- /dev/null +++ b/wizards/source/scriptforge/dialog.xlb @@ -0,0 +1,6 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="ScriptForge" library:readonly="false" library:passwordprotected="false"> + <library:element library:name="dlgConsole"/> + <library:element library:name="dlgProgress"/> +</library:library>
\ No newline at end of file diff --git a/wizards/source/scriptforge/dlgConsole.xdl b/wizards/source/scriptforge/dlgConsole.xdl new file mode 100644 index 000000000..64009f571 --- /dev/null +++ b/wizards/source/scriptforge/dlgConsole.xdl @@ -0,0 +1,14 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd"> +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="dlgConsole" dlg:left="114" dlg:top="32" dlg:width="321" dlg:height="239" dlg:closeable="true" dlg:moveable="true" dlg:title="ScriptForge"> + <dlg:styles> + <dlg:style dlg:style-id="0" dlg:font-name="Courier New" dlg:font-stylename="Regular" dlg:font-family="modern"/> + </dlg:styles> + <dlg:bulletinboard> + <dlg:textfield dlg:style-id="0" dlg:id="ConsoleLines" dlg:tab-index="0" dlg:left="4" dlg:top="2" dlg:width="312" dlg:height="225" dlg:hscroll="true" dlg:vscroll="true" dlg:multiline="true" dlg:readonly="true"/> + <dlg:button dlg:id="CloseNonModalButton" dlg:tab-index="2" dlg:left="265" dlg:top="228" dlg:width="50" dlg:height="10" dlg:default="true" dlg:image-src="private:graphicrepository/cmd/sc_cancel.png"> + <script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ScriptForge.SF_Exception._CloseConsole?language=Basic&location=application" script:language="Script"/> + </dlg:button> + <dlg:button dlg:id="CloseModalButton" dlg:tab-index="1" dlg:left="265" dlg:top="228" dlg:width="50" dlg:height="10" dlg:default="true" dlg:button-type="ok" dlg:image-src="private:graphicrepository/cmd/sc_cancel.png"/> + </dlg:bulletinboard> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/scriptforge/dlgProgress.xdl b/wizards/source/scriptforge/dlgProgress.xdl new file mode 100644 index 000000000..9d5f2776d --- /dev/null +++ b/wizards/source/scriptforge/dlgProgress.xdl @@ -0,0 +1,11 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd"> +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="dlgProgress" dlg:left="180" dlg:top="90" dlg:width="275" dlg:height="37" dlg:closeable="true" dlg:moveable="true"> + <dlg:bulletinboard> + <dlg:text dlg:id="ProgressText" dlg:tab-index="1" dlg:left="16" dlg:top="7" dlg:width="245" dlg:height="8" dlg:value="ProgressText" dlg:tabstop="true"/> + <dlg:progressmeter dlg:id="ProgressBar" dlg:tab-index="0" dlg:left="16" dlg:top="18" dlg:width="190" dlg:height="10" dlg:value="50"/> + <dlg:button dlg:id="CloseButton" dlg:tab-index="2" dlg:left="210" dlg:top="18" dlg:width="50" dlg:height="10" dlg:image-src="private:graphicrepository/cmd/sc_cancel.png"> + <script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ScriptForge.SF_UI._CloseProgressBar?language=Basic&location=application" script:language="Script"/> + </dlg:button> + </dlg:bulletinboard> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/scriptforge/po/ScriptForge.pot b/wizards/source/scriptforge/po/ScriptForge.pot new file mode 100644 index 000000000..248d800c0 --- /dev/null +++ b/wizards/source/scriptforge/po/ScriptForge.pot @@ -0,0 +1,975 @@ +# +# This pristine POT file has been generated by LibreOffice/ScriptForge +# Full documentation is available on https://help.libreoffice.org/ +# +# ********************************************************************* +# *** The ScriptForge library and its associated libraries *** +# *** are part of the LibreOffice project. *** +# ********************************************************************* +# +# ScriptForge Release 7.4 +# ----------------------- +# +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" +"POT-Creation-Date: 2022-05-04 18:07:20\n" +"PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n" +"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" +"Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" +"Language: en_US\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=n > 1;\n" +"X-Generator: LibreOffice - ScriptForge\n" +"X-Accelerator-Marker: ~\n" + +#. Title in error message box +#. %1: an error number +#, kde-format +msgctxt "ERRORNUMBER" +msgid "Error %1" +msgstr "" + +#. Error message box +#. %1: a line number +#, kde-format +msgctxt "ERRORLOCATION" +msgid "Location : %1" +msgstr "" + +#. Logfile record +#, kde-format +msgctxt "LONGERRORDESC" +msgid "Error %1 - Location = %2 - Description = %3" +msgstr "" + +#. Any blocking error message +msgctxt "STOPEXECUTION" +msgid "THE EXECUTION IS CANCELLED." +msgstr "" + +#. Any blocking error message +#. %1: a method name +#, kde-format +msgctxt "NEEDMOREHELP" +msgid "Do you want to receive more information about the '%1' method ?" +msgstr "" + +#. SF_Exception.RaiseAbort error message +msgctxt "INTERNALERROR" +msgid "" +"The ScriptForge library has crashed. The reason is unknown.\n" +"Maybe a bug that could be reported on\n" +" https://bugs.documentfoundation.org/\n" +"\n" +"More details : \n" +"\n" +"" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: probably ScriptForge +#. %2: service or module name +#. %3: property or method name where the error occurred +#, kde-format +msgctxt "VALIDATESOURCE" +msgid "" +"Library : %1\n" +"Service : %2\n" +"Method : %3" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: list of arguments of the method +#, kde-format +msgctxt "VALIDATEARGS" +msgid "Arguments: %1" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEERROR" +msgid "A serious error has been detected in your code on argument : « %1 »." +msgstr "" + +#. SF_Utils.Validate error message +msgctxt "VALIDATIONRULES" +msgid " Validation rules :" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: Comma separated list of allowed types +#, kde-format +msgctxt "VALIDATETYPES" +msgid " « %1 » must have next type (or one of next types) : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: Comma separated list of allowed values +#, kde-format +msgctxt "VALIDATEVALUES" +msgid " « %1 » must contain one of next values : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: A regular expression +#, kde-format +msgctxt "VALIDATEREGEX" +msgid " « %1 » must match next regular expression : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: The name of a Basic class +#, kde-format +msgctxt "VALIDATECLASS" +msgid " « %1 » must be a Basic object of class : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: The value of the argument as a string +#, kde-format +msgctxt "VALIDATEACTUAL" +msgid "The actual value of « %1 » is : '%2'" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEMISSING" +msgid "The « %1 » argument is mandatory, yet it is missing." +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEARRAY" +msgid " « %1 » must be an array." +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. %2: Number of dimensions of the array +#, kde-format +msgctxt "VALIDATEDIMS" +msgid " « %1 » must have exactly %2 dimension(s)." +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. %2: Either one single type or 'String, Date, Numeric' +#, kde-format +msgctxt "VALIDATEALLTYPES" +msgid " « %1 » must have all elements of the same type : %2" +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. NULL and EMPTY should not be translated +#, kde-format +msgctxt "VALIDATENOTNULL" +msgid " « %1 » must not contain any NULL or EMPTY elements." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. 'String' should not be translated +#, kde-format +msgctxt "VALIDATEFILE" +msgid " « %1 » must be of type String." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEFILESYS" +msgid "" +" « %1 » must be a valid file or folder name expressed in the " +"operating system native notation." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. 'URL' should not be translated +#, kde-format +msgctxt "VALIDATEFILEURL" +msgid "" +" « %1 » must be a valid file or folder name expressed in the " +"portable URL notation." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEFILEANY" +msgid " « %1 » must be a valid file or folder name." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. '(?, *)' is to be left as is +#, kde-format +msgctxt "VALIDATEWILDCARD" +msgid "" +" « %1 » may contain one or more wildcard characters (?, *) in " +"its last path component only." +msgstr "" + +#. SF_Array.RangeInit error message +#. %1, %2, %3: Numeric values +#. 'From', 'UpTo', 'ByStep' should not be translated +#, kde-format +msgctxt "ARRAYSEQUENCE" +msgid "" +"The respective values of 'From', 'UpTo' and 'ByStep' are incoherent.\n" +"\n" +" « From » = %1\n" +" « UpTo » = %2\n" +" « ByStep » = %3" +msgstr "" + +#. SF_Array.AppendColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_2D' should not be translated +#, kde-format +msgctxt "ARRAYINSERT" +msgid "" +"The array and the vector to insert have incompatible sizes.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" +msgstr "" + +#. SF_Array.ExtractColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_2D' should not be translated +#, kde-format +msgctxt "ARRAYINDEX1" +msgid "" +"The given index does not fit within the bounds of the array.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" +msgstr "" + +#. SF_Array.ExtractColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_1D', 'From' and 'UpTo' should not be translated +#, kde-format +msgctxt "ARRAYINDEX2" +msgid "" +"The given slice limits do not fit within the bounds of the array.\n" +"\n" +" « Array_1D » = %1\n" +" « From » = %2\n" +" « UpTo » = %3" +msgstr "" + +#. SF_Array.ImportFromCSVFile error message +#. %1: a file name +#. %2: numeric +#. %3: a long string +#, kde-format +msgctxt "CSVPARSING" +msgid "" +"The given file could not be parsed as a valid CSV file.\n" +"\n" +" « File name » = %1\n" +" Line number = %2\n" +" Content = %3" +msgstr "" + +#. SF_Dictionary Add/ReplaceKey error message +#. %1: An identifier%2: a (potentially long) string +#, kde-format +msgctxt "DUPLICATEKEY" +msgid "" +"The insertion of a new key into a dictionary failed because the key " +"already exists.\n" +"Note that the comparison between keys is NOT case-sensitive.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Dictionary Remove/ReplaceKey/ReplaceItem error message +#. %1: An identifier%2: a (potentially long) string +#, kde-format +msgctxt "UNKNOWNKEY" +msgid "" +"The requested key does not exist in the dictionary.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Dictionary Add/ReplaceKey error message +#. +msgctxt "INVALIDKEY" +msgid "" +"The insertion or the update of an entry into a dictionary failed " +"because the given key contains only spaces." +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "UNKNOWNFILE" +msgid "" +"The given file could not be found on your system.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A folder name +#, kde-format +msgctxt "UNKNOWNFOLDER" +msgid "" +"The given folder could not be found on your system.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "NOTAFILE" +msgid "" +"« %1 » contains the name of an existing folder, not that of a file.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A folder name +#, kde-format +msgctxt "NOTAFOLDER" +msgid "" +"« %1 » contains the name of an existing file, not that of a folder.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/... error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "OVERWRITE" +msgid "" +"You tried to create a new file which already exists. Overwriting it " +"has been rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "READONLY" +msgid "" +"Copying or moving a file to a destination which has its read-only " +"attribute set, or deleting such a file or folder is forbidden.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file or folder name with wildcards +#, kde-format +msgctxt "NOFILEMATCH" +msgid "" +"When « %1 » contains wildcards. at least one file or folder must " +"match the given filter. Otherwise the operation is rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem CreateFolder error message +#. %1: An identifier +#. %2: A file or folder name +#, kde-format +msgctxt "FOLDERCREATION" +msgid "" +"« %1 » contains the name of an existing file or an existing folder. " +"The operation is rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Services.CreateScriptService error message +#. %1: An identifier +#. %2: A string +#. %3: A Basic library name +#. %4: A service (1 word) name +#, kde-format +msgctxt "UNKNOWNSERVICE" +msgid "" +"No service named '%4' has been registered for the library '%3'.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Services.CreateScriptService error message +#. %1: An identifier +#. %2: A string +#. %3: A Basic library name +#, kde-format +msgctxt "SERVICESNOTLOADED" +msgid "" +"The library '%3' and its services could not been loaded.\n" +"The reason is unknown.\n" +"However, checking the '%3.SF_Services.RegisterScriptServices()' " +"function and its return value can be a good starting point.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Session.ExecuteCalcFunction error message +#. 'Calc' should not be translated +#, kde-format +msgctxt "CALCFUNC" +msgid "" +"The Calc '%1' function encountered an error. Either the given " +"function does not exist or its arguments are invalid." +msgstr "" + +#. SF_Session._GetScript error message +#. %1: 'Basic' or 'Python' +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#. %5: A string +#, kde-format +msgctxt "NOSCRIPT" +msgid "" +"The requested %1 script could not be located in the given libraries " +"and modules.\n" +"« %2 » = %3\n" +"« %4 » = %5" +msgstr "" + +#. SF_Session.ExecuteBasicScript error message +#. %1: An identifier +#. %2: A string +#. %3: A (long) string +#, kde-format +msgctxt "SCRIPTEXEC" +msgid "" +"An exception occurred during the execution of the Basic script.\n" +"Cause: %3\n" +"« %1 » = %2" +msgstr "" + +#. SF_Session.SendMail error message +#. %1 = a mail address +#, kde-format +msgctxt "WRONGEMAIL" +msgid "" +"One of the email addresses has been found invalid.\n" +"Invalid mail = « %1 »" +msgstr "" + +#. SF_Session.SendMail error message +msgctxt "SENDMAIL" +msgid "" +"The message could not be sent due to a system error.\n" +"A possible cause is that LibreOffice could not find any mail client." +msgstr "" + +#. SF_TextStream._IsFileOpen error message +#. %1: A file name +#, kde-format +msgctxt "FILENOTOPEN" +msgid "" +"The requested file operation could not be executed because the file " +"was closed previously.\n" +"\n" +"File name = '%1'" +msgstr "" + +#. SF_TextStream._IsFileOpen error message +#. %1: A file name +#. %2: READ, WRITE or APPEND +#, kde-format +msgctxt "FILEOPENMODE" +msgid "" +"The requested file operation could not be executed because it is " +"incompatible with the mode in which the file was opened.\n" +"\n" +"File name = '%1'\n" +"Open mode = %2" +msgstr "" + +#. SF_TextStream.ReadLine/ReadAll/SkipLine error message +#. %1: A file name +#, kde-format +msgctxt "ENDOFFILE" +msgid "" +"The requested file read operation could not be completed because an " +"unexpected end-of-file was encountered.\n" +"\n" +"File name = '%1'" +msgstr "" + +#. SF_UI.GetDocument error message +#. %1: An identifier +#. %2: A string +#, kde-format +msgctxt "DOCUMENT" +msgid "" +"The requested document could not be found.\n" +"\n" +"%1 = '%2'" +msgstr "" + +#. SF_UI.GetDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#, kde-format +msgctxt "DOCUMENTCREATION" +msgid "" +"The creation of a new document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the document type is unknown, or no template file was given,\n" +"or the given template file was not found on your system.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" +msgstr "" + +#. SF_UI.OpenDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#. %5: An identifier +#. %6: A string +#, kde-format +msgctxt "DOCUMENTOPEN" +msgid "" +"The opening of the document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the file does not exist, or the password is wrong, or the " +"given filter is invalid.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'\n" +"%5 = '%6'" +msgstr "" + +#. SF_UI.OpenDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#, kde-format +msgctxt "BASEDOCUMENTOPEN" +msgid "" +"The opening of the Base document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the file does not exist, or the file is not registered under " +"the given name.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" +msgstr "" + +#. SF_Document._IsStillAlive error message +#. %1: A file name +#, kde-format +msgctxt "DOCUMENTDEAD" +msgid "" +"The requested action could not be executed because the document was " +"closed inadvertently.\n" +"\n" +"The concerned document is '%1'" +msgstr "" + +#. SF_Document.SaveAs error message +#. %1: An identifier +#. %2: A file name +#. +#, kde-format +msgctxt "DOCUMENTSAVE" +msgid "" +"The document could not be saved.\n" +"Either the document has been opened read-only, or the destination " +"file has a read-only attribute set, or the file where to save to is " +"undefined.\n" +"\n" +"%1 = '%2'" +msgstr "" + +#. SF_Document.SaveAs error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. %5: An identifier +#. %6: A string +#, kde-format +msgctxt "DOCUMENTSAVEAS" +msgid "" +"The document could not be saved.\n" +"Either the document must not be overwritten, or the destination file " +"has a read-only attribute set, or the given filter is invalid.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4\n" +"%5 = '%6'" +msgstr "" + +#. SF_Document any update +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "DOCUMENTREADONLY" +msgid "" +"You tried to edit a document which is not modifiable. The document " +"has not been changed.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Base GetDatabase +#. %1: An identifier +#. %2: A user name +#. %3: An identifier +#. %4: A password +#. %5: A file name +#, kde-format +msgctxt "DBCONNECT" +msgid "" +"The database related to the actual Base document could not be " +"retrieved.\n" +"Check the connection/login parameters.\n" +"\n" +"« %1 » = '%2'\n" +"« %3 » = '%4'\n" +"« Document » = %5" +msgstr "" + +#. SF_Calc _ParseAddress (sheet) +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "CALCADDRESS1" +msgid "" +"The given address does not correspond with a valid sheet name.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" + +#. SF_Calc _ParseAddress (range) +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "CALCADDRESS2" +msgid "" +"The given address does not correspond with a valid range of cells.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" + +#. SF_Calc InsertSheet +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "DUPLICATESHEET" +msgid "" +"There exists already in the document a sheet with the same name.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" + +#. SF_Calc Offset +#. %1: An identifier +#. %2: A Calc reference +#. %3: An identifier +#. %4: A number +#. %5: An identifier +#. %6: A number +#. %7: An identifier +#. %8: A number +#. %9: An identifier +#. %10: A number +#. %11: An identifier +#. %12: A file name +#, kde-format +msgctxt "OFFSETADDRESS" +msgid "" +"The computed range falls beyond the sheet boundaries or is " +"meaningless.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8\n" +"« %9 » = %10\n" +"« %11 » = %12" +msgstr "" + +#. SF_Calc CreateChart +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#. %5: An identifier +#. %6: A file name +#, kde-format +msgctxt "DUPLICATECHART" +msgid "" +"A chart with the same name exists already in the sheet.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"" +msgstr "" + +#. SF_Calc.ExportRangeToFile error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. +#, kde-format +msgctxt "RANGEEXPORT" +msgid "" +"The given range could not be exported.\n" +"Either the destination file must not be overwritten, or it has a " +"read-only attribute set.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4" +msgstr "" + +#. SF_Chart.ExportToFile error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. +#, kde-format +msgctxt "CHARTEXPORT" +msgid "" +"The chart could not be exported.\n" +"Either the destination file must not be overwritten, or it has a " +"read-only attribute set.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4" +msgstr "" + +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier%2: A file name +#, kde-format +msgctxt "FORMDEAD" +msgid "" +"The requested action could not be executed because the form is not " +"open or the document was closed inadvertently.\n" +"\n" +"The concerned form is '%1' in document '%2'." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A sheet name +#. %3: A file name +#, kde-format +msgctxt "CALCFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Calc sheet. The given " +"index is off-limits.\n" +"\n" +"The concerned Calc document is '%3'.\n" +"\n" +"The name of the sheet = '%2'\n" +"The index = %1." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A file name +#, kde-format +msgctxt "WRITERFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Writer document. The " +"given index is off-limits.\n" +"\n" +"The concerned Writer document is '%2'.\n" +"\n" +"The index = %1." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A string +#. %3: A file name +#, kde-format +msgctxt "BASEFORMNOTFOUND" +msgid "" +"The requested form could not be found in the form document '%2'. The " +"given index is off-limits.\n" +"\n" +"The concerned Base document is '%3'.\n" +"\n" +"The index = %1." +msgstr "" + +#. SF_Form determination +#. %1: A form name +#. %2: A form name +#, kde-format +msgctxt "SUBFORMNOTFOUND" +msgid "" +"The requested subform could not be found below the given main form.\n" +"\n" +"The main form = '%2'.\n" +"The subform = '%1'." +msgstr "" + +#. SF_FormControl property setting +#. %1: An identifier +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#, kde-format +msgctxt "FORMCONTROLTYPE" +msgid "" +"The control '%1' in form '%2' is of type '%3'.\n" +"The property or method '%4' is not applicable on that type of form " +"controls." +msgstr "" + +#. SF_Dialog creation +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#. %5: An identifier +#. %6: A string +#. %7: An identifier +#. %8: A string +#, kde-format +msgctxt "DIALOGNOTFOUND" +msgid "" +"The requested dialog could not be located in the given container or " +"library.\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8" +msgstr "" + +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier +#, kde-format +msgctxt "DIALOGDEAD" +msgid "" +"The requested action could not be executed because the dialog was " +"closed inadvertently.\n" +"\n" +"The concerned dialog is '%1'." +msgstr "" + +#. SF_DialogControl property setting +#. %1: An identifier +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#, kde-format +msgctxt "CONTROLTYPE" +msgid "" +"The control '%1' in dialog '%2' is of type '%3'.\n" +"The property or method '%4' is not applicable on that type of dialog " +"controls." +msgstr "" + +#. SF_DialogControl add line in textbox +#. %1: An identifier +#. %2: An identifier +#, kde-format +msgctxt "TEXTFIELD" +msgid "" +"The control '%1' in dialog '%2' is not a multiline text field.\n" +"The requested method could not be executed." +msgstr "" + +#. SF_Database when running update SQL statement +#. %1: The concerned method +#, kde-format +msgctxt "DBREADONLY" +msgid "" +"The database has been opened in read-only mode.\n" +"The '%1' method must not be executed in this context." +msgstr "" + +#. SF_Database can't interpret SQL statement +#. %1: The statement +#, kde-format +msgctxt "SQLSYNTAX" +msgid "" +"An SQL statement could not be interpreted or executed by the " +"database system.\n" +"Check its syntax, table and/or field names, ...\n" +"\n" +"SQL Statement : « %1 »" +msgstr "" + +#. SF_Exception.PythonShell error messageAPSO: to leave unchanged +msgctxt "PYTHONSHELL" +msgid "" +"The APSO extension could not be located in your LibreOffice " +"installation." +msgstr "" + +#. SFUnitTest could not locate the library gven as argument +#. %1: The name of the library +#, kde-format +msgctxt "UNITTESTLIBRARY" +msgid "" +"The requested library could not be located.\n" +"The UnitTest service has not been initialized.\n" +"\n" +"Library name : « %1 »" +msgstr "" + +#. SFUnitTest finds a RunTest() call in a inappropriate location +#. %1: The name of a method +#, kde-format +msgctxt "UNITTESTMETHOD" +msgid "" +"The method '%1' is unexpected in the current context.\n" +"The UnitTest service cannot proceed further with the on-going test." +msgstr ""
\ No newline at end of file diff --git a/wizards/source/scriptforge/po/en.po b/wizards/source/scriptforge/po/en.po new file mode 100644 index 000000000..248d800c0 --- /dev/null +++ b/wizards/source/scriptforge/po/en.po @@ -0,0 +1,975 @@ +# +# This pristine POT file has been generated by LibreOffice/ScriptForge +# Full documentation is available on https://help.libreoffice.org/ +# +# ********************************************************************* +# *** The ScriptForge library and its associated libraries *** +# *** are part of the LibreOffice project. *** +# ********************************************************************* +# +# ScriptForge Release 7.4 +# ----------------------- +# +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" +"POT-Creation-Date: 2022-05-04 18:07:20\n" +"PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n" +"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" +"Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" +"Language: en_US\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=n > 1;\n" +"X-Generator: LibreOffice - ScriptForge\n" +"X-Accelerator-Marker: ~\n" + +#. Title in error message box +#. %1: an error number +#, kde-format +msgctxt "ERRORNUMBER" +msgid "Error %1" +msgstr "" + +#. Error message box +#. %1: a line number +#, kde-format +msgctxt "ERRORLOCATION" +msgid "Location : %1" +msgstr "" + +#. Logfile record +#, kde-format +msgctxt "LONGERRORDESC" +msgid "Error %1 - Location = %2 - Description = %3" +msgstr "" + +#. Any blocking error message +msgctxt "STOPEXECUTION" +msgid "THE EXECUTION IS CANCELLED." +msgstr "" + +#. Any blocking error message +#. %1: a method name +#, kde-format +msgctxt "NEEDMOREHELP" +msgid "Do you want to receive more information about the '%1' method ?" +msgstr "" + +#. SF_Exception.RaiseAbort error message +msgctxt "INTERNALERROR" +msgid "" +"The ScriptForge library has crashed. The reason is unknown.\n" +"Maybe a bug that could be reported on\n" +" https://bugs.documentfoundation.org/\n" +"\n" +"More details : \n" +"\n" +"" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: probably ScriptForge +#. %2: service or module name +#. %3: property or method name where the error occurred +#, kde-format +msgctxt "VALIDATESOURCE" +msgid "" +"Library : %1\n" +"Service : %2\n" +"Method : %3" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: list of arguments of the method +#, kde-format +msgctxt "VALIDATEARGS" +msgid "Arguments: %1" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEERROR" +msgid "A serious error has been detected in your code on argument : « %1 »." +msgstr "" + +#. SF_Utils.Validate error message +msgctxt "VALIDATIONRULES" +msgid " Validation rules :" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: Comma separated list of allowed types +#, kde-format +msgctxt "VALIDATETYPES" +msgid " « %1 » must have next type (or one of next types) : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: Comma separated list of allowed values +#, kde-format +msgctxt "VALIDATEVALUES" +msgid " « %1 » must contain one of next values : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: A regular expression +#, kde-format +msgctxt "VALIDATEREGEX" +msgid " « %1 » must match next regular expression : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: The name of a Basic class +#, kde-format +msgctxt "VALIDATECLASS" +msgid " « %1 » must be a Basic object of class : %2" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: The value of the argument as a string +#, kde-format +msgctxt "VALIDATEACTUAL" +msgid "The actual value of « %1 » is : '%2'" +msgstr "" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEMISSING" +msgid "The « %1 » argument is mandatory, yet it is missing." +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEARRAY" +msgid " « %1 » must be an array." +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. %2: Number of dimensions of the array +#, kde-format +msgctxt "VALIDATEDIMS" +msgid " « %1 » must have exactly %2 dimension(s)." +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. %2: Either one single type or 'String, Date, Numeric' +#, kde-format +msgctxt "VALIDATEALLTYPES" +msgid " « %1 » must have all elements of the same type : %2" +msgstr "" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. NULL and EMPTY should not be translated +#, kde-format +msgctxt "VALIDATENOTNULL" +msgid " « %1 » must not contain any NULL or EMPTY elements." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. 'String' should not be translated +#, kde-format +msgctxt "VALIDATEFILE" +msgid " « %1 » must be of type String." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEFILESYS" +msgid "" +" « %1 » must be a valid file or folder name expressed in the " +"operating system native notation." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. 'URL' should not be translated +#, kde-format +msgctxt "VALIDATEFILEURL" +msgid "" +" « %1 » must be a valid file or folder name expressed in the " +"portable URL notation." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEFILEANY" +msgid " « %1 » must be a valid file or folder name." +msgstr "" + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. '(?, *)' is to be left as is +#, kde-format +msgctxt "VALIDATEWILDCARD" +msgid "" +" « %1 » may contain one or more wildcard characters (?, *) in " +"its last path component only." +msgstr "" + +#. SF_Array.RangeInit error message +#. %1, %2, %3: Numeric values +#. 'From', 'UpTo', 'ByStep' should not be translated +#, kde-format +msgctxt "ARRAYSEQUENCE" +msgid "" +"The respective values of 'From', 'UpTo' and 'ByStep' are incoherent.\n" +"\n" +" « From » = %1\n" +" « UpTo » = %2\n" +" « ByStep » = %3" +msgstr "" + +#. SF_Array.AppendColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_2D' should not be translated +#, kde-format +msgctxt "ARRAYINSERT" +msgid "" +"The array and the vector to insert have incompatible sizes.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" +msgstr "" + +#. SF_Array.ExtractColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_2D' should not be translated +#, kde-format +msgctxt "ARRAYINDEX1" +msgid "" +"The given index does not fit within the bounds of the array.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" +msgstr "" + +#. SF_Array.ExtractColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_1D', 'From' and 'UpTo' should not be translated +#, kde-format +msgctxt "ARRAYINDEX2" +msgid "" +"The given slice limits do not fit within the bounds of the array.\n" +"\n" +" « Array_1D » = %1\n" +" « From » = %2\n" +" « UpTo » = %3" +msgstr "" + +#. SF_Array.ImportFromCSVFile error message +#. %1: a file name +#. %2: numeric +#. %3: a long string +#, kde-format +msgctxt "CSVPARSING" +msgid "" +"The given file could not be parsed as a valid CSV file.\n" +"\n" +" « File name » = %1\n" +" Line number = %2\n" +" Content = %3" +msgstr "" + +#. SF_Dictionary Add/ReplaceKey error message +#. %1: An identifier%2: a (potentially long) string +#, kde-format +msgctxt "DUPLICATEKEY" +msgid "" +"The insertion of a new key into a dictionary failed because the key " +"already exists.\n" +"Note that the comparison between keys is NOT case-sensitive.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Dictionary Remove/ReplaceKey/ReplaceItem error message +#. %1: An identifier%2: a (potentially long) string +#, kde-format +msgctxt "UNKNOWNKEY" +msgid "" +"The requested key does not exist in the dictionary.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Dictionary Add/ReplaceKey error message +#. +msgctxt "INVALIDKEY" +msgid "" +"The insertion or the update of an entry into a dictionary failed " +"because the given key contains only spaces." +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "UNKNOWNFILE" +msgid "" +"The given file could not be found on your system.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A folder name +#, kde-format +msgctxt "UNKNOWNFOLDER" +msgid "" +"The given folder could not be found on your system.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "NOTAFILE" +msgid "" +"« %1 » contains the name of an existing folder, not that of a file.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A folder name +#, kde-format +msgctxt "NOTAFOLDER" +msgid "" +"« %1 » contains the name of an existing file, not that of a folder.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/... error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "OVERWRITE" +msgid "" +"You tried to create a new file which already exists. Overwriting it " +"has been rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "READONLY" +msgid "" +"Copying or moving a file to a destination which has its read-only " +"attribute set, or deleting such a file or folder is forbidden.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file or folder name with wildcards +#, kde-format +msgctxt "NOFILEMATCH" +msgid "" +"When « %1 » contains wildcards. at least one file or folder must " +"match the given filter. Otherwise the operation is rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_FileSystem CreateFolder error message +#. %1: An identifier +#. %2: A file or folder name +#, kde-format +msgctxt "FOLDERCREATION" +msgid "" +"« %1 » contains the name of an existing file or an existing folder. " +"The operation is rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Services.CreateScriptService error message +#. %1: An identifier +#. %2: A string +#. %3: A Basic library name +#. %4: A service (1 word) name +#, kde-format +msgctxt "UNKNOWNSERVICE" +msgid "" +"No service named '%4' has been registered for the library '%3'.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Services.CreateScriptService error message +#. %1: An identifier +#. %2: A string +#. %3: A Basic library name +#, kde-format +msgctxt "SERVICESNOTLOADED" +msgid "" +"The library '%3' and its services could not been loaded.\n" +"The reason is unknown.\n" +"However, checking the '%3.SF_Services.RegisterScriptServices()' " +"function and its return value can be a good starting point.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Session.ExecuteCalcFunction error message +#. 'Calc' should not be translated +#, kde-format +msgctxt "CALCFUNC" +msgid "" +"The Calc '%1' function encountered an error. Either the given " +"function does not exist or its arguments are invalid." +msgstr "" + +#. SF_Session._GetScript error message +#. %1: 'Basic' or 'Python' +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#. %5: A string +#, kde-format +msgctxt "NOSCRIPT" +msgid "" +"The requested %1 script could not be located in the given libraries " +"and modules.\n" +"« %2 » = %3\n" +"« %4 » = %5" +msgstr "" + +#. SF_Session.ExecuteBasicScript error message +#. %1: An identifier +#. %2: A string +#. %3: A (long) string +#, kde-format +msgctxt "SCRIPTEXEC" +msgid "" +"An exception occurred during the execution of the Basic script.\n" +"Cause: %3\n" +"« %1 » = %2" +msgstr "" + +#. SF_Session.SendMail error message +#. %1 = a mail address +#, kde-format +msgctxt "WRONGEMAIL" +msgid "" +"One of the email addresses has been found invalid.\n" +"Invalid mail = « %1 »" +msgstr "" + +#. SF_Session.SendMail error message +msgctxt "SENDMAIL" +msgid "" +"The message could not be sent due to a system error.\n" +"A possible cause is that LibreOffice could not find any mail client." +msgstr "" + +#. SF_TextStream._IsFileOpen error message +#. %1: A file name +#, kde-format +msgctxt "FILENOTOPEN" +msgid "" +"The requested file operation could not be executed because the file " +"was closed previously.\n" +"\n" +"File name = '%1'" +msgstr "" + +#. SF_TextStream._IsFileOpen error message +#. %1: A file name +#. %2: READ, WRITE or APPEND +#, kde-format +msgctxt "FILEOPENMODE" +msgid "" +"The requested file operation could not be executed because it is " +"incompatible with the mode in which the file was opened.\n" +"\n" +"File name = '%1'\n" +"Open mode = %2" +msgstr "" + +#. SF_TextStream.ReadLine/ReadAll/SkipLine error message +#. %1: A file name +#, kde-format +msgctxt "ENDOFFILE" +msgid "" +"The requested file read operation could not be completed because an " +"unexpected end-of-file was encountered.\n" +"\n" +"File name = '%1'" +msgstr "" + +#. SF_UI.GetDocument error message +#. %1: An identifier +#. %2: A string +#, kde-format +msgctxt "DOCUMENT" +msgid "" +"The requested document could not be found.\n" +"\n" +"%1 = '%2'" +msgstr "" + +#. SF_UI.GetDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#, kde-format +msgctxt "DOCUMENTCREATION" +msgid "" +"The creation of a new document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the document type is unknown, or no template file was given,\n" +"or the given template file was not found on your system.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" +msgstr "" + +#. SF_UI.OpenDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#. %5: An identifier +#. %6: A string +#, kde-format +msgctxt "DOCUMENTOPEN" +msgid "" +"The opening of the document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the file does not exist, or the password is wrong, or the " +"given filter is invalid.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'\n" +"%5 = '%6'" +msgstr "" + +#. SF_UI.OpenDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#, kde-format +msgctxt "BASEDOCUMENTOPEN" +msgid "" +"The opening of the Base document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the file does not exist, or the file is not registered under " +"the given name.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" +msgstr "" + +#. SF_Document._IsStillAlive error message +#. %1: A file name +#, kde-format +msgctxt "DOCUMENTDEAD" +msgid "" +"The requested action could not be executed because the document was " +"closed inadvertently.\n" +"\n" +"The concerned document is '%1'" +msgstr "" + +#. SF_Document.SaveAs error message +#. %1: An identifier +#. %2: A file name +#. +#, kde-format +msgctxt "DOCUMENTSAVE" +msgid "" +"The document could not be saved.\n" +"Either the document has been opened read-only, or the destination " +"file has a read-only attribute set, or the file where to save to is " +"undefined.\n" +"\n" +"%1 = '%2'" +msgstr "" + +#. SF_Document.SaveAs error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. %5: An identifier +#. %6: A string +#, kde-format +msgctxt "DOCUMENTSAVEAS" +msgid "" +"The document could not be saved.\n" +"Either the document must not be overwritten, or the destination file " +"has a read-only attribute set, or the given filter is invalid.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4\n" +"%5 = '%6'" +msgstr "" + +#. SF_Document any update +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "DOCUMENTREADONLY" +msgid "" +"You tried to edit a document which is not modifiable. The document " +"has not been changed.\n" +"\n" +"« %1 » = %2" +msgstr "" + +#. SF_Base GetDatabase +#. %1: An identifier +#. %2: A user name +#. %3: An identifier +#. %4: A password +#. %5: A file name +#, kde-format +msgctxt "DBCONNECT" +msgid "" +"The database related to the actual Base document could not be " +"retrieved.\n" +"Check the connection/login parameters.\n" +"\n" +"« %1 » = '%2'\n" +"« %3 » = '%4'\n" +"« Document » = %5" +msgstr "" + +#. SF_Calc _ParseAddress (sheet) +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "CALCADDRESS1" +msgid "" +"The given address does not correspond with a valid sheet name.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" + +#. SF_Calc _ParseAddress (range) +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "CALCADDRESS2" +msgid "" +"The given address does not correspond with a valid range of cells.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" + +#. SF_Calc InsertSheet +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "DUPLICATESHEET" +msgid "" +"There exists already in the document a sheet with the same name.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" + +#. SF_Calc Offset +#. %1: An identifier +#. %2: A Calc reference +#. %3: An identifier +#. %4: A number +#. %5: An identifier +#. %6: A number +#. %7: An identifier +#. %8: A number +#. %9: An identifier +#. %10: A number +#. %11: An identifier +#. %12: A file name +#, kde-format +msgctxt "OFFSETADDRESS" +msgid "" +"The computed range falls beyond the sheet boundaries or is " +"meaningless.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8\n" +"« %9 » = %10\n" +"« %11 » = %12" +msgstr "" + +#. SF_Calc CreateChart +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#. %5: An identifier +#. %6: A file name +#, kde-format +msgctxt "DUPLICATECHART" +msgid "" +"A chart with the same name exists already in the sheet.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"" +msgstr "" + +#. SF_Calc.ExportRangeToFile error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. +#, kde-format +msgctxt "RANGEEXPORT" +msgid "" +"The given range could not be exported.\n" +"Either the destination file must not be overwritten, or it has a " +"read-only attribute set.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4" +msgstr "" + +#. SF_Chart.ExportToFile error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. +#, kde-format +msgctxt "CHARTEXPORT" +msgid "" +"The chart could not be exported.\n" +"Either the destination file must not be overwritten, or it has a " +"read-only attribute set.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4" +msgstr "" + +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier%2: A file name +#, kde-format +msgctxt "FORMDEAD" +msgid "" +"The requested action could not be executed because the form is not " +"open or the document was closed inadvertently.\n" +"\n" +"The concerned form is '%1' in document '%2'." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A sheet name +#. %3: A file name +#, kde-format +msgctxt "CALCFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Calc sheet. The given " +"index is off-limits.\n" +"\n" +"The concerned Calc document is '%3'.\n" +"\n" +"The name of the sheet = '%2'\n" +"The index = %1." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A file name +#, kde-format +msgctxt "WRITERFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Writer document. The " +"given index is off-limits.\n" +"\n" +"The concerned Writer document is '%2'.\n" +"\n" +"The index = %1." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A string +#. %3: A file name +#, kde-format +msgctxt "BASEFORMNOTFOUND" +msgid "" +"The requested form could not be found in the form document '%2'. The " +"given index is off-limits.\n" +"\n" +"The concerned Base document is '%3'.\n" +"\n" +"The index = %1." +msgstr "" + +#. SF_Form determination +#. %1: A form name +#. %2: A form name +#, kde-format +msgctxt "SUBFORMNOTFOUND" +msgid "" +"The requested subform could not be found below the given main form.\n" +"\n" +"The main form = '%2'.\n" +"The subform = '%1'." +msgstr "" + +#. SF_FormControl property setting +#. %1: An identifier +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#, kde-format +msgctxt "FORMCONTROLTYPE" +msgid "" +"The control '%1' in form '%2' is of type '%3'.\n" +"The property or method '%4' is not applicable on that type of form " +"controls." +msgstr "" + +#. SF_Dialog creation +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#. %5: An identifier +#. %6: A string +#. %7: An identifier +#. %8: A string +#, kde-format +msgctxt "DIALOGNOTFOUND" +msgid "" +"The requested dialog could not be located in the given container or " +"library.\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8" +msgstr "" + +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier +#, kde-format +msgctxt "DIALOGDEAD" +msgid "" +"The requested action could not be executed because the dialog was " +"closed inadvertently.\n" +"\n" +"The concerned dialog is '%1'." +msgstr "" + +#. SF_DialogControl property setting +#. %1: An identifier +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#, kde-format +msgctxt "CONTROLTYPE" +msgid "" +"The control '%1' in dialog '%2' is of type '%3'.\n" +"The property or method '%4' is not applicable on that type of dialog " +"controls." +msgstr "" + +#. SF_DialogControl add line in textbox +#. %1: An identifier +#. %2: An identifier +#, kde-format +msgctxt "TEXTFIELD" +msgid "" +"The control '%1' in dialog '%2' is not a multiline text field.\n" +"The requested method could not be executed." +msgstr "" + +#. SF_Database when running update SQL statement +#. %1: The concerned method +#, kde-format +msgctxt "DBREADONLY" +msgid "" +"The database has been opened in read-only mode.\n" +"The '%1' method must not be executed in this context." +msgstr "" + +#. SF_Database can't interpret SQL statement +#. %1: The statement +#, kde-format +msgctxt "SQLSYNTAX" +msgid "" +"An SQL statement could not be interpreted or executed by the " +"database system.\n" +"Check its syntax, table and/or field names, ...\n" +"\n" +"SQL Statement : « %1 »" +msgstr "" + +#. SF_Exception.PythonShell error messageAPSO: to leave unchanged +msgctxt "PYTHONSHELL" +msgid "" +"The APSO extension could not be located in your LibreOffice " +"installation." +msgstr "" + +#. SFUnitTest could not locate the library gven as argument +#. %1: The name of the library +#, kde-format +msgctxt "UNITTESTLIBRARY" +msgid "" +"The requested library could not be located.\n" +"The UnitTest service has not been initialized.\n" +"\n" +"Library name : « %1 »" +msgstr "" + +#. SFUnitTest finds a RunTest() call in a inappropriate location +#. %1: The name of a method +#, kde-format +msgctxt "UNITTESTMETHOD" +msgid "" +"The method '%1' is unexpected in the current context.\n" +"The UnitTest service cannot proceed further with the on-going test." +msgstr ""
\ No newline at end of file diff --git a/wizards/source/scriptforge/po/pt.po b/wizards/source/scriptforge/po/pt.po new file mode 100644 index 000000000..a40aafd4c --- /dev/null +++ b/wizards/source/scriptforge/po/pt.po @@ -0,0 +1,1141 @@ +# +# This pristine POT file has been generated by LibreOffice/ScriptForge +# Full documentation is available on https://help.libreoffice.org/ +# +# ********************************************************************* +# *** The ScriptForge library and its associated libraries *** +# *** are part of the LibreOffice project. *** +# ********************************************************************* +# +# ScriptForge Release 7.3 +# ----------------------- +# +msgid "" +msgstr "" +"Project-Id-Version: \n" +"Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?" +"product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" +"POT-Creation-Date: 2021-06-19 16:57:15\n" +"PO-Revision-Date: 2021-06-28 18:30-0300\n" +"Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=(n > 1);\n" +"X-Generator: Poedit 3.0\n" +"X-Accelerator-Marker: ~\n" +"Last-Translator: \n" +"Language: pt_BR\n" + +#. Text in close buttons of progress and console dialog boxes +msgctxt "CLOSEBUTTON" +msgid "Close" +msgstr "Fechar" + +#. Title in error message box +#. %1: an error number +#, kde-format +msgctxt "ERRORNUMBER" +msgid "Error %1" +msgstr "Erro %1" + +#. Error message box +#. %1: a line number +#, kde-format +msgctxt "ERRORLOCATION" +msgid "Location : %1" +msgstr "Localização : %1" + +#. Logfile record +#, kde-format +msgctxt "LONGERRORDESC" +msgid "Error %1 - Location = %2 - Description = %3" +msgstr "Erro %1 - Localização = %2 - Descrição = %3" + +#. SF_Utils._Validate error message +msgctxt "STOPEXECUTION" +msgid "THE EXECUTION IS CANCELLED." +msgstr "A EXECUÇÃO FOI CANCELADA." + +#. SF_Exception.RaiseAbort error message +msgctxt "INTERNALERROR" +msgid "" +"The ScriptForge library has crashed. The reason is unknown.\n" +"Maybe a bug that could be reported on\n" +" https://bugs.documentfoundation.org/\n" +"\n" +"More details : \n" +"\n" +msgstr "" +"A biblioteca ScriptForge encontrou um erro grave. A razão é desconhecida.\n" +"Talvez seja um bug que pode ser relatado em\n" +" https://bugs.documentfoundation.org/\n" +"\n" +"Mais detalhes: \n" +"\n" + +#. SF_Utils._Validate error message +#. %1: probably ScriptForge +#. %2: service or module name +#. %3: property or method name where the error occurred +#, kde-format +msgctxt "VALIDATESOURCE" +msgid "" +"Library : %1\n" +"Service : %2\n" +"Method : %3" +msgstr "" +"Biblioteca : %1\n" +"Serviço : %2\n" +"Método : %3" + +#. SF_Utils._Validate error message +#. %1: list of arguments of the method +#, kde-format +msgctxt "VALIDATEARGS" +msgid "Arguments: %1" +msgstr "Argumentos: %1" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEERROR" +msgid "A serious error has been detected in your code on argument : « %1 »." +msgstr "Um erro grave foi detectado em seu código no argumento : « %1»." + +#. SF_Utils.Validate error message +msgctxt "VALIDATIONRULES" +msgid " Validation rules :" +msgstr " Regras de validação:" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: Comma separated list of allowed types +#, kde-format +msgctxt "VALIDATETYPES" +msgid " « %1 » must have next type (or one of next types) : %2" +msgstr "" +" « %1 » deve ter o seguinte tipo (ou um dos tipos a seguir) : %2" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: Comma separated list of allowed values +#, kde-format +msgctxt "VALIDATEVALUES" +msgid " « %1 » must contain one of next values : %2" +msgstr " « %1 » deve conter um dos seguintes valores : %2" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: A regular expression +#, kde-format +msgctxt "VALIDATEREGEX" +msgid " « %1 » must match next regular expression : %2" +msgstr " « %1 » deve corresponder à seguinte expressão regular : %2" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: The name of a Basic class +#, kde-format +msgctxt "VALIDATECLASS" +msgid " « %1 » must be a Basic object of class : %2" +msgstr " « %1 » deve ser um objeto ou classe Basic : %2" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#. %2: The value of the argument as a string +#, kde-format +msgctxt "VALIDATEACTUAL" +msgid "The actual value of « %1 » is : '%2'" +msgstr "O valor atual de « %1 » é : '%2'" + +#. SF_Utils._Validate error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEMISSING" +msgid "The « %1 » argument is mandatory, yet it is missing." +msgstr "O argumento « %1 » é obrigatório, porém está ausente." + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEARRAY" +msgid " « %1 » must be an array." +msgstr " « %1 » deve ser um array." + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. %2: Number of dimensions of the array +#, kde-format +msgctxt "VALIDATEDIMS" +msgid " « %1 » must have exactly %2 dimension(s)." +msgstr " « %1 » deve ter exatamente %2 dimensão(ões)." + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. %2: Either one single type or 'String, Date, Numeric' +#, kde-format +msgctxt "VALIDATEALLTYPES" +msgid " « %1 » must have all elements of the same type : %2" +msgstr " « %1 » deve ter todos os elementos de um mesmo tipo : %2" + +#. SF_Utils._ValidateArray error message +#. %1: Wrong argument name +#. NULL and EMPTY should not be translated +#, kde-format +msgctxt "VALIDATENOTNULL" +msgid " « %1 » must not contain any NULL or EMPTY elements." +msgstr " « %1 » não pode conter nenhum elemento NULL ou EMPTY." + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. 'String' should not be translated +#, kde-format +msgctxt "VALIDATEFILE" +msgid " « %1 » must be of type String." +msgstr " « %1 » deve ser to tipo String." + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEFILESYS" +msgid "" +" « %1 » must be a valid file or folder name expressed in the " +"operating system native notation." +msgstr "" +" « %1 » deve ser um nome válido de arquivo ou pasta expresso usando a " +"notação do sistema operacional." + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. 'URL' should not be translated +#, kde-format +msgctxt "VALIDATEFILEURL" +msgid "" +" « %1 » must be a valid file or folder name expressed in the portable " +"URL notation." +msgstr "" +" « %1 » deve ser um nome válido de arquivo ou pasta expresso usando a " +"notação portável URL." + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#, kde-format +msgctxt "VALIDATEFILEANY" +msgid " « %1 » must be a valid file or folder name." +msgstr " « %1 » deve ser um nome válido de arquivo ou pasta." + +#. SF_Utils._ValidateFile error message +#. %1: Wrong argument name +#. '(?, *)' is to be left as is +#, kde-format +msgctxt "VALIDATEWILDCARD" +msgid "" +" « %1 » may contain one or more wildcard characters (?, *) in its " +"last path component only." +msgstr "" +" « %1 » deve conter um ou mais caracteres coringa (?,*) apenas no " +"último componente do caminho." + +#. SF_Array.RangeInit error message +#. %1, %2, %3: Numeric values +#. 'From', 'UpTo', 'ByStep' should not be translated +#, kde-format +msgctxt "ARRAYSEQUENCE" +msgid "" +"The respective values of 'From', 'UpTo' and 'ByStep' are incoherent.\n" +"\n" +" « From » = %1\n" +" « UpTo » = %2\n" +" « ByStep » = %3" +msgstr "" +"Os valores informados para 'From', 'UpTo' e 'ByStep' são incoerentes.\n" +"\n" +" « From » = %1\n" +" « UpTo » = %2\n" +" « ByStep » = %3" + +#. SF_Array.AppendColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_2D' should not be translated +#, kde-format +msgctxt "ARRAYINSERT" +msgid "" +"The array and the vector to insert have incompatible sizes.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" +msgstr "" +"O array e vetor a serem inseridos têm tamanhos incompatíveis.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" + +#. SF_Array.ExtractColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_2D' should not be translated +#, kde-format +msgctxt "ARRAYINDEX1" +msgid "" +"The given index does not fit within the bounds of the array.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" +msgstr "" +"O índice fornecido não cabe nos limites do array.\n" +"\n" +" « Array_2D » = %2\n" +" « %1 » = %3" + +#. SF_Array.ExtractColumn (...) error message +#. %1: 'Column' or 'Row' of a matrix +#. %2, %3: array contents +#. 'Array_1D', 'From' and 'UpTo' should not be translated +#, kde-format +msgctxt "ARRAYINDEX2" +msgid "" +"The given slice limits do not fit within the bounds of the array.\n" +"\n" +" « Array_1D » = %1\n" +" « From » = %2\n" +" « UpTo » = %3" +msgstr "" +"Os limites fornecidos para o intervalo não cabem nos limites do array.\n" +"\n" +" « Array_1D » = %1\n" +" « From » = %2\n" +" « UpTo » = %3" + +#. SF_Array.ImportFromCSVFile error message +#. %1: a file name +#. %2: numeric +#. %3: a long string +#, kde-format +msgctxt "CSVPARSING" +msgid "" +"The given file could not be parsed as a valid CSV file.\n" +"\n" +" « File name » = %1\n" +" Line number = %2\n" +" Content = %3" +msgstr "" +"O arquivo fornecido não pode ser processada como um arquivo CSV válido.\n" +"\n" +" « Arquivo » = %1\n" +" Número da linha = %2\n" +" Conteúdo = %3" + +#. SF_Dictionary Add/ReplaceKey error message +#. %1: An identifier%2: a (potentially long) string +#, kde-format +msgctxt "DUPLICATEKEY" +msgid "" +"The insertion of a new key into a dictionary failed because the key already " +"exists.\n" +"Note that the comparison between keys is NOT case-sensitive.\n" +"\n" +"« %1 » = %2" +msgstr "" +"A inserção de uma nova chave ao dicionário falhou porque a chave já existe.\n" +"Note que comparações entre chaves não são sensíveis à caixa.\n" +"\n" +"« %1 » = %2" + +#. SF_Dictionary Remove/ReplaceKey/ReplaceItem error message +#. %1: An identifier%2: a (potentially long) string +#, kde-format +msgctxt "UNKNOWNKEY" +msgid "" +"The requested key does not exist in the dictionary.\n" +"\n" +"« %1 » = %2" +msgstr "" +"A chave requerida não existe no dicionário.\n" +"\n" +"« %1 » = %2" + +#. SF_Dictionary Add/ReplaceKey error message +#. +msgctxt "INVALIDKEY" +msgid "" +"The insertion or the update of an entry into a dictionary failed because the " +"given key contains only spaces." +msgstr "" +"A inserção ou atualização de uma entrada em um dicionário falhou porque a " +"chave fornecido contém apenas espaços." + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "UNKNOWNFILE" +msgid "" +"The given file could not be found on your system.\n" +"\n" +"« %1 » = %2" +msgstr "" +"O arquivo fornecido não foi encontrado em seu sistema.\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A folder name +#, kde-format +msgctxt "UNKNOWNFOLDER" +msgid "" +"The given folder could not be found on your system.\n" +"\n" +"« %1 » = %2" +msgstr "" +"O diretório fornecido não foi encontrado em seu sistema.\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "NOTAFILE" +msgid "" +"« %1 » contains the name of an existing folder, not that of a file.\n" +"\n" +"« %1 » = %2" +msgstr "" +"« %1 » contém o nome de um diretório existente em vez de conter o nome de um " +"arquivo.\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A folder name +#, kde-format +msgctxt "NOTAFOLDER" +msgid "" +"« %1 » contains the name of an existing file, not that of a folder.\n" +"\n" +"« %1 » = %2" +msgstr "" +"« %1 » contém o nome de um arquivo existente em vez de conter o nome de um " +"diretório.\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem copy/move/... error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "OVERWRITE" +msgid "" +"You tried to create a new file which already exists. Overwriting it has been " +"rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" +"Você tentou criar um novo arquivo que já existe. Sobrescrever o arquivo não " +"foi permitido\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "READONLY" +msgid "" +"Copying or moving a file to a destination which has its read-only attribute " +"set, or deleting such a file or folder is forbidden.\n" +"\n" +"« %1 » = %2" +msgstr "" +"Copiar ou mover um arquivo para um destino que tem o atributo somente-" +"leitura definido, bem como apagar tais arquivos ou pastas, não é permitido.\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem copy/move/delete error message +#. %1: An identifier +#. %2: A file or folder name with wildcards +#, kde-format +msgctxt "NOFILEMATCH" +msgid "" +"When « %1 » contains wildcards. at least one file or folder must match the " +"given filter. Otherwise the operation is rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" +"Quando « %1 » contiver caracteres coringa, ao menos um arquivo ou pasta deve " +"corresponder ao filtro especificado. Caso contrário, a operação será " +"rejeitada.\n" +"\n" +"« %1 » = %2" + +#. SF_FileSystem CreateFolder error message +#. %1: An identifier +#. %2: A file or folder name +#, kde-format +msgctxt "FOLDERCREATION" +msgid "" +"« %1 » contains the name of an existing file or an existing folder. The " +"operation is rejected.\n" +"\n" +"« %1 » = %2" +msgstr "" +"« %1 » contém o nome de um arquivo ou pasta existente. A operação foi " +"rejeitada.\n" +"\n" +"« %1 » = %2" + +#. SF_Services.CreateScriptService error message +#. %1: An identifier +#. %2: A string +#. %3: A Basic library name +#. %4: A service (1 word) name +#, kde-format +msgctxt "UNKNOWNSERVICE" +msgid "" +"No service named '%4' has been registered for the library '%3'.\n" +"\n" +"« %1 » = %2" +msgstr "" +"Nenhum serviço com o nome '%4' foi registrado na biblioteca '%3'.\n" +"\n" +"« %1 » = %2" + +#. SF_Services.CreateScriptService error message +#. %1: An identifier +#. %2: A string +#. %3: A Basic library name +#, kde-format +msgctxt "SERVICESNOTLOADED" +msgid "" +"The library '%3' and its services could not been loaded.\n" +"The reason is unknown.\n" +"However, checking the '%3.SF_Services.RegisterScriptServices()' function and " +"its return value can be a good starting point.\n" +"\n" +"« %1 » = %2" +msgstr "" +"A biblioteca '%3' e seus serviços não puderam ser carregados.\n" +"A razão é desconhecida.\n" +"Contudo, verificar a função '%3.SF_Services.RegisterScriptServices()' e seu " +"valor de retorno pode ser um bom ponto de partida.\n" +"\n" +"« %1 » = %2" + +#. SF_Session.ExecuteCalcFunction error message +#. 'Calc' should not be translated +#, kde-format +msgctxt "CALCFUNC" +msgid "" +"The Calc '%1' function encountered an error. Either the given function does " +"not exist or its arguments are invalid." +msgstr "" +"A função Calc '%1' encontrou um erro. Ou a função dada não existe ou seus " +"argumentos são inválidos." + +#. SF_Session._GetScript error message +#. %1: 'Basic' or 'Python' +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#. %5: A string +#, kde-format +msgctxt "NOSCRIPT" +msgid "" +"The requested %1 script could not be located in the given libraries and " +"modules.\n" +"« %2 » = %3\n" +"« %4 » = %5" +msgstr "" +"O script %1 não pode ser localizado nas bibliotecas e módulos " +"especificados.\n" +"« %2 » = %3\n" +"« %4 » = %5" + +#. SF_Session.ExecuteBasicScript error message +#. %1: An identifier +#. %2: A string +#. %3: A (long) string +#, kde-format +msgctxt "SCRIPTEXEC" +msgid "" +"An exception occurred during the execution of the Basic script.\n" +"Cause: %3\n" +"« %1 » = %2" +msgstr "" +"Uma exceção ocorreu durante a execução do script Basic.\n" +"Cause: %3\n" +"« %1 » = %2" + +#. SF_Session.SendMail error message +#. %1 = a mail address +#, kde-format +msgctxt "WRONGEMAIL" +msgid "" +"One of the email addresses has been found invalid.\n" +"Invalid mail = « %1 »" +msgstr "" +"Um dos endereços de e-mail foram considerados inválidos.\n" +"E-mail inválido = « %1 »" + +#. SF_Session.SendMail error message +msgctxt "SENDMAIL" +msgid "" +"The message could not be sent due to a system error.\n" +"A possible cause is that LibreOffice could not find any mail client." +msgstr "" +"Esta mensagem não pode ser enviada devido a um erro de sistema.\n" +"Uma possível causa é que o LibreOffice não pode encontrar um cliente de e-" +"mail." + +#. SF_TextStream._IsFileOpen error message +#. %1: A file name +#, kde-format +msgctxt "FILENOTOPEN" +msgid "" +"The requested file operation could not be executed because the file was " +"closed previously.\n" +"\n" +"File name = '%1'" +msgstr "" +"A operação de arquivo não pode ser executada porque o arquivo foi fechado " +"previamente.\n" +"\n" +"Nome do arquivo = '%1'" + +#. SF_TextStream._IsFileOpen error message +#. %1: A file name +#. %2: READ, WRITE or APPEND +#, kde-format +msgctxt "FILEOPENMODE" +msgid "" +"The requested file operation could not be executed because it is " +"incompatible with the mode in which the file was opened.\n" +"\n" +"File name = '%1'\n" +"Open mode = %2" +msgstr "" +"A operação de arquivo não pode ser executada porque é incompatível com o " +"modo de abertura do arquivo.\n" +"\n" +"Nome do arquivo = '%1'\n" +"Modo de abertura = %2" + +#. SF_TextStream.ReadLine/ReadAll/SkipLine error message +#. %1: A file name +#, kde-format +msgctxt "ENDOFFILE" +msgid "" +"The requested file read operation could not be completed because an " +"unexpected end-of-file was encountered.\n" +"\n" +"File name = '%1'" +msgstr "" +"A operação de leitura de arquivo não pode ser completada porque um fim-de-" +"arquivo inesperado foi encontrado.\n" +"\n" +"Nome do arquivo = '%1'" + +#. SF_UI.GetDocument error message +#. %1: An identifier +#. %2: A string +#, kde-format +msgctxt "DOCUMENT" +msgid "" +"The requested document could not be found.\n" +"\n" +"%1 = '%2'" +msgstr "" +"O documento desejado não pode ser encontrado.\n" +"\n" +"%1 = '%2'" + +#. SF_UI.GetDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#, kde-format +msgctxt "DOCUMENTCREATION" +msgid "" +"The creation of a new document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the document type is unknown, or no template file was given,\n" +"or the given template file was not found on your system.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" +msgstr "" +"A criação de um novo documento falhou.\n" +"Deve haver algo de errado com algum dos argumentos.\n" +"\n" +"Ou o tipo do documento é desconhecido, ou nenhum arquivo de template foi " +"especificado,\n" +"ou o arquivo do template especificado não foi encontrado no sistema.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" + +#. SF_UI.OpenDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#. %5: An identifier +#. %6: A string +#, kde-format +msgctxt "DOCUMENTOPEN" +msgid "" +"The opening of the document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the file does not exist, or the password is wrong, or the given " +"filter is invalid.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'\n" +"%5 = '%6'" +msgstr "" +"A abertura do documento falhou.\n" +"Deve haver algo de errado com um ou mais argumentos.\n" +"\n" +"Ou o arquivo não existe, ou a senha está incorreta, ou o filtro especificado " +"é inválido.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'\n" +"%5 = '%6'" + +#. SF_UI.OpenDocument error message +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A string +#, kde-format +msgctxt "BASEDOCUMENTOPEN" +msgid "" +"The opening of the Base document failed.\n" +"Something must be wrong with some arguments.\n" +"\n" +"Either the file does not exist, or the file is not registered under the " +"given name.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" +msgstr "" +"A abertura do documento Base falhou.\n" +"Deve haver algo de errado em algum dos argumentos.\n" +"\n" +"Ou o arquivo não existe, ou o arquivo não está registrado com o nome " +"informado.\n" +"\n" +"%1 = '%2'\n" +"%3 = '%4'" + +#. SF_Document._IsStillAlive error message +#. %1: A file name +#, kde-format +msgctxt "DOCUMENTDEAD" +msgid "" +"The requested action could not be executed because the document was closed " +"inadvertently.\n" +"\n" +"The concerned document is '%1'" +msgstr "" +"A ação desejada não pode ser executada porque o documento foi fechado " +"inesperadamente.\n" +"\n" +"O documento que gerou o erro foi '%1'" + +#. SF_Document.SaveAs error message +#. %1: An identifier +#. %2: A file name +#. +#, kde-format +msgctxt "DOCUMENTSAVE" +msgid "" +"The document could not be saved.\n" +"Either the document has been opened read-only, or the destination file has a " +"read-only attribute set, or the file where to save to is undefined.\n" +"\n" +"%1 = '%2'" +msgstr "" +"O documento não pode ser salvo.\n" +"Ou o documento foi aberto como somente-leitura, ou o arquivo de destino é " +"somente leitura, ou o arquivo onde o documento será salvo é indefinido.\n" +"\n" +"%1 = '%2'" + +#. SF_Document.SaveAs error message +#. %1: An identifier +#. %2: A file name +#. %3: An identifier +#. %4: True or False +#. %5: An identifier +#. %6: A string +#, kde-format +msgctxt "DOCUMENTSAVEAS" +msgid "" +"The document could not be saved.\n" +"Either the document must not be overwritten, or the destination file has a " +"read-only attribute set, or the given filter is invalid.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4\n" +"%5 = '%6'" +msgstr "" +"O documento não pode ser salvo.\n" +"Ou o documento não pode ser sobrescrito, ou o arquivo de destino é somente " +"leitura, ou o filtro especificado é inválido.\n" +"\n" +"%1 = '%2'\n" +"%3 = %4\n" +"%5 = '%6'" + +#. SF_Document any update +#. %1: An identifier +#. %2: A file name +#, kde-format +msgctxt "DOCUMENTREADONLY" +msgid "" +"You tried to edit a document which is not modifiable. The document has not " +"been changed.\n" +"\n" +"« %1 » = %2" +msgstr "" +"Você tentou editar um documento que não é modificável. O documento não foi " +"alterado.\n" +"\n" +"« %1 » = %2" + +#. SF_Base GetDatabase +#. %1: An identifier +#. %2: A user name +#. %3: An identifier +#. %4: A password +#. %5: A file name +#, kde-format +msgctxt "DBCONNECT" +msgid "" +"The database related to the actual Base document could not be retrieved.\n" +"Check the connection/login parameters.\n" +"\n" +"« %1 » = '%2'\n" +"« %3 » = '%4'\n" +"« Document » = %5" +msgstr "" +"O banco de dados associado ao documento Base atual não pode ser recuperado.\n" +"Verifique os parâmetros de conexão e login.\n" +"\n" +"« %1 » = '%2'\n" +"« %3 » = '%4'\n" +"« Documento » = %5" + +#. SF_Calc _ParseAddress (sheet) +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "CALCADDRESS1" +msgid "" +"The given address does not correspond with a valid sheet name.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" +"O endereço fornecido não corresponde a um nome de planilha válido.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" + +#. SF_Calc _ParseAddress (range) +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "CALCADDRESS2" +msgid "" +"The given address does not correspond with a valid range of cells.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" +"O endereço fornecido não corresponde a um intervalo de células válido.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" + +#. SF_Calc InsertSheet +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#, kde-format +msgctxt "DUPLICATESHEET" +msgid "" +"There exists already in the document a sheet with the same name.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" +msgstr "" +"Já existe no documento uma planilha com o mesmo nome.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4" + +#. SF_Calc Offset +#. %1: An identifier +#. %2: A Calc reference +#. %3: An identifier +#. %4: A number +#. %5: An identifier +#. %6: A number +#. %7: An identifier +#. %8: A number +#. %9: An identifier +#. %10: A number +#. %11: An identifier +#. %12: A file name +#, kde-format +msgctxt "OFFSETADDRESS" +msgid "" +"The computed range falls beyond the sheet boundaries or is meaningless.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8\n" +"« %9 » = %10\n" +"« %11 » = %12" +msgstr "" +"O intervalo computado vai além dos limites da planilha ou não tem sentido.\n" +"\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8\n" +"« %9 » = %10\n" +"« %11 » = %12" + +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier%2: A file name +#, kde-format +msgctxt "FORMDEAD" +msgid "" +"The requested action could not be executed because the form is not open or " +"the document was closed inadvertently.\n" +"\n" +"The concerned form is '%1' in document '%2'." +msgstr "" +"A ação desejada não pode ser executada porque o formulário não está aberto " +"ou o documento foi fechado inesperadamente.\n" +"\n" +"O formulário em questão é '%1' no documento '%2'." + +#. SF_Form determination +#. %1: A number +#. %2: A sheet name +#. %3: A file name +#, kde-format +msgctxt "CALCFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Calc sheet. The given index is " +"off-limits.\n" +"\n" +"The concerned Calc document is '%3'.\n" +"\n" +"The name of the sheet = '%2'\n" +"The index = %1." +msgstr "" +"O formulário desejado não pode ser encontrada na planilha Calc. O índice " +"dado está além dos limites.\n" +"\n" +"O documento Calc em questão é '%3'.\n" +"\n" +"Nome da planilha = '%2'\n" +"Índice da planilha = %1." + +#. SF_Form determination +#. %1: A number +#. %2: A file name +#, kde-format +msgctxt "WRITERFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Writer document. The given " +"index is off-limits.\n" +"\n" +"The concerned Writer document is '%2'.\n" +"\n" +"The index = %1." +msgstr "" +"O formulário desejado não pode ser encontrado no documento Writer. O índice " +"informado está além dos limites.\n" +"\n" +"O document Writer em questão é '%2'.\n" +"\n" +"Índice do formulário = %1." + +#. SF_Form determination +#. %1: A number +#. %2: A string +#. %3: A file name +#, kde-format +msgctxt "BASEFORMNOTFOUND" +msgid "" +"The requested form could not be found in the form document '%2'. The given " +"index is off-limits.\n" +"\n" +"The concerned Base document is '%3'.\n" +"\n" +"The index = %1." +msgstr "" +"O formulário desejado não pode ser encontrado no documento de formulário " +"'%2'. O índice informado está além dos limites.\n" +"\n" +"O documento Base em questão é '%3'.\n" +"\n" +"Índice do formulário = %1." + +#. SF_Form determination +#. %1: A form name +#. %2: A form name +#, kde-format +msgctxt "SUBFORMNOTFOUND" +msgid "" +"The requested subform could not be found below the given main form.\n" +"\n" +"The main form = '%2'.\n" +"The subform = '%1'." +msgstr "" +"O sub-formulário desejado não pode ser encontrado como parte do formulário " +"principal.\n" +"\n" +"Formulário principal = '%2'.\n" +"Sub-formulário = '%1'." + +#. SF_FormControl property setting +#. %1: An identifier +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#, kde-format +msgctxt "FORMCONTROLTYPE" +msgid "" +"The control '%1' in form '%2' is of type '%3'.\n" +"The property or method '%4' is not applicable on that type of form controls." +msgstr "" +"O controle '%1' no formulário '%2' é do tipo '%3'.\n" +"A propriedade ou método '%4' não é aplicável a este tipo de controle de " +"formulário." + +#. SF_Dialog creation +#. %1: An identifier +#. %2: A string +#. %3: An identifier +#. %4: A file name +#. %5: An identifier +#. %6: A string +#. %7: An identifier +#. %8: A string +#, kde-format +msgctxt "DIALOGNOTFOUND" +msgid "" +"The requested dialog could not be located in the given container or " +"library.\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8" +msgstr "" +"O diálogo desejado não pode ser localizado no container ou biblioteca " +"informado.\n" +"« %1 » = %2\n" +"« %3 » = %4\n" +"« %5 » = %6\n" +"« %7 » = %8" + +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier +#, kde-format +msgctxt "DIALOGDEAD" +msgid "" +"The requested action could not be executed because the dialog was closed " +"inadvertently.\n" +"\n" +"The concerned dialog is '%1'." +msgstr "" +"A ação desejada não pode ser executada porque o diálogo foi fechado " +"inesperadamente.\n" +"\n" +"O diálogo em questão é '%1'." + +#. SF_DialogControl property setting +#. %1: An identifier +#. %2: An identifier +#. %3: A string +#. %4: An identifier +#, kde-format +msgctxt "CONTROLTYPE" +msgid "" +"The control '%1' in dialog '%2' is of type '%3'.\n" +"The property or method '%4' is not applicable on that type of dialog " +"controls." +msgstr "" +"O controle '%1' no diálogo '%2' é do tipo '%3'.\n" +"A propriedade ou método '%4' não é aplicável a este tipo de controle de " +"diálogo." + +#. SF_DialogControl add line in textbox +#. %1: An identifier +#. %2: An identifier +#, kde-format +msgctxt "TEXTFIELD" +msgid "" +"The control '%1' in dialog '%2' is not a multiline text field.\n" +"The requested method could not be executed." +msgstr "" +"O controle '%1' no diálogo '%2' não é uma caixa de edição de textos de " +"múltiplas linhas.\n" +"O método desejado não pode ser executado." + +#. SF_Database when running update SQL statement +#. %1: The concerned method +#, kde-format +msgctxt "DBREADONLY" +msgid "" +"The database has been opened in read-only mode.\n" +"The '%1' method must not be executed in this context." +msgstr "" +"O banco de dados foi aberto no modo somente-leitura.\n" +"O método '%1' não pode ser executado neste contexto." + +#. SF_Database can't interpret SQL statement +#. %1: The statement +#, kde-format +msgctxt "SQLSYNTAX" +msgid "" +"An SQL statement could not be interpreted or executed by the database " +"system.\n" +"Check its syntax, table and/or field names, ...\n" +"\n" +"SQL Statement : « %1 »" +msgstr "" +"Uma instrução SQL não pode ser interpretada ou executada pelo sistema de " +"banco de dados.\n" +"Verifique sua sintaxe, nomes de tabelas, campos, etc...\n" +"\n" +"Instrução SQL : « %1 »" + +#. SF_Exception.PythonShell error messageAPSO: to leave unchanged +msgctxt "PYTHONSHELL" +msgid "" +"The APSO extension could not be located in your LibreOffice installation." +msgstr "" +"A extensão APSO não pode ser localizada sem sua instalação do LibreOffice." diff --git a/wizards/source/scriptforge/python/ScriptForgeHelper.py b/wizards/source/scriptforge/python/ScriptForgeHelper.py new file mode 100644 index 000000000..396273233 --- /dev/null +++ b/wizards/source/scriptforge/python/ScriptForgeHelper.py @@ -0,0 +1,317 @@ +# -*- coding: utf-8 -*- + +# Copyright 2019-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE + +# ====================================================================================================================== +# === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +# === Full documentation is available on https://help.libreoffice.org/ === +# ====================================================================================================================== + +# ScriptForge is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +# ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option): + +# 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not +# distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ . + +# 2) The GNU Lesser General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. If a copy of the LGPL was not +# distributed with this file, see http://www.gnu.org/licenses/ . + +""" +Collection of Python helper functions called from the ScriptForge Basic libraries +to execute specific services that are not or not easily available from Basic directly. +""" + +import getpass +import os +import platform +import hashlib +import filecmp +import webbrowser +import json + + +class _Singleton(type): + """ + A Singleton design pattern + Credits: « Python in a Nutshell » by Alex Martelli, O'Reilly + """ + instances = {} + + def __call__(cls, *args, **kwargs): + if cls not in cls.instances: + cls.instances[cls] = super(_Singleton, cls).__call__(*args, **kwargs) + return cls.instances[cls] + + +# ################################################################# +# Dictionary service +# ################################################################# + +def _SF_Dictionary__ConvertToJson(propval, indent = None) -> str: + # used by Dictionary.ConvertToJson() Basic method + """ + Given an array of PropertyValues as argument, convert it to a JSON string + """ + # Array of property values => Dict(ionary) => JSON + pvDict = {} + for pv in propval: + pvDict[pv.Name] = pv.Value + return json.dumps(pvDict, indent=indent, skipkeys=True) + + +def _SF_Dictionary__ImportFromJson(jsonstr: str): # used by Dictionary.ImportFromJson() Basic method + """ + Given a JSON string as argument, convert it to a list of tuples (name, value) + The value must not be a (sub)dict. This doesn't pass the python-basic bridge. + """ + # JSON => Dictionary => Array of tuples/lists + dico = json.loads(jsonstr) + result = [] + for key in iter(dico): + value = dico[key] + item = value + if isinstance(value, dict): # check that first level is not itself a (sub)dict + item = None + elif isinstance(value, list): # check every member of the list is not a (sub)dict + for i in range(len(value)): + if isinstance(value[i], dict): value[i] = None + result.append((key, item)) + return result + + +# ################################################################# +# Exception service +# ################################################################# + +def _SF_Exception__PythonPrint(string: str) -> bool: + # used by SF_Exception.PythonPrint() Basic method + """ + Write the argument to stdout. + If the APSO shell console is active, the argument will be displayed in the console window + """ + print(string) + return True + + +# ################################################################# +# FileSystem service +# ################################################################# + +def _SF_FileSystem__CompareFiles(filename1: str, filename2: str, comparecontents=True) -> bool: + # used by SF_FileSystem.CompareFiles() Basic method + """ + Compare the 2 files, returning True if they seem equal, False otherwise. + By default, only their signatures (modification time, ...) are compared. + When comparecontents == True, their contents are compared. + """ + try: + return filecmp.cmp(filename1, filename2, not comparecontents) + except Exception: + return False + + +def _SF_FileSystem__GetFilelen(systemfilepath: str) -> str: # used by SF_FileSystem.GetFilelen() Basic method + return str(os.path.getsize(systemfilepath)) + + +def _SF_FileSystem__HashFile(filename: str, algorithm: str) -> str: # used by SF_FileSystem.HashFile() Basic method + """ + Hash a given file with the given hashing algorithm + cfr. https://www.pythoncentral.io/hashing-files-with-python/ + Example + hash = _SF_FileSystem__HashFile('myfile.txt','MD5') + """ + algo = algorithm.lower() + try: + if algo in hashlib.algorithms_guaranteed: + BLOCKSIZE = 65535 # Provision for large size files + if algo == 'md5': + hasher = hashlib.md5() + elif algo == 'sha1': + hasher = hashlib.sha1() + elif algo == 'sha224': + hasher = hashlib.sha224() + elif algo == 'sha256': + hasher = hashlib.sha256() + elif algo == 'sha384': + hasher = hashlib.sha384() + elif algo == 'sha512': + hasher = hashlib.sha512() + else: + return '' + with open(filename, 'rb') as file: # open in binary mode + buffer = file.read(BLOCKSIZE) + while len(buffer) > 0: + hasher.update(buffer) + buffer = file.read(BLOCKSIZE) + return hasher.hexdigest() + else: + return '' + except Exception: + return '' + + +# ################################################################# +# Platform service +# ################################################################# + +def _SF_Platform(propertyname: str): # used by SF_Platform Basic module + """ + Switch between SF_Platform properties (read the documentation about the ScriptForge.Platform service) + """ + pf = Platform() + if propertyname == 'Architecture': + return pf.Architecture + elif propertyname == 'ComputerName': + return pf.ComputerName + elif propertyname == 'CPUCount': + return pf.CPUCount + elif propertyname == 'CurrentUser': + return pf.CurrentUser + elif propertyname == 'Machine': + return pf.Machine + elif propertyname == 'OSName': + return pf.OSName + elif propertyname == 'OSPlatform': + return pf.OSPlatform + elif propertyname == 'OSRelease': + return pf.OSRelease + elif propertyname == 'OSVersion': + return pf.OSVersion + elif propertyname == 'Processor': + return pf.Processor + elif propertyname == 'PythonVersion': + return pf.PythonVersion + else: + return None + + +class Platform(object, metaclass = _Singleton): + @property + def Architecture(self): return platform.architecture()[0] + + @property # computer's network name + def ComputerName(self): return platform.node() + + @property # number of CPU's + def CPUCount(self): return os.cpu_count() + + @property + def CurrentUser(self): + try: + return getpass.getuser() + except Exception: + return '' + + @property # machine type e.g. 'i386' + def Machine(self): return platform.machine() + + @property # system/OS name e.g. 'Darwin', 'Java', 'Linux', ... + def OSName(self): return platform.system().replace('Darwin', 'macOS') + + @property # underlying platform e.g. 'Windows-10-...' + def OSPlatform(self): return platform.platform(aliased = True) + + @property # system's release e.g. '2.2.0' + def OSRelease(self): return platform.release() + + @property # system's version + def OSVersion(self): return platform.version() + + @property # real processor name e.g. 'amdk' + def Processor(self): return platform.processor() + + @property # Python major.minor.patchlevel + def PythonVersion(self): return 'Python ' + platform.python_version() + + +# ################################################################# +# Session service +# ################################################################# + +def _SF_Session__OpenURLInBrowser(url: str): # Used by SF_Session.OpenURLInBrowser() Basic method + """ + Display url using the default browser + """ + try: + webbrowser.open(url, new = 2) + finally: + return None + + +# ################################################################# +# String service +# ################################################################# + +def _SF_String__HashStr(string: str, algorithm: str) -> str: # used by SF_String.HashStr() Basic method + """ + Hash a given UTF-8 string with the given hashing algorithm + Example + hash = _SF_String__HashStr('This is a UTF-8 encoded string.','MD5') + """ + algo = algorithm.lower() + try: + if algo in hashlib.algorithms_guaranteed: + ENCODING = 'utf-8' + bytestring = string.encode(ENCODING) # Hashing functions expect bytes, not strings + if algo == 'md5': + hasher = hashlib.md5(bytestring) + elif algo == 'sha1': + hasher = hashlib.sha1(bytestring) + elif algo == 'sha224': + hasher = hashlib.sha224(bytestring) + elif algo == 'sha256': + hasher = hashlib.sha256(bytestring) + elif algo == 'sha384': + hasher = hashlib.sha384(bytestring) + elif algo == 'sha512': + hasher = hashlib.sha512(bytestring) + else: + return '' + return hasher.hexdigest() + else: + return '' + except Exception: + return '' + + +# ################################################################# +# lists the scripts, that shall be visible inside the Basic/Python IDE +# ################################################################# + +g_exportedScripts = () + +if __name__ == "__main__": + print(_SF_Platform('Architecture')) + print(_SF_Platform('ComputerName')) + print(_SF_Platform('CPUCount')) + print(_SF_Platform('CurrentUser')) + print(_SF_Platform('Machine')) + print(_SF_Platform('OSName')) + print(_SF_Platform('OSPlatform')) + print(_SF_Platform('OSRelease')) + print(_SF_Platform('OSVersion')) + print(_SF_Platform('Processor')) + print(_SF_Platform('PythonVersion')) + # + print(hashlib.algorithms_guaranteed) + print(_SF_FileSystem__HashFile('/opt/libreoffice6.4/program/libbootstraplo.so', 'md5')) + print(_SF_FileSystem__HashFile('/opt/libreoffice6.4/share/Scripts/python/Capitalise.py', 'sha512')) + # + print(_SF_String__HashStr('œ∑¡™£¢∞§¶•ªº–≠œ∑´®†¥¨ˆøπ“‘åß∂ƒ©˙∆˚¬', 'MD5')) # 616eb9c513ad07cd02924b4d285b9987 + # + # _SF_Session__OpenURLInBrowser('https://docs.python.org/3/library/webbrowser.html') + # + js = """ + {"firstName": "John","lastName": "Smith","isAlive": true,"age": 27, + "address": {"streetAddress": "21 2nd Street","city": "New York","state": "NY","postalCode": "10021-3100"}, + "phoneNumbers": [{"type": "home","number": "212 555-1234"},{"type": "office","number": "646 555-4567"}], + "children": ["Q", "M", "G", "T"],"spouse": null} + """ + arr = _SF_Dictionary__ImportFromJson(js) + print(arr) diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py new file mode 100644 index 000000000..ebc6f147c --- /dev/null +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -0,0 +1,2539 @@ +# -*- coding: utf-8 -*- + +# Copyright 2020-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE + +# ===================================================================================================================== +# === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +# === Full documentation is available on https://help.libreoffice.org/ === +# ===================================================================================================================== + +# ScriptForge is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +# ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option): + +# 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not +# distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ . + +# 2) The GNU Lesser General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. If a copy of the LGPL was not +# distributed with this file, see http://www.gnu.org/licenses/ . + +""" + ScriptForge libraries are an extensible and robust collection of macro scripting resources for LibreOffice + to be invoked from user Basic or Python macros. Users familiar with other BASIC macro variants often face hard + times to dig into the extensive LibreOffice Application Programming Interface even for the simplest operations. + By collecting most-demanded document operations in a set of easy to use, easy to read routines, users can now + program document macros with much less hassle and get quicker results. + + ScriptForge abundant methods are organized in reusable modules that cleanly isolate Basic/Python programming + language constructs from ODF document content accesses and user interface(UI) features. + + The scriptforge.py module + - implements a protocol between Python (user) scripts and the ScriptForge Basic library + - contains the interfaces (classes and attributes) to be used in Python user scripts + to run the services implemented in the standard libraries shipped with LibreOffice + + Usage: + + When Python and LibreOffice run in the same process (usual case): either + from scriptforge import * # or, better ... + from scriptforge import CreateScriptService + + When Python and LibreOffice are started in separate processes, + LibreOffice being started from console ... (example for Linux with port = 2021) + ./soffice --accept='socket,host=localhost,port=2021;urp;' + then use next statement: + from scriptforge import * # or, better ... + from scriptforge import CreateScriptService, ScriptForge + ScriptForge(hostname = 'localhost', port = 2021) + + Specific documentation about the use of ScriptForge from Python scripts: + https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_intro.html?DbPAR=BASIC + """ + +import uno + +import datetime +import time +import os + + +class _Singleton(type): + """ + A Singleton metaclass design pattern + Credits: « Python in a Nutshell » by Alex Martelli, O'Reilly + """ + instances = {} + + def __call__(cls, *args, **kwargs): + if cls not in cls.instances: + cls.instances[cls] = super(_Singleton, cls).__call__(*args, **kwargs) + return cls.instances[cls] + + +# ##################################################################################################################### +# ScriptForge CLASS ### +# ##################################################################################################################### + +class ScriptForge(object, metaclass = _Singleton): + """ + The ScriptForge (singleton) class encapsulates the core of the ScriptForge run-time + - Bridge with the LibreOffice process + - Implementation of the inter-language protocol with the Basic libraries + - Identification of the available services interfaces + - Dispatching of services + - Coexistence with UNO + + It embeds the Service class that manages the protocol with Basic + """ + + # ######################################################################### + # Class attributes + # ######################################################################### + hostname = '' + port = 0 + componentcontext = None + scriptprovider = None + SCRIPTFORGEINITDONE = False + + # ######################################################################### + # Class constants + # ######################################################################### + library = 'ScriptForge' + Version = '7.4' # Actual version number + # + # Basic dispatcher for Python scripts + basicdispatcher = '@application#ScriptForge.SF_PythonHelper._PythonDispatcher' + # Python helper functions module + pythonhelpermodule = 'ScriptForgeHelper.py' + # + # VarType() constants + V_EMPTY, V_NULL, V_INTEGER, V_LONG, V_SINGLE, V_DOUBLE = 0, 1, 2, 3, 4, 5 + V_CURRENCY, V_DATE, V_STRING, V_OBJECT, V_BOOLEAN = 6, 7, 8, 9, 11 + V_VARIANT, V_ARRAY, V_ERROR, V_UNO = 12, 8192, -1, 16 + # Object types + objMODULE, objCLASS, objUNO = 1, 2, 3 + # Special argument symbols + cstSymEmpty, cstSymNull, cstSymMissing = '+++EMPTY+++', '+++NULL+++', '+++MISSING+++' + # Predefined references for services implemented as standard Basic modules + servicesmodules = dict([('ScriptForge.Array', 0), + ('ScriptForge.Exception', 1), + ('ScriptForge.FileSystem', 2), + ('ScriptForge.Platform', 3), + ('ScriptForge.Region', 4), + ('ScriptForge.Services', 5), + ('ScriptForge.Session', 6), + ('ScriptForge.String', 7), + ('ScriptForge.UI', 8)]) + + def __init__(self, hostname = '', port = 0): + """ + Because singleton, constructor is executed only once while Python active + Arguments are mandatory when Python and LibreOffice run in separate processes + :param hostname: probably 'localhost' + :param port: port number + """ + ScriptForge.hostname = hostname + ScriptForge.port = port + # Determine main pyuno entry points + ScriptForge.componentcontext = self.ConnectToLOProcess(hostname, port) # com.sun.star.uno.XComponentContext + ScriptForge.scriptprovider = self.ScriptProvider(self.componentcontext) # ...script.provider.XScriptProvider + # + # Establish a list of the available services as a dictionary (servicename, serviceclass) + ScriptForge.serviceslist = dict((cls.servicename, cls) for cls in SFServices.__subclasses__()) + ScriptForge.servicesdispatcher = None + # + # All properties and methods of the ScriptForge API are ProperCased + # Compute their synonyms as lowercased and camelCased names + ScriptForge.SetAttributeSynonyms() + # + ScriptForge.SCRIPTFORGEINITDONE = True + + @classmethod + def ConnectToLOProcess(cls, hostname = '', port = 0): + """ + Called by the ScriptForge class constructor to establish the connection with + the requested LibreOffice instance + The default arguments are for the usual interactive mode + + :param hostname: probably 'localhost' or '' + :param port: port number or 0 + :return: the derived component context + """ + if len(hostname) > 0 and port > 0: # Explicit connection request via socket + ctx = uno.getComponentContext() # com.sun.star.uno.XComponentContext + resolver = ctx.ServiceManager.createInstanceWithContext( + 'com.sun.star.bridge.UnoUrlResolver', ctx) # com.sun.star.comp.bridge.UnoUrlResolver + try: + conn = 'socket,host=%s,port=%d' % (hostname, port) + url = 'uno:%s;urp;StarOffice.ComponentContext' % conn + ctx = resolver.resolve(url) + except Exception: # thrown when LibreOffice specified instance isn't started + raise SystemExit( + 'Connection to LibreOffice failed (host = ' + hostname + ', port = ' + str(port) + ')') + return ctx + elif len(hostname) == 0 and port == 0: # Usual interactive mode + return uno.getComponentContext() + else: + raise SystemExit('The creation of the ScriptForge() instance got invalid arguments: ' + + '(host = ' + hostname + ', port = ' + str(port) + ')') + + @classmethod + def ScriptProvider(cls, context = None): + """ + Returns the general script provider + """ + servicemanager = context.ServiceManager # com.sun.star.lang.XMultiComponentFactory + masterscript = servicemanager.createInstanceWithContext( + 'com.sun.star.script.provider.MasterScriptProviderFactory', context) + return masterscript.createScriptProvider("") + + @classmethod + def InvokeSimpleScript(cls, script, *args): + """ + Create a UNO object corresponding with the given Python or Basic script + The execution is done with the invoke() method applied on the created object + Implicit scope: Either + "application" a shared library (BASIC) + "share" a library of LibreOffice Macros (PYTHON) + :param script: Either + [@][scope#][library.]module.method - Must not be a class module or method + [@] means that the targeted method accepts ParamArray arguments (Basic only) + [scope#][directory/]module.py$method - Must be a method defined at module level + :return: the value returned by the invoked script, or an error if the script was not found + """ + + # The frequently called PythonDispatcher in the ScriptForge Basic library is cached to privilege performance + if cls.servicesdispatcher is not None and script == ScriptForge.basicdispatcher: + xscript = cls.servicesdispatcher + fullscript = script + paramarray = True + # Build the URI specification described in + # https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification + elif len(script) > 0: + # Check ParamArray arguments + paramarray = False + if script[0] == '@': + script = script[1:] + paramarray = True + scope = '' + if '#' in script: + scope, script = script.split('#') + if '.py$' in script.lower(): # Python + if len(scope) == 0: + scope = 'share' # Default for Python + # Provide an alternate helper script depending on test context + if script.startswith(cls.pythonhelpermodule) and hasattr(cls, 'pythonhelpermodule2'): + script = cls.pythonhelpermodule2 + script[len(cls.pythonhelpermodule):] + if '#' in script: + scope, script = script.split('#') + uri = 'vnd.sun.star.script:{0}?language=Python&location={1}'.format(script, scope) + else: # Basic + if len(scope) == 0: + scope = 'application' # Default for Basic + lib = '' + if len(script.split('.')) < 3: + lib = cls.library + '.' # Default library = ScriptForge + uri = 'vnd.sun.star.script:{0}{1}?language=Basic&location={2}'.format(lib, script, scope) + # Get the script object + fullscript = ('@' if paramarray else '') + scope + ':' + script + try: + xscript = cls.scriptprovider.getScript(uri) + except Exception: + raise RuntimeError( + 'The script \'{0}\' could not be located in your LibreOffice installation'.format(script)) + else: # Should not happen + return None + + # At 1st execution of the common Basic dispatcher, buffer xscript + if fullscript == ScriptForge.basicdispatcher and cls.servicesdispatcher is None: + cls.servicesdispatcher = xscript + + # Execute the script with the given arguments + # Packaging for script provider depends on presence of ParamArray arguments in the called Basic script + if paramarray: + scriptreturn = xscript.invoke(args[0], (), ()) + else: + scriptreturn = xscript.invoke(args, (), ()) + + # + return scriptreturn[0] # Updatable arguments passed by reference are ignored + + @classmethod + def InvokeBasicService(cls, basicobject, flags, method, *args): + """ + Execute a given Basic script and interpret its result + This method has as counterpart the ScriptForge.SF_PythonHelper._PythonDispatcher() Basic method + :param basicobject: a Service subclass + :param flags: see the vb* and flg* constants in the SFServices class + :param method: the name of the method or property to invoke, as a string + :param args: the arguments of the method. Symbolic cst* constants may be necessary + :return: The invoked Basic counterpart script (with InvokeSimpleScript()) will return a tuple + [0] The returned value - scalar, object reference or a tuple + [1] The Basic VarType() of the returned value + Null, Empty and Nothing have different vartypes but return all None to Python + Additionally, when [0] is a tuple: + [2] Number of dimensions in Basic + Additionally, when [0] is a UNO or Basic object: + [2] Module (1), Class instance (2) or UNO (3) + [3] The object's ObjectType + [4] The object's ServiceName + [5] The object's name + When an error occurs Python receives None as a scalar. This determines the occurrence of a failure + The method returns either + - the 0th element of the tuple when scalar, tuple or UNO object + - a new Service() object or one of its subclasses otherwise + """ + # Constants + script = ScriptForge.basicdispatcher + cstNoArgs = '+++NOARGS+++' + cstValue, cstVarType, cstDims, cstClass, cstType, cstService, cstName = 0, 1, 2, 2, 3, 4, 5 + + # + # Run the basic script + # The targeted script has a ParamArray argument. Do not change next 4 lines except if you know what you do ! + if len(args) == 0: + args = (basicobject,) + (flags,) + (method,) + (cstNoArgs,) + else: + args = (basicobject,) + (flags,) + (method,) + args + returntuple = cls.InvokeSimpleScript(script, args) + # + # Interpret the result + # Did an error occur in the Basic world ? + if not isinstance(returntuple, (tuple, list)): + raise RuntimeError("The execution of the method '" + method + "' failed. Execution stops.") + # + # Analyze the returned tuple + if returntuple[cstVarType] == ScriptForge.V_OBJECT and len(returntuple) > cstClass: # Avoid Nothing + if returntuple[cstClass] == ScriptForge.objUNO: + pass + else: + # Create the new class instance of the right subclass of SFServices() + servname = returntuple[cstService] + if servname not in cls.serviceslist: + # When service not found + raise RuntimeError("The service '" + servname + "' is not available in Python. Execution stops.") + subcls = cls.serviceslist[servname] + if subcls is not None: + return subcls(returntuple[cstValue], returntuple[cstType], returntuple[cstClass], + returntuple[cstName]) + elif returntuple[cstVarType] >= ScriptForge.V_ARRAY: + # Intercept empty array + if isinstance(returntuple[cstValue], uno.ByteSequence): + return () + elif returntuple[cstVarType] == ScriptForge.V_DATE: + dat = SFScriptForge.SF_Basic.CDateFromUnoDateTime(returntuple[cstValue]) + return dat + else: # All other scalar values + pass + return returntuple[cstValue] + + @staticmethod + def SetAttributeSynonyms(): + """ + A synonym of an attribute is either the lowercase or the camelCase form of its original ProperCase name. + In every subclass of SFServices: + 1) Fill the propertysynonyms dictionary with the synonyms of the properties listed in serviceproperties + Example: + serviceproperties = dict(ConfigFolder = False, InstallFolder = False) + propertysynonyms = dict(configfolder = 'ConfigFolder', installfolder = 'InstallFolder', + configFolder = 'ConfigFolder', installFolder = 'InstallFolder') + 2) Define new method attributes synonyms of the original methods + Example: + def CopyFile(...): + # etc ... + copyFile, copyfile = CopyFile, CopyFile + """ + def camelCase(key): + return key[0].lower() + key[1:] + + for cls in SFServices.__subclasses__(): + # Synonyms of properties + if hasattr(cls, 'serviceproperties'): + dico = cls.serviceproperties + dicosyn = dict(zip(map(str.lower, dico.keys()), dico.keys())) # lower case + cc = dict(zip(map(camelCase, dico.keys()), dico.keys())) # camel Case + dicosyn.update(cc) + setattr(cls, 'propertysynonyms', dicosyn) + # Synonyms of methods. A method is a public callable attribute + methods = [method for method in dir(cls) if not method.startswith('_')] + for method in methods: + func = getattr(cls, method) + if callable(func): + # Assign to each synonym a reference to the original method + lc = method.lower() + setattr(cls, lc, func) + cc = camelCase(method) + if cc != lc: + setattr(cls, cc, func) + return + + @staticmethod + def unpack_args(kwargs): + """ + Convert a dictionary passed as argument to a list alternating keys and values + Example: + dict(A = 'a', B = 2) => 'A', 'a', 'B', 2 + """ + return [v for p in zip(list(kwargs.keys()), list(kwargs.values())) for v in p] + + +# ##################################################################################################################### +# SFServices CLASS (ScriptForge services superclass) ### +# ##################################################################################################################### + +class SFServices(object): + """ + Generic implementation of a parent Service class + Every service must subclass this class to be recognized as a valid service + A service instance is created by the CreateScriptService method + It can have a mirror in the Basic world or be totally defined in Python + + Every subclass must initialize 3 class properties: + servicename (e.g. 'ScriptForge.FileSystem', 'ScriptForge.Basic') + servicesynonyms (e.g. 'FileSystem', 'Basic') + serviceimplementation: either 'python' or 'basic' + This is sufficient to register the service in the Python world + + The communication with Basic is managed by 2 ScriptForge() methods: + InvokeSimpleScript(): low level invocation of a Basic script. This script must be located + in a usual Basic module. The result is passed as-is + InvokeBasicService(): the result comes back encapsulated with additional info + The result is interpreted in the method + The invoked script can be a property or a method of a Basic class or usual module + It is up to every service method to determine which method to use + + For Basic services only: + Each instance is identified by its + - object reference: the real Basic object embedded as a UNO wrapper object + - object type ('SF_String', 'DICTIONARY', ...) + - class module: 1 for usual modules, 2 for class modules + - name (form, control, ... name) - may be blank + + The role of the SFServices() superclass is mainly to propose a generic properties management + Properties are got and set following next strategy: + 1. Property names are controlled strictly ('Value' or 'value', not 'VALUE') + 2. Getting a property value for the first time is always done via a Basic call + 3. Next occurrences are fetched from the Python dictionary of the instance if the property + is read-only, otherwise via a Basic call + 4. Read-only properties may be modified or deleted exceptionally by the class + when self.internal == True. The latter must immediately be reset after use + + Each subclass must define its interface with the user scripts: + 1. The properties + Property names are proper-cased + Conventionally, camel-cased and lower-cased synonyms are supported where relevant + a dictionary named 'serviceproperties' with keys = (proper-cased) property names and value = boolean + True = editable, False = read-only + a list named 'localProperties' reserved to properties for internal use + e.g. oDlg.Controls() is a method that uses '_Controls' to hold the list of available controls + When + forceGetProperty = False # Standard behaviour + read-only serviceproperties are buffered in Python after their 1st get request to Basic + Otherwise set it to True to force a recomputation at each property getter invocation + If there is a need to handle a specific property in a specific manner: + @property + def myProperty(self): + return self.GetProperty('myProperty') + 2 The methods + a usual def: statement + def myMethod(self, arg1, arg2 = ''): + return self.Execute(self.vbMethod, 'myMethod', arg1, arg2) + Method names are proper-cased, arguments are lower-cased + Conventionally, camel-cased and lower-cased homonyms are supported where relevant + All arguments must be present and initialized before the call to Basic, if any + """ + # Python-Basic protocol constants and flags + vbGet, vbLet, vbMethod, vbSet = 2, 4, 1, 8 # CallByName constants + flgPost = 32 # The method or the property implies a hardcoded post-processing + flgDateArg = 64 # Invoked service method may contain a date argument + flgDateRet = 128 # Invoked service method can return a date + flgArrayArg = 512 # 1st argument can be a 2D array + flgArrayRet = 1024 # Invoked service method can return a 2D array (standard modules) or any array (class modules) + flgUno = 256 # Invoked service method/property can return a UNO object + flgObject = 2048 # 1st argument may be a Basic object + flgHardCode = 4096 # Force hardcoded call to method, avoid CallByName() + # Basic class type + moduleClass, moduleStandard = 2, 1 + # + # Define the default behaviour for read-only properties: buffer their values in Python + forceGetProperty = False + # Empty dictionary for lower/camelcased homonyms or properties + propertysynonyms = {} + # To operate dynamic property getting/setting it is necessary to + # enumerate all types of properties and adapt __getattr__() and __setattr__() according to their type + internal_attributes = ('objectreference', 'objecttype', 'name', 'internal', 'servicename', + 'serviceimplementation', 'classmodule', 'EXEC', 'SIMPLEEXEC') + # Shortcuts to script provider interfaces + SIMPLEEXEC = ScriptForge.InvokeSimpleScript + EXEC = ScriptForge.InvokeBasicService + + def __init__(self, reference = -1, objtype = None, classmodule = 0, name = ''): + """ + Trivial initialization of internal properties + If the subclass has its own __init()__ method, a call to this one should be its first statement. + Afterwards localProperties should be filled with the list of its own properties + """ + self.objectreference = reference # the index in the Python storage where the Basic object is stored + self.objecttype = objtype # ('SF_String', 'DICTIONARY', ...) + self.classmodule = classmodule # Module (1), Class instance (2) + self.name = name # '' when no name + self.internal = False # True to exceptionally allow assigning a new value to a read-only property + self.localProperties = [] # the properties reserved for internal use (often empty) + + def __getattr__(self, name): + """ + Executed for EVERY property reference if name not yet in the instance dict + At the 1st get, the property value is always got from Basic + Due to the use of lower/camelcase synonyms, it is called for each variant of the same property + The method manages itself the buffering in __dict__ based on the official ProperCase property name + """ + if name in self.propertysynonyms: # Reset real name if argument provided in lower or camel case + name = self.propertysynonyms[name] + if self.serviceimplementation == 'basic': + if name in ('serviceproperties', 'localProperties', 'internal_attributes', 'propertysynonyms', + 'forceGetProperty'): + pass + elif name in self.serviceproperties: + if self.forceGetProperty is False and self.serviceproperties[name] is False: # False = read-only + if name in self.__dict__: + return self.__dict__[name] + else: + # Get Property from Basic and store it + prop = self.GetProperty(name) + self.__dict__[name] = prop + return prop + else: # Get Property from Basic and do not store it + return self.GetProperty(name) + # Execute the usual attributes getter + return super(SFServices, self).__getattribute__(name) + + def __setattr__(self, name, value): + """ + Executed for EVERY property assignment, including in __init__() !! + Setting a property requires for serviceproperties() to be executed in Basic + Management of __dict__ is automatically done in the final usual object.__setattr__ method + """ + if self.serviceimplementation == 'basic': + if name in ('serviceproperties', 'localProperties', 'internal_attributes', 'propertysynonyms', + 'forceGetProperty'): + pass + elif name[0:2] == '__' or name in self.internal_attributes or name in self.localProperties: + pass + elif name in self.serviceproperties or name in self.propertysynonyms: + if name in self.propertysynonyms: # Reset real name if argument provided in lower or camel case + name = self.propertysynonyms[name] + if self.internal: # internal = True forces property local setting even if property is read-only + pass + elif self.serviceproperties[name] is True: # True == Editable + self.SetProperty(name, value) + return + else: + raise AttributeError( + "type object '" + self.objecttype + "' has no editable property '" + name + "'") + else: + raise AttributeError("type object '" + self.objecttype + "' has no property '" + name + "'") + object.__setattr__(self, name, value) + return + + def __repr__(self): + return self.serviceimplementation + '/' + self.servicename + '/' + str(self.objectreference) + '/' + \ + super(SFServices, self).__repr__() + + def Dispose(self): + if self.serviceimplementation == 'basic': + if self.objectreference >= len(ScriptForge.servicesmodules): # Do not dispose predefined module objects + self.ExecMethod(self.vbMethod, 'Dispose') + self.objectreference = -1 + + def ExecMethod(self, flags = 0, methodname = '', *args): + if flags == 0: + flags = self.vbMethod + if len(methodname) > 0: + return self.EXEC(self.objectreference, flags, methodname, *args) + + def GetProperty(self, propertyname, arg = None): + """ + Get the given property from the Basic world + """ + if self.serviceimplementation == 'basic': + # Conventionally properties starting with X (and only them) may return a UNO object + calltype = self.vbGet + (self.flgUno if propertyname[0] == 'X' else 0) + if arg is None: + return self.EXEC(self.objectreference, calltype, propertyname) + else: # There are a few cases (Calc ...) where GetProperty accepts an argument + return self.EXEC(self.objectreference, calltype, propertyname, arg) + return None + + def Properties(self): + return list(self.serviceproperties) + + def basicmethods(self): + if self.serviceimplementation == 'basic': + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Methods') + else: + return [] + + def basicproperties(self): + if self.serviceimplementation == 'basic': + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Properties') + else: + return [] + + def SetProperty(self, propertyname, value): + """ + Set the given property to a new value in the Basic world + """ + if self.serviceimplementation == 'basic': + flag = self.vbLet + if isinstance(value, datetime.datetime): + value = SFScriptForge.SF_Basic.CDateToUnoDateTime(value) + flag += self.flgDateArg + if repr(type(value)) == "<class 'pyuno'>": + flag += self.flgUno + return self.EXEC(self.objectreference, flag, propertyname, value) + + +# ##################################################################################################################### +# SFScriptForge CLASS (alias of ScriptForge Basic library) ### +# ##################################################################################################################### +class SFScriptForge: + pass + + # ######################################################################### + # SF_Array CLASS + # ######################################################################### + class SF_Array(SFServices, metaclass = _Singleton): + """ + Provides a collection of methods for manipulating and transforming arrays of one dimension (vectors) + and arrays of two dimensions (matrices). This includes set operations, sorting, + importing to and exporting from text files. + The Python version of the service provides a single method: ImportFromCSVFile + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.Array' + servicesynonyms = ('array', 'scriptforge.array') + serviceproperties = dict() + + def ImportFromCSVFile(self, filename, delimiter = ',', dateformat = ''): + """ + Difference with the Basic version: dates are returned in their iso format, + not as any of the datetime objects. + """ + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'ImportFromCSVFile', + filename, delimiter, dateformat) + + # ######################################################################### + # SF_Basic CLASS + # ######################################################################### + class SF_Basic(SFServices, metaclass = _Singleton): + """ + This service proposes a collection of Basic methods to be executed in a Python context + simulating the exact syntax and behaviour of the identical Basic builtin method. + Typical example: + SF_Basic.MsgBox('This has to be displayed in a message box') + + The signatures of Basic builtin functions are derived from + core/basic/source/runtime/stdobj.cxx + + Detailed user documentation: + https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_basic.html?DbPAR=BASIC + """ + # Mandatory class properties for service registration + serviceimplementation = 'python' + servicename = 'ScriptForge.Basic' + servicesynonyms = ('basic', 'scriptforge.basic') + # Basic helper functions invocation + module = 'SF_PythonHelper' + # Message box constants + MB_ABORTRETRYIGNORE, MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3 = 2, 128, 256, 512 + MB_ICONEXCLAMATION, MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONSTOP = 48, 64, 32, 16 + MB_OK, MB_OKCANCEL, MB_RETRYCANCEL, MB_YESNO, MB_YESNOCANCEL = 0, 1, 5, 4, 3 + IDABORT, IDCANCEL, IDIGNORE, IDNO, IDOK, IDRETRY, IDYES = 3, 2, 5, 7, 1, 4, 6 + + @classmethod + def CDate(cls, datevalue): + cdate = cls.SIMPLEEXEC(cls.module + '.PyCDate', datevalue) + return cls.CDateFromUnoDateTime(cdate) + + @staticmethod + def CDateFromUnoDateTime(unodate): + """ + Converts a UNO date/time representation to a datetime.datetime Python native object + :param unodate: com.sun.star.util.DateTime, com.sun.star.util.Date or com.sun.star.util.Time + :return: the equivalent datetime.datetime + """ + date = datetime.datetime(1899, 12, 30, 0, 0, 0, 0) # Idem as Basic builtin TimeSeria() function + datetype = repr(type(unodate)) + if 'com.sun.star.util.DateTime' in datetype: + if 1900 <= unodate.Year <= datetime.MAXYEAR: + date = datetime.datetime(unodate.Year, unodate.Month, unodate.Day, unodate.Hours, + unodate.Minutes, unodate.Seconds, int(unodate.NanoSeconds / 1000)) + elif 'com.sun.star.util.Date' in datetype: + if 1900 <= unodate.Year <= datetime.MAXYEAR: + date = datetime.datetime(unodate.Year, unodate.Month, unodate.Day) + elif 'com.sun.star.util.Time' in datetype: + date = datetime.datetime(unodate.Hours, unodate.Minutes, unodate.Seconds, + int(unodate.NanoSeconds / 1000)) + else: + return unodate # Not recognized as a UNO date structure + return date + + @staticmethod + def CDateToUnoDateTime(date): + """ + Converts a date representation into the ccom.sun.star.util.DateTime date format + Acceptable boundaries: year >= 1900 and <= 32767 + :param date: datetime.datetime, datetime.date, datetime.time, float (time.time) or time.struct_time + :return: a com.sun.star.util.DateTime + """ + unodate = uno.createUnoStruct('com.sun.star.util.DateTime') + unodate.Year, unodate.Month, unodate.Day, unodate.Hours, unodate.Minutes, unodate.Seconds, \ + unodate.NanoSeconds, unodate.IsUTC = \ + 1899, 12, 30, 0, 0, 0, 0, False # Identical to Basic TimeSerial() function + + if isinstance(date, float): + date = time.localtime(date) + if isinstance(date, time.struct_time): + if 1900 <= date[0] <= 32767: + unodate.Year, unodate.Month, unodate.Day, unodate.Hours, unodate.Minutes, unodate.Seconds =\ + date[0:6] + else: # Copy only the time related part + unodate.Hours, unodate.Minutes, unodate.Seconds = date[3:3] + elif isinstance(date, (datetime.datetime, datetime.date, datetime.time)): + if isinstance(date, (datetime.datetime, datetime.date)): + if 1900 <= date.year <= 32767: + unodate.Year, unodate.Month, unodate.Day = date.year, date.month, date.day + if isinstance(date, (datetime.datetime, datetime.time)): + unodate.Hours, unodate.Minutes, unodate.Seconds, unodate.NanoSeconds = \ + date.hour, date.minute, date.second, date.microsecond * 1000 + else: + return date # Not recognized as a date + return unodate + + @classmethod + def ConvertFromUrl(cls, url): + return cls.SIMPLEEXEC(cls.module + '.PyConvertFromUrl', url) + + @classmethod + def ConvertToUrl(cls, systempath): + return cls.SIMPLEEXEC(cls.module + '.PyConvertToUrl', systempath) + + @classmethod + def CreateUnoService(cls, servicename): + return cls.SIMPLEEXEC(cls.module + '.PyCreateUnoService', servicename) + + @classmethod + def DateAdd(cls, interval, number, date): + if isinstance(date, datetime.datetime): + date = cls.CDateToUnoDateTime(date) + dateadd = cls.SIMPLEEXEC(cls.module + '.PyDateAdd', interval, number, date) + return cls.CDateFromUnoDateTime(dateadd) + + @classmethod + def DateDiff(cls, interval, date1, date2, firstdayofweek = 1, firstweekofyear = 1): + if isinstance(date1, datetime.datetime): + date1 = cls.CDateToUnoDateTime(date1) + if isinstance(date2, datetime.datetime): + date2 = cls.CDateToUnoDateTime(date2) + return cls.SIMPLEEXEC(cls.module + '.PyDateDiff', interval, date1, date2, firstdayofweek, firstweekofyear) + + @classmethod + def DatePart(cls, interval, date, firstdayofweek = 1, firstweekofyear = 1): + if isinstance(date, datetime.datetime): + date = cls.CDateToUnoDateTime(date) + return cls.SIMPLEEXEC(cls.module + '.PyDatePart', interval, date, firstdayofweek, firstweekofyear) + + @classmethod + def DateValue(cls, string): + if isinstance(string, datetime.datetime): + string = string.isoformat() + datevalue = cls.SIMPLEEXEC(cls.module + '.PyDateValue', string) + return cls.CDateFromUnoDateTime(datevalue) + + @classmethod + def Format(cls, expression, format = ''): + if isinstance(expression, datetime.datetime): + expression = cls.CDateToUnoDateTime(expression) + return cls.SIMPLEEXEC(cls.module + '.PyFormat', expression, format) + + @classmethod + def GetDefaultContext(cls): + return ScriptForge.componentcontext + + @classmethod + def GetGuiType(cls): + return cls.SIMPLEEXEC(cls.module + '.PyGetGuiType') + + @classmethod + def GetPathSeparator(cls): + return os.sep + + @classmethod + def GetSystemTicks(cls): + return cls.SIMPLEEXEC(cls.module + '.PyGetSystemTicks') + + class GlobalScope(object, metaclass = _Singleton): + @classmethod # Mandatory because the GlobalScope class is normally not instantiated + def BasicLibraries(cls): + return ScriptForge.InvokeSimpleScript(SFScriptForge.SF_Basic.module + '.PyGlobalScope', 'Basic') + + @classmethod + def DialogLibraries(cls): + return ScriptForge.InvokeSimpleScript(SFScriptForge.SF_Basic.module + '.PyGlobalScope', 'Dialog') + + @classmethod + def InputBox(cls, prompt, title = '', default = '', xpostwips = -1, ypostwips = -1): + if xpostwips < 0 or ypostwips < 0: + return cls.SIMPLEEXEC(cls.module + '.PyInputBox', prompt, title, default) + return cls.SIMPLEEXEC(cls.module + '.PyInputBox', prompt, title, default, xpostwips, ypostwips) + + @classmethod + def MsgBox(cls, prompt, buttons = 0, title = ''): + return cls.SIMPLEEXEC(cls.module + '.PyMsgBox', prompt, buttons, title) + + @classmethod + def Now(cls): + return datetime.datetime.now() + + @classmethod + def RGB(cls, red, green, blue): + return int('%02x%02x%02x' % (red, green, blue), 16) + + @property + def StarDesktop(self): + ctx = ScriptForge.componentcontext + if ctx is None: + return None + smgr = ctx.getServiceManager() # com.sun.star.lang.XMultiComponentFactory + DESK = 'com.sun.star.frame.Desktop' + desktop = smgr.createInstanceWithContext(DESK, ctx) + return desktop + starDesktop, stardesktop = StarDesktop, StarDesktop + + @property + def ThisComponent(self): + """ + When the current component is the Basic IDE, the ThisComponent object returns + in Basic the component owning the currently run user script. + Above behaviour cannot be reproduced in Python. + :return: the current component or None when not a document + """ + comp = self.StarDesktop.getCurrentComponent() + if comp is None: + return None + impl = comp.ImplementationName + if impl in ('com.sun.star.comp.basic.BasicIDE', 'com.sun.star.comp.sfx2.BackingComp'): + return None # None when Basic IDE or welcome screen + return comp + thisComponent, thiscomponent = ThisComponent, ThisComponent + + @property + def ThisDatabaseDocument(self): + """ + When the current component is the Basic IDE, the ThisDatabaseDocument object returns + in Basic the database owning the currently run user script. + Above behaviour cannot be reproduced in Python. + :return: the current Base (main) component or None when not a Base document or one of its subcomponents + """ + comp = self.ThisComponent # Get the current component + if comp is None: + return None + # + sess = CreateScriptService('Session') + impl, ident = '', '' + if sess.HasUnoProperty(comp, 'ImplementationName'): + impl = comp.ImplementationName + if sess.HasUnoProperty(comp, 'Identifier'): + ident = comp.Identifier + # + targetimpl = 'com.sun.star.comp.dba.ODatabaseDocument' + if impl == targetimpl: # The current component is the main Base window + return comp + # Identify resp. form, table/query, table/query in edit mode, report, relations diagram + if impl == 'SwXTextDocument' and ident == 'com.sun.star.sdb.FormDesign' \ + or impl == 'org.openoffice.comp.dbu.ODatasourceBrowser' \ + or impl in ('org.openoffice.comp.dbu.OTableDesign', 'org.openoffice.comp.dbu.OQuertDesign') \ + or impl == 'SwXTextDocument' and ident == 'com.sun.star.sdb.TextReportDesign' \ + or impl == 'org.openoffice.comp.dbu.ORelationDesign': + db = comp.ScriptContainer + if sess.HasUnoProperty(db, 'ImplementationName'): + if db.ImplementationName == targetimpl: + return db + return None + thisDatabaseDocument, thisdatabasedocument = ThisDatabaseDocument, ThisDatabaseDocument + + @classmethod + def Xray(cls, unoobject = None): + return cls.SIMPLEEXEC('XrayTool._main.xray', unoobject) + + # ######################################################################### + # SF_Dictionary CLASS + # ######################################################################### + class SF_Dictionary(SFServices, dict): + """ + The service adds to a Python dict instance the interfaces for conversion to and from + a list of UNO PropertyValues + + Usage: + dico = dict(A = 1, B = 2, C = 3) + myDict = CreateScriptService('Dictionary', dico) # Initialize myDict with the content of dico + myDict['D'] = 4 + print(myDict) # {'A': 1, 'B': 2, 'C': 3, 'D': 4} + propval = myDict.ConvertToPropertyValues() + or + dico = dict(A = 1, B = 2, C = 3) + myDict = CreateScriptService('Dictionary') # Initialize myDict as an empty dict object + myDict.update(dico) # Load the values of dico into myDict + myDict['D'] = 4 + print(myDict) # {'A': 1, 'B': 2, 'C': 3, 'D': 4} + propval = myDict.ConvertToPropertyValues() + """ + # Mandatory class properties for service registration + serviceimplementation = 'python' + servicename = 'ScriptForge.Dictionary' + servicesynonyms = ('dictionary', 'scriptforge.dictionary') + + def __init__(self, dic = None): + SFServices.__init__(self) + dict.__init__(self) + if dic is not None: + self.update(dic) + + def ConvertToPropertyValues(self): + """ + Store the content of the dictionary in an array of PropertyValues. + Each entry in the array is a com.sun.star.beans.PropertyValue. + he key is stored in Name, the value is stored in Value. + + If one of the items has a type datetime, it is converted to a com.sun.star.util.DateTime structure. + If one of the items is an empty list, it is converted to None. + + The resulting array is empty when the dictionary is empty. + """ + result = [] + for key in iter(self): + value = self[key] + item = value + if isinstance(value, dict): # check that first level is not itself a (sub)dict + item = None + elif isinstance(value, (tuple, list)): # check every member of the list is not a (sub)dict + if len(value) == 0: # Property values do not like empty lists + value = None + else: + for i in range(len(value)): + if isinstance(value[i], dict): + value[i] = None + item = value + elif isinstance(value, (datetime.datetime, datetime.date, datetime.time)): + item = SFScriptForge.SF_Basic.CDateToUnoDateTime(value) + pv = uno.createUnoStruct('com.sun.star.beans.PropertyValue') + pv.Name = key + pv.Value = item + result.append(pv) + return result + + def ImportFromPropertyValues(self, propertyvalues, overwrite = False): + """ + Inserts the contents of an array of PropertyValue objects into the current dictionary. + PropertyValue Names are used as keys in the dictionary, whereas Values contain the corresponding values. + Date-type values are converted to datetime.datetime instances. + :param propertyvalues: a list.tuple containing com.sun.star.beans.PropertyValue objects + :param overwrite: When True, entries with same name may exist in the dictionary and their values + are overwritten. When False (default), repeated keys are not overwritten. + :return: True when successful + """ + result = [] + for pv in iter(propertyvalues): + key = pv.Name + if overwrite is True or key not in self: + item = pv.Value + if 'com.sun.star.util.DateTime' in repr(type(item)): + item = datetime.datetime(item.Year, item.Month, item.Day, + item.Hours, item.Minutes, item.Seconds, int(item.NanoSeconds / 1000)) + elif 'com.sun.star.util.Date' in repr(type(item)): + item = datetime.datetime(item.Year, item.Month, item.Day) + elif 'com.sun.star.util.Time' in repr(type(item)): + item = datetime.datetime(item.Hours, item.Minutes, item.Seconds, int(item.NanoSeconds / 1000)) + result.append((key, item)) + self.update(result) + return True + + # ######################################################################### + # SF_Exception CLASS + # ######################################################################### + class SF_Exception(SFServices, metaclass = _Singleton): + """ + The Exception service is a collection of methods for code debugging and error handling. + + The Exception service console stores events, variable values and information about errors. + Use the console when the Python shell is not available, for example in Calc user defined functions (UDF) + or during events processing. + Use DebugPrint() method to aggregate additional user data of any type. + + Console entries can be dumped to a text file or visualized in a dialogue. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.Exception' + servicesynonyms = ('exception', 'scriptforge.exception') + serviceproperties = dict() + + def Console(self, modal = True): + # From Python, the current XComponentContext must be added as last argument + return self.ExecMethod(self.vbMethod, 'Console', modal, ScriptForge.componentcontext) + + def ConsoleClear(self, keep = 0): + return self.ExecMethod(self.vbMethod, 'ConsoleClear', keep) + + def ConsoleToFile(self, filename): + return self.ExecMethod(self.vbMethod, 'ConsoleToFile', filename) + + def DebugDisplay(self, *args): + # Arguments are concatenated in a single string similar to what the Python print() function would produce + self.DebugPrint(*args) + param = '\n'.join(list(map(lambda a: a.strip("'") if isinstance(a, str) else repr(a), args))) + bas = CreateScriptService('ScriptForge.Basic') + return bas.MsgBox(param, bas.MB_OK + bas.MB_ICONINFORMATION, 'DebugDisplay') + + def DebugPrint(self, *args): + # Arguments are concatenated in a single string similar to what the Python print() function would produce + # Avoid using repr() on strings to not have backslashes * 4 + param = '\t'.join(list(map(lambda a: a.strip("'") if isinstance(a, str) else repr(a), + args))).expandtabs(tabsize = 4) + return self.ExecMethod(self.vbMethod, 'DebugPrint', param) + + @classmethod + def PythonShell(cls, variables = None): + """ + Open an APSO python shell window - Thanks to its authors Hanya/Tsutomu Uchino/Hubert Lambert + :param variables: Typical use + PythonShell.({**globals(), **locals()}) + to push the global and local dictionaries to the shell window + """ + if variables is None: + variables = locals() + # Is APSO installed ? + ctx = ScriptForge.componentcontext + ext = ctx.getByName('/singletons/com.sun.star.deployment.PackageInformationProvider') + apso = 'apso.python.script.organizer' + if len(ext.getPackageLocation(apso)) > 0: + # Directly derived from apso.oxt|python|scripts|tools.py$console + # we need to load apso before import statement + ctx.ServiceManager.createInstance('apso.python.script.organizer.impl') + # now we can use apso_utils library + from apso_utils import console + kwargs = {'loc': variables} + kwargs['loc'].setdefault('XSCRIPTCONTEXT', uno) + console(**kwargs) + # An interprocess call is necessary to allow a redirection of STDOUT and STDERR by APSO + # Choice is a minimalist call to a Basic routine: no arguments, a few lines of code + SFScriptForge.SF_Basic.GetGuiType() + else: + # The APSO extension could not be located in your LibreOffice installation + cls._RaiseFatal('SF_Exception.PythonShell', 'variables=None', 'PYTHONSHELLERROR') + + @classmethod + def RaiseFatal(cls, errorcode, *args): + """ + Generate a run-time error caused by an anomaly in a user script detected by ScriptForge + The message is logged in the console. The execution is STOPPED + For INTERNAL USE only + """ + # Direct call because RaiseFatal forces an execution stop in Basic + if len(args) == 0: + args = (None,) + return cls.SIMPLEEXEC('@SF_Exception.RaiseFatal', (errorcode, *args)) # With ParamArray + + @classmethod + def _RaiseFatal(cls, sub, subargs, errorcode, *args): + """ + Wrapper of RaiseFatal(). Includes method and syntax of the failed Python routine + to simulate the exact behaviour of the Basic RaiseFatal() method + For INTERNAL USE only + """ + ScriptForge.InvokeSimpleScript('ScriptForge.SF_Utils._EnterFunction', sub, subargs) + cls.RaiseFatal(errorcode, *args) + raise RuntimeError("The execution of the method '" + sub.split('.')[-1] + "' failed. Execution stops.") + + # ######################################################################### + # SF_FileSystem CLASS + # ######################################################################### + class SF_FileSystem(SFServices, metaclass = _Singleton): + """ + The "FileSystem" service includes common file and folder handling routines. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.FileSystem' + servicesynonyms = ('filesystem', 'scriptforge.filesystem') + serviceproperties = dict(FileNaming = True, ConfigFolder = False, ExtensionsFolder = False, HomeFolder = False, + InstallFolder = False, TemplatesFolder = False, TemporaryFolder = False, + UserTemplatesFolder = False) + # Force for each property to get its value from Basic - due to FileNaming updatability + forceGetProperty = True + # Open TextStream constants + ForReading, ForWriting, ForAppending = 1, 2, 8 + + def BuildPath(self, foldername, name): + return self.ExecMethod(self.vbMethod, 'BuildPath', foldername, name) + + def CompareFiles(self, filename1, filename2, comparecontents = False): + py = ScriptForge.pythonhelpermodule + '$' + '_SF_FileSystem__CompareFiles' + if self.FileExists(filename1) and self.FileExists(filename2): + file1 = self._ConvertFromUrl(filename1) + file2 = self._ConvertFromUrl(filename2) + return self.SIMPLEEXEC(py, file1, file2, comparecontents) + else: + return False + + def CopyFile(self, source, destination, overwrite = True): + return self.ExecMethod(self.vbMethod, 'CopyFile', source, destination, overwrite) + + def CopyFolder(self, source, destination, overwrite = True): + return self.ExecMethod(self.vbMethod, 'CopyFolder', source, destination, overwrite) + + def CreateFolder(self, foldername): + return self.ExecMethod(self.vbMethod, 'CreateFolder', foldername) + + def CreateTextFile(self, filename, overwrite = True, encoding = 'UTF-8'): + return self.ExecMethod(self.vbMethod, 'CreateTextFile', filename, overwrite, encoding) + + def DeleteFile(self, filename): + return self.ExecMethod(self.vbMethod, 'DeleteFile', filename) + + def DeleteFolder(self, foldername): + return self.ExecMethod(self.vbMethod, 'DeleteFolder', foldername) + + def ExtensionFolder(self, extension): + return self.ExecMethod(self.vbMethod, 'ExtensionFolder', extension) + + def FileExists(self, filename): + return self.ExecMethod(self.vbMethod, 'FileExists', filename) + + def Files(self, foldername, filter = ''): + return self.ExecMethod(self.vbMethod, 'Files', foldername, filter) + + def FolderExists(self, foldername): + return self.ExecMethod(self.vbMethod, 'FolderExists', foldername) + + def GetBaseName(self, filename): + return self.ExecMethod(self.vbMethod, 'GetBaseName', filename) + + def GetExtension(self, filename): + return self.ExecMethod(self.vbMethod, 'GetExtension', filename) + + def GetFileLen(self, filename): + py = ScriptForge.pythonhelpermodule + '$' + '_SF_FileSystem__GetFilelen' + if self.FileExists(filename): + file = self._ConvertFromUrl(filename) + return int(self.SIMPLEEXEC(py, file)) + else: + return 0 + + def GetFileModified(self, filename): + return self.ExecMethod(self.vbMethod + self.flgDateRet, 'GetFileModified', filename) + + def GetName(self, filename): + return self.ExecMethod(self.vbMethod, 'GetName', filename) + + def GetParentFolderName(self, filename): + return self.ExecMethod(self.vbMethod, 'GetParentFolderName', filename) + + def GetTempName(self): + return self.ExecMethod(self.vbMethod, 'GetTempName') + + def HashFile(self, filename, algorithm): + py = ScriptForge.pythonhelpermodule + '$' + '_SF_FileSystem__HashFile' + if self.FileExists(filename): + file = self._ConvertFromUrl(filename) + return self.SIMPLEEXEC(py, file, algorithm.lower()) + else: + return '' + + def MoveFile(self, source, destination): + return self.ExecMethod(self.vbMethod, 'MoveFile', source, destination) + + def MoveFolder(self, source, destination): + return self.ExecMethod(self.vbMethod, 'MoveFolder', source, destination) + + def OpenTextFile(self, filename, iomode = 1, create = False, encoding = 'UTF-8'): + return self.ExecMethod(self.vbMethod, 'OpenTextFile', filename, iomode, create, encoding) + + def PickFile(self, defaultfile = ScriptForge.cstSymEmpty, mode = 'OPEN', filter = ''): + return self.ExecMethod(self.vbMethod, 'PickFile', defaultfile, mode, filter) + + def PickFolder(self, defaultfolder = ScriptForge.cstSymEmpty, freetext = ''): + return self.ExecMethod(self.vbMethod, 'PickFolder', defaultfolder, freetext) + + def SubFolders(self, foldername, filter = ''): + return self.ExecMethod(self.vbMethod, 'SubFolders', foldername, filter) + + @classmethod + def _ConvertFromUrl(cls, filename): + # Alias for same function in FileSystem Basic module + return cls.SIMPLEEXEC('ScriptForge.SF_FileSystem._ConvertFromUrl', filename) + + # ######################################################################### + # SF_L10N CLASS + # ######################################################################### + class SF_L10N(SFServices): + """ + This service provides a number of methods related to the translation of strings + with minimal impact on the program's source code. + The methods provided by the L10N service can be used mainly to: + Create POT files that can be used as templates for translation of all strings in the program. + Get translated strings at runtime for the language defined in the Locale property. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.L10N' + servicesynonyms = ('l10n', 'scriptforge.l10n') + serviceproperties = dict(Folder = False, Languages = False, Locale = False) + + @classmethod + def ReviewServiceArgs(cls, foldername = '', locale = '', encoding = 'UTF-8', + locale2 = '', encoding2 = 'UTF-8'): + """ + Transform positional and keyword arguments into positional only + """ + return foldername, locale, encoding, locale2, encoding2 + + def AddText(self, context = '', msgid = '', comment = ''): + return self.ExecMethod(self.vbMethod, 'AddText', context, msgid, comment) + + def AddTextsFromDialog(self, dialog): + dialogobj = dialog.objectreference if isinstance(dialog, SFDialogs.SF_Dialog) else dialog + return self.ExecMethod(self.vbMethod + self.flgObject, 'AddTextsFromDialog', dialogobj) + + def ExportToPOTFile(self, filename, header = '', encoding= 'UTF-8'): + return self.ExecMethod(self.vbMethod, 'ExportToPOTFile', filename, header, encoding) + + def GetText(self, msgid, *args): + return self.ExecMethod(self.vbMethod, 'GetText', msgid, *args) + _ = GetText + + # ######################################################################### + # SF_Platform CLASS + # ######################################################################### + class SF_Platform(SFServices, metaclass = _Singleton): + """ + The 'Platform' service implements a collection of properties about the actual execution environment + and context : + the hardware platform + the operating system + the LibreOffice version + the current user + All those properties are read-only. + The implementation is mainly based on the 'platform' module of the Python standard library + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.Platform' + servicesynonyms = ('platform', 'scriptforge.platform') + serviceproperties = dict(Architecture = False, ComputerName = False, CPUCount = False, CurrentUser = False, + Extensions = False, FilterNames = False, Fonts = False, FormatLocale = False, + Locale = False, Machine = False, OfficeLocale = False, OfficeVersion = False, + OSName = False, OSPlatform = False, OSRelease = False, OSVersion = False, + Printers = False, Processor = False, PythonVersion = False, SystemLocale = False) + # Python helper functions + py = ScriptForge.pythonhelpermodule + '$' + '_SF_Platform' + + @property + def Architecture(self): + return self.SIMPLEEXEC(self.py, 'Architecture') + + @property + def ComputerName(self): + return self.SIMPLEEXEC(self.py, 'ComputerName') + + @property + def CPUCount(self): + return self.SIMPLEEXEC(self.py, 'CPUCount') + + @property + def CurrentUser(self): + return self.SIMPLEEXEC(self.py, 'CurrentUser') + + @property + def Machine(self): + return self.SIMPLEEXEC(self.py, 'Machine') + + @property + def OSName(self): + return self.SIMPLEEXEC(self.py, 'OSName') + + @property + def OSPlatform(self): + return self.SIMPLEEXEC(self.py, 'OSPlatform') + + @property + def OSRelease(self): + return self.SIMPLEEXEC(self.py, 'OSRelease') + + @property + def OSVersion(self): + return self.SIMPLEEXEC(self.py, 'OSVersion') + + @property + def Processor(self): + return self.SIMPLEEXEC(self.py, 'Processor') + + @property + def PythonVersion(self): + return self.SIMPLEEXEC(self.py, 'PythonVersion') + + # ######################################################################### + # SF_Region CLASS + # ######################################################################### + class SF_Region(SFServices, metaclass = _Singleton): + """ + The "Region" service gathers a collection of functions about languages, countries and timezones + - Locales + - Currencies + - Numbers and dates formatting + - Calendars + - Timezones conversions + - Numbers transformed to text + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.Region' + servicesynonyms = ('region', 'scriptforge.region') + serviceproperties = dict() + + # Next functions are implemented in Basic as read-only properties with 1 argument + def Country(self, region = ''): + return self.GetProperty('Country', region) + + def Currency(self, region = ''): + return self.GetProperty('Currency', region) + + def DatePatterns(self, region = ''): + return self.GetProperty('DatePatterns', region) + + def DateSeparator(self, region = ''): + return self.GetProperty('DateSeparator', region) + + def DayAbbrevNames(self, region = ''): + return self.GetProperty('DayAbbrevNames', region) + + def DayNames(self, region = ''): + return self.GetProperty('DayNames', region) + + def DayNarrowNames(self, region = ''): + return self.GetProperty('DayNarrowNames', region) + + def DecimalPoint(self, region = ''): + return self.GetProperty('DecimalPoint', region) + + def Language(self, region = ''): + return self.GetProperty('Language', region) + + def ListSeparator(self, region = ''): + return self.GetProperty('ListSeparator', region) + + def MonthAbbrevNames(self, region = ''): + return self.GetProperty('MonthAbbrevNames', region) + + def MonthNames(self, region = ''): + return self.GetProperty('MonthNames', region) + + def MonthNarrowNames(self, region = ''): + return self.GetProperty('MonthNarrowNames', region) + + def ThousandSeparator(self, region = ''): + return self.GetProperty('ThousandSeparator', region) + + def TimeSeparator(self, region = ''): + return self.GetProperty('TimeSeparator', region) + + # Usual methods + def DSTOffset(self, localdatetime, timezone, locale = ''): + if isinstance(localdatetime, datetime.datetime): + localdatetime = SFScriptForge.SF_Basic.CDateToUnoDateTime(localdatetime) + return self.ExecMethod(self.vbMethod + self.flgDateArg, 'DSTOffset', localdatetime, timezone, locale) + + def LocalDateTime(self, utcdatetime, timezone, locale = ''): + if isinstance(utcdatetime, datetime.datetime): + utcdatetime = SFScriptForge.SF_Basic.CDateToUnoDateTime(utcdatetime) + localdate = self.ExecMethod(self.vbMethod + self.flgDateArg + self.flgDateRet, 'LocalDateTime', + utcdatetime, timezone, locale) + return SFScriptForge.SF_Basic.CDateFromUnoDateTime(localdate) + + def Number2Text(self, number, locale = ''): + return self.ExecMethod(self.vbMethod, 'Number2Text', number, locale) + + def TimeZoneOffset(self, timezone, locale = ''): + return self.ExecMethod(self.vbMethod, 'TimeZoneOffset', timezone, locale) + + def UTCDateTime(self, localdatetime, timezone, locale = ''): + if isinstance(localdatetime, datetime.datetime): + localdatetime = SFScriptForge.SF_Basic.CDateToUnoDateTime(localdatetime) + utcdate = self.ExecMethod(self.vbMethod + self.flgDateArg + self.flgDateRet, 'UTCDateTime', localdatetime, + timezone, locale) + return SFScriptForge.SF_Basic.CDateFromUnoDateTime(utcdate) + + def UTCNow(self, timezone, locale = ''): + now = self.ExecMethod(self.vbMethod + self.flgDateRet, 'UTCNow', timezone, locale) + return SFScriptForge.SF_Basic.CDateFromUnoDateTime(now) + + # ######################################################################### + # SF_Session CLASS + # ######################################################################### + class SF_Session(SFServices, metaclass = _Singleton): + """ + The Session service gathers various general-purpose methods about: + - UNO introspection + - the invocation of external scripts or programs + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.Session' + servicesynonyms = ('session', 'scriptforge.session') + serviceproperties = dict() + + # Class constants Where to find an invoked library ? + SCRIPTISEMBEDDED = 'document' # in the document + SCRIPTISAPPLICATION = 'application' # in any shared library (Basic) + SCRIPTISPERSONAL = 'user' # in My Macros (Python) + SCRIPTISPERSOXT = 'user:uno_packages' # in an extension installed for the current user (Python) + SCRIPTISSHARED = 'share' # in LibreOffice macros (Python) + SCRIPTISSHAROXT = 'share:uno_packages' # in an extension installed for all users (Python) + SCRIPTISOXT = 'uno_packages' # in an extension but the installation parameters are unknown (Python) + + @classmethod + def ExecuteBasicScript(cls, scope = '', script = '', *args): + if scope is None or scope == '': + scope = cls.SCRIPTISAPPLICATION + if len(args) == 0: + args = (scope,) + (script,) + (None,) + else: + args = (scope,) + (script,) + args + # ExecuteBasicScript method has a ParamArray parameter in Basic + return cls.SIMPLEEXEC('@SF_Session.ExecuteBasicScript', args) + + @classmethod + def ExecuteCalcFunction(cls, calcfunction, *args): + if len(args) == 0: + # Arguments of Calc functions are strings or numbers. None == Empty is a good alias for no argument + args = (calcfunction,) + (None,) + else: + args = (calcfunction,) + args + # ExecuteCalcFunction method has a ParamArray parameter in Basic + return cls.SIMPLEEXEC('@SF_Session.ExecuteCalcFunction', args) + + @classmethod + def ExecutePythonScript(cls, scope = '', script = '', *args): + return cls.SIMPLEEXEC(scope + '#' + script, *args) + + def HasUnoMethod(self, unoobject, methodname): + return self.ExecMethod(self.vbMethod, 'HasUnoMethod', unoobject, methodname) + + def HasUnoProperty(self, unoobject, propertyname): + return self.ExecMethod(self.vbMethod, 'HasUnoProperty', unoobject, propertyname) + + @classmethod + def OpenURLInBrowser(cls, url): + py = ScriptForge.pythonhelpermodule + '$' + '_SF_Session__OpenURLInBrowser' + return cls.SIMPLEEXEC(py, url) + + def RunApplication(self, command, parameters): + return self.ExecMethod(self.vbMethod, 'RunApplication', command, parameters) + + def SendMail(self, recipient, cc = '', bcc = '', subject = '', body = '', filenames = '', editmessage = True): + return self.ExecMethod(self.vbMethod, 'SendMail', recipient, cc, bcc, subject, body, filenames, editmessage) + + def UnoObjectType(self, unoobject): + return self.ExecMethod(self.vbMethod, 'UnoObjectType', unoobject) + + def UnoMethods(self, unoobject): + return self.ExecMethod(self.vbMethod, 'UnoMethods', unoobject) + + def UnoProperties(self, unoobject): + return self.ExecMethod(self.vbMethod, 'UnoProperties', unoobject) + + def WebService(self, uri): + return self.ExecMethod(self.vbMethod, 'WebService', uri) + + # ######################################################################### + # SF_String CLASS + # ######################################################################### + class SF_String(SFServices, metaclass = _Singleton): + """ + Focus on string manipulation, regular expressions, encodings and hashing algorithms. + The methods implemented in Basic that are redundant with Python builtin functions + are not duplicated + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.String' + servicesynonyms = ('string', 'scriptforge.string') + serviceproperties = dict() + + @classmethod + def HashStr(cls, inputstr, algorithm): + py = ScriptForge.pythonhelpermodule + '$' + '_SF_String__HashStr' + return cls.SIMPLEEXEC(py, inputstr, algorithm.lower()) + + def IsADate(self, inputstr, dateformat = 'YYYY-MM-DD'): + return self.ExecMethod(self.vbMethod, 'IsADate', inputstr, dateformat) + + def IsEmail(self, inputstr): + return self.ExecMethod(self.vbMethod, 'IsEmail', inputstr) + + def IsFileName(self, inputstr, osname = ScriptForge.cstSymEmpty): + return self.ExecMethod(self.vbMethod, 'IsFileName', inputstr, osname) + + def IsIBAN(self, inputstr): + return self.ExecMethod(self.vbMethod, 'IsIBAN', inputstr) + + def IsIPv4(self, inputstr): + return self.ExecMethod(self.vbMethod, 'IsIPv4', inputstr) + + def IsLike(self, inputstr, pattern, casesensitive = False): + return self.ExecMethod(self.vbMethod, 'IsLike', inputstr, pattern, casesensitive) + + def IsSheetName(self, inputstr): + return self.ExecMethod(self.vbMethod, 'IsSheetName', inputstr) + + def IsUrl(self, inputstr): + return self.ExecMethod(self.vbMethod, 'IsUrl', inputstr) + + def SplitNotQuoted(self, inputstr, delimiter = ' ', occurrences = 0, quotechar = '"'): + return self.ExecMethod(self.vbMethod, 'SplitNotQuoted', inputstr, delimiter, occurrences, quotechar) + + def Wrap(self, inputstr, width = 70, tabsize = 8): + return self.ExecMethod(self.vbMethod, 'Wrap', inputstr, width, tabsize) + + # ######################################################################### + # SF_TextStream CLASS + # ######################################################################### + class SF_TextStream(SFServices): + """ + The TextStream service is used to sequentially read from and write to files opened or created + using the ScriptForge.FileSystem service.. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.TextStream' + servicesynonyms = () + serviceproperties = dict(AtEndOfStream = False, Encoding = False, FileName = False, IOMode = False, + Line = False, NewLine = True) + + @property + def AtEndOfStream(self): + return self.GetProperty('AtEndOfStream') + atEndOfStream, atendofstream = AtEndOfStream, AtEndOfStream + + @property + def Line(self): + return self.GetProperty('Line') + line = Line + + def CloseFile(self): + return self.ExecMethod(self.vbMethod, 'CloseFile') + + def ReadAll(self): + return self.ExecMethod(self.vbMethod, 'ReadAll') + + def ReadLine(self): + return self.ExecMethod(self.vbMethod, 'ReadLine') + + def SkipLine(self): + return self.ExecMethod(self.vbMethod, 'SkipLine') + + def WriteBlankLines(self, lines): + return self.ExecMethod(self.vbMethod, 'WriteBlankLines', lines) + + def WriteLine(self, line): + return self.ExecMethod(self.vbMethod, 'WriteLine', line) + + # ######################################################################### + # SF_Timer CLASS + # ######################################################################### + class SF_Timer(SFServices): + """ + The "Timer" service measures the amount of time it takes to run user scripts. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.Timer' + servicesynonyms = ('timer', 'scriptforge.timer') + serviceproperties = dict(Duration = False, IsStarted = False, IsSuspended = False, + SuspendDuration = False, TotalDuration = False) + # Force for each property to get its value from Basic + forceGetProperty = True + + @classmethod + def ReviewServiceArgs(cls, start = False): + """ + Transform positional and keyword arguments into positional only + """ + return (start,) + + def Continue(self): + return self.ExecMethod(self.vbMethod, 'Continue') + + def Restart(self): + return self.ExecMethod(self.vbMethod, 'Restart') + + def Start(self): + return self.ExecMethod(self.vbMethod, 'Start') + + def Suspend(self): + return self.ExecMethod(self.vbMethod, 'Suspend') + + def Terminate(self): + return self.ExecMethod(self.vbMethod, 'Terminate') + + # ######################################################################### + # SF_UI CLASS + # ######################################################################### + class SF_UI(SFServices, metaclass = _Singleton): + """ + Singleton class for the identification and the manipulation of the + different windows composing the whole LibreOffice application: + - Windows selection + - Windows moving and resizing + - Statusbar settings + - Creation of new windows + - Access to the underlying "documents" + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'ScriptForge.UI' + servicesynonyms = ('ui', 'scriptforge.ui') + serviceproperties = dict(ActiveWindow = False, Height = False, Width = False, X = False, Y = False) + + # Class constants + MACROEXECALWAYS, MACROEXECNEVER, MACROEXECNORMAL = 2, 1, 0 + BASEDOCUMENT, CALCDOCUMENT, DRAWDOCUMENT, IMPRESSDOCUMENT, MATHDOCUMENT, WRITERDOCUMENT = \ + 'Base', 'Calc', 'Draw', 'Impress', 'Math', 'Writer' + + @property + def ActiveWindow(self): + return self.ExecMethod(self.vbMethod, 'ActiveWindow') + activeWindow, activewindow = ActiveWindow, ActiveWindow + + def Activate(self, windowname = ''): + return self.ExecMethod(self.vbMethod, 'Activate', windowname) + + def CreateBaseDocument(self, filename, embeddeddatabase = 'HSQLDB', registrationname = '', calcfilename = ''): + return self.ExecMethod(self.vbMethod, 'CreateBaseDocument', filename, embeddeddatabase, registrationname, + calcfilename) + + def CreateDocument(self, documenttype = '', templatefile = '', hidden = False): + return self.ExecMethod(self.vbMethod, 'CreateDocument', documenttype, templatefile, hidden) + + def Documents(self): + return self.ExecMethod(self.vbMethod, 'Documents') + + def GetDocument(self, windowname = ''): + return self.ExecMethod(self.vbMethod, 'GetDocument', windowname) + + def Maximize(self, windowname = ''): + return self.ExecMethod(self.vbMethod, 'Maximize', windowname) + + def Minimize(self, windowname = ''): + return self.ExecMethod(self.vbMethod, 'Minimize', windowname) + + def OpenBaseDocument(self, filename = '', registrationname = '', macroexecution = MACROEXECNORMAL): + return self.ExecMethod(self.vbMethod, 'OpenBaseDocument', filename, registrationname, macroexecution) + + def OpenDocument(self, filename, password = '', readonly = False, hidden = False, + macroexecution = MACROEXECNORMAL, filtername = '', filteroptions = ''): + return self.ExecMethod(self.vbMethod, 'OpenDocument', filename, password, readonly, hidden, + macroexecution, filtername, filteroptions) + + def Resize(self, left = -1, top = -1, width = -1, height = -1): + return self.ExecMethod(self.vbMethod, 'Resize', left, top, width, height) + + def RunCommand(self, command, *args, **kwargs): + params = tuple(list(args) + ScriptForge.unpack_args(kwargs)) + if len(params) == 0: + params = (command,) + (None,) + else: + params = (command,) + params + return self.SIMPLEEXEC('@SF_UI.RunCommand', params) + + def SetStatusbar(self, text = '', percentage = -1): + return self.ExecMethod(self.vbMethod, 'SetStatusbar', text, percentage) + + def ShowProgressBar(self, title = '', text = '', percentage = -1): + # From Python, the current XComponentContext must be added as last argument + return self.ExecMethod(self.vbMethod, 'ShowProgressBar', title, text, percentage, + ScriptForge.componentcontext) + + def WindowExists(self, windowname): + return self.ExecMethod(self.vbMethod, 'WindowExists', windowname) + + +# ##################################################################################################################### +# SFDatabases CLASS (alias of SFDatabases Basic library) ### +# ##################################################################################################################### +class SFDatabases: + """ + The SFDatabases class manages databases embedded in or connected to Base documents + """ + pass + + # ######################################################################### + # SF_Database CLASS + # ######################################################################### + class SF_Database(SFServices): + """ + Each instance of the current class represents a single database, with essentially its tables, queries + and data + The exchanges with the database are done in SQL only. + To make them more readable, use optionally square brackets to surround table/query/field names + instead of the (RDBMS-dependent) normal surrounding character. + SQL statements may be run in direct or indirect mode. In direct mode the statement is transferred literally + without syntax checking nor review to the database engine. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDatabases.Database' + servicesynonyms = ('database', 'sfdatabases.database') + serviceproperties = dict(Queries = False, Tables = False, XConnection = False, XMetaData = False) + + @classmethod + def ReviewServiceArgs(cls, filename = '', registrationname = '', readonly = True, user = '', password = ''): + """ + Transform positional and keyword arguments into positional only + """ + return filename, registrationname, readonly, user, password + + def CloseDatabase(self): + return self.ExecMethod(self.vbMethod, 'CloseDatabase') + + def DAvg(self, expression, tablename, criteria = ''): + return self.ExecMethod(self.vbMethod, 'DAvg', expression, tablename, criteria) + + def DCount(self, expression, tablename, criteria = ''): + return self.ExecMethod(self.vbMethod, 'DCount', expression, tablename, criteria) + + def DLookup(self, expression, tablename, criteria = '', orderclause = ''): + return self.ExecMethod(self.vbMethod, 'DLookup', expression, tablename, criteria, orderclause) + + def DMax(self, expression, tablename, criteria = ''): + return self.ExecMethod(self.vbMethod, 'DMax', expression, tablename, criteria) + + def DMin(self, expression, tablename, criteria = ''): + return self.ExecMethod(self.vbMethod, 'DMin', expression, tablename, criteria) + + def DSum(self, expression, tablename, criteria = ''): + return self.ExecMethod(self.vbMethod, 'DSum', expression, tablename, criteria) + + def GetRows(self, sqlcommand, directsql = False, header = False, maxrows = 0): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'GetRows', sqlcommand, directsql, header, maxrows) + + def RunSql(self, sqlcommand, directsql = False): + return self.ExecMethod(self.vbMethod, 'RunSql', sqlcommand, directsql) + + +# ##################################################################################################################### +# SFDialogs CLASS (alias of SFDialogs Basic library) ### +# ##################################################################################################################### +class SFDialogs: + """ + The SFDialogs class manages dialogs defined with the Basic IDE + """ + pass + + # ######################################################################### + # SF_Dialog CLASS + # ######################################################################### + class SF_Dialog(SFServices): + """ + Each instance of the current class represents a single dialog box displayed to the user. + The dialog box must have been designed and defined with the Basic IDE previously. + From a Python script, a dialog box can be displayed in modal or in non-modal modes. + + In modal mode, the box is displayed and the execution of the macro process is suspended + until one of the OK or Cancel buttons is pressed. In the meantime, other user actions + executed on the box can trigger specific actions. + + In non-modal mode, the floating dialog remains displayed until the dialog is terminated + by code (Terminate()) or until the LibreOffice application stops. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDialogs.Dialog' + servicesynonyms = ('dialog', 'sfdialogs.dialog') + serviceproperties = dict(Caption = True, Height = True, Modal = False, Name = False, + OnFocusGained = False, OnFocusLost = False, OnKeyPressed = False, + OnKeyReleased = False, OnMouseDragged = False, OnMouseEntered = False, + OnMouseExited = False, OnMouseMoved = False, OnMousePressed = False, + OnMouseReleased = False, + Page = True, Visible = True, Width = True, XDialogModel = False, XDialogView = False) + # Class constants used together with the Execute() method + OKBUTTON, CANCELBUTTON = 1, 0 + + @classmethod + def ReviewServiceArgs(cls, container = '', library = 'Standard', dialogname = ''): + """ + Transform positional and keyword arguments into positional only + Add the XComponentContext as last argument + """ + return container, library, dialogname, ScriptForge.componentcontext + + # Methods potentially executed while the dialog is in execution require the flgHardCode flag + def Activate(self): + return self.ExecMethod(self.vbMethod + self.flgHardCode, 'Activate') + + def Center(self, parent = ScriptForge.cstSymMissing): + parentclasses = (SFDocuments.SF_Document, SFDocuments.SF_Base, SFDocuments.SF_Calc, SFDocuments.SF_Writer, + SFDialogs.SF_Dialog) + parentobj = parent.objectreference if isinstance(parent, parentclasses) else parent + return self.ExecMethod(self.vbMethod + self.flgObject + self.flgHardCode, 'Center', parentobj) + + def Controls(self, controlname = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet + self.flgHardCode, 'Controls', controlname) + + def EndExecute(self, returnvalue): + return self.ExecMethod(self.vbMethod + self.flgHardCode, 'EndExecute', returnvalue) + + def Execute(self, modal = True): + return self.ExecMethod(self.vbMethod + self.flgHardCode, 'Execute', modal) + + def GetTextsFromL10N(self, l10n): + l10nobj = l10n.objectreference if isinstance(l10n, SFScriptForge.SF_L10N) else l10n + return self.ExecMethod(self.vbMethod + self.flgObject, 'GetTextsFromL10N', l10nobj) + + def Resize(self, left = -1, top = -1, width = -1, height = -1): + return self.ExecMethod(self.vbMethod + self.flgHardCode, 'Resize', left, top, width, height) + + def Terminate(self): + return self.ExecMethod(self.vbMethod, 'Terminate') + + # ######################################################################### + # SF_DialogControl CLASS + # ######################################################################### + class SF_DialogControl(SFServices): + """ + Each instance of the current class represents a single control within a dialog box. + The focus is clearly set on getting and setting the values displayed by the controls of the dialog box, + not on their formatting. + A special attention is given to controls with type TreeControl. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDialogs.DialogControl' + servicesynonyms = () + serviceproperties = dict(Cancel = True, Caption = True, ControlType = False, CurrentNode = True, + Default = True, Enabled = True, Format = True, ListCount = False, + ListIndex = True, Locked = True, MultiSelect = True, Name = False, + OnActionPerformed = False, OnAdjustmentValueChanged = False, OnFocusGained = False, + OnFocusLost = False, OnItemStateChanged = False, OnKeyPressed = False, + OnKeyReleased = False, OnMouseDragged = False, OnMouseEntered = False, + OnMouseExited = False, OnMouseMoved = False, OnMousePressed = False, + OnMouseReleased = False, OnNodeExpanded = True, OnNodeSelected = True, + OnTextChanged = False, Page = True, Parent = False, Picture = True, + RootNode = False, RowSource = True, Text = False, TipText = True, + TripleState = True, Value = True, Visible = True, + XControlModel = False, XControlView = False, XGridColumnModel = False, + XGridDataModel = False, XTreeDataModel = False) + + # Root related properties do not start with X and, nevertheless, return a UNO object + @property + def CurrentNode(self): + return self.EXEC(self.objectreference, self.vbGet + self.flgUno, 'CurrentNode') + + @property + def RootNode(self): + return self.EXEC(self.objectreference, self.vbGet + self.flgUno, 'RootNode') + + def AddSubNode(self, parentnode, displayvalue, datavalue = ScriptForge.cstSymEmpty): + return self.ExecMethod(self.vbMethod + self.flgUno, 'AddSubNode', parentnode, displayvalue, datavalue) + + def AddSubTree(self, parentnode, flattree, withdatavalue = False): + return self.ExecMethod(self.vbMethod, 'AddSubTree', parentnode, flattree, withdatavalue) + + def CreateRoot(self, displayvalue, datavalue = ScriptForge.cstSymEmpty): + return self.ExecMethod(self.vbMethod + self.flgUno, 'CreateRoot', displayvalue, datavalue) + + def FindNode(self, displayvalue, datavalue = ScriptForge.cstSymEmpty, casesensitive = False): + return self.ExecMethod(self.vbMethod + self.flgUno, 'FindNode', displayvalue, datavalue, casesensitive) + + def SetFocus(self): + return self.ExecMethod(self.vbMethod, 'SetFocus') + + def SetTableData(self, dataarray, widths = (1,), alignments = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetTableData', dataarray, widths, alignments) + + def WriteLine(self, line = ''): + return self.ExecMethod(self.vbMethod, 'WriteLine', line) + + +# ##################################################################################################################### +# SFDocuments CLASS (alias of SFDocuments Basic library) ### +# ##################################################################################################################### +class SFDocuments: + """ + The SFDocuments class gathers a number of classes, methods and properties making easy + managing and manipulating LibreOffice documents + """ + pass + + # ######################################################################### + # SF_Document CLASS + # ######################################################################### + class SF_Document(SFServices): + """ + The methods and properties are generic for all types of documents: they are combined in the + current SF_Document class + - saving, closing documents + - accessing their standard or custom properties + Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ... + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.Document' + servicesynonyms = ('document', 'sfdocuments.document') + serviceproperties = dict(Description = True, DocumentType = False, ExportFilters = False, ImportFilters = False, + IsBase = False, IsCalc = False, IsDraw = False, IsImpress = False, IsMath = False, + IsWriter = False, Keywords = True, Readonly = False, Subject = True, Title = True, + XComponent = False) + # Force for each property to get its value from Basic - due to intense interactivity with user + forceGetProperty = True + + @classmethod + def ReviewServiceArgs(cls, windowname = ''): + """ + Transform positional and keyword arguments into positional only + """ + return windowname, + + def Activate(self): + return self.ExecMethod(self.vbMethod, 'Activate') + + def CloseDocument(self, saveask = True): + return self.ExecMethod(self.vbMethod, 'CloseDocument', saveask) + + def CreateMenu(self, menuheader, before = '', submenuchar = '>'): + return self.ExecMethod(self.vbMethod, 'CreateMenu', menuheader, before, submenuchar) + + def ExportAsPDF(self, filename, overwrite = False, pages = '', password = '', watermark = ''): + return self.ExecMethod(self.vbMethod, 'ExportAsPDF', filename, overwrite, pages, password, watermark) + + def PrintOut(self, pages = '', copies = 1): + return self.ExecMethod(self.vbMethod, 'PrintOut', pages, copies) + + def RemoveMenu(self, menuheader): + return self.ExecMethod(self.vbMethod, 'RemoveMenu', menuheader) + + def RunCommand(self, command, *args, **kwargs): + params = tuple([command] + list(args) + ScriptForge.unpack_args(kwargs)) + return self.ExecMethod(self.vbMethod, 'RunCommand', *params) + + def Save(self): + return self.ExecMethod(self.vbMethod, 'Save') + + def SaveAs(self, filename, overwrite = False, password = '', filtername = '', filteroptions = ''): + return self.ExecMethod(self.vbMethod, 'SaveAs', filename, overwrite, password, filtername, filteroptions) + + def SaveCopyAs(self, filename, overwrite = False, password = '', filtername = '', filteroptions = ''): + return self.ExecMethod(self.vbMethod, 'SaveCopyAs', filename, overwrite, + password, filtername, filteroptions) + + def SetPrinter(self, printer = '', orientation = '', paperformat = ''): + return self.ExecMethod(self.vbMethod, 'SetPrinter', printer, orientation, paperformat) + + # ######################################################################### + # SF_Base CLASS + # ######################################################################### + class SF_Base(SF_Document, SFServices): + """ + The SF_Base module is provided mainly to block parent properties that are NOT applicable to Base documents + In addition, it provides methods to identify form documents and access their internal forms + (read more elsewhere (the "SFDocuments.Form" service) about this subject) + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.Base' + servicesynonyms = ('base', 'scriptforge.base') + serviceproperties = dict(DocumentType = False, IsBase = False, IsCalc = False, + IsDraw = False, IsImpress = False, IsMath = False, IsWriter = False, + XComponent = False) + + @classmethod + def ReviewServiceArgs(cls, windowname = ''): + """ + Transform positional and keyword arguments into positional only + """ + return windowname, + + def CloseDocument(self, saveask = True): + return self.ExecMethod(self.vbMethod, 'CloseDocument', saveask) + + def CloseFormDocument(self, formdocument): + return self.ExecMethod(self.vbMethod, 'CloseFormDocument', formdocument) + + def FormDocuments(self): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'FormDocuments') + + def Forms(self, formdocument, form = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Forms', formdocument, form) + + def GetDatabase(self, user = '', password = ''): + return self.ExecMethod(self.vbMethod, 'GetDatabase', user, password) + + def IsLoaded(self, formdocument): + return self.ExecMethod(self.vbMethod, 'IsLoaded', formdocument) + + def OpenFormDocument(self, formdocument, designmode = False): + return self.ExecMethod(self.vbMethod, 'OpenFormDocument', formdocument, designmode) + + def PrintOut(self, formdocument, pages = '', copies = 1): + return self.ExecMethod(self.vbMethod, 'PrintOut', formdocument, pages, copies) + + def SetPrinter(self, formdocument = '', printer = '', orientation = '', paperformat = ''): + return self.ExecMethod(self.vbMethod, 'SetPrinter', formdocument, printer, orientation, paperformat) + + # ######################################################################### + # SF_Calc CLASS + # ######################################################################### + class SF_Calc(SF_Document, SFServices): + """ + The SF_Calc module is focused on : + - management (copy, insert, move, ...) of sheets within a Calc document + - exchange of data between Basic data structures and Calc ranges of values + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.Calc' + servicesynonyms = ('calc', 'sfdocuments.calc') + serviceproperties = dict(CurrentSelection = True, Sheets = False, + Description = True, DocumentType = False, ExportFilters = False, ImportFilters = False, + IsBase = False, IsCalc = False, IsDraw = False, IsImpress = False, IsMath = False, + IsWriter = False, Keywords = True, Readonly = False, Subject = True, Title = True, + XComponent = False) + # Force for each property to get its value from Basic - due to intense interactivity with user + forceGetProperty = True + + @classmethod + def ReviewServiceArgs(cls, windowname = ''): + """ + Transform positional and keyword arguments into positional only + """ + return windowname, + + # Next functions are implemented in Basic as read-only properties with 1 argument + def FirstCell(self, rangename): + return self.GetProperty('FirstCell', rangename) + + def FirstColumn(self, rangename): + return self.GetProperty('FirstColumn', rangename) + + def FirstRow(self, rangename): + return self.GetProperty('FirstRow', rangename) + + def Height(self, rangename): + return self.GetProperty('Height', rangename) + + def LastCell(self, rangename): + return self.GetProperty('LastCell', rangename) + + def LastColumn(self, rangename): + return self.GetProperty('LastColumn', rangename) + + def LastRow(self, rangename): + return self.GetProperty('LastRow', rangename) + + def Range(self, rangename): + return self.GetProperty('Range', rangename) + + def Region(self, rangename): + return self.GetProperty('Region', rangename) + + def Sheet(self, sheetname): + return self.GetProperty('Sheet', sheetname) + + def SheetName(self, rangename): + return self.GetProperty('SheetName', rangename) + + def Width(self, rangename): + return self.GetProperty('Width', rangename) + + def XCellRange(self, rangename): + return self.ExecMethod(self.vbGet + self.flgUno, 'XCellRange', rangename) + + def XSheetCellCursor(self, rangename): + return self.ExecMethod(self.vbGet + self.flgUno, 'XSheetCellCursor', rangename) + + def XSpreadsheet(self, sheetname): + return self.ExecMethod(self.vbGet + self.flgUno, 'XSpreadsheet', sheetname) + + # Usual methods + def A1Style(self, row1, column1, row2 = 0, column2 = 0, sheetname = '~'): + return self.ExecMethod(self.vbMethod, 'A1Style', row1, column1, row2, column2, sheetname) + + def Activate(self, sheetname = ''): + return self.ExecMethod(self.vbMethod, 'Activate', sheetname) + + def Charts(self, sheetname, chartname = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Charts', sheetname, chartname) + + def ClearAll(self, range): + return self.ExecMethod(self.vbMethod, 'ClearAll', range) + + def ClearFormats(self, range): + return self.ExecMethod(self.vbMethod, 'ClearFormats', range) + + def ClearValues(self, range): + return self.ExecMethod(self.vbMethod, 'ClearValues', range) + + def CompactLeft(self, range, wholecolumn = False, filterformula = ''): + return self.ExecMethod(self.vbMethod, 'CompactLeft', range, wholecolumn, filterformula) + + def CompactUp(self, range, wholerow = False, filterformula = ''): + return self.ExecMethod(self.vbMethod, 'CompactUp', range, wholerow, filterformula) + + def CopySheet(self, sheetname, newname, beforesheet = 32768): + sheet = (sheetname.objectreference if isinstance(sheetname, SFDocuments.SF_CalcReference) else sheetname) + return self.ExecMethod(self.vbMethod + self.flgObject, 'CopySheet', sheet, newname, beforesheet) + + def CopySheetFromFile(self, filename, sheetname, newname, beforesheet = 32768): + sheet = (sheetname.objectreference if isinstance(sheetname, SFDocuments.SF_CalcReference) else sheetname) + return self.ExecMethod(self.vbMethod + self.flgObject, 'CopySheetFromFile', + filename, sheet, newname, beforesheet) + + def CopyToCell(self, sourcerange, destinationcell): + range = (sourcerange.objectreference if isinstance(sourcerange, SFDocuments.SF_CalcReference) + else sourcerange) + return self.ExecMethod(self.vbMethod + self.flgObject, 'CopyToCell', range, destinationcell) + + def CopyToRange(self, sourcerange, destinationrange): + range = (sourcerange.objectreference if isinstance(sourcerange, SFDocuments.SF_CalcReference) + else sourcerange) + return self.ExecMethod(self.vbMethod + self.flgObject, 'CopyToRange', range, destinationrange) + + def CreateChart(self, chartname, sheetname, range, columnheader = False, rowheader = False): + return self.ExecMethod(self.vbMethod, 'CreateChart', chartname, sheetname, range, columnheader, rowheader) + + def CreatePivotTable(self, pivottablename, sourcerange, targetcell, datafields = ScriptForge.cstSymEmpty, + rowfields = ScriptForge.cstSymEmpty, columnfields = ScriptForge.cstSymEmpty, + filterbutton = True, rowtotals = True, columntotals = True): + return self.ExecMethod(self.vbMethod, 'CreatePivotTable', pivottablename, sourcerange, targetcell, + datafields, rowfields, columnfields, filterbutton, rowtotals, columntotals) + + def DAvg(self, range): + return self.ExecMethod(self.vbMethod, 'DAvg', range) + + def DCount(self, range): + return self.ExecMethod(self.vbMethod, 'DCount', range) + + def DMax(self, range): + return self.ExecMethod(self.vbMethod, 'DMax', range) + + def DMin(self, range): + return self.ExecMethod(self.vbMethod, 'DMin', range) + + def DSum(self, range): + return self.ExecMethod(self.vbMethod, 'DSum', range) + + def ExportRangeToFile(self, range, filename, imagetype = 'pdf', overwrite = False): + return self.ExecMethod(self.vbMethod, 'ExportRangeToFile', range, filename, imagetype, overwrite) + + def Forms(self, sheetname, form = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Forms', sheetname, form) + + def GetColumnName(self, columnnumber): + return self.ExecMethod(self.vbMethod, 'GetColumnName', columnnumber) + + def GetFormula(self, range): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'GetFormula', range) + + def GetValue(self, range): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'GetValue', range) + + def ImportFromCSVFile(self, filename, destinationcell, filteroptions = ScriptForge.cstSymEmpty): + return self.ExecMethod(self.vbMethod, 'ImportFromCSVFile', filename, destinationcell, filteroptions) + + def ImportFromDatabase(self, filename = '', registrationname = '', destinationcell = '', sqlcommand = '', + directsql = False): + return self.ExecMethod(self.vbMethod, 'ImportFromDatabase', filename, registrationname, + destinationcell, sqlcommand, directsql) + + def InsertSheet(self, sheetname, beforesheet = 32768): + return self.ExecMethod(self.vbMethod, 'InsertSheet', sheetname, beforesheet) + + def MoveRange(self, source, destination): + return self.ExecMethod(self.vbMethod, 'MoveRange', source, destination) + + def MoveSheet(self, sheetname, beforesheet = 32768): + return self.ExecMethod(self.vbMethod, 'MoveSheet', sheetname, beforesheet) + + def Offset(self, range, rows = 0, columns = 0, height = ScriptForge.cstSymEmpty, + width = ScriptForge.cstSymEmpty): + return self.ExecMethod(self.vbMethod, 'Offset', range, rows, columns, height, width) + + def OpenRangeSelector(self, title = '', selection = '~', singlecell = False, closeafterselect = True): + return self.ExecMethod(self.vbMethod, 'OpenRangeSelector', title, selection, singlecell, closeafterselect) + + def Printf(self, inputstr, range, tokencharacter = '%'): + return self.ExecMethod(self.vbMethod, 'Printf', inputstr, range, tokencharacter) + + def PrintOut(self, sheetname = '~', pages = '', copies = 1): + return self.ExecMethod(self.vbMethod, 'PrintOut', sheetname, pages, copies) + + def RemoveSheet(self, sheetname): + return self.ExecMethod(self.vbMethod, 'RemoveSheet', sheetname) + + def RenameSheet(self, sheetname, newname): + return self.ExecMethod(self.vbMethod, 'RenameSheet', sheetname, newname) + + def SetArray(self, targetcell, value): + return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetArray', targetcell, value) + + def SetCellStyle(self, targetrange, style): + return self.ExecMethod(self.vbMethod, 'SetCellStyle', targetrange, style) + + def SetFormula(self, targetrange, formula): + return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetFormula', targetrange, formula) + + def SetValue(self, targetrange, value): + return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetValue', targetrange, value) + + def ShiftDown(self, range, wholerow = False, rows = 0): + return self.ExecMethod(self.vbMethod, 'ShiftDown', range, wholerow, rows) + + def ShiftLeft(self, range, wholecolumn = False, columns = 0): + return self.ExecMethod(self.vbMethod, 'ShiftLeft', range, wholecolumn, columns) + + def ShiftRight(self, range, wholecolumn = False, columns = 0): + return self.ExecMethod(self.vbMethod, 'ShiftRight', range, wholecolumn, columns) + + def ShiftUp(self, range, wholerow = False, rows = 0): + return self.ExecMethod(self.vbMethod, 'ShiftUp', range, wholerow, rows) + + def SortRange(self, range, sortkeys, sortorder = 'ASC', destinationcell = ScriptForge.cstSymEmpty, + containsheader = False, casesensitive = False, sortcolumns = False): + return self.ExecMethod(self.vbMethod, 'SortRange', range, sortkeys, sortorder, destinationcell, + containsheader, casesensitive, sortcolumns) + + # ######################################################################### + # SF_CalcReference CLASS + # ######################################################################### + class SF_CalcReference(SFServices): + """ + The SF_CalcReference class has as unique role to hold sheet and range references. + They are implemented in Basic as Type ... End Type data structures + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.CalcReference' + servicesynonyms = () + serviceproperties = dict() + + # ######################################################################### + # SF_Chart CLASS + # ######################################################################### + class SF_Chart(SFServices): + """ + The SF_Chart module is focused on the description of chart documents + stored in Calc sheets. + With this service, many chart types and chart characteristics available + in the user interface can be read or modified. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.Chart' + servicesynonyms = () + serviceproperties = dict(ChartType = True, Deep = True, Dim3D = True, Exploded = True, Filled = True, + Legend = True, Percent = True, Stacked = True, Title = True, + XChartObj = False, XDiagram = False, XShape = False, XTableChart = False, + XTitle = True, YTitle = True) + + def Resize(self, xpos = -1, ypos = -1, width = -1, height = -1): + return self.ExecMethod(self.vbMethod, 'Resize', xpos, ypos, width, height) + + def ExportToFile(self, filename, imagetype = 'png', overwrite = False): + return self.ExecMethod(self.vbMethod, 'ExportToFile', filename, imagetype, overwrite) + + # ######################################################################### + # SF_Form CLASS + # ######################################################################### + class SF_Form(SFServices): + """ + Management of forms defined in LibreOffice documents. Supported types are Base, Calc and Writer documents. + It includes the management of subforms + Each instance of the current class represents a single form or a single subform + A form may optionally be (understand "is often") linked to a data source manageable with + the SFDatabases.Database service. The current service offers a rapid access to that service. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.Form' + servicesynonyms = () + serviceproperties = dict(AllowDeletes = True, AllowInserts = True, AllowUpdates = True, BaseForm = False, + Bookmark = True, CurrentRecord = True, Filter = True, LinkChildFields = False, + LinkParentFields = False, Name = False, + OnApproveCursorMove = True, OnApproveParameter = True, OnApproveReset = True, + OnApproveRowChange = True, OnApproveSubmit = True, OnConfirmDelete = True, + OnCursorMoved = True, OnErrorOccurred = True, OnLoaded = True, OnReloaded = True, + OnReloading = True, OnResetted = True, OnRowChanged = True, OnUnloaded = True, + OnUnloading = True, + OrderBy = True, Parent = False, RecordSource = True, XForm = False) + + def Activate(self): + return self.ExecMethod(self.vbMethod, 'Activate') + + def CloseFormDocument(self): + return self.ExecMethod(self.vbMethod, 'CloseFormDocument') + + def Controls(self, controlname = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Controls', controlname) + + def GetDatabase(self, user = '', password = ''): + return self.ExecMethod(self.vbMethod, 'GetDatabase', user, password) + + def MoveFirst(self): + return self.ExecMethod(self.vbMethod, 'MoveFirst') + + def MoveLast(self): + return self.ExecMethod(self.vbMethod, 'MoveLast') + + def MoveNew(self): + return self.ExecMethod(self.vbMethod, 'MoveNew') + + def MoveNext(self, offset = 1): + return self.ExecMethod(self.vbMethod, 'MoveNext', offset) + + def MovePrevious(self, offset = 1): + return self.ExecMethod(self.vbMethod, 'MovePrevious', offset) + + def Requery(self): + return self.ExecMethod(self.vbMethod, 'Requery') + + def Subforms(self, subform = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Subforms', subform) + + # ######################################################################### + # SF_FormControl CLASS + # ######################################################################### + class SF_FormControl(SFServices): + """ + Manage the controls belonging to a form or subform stored in a document. + Each instance of the current class represents a single control within a form, a subform or a tablecontrol. + A prerequisite is that all controls within the same form, subform or tablecontrol must have + a unique name. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.FormControl' + servicesynonyms = () + serviceproperties = dict(Action = True, Caption = True, ControlSource = False, ControlType = False, + Default = True, DefaultValue = True, Enabled = True, Format = True, + ListCount = False, ListIndex = True, ListSource = True, ListSourceType = True, + Locked = True, MultiSelect = True, Name = False, + OnActionPerformed = True, OnAdjustmentValueChanged = True, + OnApproveAction = True, OnApproveReset = True, OnApproveUpdate = True, + OnChanged = True, OnErrorOccurred = True, OnFocusGained = True, OnFocusLost = True, + OnItemStateChanged = True, OnKeyPressed = True, OnKeyReleased = True, + OnMouseDragged = True, OnMouseEntered = True, OnMouseExited = True, + OnMouseMoved = True, OnMousePressed = True, OnMouseReleased = True, OnResetted = True, + OnTextChanged = True, OnUpdated = True, Parent = False, Picture = True, + Required = True, Text = False, TipText = True, TripleState = True, Value = True, + Visible = True, XControlModel = False, XControlView = False) + + def Controls(self, controlname = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Controls', controlname) + + def SetFocus(self): + return self.ExecMethod(self.vbMethod, 'SetFocus') + + # ######################################################################### + # SF_Writer CLASS + # ######################################################################### + class SF_Writer(SF_Document, SFServices): + """ + The SF_Writer module is focused on : + - TBD + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFDocuments.Writer' + servicesynonyms = ('writer', 'sfdocuments.writer') + serviceproperties = dict(Description = True, DocumentType = False, ExportFilters = False, ImportFilters = False, + IsBase = False, IsCalc = False, IsDraw = False, IsImpress = False, IsMath = False, + IsWriter = False, Keywords = True, Readonly = False, Subject = True, Title = True, + XComponent = False) + # Force for each property to get its value from Basic - due to intense interactivity with user + forceGetProperty = True + + @classmethod + def ReviewServiceArgs(cls, windowname = ''): + """ + Transform positional and keyword arguments into positional only + """ + return windowname, + + def Forms(self, form = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayRet, 'Forms', form) + + def PrintOut(self, pages = '', copies = 1, printbackground = True, printblankpages = False, + printevenpages = True, printoddpages = True, printimages = True): + return self.ExecMethod(self.vbMethod, 'PrintOut', pages, copies, printbackground, printblankpages, + printevenpages, printoddpages, printimages) + + +# ##################################################################################################################### +# SFWidgets CLASS (alias of SFWidgets Basic library) ### +# ##################################################################################################################### +class SFWidgets: + """ + The SFWidgets class manages toolbars and popup menus + """ + pass + + # ######################################################################### + # SF_Menu CLASS + # ######################################################################### + class SF_Menu(SFServices): + """ + Display a menu in the menubar of a document or a form document. + After use, the menu will not be saved neither in the application settings, nor in the document. + The menu will be displayed, as usual, when its header in the menubar is clicked. + When one of its items is selected, there are 3 alternative options: + - a UNO command (like ".uno:About") is triggered + - a user script is run receiving a standard argument defined in this service + - one of above combined with a toggle of the status of the item + The menu is described from top to bottom. Each menu item receives a numeric and a string identifier. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFWidgets.Menu' + servicesynonyms = ('menu', 'sfwidgets.menu') + serviceproperties = dict(ShortcutCharacter = False, SubmenuCharacter = False) + + def AddCheckBox(self, menuitem, name = '', status = False, icon = '', tooltip = '', + command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddCheckBox', menuitem, name, status, icon, tooltip, + command, script) + + def AddItem(self, menuitem, name = '', icon = '', tooltip = '', command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddItem', menuitem, name, icon, tooltip, command, script) + + def AddRadioButton(self, menuitem, name = '', status = False, icon = '', tooltip = '', + command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddRadioButton', menuitem, name, status, icon, tooltip, + command, script) + + # ######################################################################### + # SF_PopupMenu CLASS + # ######################################################################### + class SF_PopupMenu(SFServices): + """ + Display a popup menu anywhere and any time. + A popup menu is usually triggered by a mouse action (typically a right-click) on a dialog, a form + or one of their controls. In this case the menu will be displayed below the clicked area. + When triggered by other events, including in the normal flow of a user script, the script should + provide the coordinates of the topleft edge of the menu versus the actual component. + The menu is described from top to bottom. Each menu item receives a numeric and a string identifier. + The execute() method returns the item selected by the user. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFWidgets.PopupMenu' + servicesynonyms = ('popupmenu', 'sfwidgets.popupmenu') + serviceproperties = dict(ShortcutCharacter = False, SubmenuCharacter = False) + + @classmethod + def ReviewServiceArgs(cls, event = None, x = 0, y = 0, submenuchar = ''): + """ + Transform positional and keyword arguments into positional only + """ + return event, x, y, submenuchar + + def AddCheckBox(self, menuitem, name = '', status = False, icon = '', tooltip = ''): + return self.ExecMethod(self.vbMethod, 'AddCheckBox', menuitem, name, status, icon, tooltip) + + def AddItem(self, menuitem, name = '', icon = '', tooltip = ''): + return self.ExecMethod(self.vbMethod, 'AddItem', menuitem, name, icon, tooltip) + + def AddRadioButton(self, menuitem, name = '', status = False, icon = '', tooltip = ''): + return self.ExecMethod(self.vbMethod, 'AddRadioButton', menuitem, name, status, icon, tooltip) + + def Execute(self, returnid = True): + return self.ExecMethod(self.vbMethod, 'Execute', returnid) + + +# ##############################################False################################################################## +# CreateScriptService() ### +# ##################################################################################################################### +def CreateScriptService(service, *args, **kwargs): + """ + A service being the name of a collection of properties and methods, + this method returns either + - the Python object mirror of the Basic object implementing the requested service + - the Python object implementing the service itself + + A service may be designated by its official name, stored in its class.servicename + or by one of its synonyms stored in its class.servicesynonyms list + If the service is not identified, the service creation is delegated to Basic, that might raise an error + if still not identified there + + :param service: the name of the service as a string 'library.service' - cased exactly + or one of its synonyms + :param args: the arguments to pass to the service constructor + :return: the service as a Python object + """ + # Init at each CreateScriptService() invocation + # CreateScriptService is usually the first statement in user scripts requesting ScriptForge services + # ScriptForge() is optional in user scripts when Python process inside LibreOffice process + if ScriptForge.SCRIPTFORGEINITDONE is False: + ScriptForge() + + def ResolveSynonyms(servicename): + """ + Synonyms within service names implemented in Python or predefined are resolved here + :param servicename: The short name of the service + :return: The official service name if found, the argument otherwise + """ + for cls in SFServices.__subclasses__(): + if servicename.lower() in cls.servicesynonyms: + return cls.servicename + return servicename + + # + # Check the list of available services + scriptservice = ResolveSynonyms(service) + if scriptservice in ScriptForge.serviceslist: + serv = ScriptForge.serviceslist[scriptservice] + # Check if the requested service is within the Python world + if serv.serviceimplementation == 'python': + return serv(*args) + # Check if the service is a predefined standard Basic service + elif scriptservice in ScriptForge.servicesmodules: + return serv(ScriptForge.servicesmodules[scriptservice], classmodule = SFServices.moduleStandard) + else: + serv = None + # The requested service is to be found in the Basic world + # Check if the service must review the arguments + if serv is not None: + if hasattr(serv, 'ReviewServiceArgs'): + # ReviewServiceArgs() must be a class method + args = serv.ReviewServiceArgs(*args, **kwargs) + # Get the service object back from Basic + if len(args) == 0: + serv = ScriptForge.InvokeBasicService('SF_Services', SFServices.vbMethod, 'CreateScriptService', service) + else: + serv = ScriptForge.InvokeBasicService('SF_Services', SFServices.vbMethod, 'CreateScriptService', + service, *args) + return serv + + +createScriptService, createscriptservice = CreateScriptService, CreateScriptService + + +# ###################################################################### +# Lists the scripts, that shall be visible inside the Basic/Python IDE +# ###################################################################### + +g_exportedScripts = () diff --git a/wizards/source/scriptforge/script.xlb b/wizards/source/scriptforge/script.xlb new file mode 100644 index 000000000..dc625046f --- /dev/null +++ b/wizards/source/scriptforge/script.xlb @@ -0,0 +1,23 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="ScriptForge" library:readonly="false" library:passwordprotected="false"> + <library:element library:name="__License"/> + <library:element library:name="SF_String"/> + <library:element library:name="_CodingConventions"/> + <library:element library:name="SF_Timer"/> + <library:element library:name="_ModuleModel"/> + <library:element library:name="SF_Utils"/> + <library:element library:name="SF_Root"/> + <library:element library:name="SF_Array"/> + <library:element library:name="SF_Services"/> + <library:element library:name="SF_Dictionary"/> + <library:element library:name="SF_Session"/> + <library:element library:name="SF_FileSystem"/> + <library:element library:name="SF_TextStream"/> + <library:element library:name="SF_L10N"/> + <library:element library:name="SF_Exception"/> + <library:element library:name="SF_UI"/> + <library:element library:name="SF_Platform"/> + <library:element library:name="SF_PythonHelper"/> + <library:element library:name="SF_Region"/> +</library:library>
\ No newline at end of file |