forked from amazingfate/loongoffice
30a6bf3960
The quoting character (2nd argument of the method) can be the single or the double quote. The single quote was erroneously ignored. Additionally comments are added in the code about non-symmetrical escaping approaches: "" or \' (maybe to be added in help texts ?) Commit to push to libreoffice-7-4 branch too. Change-Id: Ifd8f66ee9e60310fdc292aa0f338e88d941b2e21 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/136292 Tested-by: Jean-Pierre Ledure <jp@ledure.be> Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins
2734 lines
118 KiB
XML
2734 lines
118 KiB
XML
<?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> |