Linux ns1.utparral.edu.mx 6.8.0-79-generic #79~22.04.1-Ubuntu SMP PREEMPT_DYNAMIC Fri Aug 15 16:54:53 UTC 2 x86_64
Apache/2.4.58 (Unix) OpenSSL/1.1.1w PHP/8.2.12 mod_perl/2.0.12 Perl/v5.34.1
: 10.10.1.9 | : 10.10.1.254
Cant Read [ /etc/named.conf ]
daemon
Terminal
AUTO ROOT
Adminer
Backdoor Destroyer
Linux Exploit
Lock Shell
Lock File
Create User
README
+ Create Folder
+ Create File
/
usr /
lib /
libreoffice /
share /
basic /
ScriptForge /
[ HOME SHELL ]
Name
Size
Permission
Action
po
[ DIR ]
drwxr-xr-x
_CodingConventions.xba
6.43
KB
-rw-r--r--
dialog.xlb
401
B
-rw-r--r--
dlgConsole.xdl
1.32
KB
-rw-r--r--
dlgProgress.xdl
1.03
KB
-rw-r--r--
__License.xba
1.69
KB
-rw-r--r--
_ModuleModel.xba
9.02
KB
-rw-r--r--
script.xlb
1.12
KB
-rw-r--r--
SF_Array.xba
105.89
KB
-rw-r--r--
SF_Dictionary.xba
36.31
KB
-rw-r--r--
SF_Exception.xba
64.09
KB
-rw-r--r--
SF_FileSystem.xba
91.06
KB
-rw-r--r--
SF_L10N.xba
35.59
KB
-rw-r--r--
SF_Platform.xba
17.28
KB
-rw-r--r--
SF_PythonHelper.xba
38.52
KB
-rw-r--r--
SF_Root.xba
50.72
KB
-rw-r--r--
SF_Services.xba
27.36
KB
-rw-r--r--
SF_Session.xba
45.97
KB
-rw-r--r--
SF_String.xba
117.97
KB
-rw-r--r--
SF_TextStream.xba
28.12
KB
-rw-r--r--
SF_Timer.xba
17.05
KB
-rw-r--r--
SF_UI.xba
53.42
KB
-rw-r--r--
SF_Utils.xba
42.69
KB
-rw-r--r--
Delete
Unzip
Zip
${this.title}
Close
Code Editor : SF_String.xba
<?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) ''' 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) <> """" 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>
Close