I have a Dictionary object in VBScript. How can I copy all the objects contained in it to a new Dictionary, i.e. create a clone/duplicate of the dictionary?
Create a new Dictionary object, iterate through the keys in the original dictionary and adds these keys and the corresponding values to the new dictionary, like this:
Function CloneDictionary(Dict)
Dim newDict
Set newDict = CreateObject("Scripting.Dictionary")
For Each key in Dict.Keys
newDict.Add key, Dict(key)
Next
newDict.CompareMode = Dict.CompareMode
Set CloneDictionary = newDict
End Function
This should be enough in most cases. However, if your original dictionary holds objects, you'll have to implement deep cloning, that is, clone these objects as well.
If anyone is looking for a VBA solution, the following function performs a "deep-clone" of a dictionary, including nested dictionary objects.
' Compare mode for cloning dictionary object
' See CloneDictionary function
Public Enum eCompareMethod2
ecmBinaryCompare = 0
ecmTextCompare = 1
ecmDatabaseCompare = 2
' Added this to use original compare method
ecmSourceMethod = 3
End Enum
'---------------------------------------------------------------------------------------
' Procedure : CloneDictionary
' Author : Adam Waller
' Date : 3/30/2021
' Purpose : Recursive function to deep-clone a dictionary object, including nested
' : dictionaries.
' : NOTE: All other object types are cloned as a reference to the same object
' : referenced by the original dictionary, not a new object.
'---------------------------------------------------------------------------------------
'
Public Function CloneDictionary(dSource As Dictionary, _
Optional Compare As eCompareMethod2 = ecmSourceMethod) As Dictionary
Dim dNew As Dictionary
Dim dChild As Dictionary
Dim varKey As Variant
' No object returned if source is nothing
If dSource Is Nothing Then Exit Function
' Create new dictionary object and set compare mode
Set dNew = New Dictionary
If Compare = ecmSourceMethod Then
' Use the same compare mode as the original dictionary.
dNew.CompareMode = dSource.CompareMode
Else
dNew.CompareMode = Compare
End If
' Loop through keys
For Each varKey In dSource.Keys
If TypeOf varKey Is Dictionary Then
' Call this function recursively to add nested dictionary
Set dChild = varKey
dNew.Add varKey, CloneDictionary(dChild, Compare)
Else
' Add key to dictionary
dNew.Add varKey, dSource(varKey)
End If
Next varKey
' Return new dictionary
Set CloneDictionary = dNew
End Function
Take a look at the accepted answer in VBScript: How to utiliize a dictionary object returned from a function?. Could be a solution if a reference is all that is being looked for.
Edit As per Ekkehard.Horner's comment, I understand now that this is not cloning, but may help others who are only looking for a reference to the original object.
Related
I wrote an CSV import function. The CSV file gets seperated into columns and rows and is then saved into a multidimensional array.
At one point, I need to set the multidimensional array to Empty, because the following If-condition checks for IsEmpty().
I already tried this:
aMultidimArray = Empty
aMultidimArray = Nothing
ReDim aMultidimArray(0,0)
Erase aMultidimArray
a = Split(sData, sDelimiter)
For Each x In a
'*** Resize and write into multidimensional array
ReDim Preserve aMultidimArray(iFirstDim, iSecondDim)
aMultidimArray(i - 1,iSecondDim) = x
If (i = iFirstDim + 1) Then
i = 0
End If
i = i + 1
Next
'***Empty array here
???
'***
GetDataFromCSV = aMultidimArray
'**** other script
If IsEmpty(GetDataFromCSV) Then
Do stuff
End If
The IsEmpty(GetDataFromCSV) should return true, but I cannot handle it.
It is NOT about clearing the array. It's about getting it uninitialized again. If this is even possible.
As a workaround (or maybe just a better solution) I just called Exit function. As a result the return value is Emptyand the IsEmptycondition will return True.
When in doubt, read the documentation:
IsEmpty returns True if the variable is uninitialized, or is explicitly set to Empty; otherwise, it returns False. False is always returned if expression contains more than one variable.
Since your variable absolutely is initialized, even if you remove all values from the array, why would you expect IsEmpty to return anything but False?
Depending on what you actually want to achieve with your code you could check the dimensions of your array:
If UBound(GetDataFromCSV, 1) = -1 And UBound(GetDataFromCSV, 2) = -1 Then
'array is a 0x0 array
End If
If your array is not zero-sized you probably need to iterate over all fields and check if those are empty.
If you think you need to reset a variable that was defined as an array to Empty I suspect you made a design error somewhere, so I would strongly recommend to go back and fix the design. However, if you absolutely must reset an array variable to Empty for some reason you should be able to do so like this:
ReDim a(2, 5) 'define variable as array
...
Dim a 're-define variable as regular variable; does not clear the value
a = Empty 'clear variable
I am writing a Contains method for vb6 collections that hold strings.
However I cannot get the syntax right on my foreach.
What should I change?
Public Function Contains(col as Collection, key as Variant) as Boolean
Dim thing as Object '// this is the key
For Each thing in col
If CStr(key) = CStr(thing) then
Contains = True
Exit Function
End If
Next
Contains = False
End Function
This is really getting annoying. The following is a method which is contained in a custom database class. I query data into a recordset then try to convert this data into an array w/o field names. It appears to be working within the function because I setup a response.write to check if there were any values. But once out of the function, things go haywire (the array is not the same).
Public Function To2Array()
dim A, x, columns
columns = Rs.Fields.Count
Rs.MoveFirst()
x = 0
do until Rs.EOF
Redim A(x+1,columns)
for y = 0 to columns - 1
A(x,y) = Rs.Fields.Item(y)
response.write A(x,y) 'returns correct value
Next
x = x + 1
Rs.MoveNext()
loop
To2Array = A
End Function
I assign the return array but there appears to be nothing.
arr = db.To2Array()
response.write(arr(1,0)) 'returns nothing
Can anyone figure out what I'm doing wrong?
You can only grow the last dimension of an VBScript array. So you
need an colsXrows array.
To keep the 'old' part of a dynamic array, you must ReDim Preserve.
To get a two dimensional array from a recordset, use .GetRows - and avoid all risks of 'rolling your own'.
You lose the values in A every time you redim it. Using redim preserve prevents this, but you can only redim the last array dimension when you use preserve.
I’m trying to obtain data from a dll, but I do not know how to do it.
My code is:
'Function
Public Declare Function SET_XML_PATH Lib "EbmPapstFan.dll" (ByRef ruta As String) As Long
Public Declare Function GET_PRODUCTS Lib "EbmPapstFan.dll" (ByRef ruta As String) As Long
Sub Selec()
Dim ruta As String
Dim Int_A As Long, Int_B
ruta = "C:\ebmpapst\data\AC\"
Int_A = SET_XML_PATH(ruta) 'If Int_A=0 then they aren't mistake
Int_B = GET_PRODUCTS("")
Worksheets("Selec").Range("E2").Value = Int_B 'Nº products
End sub
Results are:
Int_A= 0
Int_B= 18
This isn't a mistake with the path because Int_A is 0. In addition, GET_PRODUCTS gives me the number of products that software has. The manual say that this function also has string character output.
The primary problem is that I don’t know how obtain this other string character output.
vb dll strange output in C#
Both outputs of the declared functions are "Long" and not "String" so there's no way that they're outputting anything except that.
I'd recommend revisiting the manual you refer to, to see exactly how it is documented and what the string value's function call would be.
The 2 function declaratons show long as the return types, however, the string being passed in is going in byRef and not byVal. It is possible that the string value is being returned via that parameter being adjusted inside the call.
More details about the documentation would be helpful.
I have the following code:
Public Shared Function GetAvailableManufacturers() As List(Of Manufacturer)
'first get all the live orders and extract their mfrs'
Dim sos As List(Of OrderForm) = GetFormsByStatus(StockStatus.Building)
Dim unavailableMfrs As New List(Of Manufacturer)
For Each so As StockingOrder In sos
unavailableMfrs.Add(so.Source)
Next
'then remove all mfrs with an open SO from a list of all mfrs'
Dim allMfrs As List(Of Manufacturer) = Manufacturer.GetManufacturers
Return allMfrs.Except(unavailableMfrs) <----- error here
End Function
Explanation of what the above does:
GetFormsByStatus() self-explanatory
GetManufacturers() returns a list of all manufacturers in the database
My idea to get available manufacturers was to get a list of all the manufacturers in my open forms, then get a list of all manufacturers and exclude all the manufacturers in the first list, illustrated like so (pseudo):
List A: {1,2,3,4,5,6,7,8,9,10}
List B: {5,7,10}
Result: {1,2,3,4,6,8,9}
I have set up my Manufacturer class according to this article so that it can be compared, but I'm still getting this error:
Unable to cast object of type '<ExceptIterator>d__92'1[csCore.Manufacturer]' to type 'System.Collections.Generic.List'1[csCore.Manufacturer]'.
I thought at first that because during testing GetFormsByStatus() returns 0 results maybe that was causing problems, but it doesn't make sense that Except() wouldn't work if the provided list had 0 items. Can anyone spot what I'm doing wrong?
Thanks so much!
The function expects a List(Of Manufacturer) return type, not an IEnumerable(Of Manufacturer), so adding a .ToList() to the return value should fix it:
Return allMfrs.Except(unavailableMfrs).ToList()
Your function is declared as returning List(Of Manufacturer), but your Return statement is returning only an IEnumerable(Of Manufacturer). Change the return statement to:
Return allMfrs.Except(unavailableMfrs).ToList()
If you turn Option Strict On, I believe VB will catch this kind of error at compile time, instead of blowing up at runtime.
The problem is that Enumerable.Except returns IEnumerable<T>, but your return type is List(Of T).
Change your last line to:
Return allMfrs.Except(unavailableMfrs).ToList()