| blob | 888cf672c5da25f7e95f4e9a6358b1474504427e |
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 ''' Detailed user documentation:
41 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_string.html?DbPAR=BASIC
42 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
43 ''' Some references:
44 ''' https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1i18n_1_1KCharacterType.html
45 ''' com.sun.star.i18n.KCharacterType.###
46 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html
47 ''' com.sun.star.i18n.XCharacterClassification
49 REM ============================================================ MODULE CONSTANTS
51 ''' Most expressions below are derived from https://www.regular-expressions.info/
60 Const REGEXTIMESEC = REGEXTIMEMIN
66 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]?)$"
74 ''' Accented characters substitution: https://docs.google.com/spreadsheets/d/1pJKSueZK8RkAcJFQIiKpYUamWSC1u1xVQchK7Z7BIwc/edit#gid=0
75 ''' (Many of them are in the list, but do not consider the list as closed vs. the Unicode database)
77 Const cstCHARSWITHACCENT = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿŠšŸŽž" _
78 & "ĂăĐđĨĩŨũƠơƯưẠạẢảẤấẦầẨẩẪẫẬậẮắẰằẲẳẴẵẶặẸẹẺẻẼẽẾếỀềỂểỄễỆệỈỉỊịỌọỎỏỐốỒồỔổỖỗỘộỚớỜờỞởỠỡỢợỤụỦủỨứỪừỬửỮữỰựỲỳỴỵỶỷỸỹ₫"
79 Const cstCHARSWITHOUTACCENT = "AAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyySsYZz" _
80 & "AaDdIiUuOoUuAaAaAaAaAaAaAaAaAaAaAaAaEeEeEeEeEeEeEeEeIiIiOoOoOoOoOoOoOoOoOoOoOoOoUuUuUuUuUuUuUuYyYyYyYyd"
82 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
84 REM -----------------------------------------------------------------------------
85 Public Function Dispose() As Variant
86 Set Dispose = Nothing
87 End Function ' ScriptForge.SF_String Explicit destructor
89 REM ================================================================== PROPERTIES
91 REM -----------------------------------------------------------------------------
92 Property Get CHARSWITHACCENT() As String
93 ''' Latin accents
94 CHARSWITHACCENT = cstCHARSWITHACCENT
95 End Property ' ScriptForge.SF_String.CHARSWITHACCENT
97 REM -----------------------------------------------------------------------------
98 Property Get CHARSWITHOUTACCENT() As String
99 ''' Latin accents
100 CHARSWITHOUTACCENT = cstCHARSWITHOUTACCENT
101 End Property ' ScriptForge.SF_String.CHARSWITHOUTACCENT
103 ''' Symbolic constants for linebreaks
104 REM -----------------------------------------------------------------------------
105 Property Get sfCR() As Variant
106 ''' Carriage return
107 sfCR = Chr(13)
108 End Property ' ScriptForge.SF_String.sfCR
110 REM -----------------------------------------------------------------------------
111 Property Get sfCRLF() As Variant
112 ''' Carriage return
114 End Property ' ScriptForge.SF_String.sfCRLF
116 REM -----------------------------------------------------------------------------
117 Property Get sfLF() As Variant
118 ''' Linefeed
119 sfLF = Chr(10)
120 End Property ' ScriptForge.SF_String.sfLF
122 REM -----------------------------------------------------------------------------
123 Property Get sfNEWLINE() As Variant
124 ''' Linefeed or Carriage return + Linefeed
126 End Property ' ScriptForge.SF_String.sfNEWLINE
128 REM -----------------------------------------------------------------------------
129 Property Get sfTAB() As Variant
130 ''' Horizontal tabulation
131 sfTAB = Chr(9)
132 End Property ' ScriptForge.SF_String.sfTAB
134 REM -----------------------------------------------------------------------------
135 Property Get ObjectType As String
136 ''' Only to enable object representation
138 End Property ' ScriptForge.SF_String.ObjectType
140 REM -----------------------------------------------------------------------------
141 Property Get ServiceName As String
142 ''' Internal use
144 End Property ' ScriptForge.SF_String.ServiceName
146 REM ============================================================== PUBLIC METHODS
148 REM -----------------------------------------------------------------------------
149 Public Function Capitalize(Optional ByRef InputStr As Variant) As String
151 ''' Args:
152 ''' InputStr: the input string
153 ''' Returns:
155 ''' Examples:
156 ''' SF_String.Capitalize("this is a title for jean-pierre") returns "This Is A Title For Jean-Pierre"
158 Dim sCapital As String ' Return value
159 Dim lLength As Long ' Length of input string
160 Dim oLocale As Object ' com.sun.star.lang.Locale
161 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
165 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
166 sCapital = ""
168 Check:
169 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
171 End If
173 Try:
174 lLength = Len(InputStr)
178 sCapital = oChar.toTitle(InputStr, 0, lLength * 4, oLocale) ' length * 4 because length is expressed in bytes
179 End If
181 Finally:
182 Capitalize = sCapital
183 SF_Utils._ExitFunction(cstThisSub)
184 Exit Function
185 Catch:
186 GoTo Finally
187 End Function ' ScriptForge.SF_String.Capitalize
189 REM -----------------------------------------------------------------------------
190 Public Function Count(Optional ByRef InputStr As Variant _
191 , Optional ByVal Substring As Variant _
192 , Optional ByRef IsRegex As Variant _
193 , Optional ByVal CaseSensitive As Variant _
194 ) As Long
195 ''' Counts the number of occurrences of a substring or a regular expression within a string
196 ''' Args:
197 ''' InputStr: the input stringto examine
198 ''' Substring: the substring to identify
199 ''' IsRegex: True if Substring is a regular expression (default = False)
200 ''' CaseSensitive: default = False
201 ''' Returns:
202 ''' The number of occurrences as a Long
203 ''' Examples:
204 ''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", IsRegex := True, CaseSensitive := True)
206 ''' SF_String.Count("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "or", CaseSensitive := False)
210 Dim lOccurrences As Long ' Return value
211 Dim lStart As Long ' Start index of search
212 Dim sSubstring As String ' Substring to replace
213 Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive
217 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
218 lOccurrences = 0
220 Check:
221 If IsMissing(IsRegex) Or IsEmpty(IsRegex) Then IsRegex = False
222 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
223 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
227 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
228 End If
230 Try:
232 lStart = 1
235 Select Case IsRegex
236 Case False ' Use InStr
237 lStart = InStr(lStart, InputStr, Substring, iCaseSensitive)
238 If lStart = 0 Then Exit Do
239 lStart = lStart + Len(Substring)
240 Case True ' Use FindRegex
241 sSubstring = SF_String.FindRegex(InputStr, Substring, lStart, CaseSensitive)
242 If lStart = 0 Then Exit Do
243 lStart = lStart + Len(sSubstring)
244 End Select
245 lOccurrences = lOccurrences + 1
246 Loop
248 Finally:
249 Count = lOccurrences
250 SF_Utils._ExitFunction(cstThisSub)
251 Exit Function
252 Catch:
253 GoTo Finally
254 End Function ' ScriptForge.SF_String.Count
256 REM -----------------------------------------------------------------------------
257 Public Function EndsWith(Optional ByRef InputStr As Variant _
258 , Optional ByVal Substring As Variant _
259 , Optional ByVal CaseSensitive As Variant _
260 ) As Boolean
261 ''' Returns True if the last characters of InputStr are identical to Substring
262 ''' Args:
263 ''' InputStr: the input string
264 ''' Substring: the suffixing characters
265 ''' CaseSensitive: default = False
266 ''' Returns:
267 ''' True if the comparison is satisfactory
269 ''' False if Substr is longer than InputStr
270 ''' Examples:
272 ''' SF_String.EndsWith("abcdefg", "EFG", CaseSensitive := True) returns False
274 Dim bEndsWith As Boolean ' Return value
275 Dim lSub As Long ' Length of SUbstring
279 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
280 bEndsWith = False
282 Check:
283 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
284 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
287 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
288 End If
290 Try:
291 lSub = Len(Substring)
294 End If
296 Finally:
297 EndsWith = bEndsWith
298 SF_Utils._ExitFunction(cstThisSub)
299 Exit Function
300 Catch:
301 GoTo Finally
302 End Function ' ScriptForge.SF_String.EndsWith
304 REM -----------------------------------------------------------------------------
305 Public Function Escape(Optional ByRef InputStr As Variant) As String
306 ''' Convert any hard line breaks or tabs by their escaped equivalent
307 ''' Args:
308 ''' InputStr: the input string
309 ''' Returns:
310 ''' The input string after replacement of "\", Chr(10), Chr(13), Chr(9)characters
311 ''' Examples:
312 ''' SF_String.Escape("abc" & Chr(10) & Chr(9) & "def\n") returns "abc\n\tdef\\n"
314 Dim sEscape As String ' Return value
318 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
319 sEscape = ""
321 Check:
322 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
324 End If
326 Try:
327 sEscape = SF_String.ReplaceStr( InputStr _
330 )
332 Finally:
333 Escape = sEscape
334 SF_Utils._ExitFunction(cstThisSub)
335 Exit Function
336 Catch:
337 GoTo Finally
338 End Function ' ScriptForge.SF_String.Escape
340 REM -----------------------------------------------------------------------------
341 Public Function ExpandTabs(Optional ByRef InputStr As Variant _
342 , Optional ByVal TabSize As Variant _
343 ) As String
344 ''' Return the input string with each TAB (Chr(9)) character replaced by the adequate number of spaces
345 ''' Args:
346 ''' InputStr: the input string
347 ''' TabSize: defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1
349 ''' Returns:
350 ''' The input string with spaces replacing the TAB characters
351 ''' If the input string contains line breaks, the TAB positions are reset
352 ''' Examples:
353 ''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & SF_String.sfTAB & "def", 4) returns "abc def"
354 ''' SF_String.ExpandTabs("abc" & SF_String.sfTAB & "def" & SF_String.sfLF & SF_String.sfTAB & "ghi")
357 Dim sExpanded As String ' Return value
358 Dim lCharPosition As Long ' Position of current character in current line in expanded string
359 Dim lSpaces As Long ' Spaces counter
360 Dim sChar As String ' A single character
361 Dim i As Long
362 Const cstTabSize = 8
366 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
367 sExpanded = ""
369 Check:
370 If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = cstTabSize
371 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
374 End If
377 Try:
378 lCharPosition = 0
380 For i = 1 To Len(InputStr)
381 sChar = Mid(InputStr, i, 1)
382 Select Case sChar
383 Case SF_String.sfLF, Chr(12), SF_String.sfCR, Chr(28), Chr(29), Chr(30), Chr(133), Chr(8232), Chr(8233)
384 sExpanded = sExpanded & sChar
385 lCharPosition = 0
386 Case SF_String.sfTAB
387 lSpaces = Int(lCharPosition / TabSize + 1) * TabSize - lCharPosition
388 sExpanded = sExpanded & Space(lSpaces)
389 lCharPosition = lCharPosition + lSpaces
390 Case Else
391 sExpanded = sExpanded & sChar
392 lCharPosition = lCharPosition + 1
393 End Select
394 Next i
395 End If
397 Finally:
398 ExpandTabs = sExpanded
399 SF_Utils._ExitFunction(cstThisSub)
400 Exit Function
401 Catch:
402 GoTo Finally
403 End Function ' ScriptForge.SF_String.ExpandTabs
405 REM -----------------------------------------------------------------------------
406 Public Function FilterNotPrintable(Optional ByRef InputStr As Variant _
407 , Optional ByVal ReplacedBy As Variant _
408 ) As String
409 ''' Return the input string in which all the not printable characters are replaced by ReplacedBy
411 ''' Args:
412 ''' InputStr: the input string
413 ''' ReplacedBy: zero, one or more characters replacing the found not printable characters
414 ''' Default = the zero-length string
415 ''' Returns:
416 ''' The input string in which all the not printable characters are replaced by ReplacedBy
417 ''' Examples:
418 ''' SF_String.FilterNotPrintable("àén ΣlPµ" & Chr(10) & " Русский", "\n") returns "àén ΣlPµ\n Русский"
420 Dim sPrintable As String ' Return value
421 Dim bPrintable As Boolean ' Is a single character printable ?
422 Dim lLength As Long ' Length of InputStr
423 Dim lReplace As Long ' Length of ReplacedBy
424 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
425 Dim oLocale As Object ' com.sun.star.lang.Locale
426 Dim lType As Long ' com.sun.star.i18n.KCharacterType
427 Dim sChar As String ' A single character
428 Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE
429 Dim i As Long
433 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
434 sPrintable = ""
436 Check:
437 If IsMissing(ReplacedBy) Or IsEmpty(ReplacedBy) Then ReplacedBy = ""
438 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
441 End If
443 Try:
444 lLength = Len(InputStr)
445 lReplace = Len(ReplacedBy)
451 lType = oChar.getCharacterType(sChar, 0, oLocale)
454 If Not bPrintable Then
456 Else
457 sPrintable = sPrintable & sChar
458 End If
459 Next i
460 End If
462 Finally:
463 FilterNotPrintable = sPrintable
464 SF_Utils._ExitFunction(cstThisSub)
465 Exit Function
466 Catch:
467 GoTo Finally
468 End Function ' ScriptForge.SF_String.FilterNotPrintable
470 REM -----------------------------------------------------------------------------
471 Public Function FindRegex(Optional ByRef InputStr As Variant _
472 , Optional ByVal Regex As Variant _
473 , Optional ByRef Start As Variant _
474 , Optional ByVal CaseSensitive As Variant _
475 , Optional ByVal Forward As Variant _
476 ) As String
477 ''' Find in InputStr a substring matching a given regular expression
478 ''' Args:
479 ''' InputStr: the input string to be searched for the expression
480 ''' Regex: the regular expression
481 ''' Start (passed by reference): where to start searching from
482 ''' Should be = 1 (Forward = True) or = Len(InputStr) (Forward = False) the 1st time
483 ''' After execution points to the first character of the found substring
484 ''' CaseSensitive: default = False
485 ''' Forward: True (default) or False (backward)
486 ''' Returns:
487 ''' The found substring matching the regular expression
489 ''' Examples:
491 ''' SF_String.FindRegex("abCcdefghHij", "C.*H", lStart, CaseSensitive := True) returns "CcdefghH"
492 ''' Above statement may be reexecuted for searching the same or another pattern
493 ''' by starting from lStart + Len(matching string)
495 Dim sOutput As String ' Return value
496 Dim oTextSearch As Object ' com.sun.star.util.TextSearch
497 Dim vOptions As Variant ' com.sun.star.util.SearchOptions
498 Dim lEnd As Long ' Upper limit of search area
499 Dim vResult As Object ' com.sun.star.util.SearchResult
501 Const cstSubArgs = "InputStr, Regex, [Start=1], [CaseSensitive=False], [Forward=True]"
503 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
504 sOutput = ""
506 Check:
507 If IsMissing(Start) Or IsEmpty(Start) Then Start = 1
508 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
509 If IsMissing(Forward) Or IsEmpty(Forward) Then Forward = True
510 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
514 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
516 End If
519 Try:
520 sOutput = ""
522 ' Set pattern search options
524 With vOptions
525 .searchString = Regex
526 If CaseSensitive Then .transliterateFlags = 0 Else .transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
527 End With
528 ' Run search
529 With oTextSearch
530 .setOptions(vOptions)
531 If Forward Then
532 lEnd = Len(InputStr)
533 vResult = .searchForward(InputStr, Start - 1, lEnd)
534 Else
535 lEnd = 1
536 vResult = .searchBackward(InputStr, Start, lEnd - 1)
537 End If
538 End With
539 ' https://api.libreoffice.org/docs/idl/ref/structcom_1_1sun_1_1star_1_1util_1_1SearchResult.html
540 With vResult
542 If Forward Then
545 Else
548 End If
549 sOutput = Mid(InputStr, Start, lEnd - Start)
550 Else
551 Start = 0
552 End If
553 End With
555 Finally:
556 FindRegex = sOutput
557 SF_Utils._ExitFunction(cstThisSub)
558 Exit Function
559 Catch:
560 GoTo Finally
561 End Function ' ScriptForge.SF_String.FindRegex
563 REM -----------------------------------------------------------------------------
564 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
565 ''' Return the actual value of the given property
566 ''' Args:
567 ''' PropertyName: the name of the property as a string
568 ''' Returns:
569 ''' The actual value of the property
570 ''' Exceptions
571 ''' ARGUMENTERROR The property does not exist
576 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
577 GetProperty = Null
579 Check:
580 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
581 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
582 End If
584 Try:
585 Select Case UCase(PropertyName)
591 Case Else
592 End Select
594 Finally:
595 SF_Utils._ExitFunction(cstThisSub)
596 Exit Function
597 Catch:
598 GoTo Finally
599 End Function ' ScriptForge.SF_String.GetProperty
601 REM -----------------------------------------------------------------------------
602 Public Function HashStr(Optional ByVal InputStr As Variant _
603 , Optional ByVal Algorithm As Variant _
604 ) As String
605 ''' Return an hexadecimal string representing a checksum of the given input string
606 ''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
607 ''' Args:
608 ''' InputStr: the string to be hashed
609 ''' Algorithm: The hashing algorithm to use
610 ''' Returns:
611 ''' The requested checksum as a string. Hexadecimal digits are lower-cased
612 ''' A zero-length string when an error occurred
613 ''' Example:
614 ''' Print SF_String.HashStr("œ∑¡™£¢∞§¶•ªº–≠œ∑´®†¥¨ˆøπ“‘åß∂ƒ©˙∆˚¬", "MD5") ' 616eb9c513ad07cd02924b4d285b9987
616 Dim sHash As String ' Return value
619 Const cstSubArgs = "InputStr, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""
621 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
622 sHash = ""
624 Check:
625 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
628 , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
629 End If
631 Try:
632 With ScriptForge.SF_Session
633 sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
634 , InputStr, LCase(Algorithm))
635 End With
637 Finally:
638 HashStr = sHash
639 SF_Utils._ExitFunction(cstThisSub)
640 Exit Function
641 Catch:
642 GoTo Finally
643 End Function ' ScriptForge.SF_String.HashStr
645 REM -----------------------------------------------------------------------------
646 Public Function HtmlEncode(Optional ByRef InputStr As Variant) As String
647 ''' &-encoding of the input string (e.g. "é" becomes "&eacute;" or numeric equivalent
648 ''' Args:
649 ''' InputStr: the input string
650 ''' Returns:
651 ''' the encoded string
652 ''' Examples:
653 ''' SF_String.HtmlEncode("<a href=""https://a.b.com"">From α to ω</a>")
654 ''' returns "&lt;a href=&quot;https://a.b.com&quot;&gt;From &#945; to &#969;&lt;/a&gt;"
656 Dim sEncode As String ' Return value
657 Dim lPos As Long ' Position in InputStr
658 Dim sChar As String ' A single character extracted from InputStr
659 Dim i As Long
663 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
664 sEncode = ""
666 Check:
667 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
669 End If
671 Try:
673 lPos = 1
674 sEncode = InputStr
675 Do While lPos <= Len(sEncode)
676 sChar = Mid(sEncode, lPos, 1)
677 ' Leave as is or encode every single char
678 Select Case sChar
684 Case ":", "/", "?", "#", "[", "]", "@" ' Reserved characters
685 Case SF_String.sfCR : sChar = "" ' Carriage return
690 End Select
691 If Len(sChar) = 1 Then
692 Mid(sEncode, lPos, 1) = sChar
693 Else
695 End If
696 lPos = lPos + Len(sChar)
697 Loop
698 End If
700 Finally:
701 HtmlEncode = sEncode
702 SF_Utils._ExitFunction(cstThisSub)
703 Exit Function
704 Catch:
705 GoTo Finally
706 End Function ' ScriptForge.SF_String.HtmlEncode
708 REM -----------------------------------------------------------------------------
709 Public Function IsADate(Optional ByRef InputStr As Variant _
710 , Optional ByVal DateFormat _
711 ) As Boolean
712 ''' Return True if the string is a valid date respecting the given format
713 ''' Args:
714 ''' InputStr: the input string
715 ''' DateFormat: either YYYY-MM-DD (default), DD-MM-YYYY or MM-DD-YYYY
716 ''' The dash (-) may be replaced by a dot (.), a slash (/) or a space
717 ''' Returns:
718 ''' True if the string contains a valid date and there is at least one character
719 ''' False otherwise or if the date format is invalid
720 ''' Examples:
721 ''' SF_String.IsADate("2019-12-31", "YYYY-MM-DD") returns True
723 Dim bADate As Boolean ' Return value
724 Dim sFormat As String ' Alias for DateFormat
725 Dim iYear As Integer ' Alias of year in input string
726 Dim iMonth As Integer ' Alias of month in input string
727 Dim iDay As Integer ' Alias of day in input string
728 Dim dDate As Date ' Date value
730 Const cstFormatRegex = "(YYYY[- /.]MM[- /.]DD|MM[- /.]DD[- /.]YYYY|DD[- /.]MM[- /.]YYYY)"
731 ' The regular expression the format must match
733 Const cstSubArgs = "InputStr, [DateFormat=""" & cstFormat & """]"
735 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
736 bADate = False
738 Check:
740 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
743 End If
744 sFormat = UCase(DateFormat)
745 If Len(sFormat) <> Len(cstFormat)Then GoTo Finally
747 If Not SF_String.IsRegex(sFormat, cstFormatRegex) Then GoTo Finally
748 End If
750 Try:
751 If Len(InputStr) = Len(DateFormat) Then
752 ' Extract the date components YYYY, MM, DD from the input string
756 ' Check the validity of the date
757 On Local Error GoTo NotADate
758 dDate = DateSerial(iYear, iMonth, iDay)
759 bADate = True ' Statement reached only if no error
760 End If
762 Finally:
763 IsADate = bADate
764 SF_Utils._ExitFunction(cstThisSub)
765 Exit Function
766 Catch:
767 GoTo Finally
768 NotADate:
770 GoTo Finally
771 End Function ' ScriptForge.SF_String.IsADate
773 REM -----------------------------------------------------------------------------
774 Public Function IsAlpha(Optional ByRef InputStr As Variant) As Boolean
775 ''' Return True if all characters in the string are alphabetic
776 ''' Alphabetic characters are those characters defined in the Unicode character database as “Letter”
777 ''' Args:
778 ''' InputStr: the input string
779 ''' Returns:
780 ''' True if the string is alphabetic and there is at least one character, False otherwise
781 ''' Examples:
783 ''' Note:
784 ''' Use SF_String.IsRegex("...", REGEXALPHA) to limit characters to latin alphabet
786 Dim bAlpha As Boolean ' Return value
787 Dim lLength As Long ' Length of InputStr
788 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
789 Dim oLocale As Object ' com.sun.star.lang.Locale
790 Dim lType As Long ' com.sun.star.i18n.KCharacterType
791 Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER
792 Dim i As Long
796 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
797 bAlpha = False
799 Check:
800 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
802 End If
804 Try:
805 lLength = Len(InputStr)
810 lType = oChar.getCharacterType(InputStr, i, oLocale)
811 bAlpha = ( (lType And lLETTER) = lLETTER )
812 If Not bAlpha Then Exit For
813 Next i
814 End If
816 Finally:
817 IsAlpha = bAlpha
818 SF_Utils._ExitFunction(cstThisSub)
819 Exit Function
820 Catch:
821 GoTo Finally
822 End Function ' ScriptForge.SF_String.IsAlpha
824 REM -----------------------------------------------------------------------------
825 Public Function IsAlphaNum(Optional ByRef InputStr As Variant) As Boolean
826 ''' Return True if all characters in the string are alphabetic, digits or "_" (underscore)
827 ''' The first character must not be a digit
828 ''' Args:
829 ''' InputStr: the input string
830 ''' Returns:
831 ''' True if the string is alphanumeric and there is at least one character, False otherwise
832 ''' Examples:
835 Dim bAlphaNum As Boolean ' Return value
836 Dim sInputStr As String ' Alias of InputStr without underscores
837 Dim sFirst As String ' Leftmost character of InputStr
838 Dim lLength As Long ' Length of InputStr
839 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
840 Dim oLocale As Object ' com.sun.star.lang.Locale
841 Dim lType As Long ' com.sun.star.i18n.KCharacterType
842 Dim lLETTER As Long : lLETTER = com.sun.star.i18n.KCharacterType.LETTER
843 Dim lDIGIT As Long : lDIGIT = com.sun.star.i18n.KCharacterType.DIGIT
844 Dim i As Long
848 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
849 bAlphaNum = False
851 Check:
852 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
854 End If
856 Try:
857 lLength = Len(InputStr)
859 sFirst = Left(InputStr, 1)
861 If bAlphaNum Then
862 sInputStr = Replace(InputStr, "_", "A") ' Replace by an arbitrary alphabetic character
866 lType = oChar.getCharacterType(sInputStr, i, oLocale)
867 bAlphaNum = ( (lType And lLETTER) = lLETTER _
868 Or (lType And lDIGIT) = lDIGIT )
869 If Not bAlphaNum Then Exit For
870 Next i
871 End If
872 End If
874 Finally:
875 IsAlphaNum = bAlphaNum
876 SF_Utils._ExitFunction(cstThisSub)
877 Exit Function
878 Catch:
879 GoTo Finally
880 End Function ' ScriptForge.SF_String.IsAlphaNum
882 REM -----------------------------------------------------------------------------
883 Public Function IsAscii(Optional ByRef InputStr As Variant) As Boolean
884 ''' Return True if all characters in the string are Ascii characters
886 ''' Args:
887 ''' InputStr: the input string
888 ''' Returns:
889 ''' True if the string is Ascii and there is at least one character, False otherwise
890 ''' Examples:
893 Dim bAscii As Boolean ' Return value
894 Dim lLength As Long ' Length of InputStr
895 Dim sChar As String ' Single character
896 Dim i As Long
900 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
901 bAscii = False
903 Check:
904 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
906 End If
908 Try:
909 lLength = Len(InputStr)
911 For i = 1 To lLength
912 sChar = Mid(InputStr, i, 1)
914 If Not bAscii Then Exit For
915 Next i
916 End If
918 Finally:
919 IsAscii = bAscii
920 SF_Utils._ExitFunction(cstThisSub)
921 Exit Function
922 Catch:
923 GoTo Finally
924 End Function ' ScriptForge.SF_String.IsAscii
926 REM -----------------------------------------------------------------------------
927 Public Function IsDigit(Optional ByRef InputStr As Variant) As Boolean
928 ''' Return True if all characters in the string are digits
929 ''' Args:
930 ''' InputStr: the input string
931 ''' Returns:
932 ''' True if the string contains only digits and there is at least one character, False otherwise
933 ''' Examples:
936 Dim bDigit As Boolean ' Return value
940 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
941 bDigit = False
943 Check:
944 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
946 End If
948 Try:
949 If Len(InputStr) > 0 Then bDigit = SF_String.IsRegex(InputStr, REGEXDIGITS, CaseSensitive := False)
951 Finally:
952 IsDigit = bDigit
953 SF_Utils._ExitFunction(cstThisSub)
954 Exit Function
955 Catch:
956 GoTo Finally
957 End Function ' ScriptForge.SF_String.IsDigit
959 REM -----------------------------------------------------------------------------
960 Public Function IsEmail(Optional ByRef InputStr As Variant) As Boolean
961 ''' Return True if the string is a valid email address
962 ''' Args:
963 ''' InputStr: the input string
964 ''' Returns:
965 ''' True if the string contains an email address and there is at least one character, False otherwise
966 ''' Examples:
969 Dim bEmail As Boolean ' Return value
973 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
974 bEmail = False
976 Check:
977 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
979 End If
981 Try:
982 If Len(InputStr) > 0 Then bEmail = SF_String.IsRegex(InputStr, REGEXEMAIL, CaseSensitive := False)
984 Finally:
985 IsEmail = bEmail
986 SF_Utils._ExitFunction(cstThisSub)
987 Exit Function
988 Catch:
989 GoTo Finally
990 End Function ' ScriptForge.SF_String.IsEmail
992 REM -----------------------------------------------------------------------------
993 Public Function IsFileName(Optional ByRef InputStr As Variant _
994 , Optional ByVal OSName As Variant _
995 ) As Boolean
996 ''' Return True if the string is a valid filename in a given operating system
997 ''' Args:
998 ''' InputStr: the input string
999 ''' OSName: Windows, Linux, macOS or Solaris
1000 ''' The default is the current operating system on which the script is run
1001 ''' Returns:
1002 ''' True if the string contains a valid filename and there is at least one character, False otherwise
1003 ''' Examples:
1004 ''' SF_String.IsFileName("/home/a file name.odt", "LINUX") returns True
1006 Dim bFileName As Boolean ' Return value
1007 Dim sRegex As String ' Regex to apply depending on OS
1009 Const cstSubArgs = "InputStr, [OSName=""Windows""|""Linux""|""macOS""|Solaris""]"
1011 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1012 bFileName = False
1014 Check:
1015 If IsMissing(OSName) Or IsEmpty(OSName) Then
1016 If _SF_.OSname = "" Then _SF_.OSName = SF_Platform.OSName
1017 OSName = _SF_.OSName
1018 End If
1019 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1021 If Not SF_Utils._Validate(OSName, "OSName", V_STRING, Array("Windows", "Linux", "macOS", "Solaris")) Then GoTo Finally
1022 End If
1024 Try:
1026 Select Case UCase(OSName)
1029 End Select
1030 bFileName = SF_String.IsRegex(InputStr, sRegex, CaseSensitive := False)
1031 End If
1033 Finally:
1034 IsFileName = bFileName
1035 SF_Utils._ExitFunction(cstThisSub)
1036 Exit Function
1037 Catch:
1038 GoTo Finally
1039 End Function ' ScriptForge.SF_String.IsFileName
1041 REM -----------------------------------------------------------------------------
1042 Public Function IsHexDigit(Optional ByRef InputStr As Variant) As Boolean
1043 ''' Return True if all characters in the string are hexadecimal digits
1044 ''' Args:
1045 ''' InputStr: the input string
1046 ''' Returns:
1047 ''' True if the string contains only hexadecimal igits and there is at least one character
1049 ''' False otherwise
1050 ''' Examples:
1053 Dim bHexDigit As Boolean ' Return value
1057 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1058 bHexDigit = False
1060 Check:
1061 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1063 End If
1065 Try:
1066 If Len(InputStr) > 0 Then bHexDigit = SF_String.IsRegex(InputStr, REGEXHEXA, CaseSensitive := False)
1068 Finally:
1069 IsHexDigit = bHexDigit
1070 SF_Utils._ExitFunction(cstThisSub)
1071 Exit Function
1072 Catch:
1073 GoTo Finally
1074 End Function ' ScriptForge.SF_String.IsHexDigit
1076 REM -----------------------------------------------------------------------------
1077 Public Function IsIBAN(Optional ByVal InputStr As Variant) As Boolean
1078 ''' Returns True if the input string is a valid International Bank Account Number
1079 ''' Read https://en.wikipedia.org/wiki/International_Bank_Account_Number
1080 ''' Args:
1081 ''' InputStr: the input string
1082 ''' Returns:
1083 ''' True if the string contains a valid IBAN number. The comparison is not case-sensitive
1084 ''' Examples:
1085 ''' SF_String.IsIBAN("BR15 0000 0000 0000 1093 2840 814 P2") returns True
1087 Dim bIBAN As Boolean ' Return value
1088 Dim sIBAN As String ' Transformed input string
1089 Dim sChar As String ' A single character
1090 Dim sLetter As String ' Integer representation of letters
1091 Dim iIndex As Integer ' Index in IBAN string
1092 Dim sLong As String ' String representation of a Long
1094 Dim i As Integer
1098 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1099 bIBAN = False
1101 Check:
1102 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1104 End If
1106 Try:
1107 sIBAN = ""
1108 ' 1. Remove spaces. Check that the total IBAN length is correct as per the country. If not, the IBAN is invalid
1109 ' NOT DONE: Country specific
1113 ' 2. Move the four initial characters to the end of the string. String is case-insensitive
1116 ' 3. Replace each letter in the string with two digits, thereby expanding the string, where A = 10, B = 11, ..., Z = 35
1117 iIndex = 1
1118 Do While iIndex < Len(sIBAN)
1119 sChar = Mid(sIBAN, iIndex, 1)
1123 iIndex = iIndex + 2
1124 ElseIf sChar < "0" Or sChar > "9" Then ' Remove any non-alphanumeric character
1125 GoTo Finally
1126 Else
1127 iIndex = iIndex + 1
1128 End If
1129 Loop
1131 ' 4. Interpret the string as a decimal integer and compute the remainder of that number on division by 97
1133 iIndex = 3
1134 sLong = Left(sIBAN, 2)
1135 Do While iIndex <= Len(sIBAN)
1137 iModulo97 = CLng(sLong) Mod 97
1138 iIndex = iIndex + Len(sLong) - 2
1140 Loop
1142 bIBAN = ( iModulo97 = 1 )
1144 Finally:
1145 IsIBAN = bIBAN
1146 SF_Utils._ExitFunction(cstThisSub)
1147 Exit Function
1148 Catch:
1149 GoTo Finally
1150 End Function ' ScriptForge.SF_String.IsIBAN
1152 REM -----------------------------------------------------------------------------
1153 Public Function IsIPv4(Optional ByRef InputStr As Variant) As Boolean
1154 ''' Return True if the string is a valid IPv4 address
1155 ''' Args:
1156 ''' InputStr: the input string
1157 ''' Returns:
1158 ''' True if the string contains a valid IPv4 address and there is at least one character, False otherwise
1159 ''' Examples:
1162 Dim bIPv4 As Boolean ' Return value
1166 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1167 bIPv4 = False
1169 Check:
1170 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1172 End If
1174 Try:
1175 If Len(InputStr) > 0 Then bIPv4 = SF_String.IsRegex(InputStr, REGEXIPV4, CaseSensitive := False)
1177 Finally:
1178 IsIPv4 = bIPv4
1179 SF_Utils._ExitFunction(cstThisSub)
1180 Exit Function
1181 Catch:
1182 GoTo Finally
1183 End Function ' ScriptForge.SF_String.IsIPv4
1185 REM -----------------------------------------------------------------------------
1186 Public Function IsLike(Optional ByRef InputStr As Variant _
1187 , Optional ByVal Pattern As Variant _
1188 , Optional ByVal CaseSensitive As Variant _
1189 ) As Boolean
1190 ''' Returns True if the whole input string matches a given pattern containing wildcards
1191 ''' Args:
1192 ''' InputStr: the input string
1193 ''' Pattern: the pattern as a string
1196 ''' CaseSensitive: default = False
1197 ''' Returns:
1198 ''' True if a match is found
1199 ''' Zero-length input or pattern strings always return False
1200 ''' Examples:
1202 ''' SF_String.IsLike("C:\a\b\c\f.odb", "?:*.*") returns True
1204 Dim bLike As Boolean ' Return value
1205 ' Build an equivalent regular expression by escaping the special characters present in Pattern
1206 Dim sRegex As String ' Equivalent regular expression
1207 Const cstSpecialChars = "\,^,$,.,|,+,(,),[,{,?,*" ' List of special chars in regular expressions
1213 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1214 bLike = False
1216 Check:
1217 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1218 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1221 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1222 End If
1224 Try:
1226 ' Substitute special chars by escaped chars
1227 sRegex = SF_String.ReplaceStr(Pattern, Split(cstSPecialChars, ","), Split(cstEscapedChars, ","))
1228 bLike = SF_String.IsRegex(InputStr, sRegex, CaseSensitive)
1229 End If
1231 Finally:
1232 IsLike = bLike
1233 SF_Utils._ExitFunction(cstThisSub)
1234 Exit Function
1235 Catch:
1236 GoTo Finally
1237 End Function ' ScriptForge.SF_String.IsLike
1239 REM -----------------------------------------------------------------------------
1240 Public Function IsLower(Optional ByRef InputStr As Variant) As Boolean
1241 ''' Return True if all characters in the string are in lower case
1242 ''' Non alphabetic characters are ignored
1243 ''' Args:
1244 ''' InputStr: the input string
1245 ''' Returns:
1246 ''' True if the string contains only lower case characters and there is at least one character, False otherwise
1247 ''' Examples:
1250 Dim bLower As Boolean ' Return value
1254 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1255 bLower = False
1257 Check:
1258 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1260 End If
1262 Try:
1265 Finally:
1266 IsLower = bLower
1267 SF_Utils._ExitFunction(cstThisSub)
1268 Exit Function
1269 Catch:
1270 GoTo Finally
1271 End Function ' ScriptForge.SF_String.IsLower
1273 REM -----------------------------------------------------------------------------
1274 Public Function IsPrintable(Optional ByRef InputStr As Variant) As Boolean
1275 ''' Return True if all characters in the string are printable
1277 ''' Args:
1278 ''' InputStr: the input string
1279 ''' Returns:
1280 ''' True if the string is printable and there is at least one character, False otherwise
1281 ''' Examples:
1284 Dim bPrintable As Boolean ' Return value
1285 Dim lLength As Long ' Length of InputStr
1286 Dim oChar As Object ' com.sun.star.i18n.CharacterClassification
1287 Dim oLocale As Object ' com.sun.star.lang.Locale
1288 Dim lType As Long ' com.sun.star.i18n.KCharacterType
1289 Dim sChar As String ' A single character
1290 Dim lPRINTABLE As Long : lPRINTABLE = com.sun.star.i18n.KCharacterType.PRINTABLE
1291 Dim i As Long
1295 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1296 bPrintable = False
1298 Check:
1299 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1301 End If
1303 Try:
1304 lLength = Len(InputStr)
1310 lType = oChar.getCharacterType(sChar, 0, oLocale)
1313 If Not bPrintable Then Exit For
1314 Next i
1315 End If
1317 Finally:
1318 IsPrintable = bPrintable
1319 SF_Utils._ExitFunction(cstThisSub)
1320 Exit Function
1321 Catch:
1322 GoTo Finally
1323 End Function ' ScriptForge.SF_String.IsPrintable
1325 REM -----------------------------------------------------------------------------
1326 Public Function IsRegex(Optional ByRef InputStr As Variant _
1327 , Optional ByVal Regex As Variant _
1328 , Optional ByVal CaseSensitive As Variant _
1329 ) As Boolean
1330 ''' Returns True if the whole input string matches a given regular expression
1331 ''' Args:
1332 ''' InputStr: the input string
1333 ''' Regex: the regular expression as a string
1334 ''' CaseSensitive: default = False
1335 ''' Returns:
1336 ''' True if a match is found
1337 ''' Zero-length input or regex strings always return False
1338 ''' Examples:
1341 Dim bRegex As Boolean ' Return value
1343 Dim sMatch As String ' Matching string
1349 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1350 bRegex = False
1352 Check:
1353 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1354 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1357 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1358 End If
1360 Try:
1362 ' Whole string must match Regex
1363 lStart = 1
1366 sMatch = SF_String.FindRegex(InputStr, Regex, lStart, CaseSensitive)
1367 ' Match ?
1368 bRegex = ( lStart = 1 And Len(sMatch) = Len(InputStr) )
1369 End If
1371 Finally:
1372 IsRegex = bRegex
1373 SF_Utils._ExitFunction(cstThisSub)
1374 Exit Function
1375 Catch:
1376 GoTo Finally
1377 End Function ' ScriptForge.SF_String.IsRegex
1379 REM -----------------------------------------------------------------------------
1380 Public Function IsSheetName(Optional ByRef InputStr As Variant) As Boolean
1381 ''' Return True if the input string can serve as a valid Calc sheet name
1382 ''' The sheet name must not contain the characters [ ] * ? : / \
1385 ''' Args:
1386 ''' InputStr: the input string
1387 ''' Returns:
1388 ''' True if the string is validated as a potential Calc sheet name, False otherwise
1389 ''' Examples:
1390 ''' SF_String.IsSheetName("1àbc + ""def""") returns True
1392 Dim bSheetName As Boolean ' Return value
1396 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1397 bSheetName = False
1399 Check:
1400 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1402 End If
1404 Try:
1414 = 0 Then
1415 bSheetName = True
1416 End If
1417 End If
1419 Finally:
1420 IsSheetName = bSheetName
1421 SF_Utils._ExitFunction(cstThisSub)
1422 Exit Function
1423 Catch:
1424 GoTo Finally
1425 End Function ' ScriptForge.SF_String.IsSheetName
1427 REM -----------------------------------------------------------------------------
1428 Public Function IsTitle(Optional ByRef InputStr As Variant) As Boolean
1429 ''' Return True if the 1st character of every word is in upper case and the other characters are in lower case
1430 ''' Args:
1431 ''' InputStr: the input string
1432 ''' Returns:
1433 ''' True if the string is capitalized and there is at least one character, False otherwise
1434 ''' Examples:
1437 Dim bTitle As Boolean ' Return value
1441 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1442 bTitle = False
1444 Check:
1445 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1447 End If
1449 Try:
1450 If Len(InputStr) > 0 Then bTitle = ( StrComp(InputStr, SF_String.Capitalize(InputStr), 1) = 0 )
1452 Finally:
1453 IsTitle = bTitle
1454 SF_Utils._ExitFunction(cstThisSub)
1455 Exit Function
1456 Catch:
1457 GoTo Finally
1458 End Function ' ScriptForge.SF_String.IsTitle
1460 REM -----------------------------------------------------------------------------
1461 Public Function IsUpper(Optional ByRef InputStr As Variant) As Boolean
1462 ''' Return True if all characters in the string are in upper case
1463 ''' Non alphabetic characters are ignored
1464 ''' Args:
1465 ''' InputStr: the input string
1466 ''' Returns:
1467 ''' True if the string contains only upper case characters and there is at least one character, False otherwise
1468 ''' Examples:
1471 Dim bUpper As Boolean ' Return value
1475 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1476 bUpper = False
1478 Check:
1479 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1481 End If
1483 Try:
1486 Finally:
1487 IsUpper = bUpper
1488 SF_Utils._ExitFunction(cstThisSub)
1489 Exit Function
1490 Catch:
1491 GoTo Finally
1492 End Function ' ScriptForge.SF_String.IsUpper
1494 REM -----------------------------------------------------------------------------
1495 Public Function IsUrl(Optional ByRef InputStr As Variant) As Boolean
1496 ''' Return True if the string is a valid absolute URL (Uniform Resource Locator)
1497 ''' The parsing is done by the ParseStrict method of the URLTransformer UNO service
1498 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1util_1_1XURLTransformer.html
1499 ''' Args:
1500 ''' InputStr: the input string
1501 ''' Returns:
1502 ''' True if the string contains a URL and there is at least one character, False otherwise
1503 ''' Examples:
1504 ''' SF_String.IsUrl("http://foo.bar/?q=Test%20URL-encoded%20stuff") returns True
1506 Dim bUrl As Boolean ' Return value
1510 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1511 bUrl = False
1513 Check:
1514 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1516 End If
1518 Try:
1521 Finally:
1522 IsUrl = bUrl
1523 SF_Utils._ExitFunction(cstThisSub)
1524 Exit Function
1525 Catch:
1526 GoTo Finally
1527 End Function ' ScriptForge.SF_String.IsUrl
1529 REM -----------------------------------------------------------------------------
1530 Public Function IsWhitespace(Optional ByRef InputStr As Variant) As Boolean
1531 ''' Return True if all characters in the string are whitespaces
1532 ''' Whitespaces include Space(32), HT(9), LF(10), VT(11), FF(12), CR(13), Next Line(133), No-break space(160),
1534 ''' Args:
1535 ''' InputStr: the input string
1536 ''' Returns:
1537 ''' True if the string contains only whitespaces and there is at least one character, False otherwise
1538 ''' Examples:
1539 ''' SF_String.IsWhitespace(" " & Chr(9) & Chr(10)) returns True
1541 Dim bWhitespace As Boolean ' Return value
1545 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1546 bWhitespace = False
1548 Check:
1549 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1551 End If
1553 Try:
1554 If Len(InputStr) > 0 Then bWhitespace = SF_String.IsRegex(InputStr, REGEXWHITESPACES, CaseSensitive := False)
1556 Finally:
1557 IsWhitespace = bWhitespace
1558 SF_Utils._ExitFunction(cstThisSub)
1559 Exit Function
1560 Catch:
1561 GoTo Finally
1562 End Function ' ScriptForge.SF_String.IsWhitespace
1564 REM -----------------------------------------------------------------------------
1565 Public Function JustifyCenter(Optional ByRef InputStr As Variant _
1566 , Optional ByVal Length As Variant _
1567 , Optional ByVal Padding As Variant _
1568 ) As String
1569 ''' Return the input string center justified
1570 ''' Args:
1571 ''' InputStr: the input string
1572 ''' Length: the resulting string length (default = length of input string)
1573 ''' Padding: the padding (single) character (default = the ascii space)
1574 ''' Returns:
1575 ''' The input string without its leading and trailing white spaces
1576 ''' completed left and right up to a total length of Length with the character Padding
1577 ''' If the input string is empty, the returned string is empty too
1578 ''' If the requested length is shorter than the center justified input string,
1579 ''' then the returned string is truncated
1580 ''' Examples:
1581 ''' SF_String.JustifyCenter(" ABCDE ", Padding := "x") returns "xxABCDEFxx"
1583 Dim sJustify As String ' Return value
1584 Dim lLength As Long ' Length of input string
1585 Dim lJustLength As Long ' Length of trimmed input string
1586 Dim sPadding As String ' Series of Padding characters
1588 Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]"
1590 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1591 sJustify = ""
1593 Check:
1594 If IsMissing(Length) Or IsEmpty(Length) Then Length = 0
1595 If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " "
1596 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1600 End If
1603 Try:
1604 lLength = Len(InputStr)
1605 If Length = 0 Then Length = lLength
1607 sJustify = SF_String.TrimExt(InputStr) ' Trim left and right
1608 lJustLength = Len(sJustify)
1609 If lJustLength > Length Then
1611 ElseIf lJustLength < Length Then
1612 sPadding = String(Int((Length - lJustLength) / 2), Padding)
1614 If Len(sJustify) < Length Then sJustify = sJustify & Padding ' One Padding char is lacking when lJustLength is odd
1615 End If
1616 End If
1618 Finally:
1619 JustifyCenter = sJustify
1620 SF_Utils._ExitFunction(cstThisSub)
1621 Exit Function
1622 Catch:
1623 GoTo Finally
1624 End Function ' ScriptForge.SF_String.JustifyCenter
1626 REM -----------------------------------------------------------------------------
1627 Public Function JustifyLeft(Optional ByRef InputStr As Variant _
1628 , Optional ByVal Length As Variant _
1629 , Optional ByVal Padding As Variant _
1630 ) As String
1631 ''' Return the input string left justified
1632 ''' Args:
1633 ''' InputStr: the input string
1634 ''' Length: the resulting string length (default = length of input string)
1635 ''' Padding: the padding (single) character (default = the ascii space)
1636 ''' Returns:
1637 ''' The input string without its leading white spaces
1638 ''' filled up to a total length of Length with the character Padding
1639 ''' If the input string is empty, the returned string is empty too
1640 ''' If the requested length is shorter than the left justified input string,
1641 ''' then the returned string is truncated
1642 ''' Examples:
1643 ''' SF_String.JustifyLeft(" ABCDE ", Padding := "x") returns "ABCDE xxx"
1645 Dim sJustify As String ' Return value
1646 Dim lLength As Long ' Length of input string
1648 Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]"
1650 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1651 sJustify = ""
1653 Check:
1654 If IsMissing(Length) Or IsEmpty(Length) Then Length = 0
1655 If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " "
1656 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1660 End If
1663 Try:
1664 lLength = Len(InputStr)
1665 If Length = 0 Then Length = lLength
1668 If Len(sJustify) >= Length Then
1669 sJustify = Left(sJustify, Length)
1670 Else
1671 sJustify = sJustify & String(Length - Len(sJustify), Padding)
1672 End If
1673 End If
1675 Finally:
1676 JustifyLeft = sJustify
1677 SF_Utils._ExitFunction(cstThisSub)
1678 Exit Function
1679 Catch:
1680 GoTo Finally
1681 End Function ' ScriptForge.SF_String.JustifyLeft
1683 REM -----------------------------------------------------------------------------
1684 Public Function JustifyRight(Optional ByRef InputStr As Variant _
1685 , Optional ByVal Length As Variant _
1686 , Optional ByVal Padding As Variant _
1687 ) As String
1688 ''' Return the input string right justified
1689 ''' Args:
1690 ''' InputStr: the input string
1691 ''' Length: the resulting string length (default = length of input string)
1692 ''' Padding: the padding (single) character (default = the ascii space)
1693 ''' Returns:
1694 ''' The input string without its trailing white spaces
1695 ''' preceded up to a total length of Length with the character Padding
1696 ''' If the input string is empty, the returned string is empty too
1697 ''' If the requested length is shorter than the right justified input string,
1698 ''' then the returned string is right-truncated
1699 ''' Examples:
1700 ''' SF_String.JustifyRight(" ABCDE ", Padding := "x") returns "x ABCDE"
1702 Dim sJustify As String ' Return value
1703 Dim lLength As Long ' Length of input string
1705 Const cstSubArgs = "InputStr, [length=Len(InputStr)], [Padding="" ""]"
1707 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1708 sJustify = ""
1710 Check:
1711 If IsMissing(Length) Or IsEmpty(Length) Then Length = 0
1712 If IsMissing(Padding) Or IsMissing(Padding) Then Padding = " "
1713 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1717 End If
1720 Try:
1721 lLength = Len(InputStr)
1722 If Length = 0 Then Length = lLength
1725 If Len(sJustify) >= Length Then
1726 sJustify = Right(sJustify, Length)
1727 Else
1728 sJustify = String(Length - Len(sJustify), Padding) & sJustify
1729 End If
1730 End If
1732 Finally:
1733 JustifyRight = sJustify
1734 SF_Utils._ExitFunction(cstThisSub)
1735 Exit Function
1736 Catch:
1737 GoTo Finally
1738 End Function ' ScriptForge.SF_String.JustifyRight
1740 REM -----------------------------------------------------------------------------
1741 Public Function Methods() As Variant
1742 ''' Return the list of public methods of the String service as an array
1744 Methods = Array( _
1788 )
1790 End Function ' ScriptForge.SF_String.Methods
1792 REM -----------------------------------------------------------------------------
1793 Public Function Properties() As Variant
1794 ''' Return the list or properties as an array
1796 Properties = Array( _
1802 )
1804 End Function ' ScriptForge.SF_Session.Properties
1806 REM -----------------------------------------------------------------------------
1807 Public Function Quote(Optional ByRef InputStr As Variant _
1808 , Optional ByVal QuoteChar As String _
1809 ) As String
1810 ''' Return the input string surrounded with double quotes
1811 ''' Used f.i. to prepare a string field to be stored in a csv-like file
1812 ''' Args:
1813 ''' InputStr: the input string
1815 ''' Returns:
1816 ''' Existing - including leading and/or trailing - double quotes are doubled
1817 ''' Examples:
1818 ''' SF_String.Quote("àé""n ΣlPµ Русский") returns """àé""""n ΣlPµ Русский"""
1820 Dim sQuote As String ' Return value
1826 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1827 sQuote = ""
1829 Check:
1830 If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
1831 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1833 If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
1834 End If
1836 Try:
1837 If QuoteChar = cstDouble Then
1838 sQuote = cstDouble & Replace(InputStr, cstDouble, cstDouble & cstDouble) & cstDouble
1839 Else
1840 sQuote = Replace(InputStr, cstEscape, cstEscape & cstEscape)
1842 End If
1844 Finally:
1845 Quote = sQuote
1846 SF_Utils._ExitFunction(cstThisSub)
1847 Exit Function
1848 Catch:
1849 GoTo Finally
1850 End Function ' ScriptForge.SF_String.Quote
1852 REM -----------------------------------------------------------------------------
1853 Public Function ReplaceChar(Optional ByRef InputStr As Variant _
1854 , Optional ByVal Before As Variant _
1855 , Optional ByVal After As Variant _
1856 ) As String
1857 ''' Replace in InputStr all occurrences of any character from Before
1858 ''' by the corresponding character in After
1859 ''' Args:
1860 ''' InputStr: the input string on which replacements should occur
1862 ''' After: the replacing characters
1863 ''' Returns:
1864 ''' The new string after replacement of Nth character of Before by the Nth character of After
1866 ''' If the length of Before is larger than the length of After,
1867 ''' the residual characters of Before are replaced by the last character of After
1868 ''' The input string when Before is the zero-length string
1869 ''' Examples: easily remove accents
1870 ''' SF_String.ReplaceChar("Protégez votre vie privée", "àâãçèéêëîïôöûüýÿ", "aaaceeeeiioouuyy")
1872 ''' SF_String.ReplaceChar("Protégez votre vie privée", SF_String.CHARSWITHACCENT, SF_String.CHARSWITHOUTACCENT)
1874 Dim sOutput As String ' Return value
1876 Dim sBefore As String ' A single character extracted from InputStr
1877 Dim sAfter As String ' A single character extracted from After
1878 Dim lInStr As Long ' Output of InStr()
1879 Dim i As Long
1883 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1884 sOutput = ""
1886 Check:
1887 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1891 End If
1893 Try:
1894 ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive)
1895 sOutput = InputStr
1896 iCaseSensitive = 0
1898 ' Replace one by one up length of Before and After
1900 i = 1
1901 Do While i <= Len(sOutput)
1902 sBefore = Mid(sOutput, i, 1)
1903 lInStr = InStr(1, Before, sBefore, iCaseSensitive)
1905 If Len(After) = 0 Then
1906 sAfter = ""
1907 ElseIf lInStr > Len(After) Then
1908 sAfter = Right(After, 1)
1909 Else
1910 sAfter = Mid(After, lInStr, 1)
1911 End If
1912 sOutput = Left(sOutput, i - 1) & Replace(sOutput, sBefore, sAfter, i, Empty, iCaseSensitive)
1913 End If
1914 i = i + 1
1915 Loop
1916 End If
1918 Finally:
1919 ReplaceChar = sOutput
1920 SF_Utils._ExitFunction(cstThisSub)
1921 Exit Function
1922 Catch:
1923 GoTo Finally
1924 End Function ' ScriptForge.SF_String.ReplaceChar
1926 REM -----------------------------------------------------------------------------
1927 Public Function ReplaceRegex(Optional ByRef InputStr As Variant _
1928 , Optional ByVal Regex As Variant _
1929 , Optional ByRef NewStr As Variant _
1930 , Optional ByVal CaseSensitive As Variant _
1931 ) As String
1932 ''' Replace in InputStr all occurrences of a given regular expression by NewStr
1933 ''' Args:
1934 ''' InputStr: the input string where replacements should occur
1935 ''' Regex: the regular expression
1936 ''' NewStr: the replacing string
1937 ''' CaseSensitive: default = False
1938 ''' Returns:
1939 ''' The new string after all replacements
1940 ''' Examples:
1941 ''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "[a-z]", "x", CaseSensitive := True)
1942 ''' returns "Lxxxx xxxxx xxxxx xxx xxxx, xxxxxxxxxxx xxxxxxxxxx xxxx."
1943 ''' SF_String.ReplaceRegex("Lorem ipsum dolor sit amet, consectetur adipiscing elit.", "\b[a-z]+\b", "x", CaseSensitive := False)
1947 Dim sOutput As String ' Return value
1948 Dim lStartOld As Long ' Previous start of search
1949 Dim lStartNew As Long ' Next start of search
1950 Dim sSubstring As String ' Substring to replace
1954 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1955 sOutput = ""
1957 Check:
1958 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1959 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1963 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
1964 End If
1966 Try:
1967 sOutput = ""
1968 lStartNew = 1
1969 lStartOld = 1
1972 sSubstring = SF_String.FindRegex(InputStr, Regex, lStartNew, CaseSensitive)
1974 ' Copy remaining substring of InputStr before leaving
1975 sOutput = sOutput & Mid(InputStr, lStartOld)
1976 Exit Do
1977 End If
1979 If lStartNew > lStartOld Then sOutput = sOutput & Mid(InputStr, lStartOld, lStartNew - lStartOld)
1980 sOutput = sOutput & NewStr
1981 lStartOld = lStartNew + Len(sSubstring)
1982 lStartNew = lStartOld
1983 Loop
1985 Finally:
1986 ReplaceRegex = sOutput
1987 SF_Utils._ExitFunction(cstThisSub)
1988 Exit Function
1989 Catch:
1990 GoTo Finally
1991 End Function ' ScriptForge.SF_String.ReplaceRegex
1993 REM -----------------------------------------------------------------------------
1994 Public Function ReplaceStr(Optional ByRef InputStr As Variant _
1995 , Optional ByVal OldStr As Variant _
1996 , Optional ByVal NewStr As Variant _
1997 , Optional ByVal Occurrences As Variant _
1998 , Optional ByVal CaseSensitive As Variant _
1999 ) As String
2000 ''' Replace in InputStr some or all occurrences of OldStr by NewStr
2001 ''' Args:
2002 ''' InputStr: the input string on which replacements should occur
2004 ''' Zero-length strings are ignored
2006 ''' If OldStr is an array
2007 ''' each occurrence of any of the items of OldStr is replaced by NewStr
2008 ''' If OldStr and NewStr are arrays
2009 ''' replacements occur one by one up to the UBound of NewStr
2010 ''' remaining OldStr(ings) are replaced by the last element of NewStr
2011 ''' Occurrences: the maximum number of replacements (0, default, = all occurrences)
2012 ''' Is applied for each single replacement when OldStr is an array
2013 ''' CaseSensitive: True or False (default)
2014 ''' Returns:
2015 ''' The new string after replacements
2016 ''' Replacements are done one by one when OldStr is an array => potential overlaps
2017 ''' Examples:
2018 ''' SF_String.ReplaceStr("abCcdefghHij", Array("c", "h"), Array("Y", "Z"), CaseSensitive := False) returns "abYYdefgZZij"
2020 Dim sOutput As String ' Return value
2021 Dim iCaseSensitive As Integer ' Integer alias for boolean CaseSensitive
2022 Dim vOccurrences As Variant ' Variant alias for Integer Occurrences
2023 Dim sNewStr As String ' Alias for a NewStr item
2024 Dim i As Long, j As Long
2026 Const cstSubArgs = "InputStr, OldStr, NewStr, [Occurrences=0], [CaseSensitive=False]"
2028 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2029 sOutput = ""
2031 Check:
2032 If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0
2033 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
2034 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2036 If IsArray(OldStr) Then
2037 If Not SF_Utils._ValidateArray(OldStr, "OldStr", 1, V_STRING, True) Then GoTo Finally
2038 Else
2040 End If
2041 If IsArray(NewStr) Then
2042 If Not SF_Utils._ValidateArray(NewStr, "NewStr", 1, V_STRING, True) Then GoTo Finally
2043 Else
2045 End If
2047 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
2048 End If
2050 Try:
2051 ' Replace standard function => Replace(string, before, after, start, occurrences, casesensitive)
2052 sOutput = InputStr
2055 If Not IsArray(OldStr) Then OldStr = Array(OldStr)
2056 If Not IsArray(NewStr) Then NewStr = Array(NewStr)
2058 ' Replace one by one up to UBounds of Old and NewStr
2059 j = LBound(NewStr) - 1
2060 For i = LBound(OldStr) To UBound(OldStr)
2061 j = j + 1
2064 sOutput = Replace(sOutput, OldStr(i), sNewStr, 1, vOccurrences, iCaseSensitive)
2065 End If
2066 Next i
2068 Finally:
2069 ReplaceStr = sOutput
2070 SF_Utils._ExitFunction(cstThisSub)
2071 Exit Function
2072 Catch:
2073 GoTo Finally
2074 End Function ' ScriptForge.SF_String.ReplaceStr
2076 REM -----------------------------------------------------------------------------
2077 Public Function Represent(Optional ByRef AnyValue As Variant _
2078 , Optional ByVal MaxLength As Variant _
2079 ) As String
2080 ''' Return a readable (string) form of the argument, truncated at MaxLength
2081 ''' Args:
2082 ''' AnyValue: really any value (object, date, whatever)
2083 ''' MaxLength: the maximum length of the resulting string (Default = 0, unlimited)
2084 ''' Returns:
2085 ''' The argument converted or transformed into a string of a maximum length = MaxLength
2086 ''' Objects are surrounded with square brackets ([])
2087 ''' In strings, tabs and line breaks are replaced by \t, \n or \r
2088 ''' If the effective length exceeds MaxLength, the final part of the string is replaced by " ... (N)"
2089 ''' where N = the total length of the string before truncation
2090 ''' Examples:
2091 ''' SF_String.Represent("this is a usual string") returns "this is a usual string"
2092 ''' SF_String.Represent("this is a usual string", 15) returns "this i ... (22)"
2093 ''' SF_String.Represent("this is a" & Chr(10) & " 2-lines string") returns "this is a\n 2-lines string"
2097 ''' SF_String.Represent(CreateUnoService("com.sun.star.util.PathSettings")) returns "[com.sun.star.comp.framework.PathSettings]"
2098 ''' SF_String.Represent(Array(1, 2, "Text" & Chr(9) & "here")) returns "[ARRAY] (0:2) (1, 2, Text\there)"
2099 ''' Dim myDict As Variant : myDict = CreateScriptService("Dictionary")
2101 ''' SF_String.Represent(myDict) returns "[Dictionary] ("A":1, "B":2)"
2103 Dim sRepr As String ' Return value
2107 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2108 sRepr = ""
2110 Check:
2111 If IsMissing(AnyValue) Then AnyValue = Empty
2112 If IsMissing(MaxLength) Or IsEmpty(MaxLength) Then MaxLength = 0
2113 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2115 End If
2117 Try:
2118 sRepr = SF_Utils._Repr(AnyValue, MaxLength)
2119 If MaxLength > 0 And MaxLength < Len(sRepr) Then sRepr = sRepr & " ... (" & Len(sRepr) & ")"
2121 Finally:
2122 Represent = sRepr
2123 SF_Utils._ExitFunction(cstThisSub)
2124 Exit Function
2125 Catch:
2126 GoTo Finally
2127 End Function ' ScriptForge.SF_String.Represent
2129 REM -----------------------------------------------------------------------------
2130 Public Function Reverse(Optional ByRef InputStr As Variant) As String
2131 ''' Return the input string in reversed order
2132 ''' It is equivalent to the standard StrReverse Basic function
2133 ''' The latter requires the OpTion VBASupport 1 statement to be present in the module
2134 ''' Args:
2135 ''' InputStr: the input string
2136 ''' Returns:
2137 ''' The input string in reversed order
2138 ''' Examples:
2141 Dim sReversed As String ' Return value
2142 Dim lLength As Long ' Length of input string
2143 Dim i As Long
2147 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2148 sReversed = ""
2150 Check:
2151 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2153 End If
2155 Try:
2156 lLength = Len(InputStr)
2158 sReversed = Space(lLength)
2159 For i = 1 To lLength
2161 Next i
2162 End If
2164 Finally:
2165 Reverse = sReversed
2166 SF_Utils._ExitFunction(cstThisSub)
2167 Exit Function
2168 Catch:
2169 GoTo Finally
2170 End Function ' ScriptForge.SF_String.Reverse
2172 REM -----------------------------------------------------------------------------
2173 Public Function SetProperty(Optional ByVal PropertyName As Variant _
2174 , Optional ByRef Value As Variant _
2175 ) As Boolean
2176 ''' Set a new value to the given property
2177 ''' Args:
2178 ''' PropertyName: the name of the property as a string
2179 ''' Value: its new value
2180 ''' Exceptions
2181 ''' ARGUMENTERROR The property does not exist
2186 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2187 SetProperty = False
2189 Check:
2190 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2191 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
2192 End If
2194 Try:
2195 Select Case UCase(PropertyName)
2196 Case Else
2197 End Select
2199 Finally:
2200 SF_Utils._ExitFunction(cstThisSub)
2201 Exit Function
2202 Catch:
2203 GoTo Finally
2204 End Function ' ScriptForge.SF_String.SetProperty
2206 REM -----------------------------------------------------------------------------
2207 Public Function SplitLines(Optional ByRef InputStr As Variant _
2208 , Optional ByVal KeepBreaks As Variant _
2209 ) As Variant
2210 ''' Return an array of the lines in a string, breaking at line boundaries
2211 ''' Line boundaries include LF(10), VT(12), CR(13), LF+CR, File separator(28), Group separator(29), Record separator(30),
2213 ''' Args:
2214 ''' InputStr: the input string
2215 ''' KeepBreaks: when True, line breaks are preserved in the output array (default = False)
2216 ''' Returns:
2217 ''' An array of all the individual lines
2218 ''' Examples:
2219 ''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3") returns ("Line1", "Line2", "Line3")
2220 ''' SF_String.SplitLines("Line1" & Chr(10) & "Line2" & Chr(13) & "Line3" & Chr(10)) returns ("Line1", "Line2", "Line3", "")
2222 Dim vSplit As Variant ' Return value
2223 Dim vLineBreaks As Variant ' Array of recognized line breaks
2224 Dim vTokenizedBreaks As Variant ' Array of line breaks extended with tokens
2225 Dim sAlias As String ' Alias for input string
2226 ' The procedure uses (dirty) placeholders to identify line breaks
2227 ' The used tokens are presumed unlikely present in text strings
2228 Dim sTokenCRLF As String ' Token to identify combined CR + LF
2229 Dim sToken As String ' Token to identify any line break
2230 Dim i As Long
2234 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2235 vSplit = Array()
2237 Check:
2238 If IsMissing(KeepBreaks) Or IsEmpty(KeepBreaks) Then KeepBreaks = False
2239 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2242 End If
2244 Try:
2245 ' In next list CR + LF must precede CR and LF
2246 vLineBreaks = Array(SF_String.sfCRLF, SF_String.sfLF, Chr(12), SF_String.sfCR _
2249 If KeepBreaks = False Then
2250 ' Replace line breaks by linefeeds and split on linefeeds
2251 vSplit = Split(SF_String.ReplaceStr(InputStr, vLineBreaks, SF_String.sfLF, CaseSensitive := False), SF_String.sfLF)
2252 Else
2253 sTokenCRLF = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1)
2254 sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(2)
2255 vTokenizedBreaks = Array() : ReDim vTokenizedBreaks(0 To UBound(vLineBreaks))
2256 ' Extend breaks with token
2257 For i = 0 To UBound(vLineBreaks)
2259 Next i
2260 sAlias = SF_String.ReplaceStr(InputStr, vLineBreaks, vTokenizedBreaks, CaseSensitive := False)
2261 ' Suppress CRLF tokens and split
2262 vSplit = Split(Replace(sAlias, sTokenCRLF, SF_String.sfCRLF), sToken)
2263 End If
2265 Finally:
2266 SplitLines = vSplit
2267 SF_Utils._ExitFunction(cstThisSub)
2268 Exit Function
2269 Catch:
2270 GoTo Finally
2271 End Function ' ScriptForge.SF_String.SplitLines
2273 REM -----------------------------------------------------------------------------
2274 Public Function SplitNotQuoted(Optional ByRef InputStr As Variant _
2275 , Optional ByVal Delimiter As Variant _
2276 , Optional ByVal Occurrences As Variant _
2277 , Optional ByVal QuoteChar As Variant _
2278 ) As Variant
2279 ''' Split a string on Delimiter into an array. If Delimiter is part of a quoted (sub)string, it is ignored
2280 ''' (used f.i. for parsing of csv-like records)
2281 ''' Args:
2282 ''' InputStr: the input string
2283 ''' Might contain quoted substrings:
2285 ''' To preserve a quoting character inside the quoted substring, use (\) or (") as escape character
2287 ''' Delimiter: A string of one or more characters that is used to delimit the input string
2288 ''' The default is the space character
2289 ''' Occurrences: The number of substrings to return (Default = 0, meaning no limit)
2291 ''' Returns:
2292 ''' An array whose items are chunks of the input string, Delimiter not included
2293 ''' Examples:
2294 ''' SF_String.SplitNotQuoted("abc def ghi") returns ("abc", "def", "ghi")
2295 ''' SF_String.SplitNotQuoted("abc,""def,ghi""", ",") returns ("abc", """def,ghi""")
2296 ''' SF_String.SplitNotQuoted("abc,""def\"",ghi""", ",") returns ("abc", """def\"",ghi""")
2297 ''' SF_String.SplitNotQuoted("abc,""def\"",ghi"""",", ",") returns ("abc", """def\"",ghi""", "")
2299 Dim vSplit As Variant ' Return value
2300 Dim lDelimLen As Long ' Length of Delimiter
2301 Dim vStart As Variant ' Array of start positions of quoted strings
2302 Dim vEnd As Variant ' Array of end positions of quoted strings
2303 Dim lInStr As Long ' InStr() on input string
2304 Dim lInStrPrev As Long ' Previous value of lInputStr
2305 Dim lBound As Long ' UBound of vStart and vEnd
2306 Dim lMin As Long ' Lower bound to consider when searching vStart and vEnd
2307 Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification
2308 Dim oLocale As Object ' com.sun.star.lang.Locale
2309 Dim oParse As Object ' com.sun.star.i18n.ParseResult
2310 Dim sChunk As String ' Substring of InputStr
2311 Dim bSplit As Boolean ' New chunk found or not
2312 Dim i As Long
2315 Const cstSubArgs = "InputStr, [Delimiter="" ""], [Occurrences=0], [QuoteChar=""" & cstDouble & """]"
2317 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2318 vSplit = Array()
2320 Check:
2321 If IsMissing(Delimiter) Or IsEmpty(Delimiter) Then Delimiter = " "
2322 If IsMissing(Occurrences) Or IsEmpty(Occurrences) Then Occurrences = 0
2323 If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
2324 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2328 If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
2329 End If
2332 Try:
2334 vSplit = Array(InputStr)
2336 If Occurrences > 0 Then vSplit = Split(InputStr, Delimiter, Occurrences) Else vSplit = Split(InputStr, Delimiter)
2337 Else
2342 ' Build an array of start/end positions of quoted strings containing at least 1x the Delimiter
2343 vStart = Array() : vEnd = Array()
2344 lInStr = InStr(1, InputStr, QuoteChar)
2346 lBound = UBound(vStart)
2347 ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b
2348 Set oParse = oCharacterClass.parsePredefinedToken( _
2349 Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _
2352 ' Is there some delimiter ?
2354 vStart = SF_Array.Append(vStart, lInStr + 0)
2355 vEnd = SF_Array.Append(vEnd, lInStr + oParse.CharLen - 1)
2356 End If
2357 lInStr = InStr(lInStr + oParse.CharLen, InputStr, QuoteChar)
2358 Else
2359 lInStr = 0
2360 End If
2361 Loop
2363 lBound = UBound(vStart)
2364 lDelimLen = Len(Delimiter)
2366 vSplit = Split(InputStr, Delimiter, Occurrences)
2367 Else
2368 ' Split chunk by chunk
2369 lMin = 0
2370 lInStrPrev = 0
2374 bSplit = False
2375 ' Ignore found Delimiter if in quoted string
2376 For i = lMin To lBound
2377 If lInStr < vStart(i) Then
2378 bSplit = True
2379 Exit For
2381 Exit For
2382 Else
2383 lMin = i + 1
2384 If i = lBound Then bSplit = True Else bSplit = ( lInStr < vStart(lMin) )
2385 End If
2386 Next i
2387 ' Build next chunk and store in split array
2388 If bSplit Then
2390 sChunk = Left(InputStr, lInStr - 1)
2391 Else
2392 sChunk = Mid(InputStr, lInStrPrev + lDelimLen, lInStr - lInStrPrev - lDelimLen)
2393 End If
2394 vSplit = SF_Array.Append(vSplit, sChunk & "")
2395 lInStrPrev = lInStr
2396 End If
2397 lInStr = InStr(lInStr + lDelimLen, InputStr, Delimiter, 0)
2398 Loop
2400 sChunk = Mid(InputStr, lInStrPrev + lDelimLen) ' Append last chunk
2401 vSplit = SF_Array.Append(vSplit, sChunk & "")
2402 End If
2403 End If
2404 End If
2406 Finally:
2407 SplitNotQuoted = vSplit
2408 SF_Utils._ExitFunction(cstThisSub)
2409 Exit Function
2410 Catch:
2411 GoTo Finally
2412 End Function ' ScriptForge.SF_String.SplitNotQuoted
2414 REM -----------------------------------------------------------------------------
2415 Public Function StartsWith(Optional ByRef InputStr As Variant _
2416 , Optional ByVal Substring As Variant _
2417 , Optional ByVal CaseSensitive As Variant _
2418 ) As Boolean
2419 ''' Returns True if the first characters of InputStr are identical to Substring
2420 ''' Args:
2421 ''' InputStr: the input string
2422 ''' Substring: the prefixing characters
2423 ''' CaseSensitive: default = False
2424 ''' Returns:
2425 ''' True if the comparison is satisfactory
2427 ''' False if Substr is longer than InputStr
2428 ''' Examples:
2430 ''' SF_String.StartsWith("abcdefg", "ABC", CaseSensitive := True) returns False
2432 Dim bStartsWith As Boolean ' Return value
2433 Dim lSub As Long ' Length of SUbstring
2437 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2438 bStartsWith = False
2440 Check:
2441 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
2442 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2445 If Not SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
2446 End If
2448 Try:
2449 lSub = Len(Substring)
2452 End If
2454 Finally:
2455 StartsWith = bStartsWith
2456 SF_Utils._ExitFunction(cstThisSub)
2457 Exit Function
2458 Catch:
2459 GoTo Finally
2460 End Function ' ScriptForge.SF_String.StartsWith
2462 REM -----------------------------------------------------------------------------
2463 Public Function TrimExt(Optional ByRef InputStr As Variant) As String
2464 ''' Return the input string without its leading and trailing whitespaces
2465 ''' Args:
2466 ''' InputStr: the input string
2467 ''' Returns:
2468 ''' The input string without its leading and trailing white spaces
2469 ''' Examples:
2470 ''' SF_String.TrimExt(" ABCDE" & Chr(9) & Chr(10) & Chr(13) & " ") returns "ABCDE"
2472 Dim sTrim As String ' Return value
2476 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2477 sTrim = ""
2479 Check:
2480 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2482 End If
2484 Try:
2488 End If
2490 Finally:
2491 TrimExt = sTrim
2492 SF_Utils._ExitFunction(cstThisSub)
2493 Exit Function
2494 Catch:
2495 GoTo Finally
2496 End Function ' ScriptForge.SF_String.TrimExt
2498 REM -----------------------------------------------------------------------------
2499 Public Function Unescape(Optional ByRef InputStr As Variant) As String
2500 ''' Convert any escaped characters in the input string
2501 ''' Args:
2502 ''' InputStr: the input string
2503 ''' Returns:
2504 ''' The input string after replacement of \\, \n, \r, \t sequences
2505 ''' Examples:
2506 ''' SF_String.Unescape("abc\n\tdef\\n") returns "abc" & Chr(10) & Chr(9) & "def\n"
2508 Dim sUnescape As String ' Return value
2509 Dim sToken As String ' Placeholder unlikely to be present in input string
2513 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2514 sUnescape = ""
2516 Check:
2517 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2519 End If
2521 Try:
2522 sToken = Chr(1) & "$" & Chr(2) & "*" & Chr(3) & "$" & Chr(1) ' Placeholder for "\\"
2523 sUnescape = SF_String.ReplaceStr( InputStr _
2526 )
2528 Finally:
2529 Unescape = sUnescape
2530 SF_Utils._ExitFunction(cstThisSub)
2531 Exit Function
2532 Catch:
2533 GoTo Finally
2534 End Function ' ScriptForge.SF_String.Unescape
2536 REM -----------------------------------------------------------------------------
2537 Public Function Unquote(Optional ByRef InputStr As Variant _
2538 , Optional ByVal QuoteChar As String _
2539 ) As String
2540 ''' Reset a quoted string to its original content
2541 ''' (used f.i. for parsing of csv-like records)
2542 ''' When the input string contains the quote character, the latter must be escaped:
2545 ''' Args:
2546 ''' InputStr: the input string
2548 ''' Returns:
2549 ''' The input string after removal of leading/trailing quotes and escaped single/double quotes
2550 ''' The input string if not a quoted string
2551 ''' Examples:
2552 ''' SF_String.Unquote("""àé""""n ΣlPµ Русский""") returns "àé""n ΣlPµ Русский"
2554 Dim sUnquote As String ' Return value
2555 Dim oCharacterClass As Object ' com.sun.star.i18n.CharacterClassification
2556 Dim oLocale As Object ' com.sun.star.lang.Locale
2557 Dim oParse As Object ' com.sun.star.i18n.ParseResult
2562 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2563 sUnquote = ""
2565 Check:
2566 If IsMissing(QuoteChar) Or IsEmpty(QuoteChar) Then QuoteChar = cstDouble
2567 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2569 If Not SF_Utils._Validate(QuoteChar, "QuoteChar", V_STRING, Array(cstDouble, cstSingle)) Then GoTo Finally
2570 End If
2572 Try:
2574 sUnquote = InputStr
2575 Else
2579 ' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1i18n_1_1XCharacterClassification.html#ad5f1be91fbe86853200391f828d4166b
2580 Set oParse = oCharacterClass.parsePredefinedToken( _
2581 Iif(QuoteChar = cstDouble, com.sun.star.i18n.KParseType.DOUBLE_QUOTE_STRING, com.sun.star.i18n.KParseType.SINGLE_QUOTE_NAME) _
2584 sUnquote = oParse.DequotedNameOrString
2585 Else
2586 sUnquote = InputStr
2587 End If
2588 End If
2590 Finally:
2591 Unquote = sUnquote
2592 SF_Utils._ExitFunction(cstThisSub)
2593 Exit Function
2594 Catch:
2595 GoTo Finally
2596 End Function ' ScriptForge.SF_String.Unquote
2598 REM -----------------------------------------------------------------------------
2599 Public Function Wrap(Optional ByRef InputStr As Variant _
2600 , Optional ByVal Width As Variant _
2601 , Optional ByVal TabSize As Variant _
2602 ) As Variant
2603 ''' Wraps every single paragraph in text (a string) so every line is at most Width characters long
2604 ''' Args:
2605 ''' InputStr: the input string
2607 ''' TabSize: before wrapping the text, the existing TAB (Chr(9)) characters are replaced with spaces.
2608 ''' TabSize defines the TAB positions at TabSize + 1, 2 * TabSize + 1 , ... N * TabSize + 1
2610 ''' Returns:
2611 ''' Returns a zero-based array of output lines, without final newlines except the pre-existing line-breaks
2612 ''' Tabs are expanded. Symbolic line breaks are replaced by their hard equivalents
2613 ''' If the wrapped output has no content, the returned array is empty.
2614 ''' Examples:
2615 ''' SF_String.Wrap("Neque porro quisquam est qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit...", 20)
2617 Dim vWrap As Variant ' Return value
2618 Dim vWrapLines ' Input string split on line breaks
2619 Dim sWrap As String ' Intermediate string
2620 Dim sLine As String ' Line after splitting on line breaks
2621 Dim lPos As Long ' Position in sLine already wrapped
2622 Dim lStart As Long ' Start position before and after regex search
2623 Dim sSpace As String ' Next whitespace
2624 Dim sChunk As String ' Next wrappable text chunk
2628 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2629 vWrap = Array()
2631 Check:
2632 If IsMissing(Width) Or IsEmpty(Width) Then Width = 70
2633 If IsMissing(TabSize) Or IsEmpty(TabSize) Then TabSize = 8
2634 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2638 End If
2640 Try:
2642 sWrap = SF_String.Unescape(InputStr) ' Replace symbolic breaks
2643 sWrap = SF_String.ExpandTabs(sWrap, TabSize) ' Interpret TABs to have a meaningful Width
2644 ' First, split full string
2645 vWrapLines = SF_String.SplitLines(sWrap, KeepBreaks := True) ' Keep pre-existing breaks
2647 vWrap = Array(sWrap)
2648 Else
2649 ' Second, split each line on Width
2650 For Each sLine In vWrapLines
2651 If Len(sLine) <= Width Then
2653 Else
2654 ' Scan sLine and accumulate found substrings up to Width
2655 lStart = 1
2656 lPos = 0
2657 sWrap = ""
2658 Do While lStart <= Len(sLine)
2659 sSpace = SF_String.FindRegex(sLine, REGEXSPACES, lStart)
2663 sWrap = sWrap & sChunk
2664 Else ' Save current line and initialize next one
2666 sWrap = sChunk
2667 End If
2668 lPos = lPos + Len(sChunk)
2669 lStart = lPos + 1
2670 Loop
2671 ' Add last chunk
2674 End If
2675 End If
2676 Next sLine
2677 End If
2678 End If
2680 Finally:
2681 Wrap = vWrap
2682 SF_Utils._ExitFunction(cstThisSub)
2683 Exit Function
2684 Catch:
2685 GoTo Finally
2686 End Function ' ScriptForge.SF_String.Wrap
2688 REM ============================================================= PRIVATE METHODS
2690 REM -----------------------------------------------------------------------------
2691 Private Function _Repr(ByRef pvString As String) As String
2692 ''' Convert an arbitrary string to a readable string, typically for debugging purposes (DebugPrint ...)
2693 ''' Carriage Returns are replaced by \r. Other line breaks are replaced by \n
2694 ''' Tabs are replaced by \t
2695 ''' Backslashes are doubled
2696 ''' Other non printable characters are replaced by \x00 to \xFF or \x0000 to \xFFFF
2697 ''' Args:
2698 ''' pvString: the string to make readable
2699 ''' Return:
2700 ''' the converted string
2702 Dim sString As String ' Return value
2703 Dim sChar As String ' A single character
2704 Dim lAsc As Long ' Ascii value
2705 Dim lPos As Long ' Position in sString
2706 Dim i As Long
2708 ' Process TABs, CRs and LFs
2709 sString = Replace(Replace(Replace(pvString, "\", "\\"), SF_String.sfCR, "\r"), SF_String.sfTAB, "\t")
2711 ' Process not printable characters
2713 lPos = 1
2714 Do While lPos <= Len(sString)
2715 sChar = Mid(sString, lPos, 1)
2716 If Not SF_String.IsPrintable(sChar) Then
2717 lAsc = Asc(sChar)
2718 sChar = "\x" & Iif(lAsc < 255, Right("00" & Hex(lAsc), 2), Right("0000" & Hex(lAsc), 4))
2719 If lPos < Len(sString) Then
2721 Else
2723 End If
2724 End If
2725 lPos = lPos + Len(sChar)
2726 Loop
2727 End If
2729 _Repr = sString
2731 End Function ' ScriptForge.SF_String._Repr
2733 REM ================================================ END OF SCRIPTFORGE.SF_STRING
2734 </script:module>