| blob | 22ada5148e2afbb2a822c02af66e111f657c9d9b |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Dictionary" 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 ClassModule
11 Option Explicit
13 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
14 ''' SF_Dictionary
15 ''' =============
16 ''' Class for management of dictionaries
17 ''' A dictionary is a collection of key-item pairs
18 ''' The key is a not case-sensitive string
19 ''' Items may be of any type
20 ''' Keys, items can be retrieved, counted, etc.
21 '''
22 ''' The implementation is based on
23 ''' - one collection mapping keys and entries in the array
25 '''
26 ''' Why a Dictionary class beside the builtin Collection class ?
27 ''' A standard Basic collection does not support the retrieval of the keys
28 ''' Additionally it may contain only simple data (strings, numbers, ...)
29 '''
30 ''' Service instantiation example:
31 ''' Dim myDict As Variant
32 ''' myDict = CreateScriptService("Dictionary") ' Once per dictionary
33 '''
34 ''' Detailed user documentation:
35 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dictionary.html?DbPAR=BASIC
36 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
38 REM ================================================================== EXCEPTIONS
44 REM ============================================================= PRIVATE MEMBERS
46 ' Defines an entry in the MapItems array
47 Type ItemMap
48 Key As String
49 Value As Variant
50 End Type
52 Private [Me] As Object
53 Private [_Parent] As Object
55 Private ServiceName As String
56 Private MapKeys As Variant ' To retain the original keys
57 Private MapItems As Variant ' Array of ItemMaps
58 Private _MapSize As Long ' Total number of entries in the dictionary
59 Private _MapRemoved As Long ' Number of inactive entries in the dictionary
61 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
63 REM -----------------------------------------------------------------------------
64 Private Sub Class_Initialize()
65 Set [Me] = Nothing
66 Set [_Parent] = Nothing
69 Set MapKeys = New Collection
70 Set MapItems = Array()
71 _MapSize = 0
72 _MapRemoved = 0
73 End Sub ' ScriptForge.SF_Dictionary Constructor
75 REM -----------------------------------------------------------------------------
76 Private Sub Class_Terminate()
77 Call Class_Initialize()
78 End Sub ' ScriptForge.SF_Dictionary Destructor
80 REM -----------------------------------------------------------------------------
81 Public Function Dispose() As Variant
82 RemoveAll()
83 Set Dispose = Nothing
84 End Function ' ScriptForge.SF_Dictionary Explicit destructor
86 REM ================================================================== PROPERTIES
88 REM -----------------------------------------------------------------------------
89 Property Get Count() As Long
90 ''' Actual number of entries in the dictionary
91 ''' Example:
92 ''' myDict.Count
96 End Property ' ScriptForge.SF_Dictionary.Count
98 REM -----------------------------------------------------------------------------
99 Public Function Item(Optional ByVal Key As Variant) As Variant
100 ''' Return the value of the item related to Key
101 ''' Args:
102 ''' Key: the key value (string)
103 ''' Returns:
104 ''' Empty if not found, otherwise the found value
105 ''' Example:
107 ''' NB: defined as a function to not disrupt the Basic IDE debugger
111 End Function ' ScriptForge.SF_Dictionary.Item
113 REM -----------------------------------------------------------------------------
114 Property Get Items() as Variant
116 ''' The Items and Keys properties return their respective contents in the same order
117 ''' The order is however not necessarily identical to the creation sequence
118 ''' Returns:
119 ''' The array is empty if the dictionary is empty
120 ''' Examples
121 ''' a = myDict.Items
122 ''' For Each b In a ...
126 End Property ' ScriptForge.SF_Dictionary.Items
128 REM -----------------------------------------------------------------------------
129 Property Get Keys() as Variant
131 ''' The Keys and Items properties return their respective contents in the same order
132 ''' The order is however not necessarily identical to the creation sequence
133 ''' Returns:
134 ''' The array is empty if the dictionary is empty
135 ''' Examples
136 ''' a = myDict.Keys
137 ''' For each b In a ...
141 End Property ' ScriptForge.SF_Dictionary.Keys
143 REM ===================================================================== METHODS
145 REM -----------------------------------------------------------------------------
146 Public Function Add(Optional ByVal Key As Variant _
147 , Optional ByVal Item As Variant _
148 ) As Boolean
149 ''' Add a new key-item pair into the dictionary
150 ''' Args:
151 ''' Key: must not yet exist in the dictionary
152 ''' Item: any value, including an array, a Basic object, a UNO object, ...
153 ''' Returns: True if successful
154 ''' Exceptions:
155 ''' DUPLICATEKEYERROR: such a key exists already
156 ''' INVALIDKEYERROR: zero-length string or only spaces
157 ''' Examples:
160 Dim oItemMap As ItemMap ' New entry in the MapItems array
164 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
165 Add = False
167 Check:
168 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
170 If IsArray(Item) Then
172 Else
174 End If
175 End If
176 If Key = Space(Len(Key)) Then GoTo CatchInvalid
177 If Exists(Key) Then GoTo CatchDuplicate
179 Try:
180 _MapSize = _MapSize + 1
181 MapKeys.Add(_MapSize, Key)
182 oItemMap.Key = Key
183 oItemMap.Value = Item
184 ReDim Preserve MapItems(1 To _MapSize)
185 MapItems(_MapSize) = oItemMap
186 Add = True
188 Finally:
189 SF_Utils._ExitFunction(cstThisSub)
190 Exit Function
191 Catch:
192 GoTo Finally
193 CatchDuplicate:
195 GoTo Finally
196 CatchInvalid:
198 GoTo Finally
199 End Function ' ScriptForge.SF_Dictionary.Add
201 REM -----------------------------------------------------------------------------
202 Public Function ConvertToArray() As Variant
205 ''' Args:
206 ''' Returns:
208 ''' an empty array if the dictionary is empty
210 Dim vArray As Variant ' Return value
211 Dim sKey As String ' Tempry key
212 Dim vKeys As Variant ' Array of keys
213 Dim lCount As Long ' Counter
215 Const cstSubArgs = ""
217 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
219 Check:
220 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
222 Try:
223 vArray = Array()
224 If Count = 0 Then
225 Else
227 lCount = -1
228 vKeys = Keys
229 For Each sKey in vKeys
230 lCount = lCount + 1
231 vArray(lCount, 0) = sKey
232 vArray(lCount, 1) = Item(sKey)
233 Next sKey
234 End If
236 Finally:
237 ConvertToArray = vArray()
238 SF_Utils._ExitFunction(cstThisSub)
239 Exit Function
240 Catch:
241 GoTo Finally
242 End Function ' ScriptForge.SF_Dictionary.ConvertToArray
244 REM -----------------------------------------------------------------------------
245 Public Function ConvertToJson(ByVal Optional Indent As Variant) As Variant
246 ''' Convert the content of the dictionary to a JSON string
247 ''' JSON = JavaScript Object Notation: https://en.wikipedia.org/wiki/JSON
248 ''' Limitations
249 ''' Allowed item types: String, Boolean, numbers, Null and Empty
250 ''' Arrays containing above types are allowed
251 ''' Dates are converted into strings (not within arrays)
252 ''' Other types are converted to their string representation (cfr. SF_String.Represent)
253 ''' Args:
254 ''' Indent:
255 ''' If indent is a non-negative integer or string, then JSON array elements and object members will be pretty-printed with that indent level.
257 ''' "", (the default) selects the most compact representation.
258 ''' Using a positive integer indent indents that many spaces per level.
259 ''' If indent is a string (such as Chr(9)), that string is used to indent each level.
260 ''' Returns:
261 ''' the JSON string
262 ''' Example:
268 ''' MsgBox a.ConvertToJson() ' {"p0": 12.5, "p1": "a string \u00e0\u00e9\"\u00ea", "p2": "2020-09-28", "p3": true, "p4": [1, 2, 3]}
270 Dim sJson As String ' Return value
271 Dim vArray As Variant ' Array of property values
272 Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue
273 Dim sKey As String ' Tempry key
274 Dim vKeys As Variant ' Array of keys
275 Dim vItem As Variant ' Tempry item
276 Dim iVarType As Integer ' Extended VarType
277 Dim lCount As Long ' Counter
278 Dim vIndent As Variant ' Python alias of Indent
284 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
286 Check:
287 If IsMissing(Indent) Or IsEmpty(INDENT) Then Indent = ""
288 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
289 If Not SF_Utils._Validate(Indent, "Indent", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
290 End If
291 sJson = ""
293 Try:
294 vArray = Array()
295 If Count = 0 Then
296 Else
298 lCount = -1
299 vKeys = Keys
300 For Each sKey in vKeys
301 ' Check item type
302 vItem = Item(sKey)
303 iVarType = SF_Utils._VarTypeExt(vItem)
304 Select Case iVarType
305 Case V_STRING, V_BOOLEAN, V_NUMERIC, V_NULL, V_EMPTY
306 Case V_DATE
307 vItem = SF_Utils._CDateToIso(vItem)
308 Case >= V_ARRAY
309 Case Else
310 vItem = SF_Utils._Repr(vItem)
311 End Select
312 ' Build in each array entry a (Name, Value) pair
313 Set oPropertyValue = SF_Utils._MakePropertyValue(sKey, vItem)
314 lCount = lCount + 1
315 Set vArray(lCount) = oPropertyValue
316 Next sKey
317 End If
319 'Pass array to Python script for the JSON conversion
320 With ScriptForge.SF_Session
321 vIndent = Indent
322 If VarType(Indent) = V_STRING Then
323 If Len(Indent) = 0 Then vIndent = Null
324 End If
325 sJson = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, vArray, vIndent)
326 End With
328 Finally:
329 ConvertToJson = sJson
330 SF_Utils._ExitFunction(cstThisSub)
331 Exit Function
332 Catch:
333 GoTo Finally
334 End Function ' ScriptForge.SF_Dictionary.ConvertToJson
336 REM -----------------------------------------------------------------------------
337 Public Function ConvertToPropertyValues() As Variant
338 ''' Store the content of the dictionary in an array of PropertyValues
339 ''' Key stored in Name, Item stored in Value
340 ''' Args:
341 ''' Returns:
342 ''' a zero-based 1D array(0:Count - 1). Each entry is a com.sun.star.beans.PropertyValue
343 ''' Name: the key in the dictionary
344 ''' Value:
345 ''' Dates are converted to UNO dates
346 ''' Empty arrays are replaced by Null
347 ''' an empty array if the dictionary is empty
349 Dim vArray As Variant ' Return value
350 Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue
351 Dim sKey As String ' Tempry key
352 Dim vKeys As Variant ' Array of keys
353 Dim lCount As Long ' Counter
355 Const cstSubArgs = ""
357 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
359 Check:
360 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
362 Try:
363 vArray = Array()
364 If Count = 0 Then
365 Else
367 lCount = -1
368 vKeys = Keys
369 For Each sKey in vKeys
370 ' Build in each array entry a (Name, Value) pair
371 Set oPropertyValue = SF_Utils._MakePropertyValue(sKey, Item(sKey))
372 lCount = lCount + 1
373 Set vArray(lCount) = oPropertyValue
374 Next sKey
375 End If
377 Finally:
378 ConvertToPropertyValues = vArray()
379 SF_Utils._ExitFunction(cstThisSub)
380 Exit Function
381 Catch:
382 GoTo Finally
383 End Function ' ScriptForge.SF_Dictionary.ConvertToPropertyValues
385 REM -----------------------------------------------------------------------------
386 Public Function Exists(Optional ByVal Key As Variant) As Boolean
387 ''' Determine if a key exists in the dictionary
388 ''' Args:
389 ''' Key: the key value (string)
390 ''' Returns: True if key exists
391 ''' Examples:
394 Dim vItem As Variant ' Item part in MapKeys
398 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
399 Exists = False
401 Check:
402 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
404 End If
406 Try:
407 ' Dirty but preferred to go through whole collection
408 On Local Error GoTo NotFound
409 vItem = MapKeys(Key)
410 NotFound:
412 On Local Error GoTo 0
414 Finally:
415 SF_Utils._ExitFunction(cstThisSub)
416 Exit Function
417 Catch:
418 GoTo Finally
419 End Function ' ScriptForge.SF_Dictionary.Exists
421 REM -----------------------------------------------------------------------------
422 Public Function GetProperty(Optional ByVal PropertyName As Variant _
423 , Optional ByVal Key As Variant _
424 ) As Variant
425 ''' Return the actual value of the given property
426 ''' Args:
427 ''' PropertyName: the name of the property as a string
429 ''' Returns:
430 ''' The actual value of the property
431 ''' Exceptions:
432 ''' ARGUMENTERROR The property does not exist
433 ''' Examples:
439 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
440 GetProperty = Null
442 Check:
443 If IsMissing(Key) Or IsEmpty(Key) Then Key = ""
444 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
445 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
446 End If
448 Try:
449 GetProperty = _PropertyGet(PropertyName, Key)
451 Finally:
452 SF_Utils._ExitFunction(cstThisSub)
453 Exit Function
454 Catch:
455 GoTo Finally
456 End Function ' ScriptForge.SF_Dictionary.GetProperty
458 REM -----------------------------------------------------------------------------
459 Public Function ImportFromJson(Optional ByVal InputStr As Variant _
460 , Optional ByVal Overwrite As Variant _
461 ) As Boolean
462 ''' Adds the content of a Json string into the current dictionary
463 ''' JSON = JavaScript Object Notation: https://en.wikipedia.org/wiki/JSON
464 ''' Limitations
465 ''' The JSON string may contain numbers, strings, booleans, null values and arrays containing those types
466 ''' It must not contain JSON objects, i.e. sub-dictionaries
467 ''' An attempt is made to convert strings to dates if they fit one of next patterns:
468 ''' YYYY-MM-DD, HH:MM:SS or YYYY-MM-DD HH:MM:SS
469 ''' Args:
470 ''' InputStr: the json string to import
471 ''' Overwrite: when True entries with same name may exist in the dictionary and their values are overwritten
472 ''' Default = False
473 ''' Returns:
474 ''' True if successful
475 ''' Exceptions:
476 ''' DUPLICATEKEYERROR: such a key exists already
477 ''' INVALIDKEYERROR: zero-length string or only spaces
478 ''' Example:
479 ''' Dim s As String
480 ''' s = "{'firstName': 'John','lastName': 'Smith','isAlive': true,'age': 66, 'birth': '1954-09-28 20:15:00'" _
481 ''' & ",'address': {'streetAddress': '21 2nd Street','city': 'New York','state': 'NY','postalCode': '10021-3100'}" _
482 ''' & ",'phoneNumbers': [{'type': 'home','number': '212 555-1234'},{'type': 'office','number': '646 555-4567'}]" _
483 ''' & ",'children': ['Q','M','G','T'],'spouse': null}"
485 ''' myDict.ImportFromJson(s, OverWrite := True)
486 ''' ' The (sub)-dictionaries "address" and "phoneNumbers(0) and (1) are reduced to Empty
488 Dim bImport As Boolean ' Return value
489 Dim vArray As Variant ' JSON string converted to array
490 Dim vArrayEntry As Variant ' A single entry in vArray
491 Dim vKey As Variant ' Tempry key
492 Dim vItem As Variant ' Tempry item
493 Dim bExists As Boolean ' True when an entry exists
494 Dim dDate As Date ' String converted to Date
500 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
501 bImport = False
503 Check:
504 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
505 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
508 End If
510 Try:
511 With ScriptForge.SF_Session
512 vArray = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, InputStr)
513 End With
514 If Not IsArray(vArray) Then GoTo Finally ' Conversion error or nothing to do
517 For Each vArrayEntry In vArray
518 vKey = vArrayEntry(0)
519 If VarType(vKey) = V_STRING Then ' Else skip
520 vItem = vArrayEntry(1)
521 If Overwrite Then bExists = Exists(vKey) Else bExists = False
522 ' When the item matches a date pattern, convert it to a date
523 If VarType(vItem) = V_STRING Then
524 dDate = SF_Utils._CStrToDate(vItem)
526 End If
527 If bExists Then
528 ReplaceItem(vKey, vItem)
529 Else
530 Add(vKey, vItem) ' Key controls are done in Add
531 End If
532 End If
533 Next vArrayEntry
535 bImport = True
537 Finally:
538 ImportFromJson = bImport
539 SF_Utils._ExitFunction(cstThisSub)
540 Exit Function
541 Catch:
542 GoTo Finally
543 End Function ' ScriptForge.SF_Dictionary.ImportFromJson
545 REM -----------------------------------------------------------------------------
546 Public Function ImportFromPropertyValues(Optional ByVal PropertyValues As Variant _
547 , Optional ByVal Overwrite As Variant _
548 ) As Boolean
549 ''' Adds the content of an array of PropertyValues into the current dictionary
550 ''' Names contain Keys, Values contain Items
551 ''' UNO dates are replaced by Basic dates
552 ''' Args:
553 ''' PropertyValues: a zero-based 1D array. Each entry is a com.sun.star.beans.PropertyValue
554 ''' Overwrite: when True entries with same name may exist in the dictionary and their values are overwritten
555 ''' Default = False
556 ''' Returns:
557 ''' True if successful
558 ''' Exceptions:
559 ''' DUPLICATEKEYERROR: such a key exists already
560 ''' INVALIDKEYERROR: zero-length string or only spaces
562 Dim bImport As Boolean ' Return value
563 Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue
564 Dim vItem As Variant ' Tempry item
565 Dim sObjectType As String ' UNO object type of dates
566 Dim bExists As Boolean ' True when an entry exists
570 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
571 bImport = False
573 Check:
574 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
575 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
576 If IsArray(PropertyValues) Then
577 If Not SF_Utils._ValidateArray(PropertyValues, "PropertyValues", 1, V_OBJECT, True) Then GoTo Finally
578 Else
579 If Not SF_Utils._Validate(PropertyValues, "PropertyValues", V_OBJECT) Then GoTo Finally
580 End If
582 End If
584 Try:
585 If Not IsArray(PropertyValues) Then PropertyValues = Array(PropertyValues)
586 With oPropertyValue
587 For Each oPropertyValue In PropertyValues
588 If Overwrite Then bExists = Exists(.Name) Else bExists = False
590 If IsUnoStruct(.Value) Then
591 sObjectType = SF_Session.UnoObjectType(.Value)
592 Select Case sObjectType
596 Case Else : vItem = .Value
597 End Select
598 Else
599 vItem = .Value
600 End If
601 If bExists Then
602 ReplaceItem(.Name, vItem)
603 Else
604 Add(.Name, vItem) ' Key controls are done in Add
605 End If
606 End If
607 Next oPropertyValue
608 End With
609 bImport = True
611 Finally:
612 ImportFromPropertyValues = bImport
613 SF_Utils._ExitFunction(cstThisSub)
614 Exit Function
615 Catch:
616 GoTo Finally
617 End Function ' ScriptForge.SF_Dictionary.ImportFromPropertyValues
619 REM -----------------------------------------------------------------------------
620 Public Function Methods() As Variant
621 ''' Return the list or methods of the Dictionary class as an array
623 Methods = Array( _
635 )
637 End Function ' ScriptForge.SF_Dictionary.Methods
639 REM -----------------------------------------------------------------------------
640 Public Function Properties() As Variant
641 ''' Return the list or properties of the Dictionary class as an array
643 Properties = Array( _
648 )
650 End Function ' ScriptForge.SF_Dictionary.Properties
652 REM -----------------------------------------------------------------------------
653 Public Function Remove(Optional ByVal Key As Variant) As Boolean
654 ''' Remove an existing dictionary entry based on its key
655 ''' Args:
656 ''' Key: must exist in the dictionary
657 ''' Returns: True if successful
658 ''' Exceptions:
659 ''' UNKNOWNKEYERROR: the key does not exist
660 ''' Examples:
663 Dim lIndex As Long ' To remove entry in the MapItems array
667 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
668 Remove = False
670 Check:
671 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
673 End If
674 If Not Exists(Key) Then GoTo CatchUnknown
676 Try:
677 lIndex = MapKeys.Item(Key)
678 MapKeys.Remove(Key)
679 Erase MapItems(lIndex) ' Is now Empty
680 _MapRemoved = _MapRemoved + 1
681 Remove = True
683 Finally:
684 SF_Utils._ExitFunction(cstThisSub)
685 Exit Function
686 Catch:
687 GoTo Finally
688 CatchUnknown:
690 GoTo Finally
691 End Function ' ScriptForge.SF_Dictionary.Remove
693 REM -----------------------------------------------------------------------------
694 Public Function RemoveAll() As Boolean
695 ''' Remove all the entries from the dictionary
696 ''' Args:
697 ''' Returns: True if successful
698 ''' Examples:
699 ''' myDict.RemoveAll()
701 Dim vKeys As Variant ' Array of keys
702 Dim sColl As String ' A collection key in MapKeys
704 Const cstSubArgs = ""
706 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
707 RemoveAll = False
709 Check:
710 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
712 Try:
713 vKeys = Keys
714 For Each sColl In vKeys
715 MapKeys.Remove(sColl)
716 Next sColl
717 Erase MapKeys
718 Erase MapItems
719 ' Make dictionary ready to receive new entries
720 Call Class_Initialize()
721 RemoveAll = True
723 Finally:
724 SF_Utils._ExitFunction(cstThisSub)
725 Exit Function
726 Catch:
727 GoTo Finally
728 End Function ' ScriptForge.SF_Dictionary.RemoveAll
730 REM -----------------------------------------------------------------------------
731 Public Function ReplaceItem(Optional ByVal Key As Variant _
732 , Optional ByVal Value As Variant _
733 ) As Boolean
734 ''' Replace the item value
735 ''' Args:
736 ''' Key: must exist in the dictionary
737 ''' Returns: True if successful
738 ''' Exceptions:
739 ''' UNKNOWNKEYERROR: the old key does not exist
740 ''' Examples:
743 Dim oItemMap As ItemMap ' Content to update in the MapItems array
744 Dim lIndex As Long ' Entry in the MapItems array
748 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
749 ReplaceItem = False
751 Check:
752 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
754 If IsArray(Value) Then
756 Else
758 End If
759 End If
760 If Not Exists(Key) Then GoTo CatchUnknown
762 Try:
763 ' Find entry in MapItems and update it with the new value
764 lIndex = MapKeys.Item(Key)
765 oItemMap = MapItems(lIndex)
766 oItemMap.Value = Value
767 ReplaceItem = True
769 Finally:
770 SF_Utils._ExitFunction(cstThisSub)
771 Exit Function
772 Catch:
773 GoTo Finally
774 CatchUnknown:
776 GoTo Finally
777 End Function ' ScriptForge.SF_Dictionary.ReplaceItem
779 REM -----------------------------------------------------------------------------
780 Public Function ReplaceKey(Optional ByVal Key As Variant _
781 , Optional ByVal Value As Variant _
782 ) As Boolean
783 ''' Replace existing key
784 ''' Args:
785 ''' Key: must exist in the dictionary
786 ''' Value: must not exist in the dictionary
787 ''' Returns: True if successful
788 ''' Exceptions:
789 ''' UNKNOWNKEYERROR: the old key does not exist
790 ''' DUPLICATEKEYERROR: the new key exists
791 ''' Examples:
794 Dim oItemMap As ItemMap ' Content to update in the MapItems array
795 Dim lIndex As Long ' Entry in the MapItems array
799 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
800 ReplaceKey = False
802 Check:
803 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
806 End If
807 If Not Exists(Key) Then GoTo CatchUnknown
808 If Value = Space(Len(Value)) Then GoTo CatchInvalid
809 If Exists(Value) Then GoTo CatchDuplicate
811 Try:
812 ' Remove the Key entry and create a new one in MapKeys
813 With MapKeys
814 lIndex = .Item(Key)
815 .Remove(Key)
816 .Add(lIndex, Value)
817 End With
818 oItemMap = MapItems(lIndex)
819 oItemMap.Key = Value
820 ReplaceKey = True
822 Finally:
823 SF_Utils._ExitFunction(cstThisSub)
824 Exit Function
825 Catch:
826 GoTo Finally
827 CatchUnknown:
829 GoTo Finally
830 CatchDuplicate:
832 GoTo Finally
833 CatchInvalid:
835 GoTo Finally
836 End Function ' ScriptForge.SF_Dictionary.ReplaceKey
838 REM -----------------------------------------------------------------------------
839 Public Function SetProperty(Optional ByVal PropertyName As Variant _
840 , Optional ByRef Value As Variant _
841 ) As Boolean
842 ''' Set a new value to the given property
843 ''' Args:
844 ''' PropertyName: the name of the property as a string
845 ''' Value: its new value
846 ''' Exceptions
847 ''' ARGUMENTERROR The property does not exist
852 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
853 SetProperty = False
855 Check:
856 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
857 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
858 End If
860 Try:
861 Select Case UCase(PropertyName)
862 Case Else
863 End Select
865 Finally:
866 SF_Utils._ExitFunction(cstThisSub)
867 Exit Function
868 Catch:
869 GoTo Finally
870 End Function ' ScriptForge.SF_Dictionary.SetProperty
872 REM =========================================================== PRIVATE FUNCTIONS
874 REM -----------------------------------------------------------------------------
875 Private Function _PropertyGet(Optional ByVal psProperty As String _
876 , Optional pvKey As Variant _
877 )
878 ''' Return the named property
879 ''' Args:
880 ''' psProperty: the name of the property
881 ''' pvKey: the key to retrieve, numeric or string
883 Dim vItemMap As Variant ' Entry in the MapItems array
884 Dim vArray As Variant ' To get Keys or Values
885 Dim i As Long
886 Dim cstThisSub As String
887 Dim cstSubArgs As String
889 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
894 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
896 Select Case UCase(psProperty)
898 _PropertyGet = _MapSize - _MapRemoved
901 If Exists(pvKey) Then _PropertyGet = MapItems(MapKeys(pvKey)).Value Else _PropertyGet = Empty
903 vArray = Array()
906 i = -1
907 For each vItemMap In MapItems()
908 If Not IsEmpty(vItemMap) Then
909 i = i + 1
910 If UCase(psProperty) = "KEYS" Then vArray(i) = vItemMap.Key Else vArray(i) = vItemMap.Value
911 End If
912 Next vItemMap
913 End If
914 _PropertyGet = vArray
915 End Select
917 Finally:
918 SF_Utils._ExitFunction(cstThisSub)
919 Exit Function
920 Catch:
921 GoTo Finally
922 End Function ' ScriptForge.SF_Dictionary._PropertyGet
924 REM -----------------------------------------------------------------------------
925 Private Function _Repr() As String
926 ''' Convert the Dictionary instance to a readable string, typically for debugging purposes (DebugPrint ...)
927 ''' Args:
928 ''' Return:
929 ''' "[Dictionary] (key1:value1, key2:value2, ...)
931 Dim sDict As String ' Return value
932 Dim vKeys As Variant ' Array of keys
933 Dim sKey As String ' Tempry key
934 Dim vItem As Variant ' Tempry item
940 _Repr = ""
942 If Count = 0 Then
943 sDict = cstDictEmpty
944 Else
946 vKeys = Keys
947 For Each sKey in vKeys
948 vItem = Item(sKey)
949 sDict = sDict & sKey & ":" & SF_Utils._Repr(vItem, cstMaxLength) & cstSeparator
950 Next sKey
951 sDict = Left(sDict, Len(sDict) - Len(cstSeparator)) & ")" ' Suppress last comma
952 End If
954 _Repr = sDict
956 End Function ' ScriptForge.SF_Dictionary._Repr
958 REM ============================================ END OF SCRIPTFORGE.SF_DICTIONARY
959 </script:module>