diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
| commit | ed5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch) | |
| tree | 7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/scriptforge/SF_String.xba | |
| parent | Initial commit. (diff) | |
| download | libreoffice-upstream.tar.xz libreoffice-upstream.zip | |
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
| -rw-r--r-- | wizards/source/scriptforge/SF_String.xba | 2734 |
1 files changed, 2734 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_String.xba b/wizards/source/scriptforge/SF_String.xba new file mode 100644 index 000000000..888cf672c --- /dev/null +++ b/wizards/source/scriptforge/SF_String.xba @@ -0,0 +1,2734 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_String" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_String +''' ========= +''' Singleton class implementing the "ScriptForge.String" service +''' Implemented as a usual Basic module +''' Focus on string manipulation, regular expressions, encodings and hashing algorithms +''' The first argument of almost every method is the string to consider +''' It is always passed by reference and left unchanged +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' Definitions +''' Line breaks: symbolic name(Ascii number) +''' LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30), +''' Next Line(133), Line separator(8232), Paragraph separator(8233) +''' Whitespaces: symbolic name(Ascii number) +''' Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160), +''' Line separator(8232), Paragraph separator(8233) +''' A quoted string: +''' The quoting character must be the double quote (") +''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character +''' => [str\"i""ng] means [str"i"ng] +''' Escape sequences: symbolic name(Ascii number) = escape sequence +''' Line feed(10) = "\n" +''' Carriage return(13) = "\r" +''' Horizontal tab(9) = "\t" +''' Double the backslash to ignore the sequence, e.g. "\\n" means "\n" (not "\" & Chr(10)). +''' Not printable characters: +''' Defined in the Unicode character database as “Other” or “Separator” +''' In particular, "control" characters (ascii code <= 0x1F) are not printable +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_string.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' Some references: +''' https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1i18n_1_1KCharacterType.html +''' com.sun.star.i18n.KCharacterType.### +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html +''' com.sun.star.i18n.XCharacterClassification + +REM ============================================================ MODULE CONSTANTS + +''' Most expressions below are derived from https://www.regular-expressions.info/ + +Const REGEXALPHA = "^[A-Za-z]+$" ' Not used +Const REGEXALPHANUM = "^[\w]+$" +Const REGEXDATEDAY = "(0[1-9]|[12][0-9]|3[01])" +Const REGEXDATEMONTH = "(0[1-9]|1[012])" +Const REGEXDATEYEAR = "(19|20)\d\d" +Const REGEXTIMEHOUR = "(0[1-9]|1[0-9]|2[0123])" +Const REGEXTIMEMIN = "([0-5][0-9])" +Const REGEXTIMESEC = REGEXTIMEMIN +Const REGEXDIGITS = "^[0-9]+$" +Const REGEXEMAIL = "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,}$" +Const REGEXFILELINUX = "^[^<>:;,?""*|\\]+$" +Const REGEXFILEWIN = "^([A-Z]|[a-z]:)?[^<>:;,?""*|]+$" +Const REGEXHEXA = "^(0X|&H)?[0-9A-F]+$" ' Includes 0xFF and &HFF +Const REGEXIPV4 = "^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$" +Const REGEXNUMBER = "^[-+]?(([0-9]+)?\.)?[0-9]+([eE][-+]?[0-9]+)?$" +Const REGEXURL = "^(https?|ftp)://[^\s/$.?#].[^\s]*$" +Const REGEXWHITESPACES = "^[\s]+$" +Const REGEXLTRIM = "^[\s]+" +Const REGEXRTRIM = "[\s]+$" +Const REGEXSPACES = "[\s]+" + +''' Accented characters substitution: https://docs.google.com/spreadsheets/d/1pJKSueZK8RkAcJFQIiKpYUamWSC1u1xVQchK7Z7BIwc/edit#gid=0 +''' (Many of them are in the list, but do not consider the list as closed vs. the Unicode database) + +Const cstCHARSWITHACCENT = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿŠšŸŽž" _ + & "ĂăĐđĨĩŨũƠơƯưẠạẢảẤấẦầẨẩẪẫẬậẮắẰằẲẳẴẵẶặẸẹẺẻẼẽẾếỀềỂểỄễỆệỈỉỊịỌọỎỏỐốỒồỔổỖỗỘộỚớỜờỞởỠỡỢợỤụỦủỨứỪừỬửỮữỰựỲỳỴỵỶỷỸỹ₫" +Const cstCHARSWITHOUTACCENT = "AAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyySsYZz" _ + & "AaDdIiUuOoUuAaAaAaAaAaAaAaAaAaAaAaAaEeEeEeEeEeEeEeEeIiIiOoOoOoOoOoOoOoOoOoOoOoOoUuUuUuUuUuUuUuYyYyYyYyd" + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_String Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CHARSWITHACCENT() As String +''' Latin accents + CHARSWITHACCENT = cstCHARSWITHACCENT +End Property ' ScriptForge.SF_String.CHARSWITHACCENT + +REM ----------------------------------------------------------------------------- +Property Get CHARSWITHOUTACCENT() As String +''' Latin accents + CHARSWITHOUTACCENT = cstCHARSWITHOUTACCENT +End Property ' ScriptForge.SF_String.CHARSWITHOUTACCENT + +''' Symbolic constants for linebreaks +REM ----------------------------------------------------------------------------- +Property Get sfCR() As Variant +''' Carriage return + sfCR = Chr(13) +End Property ' ScriptForge.SF_String.sfCR + +REM ----------------------------------------------------------------------------- +Property Get sfCRLF() As Variant +''' Carriage return + sfCRLF = Chr(13) & Chr(10) +End Property ' ScriptForge.SF_String.sfCRLF + +REM ----------------------------------------------------------------------------- +Property Get sfLF() As Variant +''' Linefeed + sfLF = Chr(10) +End Property ' ScriptForge.SF_String.sfLF + +REM ----------------------------------------------------------------------------- +Property Get sfNEWLINE() As Variant +''' Linefeed or Carriage return + Linefeed + sfNEWLINE = Iif(GetGuiType() = 1, Chr(13), "") & Chr(10) +End Property ' ScriptForge.SF_String.sfNEWLINE + +REM ----------------------------------------------------------------------------- +Property Get sfTAB() As Variant +''' Horizontal tabulation + sfTAB = Chr(9) +End Property ' ScriptForge.SF_String.sfTAB + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_String" +End Property ' ScriptForge.SF_String.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.String" +End Property ' ScriptForge.SF_String.ServiceName + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Function Capitalize(Optional ByRef InputStr As Variant) As String +''' Return the input string with the 1st character of each word in title case +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string with the 1st character of each word in title case +''' Examples: +''' SF_String.Capitalize("this is a title for jean-pierre") returns "This Is A Title For Jean-Pierre" + +Dim sCapital As String ' Return value +Dim lLength As Long ' Length of input string +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Const cstThisSub = "String.Capitalize" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCapital = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + sCapital = oChar.toTitle(InputStr, 0, lLength * 4, oLocale) ' length * 4 because length is expressed in bytes + End If + +Finally: + Capitalize = sCapital + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Capitalize + +REM ----------------------------------------------------------------------------- +Public Function Count(Optional ByRef InputStr As Variant _ + , Optional ByVal Substring As Variant _ + , Optional ByRef IsRegex As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Long +''' Counts the number of occurrences of a substring or a regular expression within a string +''' Args: +''' InputStr: the input stringto examine +''' Substring: the substring to identify +''' IsRegex: True if Substring is a regular expression (default = False) +''' CaseSensitive: default = False +''' Returns: +''' The number of occurrences as a Long +''' Examples: +''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", IsRegex := True, CaseSensitive := True) +''' returns 7 (the number of words in lower case) +''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "or", CaseSensitive := False) +''' returns 2 + + +Dim lOccurrences As Long ' Return value +Dim lStart As Long ' Start index of search +Dim sSubstring As String ' Substring to replace +Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive +Const cstThisSub = "String.Count" +Const cstSubArgs = "InputStr, Substring, [IsRegex=False], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + lOccurrences = 0 + +Check: + If IsMissing(IsRegex) Or IsEmpty(IsRegex) Then IsRegex = False + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(IsRegex, "IsRegex", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + iCaseSensitive = Iif(CaseSensitive, 0, 1) ' 1 = False ;) + lStart = 1 + + Do While lStart >= 1 And lStart <= Len(InputStr) + Select Case IsRegex + Case False ' Use InStr + lStart = InStr(lStart, InputStr, Substring, iCaseSensitive) + If lStart = 0 Then Exit Do + lStart = lStart + Len(Substring) + Case True ' Use FindRegex + sSubstring = SF_String.FindRegex(InputStr, Substring, lStart, CaseSensitive) + If lStart = 0 Then Exit Do + lStart = lStart + Len(sSubstring) + End Select + lOccurrences = lOccurrences + 1 + Loop + +Finally: + Count = lOccurrences + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Count + +REM ----------------------------------------------------------------------------- +Public Function EndsWith(Optional ByRef InputStr As Variant _ + , Optional ByVal Substring As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the last characters of InputStr are identical to Substring +''' Args: +''' InputStr: the input string +''' Substring: the suffixing characters +''' CaseSensitive: default = False +''' Returns: +''' True if the comparison is satisfactory +''' False if either InputStr or Substring have a length = 0 +''' False if Substr is longer than InputStr +''' Examples: +''' SF_String.EndsWith("abcdefg", "EFG") returns True +''' SF_String.EndsWith("abcdefg", "EFG", CaseSensitive := True) returns False + +Dim bEndsWith As Boolean ' Return value +Dim lSub As Long ' Length of SUbstring +Const cstThisSub = "String.EndsWith" +Const cstSubArgs = "InputStr, Substring, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bEndsWith = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lSub = Len(Substring) + If Len(InputStr) > 0 And lSub > 0 And lSub <= Len(InputStr) Then + bEndsWith = ( StrComp(Right(InputStr, lSub), Substring, Iif(CaseSensitive, 1, 0)) = 0 ) + End If + +Finally: + EndsWith = bEndsWith + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.EndsWith + +REM ----------------------------------------------------------------------------- +Public Function Escape(Optional ByRef InputStr As Variant) As String +''' Convert any hard line breaks or tabs by their escaped equivalent +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string after replacement of "\", Chr(10), Chr(13), Chr(9)characters +''' Examples: +''' SF_String.Escape("abc" & Chr(10) & Chr(9) & "def\n") returns "abc\n\tdef\\n" + +Dim sEscape As String ' Return value +Const cstThisSub = "String.Escape" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sEscape = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + sEscape = SF_String.ReplaceStr( InputStr _ + , Array("\", SF_String.sfLF, SF_String.sfCR, SF_String.sfTAB) _ + , Array("\\", "\n", "\r", "\t") _ + ) + +Finally: + Escape = sEscape + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Escape + +REM ----------------------------------------------------------------------------- +Public Function ExpandTabs(Optional ByRef InputStr As Variant _ + , Optional ByVal TabSize As Variant _ + ) As String +''' Return the input string with each TAB (Chr(9)) character replaced by the adequate number of spaces +''' Args: +''' InputStr: the input string +''' TabSize: defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1 +''' Default = 8 +''' Returns: +''' The input string with spaces replacing the TAB characters +''' If the input string contains line breaks, the TAB positions are reset +''' Examples: +''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & SF_String.sfTAB & "def", 4) returns "abc def" +''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & "def" & SF_String.sfLF & SF_String.sfTAB & "ghi") +''' returns "abc def" & SF_String.sfLF & " ghi" + +Dim sExpanded As String ' Return value +Dim lCharPosition As Long ' Position of current character in current line in expanded string +Dim lSpaces As Long ' Spaces counter +Dim sChar As String ' A single character +Dim i As Long +Const cstTabSize = 8 +Const cstThisSub = "String.ExpandTabs" +Const cstSubArgs = "InputStr, [TabSize=8]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sExpanded = "" + +Check: + If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = cstTabSize + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(TabSize, "TabSize", V_NUMERIC) Then GoTo Finally + End If + If TabSize <= 0 Then TabSize = cstTabSize + +Try: + lCharPosition = 0 + If Len(InputStr) > 0 Then + For i = 1 To Len(InputStr) + sChar = Mid(InputStr, i, 1) + Select Case sChar + Case SF_String.sfLF, Chr(12), SF_String.sfCR, Chr(28), Chr(29), Chr(30), Chr(133), Chr(8232), Chr(8233) + sExpanded = sExpanded & sChar + lCharPosition = 0 + Case SF_String.sfTAB + lSpaces = Int(lCharPosition / TabSize + 1) * TabSize - lCharPosition + sExpanded = sExpanded & Space(lSpaces) + lCharPosition = lCharPosition + lSpaces + Case Else + sExpanded = sExpanded & sChar + lCharPosition = lCharPosition + 1 + End Select + Next i + End If + +Finally: + ExpandTabs = sExpanded + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ExpandTabs + +REM ----------------------------------------------------------------------------- +Public Function FilterNotPrintable(Optional ByRef InputStr As Variant _ + , Optional ByVal ReplacedBy As Variant _ + ) As String +''' Return the input string in which all the not printable characters are replaced by ReplacedBy +''' Among others, control characters (Ascii <= 1F) are not printable +''' Args: +''' InputStr: the input string +''' ReplacedBy: zero, one or more characters replacing the found not printable characters +''' Default = the zero-length string +''' Returns: +''' The input string in which all the not printable characters are replaced by ReplacedBy +''' Examples: +''' SF_String.FilterNotPrintable("àén ΣlPµ" & Chr(10) & " Русский", "\n") returns "àén ΣlPµ\n Русский" + +Dim sPrintable As String ' Return value +Dim bPrintable As Boolean ' Is a single character printable ? +Dim lLength As Long ' Length of InputStr +Dim lReplace As Long ' Length of ReplacedBy +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim sChar As String ' A single character +Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE +Dim i As Long +Const cstThisSub = "String.FilterNotPrintable" +Const cstSubArgs = "InputStr, [ReplacedBy=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sPrintable = "" + +Check: + If IsMissing(ReplacedBy) Or IsEmpty(ReplacedBy) Then ReplacedBy = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(ReplacedBy, "ReplacedBy", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + lReplace = Len(ReplacedBy) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + sChar = Mid(InputStr, i + 1, 1) + lType = oChar.getCharacterType(sChar, 0, oLocale) + ' Parenthses (), [], {} have a KCharacterType = 0 + bPrintable = ( (lType And lPRINTABLE) = lPRINTABLE Or (lType = 0 And Asc(sChar) <= 127) ) + If Not bPrintable Then + If lReplace > 0 Then sPrintable = sPrintable & ReplacedBy + Else + sPrintable = sPrintable & sChar + End If + Next i + End If + +Finally: + FilterNotPrintable = sPrintable + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.FilterNotPrintable + +REM ----------------------------------------------------------------------------- +Public Function FindRegex(Optional ByRef InputStr As Variant _ + , Optional ByVal Regex As Variant _ + , Optional ByRef Start As Variant _ + , Optional ByVal CaseSensitive As Variant _ + , Optional ByVal Forward As Variant _ + ) As String +''' Find in InputStr a substring matching a given regular expression +''' Args: +''' InputStr: the input string to be searched for the expression +''' Regex: the regular expression +''' Start (passed by reference): where to start searching from +''' Should be = 1 (Forward = True) or = Len(InputStr) (Forward = False) the 1st time +''' After execution points to the first character of the found substring +''' CaseSensitive: default = False +''' Forward: True (default) or False (backward) +''' Returns: +''' The found substring matching the regular expression +''' A zero-length string if not found (Start is set to 0) +''' Examples: +''' Dim lStart As Long : lStart = 1 +''' SF_String.FindRegex("abCcdefghHij", "C.*H", lStart, CaseSensitive := True) returns "CcdefghH" +''' Above statement may be reexecuted for searching the same or another pattern +''' by starting from lStart + Len(matching string) + +Dim sOutput As String ' Return value +Dim oTextSearch As Object ' com.sun.star.util.TextSearch +Dim vOptions As Variant ' com.sun.star.util.SearchOptions +Dim lEnd As Long ' Upper limit of search area +Dim vResult As Object ' com.sun.star.util.SearchResult +Const cstThisSub = "String.FindRegex" +Const cstSubArgs = "InputStr, Regex, [Start=1], [CaseSensitive=False], [Forward=True]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If IsMissing(Start) Or IsEmpty(Start) Then Start = 1 + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If IsMissing(Forward) Or IsEmpty(Forward) Then Forward = True + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Start, "Start", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Forward, "Forward", V_BOOLEAN) Then GoTo Finally + End If + If Start <= 0 Or Start > Len(InputStr) Then GoTo Finally + +Try: + sOutput = "" + Set oTextSearch = SF_Utils._GetUNOService("TextSearch") + ' Set pattern search options + vOptions = SF_Utils._GetUNOService("SearchOptions") + With vOptions + .searchString = Regex + If CaseSensitive Then .transliterateFlags = 0 Else .transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE + End With + ' Run search + With oTextSearch + .setOptions(vOptions) + If Forward Then + lEnd = Len(InputStr) + vResult = .searchForward(InputStr, Start - 1, lEnd) + Else + lEnd = 1 + vResult = .searchBackward(InputStr, Start, lEnd - 1) + End If + End With + ' https://api.libreoffice.org/docs/idl/ref/structcom_1_1sun_1_1star_1_1util_1_1SearchResult.html + With vResult + If .subRegExpressions >= 1 Then + If Forward Then + Start = .startOffset(0) + 1 + lEnd = .endOffset(0) + 1 + Else + Start = .endOffset(0) + 1 + lEnd = .startOffset(0) + 1 + End If + sOutput = Mid(InputStr, Start, lEnd - Start) + Else + Start = 0 + End If + End With + +Finally: + FindRegex = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.FindRegex + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "String.GetProperty" +Const cstSubArgs = "PropertyName" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case "SFCR" : GetProperty = sfCR + Case "SFCRLF" : GetProperty = sfCRLF + Case "SFLF" : GetProperty = sfLF + Case "SFNEWLINE" : GetProperty = sfNEWLINE + Case "SFTAB" : GetProperty = sfTAB + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function HashStr(Optional ByVal InputStr As Variant _ + , Optional ByVal Algorithm As Variant _ + ) As String +''' Return an hexadecimal string representing a checksum of the given input string +''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512 +''' Args: +''' InputStr: the string to be hashed +''' Algorithm: The hashing algorithm to use +''' Returns: +''' The requested checksum as a string. Hexadecimal digits are lower-cased +''' A zero-length string when an error occurred +''' Example: +''' Print SF_String.HashStr("œ∑¡™£¢∞§¶•ªº–≠œ∑´®†¥¨ˆøπ“‘åß∂ƒ©˙∆˚¬", "MD5") ' 616eb9c513ad07cd02924b4d285b9987 + +Dim sHash As String ' Return value +Const cstPyHelper = "$" & "_SF_String__HashStr" +Const cstThisSub = "String.HashStr" +Const cstSubArgs = "InputStr, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512""" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sHash = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Algorithm, "Algorithm", V_STRING _ + , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally + End If + +Try: + With ScriptForge.SF_Session + sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _ + , InputStr, LCase(Algorithm)) + End With + +Finally: + HashStr = sHash + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.HashStr + +REM ----------------------------------------------------------------------------- +Public Function HtmlEncode(Optional ByRef InputStr As Variant) As String +''' &-encoding of the input string (e.g. "é" becomes "&eacute;" or numeric equivalent +''' Args: +''' InputStr: the input string +''' Returns: +''' the encoded string +''' Examples: +''' SF_String.HtmlEncode("<a href=""https://a.b.com"">From α to ω</a>") +''' returns "&lt;a href=&quot;https://a.b.com&quot;&gt;From &#945; to &#969;&lt;/a&gt;" + +Dim sEncode As String ' Return value +Dim lPos As Long ' Position in InputStr +Dim sChar As String ' A single character extracted from InputStr +Dim i As Long +Const cstThisSub = "String.HtmlEncode" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sEncode = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + lPos = 1 + sEncode = InputStr + Do While lPos <= Len(sEncode) + sChar = Mid(sEncode, lPos, 1) + ' Leave as is or encode every single char + Select Case sChar + Case """" : sChar = "&quot;" + Case "&" : sChar = "&amp;" + Case "<" : sChar = "&lt;" + Case ">" : sChar = "&gt;" + Case "'" : sChar = "&apos;" + Case ":", "/", "?", "#", "[", "]", "@" ' Reserved characters + Case SF_String.sfCR : sChar = "" ' Carriage return + Case SF_String.sfLF : sChar = "<br>" ' Line Feed + Case < Chr(126) + Case "€" : sChar = "&euro;" + Case Else : sChar = "&#" & Asc(sChar) & ";" + End Select + If Len(sChar) = 1 Then + Mid(sEncode, lPos, 1) = sChar + Else + sEncode = Left(sEncode, lPos - 1) & sChar & Mid(sEncode, lPos + 1) + End If + lPos = lPos + Len(sChar) + Loop + End If + +Finally: + HtmlEncode = sEncode + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.HtmlEncode + +REM ----------------------------------------------------------------------------- +Public Function IsADate(Optional ByRef InputStr As Variant _ + , Optional ByVal DateFormat _ + ) As Boolean +''' Return True if the string is a valid date respecting the given format +''' Args: +''' InputStr: the input string +''' DateFormat: either YYYY-MM-DD (default), DD-MM-YYYY or MM-DD-YYYY +''' The dash (-) may be replaced by a dot (.), a slash (/) or a space +''' Returns: +''' True if the string contains a valid date and there is at least one character +''' False otherwise or if the date format is invalid +''' Examples: +''' SF_String.IsADate("2019-12-31", "YYYY-MM-DD") returns True + +Dim bADate As Boolean ' Return value +Dim sFormat As String ' Alias for DateFormat +Dim iYear As Integer ' Alias of year in input string +Dim iMonth As Integer ' Alias of month in input string +Dim iDay As Integer ' Alias of day in input string +Dim dDate As Date ' Date value +Const cstFormat = "YYYY-MM-DD" ' Default date format +Const cstFormatRegex = "(YYYY[- /.]MM[- /.]DD|MM[- /.]DD[- /.]YYYY|DD[- /.]MM[- /.]YYYY)" + ' The regular expression the format must match +Const cstThisSub = "String.IsADate" +Const cstSubArgs = "InputStr, [DateFormat=""" & cstFormat & """]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bADate = False + +Check: + If IsMissing(DateFormat) Or IsEmpty(DateFormat) Then DateFormat = "YYYY-MM-DD" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(DateFormat, "DateFormat", V_STRING) Then GoTo Finally + End If + sFormat = UCase(DateFormat) + If Len(sFormat) <> Len(cstFormat)Then GoTo Finally + If sFormat <> cstFormat Then ' Do not check if default format + If Not SF_String.IsRegex(sFormat, cstFormatRegex) Then GoTo Finally + End If + +Try: + If Len(InputStr) = Len(DateFormat) Then + ' Extract the date components YYYY, MM, DD from the input string + iYear = CInt(Mid(InputStr, InStr(sFormat, "YYYY"), 4)) + iMonth = CInt(Mid(InputStr, InStr(sFormat, "MM"), 2)) + iDay = CInt(Mid(InputStr, InStr(sFormat, "DD"), 2)) + ' Check the validity of the date + On Local Error GoTo NotADate + dDate = DateSerial(iYear, iMonth, iDay) + bADate = True ' Statement reached only if no error + End If + +Finally: + IsADate = bADate + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +NotADate: + On Error GoTo 0 ' Reset the error object + GoTo Finally +End Function ' ScriptForge.SF_String.IsADate + +REM ----------------------------------------------------------------------------- +Public Function IsAlpha(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are alphabetic +''' Alphabetic characters are those characters defined in the Unicode character database as “Letter” +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is alphabetic and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsAlpha("àénΣlPµ") returns True +''' Note: +''' Use SF_String.IsRegex("...", REGEXALPHA) to limit characters to latin alphabet + +Dim bAlpha As Boolean ' Return value +Dim lLength As Long ' Length of InputStr +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER +Dim i As Long +Const cstThisSub = "String.IsAlpha" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAlpha = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + lType = oChar.getCharacterType(InputStr, i, oLocale) + bAlpha = ( (lType And lLETTER) = lLETTER ) + If Not bAlpha Then Exit For + Next i + End If + +Finally: + IsAlpha = bAlpha + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsAlpha + +REM ----------------------------------------------------------------------------- +Public Function IsAlphaNum(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are alphabetic, digits or "_" (underscore) +''' The first character must not be a digit +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is alphanumeric and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsAlphaNum("_ABC_123456_abcàénΣlPµ") returns True + +Dim bAlphaNum As Boolean ' Return value +Dim sInputStr As String ' Alias of InputStr without underscores +Dim sFirst As String ' Leftmost character of InputStr +Dim lLength As Long ' Length of InputStr +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER +Dim lDIGIT As Long : lDIGIT = com.sun.star.i18n.KCharacterType.DIGIT +Dim i As Long +Const cstThisSub = "String.IsAlphaNum" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAlphaNum = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + sFirst = Left(InputStr, 1) + bAlphanum = ( sFirst < "0" Or sFirst > "9" ) + If bAlphaNum Then + sInputStr = Replace(InputStr, "_", "A") ' Replace by an arbitrary alphabetic character + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + lType = oChar.getCharacterType(sInputStr, i, oLocale) + bAlphaNum = ( (lType And lLETTER) = lLETTER _ + Or (lType And lDIGIT) = lDIGIT ) + If Not bAlphaNum Then Exit For + Next i + End If + End If + +Finally: + IsAlphaNum = bAlphaNum + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsAlphaNum + +REM ----------------------------------------------------------------------------- +Public Function IsAscii(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are Ascii characters +''' Ascii characters are those characters defined between &H00 and &H7F +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is Ascii and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsAscii("a%?,25") returns True + +Dim bAscii As Boolean ' Return value +Dim lLength As Long ' Length of InputStr +Dim sChar As String ' Single character +Dim i As Long +Const cstThisSub = "String.IsAscii" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bAscii = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + For i = 1 To lLength + sChar = Mid(InputStr, i, 1) + bAscii = ( Asc(sChar) <= 127 ) + If Not bAscii Then Exit For + Next i + End If + +Finally: + IsAscii = bAscii + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsAscii + +REM ----------------------------------------------------------------------------- +Public Function IsDigit(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are digits +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only digits and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsDigit("123456") returns True + +Dim bDigit As Boolean ' Return value +Const cstThisSub = "String.IsDigit" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bDigit = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bDigit = SF_String.IsRegex(InputStr, REGEXDIGITS, CaseSensitive := False) + +Finally: + IsDigit = bDigit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsDigit + +REM ----------------------------------------------------------------------------- +Public Function IsEmail(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the string is a valid email address +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains an email address and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsEmail("first.last@something.org") returns True + +Dim bEmail As Boolean ' Return value +Const cstThisSub = "String.IsEmail" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bEmail = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bEmail = SF_String.IsRegex(InputStr, REGEXEMAIL, CaseSensitive := False) + +Finally: + IsEmail = bEmail + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsEmail + +REM ----------------------------------------------------------------------------- +Public Function IsFileName(Optional ByRef InputStr As Variant _ + , Optional ByVal OSName As Variant _ + ) As Boolean +''' Return True if the string is a valid filename in a given operating system +''' Args: +''' InputStr: the input string +''' OSName: Windows, Linux, macOS or Solaris +''' The default is the current operating system on which the script is run +''' Returns: +''' True if the string contains a valid filename and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsFileName("/home/a file name.odt", "LINUX") returns True + +Dim bFileName As Boolean ' Return value +Dim sRegex As String ' Regex to apply depending on OS +Const cstThisSub = "String.IsFileName" +Const cstSubArgs = "InputStr, [OSName=""Windows""|""Linux""|""macOS""|Solaris""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bFileName = False + +Check: + If IsMissing(OSName) Or IsEmpty(OSName) Then + If _SF_.OSname = "" Then _SF_.OSName = SF_Platform.OSName + OSName = _SF_.OSName + End If + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(OSName, "OSName", V_STRING, Array("Windows", "Linux", "macOS", "Solaris")) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + Select Case UCase(OSName) + Case "LINUX", "MACOS", "SOLARIS" : sRegex = REGEXFILELINUX + Case "WINDOWS" : sRegex = REGEXFILEWIN + End Select + bFileName = SF_String.IsRegex(InputStr, sRegex, CaseSensitive := False) + End If + +Finally: + IsFileName = bFileName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsFileName + +REM ----------------------------------------------------------------------------- +Public Function IsHexDigit(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are hexadecimal digits +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only hexadecimal igits and there is at least one character +''' The prefixes "0x" and "&H" are admitted +''' False otherwise +''' Examples: +''' SF_String.IsHexDigit("&H00FF") returns True + +Dim bHexDigit As Boolean ' Return value +Const cstThisSub = "String.IsHexDigit" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bHexDigit = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bHexDigit = SF_String.IsRegex(InputStr, REGEXHEXA, CaseSensitive := False) + +Finally: + IsHexDigit = bHexDigit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsHexDigit + +REM ----------------------------------------------------------------------------- +Public Function IsIBAN(Optional ByVal InputStr As Variant) As Boolean +''' Returns True if the input string is a valid International Bank Account Number +''' Read https://en.wikipedia.org/wiki/International_Bank_Account_Number +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains a valid IBAN number. The comparison is not case-sensitive +''' Examples: +''' SF_String.IsIBAN("BR15 0000 0000 0000 1093 2840 814 P2") returns True + +Dim bIBAN As Boolean ' Return value +Dim sIBAN As String ' Transformed input string +Dim sChar As String ' A single character +Dim sLetter As String ' Integer representation of letters +Dim iIndex As Integer ' Index in IBAN string +Dim sLong As String ' String representation of a Long +Dim iModulo97 As Integer ' Remainder of division by 97 +Dim i As Integer +Const cstThisSub = "String.IsIBAN" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bIBAN = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + sIBAN = "" + ' 1. Remove spaces. Check that the total IBAN length is correct as per the country. If not, the IBAN is invalid + ' NOT DONE: Country specific + sIBAN = Replace(InputStr, " ", "") + If Len(sIBAN) < 5 Or Len(sIBAN) > 34 Then GoTo Finally + + ' 2. Move the four initial characters to the end of the string. String is case-insensitive + sIBAN = UCase(Mid(sIBAN, 5) & Left(sIBAN, 4)) + + ' 3. Replace each letter in the string with two digits, thereby expanding the string, where A = 10, B = 11, ..., Z = 35 + iIndex = 1 + Do While iIndex < Len(sIBAN) + sChar = Mid(sIBAN, iIndex, 1) + If sChar >= "A" And sChar <= "Z" Then + sLetter = CStr(Asc(sChar) - Asc("A") + 10) + sIBAN = Left(sIBAN, iIndex - 1) & sLetter & Mid(sIBAN, iIndex + 1) + iIndex = iIndex + 2 + ElseIf sChar < "0" Or sChar > "9" Then ' Remove any non-alphanumeric character + GoTo Finally + Else + iIndex = iIndex + 1 + End If + Loop + + ' 4. Interpret the string as a decimal integer and compute the remainder of that number on division by 97 + ' Computation is done in chunks of 9 digits + iIndex = 3 + sLong = Left(sIBAN, 2) + Do While iIndex <= Len(sIBAN) + sLong = sLong & Mid(sIBAN, iIndex, 7) + iModulo97 = CLng(sLong) Mod 97 + iIndex = iIndex + Len(sLong) - 2 + sLong = Right("0" & CStr(iModulo97), 2) ' Force leading zero + Loop + + bIBAN = ( iModulo97 = 1 ) + +Finally: + IsIBAN = bIBAN + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsIBAN + +REM ----------------------------------------------------------------------------- +Public Function IsIPv4(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the string is a valid IPv4 address +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains a valid IPv4 address and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsIPv4("192.168.1.50") returns True + +Dim bIPv4 As Boolean ' Return value +Const cstThisSub = "String.IsIPv4" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bIPv4 = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bIPv4 = SF_String.IsRegex(InputStr, REGEXIPV4, CaseSensitive := False) + +Finally: + IsIPv4 = bIPv4 + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsIPv4 + +REM ----------------------------------------------------------------------------- +Public Function IsLike(Optional ByRef InputStr As Variant _ + , Optional ByVal Pattern As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the whole input string matches a given pattern containing wildcards +''' Args: +''' InputStr: the input string +''' Pattern: the pattern as a string +''' Admitted wildcard are: the "?" represents any single character +''' the "*" represents zero, one, or multiple characters +''' CaseSensitive: default = False +''' Returns: +''' True if a match is found +''' Zero-length input or pattern strings always return False +''' Examples: +''' SF_String.IsLike("aAbB", "?A*") returns True +''' SF_String.IsLike("C:\a\b\c\f.odb", "?:*.*") returns True + +Dim bLike As Boolean ' Return value +' Build an equivalent regular expression by escaping the special characters present in Pattern +Dim sRegex As String ' Equivalent regular expression +Const cstSpecialChars = "\,^,$,.,|,+,(,),[,{,?,*" ' List of special chars in regular expressions +Const cstEscapedChars = "\\,\^,\$,\.,\|,\+,\(,\),\[,\{,.,.*" + +Const cstThisSub = "String.IsLike" +Const cstSubArgs = "InputStr, Pattern, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bLike = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Pattern, "Pattern", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 And Len(Pattern) > 0 Then + ' Substitute special chars by escaped chars + sRegex = SF_String.ReplaceStr(Pattern, Split(cstSPecialChars, ","), Split(cstEscapedChars, ",")) + bLike = SF_String.IsRegex(InputStr, sRegex, CaseSensitive) + End If + +Finally: + IsLike = bLike + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsLike + +REM ----------------------------------------------------------------------------- +Public Function IsLower(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are in lower case +''' Non alphabetic characters are ignored +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only lower case characters and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsLower("abc'(-xyz") returns True + +Dim bLower As Boolean ' Return value +Const cstThisSub = "String.IsLower" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bLower = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bLower = ( StrComp(InputStr, LCase(InputStr), 1) = 0 ) + +Finally: + IsLower = bLower + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsLower + +REM ----------------------------------------------------------------------------- +Public Function IsPrintable(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are printable +''' In particular, control characters (Ascii <= 1F) are not printable +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is printable and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsPrintable("àén ΣlPµ Русский") returns True + +Dim bPrintable As Boolean ' Return value +Dim lLength As Long ' Length of InputStr +Dim oChar As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim lType As Long ' com.sun.star.i18n.KCharacterType +Dim sChar As String ' A single character +Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE +Dim i As Long +Const cstThisSub = "String.IsPrintable" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bPrintable = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + Set oChar = SF_Utils._GetUNOService("CharacterClass") + For i = 0 To lLength - 1 + sChar = Mid(InputStr, i + 1, 1) + lType = oChar.getCharacterType(sChar, 0, oLocale) + ' Parenthses (), [], {} have a KCharacterType = 0 + bPrintable = ( (lType And lPRINTABLE) = lPRINTABLE Or (lType = 0 And Asc(sChar) <= 127) ) + If Not bPrintable Then Exit For + Next i + End If + +Finally: + IsPrintable = bPrintable + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsPrintable + +REM ----------------------------------------------------------------------------- +Public Function IsRegex(Optional ByRef InputStr As Variant _ + , Optional ByVal Regex As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the whole input string matches a given regular expression +''' Args: +''' InputStr: the input string +''' Regex: the regular expression as a string +''' CaseSensitive: default = False +''' Returns: +''' True if a match is found +''' Zero-length input or regex strings always return False +''' Examples: +''' SF_String.IsRegex("aAbB", "[A-Za-z]+") returns True + +Dim bRegex As Boolean ' Return value +Dim lStart As Long ' Must be 1 +Dim sMatch As String ' Matching string +Const cstBegin = "^" ' Beginning of line symbol +Const cstEnd = "$" ' End of line symbol +Const cstThisSub = "String.IsRegex" +Const cstSubArgs = "InputStr, Regex, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRegex = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 And Len(Regex) > 0 Then + ' Whole string must match Regex + lStart = 1 + If Left(Regex, 1) <> cstBegin Then Regex = cstBegin & Regex + If Right(Regex, 1) <> cstEnd Then Regex = Regex & cstEnd + sMatch = SF_String.FindRegex(InputStr, Regex, lStart, CaseSensitive) + ' Match ? + bRegex = ( lStart = 1 And Len(sMatch) = Len(InputStr) ) + End If + +Finally: + IsRegex = bRegex + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsRegex + +REM ----------------------------------------------------------------------------- +Public Function IsSheetName(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the input string can serve as a valid Calc sheet name +''' The sheet name must not contain the characters [ ] * ? : / \ +''' or the character ' (apostrophe) as first or last character. + +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is validated as a potential Calc sheet name, False otherwise +''' Examples: +''' SF_String.IsSheetName("1àbc + ""def""") returns True + +Dim bSheetName As Boolean ' Return value +Const cstThisSub = "String.IsSheetName" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSheetName = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + If Left(InputStr, 1) = "'" Or Right(InputStr, 1) = "'" Then + ElseIf InStr(InputStr, "[") _ + + InStr(InputStr, "]") _ + + InStr(InputStr, "*") _ + + InStr(InputStr, "?") _ + + InStr(InputStr, ":") _ + + InStr(InputStr, "/") _ + + InStr(InputStr, "\") _ + = 0 Then + bSheetName = True + End If + End If + +Finally: + IsSheetName = bSheetName + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsSheetName + +REM ----------------------------------------------------------------------------- +Public Function IsTitle(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the 1st character of every word is in upper case and the other characters are in lower case +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string is capitalized and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsTitle("This Is A Title For Jean-Pierre") returns True + +Dim bTitle As Boolean ' Return value +Const cstThisSub = "String.IsTitle" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bTitle = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bTitle = ( StrComp(InputStr, SF_String.Capitalize(InputStr), 1) = 0 ) + +Finally: + IsTitle = bTitle + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsTitle + +REM ----------------------------------------------------------------------------- +Public Function IsUpper(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are in upper case +''' Non alphabetic characters are ignored +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only upper case characters and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsUpper("ABC'(-XYZ") returns True + +Dim bUpper As Boolean ' Return value +Const cstThisSub = "String.IsUpper" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bUpper = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bUpper = ( StrComp(InputStr, UCase(InputStr), 1) = 0 ) + +Finally: + IsUpper = bUpper + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsUpper + +REM ----------------------------------------------------------------------------- +Public Function IsUrl(Optional ByRef InputStr As Variant) As Boolean +''' Return True if the string is a valid absolute URL (Uniform Resource Locator) +''' The parsing is done by the ParseStrict method of the URLTransformer UNO service +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1util_1_1XURLTransformer.html +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains a URL and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsUrl("http://foo.bar/?q=Test%20URL-encoded%20stuff") returns True + +Dim bUrl As Boolean ' Return value +Const cstThisSub = "String.IsUrl" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bUrl = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bUrl = ( Len(SF_FileSystem._ParseUrl(InputStr).Main) > 0 ) + +Finally: + IsUrl = bUrl + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsUrl + +REM ----------------------------------------------------------------------------- +Public Function IsWhitespace(Optional ByRef InputStr As Variant) As Boolean +''' Return True if all characters in the string are whitespaces +''' Whitespaces include Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160), +''' Line separator(8232), Paragraph separator(8233) +''' Args: +''' InputStr: the input string +''' Returns: +''' True if the string contains only whitespaces and there is at least one character, False otherwise +''' Examples: +''' SF_String.IsWhitespace(" " & Chr(9) & Chr(10)) returns True + +Dim bWhitespace As Boolean ' Return value +Const cstThisSub = "String.IsWhitespace" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bWhitespace = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then bWhitespace = SF_String.IsRegex(InputStr, REGEXWHITESPACES, CaseSensitive := False) + +Finally: + IsWhitespace = bWhitespace + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.IsWhitespace + +REM ----------------------------------------------------------------------------- +Public Function JustifyCenter(Optional ByRef InputStr As Variant _ + , Optional ByVal Length As Variant _ + , Optional ByVal Padding As Variant _ + ) As String +''' Return the input string center justified +''' Args: +''' InputStr: the input string +''' Length: the resulting string length (default = length of input string) +''' Padding: the padding (single) character (default = the ascii space) +''' Returns: +''' The input string without its leading and trailing white spaces +''' completed left and right up to a total length of Length with the character Padding +''' If the input string is empty, the returned string is empty too +''' If the requested length is shorter than the center justified input string, +''' then the returned string is truncated +''' Examples: +''' SF_String.JustifyCenter(" ABCDE ", Padding := "x") returns "xxABCDEFxx" + +Dim sJustify As String ' Return value +Dim lLength As Long ' Length of input string +Dim lJustLength As Long ' Length of trimmed input string +Dim sPadding As String ' Series of Padding characters +Const cstThisSub = "String.JustifyCenter" +Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJustify = "" + +Check: + If IsMissing(Length) Or IsEmpty(Length) Then Length = 0 + If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " " + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Length, "Length", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Padding, "Padding", V_STRING) Then GoTo Finally + End If + If Len(Padding) = 0 Then Padding = " " Else Padding = Left(Padding, 1) + +Try: + lLength = Len(InputStr) + If Length = 0 Then Length = lLength + If lLength > 0 Then + sJustify = SF_String.TrimExt(InputStr) ' Trim left and right + lJustLength = Len(sJustify) + If lJustLength > Length Then + sJustify = Mid(sJustify, Int((lJustLength - Length) / 2) + 1, Length) + ElseIf lJustLength < Length Then + sPadding = String(Int((Length - lJustLength) / 2), Padding) + sJustify = sPadding & sJustify & sPadding + If Len(sJustify) < Length Then sJustify = sJustify & Padding ' One Padding char is lacking when lJustLength is odd + End If + End If + +Finally: + JustifyCenter = sJustify + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.JustifyCenter + +REM ----------------------------------------------------------------------------- +Public Function JustifyLeft(Optional ByRef InputStr As Variant _ + , Optional ByVal Length As Variant _ + , Optional ByVal Padding As Variant _ + ) As String +''' Return the input string left justified +''' Args: +''' InputStr: the input string +''' Length: the resulting string length (default = length of input string) +''' Padding: the padding (single) character (default = the ascii space) +''' Returns: +''' The input string without its leading white spaces +''' filled up to a total length of Length with the character Padding +''' If the input string is empty, the returned string is empty too +''' If the requested length is shorter than the left justified input string, +''' then the returned string is truncated +''' Examples: +''' SF_String.JustifyLeft(" ABCDE ", Padding := "x") returns "ABCDE xxx" + +Dim sJustify As String ' Return value +Dim lLength As Long ' Length of input string +Const cstThisSub = "String.JustifyLeft" +Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJustify = "" + +Check: + If IsMissing(Length) Or IsEmpty(Length) Then Length = 0 + If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " " + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Length, "Length", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Padding, "Padding", V_STRING) Then GoTo Finally + End If + If Len(Padding) = 0 Then Padding = " " Else Padding = Left(Padding, 1) + +Try: + lLength = Len(InputStr) + If Length = 0 Then Length = lLength + If lLength > 0 Then + sJustify = SF_String.ReplaceRegex(InputStr, REGEXLTRIM, "") ' Trim left + If Len(sJustify) >= Length Then + sJustify = Left(sJustify, Length) + Else + sJustify = sJustify & String(Length - Len(sJustify), Padding) + End If + End If + +Finally: + JustifyLeft = sJustify + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.JustifyLeft + +REM ----------------------------------------------------------------------------- +Public Function JustifyRight(Optional ByRef InputStr As Variant _ + , Optional ByVal Length As Variant _ + , Optional ByVal Padding As Variant _ + ) As String +''' Return the input string right justified +''' Args: +''' InputStr: the input string +''' Length: the resulting string length (default = length of input string) +''' Padding: the padding (single) character (default = the ascii space) +''' Returns: +''' The input string without its trailing white spaces +''' preceded up to a total length of Length with the character Padding +''' If the input string is empty, the returned string is empty too +''' If the requested length is shorter than the right justified input string, +''' then the returned string is right-truncated +''' Examples: +''' SF_String.JustifyRight(" ABCDE ", Padding := "x") returns "x ABCDE" + +Dim sJustify As String ' Return value +Dim lLength As Long ' Length of input string +Const cstThisSub = "String.JustifyRight" +Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sJustify = "" + +Check: + If IsMissing(Length) Or IsEmpty(Length) Then Length = 0 + If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " " + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Length, "Length", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Padding, "Padding", V_STRING) Then GoTo Finally + End If + If Len(Padding) = 0 Then Padding = " " Else Padding = Left(Padding, 1) + +Try: + lLength = Len(InputStr) + If Length = 0 Then Length = lLength + If lLength > 0 Then + sJustify = SF_String.ReplaceRegex(InputStr, REGEXRTRIM, "") ' Trim right + If Len(sJustify) >= Length Then + sJustify = Right(sJustify, Length) + Else + sJustify = String(Length - Len(sJustify), Padding) & sJustify + End If + End If + +Finally: + JustifyRight = sJustify + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.JustifyRight + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the String service as an array + + Methods = Array( _ + "Capitalize" _ + , "Count" _ + , "EndWith" _ + , "Escape" _ + , "ExpandTabs" _ + , "FilterNotPrintable" _ + , "FindRegex" _ + , "HashStr" _ + , "HtmlEncode" _ + , "IsADate" _ + , "IsAlpha" _ + , "IsAlphaNum" _ + , "IsAscii" _ + , "IsDigit" _ + , "IsEmail" _ + , "IsFileName" _ + , "IsHexDigit" _ + , "IsIPv4" _ + , "IsLike" _ + , "IsLower" _ + , "IsPrintable" _ + , "IsRegex" _ + , "IsSheetName" _ + , "IsTitle" _ + , "IsUpper" _ + , "IsUrl" _ + , "IsWhitespace" _ + , "JustifyCenter" _ + , "JustifyLeft" _ + , "JustifyRight" _ + , "Quote" _ + , "ReplaceChar" _ + , "ReplaceRegex" _ + , "ReplaceStr" _ + , "Represent" _ + , "Reverse" _ + , "SplitLines" _ + , "SplitNotQuoted" _ + , "StartsWith" _ + , "TrimExt" _ + , "Unescape" _ + , "Unquote" _ + , "Wrap" _ + ) + +End Function ' ScriptForge.SF_String.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties as an array + + Properties = Array( _ + "sfCR" _ + , "sfCRLF" _ + , "sfLF" _ + , "sfNEWLINE" _ + , "sfTAB" _ + ) + +End Function ' ScriptForge.SF_Session.Properties + +REM ----------------------------------------------------------------------------- +Public Function Quote(Optional ByRef InputStr As Variant _ + , Optional ByVal QuoteChar As String _ + ) As String +''' Return the input string surrounded with double quotes +''' Used f.i. to prepare a string field to be stored in a csv-like file +''' Args: +''' InputStr: the input string +''' QuoteChar: either " (default) or ' +''' Returns: +''' Existing - including leading and/or trailing - double quotes are doubled +''' Examples: +''' SF_String.Quote("àé""n ΣlPµ Русский") returns """àé""""n ΣlPµ Русский""" + +Dim sQuote As String ' Return value +Const cstDouble = """" : Const cstSingle = "'" +Const cstEscape = "\" +Const cstThisSub = "String.Quote" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sQuote = "" + +Check: + If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally + End If + +Try: + If QuoteChar = cstDouble Then + sQuote = cstDouble & Replace(InputStr, cstDouble, cstDouble & cstDouble) & cstDouble + Else + sQuote = Replace(InputStr, cstEscape, cstEscape & cstEscape) + sQuote = cstSingle & Replace(sQuote, cstSingle, cstEscape & cstSingle) & cstSingle + End If + +Finally: + Quote = sQuote + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Quote + +REM ----------------------------------------------------------------------------- +Public Function ReplaceChar(Optional ByRef InputStr As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal After As Variant _ + ) As String +''' Replace in InputStr all occurrences of any character from Before +''' by the corresponding character in After +''' Args: +''' InputStr: the input string on which replacements should occur +''' Before: a string of characters to replace 1 by 1 in InputStr +''' After: the replacing characters +''' Returns: +''' The new string after replacement of Nth character of Before by the Nth character of After +''' Replacements are done one by one => potential overlaps +''' If the length of Before is larger than the length of After, +''' the residual characters of Before are replaced by the last character of After +''' The input string when Before is the zero-length string +''' Examples: easily remove accents +''' SF_String.ReplaceChar("Protégez votre vie privée", "àâãçèéêëîïôöûüýÿ", "aaaceeeeiioouuyy") +''' returns "Protegez votre vie privee" +''' SF_String.ReplaceChar("Protégez votre vie privée", SF_String.CHARSWITHACCENT, SF_String.CHARSWITHOUTACCENT) + +Dim sOutput As String ' Return value +Dim iCaseSensitive As Integer ' Always 0 (True) +Dim sBefore As String ' A single character extracted from InputStr +Dim sAfter As String ' A single character extracted from After +Dim lInStr As Long ' Output of InStr() +Dim i As Long +Const cstThisSub = "String.ReplaceChar" +Const cstSubArgs = "InputStr, Before, After" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(After, "After", V_STRING) Then GoTo Finally + End If + +Try: + ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive) + sOutput = InputStr + iCaseSensitive = 0 + + ' Replace one by one up length of Before and After + If Len(Before) > 0 Then + i = 1 + Do While i <= Len(sOutput) + sBefore = Mid(sOutput, i, 1) + lInStr = InStr(1, Before, sBefore, iCaseSensitive) + If lInStr > 0 Then + If Len(After) = 0 Then + sAfter = "" + ElseIf lInStr > Len(After) Then + sAfter = Right(After, 1) + Else + sAfter = Mid(After, lInStr, 1) + End If + sOutput = Left(sOutput, i - 1) & Replace(sOutput, sBefore, sAfter, i, Empty, iCaseSensitive) + End If + i = i + 1 + Loop + End If + +Finally: + ReplaceChar = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ReplaceChar + +REM ----------------------------------------------------------------------------- +Public Function ReplaceRegex(Optional ByRef InputStr As Variant _ + , Optional ByVal Regex As Variant _ + , Optional ByRef NewStr As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As String +''' Replace in InputStr all occurrences of a given regular expression by NewStr +''' Args: +''' InputStr: the input string where replacements should occur +''' Regex: the regular expression +''' NewStr: the replacing string +''' CaseSensitive: default = False +''' Returns: +''' The new string after all replacements +''' Examples: +''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "[a-z]", "x", CaseSensitive := True) +''' returns "Lxxxx xxxxx xxxxx xxx xxxx, xxxxxxxxxxx xxxxxxxxxx xxxx." +''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", "x", CaseSensitive := False) +''' returns "x x x x x, x x x." (each word is replaced by x) + + +Dim sOutput As String ' Return value +Dim lStartOld As Long ' Previous start of search +Dim lStartNew As Long ' Next start of search +Dim sSubstring As String ' Substring to replace +Const cstThisSub = "String.ReplaceRegex" +Const cstSubArgs = "InputStr, Regex, NewStr, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(NewStr, "NewStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + sOutput = "" + lStartNew = 1 + lStartOld = 1 + + Do While lStartNew >= 1 And lStartNew <= Len(InputStr) + sSubstring = SF_String.FindRegex(InputStr, Regex, lStartNew, CaseSensitive) + If lStartNew = 0 Then ' Regex not found + ' Copy remaining substring of InputStr before leaving + sOutput = sOutput & Mid(InputStr, lStartOld) + Exit Do + End If + ' Append the interval between 2 occurrences and the replacing string + If lStartNew > lStartOld Then sOutput = sOutput & Mid(InputStr, lStartOld, lStartNew - lStartOld) + sOutput = sOutput & NewStr + lStartOld = lStartNew + Len(sSubstring) + lStartNew = lStartOld + Loop + +Finally: + ReplaceRegex = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ReplaceRegex + +REM ----------------------------------------------------------------------------- +Public Function ReplaceStr(Optional ByRef InputStr As Variant _ + , Optional ByVal OldStr As Variant _ + , Optional ByVal NewStr As Variant _ + , Optional ByVal Occurrences As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As String +''' Replace in InputStr some or all occurrences of OldStr by NewStr +''' Args: +''' InputStr: the input string on which replacements should occur +''' OldStr: the string to replace or a 1D array of strings to replace +''' Zero-length strings are ignored +''' NewStr: the replacing string or a 1D array of replacing strings +''' If OldStr is an array +''' each occurrence of any of the items of OldStr is replaced by NewStr +''' If OldStr and NewStr are arrays +''' replacements occur one by one up to the UBound of NewStr +''' remaining OldStr(ings) are replaced by the last element of NewStr +''' Occurrences: the maximum number of replacements (0, default, = all occurrences) +''' Is applied for each single replacement when OldStr is an array +''' CaseSensitive: True or False (default) +''' Returns: +''' The new string after replacements +''' Replacements are done one by one when OldStr is an array => potential overlaps +''' Examples: +''' SF_String.ReplaceStr("abCcdefghHij", Array("c", "h"), Array("Y", "Z"), CaseSensitive := False) returns "abYYdefgZZij" + +Dim sOutput As String ' Return value +Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive +Dim vOccurrences As Variant ' Variant alias for Integer Occurrences +Dim sNewStr As String ' Alias for a NewStr item +Dim i As Long, j As Long +Const cstThisSub = "String.ReplaceStr" +Const cstSubArgs = "InputStr, OldStr, NewStr, [Occurrences=0], [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOutput = "" + +Check: + If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0 + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If IsArray(OldStr) Then + If Not SF_Utils._ValidateArray(OldStr, "OldStr", 1, V_STRING, True) Then GoTo Finally + Else + If Not SF_Utils._Validate(OldStr, "OldStr", V_STRING) Then GoTo Finally + End If + If IsArray(NewStr) Then + If Not SF_Utils._ValidateArray(NewStr, "NewStr", 1, V_STRING, True) Then GoTo Finally + Else + If Not SF_Utils._Validate(NewStr, "NewStr", V_STRING) Then GoTo Finally + End If + If Not SF_Utils._Validate(Occurrences, "Occurrences", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive) + sOutput = InputStr + iCaseSensitive = Iif(CaseSensitive, 0, 1) ' 1 = False ;) + vOccurrences = Iif(Occurrences = 0, Empty, Occurrences) ' Empty = no limit + If Not IsArray(OldStr) Then OldStr = Array(OldStr) + If Not IsArray(NewStr) Then NewStr = Array(NewStr) + + ' Replace one by one up to UBounds of Old and NewStr + j = LBound(NewStr) - 1 + For i = LBound(OldStr) To UBound(OldStr) + j = j + 1 + If j <= UBound(NewStr) Then sNewStr = NewStr(j) ' Else do not change + If StrComp(OldStr(i), sNewStr, 1) <> 0 Then + sOutput = Replace(sOutput, OldStr(i), sNewStr, 1, vOccurrences, iCaseSensitive) + End If + Next i + +Finally: + ReplaceStr = sOutput + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.ReplaceStr + +REM ----------------------------------------------------------------------------- +Public Function Represent(Optional ByRef AnyValue As Variant _ + , Optional ByVal MaxLength As Variant _ + ) As String +''' Return a readable (string) form of the argument, truncated at MaxLength +''' Args: +''' AnyValue: really any value (object, date, whatever) +''' MaxLength: the maximum length of the resulting string (Default = 0, unlimited) +''' Returns: +''' The argument converted or transformed into a string of a maximum length = MaxLength +''' Objects are surrounded with square brackets ([]) +''' In strings, tabs and line breaks are replaced by \t, \n or \r +''' If the effective length exceeds MaxLength, the final part of the string is replaced by " ... (N)" +''' where N = the total length of the string before truncation +''' Examples: +''' SF_String.Represent("this is a usual string") returns "this is a usual string" +''' SF_String.Represent("this is a usual string", 15) returns "this i ... (22)" +''' SF_String.Represent("this is a" & Chr(10) & " 2-lines string") returns "this is a\n 2-lines string" +''' SF_String.Represent(Empty) returns "[EMPTY]" +''' SF_String.Represent(Null) returns "[NULL]" +''' SF_String.Represent(Pi) returns "3.142" +''' SF_String.Represent(CreateUnoService("com.sun.star.util.PathSettings")) returns "[com.sun.star.comp.framework.PathSettings]" +''' SF_String.Represent(Array(1, 2, "Text" & Chr(9) & "here")) returns "[ARRAY] (0:2) (1, 2, Text\there)" +''' Dim myDict As Variant : myDict = CreateScriptService("Dictionary") +''' myDict.Add("A", 1) : myDict.Add("B", 2) +''' SF_String.Represent(myDict) returns "[Dictionary] ("A":1, "B":2)" + +Dim sRepr As String ' Return value +Const cstThisSub = "String.Represent" +Const cstSubArgs = "AnyValue, [MaxLength=0]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sRepr = "" + +Check: + If IsMissing(AnyValue) Then AnyValue = Empty + If IsMissing(MaxLength) Or IsEmpty(MaxLength) Then MaxLength = 0 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(MaxLength, "MaxLength", V_NUMERIC) Then GoTo Finally + End If + +Try: + sRepr = SF_Utils._Repr(AnyValue, MaxLength) + If MaxLength > 0 And MaxLength < Len(sRepr) Then sRepr = sRepr & " ... (" & Len(sRepr) & ")" + +Finally: + Represent = sRepr + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Represent + +REM ----------------------------------------------------------------------------- +Public Function Reverse(Optional ByRef InputStr As Variant) As String +''' Return the input string in reversed order +''' It is equivalent to the standard StrReverse Basic function +''' The latter requires the OpTion VBASupport 1 statement to be present in the module +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string in reversed order +''' Examples: +''' SF_String.Reverse("abcdefghij") returns "jihgfedcba" + +Dim sReversed As String ' Return value +Dim lLength As Long ' Length of input string +Dim i As Long +Const cstThisSub = "String.Reverse" +Const cstSubArgs = "InputSt" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sReversed = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + lLength = Len(InputStr) + If lLength > 0 Then + sReversed = Space(lLength) + For i = 1 To lLength + Mid(sReversed, i, 1) = Mid(InputStr, lLength - i + 1) + Next i + End If + +Finally: + Reverse = sReversed + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Reverse + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "String.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function SplitLines(Optional ByRef InputStr As Variant _ + , Optional ByVal KeepBreaks As Variant _ + ) As Variant +''' Return an array of the lines in a string, breaking at line boundaries +''' Line boundaries include LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30), +''' Next Line(133), Line separator(8232), Paragraph separator(8233) +''' Args: +''' InputStr: the input string +''' KeepBreaks: when True, line breaks are preserved in the output array (default = False) +''' Returns: +''' An array of all the individual lines +''' Examples: +''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3") returns ("Line1", "Line2", "Line3") +''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3" & Chr(10)) returns ("Line1", "Line2", "Line3", "") + +Dim vSplit As Variant ' Return value +Dim vLineBreaks As Variant ' Array of recognized line breaks +Dim vTokenizedBreaks As Variant ' Array of line breaks extended with tokens +Dim sAlias As String ' Alias for input string +' The procedure uses (dirty) placeholders to identify line breaks +' The used tokens are presumed unlikely present in text strings +Dim sTokenCRLF As String ' Token to identify combined CR + LF +Dim sToken As String ' Token to identify any line break +Dim i As Long +Const cstThisSub = "String.SplitLines" +Const cstSubArgs = "InputStr, [KeepBreaks=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSplit = Array() + +Check: + If IsMissing(KeepBreaks) Or IsEmpty(KeepBreaks) Then KeepBreaks = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(KeepBreaks, "KeepBreaks", V_BOOLEAN) Then GoTo Finally + End If + +Try: + ' In next list CR + LF must precede CR and LF + vLineBreaks = Array(SF_String.sfCRLF, SF_String.sfLF, Chr(12), SF_String.sfCR _ + , Chr(28), Chr(29), Chr(30), Chr(133), Chr(8232), Chr(8233)) + + If KeepBreaks = False Then + ' Replace line breaks by linefeeds and split on linefeeds + vSplit = Split(SF_String.ReplaceStr(InputStr, vLineBreaks, SF_String.sfLF, CaseSensitive := False), SF_String.sfLF) + Else + sTokenCRLF = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) + sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(2) + vTokenizedBreaks = Array() : ReDim vTokenizedBreaks(0 To UBound(vLineBreaks)) + ' Extend breaks with token + For i = 0 To UBound(vLineBreaks) + vTokenizedBreaks(i) = Iif(i = 0, sTokenCRLF, vLineBreaks(i)) & sToken + Next i + sAlias = SF_String.ReplaceStr(InputStr, vLineBreaks, vTokenizedBreaks, CaseSensitive := False) + ' Suppress CRLF tokens and split + vSplit = Split(Replace(sAlias, sTokenCRLF, SF_String.sfCRLF), sToken) + End If + +Finally: + SplitLines = vSplit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.SplitLines + +REM ----------------------------------------------------------------------------- +Public Function SplitNotQuoted(Optional ByRef InputStr As Variant _ + , Optional ByVal Delimiter As Variant _ + , Optional ByVal Occurrences As Variant _ + , Optional ByVal QuoteChar As Variant _ + ) As Variant +''' Split a string on Delimiter into an array. If Delimiter is part of a quoted (sub)string, it is ignored +''' (used f.i. for parsing of csv-like records) +''' Args: +''' InputStr: the input string +''' Might contain quoted substrings: +''' The quoting character must be the double quote (") +''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character +''' => [str\"i""ng] means [str"i"ng] +''' Delimiter: A string of one or more characters that is used to delimit the input string +''' The default is the space character +''' Occurrences: The number of substrings to return (Default = 0, meaning no limit) +''' QuoteChar: The quoting character, either " (default) or ' +''' Returns: +''' An array whose items are chunks of the input string, Delimiter not included +''' Examples: +''' SF_String.SplitNotQuoted("abc def ghi") returns ("abc", "def", "ghi") +''' SF_String.SplitNotQuoted("abc,""def,ghi""", ",") returns ("abc", """def,ghi""") +''' SF_String.SplitNotQuoted("abc,""def\"",ghi""", ",") returns ("abc", """def\"",ghi""") +''' SF_String.SplitNotQuoted("abc,""def\"",ghi"""",", ",") returns ("abc", """def\"",ghi""", "") + +Dim vSplit As Variant ' Return value +Dim lDelimLen As Long ' Length of Delimiter +Dim vStart As Variant ' Array of start positions of quoted strings +Dim vEnd As Variant ' Array of end positions of quoted strings +Dim lInStr As Long ' InStr() on input string +Dim lInStrPrev As Long ' Previous value of lInputStr +Dim lBound As Long ' UBound of vStart and vEnd +Dim lMin As Long ' Lower bound to consider when searching vStart and vEnd +Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oParse As Object ' com.sun.star.i18n.ParseResult +Dim sChunk As String ' Substring of InputStr +Dim bSplit As Boolean ' New chunk found or not +Dim i As Long +Const cstDouble = """" : Const cstSingle = "'" +Const cstThisSub = "String.SplitNotQuoted" +Const cstSubArgs = "InputStr, [Delimiter="" ""], [Occurrences=0], [QuoteChar=""" & cstDouble & """]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vSplit = Array() + +Check: + If IsMissing(Delimiter) Or IsEmpty(Delimiter) Then Delimiter = " " + If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0 + If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Delimiter, "Delimiter", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Occurrences, "Occurrences", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally + End If + If Len(Delimiter) = 0 Then Delimiter = " " + +Try: + If Occurrences = 1 Or InStr(1, InputStr, Delimiter, 0) = 0 Then ' No reason to split + vSplit = Array(InputStr) + ElseIf InStr(1, InputStr, QuoteChar, 0) = 0 Then ' No reason to make a complex split + If Occurrences > 0 Then vSplit = Split(InputStr, Delimiter, Occurrences) Else vSplit = Split(InputStr, Delimiter) + Else + If Occurrences < 0 Then Occurrences = 0 + Set oCharacterClass = SF_Utils._GetUNOService("CharacterClass") + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + + ' Build an array of start/end positions of quoted strings containing at least 1x the Delimiter + vStart = Array() : vEnd = Array() + lInStr = InStr(1, InputStr, QuoteChar) + Do While lInStr > 0 + lBound = UBound(vStart) + ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b + Set oParse = oCharacterClass.parsePredefinedToken( _ + Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _ + , InputStr, lInStr - 1, oLocale, 0, "", 0, "") + If oParse.CharLen > 0 Then ' Is parsing successful ? + ' Is there some delimiter ? + If InStr(1, oParse.DequotedNameOrString, Delimiter, 0) > 0 Then + vStart = SF_Array.Append(vStart, lInStr + 0) + vEnd = SF_Array.Append(vEnd, lInStr + oParse.CharLen - 1) + End If + lInStr = InStr(lInStr + oParse.CharLen, InputStr, QuoteChar) + Else + lInStr = 0 + End If + Loop + + lBound = UBound(vStart) + lDelimLen = Len(Delimiter) + If lBound < 0 Then ' Usual split is applicable + vSplit = Split(InputStr, Delimiter, Occurrences) + Else + ' Split chunk by chunk + lMin = 0 + lInStrPrev = 0 + lInStr = InStr(1, InputStr, Delimiter, 0) + Do While lInStr > 0 + If Occurrences > 0 And Occurrences = UBound(vSplit) - 1 Then Exit Do + bSplit = False + ' Ignore found Delimiter if in quoted string + For i = lMin To lBound + If lInStr < vStart(i) Then + bSplit = True + Exit For + ElseIf lInStr > vStart(i) And lInStr < vEnd (i) Then + Exit For + Else + lMin = i + 1 + If i = lBound Then bSplit = True Else bSplit = ( lInStr < vStart(lMin) ) + End If + Next i + ' Build next chunk and store in split array + If bSplit Then + If lInStrPrev = 0 Then ' First chunk + sChunk = Left(InputStr, lInStr - 1) + Else + sChunk = Mid(InputStr, lInStrPrev + lDelimLen, lInStr - lInStrPrev - lDelimLen) + End If + vSplit = SF_Array.Append(vSplit, sChunk & "") + lInStrPrev = lInStr + End If + lInStr = InStr(lInStr + lDelimLen, InputStr, Delimiter, 0) + Loop + If Occurrences = 0 Or Occurrences > UBound(vSplit) + 1 Then + sChunk = Mid(InputStr, lInStrPrev + lDelimLen) ' Append last chunk + vSplit = SF_Array.Append(vSplit, sChunk & "") + End If + End If + End If + +Finally: + SplitNotQuoted = vSplit + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.SplitNotQuoted + +REM ----------------------------------------------------------------------------- +Public Function StartsWith(Optional ByRef InputStr As Variant _ + , Optional ByVal Substring As Variant _ + , Optional ByVal CaseSensitive As Variant _ + ) As Boolean +''' Returns True if the first characters of InputStr are identical to Substring +''' Args: +''' InputStr: the input string +''' Substring: the prefixing characters +''' CaseSensitive: default = False +''' Returns: +''' True if the comparison is satisfactory +''' False if either InputStr or Substring have a length = 0 +''' False if Substr is longer than InputStr +''' Examples: +''' SF_String.StartsWith("abcdefg", "ABC") returns True +''' SF_String.StartsWith("abcdefg", "ABC", CaseSensitive := True) returns False + +Dim bStartsWith As Boolean ' Return value +Dim lSub As Long ' Length of SUbstring +Const cstThisSub = "String.StartsWith" +Const cstSubArgs = "InputStr, Substring, [CaseSensitive=False]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bStartsWith = False + +Check: + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + End If + +Try: + lSub = Len(Substring) + If Len(InputStr) > 0 And lSub > 0 And lSub <= Len(InputStr) Then + bStartsWith = ( StrComp(Left(InputStr, lSub), Substring, Iif(CaseSensitive, 1, 0)) = 0 ) + End If + +Finally: + StartsWith = bStartsWith + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.StartsWith + +REM ----------------------------------------------------------------------------- +Public Function TrimExt(Optional ByRef InputStr As Variant) As String +''' Return the input string without its leading and trailing whitespaces +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string without its leading and trailing white spaces +''' Examples: +''' SF_String.TrimExt(" ABCDE" & Chr(9) & Chr(10) & Chr(13) & " ") returns "ABCDE" + +Dim sTrim As String ' Return value +Const cstThisSub = "String.TrimExt" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sTrim = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + sTrim = SF_String.ReplaceRegex(InputStr, REGEXLTRIM, "") ' Trim left + sTrim = SF_String.ReplaceRegex(sTrim, REGEXRTRIM, "") ' Trim right + End If + +Finally: + TrimExt = sTrim + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.TrimExt + +REM ----------------------------------------------------------------------------- +Public Function Unescape(Optional ByRef InputStr As Variant) As String +''' Convert any escaped characters in the input string +''' Args: +''' InputStr: the input string +''' Returns: +''' The input string after replacement of \\, \n, \r, \t sequences +''' Examples: +''' SF_String.Unescape("abc\n\tdef\\n") returns "abc" & Chr(10) & Chr(9) & "def\n" + +Dim sUnescape As String ' Return value +Dim sToken As String ' Placeholder unlikely to be present in input string +Const cstThisSub = "String.Unescape" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sUnescape = "" + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + End If + +Try: + sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) ' Placeholder for "\\" + sUnescape = SF_String.ReplaceStr( InputStr _ + , Array("\\", "\n", "\r", "\t", sToken) _ + , Array(sToken, SF_String.sfLF, SF_String.sfCR, SF_String.sfTAB, "\") _ + ) + +Finally: + Unescape = sUnescape + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Unescape + +REM ----------------------------------------------------------------------------- +Public Function Unquote(Optional ByRef InputStr As Variant _ + , Optional ByVal QuoteChar As String _ + ) As String +''' Reset a quoted string to its original content +''' (used f.i. for parsing of csv-like records) +''' When the input string contains the quote character, the latter must be escaped: +''' - QuoteChar = double quote, by doubling it ("") +''' - QuoteChar = single quote, with a preceding backslash (\') +''' Args: +''' InputStr: the input string +''' QuoteChar: either " (default) or ' +''' Returns: +''' The input string after removal of leading/trailing quotes and escaped single/double quotes +''' The input string if not a quoted string +''' Examples: +''' SF_String.Unquote("""àé""""n ΣlPµ Русский""") returns "àé""n ΣlPµ Русский" + +Dim sUnquote As String ' Return value +Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oParse As Object ' com.sun.star.i18n.ParseResult +Const cstDouble = """" : Const cstSingle = "'" +Const cstThisSub = "String.Unquote" +Const cstSubArgs = "InputStr" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sUnquote = "" + +Check: + If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally + End If + +Try: + If Left(InputStr, 1) <> QuoteChar Then ' No need to parse further + sUnquote = InputStr + Else + Set oCharacterClass = SF_Utils._GetUNOService("CharacterClass") + Set oLocale = SF_Utils._GetUNOService("SystemLocale") + + ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b + Set oParse = oCharacterClass.parsePredefinedToken( _ + Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _ + , InputStr, 0, oLocale, 0, "", 0, "") + If oParse.CharLen > 0 Then ' Is parsing successful ? + sUnquote = oParse.DequotedNameOrString + Else + sUnquote = InputStr + End If + End If + +Finally: + Unquote = sUnquote + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Unquote + +REM ----------------------------------------------------------------------------- +Public Function Wrap(Optional ByRef InputStr As Variant _ + , Optional ByVal Width As Variant _ + , Optional ByVal TabSize As Variant _ + ) As Variant +''' Wraps every single paragraph in text (a string) so every line is at most Width characters long +''' Args: +''' InputStr: the input string +''' Width: the maximum number of characters in each line, default = 70 +''' TabSize: before wrapping the text, the existing TAB (Chr(9)) characters are replaced with spaces. +''' TabSize defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1 +''' Default = 8 +''' Returns: +''' Returns a zero-based array of output lines, without final newlines except the pre-existing line-breaks +''' Tabs are expanded. Symbolic line breaks are replaced by their hard equivalents +''' If the wrapped output has no content, the returned array is empty. +''' Examples: +''' SF_String.Wrap("Neque porro quisquam est qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit...", 20) + +Dim vWrap As Variant ' Return value +Dim vWrapLines ' Input string split on line breaks +Dim sWrap As String ' Intermediate string +Dim sLine As String ' Line after splitting on line breaks +Dim lPos As Long ' Position in sLine already wrapped +Dim lStart As Long ' Start position before and after regex search +Dim sSpace As String ' Next whitespace +Dim sChunk As String ' Next wrappable text chunk +Const cstThisSub = "String.Wrap" +Const cstSubArgs = "InputStr, [Width=70], [TabSize=8]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vWrap = Array() + +Check: + If IsMissing(Width) Or IsEmpty(Width) Then Width = 70 + If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = 8 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Width, "Width", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(TabSize, "TabSize", V_NUMERIC) Then GoTo Finally + End If + +Try: + If Len(InputStr) > 0 Then + sWrap = SF_String.Unescape(InputStr) ' Replace symbolic breaks + sWrap = SF_String.ExpandTabs(sWrap, TabSize) ' Interpret TABs to have a meaningful Width + ' First, split full string + vWrapLines = SF_String.SplitLines(sWrap, KeepBreaks := True) ' Keep pre-existing breaks + If UBound(vWrapLines) = 0 And Len(sWrap) <= Width Then ' Output a single line + vWrap = Array(sWrap) + Else + ' Second, split each line on Width + For Each sLine In vWrapLines + If Len(sLine) <= Width Then + If UBound(vWrap) < 0 Then vWrap = Array(sLine) Else vWrap = SF_Array.Append(vWrap, sLine) + Else + ' Scan sLine and accumulate found substrings up to Width + lStart = 1 + lPos = 0 + sWrap = "" + Do While lStart <= Len(sLine) + sSpace = SF_String.FindRegex(sLine, REGEXSPACES, lStart) + If lStart = 0 Then lStart = Len(sLine) + 1 + sChunk = Mid(sLine, lPos + 1, lStart - 1 - lPos + Len(sSpace)) + If Len(sWrap) + Len(sChunk) < Width Then ' Add chunk to current piece of line + sWrap = sWrap & sChunk + Else ' Save current line and initialize next one + If UBound(vWrap) < 0 Then vWrap = Array(sWrap) Else vWrap = SF_Array.Append(vWrap, sWrap) + sWrap = sChunk + End If + lPos = lPos + Len(sChunk) + lStart = lPos + 1 + Loop + ' Add last chunk + If Len(sWrap) > 0 Then + If UBound(vWrap) < 0 Then vWrap = Array(sWrap) Else vWrap = SF_Array.Append(vWrap, sWrap) + End If + End If + Next sLine + End If + End If + +Finally: + Wrap = vWrap + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_String.Wrap + +REM ============================================================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Private Function _Repr(ByRef pvString As String) As String +''' Convert an arbitrary string to a readable string, typically for debugging purposes (DebugPrint ...) +''' Carriage Returns are replaced by \r. Other line breaks are replaced by \n +''' Tabs are replaced by \t +''' Backslashes are doubled +''' Other non printable characters are replaced by \x00 to \xFF or \x0000 to \xFFFF +''' Args: +''' pvString: the string to make readable +''' Return: +''' the converted string + +Dim sString As String ' Return value +Dim sChar As String ' A single character +Dim lAsc As Long ' Ascii value +Dim lPos As Long ' Position in sString +Dim i As Long + + ' Process TABs, CRs and LFs + sString = Replace(Replace(Replace(pvString, "\", "\\"), SF_String.sfCR, "\r"), SF_String.sfTAB, "\t") + sString = Join(SF_String.SplitLines(sString, KeepBreaks := False), "\n") + ' Process not printable characters + If Len(sString) > 0 Then + lPos = 1 + Do While lPos <= Len(sString) + sChar = Mid(sString, lPos, 1) + If Not SF_String.IsPrintable(sChar) Then + lAsc = Asc(sChar) + sChar = "\x" & Iif(lAsc < 255, Right("00" & Hex(lAsc), 2), Right("0000" & Hex(lAsc), 4)) + If lPos < Len(sString) Then + sString = Left(sString, lPos - 1) & sChar & Mid(sString, lPos + 1) + Else + sString = Left(sString, lPos - 1) & sChar + End If + End If + lPos = lPos + Len(sChar) + Loop + End If + + _Repr = sString + +End Function ' ScriptForge.SF_String._Repr + +REM ================================================ END OF SCRIPTFORGE.SF_STRING +</script:module>
\ No newline at end of file |