2643 lines
114 KiB
Java
2643 lines
114 KiB
Java
<?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
|
||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||
''' 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("Locale")
|
||
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("Locale")
|
||
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 sRegex As String ' The regex to check against the input string
|
||
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
|
||
sRegex = ReplaceStr(sFormat, Array("YYYY", "MM", "DD") _
|
||
, Array(REGEXDATEYEAR, REGEXDATEMONTH, REGEXDATEDAY) _
|
||
, CaseSensitive := False)
|
||
bADate = SF_String.IsRegex(InputStr, sRegex, CaseSensitive := False)
|
||
End If
|
||
|
||
Finally:
|
||
IsADate = bADate
|
||
SF_Utils._ExitFunction(cstThisSub)
|
||
Exit Function
|
||
Catch:
|
||
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("Locale")
|
||
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("Locale")
|
||
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 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("Locale")
|
||
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("Locale")
|
||
|
||
' Build an array of start/end positions of quoted strings containing at least 1x the Delimiter
|
||
vStart = Array() : vEnd = Array()
|
||
lInStr = InStr(1, InputStr, QuoteChar)
|
||
Do While lInStr > 0
|
||
lBound = UBound(vStart)
|
||
' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b
|
||
Set oParse = oCharacterClass.parsePredefinedToken( _
|
||
Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _
|
||
, InputStr, lInStr - 1, oLocale, 0, "", 0, "")
|
||
If oParse.CharLen > 0 Then ' Is parsing successful ?
|
||
' Is there some delimiter ?
|
||
If InStr(1, oParse.DequotedNameOrString, Delimiter, 0) > 0 Then
|
||
vStart = SF_Array.Append(vStart, lInStr + 0)
|
||
vEnd = SF_Array.Append(vEnd, lInStr + oParse.CharLen - 1)
|
||
End If
|
||
lInStr = InStr(lInStr + oParse.CharLen, InputStr, QuoteChar)
|
||
Else
|
||
lInStr = 0
|
||
End If
|
||
Loop
|
||
|
||
lBound = UBound(vStart)
|
||
lDelimLen = Len(Delimiter)
|
||
If lBound < 0 Then ' Usual split is applicable
|
||
vSplit = Split(InputStr, Delimiter, Occurrences)
|
||
Else
|
||
' Split chunk by chunk
|
||
lMin = 0
|
||
lInStrPrev = 0
|
||
lInStr = InStr(1, InputStr, Delimiter, 0)
|
||
Do While lInStr > 0
|
||
If Occurrences > 0 And Occurrences = UBound(vSplit) - 1 Then Exit Do
|
||
bSplit = False
|
||
' Ignore found Delimiter if in quoted string
|
||
For i = lMin To lBound
|
||
If lInStr < vStart(i) Then
|
||
bSplit = True
|
||
Exit For
|
||
ElseIf lInStr > vStart(i) And lInStr < vEnd (i) Then
|
||
Exit For
|
||
Else
|
||
lMin = i + 1
|
||
If i = lBound Then bSplit = True Else bSplit = ( lInStr < vStart(lMin) )
|
||
End If
|
||
Next i
|
||
' Build next chunk and store in split array
|
||
If bSplit Then
|
||
If lInStrPrev = 0 Then ' First chunk
|
||
sChunk = Left(InputStr, lInStr - 1)
|
||
Else
|
||
sChunk = Mid(InputStr, lInStrPrev + lDelimLen, lInStr - lInStrPrev - lDelimLen)
|
||
End If
|
||
vSplit = SF_Array.Append(vSplit, sChunk & "")
|
||
lInStrPrev = lInStr
|
||
End If
|
||
lInStr = InStr(lInStr + lDelimLen, InputStr, Delimiter, 0)
|
||
Loop
|
||
If Occurrences = 0 Or Occurrences > UBound(vSplit) + 1 Then
|
||
sChunk = Mid(InputStr, lInStrPrev + lDelimLen) ' Append last chunk
|
||
vSplit = SF_Array.Append(vSplit, sChunk & "")
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
Finally:
|
||
SplitNotQuoted = vSplit
|
||
SF_Utils._ExitFunction(cstThisSub)
|
||
Exit Function
|
||
Catch:
|
||
GoTo Finally
|
||
End Function ' ScriptForge.SF_String.SplitNotQuoted
|
||
|
||
REM -----------------------------------------------------------------------------
|
||
Public Function StartsWith(Optional ByRef InputStr As Variant _
|
||
, Optional ByVal Substring As Variant _
|
||
, Optional ByVal CaseSensitive As Variant _
|
||
) As Boolean
|
||
''' Returns True if the first characters of InputStr are identical to Substring
|
||
''' Args:
|
||
''' InputStr: the input string
|
||
''' Substring: the prefixing characters
|
||
''' CaseSensitive: default = False
|
||
''' Returns:
|
||
''' True if the comparison is satisfactory
|
||
''' False if either InputStr or Substring have a length = 0
|
||
''' False if Substr is longer than InputStr
|
||
''' Examples:
|
||
''' SF_String.StartsWith("abcdefg", "ABC") returns True
|
||
''' SF_String.StartsWith("abcdefg", "ABC", CaseSensitive := True) returns False
|
||
|
||
Dim bStartsWith As Boolean ' Return value
|
||
Dim lSub As Long ' Length of SUbstring
|
||
Const cstThisSub = "String.StartsWith"
|
||
Const cstSubArgs = "InputStr, Substring, [CaseSensitive=False]"
|
||
|
||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||
bStartsWith = False
|
||
|
||
Check:
|
||
If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
|
||
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||
If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
|
||
If Not SF_Utils._Validate(Substring, "Substring", V_STRING) Then GoTo Finally
|
||
If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
|
||
End If
|
||
|
||
Try:
|
||
lSub = Len(Substring)
|
||
If Len(InputStr) > 0 And lSub > 0 And lSub <= Len(InputStr) Then
|
||
bStartsWith = ( StrComp(Left(InputStr, lSub), Substring, Iif(CaseSensitive, 1, 0)) = 0 )
|
||
End If
|
||
|
||
Finally:
|
||
StartsWith = bStartsWith
|
||
SF_Utils._ExitFunction(cstThisSub)
|
||
Exit Function
|
||
Catch:
|
||
GoTo Finally
|
||
End Function ' ScriptForge.SF_String.StartsWith
|
||
|
||
REM -----------------------------------------------------------------------------
|
||
Public Function TrimExt(Optional ByRef InputStr As Variant) As String
|
||
''' Return the input string without its leading and trailing whitespaces
|
||
''' Args:
|
||
''' InputStr: the input string
|
||
''' Returns:
|
||
''' The input string without its leading and trailing white spaces
|
||
''' Examples:
|
||
''' SF_String.TrimExt(" ABCDE" & Chr(9) & Chr(10) & Chr(13) & " ") returns "ABCDE"
|
||
|
||
Dim sTrim As String ' Return value
|
||
Const cstThisSub = "String.TrimExt"
|
||
Const cstSubArgs = "InputStr"
|
||
|
||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||
sTrim = ""
|
||
|
||
Check:
|
||
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||
If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
|
||
End If
|
||
|
||
Try:
|
||
If Len(InputStr) > 0 Then
|
||
sTrim = SF_String.ReplaceRegex(InputStr, REGEXLTRIM, "") ' Trim left
|
||
sTrim = SF_String.ReplaceRegex(sTrim, REGEXRTRIM, "") ' Trim right
|
||
End If
|
||
|
||
Finally:
|
||
TrimExt = sTrim
|
||
SF_Utils._ExitFunction(cstThisSub)
|
||
Exit Function
|
||
Catch:
|
||
GoTo Finally
|
||
End Function ' ScriptForge.SF_String.TrimExt
|
||
|
||
REM -----------------------------------------------------------------------------
|
||
Public Function Unescape(Optional ByRef InputStr As Variant) As String
|
||
''' Convert any escaped characters in the input string
|
||
''' Args:
|
||
''' InputStr: the input string
|
||
''' Returns:
|
||
''' The input string after replacement of \\, \n, \r, \t sequences
|
||
''' Examples:
|
||
''' SF_String.Unescape("abc\n\tdef\\n") returns "abc" & Chr(10) & Chr(9) & "def\n"
|
||
|
||
Dim sUnescape As String ' Return value
|
||
Dim sToken As String ' Placeholder unlikely to be present in input string
|
||
Const cstThisSub = "String.Unescape"
|
||
Const cstSubArgs = "InputStr"
|
||
|
||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||
sUnescape = ""
|
||
|
||
Check:
|
||
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||
If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
|
||
End If
|
||
|
||
Try:
|
||
sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) ' Placeholder for "\\"
|
||
sUnescape = SF_String.ReplaceStr( InputStr _
|
||
, Array("\\", "\n", "\r", "\t", sToken) _
|
||
, Array(sToken, SF_String.sfLF, SF_String.sfCR, SF_String.sfTAB, "\") _
|
||
)
|
||
|
||
Finally:
|
||
Unescape = sUnescape
|
||
SF_Utils._ExitFunction(cstThisSub)
|
||
Exit Function
|
||
Catch:
|
||
GoTo Finally
|
||
End Function ' ScriptForge.SF_String.Unescape
|
||
|
||
REM -----------------------------------------------------------------------------
|
||
Public Function Unquote(Optional ByRef InputStr As Variant _
|
||
, Optional ByVal QuoteChar As String _
|
||
) As String
|
||
''' Reset a quoted string to its original content
|
||
''' (used f.i. for parsing of csv-like records)
|
||
''' Args:
|
||
''' InputStr: the input string
|
||
''' QuoteChar: either " (default) or '
|
||
''' Returns:
|
||
''' The input string after removal of leading/trailing quotes and escaped single/double quotes
|
||
''' The input string if not a quoted string
|
||
''' Examples:
|
||
''' SF_String.Unquote("""àé""""n ΣlPµ Русский""") returns "àé""n ΣlPµ Русский"
|
||
|
||
Dim sUnquote As String ' Return value
|
||
Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification
|
||
Dim oLocale As Object ' com.sun.star.lang.Locale
|
||
Dim oParse As Object ' com.sun.star.i18n.ParseResult
|
||
Const cstDouble = """" : Const cstSingle = "'"
|
||
Const cstThisSub = "String.Unquote"
|
||
Const cstSubArgs = "InputStr"
|
||
|
||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||
sUnquote = ""
|
||
|
||
Check:
|
||
If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
|
||
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||
If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
|
||
If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
|
||
End If
|
||
|
||
Try:
|
||
If Left(InputStr, 1) <> """" Then ' No need to parse further
|
||
sUnquote = InputStr
|
||
Else
|
||
Set oCharacterClass = SF_Utils._GetUNOService("CharacterClass")
|
||
Set oLocale = SF_Utils._GetUNOService("Locale")
|
||
|
||
' 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>
|