| blob | 272a2d1cefa723dbf78aaf34793fd8151e5a6157 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_String" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option Explicit
11 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12 ''' SF_String
13 ''' =========
15 ''' Implemented as a usual Basic module
16 ''' Focus on string manipulation, regular expressions, encodings and hashing algorithms
17 ''' The first argument of almost every method is the string to consider
18 ''' It is always passed by reference and left unchanged
19 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
20 ''' Definitions
21 ''' Line breaks: symbolic name(Ascii number)
22 ''' LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30),
24 ''' Whitespaces: symbolic name(Ascii number)
25 ''' Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160),
27 ''' A quoted string:
29 ''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character
31 ''' Escape sequences: symbolic name(Ascii number) = escape sequence
35 ''' Double the backslash to ignore the sequence, e.g. "\\n" means "\n" (not "\" & Chr(10)).
36 ''' Not printable characters:
37 ''' Defined in the Unicode character database as “Other” or “Separator”
38 ''' In particular, "control" characters (ascii code <= 0x1F) are not printable
39 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
40 ''' Some references:
41 ''' https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1i18n_1_1KCharacterType.html
42 ''' com.sun.star.i18n.KCharacterType.###
43 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html
44 ''' com.sun.star.i18n.XCharacterClassification
46 REM ============================================================ MODULE CONSTANTS
48 ''' Most expressions below are derived from https://www.regular-expressions.info/
57 Const REGEXTIMESEC = REGEXTIMEMIN
63 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]?)$"
71 ''' Accented characters substitution: https://docs.google.com/spreadsheets/d/1pJKSueZK8RkAcJFQIiKpYUamWSC1u1xVQchK7Z7BIwc/edit#gid=0
72 ''' (Many of them are in the list, but do not consider the list as closed vs. the Unicode database)
74 Const cstCHARSWITHACCENT = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿŠšŸŽž" _
75 & "ĂăĐđĨĩŨũƠơƯưẠạẢảẤấẦầẨẩẪẫẬậẮắẰằẲẳẴẵẶặẸẹẺẻẼẽẾếỀềỂểỄễỆệỈỉỊịỌọỎỏỐốỒồỔổỖỗỘộỚớỜờỞởỠỡỢợỤụỦủỨứỪừỬửỮữỰựỲỳỴỵỶỷỸỹ₫"
76 Const cstCHARSWITHOUTACCENT = "AAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyySsYZz" _
77 & "AaDdIiUuOoUuAaAaAaAaAaAaAaAaAaAaAaAaEeEeEeEeEeEeEeEeIiIiOoOoOoOoOoOoOoOoOoOoOoOoUuUuUuUuUuUuUuYyYyYyYyd"
79 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
81 REM -----------------------------------------------------------------------------
82 Public Function Dispose() As Variant
83 Set Dispose = Nothing
84 End Function ' ScriptForge.SF_String Explicit destructor
86 REM ================================================================== PROPERTIES
88 REM -----------------------------------------------------------------------------
89 Property Get CHARSWITHACCENT() As String
90 ''' Latin accents
91 CHARSWITHACCENT = cstCHARSWITHACCENT
92 End Property ' ScriptForge.SF_String.CHARSWITHACCENT
94 REM -----------------------------------------------------------------------------
95 Property Get CHARSWITHOUTACCENT() As String
96 ''' Latin accents
97 CHARSWITHOUTACCENT = cstCHARSWITHOUTACCENT
98 End Property ' ScriptForge.SF_String.CHARSWITHOUTACCENT
100 ''' Symbolic constants for linebreaks
101 REM -----------------------------------------------------------------------------
102 Property Get sfCR() As Variant
103 ''' Carriage return
104 sfCR = Chr(13)
105 End Property ' ScriptForge.SF_String.sfCR
107 REM -----------------------------------------------------------------------------
108 Property Get sfCRLF() As Variant
109 ''' Carriage return
111 End Property ' ScriptForge.SF_String.sfCRLF
113 REM -----------------------------------------------------------------------------
114 Property Get sfLF() As Variant
115 ''' Linefeed
116 sfLF = Chr(10)
117 End Property ' ScriptForge.SF_String.sfLF
119 REM -----------------------------------------------------------------------------
120 Property Get sfNEWLINE() As Variant
121 ''' Linefeed or Carriage return + Linefeed
123 End Property ' ScriptForge.SF_String.sfNEWLINE
125 REM -----------------------------------------------------------------------------
126 Property Get sfTAB() As Variant
127 ''' Horizontal tabulation
128 sfTAB = Chr(9)
129 End Property ' ScriptForge.SF_String.sfTAB
131 REM -----------------------------------------------------------------------------
132 Property Get ObjectType As String
133 ''' Only to enable object representation
135 End Property ' ScriptForge.SF_String.ObjectType
137 REM -----------------------------------------------------------------------------
138 Property Get ServiceName As String
139 ''' Internal use
141 End Property ' ScriptForge.SF_String.ServiceName
143 REM ============================================================== PUBLIC METHODS
145 REM -----------------------------------------------------------------------------
146 Public Function Capitalize(Optional ByRef InputStr As Variant) As String
148 ''' Args:
149 ''' InputStr: the input string
150 ''' Returns:
152 ''' Examples:
153 ''' SF_String.Capitalize("this is a title for jean-pierre") returns "This Is A Title For Jean-Pierre"
155 Dim sCapital As String ' Return value
156 Dim lLength As Long ' Length of input string
157 Dim oLocale As Object ' com.sun.star.lang.Locale
158 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
162 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
163 sCapital = ""
165 Check:
166 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
168 End If
170 Try:
171 lLength = Len(InputStr)
175 sCapital = oChar.toTitle(InputStr, 0, lLength * 4, oLocale) ' length * 4 because length is expressed in bytes
176 End If
178 Finally:
179 Capitalize = sCapital
180 SF_Utils._ExitFunction(cstThisSub)
181 Exit Function
182 Catch:
183 GoTo Finally
184 End Function ' ScriptForge.SF_String.Capitalize
186 REM -----------------------------------------------------------------------------
187 Public Function Count(Optional ByRef InputStr As Variant _
188 , Optional ByVal Substring As Variant _
189 , Optional ByRef IsRegex As Variant _
190 , Optional ByVal CaseSensitive As Variant _
191 ) As Long
192 ''' Counts the number of occurrences of a substring or a regular expression within a string
193 ''' Args:
194 ''' InputStr: the input stringto examine
195 ''' Substring: the substring to identify
196 ''' IsRegex: True if Substring is a regular expression (default = False)
197 ''' CaseSensitive: default = False
198 ''' Returns:
199 ''' The number of occurrences as a Long
200 ''' Examples:
201 ''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", IsRegex := True, CaseSensitive := True)
203 ''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "or", CaseSensitive := False)
207 Dim lOccurrences As Long ' Return value
208 Dim lStart As Long ' Start index of search
209 Dim sSubstring As String ' Substring to replace
210 Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive
214 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
215 lOccurrences = 0
217 Check:
218 If IsMissing(IsRegex) Or IsEmpty(IsRegex) Then IsRegex = False
219 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
220 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
224 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
225 End If
227 Try:
229 lStart = 1
232 Select Case IsRegex
233 Case False ' Use InStr
234 lStart = InStr(lStart, InputStr, Substring, iCaseSensitive)
235 If lStart = 0 Then Exit Do
236 lStart = lStart + Len(Substring)
237 Case True ' Use FindRegex
238 sSubstring = SF_String.FindRegex(InputStr, Substring, lStart, CaseSensitive)
239 If lStart = 0 Then Exit Do
240 lStart = lStart + Len(sSubstring)
241 End Select
242 lOccurrences = lOccurrences + 1
243 Loop
245 Finally:
246 Count = lOccurrences
247 SF_Utils._ExitFunction(cstThisSub)
248 Exit Function
249 Catch:
250 GoTo Finally
251 End Function ' ScriptForge.SF_String.Count
253 REM -----------------------------------------------------------------------------
254 Public Function EndsWith(Optional ByRef InputStr As Variant _
255 , Optional ByVal Substring As Variant _
256 , Optional ByVal CaseSensitive As Variant _
257 ) As Boolean
258 ''' Returns True if the last characters of InputStr are identical to Substring
259 ''' Args:
260 ''' InputStr: the input string
261 ''' Substring: the suffixing characters
262 ''' CaseSensitive: default = False
263 ''' Returns:
264 ''' True if the comparison is satisfactory
266 ''' False if Substr is longer than InputStr
267 ''' Examples:
269 ''' SF_String.EndsWith("abcdefg", "EFG", CaseSensitive := True) returns False
271 Dim bEndsWith As Boolean ' Return value
272 Dim lSub As Long ' Length of SUbstring
276 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
277 bEndsWith = False
279 Check:
280 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
281 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
284 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
285 End If
287 Try:
288 lSub = Len(Substring)
291 End If
293 Finally:
294 EndsWith = bEndsWith
295 SF_Utils._ExitFunction(cstThisSub)
296 Exit Function
297 Catch:
298 GoTo Finally
299 End Function ' ScriptForge.SF_String.EndsWith
301 REM -----------------------------------------------------------------------------
302 Public Function Escape(Optional ByRef InputStr As Variant) As String
303 ''' Convert any hard line breaks or tabs by their escaped equivalent
304 ''' Args:
305 ''' InputStr: the input string
306 ''' Returns:
307 ''' The input string after replacement of "\", Chr(10), Chr(13), Chr(9)characters
308 ''' Examples:
309 ''' SF_String.Escape("abc" & Chr(10) & Chr(9) & "def\n") returns "abc\n\tdef\\n"
311 Dim sEscape As String ' Return value
315 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
316 sEscape = ""
318 Check:
319 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
321 End If
323 Try:
324 sEscape = SF_String.ReplaceStr( InputStr _
327 )
329 Finally:
330 Escape = sEscape
331 SF_Utils._ExitFunction(cstThisSub)
332 Exit Function
333 Catch:
334 GoTo Finally
335 End Function ' ScriptForge.SF_String.Escape
337 REM -----------------------------------------------------------------------------
338 Public Function ExpandTabs(Optional ByRef InputStr As Variant _
339 , Optional ByVal TabSize As Variant _
340 ) As String
341 ''' Return the input string with each TAB (Chr(9)) character replaced by the adequate number of spaces
342 ''' Args:
343 ''' InputStr: the input string
344 ''' TabSize: defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1
346 ''' Returns:
347 ''' The input string with spaces replacing the TAB characters
348 ''' If the input string contains line breaks, the TAB positions are reset
349 ''' Examples:
350 ''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & SF_String.sfTAB & "def", 4) returns "abc def"
351 ''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & "def" & SF_String.sfLF & SF_String.sfTAB & "ghi")
354 Dim sExpanded As String ' Return value
355 Dim lCharPosition As Long ' Position of current character in current line in expanded string
356 Dim lSpaces As Long ' Spaces counter
357 Dim sChar As String ' A single character
358 Dim i As Long
359 Const cstTabSize = 8
363 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
364 sExpanded = ""
366 Check:
367 If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = cstTabSize
368 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
371 End If
374 Try:
375 lCharPosition = 0
377 For i = 1 To Len(InputStr)
378 sChar = Mid(InputStr, i, 1)
379 Select Case sChar
380 Case SF_String.sfLF, Chr(12), SF_String.sfCR, Chr(28), Chr(29), Chr(30), Chr(133), Chr(8232), Chr(8233)
381 sExpanded = sExpanded & sChar
382 lCharPosition = 0
383 Case SF_String.sfTAB
384 lSpaces = Int(lCharPosition / TabSize + 1) * TabSize - lCharPosition
385 sExpanded = sExpanded & Space(lSpaces)
386 lCharPosition = lCharPosition + lSpaces
387 Case Else
388 sExpanded = sExpanded & sChar
389 lCharPosition = lCharPosition + 1
390 End Select
391 Next i
392 End If
394 Finally:
395 ExpandTabs = sExpanded
396 SF_Utils._ExitFunction(cstThisSub)
397 Exit Function
398 Catch:
399 GoTo Finally
400 End Function ' ScriptForge.SF_String.ExpandTabs
402 REM -----------------------------------------------------------------------------
403 Public Function FilterNotPrintable(Optional ByRef InputStr As Variant _
404 , Optional ByVal ReplacedBy As Variant _
405 ) As String
406 ''' Return the input string in which all the not printable characters are replaced by ReplacedBy
408 ''' Args:
409 ''' InputStr: the input string
410 ''' ReplacedBy: zero, one or more characters replacing the found not printable characters
411 ''' Default = the zero-length string
412 ''' Returns:
413 ''' The input string in which all the not printable characters are replaced by ReplacedBy
414 ''' Examples:
415 ''' SF_String.FilterNotPrintable("àén ΣlPµ" & Chr(10) & " Русский", "\n") returns "àén ΣlPµ\n Русский"
417 Dim sPrintable As String ' Return value
418 Dim bPrintable As Boolean ' Is a single character printable ?
419 Dim lLength As Long ' Length of InputStr
420 Dim lReplace As Long ' Length of ReplacedBy
421 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
422 Dim oLocale As Object ' com.sun.star.lang.Locale
423 Dim lType As Long ' com.sun.star.i18n.KCharacterType
424 Dim sChar As String ' A single character
425 Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE
426 Dim i As Long
430 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
431 sPrintable = ""
433 Check:
434 If IsMissing(ReplacedBy) Or IsEmpty(ReplacedBy) Then ReplacedBy = ""
435 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
438 End If
440 Try:
441 lLength = Len(InputStr)
442 lReplace = Len(ReplacedBy)
448 lType = oChar.getCharacterType(sChar, 0, oLocale)
451 If Not bPrintable Then
453 Else
454 sPrintable = sPrintable & sChar
455 End If
456 Next i
457 End If
459 Finally:
460 FilterNotPrintable = sPrintable
461 SF_Utils._ExitFunction(cstThisSub)
462 Exit Function
463 Catch:
464 GoTo Finally
465 End Function ' ScriptForge.SF_String.FilterNotPrintable
467 REM -----------------------------------------------------------------------------
468 Public Function FindRegex(Optional ByRef InputStr As Variant _
469 , Optional ByVal Regex As Variant _
470 , Optional ByRef Start As Variant _
471 , Optional ByVal CaseSensitive As Variant _
472 , Optional ByVal Forward As Variant _
473 ) As String
474 ''' Find in InputStr a substring matching a given regular expression
475 ''' Args:
476 ''' InputStr: the input string to be searched for the expression
477 ''' Regex: the regular expression
478 ''' Start (passed by reference): where to start searching from
479 ''' Should be = 1 (Forward = True) or = Len(InputStr) (Forward = False) the 1st time
480 ''' After execution points to the first character of the found substring
481 ''' CaseSensitive: default = False
482 ''' Forward: True (default) or False (backward)
483 ''' Returns:
484 ''' The found substring matching the regular expression
486 ''' Examples:
488 ''' SF_String.FindRegex("abCcdefghHij", "C.*H", lStart, CaseSensitive := True) returns "CcdefghH"
489 ''' Above statement may be reexecuted for searching the same or another pattern
490 ''' by starting from lStart + Len(matching string)
492 Dim sOutput As String ' Return value
493 Dim oTextSearch As Object ' com.sun.star.util.TextSearch
494 Dim vOptions As Variant ' com.sun.star.util.SearchOptions
495 Dim lEnd As Long ' Upper limit of search area
496 Dim vResult As Object ' com.sun.star.util.SearchResult
498 Const cstSubArgs = "InputStr, Regex, [Start=1], [CaseSensitive=False], [Forward=True]"
500 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
501 sOutput = ""
503 Check:
504 If IsMissing(Start) Or IsEmpty(Start) Then Start = 1
505 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
506 If IsMissing(Forward) Or IsEmpty(Forward) Then Forward = True
507 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
511 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
513 End If
516 Try:
517 sOutput = ""
519 ' Set pattern search options
521 With vOptions
522 .searchString = Regex
523 If CaseSensitive Then .transliterateFlags = 0 Else .transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
524 End With
525 ' Run search
526 With oTextSearch
527 .setOptions(vOptions)
528 If Forward Then
529 lEnd = Len(InputStr)
530 vResult = .searchForward(InputStr, Start - 1, lEnd)
531 Else
532 lEnd = 1
533 vResult = .searchBackward(InputStr, Start, lEnd - 1)
534 End If
535 End With
536 ' https://api.libreoffice.org/docs/idl/ref/structcom_1_1sun_1_1star_1_1util_1_1SearchResult.html
537 With vResult
539 If Forward Then
542 Else
545 End If
546 sOutput = Mid(InputStr, Start, lEnd - Start)
547 Else
548 Start = 0
549 End If
550 End With
552 Finally:
553 FindRegex = sOutput
554 SF_Utils._ExitFunction(cstThisSub)
555 Exit Function
556 Catch:
557 GoTo Finally
558 End Function ' ScriptForge.SF_String.FindRegex
560 REM -----------------------------------------------------------------------------
561 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
562 ''' Return the actual value of the given property
563 ''' Args:
564 ''' PropertyName: the name of the property as a string
565 ''' Returns:
566 ''' The actual value of the property
567 ''' Exceptions
568 ''' ARGUMENTERROR The property does not exist
573 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
574 GetProperty = Null
576 Check:
577 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
578 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
579 End If
581 Try:
582 Select Case UCase(PropertyName)
588 Case Else
589 End Select
591 Finally:
592 SF_Utils._ExitFunction(cstThisSub)
593 Exit Function
594 Catch:
595 GoTo Finally
596 End Function ' ScriptForge.SF_String.GetProperty
598 REM -----------------------------------------------------------------------------
599 Public Function HashStr(Optional ByVal InputStr As Variant _
600 , Optional ByVal Algorithm As Variant _
601 ) As String
602 ''' Return an hexadecimal string representing a checksum of the given input string
603 ''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
604 ''' Args:
605 ''' InputStr: the string to be hashed
606 ''' Algorithm: The hashing algorithm to use
607 ''' Returns:
608 ''' The requested checksum as a string. Hexadecimal digits are lower-cased
609 ''' A zero-length string when an error occurred
610 ''' Example:
611 ''' Print SF_String.HashStr("œ∑¡™£¢∞§¶•ªº–≠œ∑´®†¥¨ˆøπ“‘åß∂ƒ©˙∆˚¬", "MD5") ' 616eb9c513ad07cd02924b4d285b9987
613 Dim sHash As String ' Return value
616 Const cstSubArgs = "InputStr, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""
618 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
619 sHash = ""
621 Check:
622 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
625 , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
626 End If
628 Try:
629 With ScriptForge.SF_Session
630 sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
631 , InputStr, LCase(Algorithm))
632 End With
634 Finally:
635 HashStr = sHash
636 SF_Utils._ExitFunction(cstThisSub)
637 Exit Function
638 Catch:
639 GoTo Finally
640 End Function ' ScriptForge.SF_String.HashStr
642 REM -----------------------------------------------------------------------------
643 Public Function HtmlEncode(Optional ByRef InputStr As Variant) As String
644 ''' &-encoding of the input string (e.g. "é" becomes "&eacute;" or numeric equivalent
645 ''' Args:
646 ''' InputStr: the input string
647 ''' Returns:
648 ''' the encoded string
649 ''' Examples:
650 ''' SF_String.HtmlEncode("<a href=""https://a.b.com"">From α to ω</a>")
651 ''' returns "&lt;a href=&quot;https://a.b.com&quot;&gt;From &#945; to &#969;&lt;/a&gt;"
653 Dim sEncode As String ' Return value
654 Dim lPos As Long ' Position in InputStr
655 Dim sChar As String ' A single character extracted from InputStr
656 Dim i As Long
660 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
661 sEncode = ""
663 Check:
664 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
666 End If
668 Try:
670 lPos = 1
671 sEncode = InputStr
672 Do While lPos <= Len(sEncode)
673 sChar = Mid(sEncode, lPos, 1)
674 ' Leave as is or encode every single char
675 Select Case sChar
681 Case ":", "/", "?", "#", "[", "]", "@" ' Reserved characters
682 Case SF_String.sfCR : sChar = "" ' Carriage return
687 End Select
688 If Len(sChar) = 1 Then
689 Mid(sEncode, lPos, 1) = sChar
690 Else
692 End If
693 lPos = lPos + Len(sChar)
694 Loop
695 End If
697 Finally:
698 HtmlEncode = sEncode
699 SF_Utils._ExitFunction(cstThisSub)
700 Exit Function
701 Catch:
702 GoTo Finally
703 End Function ' ScriptForge.SF_String.HtmlEncode
705 REM -----------------------------------------------------------------------------
706 Public Function IsADate(Optional ByRef InputStr As Variant _
707 , Optional ByVal DateFormat _
708 ) As Boolean
709 ''' Return True if the string is a valid date respecting the given format
710 ''' Args:
711 ''' InputStr: the input string
712 ''' DateFormat: either YYYY-MM-DD (default), DD-MM-YYYY or MM-DD-YYYY
713 ''' The dash (-) may be replaced by a dot (.), a slash (/) or a space
714 ''' Returns:
715 ''' True if the string contains a valid date and there is at least one character
716 ''' False otherwise or if the date format is invalid
717 ''' Examples:
718 ''' SF_String.IsADate("2019-12-31", "YYYY-MM-DD") returns True
720 Dim bADate As Boolean ' Return value
721 Dim sFormat As String ' Alias for DateFormat
722 Dim sRegex As String ' The regex to check against the input string
724 Const cstFormatRegex = "(YYYY[- /.]MM[- /.]DD|MM[- /.]DD[- /.]YYYY|DD[- /.]MM[- /.]YYYY)"
725 ' The regular expression the format must match
727 Const cstSubArgs = "InputStr, [DateFormat=""" & cstFormat & """]"
729 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
730 bADate = False
732 Check:
734 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
737 End If
738 sFormat = UCase(DateFormat)
739 If Len(sFormat) <> Len(cstFormat)Then GoTo Finally
741 If Not SF_String.IsRegex(sFormat, cstFormatRegex) Then GoTo Finally
742 End If
744 Try:
745 If Len(InputStr) = Len(DateFormat) Then
747 , Array(REGEXDATEYEAR, REGEXDATEMONTH, REGEXDATEDAY) _
748 , CaseSensitive := False)
749 bADate = SF_String.IsRegex(InputStr, sRegex, CaseSensitive := False)
750 End If
752 Finally:
753 IsADate = bADate
754 SF_Utils._ExitFunction(cstThisSub)
755 Exit Function
756 Catch:
757 GoTo Finally
758 End Function ' ScriptForge.SF_String.IsADate
760 REM -----------------------------------------------------------------------------
761 Public Function IsAlpha(Optional ByRef InputStr As Variant) As Boolean
762 ''' Return True if all characters in the string are alphabetic
763 ''' Alphabetic characters are those characters defined in the Unicode character database as “Letter”
764 ''' Args:
765 ''' InputStr: the input string
766 ''' Returns:
767 ''' True if the string is alphabetic and there is at least one character, False otherwise
768 ''' Examples:
770 ''' Note:
771 ''' Use SF_String.IsRegex("...", REGEXALPHA) to limit characters to latin alphabet
773 Dim bAlpha As Boolean ' Return value
774 Dim lLength As Long ' Length of InputStr
775 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
776 Dim oLocale As Object ' com.sun.star.lang.Locale
777 Dim lType As Long ' com.sun.star.i18n.KCharacterType
778 Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER
779 Dim i As Long
783 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
784 bAlpha = False
786 Check:
787 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
789 End If
791 Try:
792 lLength = Len(InputStr)
797 lType = oChar.getCharacterType(InputStr, i, oLocale)
798 bAlpha = ( (lType And lLETTER) = lLETTER )
799 If Not bAlpha Then Exit For
800 Next i
801 End If
803 Finally:
804 IsAlpha = bAlpha
805 SF_Utils._ExitFunction(cstThisSub)
806 Exit Function
807 Catch:
808 GoTo Finally
809 End Function ' ScriptForge.SF_String.IsAlpha
811 REM -----------------------------------------------------------------------------
812 Public Function IsAlphaNum(Optional ByRef InputStr As Variant) As Boolean
813 ''' Return True if all characters in the string are alphabetic, digits or "_" (underscore)
814 ''' The first character must not be a digit
815 ''' Args:
816 ''' InputStr: the input string
817 ''' Returns:
818 ''' True if the string is alphanumeric and there is at least one character, False otherwise
819 ''' Examples:
822 Dim bAlphaNum As Boolean ' Return value
823 Dim sInputStr As String ' Alias of InputStr without underscores
824 Dim sFirst As String ' Leftmost character of InputStr
825 Dim lLength As Long ' Length of InputStr
826 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
827 Dim oLocale As Object ' com.sun.star.lang.Locale
828 Dim lType As Long ' com.sun.star.i18n.KCharacterType
829 Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER
830 Dim lDIGIT As Long : lDIGIT = com.sun.star.i18n.KCharacterType.DIGIT
831 Dim i As Long
835 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
836 bAlphaNum = False
838 Check:
839 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
841 End If
843 Try:
844 lLength = Len(InputStr)
846 sFirst = Left(InputStr, 1)
848 If bAlphaNum Then
849 sInputStr = Replace(InputStr, "_", "A") ' Replace by an arbitrary alphabetic character
853 lType = oChar.getCharacterType(sInputStr, i, oLocale)
854 bAlphaNum = ( (lType And lLETTER) = lLETTER _
855 Or (lType And lDIGIT) = lDIGIT )
856 If Not bAlphaNum Then Exit For
857 Next i
858 End If
859 End If
861 Finally:
862 IsAlphaNum = bAlphaNum
863 SF_Utils._ExitFunction(cstThisSub)
864 Exit Function
865 Catch:
866 GoTo Finally
867 End Function ' ScriptForge.SF_String.IsAlphaNum
869 REM -----------------------------------------------------------------------------
870 Public Function IsAscii(Optional ByRef InputStr As Variant) As Boolean
871 ''' Return True if all characters in the string are Ascii characters
873 ''' Args:
874 ''' InputStr: the input string
875 ''' Returns:
876 ''' True if the string is Ascii and there is at least one character, False otherwise
877 ''' Examples:
880 Dim bAscii As Boolean ' Return value
881 Dim lLength As Long ' Length of InputStr
882 Dim sChar As String ' Single character
883 Dim i As Long
887 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
888 bAscii = False
890 Check:
891 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
893 End If
895 Try:
896 lLength = Len(InputStr)
898 For i = 1 To lLength
899 sChar = Mid(InputStr, i, 1)
901 If Not bAscii Then Exit For
902 Next i
903 End If
905 Finally:
906 IsAscii = bAscii
907 SF_Utils._ExitFunction(cstThisSub)
908 Exit Function
909 Catch:
910 GoTo Finally
911 End Function ' ScriptForge.SF_String.IsAscii
913 REM -----------------------------------------------------------------------------
914 Public Function IsDigit(Optional ByRef InputStr As Variant) As Boolean
915 ''' Return True if all characters in the string are digits
916 ''' Args:
917 ''' InputStr: the input string
918 ''' Returns:
919 ''' True if the string contains only digits and there is at least one character, False otherwise
920 ''' Examples:
923 Dim bDigit As Boolean ' Return value
927 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
928 bDigit = False
930 Check:
931 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
933 End If
935 Try:
936 If Len(InputStr) > 0 Then bDigit = SF_String.IsRegex(InputStr, REGEXDIGITS, CaseSensitive := False)
938 Finally:
939 IsDigit = bDigit
940 SF_Utils._ExitFunction(cstThisSub)
941 Exit Function
942 Catch:
943 GoTo Finally
944 End Function ' ScriptForge.SF_String.IsDigit
946 REM -----------------------------------------------------------------------------
947 Public Function IsEmail(Optional ByRef InputStr As Variant) As Boolean
948 ''' Return True if the string is a valid email address
949 ''' Args:
950 ''' InputStr: the input string
951 ''' Returns:
952 ''' True if the string contains an email address and there is at least one character, False otherwise
953 ''' Examples:
956 Dim bEmail As Boolean ' Return value
960 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
961 bEmail = False
963 Check:
964 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
966 End If
968 Try:
969 If Len(InputStr) > 0 Then bEmail = SF_String.IsRegex(InputStr, REGEXEMAIL, CaseSensitive := False)
971 Finally:
972 IsEmail = bEmail
973 SF_Utils._ExitFunction(cstThisSub)
974 Exit Function
975 Catch:
976 GoTo Finally
977 End Function ' ScriptForge.SF_String.IsEmail
979 REM -----------------------------------------------------------------------------
980 Public Function IsFileName(Optional ByRef InputStr As Variant _
981 , Optional ByVal OSName As Variant _
982 ) As Boolean
983 ''' Return True if the string is a valid filename in a given operating system
984 ''' Args:
985 ''' InputStr: the input string
986 ''' OSName: Windows, Linux, macOS or Solaris
987 ''' The default is the current operating system on which the script is run
988 ''' Returns:
989 ''' True if the string contains a valid filename and there is at least one character, False otherwise
990 ''' Examples:
991 ''' SF_String.IsFileName("/home/a file name.odt", "LINUX") returns True
993 Dim bFileName As Boolean ' Return value
994 Dim sRegex As String ' Regex to apply depending on OS
996 Const cstSubArgs = "InputStr, [OSName=""Windows""|""Linux""|""macOS""|Solaris""]"
998 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
999 bFileName = False
1001 Check:
1002 If IsMissing(OSName) Or IsEmpty(OSName) Then
1003 If _SF_.OSname = "" Then _SF_.OSName = SF_Platform.OSName
1004 OSName = _SF_.OSName
1005 End If
1006 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1008 If Not SF_Utils._Validate(OSName, "OSName", V_STRING, Array("Windows", "Linux", "macOS", "Solaris")) Then GoTo Finally
1009 End If
1011 Try:
1013 Select Case UCase(OSName)
1016 End Select
1017 bFileName = SF_String.IsRegex(InputStr, sRegex, CaseSensitive := False)
1018 End If
1020 Finally:
1021 IsFileName = bFileName
1022 SF_Utils._ExitFunction(cstThisSub)
1023 Exit Function
1024 Catch:
1025 GoTo Finally
1026 End Function ' ScriptForge.SF_String.IsFileName
1028 REM -----------------------------------------------------------------------------
1029 Public Function IsHexDigit(Optional ByRef InputStr As Variant) As Boolean
1030 ''' Return True if all characters in the string are hexadecimal digits
1031 ''' Args:
1032 ''' InputStr: the input string
1033 ''' Returns:
1034 ''' True if the string contains only hexadecimal igits and there is at least one character
1036 ''' False otherwise
1037 ''' Examples:
1040 Dim bHexDigit As Boolean ' Return value
1044 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1045 bHexDigit = False
1047 Check:
1048 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1050 End If
1052 Try:
1053 If Len(InputStr) > 0 Then bHexDigit = SF_String.IsRegex(InputStr, REGEXHEXA, CaseSensitive := False)
1055 Finally:
1056 IsHexDigit = bHexDigit
1057 SF_Utils._ExitFunction(cstThisSub)
1058 Exit Function
1059 Catch:
1060 GoTo Finally
1061 End Function ' ScriptForge.SF_String.IsHexDigit
1063 REM -----------------------------------------------------------------------------
1064 Public Function IsIPv4(Optional ByRef InputStr As Variant) As Boolean
1065 ''' Return True if the string is a valid IPv4 address
1066 ''' Args:
1067 ''' InputStr: the input string
1068 ''' Returns:
1069 ''' True if the string contains a valid IPv4 address and there is at least one character, False otherwise
1070 ''' Examples:
1073 Dim bIPv4 As Boolean ' Return value
1077 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1078 bIPv4 = False
1080 Check:
1081 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1083 End If
1085 Try:
1086 If Len(InputStr) > 0 Then bIPv4 = SF_String.IsRegex(InputStr, REGEXIPV4, CaseSensitive := False)
1088 Finally:
1089 IsIPv4 = bIPv4
1090 SF_Utils._ExitFunction(cstThisSub)
1091 Exit Function
1092 Catch:
1093 GoTo Finally
1094 End Function ' ScriptForge.SF_String.IsIPv4
1096 REM -----------------------------------------------------------------------------
1097 Public Function IsLike(Optional ByRef InputStr As Variant _
1098 , Optional ByVal Pattern As Variant _
1099 , Optional ByVal CaseSensitive As Variant _
1100 ) As Boolean
1101 ''' Returns True if the whole input string matches a given pattern containing wildcards
1102 ''' Args:
1103 ''' InputStr: the input string
1104 ''' Pattern: the pattern as a string
1107 ''' CaseSensitive: default = False
1108 ''' Returns:
1109 ''' True if a match is found
1110 ''' Zero-length input or pattern strings always return False
1111 ''' Examples:
1113 ''' SF_String.IsLike("C:\a\b\c\f.odb", "?:*.*") returns True
1115 Dim bLike As Boolean ' Return value
1116 ' Build an equivalent regular expression by escaping the special characters present in Pattern
1117 Dim sRegex As String ' Equivalent regular expression
1118 Const cstSpecialChars = "\,^,$,.,|,+,(,),[,{,?,*" ' List of special chars in regular expressions
1124 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1125 bLike = False
1127 Check:
1128 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1129 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1132 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1133 End If
1135 Try:
1137 ' Substitute special chars by escaped chars
1138 sRegex = SF_String.ReplaceStr(Pattern, Split(cstSPecialChars, ","), Split(cstEscapedChars, ","))
1139 bLike = SF_String.IsRegex(InputStr, sRegex, CaseSensitive)
1140 End If
1142 Finally:
1143 IsLike = bLike
1144 SF_Utils._ExitFunction(cstThisSub)
1145 Exit Function
1146 Catch:
1147 GoTo Finally
1148 End Function ' ScriptForge.SF_String.IsLike
1150 REM -----------------------------------------------------------------------------
1151 Public Function IsLower(Optional ByRef InputStr As Variant) As Boolean
1152 ''' Return True if all characters in the string are in lower case
1153 ''' Non alphabetic characters are ignored
1154 ''' Args:
1155 ''' InputStr: the input string
1156 ''' Returns:
1157 ''' True if the string contains only lower case characters and there is at least one character, False otherwise
1158 ''' Examples:
1161 Dim bLower As Boolean ' Return value
1165 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1166 bLower = False
1168 Check:
1169 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1171 End If
1173 Try:
1176 Finally:
1177 IsLower = bLower
1178 SF_Utils._ExitFunction(cstThisSub)
1179 Exit Function
1180 Catch:
1181 GoTo Finally
1182 End Function ' ScriptForge.SF_String.IsLower
1184 REM -----------------------------------------------------------------------------
1185 Public Function IsPrintable(Optional ByRef InputStr As Variant) As Boolean
1186 ''' Return True if all characters in the string are printable
1188 ''' Args:
1189 ''' InputStr: the input string
1190 ''' Returns:
1191 ''' True if the string is printable and there is at least one character, False otherwise
1192 ''' Examples:
1195 Dim bPrintable As Boolean ' Return value
1196 Dim lLength As Long ' Length of InputStr
1197 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
1198 Dim oLocale As Object ' com.sun.star.lang.Locale
1199 Dim lType As Long ' com.sun.star.i18n.KCharacterType
1200 Dim sChar As String ' A single character
1201 Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE
1202 Dim i As Long
1206 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1207 bPrintable = False
1209 Check:
1210 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1212 End If
1214 Try:
1215 lLength = Len(InputStr)
1221 lType = oChar.getCharacterType(sChar, 0, oLocale)
1224 If Not bPrintable Then Exit For
1225 Next i
1226 End If
1228 Finally:
1229 IsPrintable = bPrintable
1230 SF_Utils._ExitFunction(cstThisSub)
1231 Exit Function
1232 Catch:
1233 GoTo Finally
1234 End Function ' ScriptForge.SF_String.IsPrintable
1236 REM -----------------------------------------------------------------------------
1237 Public Function IsRegex(Optional ByRef InputStr As Variant _
1238 , Optional ByVal Regex As Variant _
1239 , Optional ByVal CaseSensitive As Variant _
1240 ) As Boolean
1241 ''' Returns True if the whole input string matches a given regular expression
1242 ''' Args:
1243 ''' InputStr: the input string
1244 ''' Regex: the regular expression as a string
1245 ''' CaseSensitive: default = False
1246 ''' Returns:
1247 ''' True if a match is found
1248 ''' Zero-length input or regex strings always return False
1249 ''' Examples:
1252 Dim bRegex As Boolean ' Return value
1254 Dim sMatch As String ' Matching string
1260 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1261 bRegex = False
1263 Check:
1264 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1265 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1268 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1269 End If
1271 Try:
1273 ' Whole string must match Regex
1274 lStart = 1
1277 sMatch = SF_String.FindRegex(InputStr, Regex, lStart, CaseSensitive)
1278 ' Match ?
1279 bRegex = ( lStart = 1 And Len(sMatch) = Len(InputStr) )
1280 End If
1282 Finally:
1283 IsRegex = bRegex
1284 SF_Utils._ExitFunction(cstThisSub)
1285 Exit Function
1286 Catch:
1287 GoTo Finally
1288 End Function ' ScriptForge.SF_String.IsRegex
1290 REM -----------------------------------------------------------------------------
1291 Public Function IsSheetName(Optional ByRef InputStr As Variant) As Boolean
1292 ''' Return True if the input string can serve as a valid Calc sheet name
1293 ''' The sheet name must not contain the characters [ ] * ? : / \
1296 ''' Args:
1297 ''' InputStr: the input string
1298 ''' Returns:
1299 ''' True if the string is validated as a potential Calc sheet name, False otherwise
1300 ''' Examples:
1301 ''' SF_String.IsSheetName("1àbc + ""def""") returns True
1303 Dim bSheetName As Boolean ' Return value
1307 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1308 bSheetName = False
1310 Check:
1311 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1313 End If
1315 Try:
1325 = 0 Then
1326 bSheetName = True
1327 End If
1328 End If
1330 Finally:
1331 IsSheetName = bSheetName
1332 SF_Utils._ExitFunction(cstThisSub)
1333 Exit Function
1334 Catch:
1335 GoTo Finally
1336 End Function ' ScriptForge.SF_String.IsSheetName
1338 REM -----------------------------------------------------------------------------
1339 Public Function IsTitle(Optional ByRef InputStr As Variant) As Boolean
1340 ''' Return True if the 1st character of every word is in upper case and the other characters are in lower case
1341 ''' Args:
1342 ''' InputStr: the input string
1343 ''' Returns:
1344 ''' True if the string is capitalized and there is at least one character, False otherwise
1345 ''' Examples:
1348 Dim bTitle As Boolean ' Return value
1352 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1353 bTitle = False
1355 Check:
1356 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1358 End If
1360 Try:
1361 If Len(InputStr) > 0 Then bTitle = ( StrComp(InputStr, SF_String.Capitalize(InputStr), 1) = 0 )
1363 Finally:
1364 IsTitle = bTitle
1365 SF_Utils._ExitFunction(cstThisSub)
1366 Exit Function
1367 Catch:
1368 GoTo Finally
1369 End Function ' ScriptForge.SF_String.IsTitle
1371 REM -----------------------------------------------------------------------------
1372 Public Function IsUpper(Optional ByRef InputStr As Variant) As Boolean
1373 ''' Return True if all characters in the string are in upper case
1374 ''' Non alphabetic characters are ignored
1375 ''' Args:
1376 ''' InputStr: the input string
1377 ''' Returns:
1378 ''' True if the string contains only upper case characters and there is at least one character, False otherwise
1379 ''' Examples:
1382 Dim bUpper As Boolean ' Return value
1386 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1387 bUpper = False
1389 Check:
1390 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1392 End If
1394 Try:
1397 Finally:
1398 IsUpper = bUpper
1399 SF_Utils._ExitFunction(cstThisSub)
1400 Exit Function
1401 Catch:
1402 GoTo Finally
1403 End Function ' ScriptForge.SF_String.IsUpper
1405 REM -----------------------------------------------------------------------------
1406 Public Function IsUrl(Optional ByRef InputStr As Variant) As Boolean
1407 ''' Return True if the string is a valid absolute URL (Uniform Resource Locator)
1408 ''' The parsing is done by the ParseStrict method of the URLTransformer UNO service
1409 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1util_1_1XURLTransformer.html
1410 ''' Args:
1411 ''' InputStr: the input string
1412 ''' Returns:
1413 ''' True if the string contains a URL and there is at least one character, False otherwise
1414 ''' Examples:
1415 ''' SF_String.IsUrl("http://foo.bar/?q=Test%20URL-encoded%20stuff") returns True
1417 Dim bUrl As Boolean ' Return value
1421 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1422 bUrl = False
1424 Check:
1425 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1427 End If
1429 Try:
1432 Finally:
1433 IsUrl = bUrl
1434 SF_Utils._ExitFunction(cstThisSub)
1435 Exit Function
1436 Catch:
1437 GoTo Finally
1438 End Function ' ScriptForge.SF_String.IsUrl
1440 REM -----------------------------------------------------------------------------
1441 Public Function IsWhitespace(Optional ByRef InputStr As Variant) As Boolean
1442 ''' Return True if all characters in the string are whitespaces
1443 ''' Whitespaces include Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160),
1445 ''' Args:
1446 ''' InputStr: the input string
1447 ''' Returns:
1448 ''' True if the string contains only whitespaces and there is at least one character, False otherwise
1449 ''' Examples:
1450 ''' SF_String.IsWhitespace(" " & Chr(9) & Chr(10)) returns True
1452 Dim bWhitespace As Boolean ' Return value
1456 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1457 bWhitespace = False
1459 Check:
1460 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1462 End If
1464 Try:
1465 If Len(InputStr) > 0 Then bWhitespace = SF_String.IsRegex(InputStr, REGEXWHITESPACES, CaseSensitive := False)
1467 Finally:
1468 IsWhitespace = bWhitespace
1469 SF_Utils._ExitFunction(cstThisSub)
1470 Exit Function
1471 Catch:
1472 GoTo Finally
1473 End Function ' ScriptForge.SF_String.IsWhitespace
1475 REM -----------------------------------------------------------------------------
1476 Public Function JustifyCenter(Optional ByRef InputStr As Variant _
1477 , Optional ByVal Length As Variant _
1478 , Optional ByVal Padding As Variant _
1479 ) As String
1480 ''' Return the input string center justified
1481 ''' Args:
1482 ''' InputStr: the input string
1483 ''' Length: the resulting string length (default = length of input string)
1484 ''' Padding: the padding (single) character (default = the ascii space)
1485 ''' Returns:
1486 ''' The input string without its leading and trailing white spaces
1487 ''' completed left and right up to a total length of Length with the character Padding
1488 ''' If the input string is empty, the returned string is empty too
1489 ''' If the requested length is shorter than the center justified input string,
1490 ''' then the returned string is truncated
1491 ''' Examples:
1492 ''' SF_String.JustifyCenter(" ABCDE ", Padding := "x") returns "xxABCDEFxx"
1494 Dim sJustify As String ' Return value
1495 Dim lLength As Long ' Length of input string
1496 Dim lJustLength As Long ' Length of trimmed input string
1497 Dim sPadding As String ' Series of Padding characters
1499 Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]"
1501 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1502 sJustify = ""
1504 Check:
1505 If IsMissing(Length) Or IsEmpty(Length) Then Length = 0
1506 If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " "
1507 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1511 End If
1514 Try:
1515 lLength = Len(InputStr)
1516 If Length = 0 Then Length = lLength
1518 sJustify = SF_String.TrimExt(InputStr) ' Trim left and right
1519 lJustLength = Len(sJustify)
1520 If lJustLength > Length Then
1522 ElseIf lJustLength < Length Then
1523 sPadding = String(Int((Length - lJustLength) / 2), Padding)
1525 If Len(sJustify) < Length Then sJustify = sJustify & Padding ' One Padding char is lacking when lJustLength is odd
1526 End If
1527 End If
1529 Finally:
1530 JustifyCenter = sJustify
1531 SF_Utils._ExitFunction(cstThisSub)
1532 Exit Function
1533 Catch:
1534 GoTo Finally
1535 End Function ' ScriptForge.SF_String.JustifyCenter
1537 REM -----------------------------------------------------------------------------
1538 Public Function JustifyLeft(Optional ByRef InputStr As Variant _
1539 , Optional ByVal Length As Variant _
1540 , Optional ByVal Padding As Variant _
1541 ) As String
1542 ''' Return the input string left justified
1543 ''' Args:
1544 ''' InputStr: the input string
1545 ''' Length: the resulting string length (default = length of input string)
1546 ''' Padding: the padding (single) character (default = the ascii space)
1547 ''' Returns:
1548 ''' The input string without its leading white spaces
1549 ''' filled up to a total length of Length with the character Padding
1550 ''' If the input string is empty, the returned string is empty too
1551 ''' If the requested length is shorter than the left justified input string,
1552 ''' then the returned string is truncated
1553 ''' Examples:
1554 ''' SF_String.JustifyLeft(" ABCDE ", Padding := "x") returns "ABCDE xxx"
1556 Dim sJustify As String ' Return value
1557 Dim lLength As Long ' Length of input string
1559 Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]"
1561 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1562 sJustify = ""
1564 Check:
1565 If IsMissing(Length) Or IsEmpty(Length) Then Length = 0
1566 If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " "
1567 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1571 End If
1574 Try:
1575 lLength = Len(InputStr)
1576 If Length = 0 Then Length = lLength
1579 If Len(sJustify) >= Length Then
1580 sJustify = Left(sJustify, Length)
1581 Else
1582 sJustify = sJustify & String(Length - Len(sJustify), Padding)
1583 End If
1584 End If
1586 Finally:
1587 JustifyLeft = sJustify
1588 SF_Utils._ExitFunction(cstThisSub)
1589 Exit Function
1590 Catch:
1591 GoTo Finally
1592 End Function ' ScriptForge.SF_String.JustifyLeft
1594 REM -----------------------------------------------------------------------------
1595 Public Function JustifyRight(Optional ByRef InputStr As Variant _
1596 , Optional ByVal Length As Variant _
1597 , Optional ByVal Padding As Variant _
1598 ) As String
1599 ''' Return the input string right justified
1600 ''' Args:
1601 ''' InputStr: the input string
1602 ''' Length: the resulting string length (default = length of input string)
1603 ''' Padding: the padding (single) character (default = the ascii space)
1604 ''' Returns:
1605 ''' The input string without its trailing white spaces
1606 ''' preceded up to a total length of Length with the character Padding
1607 ''' If the input string is empty, the returned string is empty too
1608 ''' If the requested length is shorter than the right justified input string,
1609 ''' then the returned string is right-truncated
1610 ''' Examples:
1611 ''' SF_String.JustifyRight(" ABCDE ", Padding := "x") returns "x ABCDE"
1613 Dim sJustify As String ' Return value
1614 Dim lLength As Long ' Length of input string
1616 Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]"
1618 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1619 sJustify = ""
1621 Check:
1622 If IsMissing(Length) Or IsEmpty(Length) Then Length = 0
1623 If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " "
1624 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1628 End If
1631 Try:
1632 lLength = Len(InputStr)
1633 If Length = 0 Then Length = lLength
1636 If Len(sJustify) >= Length Then
1637 sJustify = Right(sJustify, Length)
1638 Else
1639 sJustify = String(Length - Len(sJustify), Padding) & sJustify
1640 End If
1641 End If
1643 Finally:
1644 JustifyRight = sJustify
1645 SF_Utils._ExitFunction(cstThisSub)
1646 Exit Function
1647 Catch:
1648 GoTo Finally
1649 End Function ' ScriptForge.SF_String.JustifyRight
1651 REM -----------------------------------------------------------------------------
1652 Public Function Methods() As Variant
1653 ''' Return the list of public methods of the String service as an array
1655 Methods = Array( _
1699 )
1701 End Function ' ScriptForge.SF_String.Methods
1703 REM -----------------------------------------------------------------------------
1704 Public Function Properties() As Variant
1705 ''' Return the list or properties as an array
1707 Properties = Array( _
1713 )
1715 End Function ' ScriptForge.SF_Session.Properties
1717 REM -----------------------------------------------------------------------------
1718 Public Function Quote(Optional ByRef InputStr As Variant _
1719 , Optional ByVal QuoteChar As String _
1720 ) As String
1721 ''' Return the input string surrounded with double quotes
1722 ''' Used f.i. to prepare a string field to be stored in a csv-like file
1723 ''' Args:
1724 ''' InputStr: the input string
1726 ''' Returns:
1727 ''' Existing - including leading and/or trailing - double quotes are doubled
1728 ''' Examples:
1729 ''' SF_String.Quote("àé""n ΣlPµ Русский") returns """àé""""n ΣlPµ Русский"""
1731 Dim sQuote As String ' Return value
1737 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1738 sQuote = ""
1740 Check:
1741 If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
1742 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1744 If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
1745 End If
1747 Try:
1748 If QuoteChar = cstDouble Then
1749 sQuote = cstDouble & Replace(InputStr, cstDouble, cstDouble & cstDouble) & cstDouble
1750 Else
1751 sQuote = Replace(InputStr, cstEscape, cstEscape & cstEscape)
1753 End If
1755 Finally:
1756 Quote = sQuote
1757 SF_Utils._ExitFunction(cstThisSub)
1758 Exit Function
1759 Catch:
1760 GoTo Finally
1761 End Function ' ScriptForge.SF_String.Quote
1763 REM -----------------------------------------------------------------------------
1764 Public Function ReplaceChar(Optional ByRef InputStr As Variant _
1765 , Optional ByVal Before As Variant _
1766 , Optional ByVal After As Variant _
1767 ) As String
1768 ''' Replace in InputStr all occurrences of any character from Before
1769 ''' by the corresponding character in After
1770 ''' Args:
1771 ''' InputStr: the input string on which replacements should occur
1773 ''' After: the replacing characters
1774 ''' Returns:
1775 ''' The new string after replacement of Nth character of Before by the Nth character of After
1777 ''' If the length of Before is larger than the length of After,
1778 ''' the residual characters of Before are replaced by the last character of After
1779 ''' The input string when Before is the zero-length string
1780 ''' Examples: easily remove accents
1781 ''' SF_String.ReplaceChar("Protégez votre vie privée", "àâãçèéêëîïôöûüýÿ", "aaaceeeeiioouuyy")
1783 ''' SF_String.ReplaceChar("Protégez votre vie privée", SF_String.CHARSWITHACCENT, SF_String.CHARSWITHOUTACCENT)
1785 Dim sOutput As String ' Return value
1787 Dim sBefore As String ' A single character extracted from InputStr
1788 Dim sAfter As String ' A single character extracted from After
1789 Dim lInStr As Long ' Output of InStr()
1790 Dim i As Long
1794 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1795 sOutput = ""
1797 Check:
1798 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1802 End If
1804 Try:
1805 ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive)
1806 sOutput = InputStr
1807 iCaseSensitive = 0
1809 ' Replace one by one up length of Before and After
1811 i = 1
1812 Do While i <= Len(sOutput)
1813 sBefore = Mid(sOutput, i, 1)
1814 lInStr = InStr(1, Before, sBefore, iCaseSensitive)
1816 If Len(After) = 0 Then
1817 sAfter = ""
1818 ElseIf lInStr > Len(After) Then
1819 sAfter = Right(After, 1)
1820 Else
1821 sAfter = Mid(After, lInStr, 1)
1822 End If
1823 sOutput = Left(sOutput, i - 1) & Replace(sOutput, sBefore, sAfter, i, Empty, iCaseSensitive)
1824 End If
1825 i = i + 1
1826 Loop
1827 End If
1829 Finally:
1830 ReplaceChar = sOutput
1831 SF_Utils._ExitFunction(cstThisSub)
1832 Exit Function
1833 Catch:
1834 GoTo Finally
1835 End Function ' ScriptForge.SF_String.ReplaceChar
1837 REM -----------------------------------------------------------------------------
1838 Public Function ReplaceRegex(Optional ByRef InputStr As Variant _
1839 , Optional ByVal Regex As Variant _
1840 , Optional ByRef NewStr As Variant _
1841 , Optional ByVal CaseSensitive As Variant _
1842 ) As String
1843 ''' Replace in InputStr all occurrences of a given regular expression by NewStr
1844 ''' Args:
1845 ''' InputStr: the input string where replacements should occur
1846 ''' Regex: the regular expression
1847 ''' NewStr: the replacing string
1848 ''' CaseSensitive: default = False
1849 ''' Returns:
1850 ''' The new string after all replacements
1851 ''' Examples:
1852 ''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "[a-z]", "x", CaseSensitive := True)
1853 ''' returns "Lxxxx xxxxx xxxxx xxx xxxx, xxxxxxxxxxx xxxxxxxxxx xxxx."
1854 ''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", "x", CaseSensitive := False)
1858 Dim sOutput As String ' Return value
1859 Dim lStartOld As Long ' Previous start of search
1860 Dim lStartNew As Long ' Next start of search
1861 Dim sSubstring As String ' Substring to replace
1865 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1866 sOutput = ""
1868 Check:
1869 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1870 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1874 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1875 End If
1877 Try:
1878 sOutput = ""
1879 lStartNew = 1
1880 lStartOld = 1
1883 sSubstring = SF_String.FindRegex(InputStr, Regex, lStartNew, CaseSensitive)
1885 ' Copy remaining substring of InputStr before leaving
1886 sOutput = sOutput & Mid(InputStr, lStartOld)
1887 Exit Do
1888 End If
1890 If lStartNew > lStartOld Then sOutput = sOutput & Mid(InputStr, lStartOld, lStartNew - lStartOld)
1891 sOutput = sOutput & NewStr
1892 lStartOld = lStartNew + Len(sSubstring)
1893 lStartNew = lStartOld
1894 Loop
1896 Finally:
1897 ReplaceRegex = sOutput
1898 SF_Utils._ExitFunction(cstThisSub)
1899 Exit Function
1900 Catch:
1901 GoTo Finally
1902 End Function ' ScriptForge.SF_String.ReplaceRegex
1904 REM -----------------------------------------------------------------------------
1905 Public Function ReplaceStr(Optional ByRef InputStr As Variant _
1906 , Optional ByVal OldStr As Variant _
1907 , Optional ByVal NewStr As Variant _
1908 , Optional ByVal Occurrences As Variant _
1909 , Optional ByVal CaseSensitive As Variant _
1910 ) As String
1911 ''' Replace in InputStr some or all occurrences of OldStr by NewStr
1912 ''' Args:
1913 ''' InputStr: the input string on which replacements should occur
1915 ''' Zero-length strings are ignored
1917 ''' If OldStr is an array
1918 ''' each occurrence of any of the items of OldStr is replaced by NewStr
1919 ''' If OldStr and NewStr are arrays
1920 ''' replacements occur one by one up to the UBound of NewStr
1921 ''' remaining OldStr(ings) are replaced by the last element of NewStr
1922 ''' Occurrences: the maximum number of replacements (0, default, = all occurrences)
1923 ''' Is applied for each single replacement when OldStr is an array
1924 ''' CaseSensitive: True or False (default)
1925 ''' Returns:
1926 ''' The new string after replacements
1927 ''' Replacements are done one by one when OldStr is an array => potential overlaps
1928 ''' Examples:
1929 ''' SF_String.ReplaceStr("abCcdefghHij", Array("c", "h"), Array("Y", "Z"), CaseSensitive := False) returns "abYYdefgZZij"
1931 Dim sOutput As String ' Return value
1932 Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive
1933 Dim vOccurrences As Variant ' Variant alias for Integer Occurrences
1934 Dim sNewStr As String ' Alias for a NewStr item
1935 Dim i As Long, j As Long
1937 Const cstSubArgs = "InputStr, OldStr, NewStr, [Occurrences=0], [CaseSensitive=False]"
1939 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1940 sOutput = ""
1942 Check:
1943 If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0
1944 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1945 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1947 If IsArray(OldStr) Then
1948 If Not SF_Utils._ValidateArray(OldStr, "OldStr", 1, V_STRING, True) Then GoTo Finally
1949 Else
1951 End If
1952 If IsArray(NewStr) Then
1953 If Not SF_Utils._ValidateArray(NewStr, "NewStr", 1, V_STRING, True) Then GoTo Finally
1954 Else
1956 End If
1958 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1959 End If
1961 Try:
1962 ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive)
1963 sOutput = InputStr
1966 If Not IsArray(OldStr) Then OldStr = Array(OldStr)
1967 If Not IsArray(NewStr) Then NewStr = Array(NewStr)
1969 ' Replace one by one up to UBounds of Old and NewStr
1970 j = LBound(NewStr) - 1
1971 For i = LBound(OldStr) To UBound(OldStr)
1972 j = j + 1
1975 sOutput = Replace(sOutput, OldStr(i), sNewStr, 1, vOccurrences, iCaseSensitive)
1976 End If
1977 Next i
1979 Finally:
1980 ReplaceStr = sOutput
1981 SF_Utils._ExitFunction(cstThisSub)
1982 Exit Function
1983 Catch:
1984 GoTo Finally
1985 End Function ' ScriptForge.SF_String.ReplaceStr
1987 REM -----------------------------------------------------------------------------
1988 Public Function Represent(Optional ByRef AnyValue As Variant _
1989 , Optional ByVal MaxLength As Variant _
1990 ) As String
1991 ''' Return a readable (string) form of the argument, truncated at MaxLength
1992 ''' Args:
1993 ''' AnyValue: really any value (object, date, whatever)
1994 ''' MaxLength: the maximum length of the resulting string (Default = 0, unlimited)
1995 ''' Returns:
1996 ''' The argument converted or transformed into a string of a maximum length = MaxLength
1997 ''' Objects are surrounded with square brackets ([])
1998 ''' In strings, tabs and line breaks are replaced by \t, \n or \r
1999 ''' If the effective length exceeds MaxLength, the final part of the string is replaced by " ... (N)"
2000 ''' where N = the total length of the string before truncation
2001 ''' Examples:
2002 ''' SF_String.Represent("this is a usual string") returns "this is a usual string"
2003 ''' SF_String.Represent("this is a usual string", 15) returns "this i ... (22)"
2004 ''' SF_String.Represent("this is a" & Chr(10) & " 2-lines string") returns "this is a\n 2-lines string"
2008 ''' SF_String.Represent(CreateUnoService("com.sun.star.util.PathSettings")) returns "[com.sun.star.comp.framework.PathSettings]"
2009 ''' SF_String.Represent(Array(1, 2, "Text" & Chr(9) & "here")) returns "[ARRAY] (0:2) (1, 2, Text\there)"
2010 ''' Dim myDict As Variant : myDict = CreateScriptService("Dictionary")
2012 ''' SF_String.Represent(myDict) returns "[Dictionary] ("A":1, "B":2)"
2014 Dim sRepr As String ' Return value
2018 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2019 sRepr = ""
2021 Check:
2022 If IsMissing(AnyValue) Then AnyValue = Empty
2023 If IsMissing(MaxLength) Or IsEmpty(MaxLength) Then MaxLength = 0
2024 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2026 End If
2028 Try:
2029 sRepr = SF_Utils._Repr(AnyValue, MaxLength)
2030 If MaxLength > 0 And MaxLength < Len(sRepr) Then sRepr = sRepr & " ... (" & Len(sRepr) & ")"
2032 Finally:
2033 Represent = sRepr
2034 SF_Utils._ExitFunction(cstThisSub)
2035 Exit Function
2036 Catch:
2037 GoTo Finally
2038 End Function ' ScriptForge.SF_String.Represent
2040 REM -----------------------------------------------------------------------------
2041 Public Function Reverse(Optional ByRef InputStr As Variant) As String
2042 ''' Return the input string in reversed order
2043 ''' It is equivalent to the standard StrReverse Basic function
2044 ''' The latter requires the OpTion VBASupport 1 statement to be present in the module
2045 ''' Args:
2046 ''' InputStr: the input string
2047 ''' Returns:
2048 ''' The input string in reversed order
2049 ''' Examples:
2052 Dim sReversed As String ' Return value
2053 Dim lLength As Long ' Length of input string
2054 Dim i As Long
2058 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2059 sReversed = ""
2061 Check:
2062 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2064 End If
2066 Try:
2067 lLength = Len(InputStr)
2069 sReversed = Space(lLength)
2070 For i = 1 To lLength
2072 Next i
2073 End If
2075 Finally:
2076 Reverse = sReversed
2077 SF_Utils._ExitFunction(cstThisSub)
2078 Exit Function
2079 Catch:
2080 GoTo Finally
2081 End Function ' ScriptForge.SF_String.Reverse
2083 REM -----------------------------------------------------------------------------
2084 Public Function SetProperty(Optional ByVal PropertyName As Variant _
2085 , Optional ByRef Value As Variant _
2086 ) As Boolean
2087 ''' Set a new value to the given property
2088 ''' Args:
2089 ''' PropertyName: the name of the property as a string
2090 ''' Value: its new value
2091 ''' Exceptions
2092 ''' ARGUMENTERROR The property does not exist
2097 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2098 SetProperty = False
2100 Check:
2101 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2102 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
2103 End If
2105 Try:
2106 Select Case UCase(PropertyName)
2107 Case Else
2108 End Select
2110 Finally:
2111 SF_Utils._ExitFunction(cstThisSub)
2112 Exit Function
2113 Catch:
2114 GoTo Finally
2115 End Function ' ScriptForge.SF_String.SetProperty
2117 REM -----------------------------------------------------------------------------
2118 Public Function SplitLines(Optional ByRef InputStr As Variant _
2119 , Optional ByVal KeepBreaks As Variant _
2120 ) As Variant
2121 ''' Return an array of the lines in a string, breaking at line boundaries
2122 ''' Line boundaries include LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30),
2124 ''' Args:
2125 ''' InputStr: the input string
2126 ''' KeepBreaks: when True, line breaks are preserved in the output array (default = False)
2127 ''' Returns:
2128 ''' An array of all the individual lines
2129 ''' Examples:
2130 ''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3") returns ("Line1", "Line2", "Line3")
2131 ''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3" & Chr(10)) returns ("Line1", "Line2", "Line3", "")
2133 Dim vSplit As Variant ' Return value
2134 Dim vLineBreaks As Variant ' Array of recognized line breaks
2135 Dim vTokenizedBreaks As Variant ' Array of line breaks extended with tokens
2136 Dim sAlias As String ' Alias for input string
2137 ' The procedure uses (dirty) placeholders to identify line breaks
2138 ' The used tokens are presumed unlikely present in text strings
2139 Dim sTokenCRLF As String ' Token to identify combined CR + LF
2140 Dim sToken As String ' Token to identify any line break
2141 Dim i As Long
2145 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2146 vSplit = Array()
2148 Check:
2149 If IsMissing(KeepBreaks) Or IsEmpty(KeepBreaks) Then KeepBreaks = False
2150 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2153 End If
2155 Try:
2156 ' In next list CR + LF must precede CR and LF
2157 vLineBreaks = Array(SF_String.sfCRLF, SF_String.sfLF, Chr(12), SF_String.sfCR _
2160 If KeepBreaks = False Then
2161 ' Replace line breaks by linefeeds and split on linefeeds
2162 vSplit = Split(SF_String.ReplaceStr(InputStr, vLineBreaks, SF_String.sfLF, CaseSensitive := False), SF_String.sfLF)
2163 Else
2164 sTokenCRLF = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1)
2165 sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(2)
2166 vTokenizedBreaks = Array() : ReDim vTokenizedBreaks(0 To UBound(vLineBreaks))
2167 ' Extend breaks with token
2168 For i = 0 To UBound(vLineBreaks)
2170 Next i
2171 sAlias = SF_String.ReplaceStr(InputStr, vLineBreaks, vTokenizedBreaks, CaseSensitive := False)
2172 ' Suppress CRLF tokens and split
2173 vSplit = Split(Replace(sAlias, sTokenCRLF, SF_String.sfCRLF), sToken)
2174 End If
2176 Finally:
2177 SplitLines = vSplit
2178 SF_Utils._ExitFunction(cstThisSub)
2179 Exit Function
2180 Catch:
2181 GoTo Finally
2182 End Function ' ScriptForge.SF_String.SplitLines
2184 REM -----------------------------------------------------------------------------
2185 Public Function SplitNotQuoted(Optional ByRef InputStr As Variant _
2186 , Optional ByVal Delimiter As Variant _
2187 , Optional ByVal Occurrences As Variant _
2188 , Optional ByVal QuoteChar As Variant _
2189 ) As Variant
2190 ''' Split a string on Delimiter into an array. If Delimiter is part of a quoted (sub)string, it is ignored
2191 ''' (used f.i. for parsing of csv-like records)
2192 ''' Args:
2193 ''' InputStr: the input string
2194 ''' Might contain quoted substrings:
2196 ''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character
2198 ''' Delimiter: A string of one or more characters that is used to delimit the input string
2199 ''' The default is the space character
2200 ''' Occurrences: The number of substrings to return (Default = 0, meaning no limit)
2202 ''' Returns:
2203 ''' An array whose items are chunks of the input string, Delimiter not included
2204 ''' Examples:
2205 ''' SF_String.SplitNotQuoted("abc def ghi") returns ("abc", "def", "ghi")
2206 ''' SF_String.SplitNotQuoted("abc,""def,ghi""", ",") returns ("abc", """def,ghi""")
2207 ''' SF_String.SplitNotQuoted("abc,""def\"",ghi""", ",") returns ("abc", """def\"",ghi""")
2208 ''' SF_String.SplitNotQuoted("abc,""def\"",ghi"""",", ",") returns ("abc", """def\"",ghi""", "")
2210 Dim vSplit As Variant ' Return value
2211 Dim lDelimLen As Long ' Length of Delimiter
2212 Dim vStart As Variant ' Array of start positions of quoted strings
2213 Dim vEnd As Variant ' Array of end positions of quoted strings
2214 Dim lInStr As Long ' InStr() on input string
2215 Dim lInStrPrev As Long ' Previous value of lInputStr
2216 Dim lBound As Long ' UBound of vStart and vEnd
2217 Dim lMin As Long ' Lower bound to consider when searching vStart and vEnd
2218 Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification
2219 Dim oLocale As Object ' com.sun.star.lang.Locale
2220 Dim oParse As Object ' com.sun.star.i18n.ParseResult
2221 Dim sChunk As String ' Substring of InputStr
2222 Dim bSplit As Boolean ' New chunk found or not
2223 Dim i As Long
2226 Const cstSubArgs = "InputStr, [Delimiter="" ""], [Occurrences=0], [QuoteChar=""" & cstDouble & """"
2228 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2229 vSplit = Array()
2231 Check:
2232 If IsMissing(Delimiter) Or IsEmpty(Delimiter) Then Delimiter = " "
2233 If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0
2234 If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
2235 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2239 If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
2240 End If
2243 Try:
2245 vSplit = Array(InputStr)
2247 If Occurrences > 0 Then vSplit = Split(InputStr, Delimiter, Occurrences) Else vSplit = Split(InputStr, Delimiter)
2248 Else
2253 ' Build an array of start/end positions of quoted strings containing at least 1x the Delimiter
2254 vStart = Array() : vEnd = Array()
2255 lInStr = InStr(1, InputStr, QuoteChar)
2257 lBound = UBound(vStart)
2258 ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b
2259 Set oParse = oCharacterClass.parsePredefinedToken( _
2260 Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _
2263 ' Is there some delimiter ?
2265 vStart = SF_Array.Append(vStart, lInStr + 0)
2266 vEnd = SF_Array.Append(vEnd, lInStr + oParse.CharLen - 1)
2267 End If
2268 lInStr = InStr(lInStr + oParse.CharLen, InputStr, QuoteChar)
2269 Else
2270 lInStr = 0
2271 End If
2272 Loop
2274 lBound = UBound(vStart)
2275 lDelimLen = Len(Delimiter)
2277 vSplit = Split(InputStr, Delimiter, Occurrences)
2278 Else
2279 ' Split chunk by chunk
2280 lMin = 0
2281 lInStrPrev = 0
2285 bSplit = False
2286 ' Ignore found Delimiter if in quoted string
2287 For i = lMin To lBound
2288 If lInStr < vStart(i) Then
2289 bSplit = True
2290 Exit For
2292 Exit For
2293 Else
2294 lMin = i + 1
2295 If i = lBound Then bSplit = True Else bSplit = ( lInStr < vStart(lMin) )
2296 End If
2297 Next i
2298 ' Build next chunk and store in split array
2299 If bSplit Then
2301 sChunk = Left(InputStr, lInStr - 1)
2302 Else
2303 sChunk = Mid(InputStr, lInStrPrev + lDelimLen, lInStr - lInStrPrev - lDelimLen)
2304 End If
2305 vSplit = SF_Array.Append(vSplit, sChunk & "")
2306 lInStrPrev = lInStr
2307 End If
2308 lInStr = InStr(lInStr + lDelimLen, InputStr, Delimiter, 0)
2309 Loop
2311 sChunk = Mid(InputStr, lInStrPrev + lDelimLen) ' Append last chunk
2312 vSplit = SF_Array.Append(vSplit, sChunk & "")
2313 End If
2314 End If
2315 End If
2317 Finally:
2318 SplitNotQuoted = vSplit
2319 SF_Utils._ExitFunction(cstThisSub)
2320 Exit Function
2321 Catch:
2322 GoTo Finally
2323 End Function ' ScriptForge.SF_String.SplitNotQuoted
2325 REM -----------------------------------------------------------------------------
2326 Public Function StartsWith(Optional ByRef InputStr As Variant _
2327 , Optional ByVal Substring As Variant _
2328 , Optional ByVal CaseSensitive As Variant _
2329 ) As Boolean
2330 ''' Returns True if the first characters of InputStr are identical to Substring
2331 ''' Args:
2332 ''' InputStr: the input string
2333 ''' Substring: the prefixing characters
2334 ''' CaseSensitive: default = False
2335 ''' Returns:
2336 ''' True if the comparison is satisfactory
2338 ''' False if Substr is longer than InputStr
2339 ''' Examples:
2341 ''' SF_String.StartsWith("abcdefg", "ABC", CaseSensitive := True) returns False
2343 Dim bStartsWith As Boolean ' Return value
2344 Dim lSub As Long ' Length of SUbstring
2348 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2349 bStartsWith = False
2351 Check:
2352 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
2353 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2356 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
2357 End If
2359 Try:
2360 lSub = Len(Substring)
2363 End If
2365 Finally:
2366 StartsWith = bStartsWith
2367 SF_Utils._ExitFunction(cstThisSub)
2368 Exit Function
2369 Catch:
2370 GoTo Finally
2371 End Function ' ScriptForge.SF_String.StartsWith
2373 REM -----------------------------------------------------------------------------
2374 Public Function TrimExt(Optional ByRef InputStr As Variant) As String
2375 ''' Return the input string without its leading and trailing whitespaces
2376 ''' Args:
2377 ''' InputStr: the input string
2378 ''' Returns:
2379 ''' The input string without its leading and trailing white spaces
2380 ''' Examples:
2381 ''' SF_String.TrimExt(" ABCDE" & Chr(9) & Chr(10) & Chr(13) & " ") returns "ABCDE"
2383 Dim sTrim As String ' Return value
2387 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2388 sTrim = ""
2390 Check:
2391 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2393 End If
2395 Try:
2399 End If
2401 Finally:
2402 TrimExt = sTrim
2403 SF_Utils._ExitFunction(cstThisSub)
2404 Exit Function
2405 Catch:
2406 GoTo Finally
2407 End Function ' ScriptForge.SF_String.TrimExt
2409 REM -----------------------------------------------------------------------------
2410 Public Function Unescape(Optional ByRef InputStr As Variant) As String
2411 ''' Convert any escaped characters in the input string
2412 ''' Args:
2413 ''' InputStr: the input string
2414 ''' Returns:
2415 ''' The input string after replacement of \\, \n, \r, \t sequences
2416 ''' Examples:
2417 ''' SF_String.Unescape("abc\n\tdef\\n") returns "abc" & Chr(10) & Chr(9) & "def\n"
2419 Dim sUnescape As String ' Return value
2420 Dim sToken As String ' Placeholder unlikely to be present in input string
2424 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2425 sUnescape = ""
2427 Check:
2428 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2430 End If
2432 Try:
2433 sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) ' Placeholder for "\\"
2434 sUnescape = SF_String.ReplaceStr( InputStr _
2437 )
2439 Finally:
2440 Unescape = sUnescape
2441 SF_Utils._ExitFunction(cstThisSub)
2442 Exit Function
2443 Catch:
2444 GoTo Finally
2445 End Function ' ScriptForge.SF_String.Unescape
2447 REM -----------------------------------------------------------------------------
2448 Public Function Unquote(Optional ByRef InputStr As Variant _
2449 , Optional ByVal QuoteChar As String _
2450 ) As String
2451 ''' Reset a quoted string to its original content
2452 ''' (used f.i. for parsing of csv-like records)
2453 ''' Args:
2454 ''' InputStr: the input string
2456 ''' Returns:
2457 ''' The input string after removal of leading/trailing quotes and escaped single/double quotes
2458 ''' The input string if not a quoted string
2459 ''' Examples:
2460 ''' SF_String.Unquote("""àé""""n ΣlPµ Русский""") returns "àé""n ΣlPµ Русский"
2462 Dim sUnquote As String ' Return value
2463 Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification
2464 Dim oLocale As Object ' com.sun.star.lang.Locale
2465 Dim oParse As Object ' com.sun.star.i18n.ParseResult
2470 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2471 sUnquote = ""
2473 Check:
2474 If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
2475 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2477 If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
2478 End If
2480 Try:
2482 sUnquote = InputStr
2483 Else
2487 ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b
2488 Set oParse = oCharacterClass.parsePredefinedToken( _
2489 Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _
2492 sUnquote = oParse.DequotedNameOrString
2493 Else
2494 sUnquote = InputStr
2495 End If
2496 End If
2498 Finally:
2499 Unquote = sUnquote
2500 SF_Utils._ExitFunction(cstThisSub)
2501 Exit Function
2502 Catch:
2503 GoTo Finally
2504 End Function ' ScriptForge.SF_String.Unquote
2506 REM -----------------------------------------------------------------------------
2507 Public Function Wrap(Optional ByRef InputStr As Variant _
2508 , Optional ByVal Width As Variant _
2509 , Optional ByVal TabSize As Variant _
2510 ) As Variant
2511 ''' Wraps every single paragraph in text (a string) so every line is at most Width characters long
2512 ''' Args:
2513 ''' InputStr: the input string
2515 ''' TabSize: before wrapping the text, the existing TAB (Chr(9)) characters are replaced with spaces.
2516 ''' TabSize defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1
2518 ''' Returns:
2519 ''' Returns a zero-based array of output lines, without final newlines except the pre-existing line-breaks
2520 ''' Tabs are expanded. Symbolic line breaks are replaced by their hard equivalents
2521 ''' If the wrapped output has no content, the returned array is empty.
2522 ''' Examples:
2523 ''' SF_String.Wrap("Neque porro quisquam est qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit...", 20)
2525 Dim vWrap As Variant ' Return value
2526 Dim vWrapLines ' Input string split on line breaks
2527 Dim sWrap As String ' Intermediate string
2528 Dim sLine As String ' Line after splitting on line breaks
2529 Dim lPos As Long ' Position in sLine already wrapped
2530 Dim lStart As Long ' Start position before and after regex search
2531 Dim sSpace As String ' Next whitespace
2532 Dim sChunk As String ' Next wrappable text chunk
2536 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2537 vWrap = Array()
2539 Check:
2540 If IsMissing(Width) Or IsEmpty(Width) Then Width = 70
2541 If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = 8
2542 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2546 End If
2548 Try:
2550 sWrap = SF_String.Unescape(InputStr) ' Replace symbolic breaks
2551 sWrap = SF_String.ExpandTabs(sWrap, TabSize) ' Interpret TABs to have a meaningful Width
2552 ' First, split full string
2553 vWrapLines = SF_String.SplitLines(sWrap, KeepBreaks := True) ' Keep pre-existing breaks
2555 vWrap = Array(sWrap)
2556 Else
2557 ' Second, split each line on Width
2558 For Each sLine In vWrapLines
2559 If Len(sLine) <= Width Then
2561 Else
2562 ' Scan sLine and accumulate found substrings up to Width
2563 lStart = 1
2564 lPos = 0
2565 sWrap = ""
2566 Do While lStart <= Len(sLine)
2567 sSpace = SF_String.FindRegex(sLine, REGEXSPACES, lStart)
2571 sWrap = sWrap & sChunk
2572 Else ' Save current line and initialize next one
2574 sWrap = sChunk
2575 End If
2576 lPos = lPos + Len(sChunk)
2577 lStart = lPos + 1
2578 Loop
2579 ' Add last chunk
2582 End If
2583 End If
2584 Next sLine
2585 End If
2586 End If
2588 Finally:
2589 Wrap = vWrap
2590 SF_Utils._ExitFunction(cstThisSub)
2591 Exit Function
2592 Catch:
2593 GoTo Finally
2594 End Function ' ScriptForge.SF_String.Wrap
2596 REM ============================================================= PRIVATE METHODS
2598 REM -----------------------------------------------------------------------------
2599 Private Function _Repr(ByRef pvString As String) As String
2600 ''' Convert an arbitrary string to a readable string, typically for debugging purposes (DebugPrint ...)
2601 ''' Carriage Returns are replaced by \r. Other line breaks are replaced by \n
2602 ''' Tabs are replaced by \t
2603 ''' Backslashes are doubled
2604 ''' Other non printable characters are replaced by \x00 to \xFF or \x0000 to \xFFFF
2605 ''' Args:
2606 ''' pvString: the string to make readable
2607 ''' Return:
2608 ''' the converted string
2610 Dim sString As String ' Return value
2611 Dim sChar As String ' A single character
2612 Dim lAsc As Long ' Ascii value
2613 Dim lPos As Long ' Position in sString
2614 Dim i As Long
2616 ' Process TABs, CRs and LFs
2617 sString = Replace(Replace(Replace(pvString, "\", "\\"), SF_String.sfCR, "\r"), SF_String.sfTAB, "\t")
2619 ' Process not printable characters
2621 lPos = 1
2622 Do While lPos <= Len(sString)
2623 sChar = Mid(sString, lPos, 1)
2624 If Not SF_String.IsPrintable(sChar) Then
2625 lAsc = Asc(sChar)
2626 sChar = "\x" & Iif(lAsc < 255, Right("00" & Hex(lAsc, 2)), Right("0000" & Hex(lAsc, 4)))
2627 If lPos < Len(sString) Then
2629 Else
2631 End If
2632 End If
2633 lPos = lPos + Len(sChar)
2634 Loop
2635 End If
2637 _Repr = sString
2639 End Function ' ScriptForge.SF_String._Repr
2641 REM ================================================ END OF SCRIPTFORGE.SF_STRING
2642 </script:module>