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>
|