-
Notifications
You must be signed in to change notification settings - Fork 0
/
ScriptingDictionary.cls
430 lines (397 loc) · 18.9 KB
/
ScriptingDictionary.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ScriptingDictionary"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_Description = "A VBA wrapper for the Microsoft Scripting.Dictionary, scrrun.dll library, implementing an IScriptingDictionary interface.\r\n\r\nVBA-IDictionary v2.1 (September 02, 2019)\r\n(c) Mark Johnstone - https://github.com/MarkJohnstoneGitHub/VBA-IDictionary\r\nAuthor: markjohnstone@hotmail.com\r\n"
''
'Rubberduck annotations
'@Folder("VBA-IScriptingDictionary")
'@PredeclaredId
'@ModuleDescription "A VBA wrapper for the Microsoft Scripting.Dictionary, scrrun.dll library, implementing an IScriptingDictionary interface.\r\n\r\nVBA-IDictionary v2.1 (September 02, 2019)\r\n(c) Mark Johnstone - https://github.com/MarkJohnstoneGitHub/VBA-IDictionary\r\nAuthor: markjohnstone@hotmail.com\r\n"
'@REFERENCEADDIN Microsoft Scripting Runtime Scripting scrrun.dll
'
'@Version VBA-IDictionary v2.1 (September 02, 2019)
'(c) Mark Johnstone - https://github.com/MarkJohnstoneGitHub/VBA-IDictionary
'@Description A VBA wrapper for the Microsoft Scripting.Dictionary, scrrun.dll library
'@Dependencies
' IScriptingDictionary.cls
' ScriptingDictionary.cls
' Optional: Reference addin Microsoft Scripting Runtime Scripting, scrrun.dll dependant on compiler constant settings.
'@Author Mark Johnstone markjohnstone@hotmail.com
'@LastModified July 28, 2019
'
'@Errors 429 Cannot Create Object as Scripting.Dictionary is not available.
' Raised for Mac or Scripting.Dictionary isn't available from compiler arguments.
' It can also be raised for late binding where the call to CreateObject fails.
'@Remarks
' The compiler constants SCRIPTING_REFERENCE and SCRIPTING_LATEBINDING are
' used to determine whether the library is referenced or if not. If not available
' to created using late binding.
' These compiler constants are required to be appropriately set in the
' ScriptingDictionary.cls and the Dictionary.cls
' If not set appropriately they may cause compile errors.
'
' Updating the compiler constants
' If the Microsoft Scripting Runtime is referenced set:
' SCRIPTING_REFERENCE = True
' If the Microsoft Scripting Runtime is not referenced and is available for late binding set
' SCRIPTING_REFERENCE = False, SCRIPTING_LATEBINDING = True
' For Mac, set to:
' SCRIPTING_REFERENCE = False, SCRIPTING_LATEBINDING = False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Option Explicit
'============================================='
'Compiler Constants
'============================================='
'@CompilerConstants
#Const SCRIPTING_REFERENCE = True
#Const SCRIPTING_LATEBINDING = True
Implements IScriptingDictionary
'============================================='
'Types
'============================================='
#If Not Mac And SCRIPTING_REFERENCE Then
Private Type TScriptingDictionary
scriptDictionary As Scripting.Dictionary
End Type
#ElseIf Not Mac And SCRIPTING_LATEBINDING Then
Private Type TScriptingDictionary
scriptDictionary As Object
End Type
#End If
'============================================='
'Constants
'============================================='
Const SCRIPTING_DICTIONARY As String = "Scripting.Dictionary"
'============================================='
'Private Variables
'============================================='
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Private this As TScriptingDictionary
#End If
'============================================='
'Constructors and destructors
'============================================='
'@Description Initializes the ScriptingDictionary with either early or late binding according to the constant compiler arguments.
'@Errors 429 Run-time error '429': ActiveX component can't create object
' Raised for Mac or Scripting.Dictionary isn't available from compiler arguments.
' It can also be raised for late binding where the call to CreateObject fails.
Private Sub Class_Initialize()
#If Not Mac And SCRIPTING_REFERENCE Then
Set this.scriptDictionary = New Scripting.Dictionary
#ElseIf Not Mac And SCRIPTING_LATEBINDING Then
Set this.scriptDictionary = CreateObject(SCRIPTING_DICTIONARY)
#Else
VBA.Err.Raise 429 'Cannot create object as Scripting.Dictionary is not available."
#End If
End Sub
Private Sub Class_Terminate()
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Set this.scriptDictionary = Nothing
#End If
End Sub
'============================================='
'Properties
'============================================='
''
'@Description("Sets or returns the comparison mode for comparing keys in a Dictionary object.")
'------------------------------------------------------------'
Public Property Get CompareMode() As VBA.VbCompareMethod
Attribute CompareMode.VB_Description = "Sets or returns the comparison mode for comparing keys in a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
CompareMode = this.scriptDictionary.CompareMode
#End If
End Property
''
'@Description("Sets the comparison mode for comparing keys in a Dictionary object.")
'@param compareMethod Value representing the comparison mode used by functions such as StrComp.
'@Error 5 Invalid procedure call or argument
' Raised for an invalid data type for compareMethod.
'@Error 9 Subscript out of range
' Raised for an invalid value for compareMethod.
'@Remarks The comparison mode cannot be changed once the dictionary contains items
'------------------------------------------------------------'
Public Property Let CompareMode(ByVal compareMethod As VBA.VbCompareMethod)
Attribute CompareMode.VB_Description = "Sets the comparison mode for comparing keys in a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.CompareMode = compareMethod
#End If
End Property
''
'@Description("Returns the number of key, item pairs in a Dictionary object.")
Public Property Get Count() As Long
Attribute Count.VB_Description = "Returns the number of key, item pairs in a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Count = this.scriptDictionary.Count
#End If
End Property
''
'@Enumerator
'@Description("Enumerator for dictionary which returns dictionary keys.")
'@Remarks Attribute NewEnum.VB_UserMemId = -4 declares NewEnum as the enumerator
' Attribute NewEnum.VB_MemberFlags = "40" declares NewEnum as a hidden property.
' ------------------------------------------------------------'
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Enumerator for dictionary which returns dictionary keys."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Set NewEnum = this.scriptDictionary.Keys.[_NewEnum]
#End If
End Property
''
'@DefaultMember
'@Description("Sets or returns the value of an item in a Dictionary object.")
'@param key The key associated with the item being retrieved.
'@Error 5 Invalid procedure call or argument.
' Raised for invalid key data type.
'@Remarks
' The syntax for setting an item is: dictionaryobject.Item(key) = newItem
' If you try to set item to a nonexistent key, a new key, item pair is added
' to the dictionary, and its associated item is left empty, a sort of "implicit add".
' Attribute Item.VB_UserMemId = 0 Declares property Item as the default property.
'------------------------------------------------------------'
Public Property Get Item(ByRef Key As Variant) As Variant
Attribute Item.VB_Description = "Sets or returns the value of an item in a Dictionary object."
Attribute Item.VB_UserMemId = 0
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Dim result As Variant
result = Array(this.scriptDictionary.Item(Key)) 'The get Item property result is wrapped in the Array to avoid running twice
If VBA.IsObject(result(0)) Then
Set Item = result(0)
Else
Item = result(0)
End If
#End If
End Property
''
'@DefaultMember
'@Description Sets a scalar item value for a specified key in a Dictionary object
'@param key The key associated with the item being retrieved or added.
'@param Item The new value associated with the specified key
'@Error 5 Invalid procedure call or argument
' Raised for an invalid key data type
'@Error 450 Wrong number of arguments of invalid property assignment
' Raised when an item is an object when expecting a scalar value
'@Remarks
' The syntax for setting an item is: dictionaryobject.Item(key) = newItem
' If you try to set item to a nonexistent key, the key is added to the dictionary,
' and the item is linked to it, a sort of "implicit add."
'------------------------------------------------------------'
Public Property Let Item(ByRef Key As Variant, ByRef Item As Variant)
Attribute Item.VB_Description = "Sets or returns the value of an item in a Dictionary object."
Attribute Item.VB_UserMemId = 0
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Item(Key) = Item
#End If
End Property
''
'@DefaultMember
'@Description Sets the object value of an item in a Dictionary object.
'@param key Key associated with the item being retrieved or added.
'@param Item The new value associated with the specified key
'@Error 5 Invalid procedure call or argument
' Raised for invalid key data type.
'@Error 424 Object required
' Raised when the item is a scalar value when expecting an object.
'@Remarks
' The syntax for setting an item is: Set dictionaryobject.Item(key) = newItem
' If you try to set item to a nonexistent key, the key is added to the dictionary,
' and the item is linked to it, a sort of an "implicit add."
'------------------------------------------------------------'
Public Property Set Item(ByRef Key As Variant, ByRef Item As Object)
Attribute Item.VB_Description = "Sets or returns the value of an item in a Dictionary object."
Attribute Item.VB_UserMemId = 0
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Set this.scriptDictionary.Item(Key) = Item
#End If
End Property
''
'@Description("Sets a new key for an existing key in a Dictionary object.")
'@param key The key value being changed.
'@param newKey The new key value that replaces the specified key.
'@Error 5 Invalid procedure call or argument
' Raised for invalid key data type
'@Error 457 This key is already associated with an element of this collection
' Raised when new key already exists in the dictionary object
'@Error 32811 Application-defined or object-defined error
' Raised when previous key doesn't exist in the dictionary object
'------------------------------------------------------------'
Public Property Let Key(ByRef Key As Variant, ByRef newKey As Variant)
Attribute Key.VB_Description = "Sets a new key for an existing key in a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Key(Key) = newKey
#End If
End Property
'============================================='
'Public Methods
'============================================='
''
'@Description("Creates a new instance of a ScriptingDictionary.")
'@param compareMethod (Optional) The comparison mode for comparing string keys in a Dictionary object, default is vbBinaryCompare.
'@return (ScriptingDictionary)
Public Function Create(Optional ByVal compareMethod As VBA.VbCompareMethod = VBA.vbBinaryCompare) As ScriptingDictionary
Attribute Create.VB_Description = "Creates a new instance of a ScriptingDictionary."
Dim newDictionary As ScriptingDictionary
Set newDictionary = New ScriptingDictionary
newDictionary.CompareMode = compareMethod
Set Create = newDictionary
End Function
''
'@Description("Adds a key and item pair to a Dictionary object.")
'@param key The key associated with the item being added.
'@param item The new item associated with the key being added.
'@Error 5 Invalid procedure call or argument
' Raised for an invalid/unsupported key data type
'@Error 457 This key is already associated with an element of this collection
'------------------------------------------------------------'
Public Sub Add(ByRef Key As Variant, ByRef Item As Variant)
Attribute Add.VB_Description = "Adds a key and item pair to a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Add Key, Item
#End If
End Sub
''
'@Description("Returns True if a specified key exists in the Dictionary object; False if it does not.")
'@param key The key value being searched for in the Dictionary object.
'@returns {Boolean}
'@Error 5 Invalid procedure call or argument
' Raised for invalid key data type
'------------------------------------------------------------'
Public Function Exists(ByRef Key As Variant) As Boolean
Attribute Exists.VB_Description = "Returns True if a specified key exists in the Dictionary object; False if it does not."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Exists = this.scriptDictionary.Exists(Key)
#End If
End Function
''
'@Description("Returns an array of items in a dictionary object.")
'@return Variant Array of items
'------------------------------------------------------------'
Public Function Items() As Variant
Attribute Items.VB_Description = "Returns an array of items in a dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Items = this.scriptDictionary.Items
#End If
End Function
''
'@Description("Returns an array of all the keys in a dictionary object.")
'@returns {Variant} Array of keys
'------------------------------------------------------------'
Public Function Keys() As Variant
Attribute Keys.VB_Description = "Returns an array of all the keys in a dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Keys = this.scriptDictionary.Keys
#End If
End Function
''
'@Description("Removes a key, item pair from a Dictionary object.")
'@param key The key associated with the key/item pair to remove from the Dictionary object.
'@Error 5 Invalid procedure call or argument
' Raised for invalid/unsupported key data type
'------------------------------------------------------------'
Public Sub Remove(ByRef Key As Variant)
Attribute Remove.VB_Description = "Removes a key, item pair from a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Remove Key
#End If
End Sub
''
'@Description("Removes all key, item pairs from a Dictionary object.")
'------------------------------------------------------------'
Public Sub RemoveAll()
Attribute RemoveAll.VB_Description = "Removes all key, item pairs from a Dictionary object."
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.RemoveAll
#End If
End Sub
'============================================='
'Interfaces
'============================================='
'------------------------------------------------------------'
'IScriptingDictionary Properties
'------------------------------------------------------------'
Private Property Get IScriptingDictionary_CompareMode() As VBA.VbCompareMethod
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
IScriptingDictionary_CompareMode = this.scriptDictionary.CompareMode
#End If
End Property
Private Property Let IScriptingDictionary_CompareMode(ByVal compareMethod As VBA.VbCompareMethod)
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.CompareMode = compareMethod
#End If
End Property
Private Property Get IScriptingDictionary_Count() As Long
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
IScriptingDictionary_Count = this.scriptDictionary.Count
#End If
End Property
Private Property Get IScriptingDictionary_NewEnum() As IUnknown
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Set IScriptingDictionary_NewEnum = Me.NewEnum
#End If
End Property
Private Property Get IScriptingDictionary_Item(ByRef Key As Variant) As Variant
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Dim result As Variant
result = Array(this.scriptDictionary.Item(Key)) 'The get Item property result is wrapped in the Array to avoid running twice
If IsObject(result(0)) Then
Set IScriptingDictionary_Item = result(0)
Else
IScriptingDictionary_Item = result(0)
End If
#End If
End Property
Private Property Let IScriptingDictionary_Item(ByRef Key As Variant, ByRef Item As Variant)
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Item(Key) = Item
#End If
End Property
Private Property Set IScriptingDictionary_Item(ByRef Key As Variant, ByRef Item As Object)
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
Set this.scriptDictionary.Item(Key) = Item
#End If
End Property
Private Property Let IScriptingDictionary_Key(ByRef Key As Variant, ByRef newKey As Variant)
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Key(Key) = newKey
#End If
End Property
'------------------------------------------------------------'
'IScriptingDictionary Methods
'------------------------------------------------------------'
Private Sub IScriptingDictionary_Add(ByRef Key As Variant, ByRef Item As Variant)
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Add Key, Item
#End If
End Sub
Private Function IScriptingDictionary_Exists(ByRef Key As Variant) As Boolean
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
IScriptingDictionary_Exists = this.scriptDictionary.Exists(Key)
#End If
End Function
Private Function IScriptingDictionary_Items() As Variant
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
IScriptingDictionary_Items = this.scriptDictionary.Items
#End If
End Function
Private Function IScriptingDictionary_Keys() As Variant
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
IScriptingDictionary_Keys = this.scriptDictionary.Keys
#End If
End Function
Private Sub IScriptingDictionary_Remove(Key As Variant)
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.Remove Key
#End If
End Sub
Private Sub IScriptingDictionary_RemoveAll()
#If Not Mac And (SCRIPTING_REFERENCE Or SCRIPTING_LATEBINDING) Then
this.scriptDictionary.RemoveAll
#End If
End Sub