How much do you trust the Collection class?

[DEXWERX]

So, if I understand correctly, you're proposing that there are two additional structures (one a hash table (small-ish array) and the other a complete sorted array of collection entries).

It seems you're off in the weeds... I didn't say anything like that. To implement an identically functioning Collection class, you wouldn't need any additional structures beyond VBCOLLECTIONITEM. It is however probably that the Collection Class uses an Array of Buckets. The Bucket could be an array of 2-3 VBCOLLECTIONITEM(s).

[DEXWERX]

So, are you proposing that VB keeps that array sorted (upon .Add)? And that the doubly-linked pointers are just there so the index order doesn't have to agree with the sort order?

bingo. (to clarify that's not what I'm proposing. proposing seems too weak - I'm saying with a high degree of confidence, that this is exactly how the collection class works)

Also when you say an array is sorted.. no sorting is happening on Add. Only Node Insertion... the Prev/Next pointers are updated of the "neighboring nodes". neighboring nodes, are not sequential in the array. Hashtable(s) are by their nature - unsorted. (remember - we're jumping into an "arbitrary" array index, calculated by the Hash Function.)

This unsorted nature of a base HashTable and the Collection class, is exactly the type of issue that was going to be addressed in an updated Collection in VB7. And actually was addressed in .NET



If you really want to abuse the Collection class, Keep .Add(ing) entries at the middle Index, and watch the Add slow to a crawl the more Entries you add.

Read TheTrick's HashTable Implementation if you want more details on how to combine a HashTable with a Doubly linked list.
http://www.vbforums.com/showthread.p...VB6-Hash-table

It's very similar to VB's Collection class... it looks like he uses a single level of indirection, to go from a hash index, to a dynamically allocated bucket. (A dynamic array of dynamic arrays)


Here's a piece of code from The Trick

Public Property Let Item(Key As Variant, value As Variant)
    Dim pt As tPointer
    
    If Not GetFromKey(Key, pt) Then
        Err.Raise 5
        Exit Property
    End If
    
    If pt.Index = -1 Then Err.Raise 5: Exit Property
    List(pt.hash).Elements(pt.Index).value = value
    
End Property

His internal Hashtable is called List() his array of Slots within the Bucket are named Elements.
You can see in that one line of code, that the "Hash" or "arbitrary array position" is used directly as an index into his HashTable.
the GetFromKey worker function, checks if the Key exists, and for collisions - and updates pt.Index accordingly.
It's not theory, this is how a Hashtable works in practice.

[Elroy]

Okay, to test this proposition, I wrote a routine to gather up and return all the First, Next, Next, etcetera pointers. If the Collection is sorted, and we add a series of keys that are randomly alphabetized (i.e., not alphabetized), then these pointers should jump all around. Just to get right to my test code, here it is:

Option Explicit
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
'
Private Type VbCollection
    pVTable As Long     ' &h0000 
    Unk0    As Long     ' &h0004 
    Unk1    As Long     ' &h0008 
    Unk2    As Long     ' &h000C 
    Count   As Long     ' &h0010 
    Unk3    As Long     ' &h0014 
    First   As Long     ' &h0018 
    Last    As Long     ' &h001C 
End Type                ' &h0020 length 
'
Private Type VbCollectionItem
    Data    As Variant  ' &h0000 
    Key     As String   ' &h0010 
    Prev    As Long     ' &h0014 
    Next    As Long     ' &h0018 
End Type                ' &h001C length 
'

Private Sub Form_Load()
    Dim c As New Collection
    Dim p() As Long
    Dim i As Long


    c.Add "asdf", "asdf"
    c.Add "qwer", "qwer"
    c.Add "cdef", "cdef"
    c.Add "fghj", "fghj"
    c.Add "cfgh", "cfgh"
    c.Add "aihg", "aihg"
    c.Add "werb", "werb"
    c.Add "bbbb", "bbbb"
    c.Add "ercd", "ercd"


    p = CollectionNextPointers(c)
    For i = 0 To c.Count
        Debug.Print p(i)
    Next i

End Sub

Public Function CollectionNextPointers(Coll As Collection) As Long()
    ' This returns an array of the entire collection's "Next" pointers. 
    ' The array's zeroth element is the pointer from the header to the first item. 
    Dim CollNextPtrs() As Long
    Dim j As Long
    Dim iHold As Long
    Dim ptr As Long
    '
    If Coll Is Nothing Then
        Err.Raise 91
        Exit Function
    End If
    '
    If Coll.Count = 0 Then Exit Function
    '
    ReDim CollNextPtrs(0 To Coll.Count)
    CopyMemory ptr, ByVal ObjPtr(Coll) + &H18, 4    ' VbCollection.First 
    CollNextPtrs(0) = ptr
    For j = 1 To Coll.Count
        CopyMemory ptr, ByVal ptr + &H18, 4         ' VbCollectionItem.Next 
        CollNextPtrs(j) = ptr
    Next j
    '
    CollectionNextPointers = CollNextPtrs
End Function

Particularly notice this loop:

    p = CollectionNextPointers(c)
    For i = 0 To c.Count
        Debug.Print p(i)
    Next i

Now, here's what that printed out for me (annotated by me):

 75472608   <--- First pointer from header.
 75472696   <--- Next pointer of first item.
 75472784   <--- Next pointer of next item.
 75472872   <--- Next pointer of next item.
 75472960   <--- Next pointer of next item.
 75473048   <--- Next pointer of next item.
 75473136   <--- Next pointer of next item.
 75473224   <--- Next pointer of next item.
 75473312   <--- Next pointer of next item.
 0          <--- Next pointer of last item.

Okay, the very first thing to notice here is that the pointers are sequential. In other words, the pointers are in the same order as the Collection items indices. However, look at the keys added. They're far from alphabetical.

So, the keys are not alphabetized in the VBCOLLECTIONITEM array. Therefore, when we have two keys that might produce the same hash-code, having a pointer into this VBCOLLECTIONITEM array does us no good if we jump into the wrong key. The other key can be anywhere in the array.

Next, I'll do some testing to see if it's even an array, or just a scattered collection of memory blocks.

Regards,
Elroy

[Elroy]

Okay, it does seem to be a contiguous block of memory. Here's what I did:

Option Explicit
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
'
Private Type VbCollection
    pVTable As Long     ' &h0000 
    Unk0    As Long     ' &h0004 
    Unk1    As Long     ' &h0008 
    Unk2    As Long     ' &h000C 
    Count   As Long     ' &h0010 
    Unk3    As Long     ' &h0014 
    First   As Long     ' &h0018 
    Last    As Long     ' &h001C 
End Type                ' &h0020 length 
'
Private Type VbCollectionItem
    Data    As Variant  ' &h0000 
    Key     As String   ' &h0010 
    Prev    As Long     ' &h0014 
    Next    As Long     ' &h0018 
End Type                ' &h001C length 
'

Private Sub Form_Load()
    Dim c As New Collection
    Dim p() As Long
    Dim i As Long
    Dim a() As String
    Dim b() As Long
    Dim s As String

    ReDim a(1 To 1000)

    c.Add "asdf", "asdf"
    c.Add "qwer", "qwer"
    c.Add "cdef", "cdef"
    c.Add "fghj", "fghj"

    ' Attempt to allocate/deallocate some memory 
    Erase a
    ReDim b(1 To 5000)
    s = String(3000, "x")

    c.Add "cfgh", "cfgh"
    c.Add "aihg", "aihg"
    c.Add "werb", "werb"
    c.Add "bbbb", "bbbb"
    c.Add "ercd", "ercd"


    p = CollectionNextPointers(c)
    For i = 0 To c.Count
        Debug.Print p(i)
    Next i

End Sub

Public Function CollectionNextPointers(Coll As Collection) As Long()
    ' This returns an array of the entire collection's "Next" pointers. 
    ' The array's zeroth element is the pointer from the header to the first item. 
    Dim CollNextPtrs() As Long
    Dim j As Long
    Dim iHold As Long
    Dim ptr As Long
    '
    If Coll Is Nothing Then
        Err.Raise 91
        Exit Function
    End If
    '
    If Coll.Count = 0 Then Exit Function
    '
    ReDim CollNextPtrs(0 To Coll.Count)
    CopyMemory ptr, ByVal ObjPtr(Coll) + &H18, 4    ' VbCollection.First 
    CollNextPtrs(0) = ptr
    For j = 1 To Coll.Count
        CopyMemory ptr, ByVal ptr + &H18, 4         ' VbCollectionItem.Next 
        CollNextPtrs(j) = ptr
    Next j
    '
    CollectionNextPointers = CollNextPtrs
End Function

Particularly notice the line in between adding the list of items. It would seem that that would certainly shuffle memory around.

But here's my new list of "first/next" pointers.

 107868824
 107868912
 107869000
 107869088
 107869176
 107869264
 107869352
 107869440
 107869528
 0

Contiguous blocks of 88 (&h58) bytes each.

Actually, this brings up yet another question. From what you've (DEX) posted, we only know about &h1C bytes in the VBCOLLECTIONITEM structure. Where/what are the other 60 (&h3C) bytes?

Regards,
Elroy

[DEXWERX]

So, the keys are not alphabetized in the VBCOLLECTIONITEM array. Therefore, when we have two keys that might produce the same hash-code, having a pointer into this VBCOLLECTIONITEM array does us no good if we jump into the wrong key. The other key can be anywhere in the array.

Yes. this is exactly how a HashTable works. It's unsorted, and the other Key/Value pair can be anywhere in the Array/HashTable.

Next, I'll do some testing to see if it's even an array, or just a scattered collection of memory blocks.

That will tell you nothing, except that the buckets are dynamically allocated. If you look at Trick's code - he dynamically allocates his buckets as well - which means his buckets don't have to be contiguous in memory, and even if they are - you still can't deduce how they're indexed without stepping through the insertion to find the HashTable index, before its redirected. (pointers to pointers....)

[DEXWERX]

Contiguous blocks of 88 (&h58) bytes each.

Actually, this brings up yet another question. From what you've (DEX) posted, we only know about &h1C bytes in the VBCOLLECTIONITEM structure. Where/what are the other 60 (&h3C) bytes?

This isn't DOS, and I know enough about memory management to know I can't make any deductions about this. For all I know they are more slots in each bucket. CS101 says a bucket usually consists of multiple slots (2-3 according to Wikipedia) - to make collision resolution easier.

[Elroy]

We haven't solved much, if anything, but maybe it's time to put this one to bed. (In my mind, we (or I) have concluded that Collections work just fine so long as we honor some rules about Unicode.)

It would be nice to completely sort out how Collections work, but I don't think it's happening.

I still have no clue how a hash table is going to help us, unless there is a sorted array somewhere.

I could possibly see yet another set of doubly-linked pointers somewhere in that additional 60 bytes. The array itself doesn't need to be sorted, so long as we've got some way to traverse it in a sorted fashion. And pointers can certainly accomplish that. It rules out binary searches, but it doesn't rule out a hash table. Also, we need to recognize that the sorting has to be based on the actual hash-codes and not the actual keys.

I'm still far from convinced that hash-codes and hash-tables have anything to do with these things.

Regards,
Elroy

[DEXWERX]

I still have no clue how a hash table is going to help us, unless there is a sorted array somewhere.

I have no idea why you're stuck on sorting. Nothing is sorted. Ordered yes, sorted no. Very different concepts.

I'm still far from convinced that hash-codes and hash-tables have anything to do with these things.

A) you don't even know how a hash-table works... until that happens i don't see how you can make any sort of judgement?
B) We _know_ a VB collection uses a Hashtable because it's as fast as Hashtable.

[Elroy]

Alright DEX, we'll let the digs pass for the sake of some rational edification. Please go ahead and explain to me the distinction between ordered and sorted.

Ordered? Possibly based on pointers (but others from our index pointers) that traverse a list in a particular "order"? Possibly ... erm ... "organized" alphanumerically based on a value that's not actually in the list? DEX, please don't split hairs for the pure sake of obfuscation.

I think I've rather conclusively demonstrated that all the VBCOLLECTIONITEMs are in a contiguous block of memory, and that they're, at least initially, "ordered" (if you must) in the order they were added, and not by any alphabetizing (of either keys or hash-codes).

I'll freely admit that I don't use hash-codes daily, but I do have a reasonable working knowledge of what they are and how they're used in a hash-table. In fact, without any reference, I feel confident that I could patch together a hash-lookup-system reasonably quickly.

However, if we know that our hash-codes are lossy (i.e., multiple keys may derive the same hash-code, or, said differently, we can't derive the original key from the hash-code), then we know we may have collisions. Therefore, this knowledge mandates that must have some way to traverse our list in hash-code "order".

At the risk of incessantly-repeating myself, I see no evidence of any "ordering". In fact, all I see is the contrary, and I illustrated that above. You also talked about buckets. My understanding of a hash-table is that the buckets are in the table itself, and not in the list. Therefore, your comment about the unknown 60 bytes is also confusing to me.

I'll admit that it's still possible that a hash-table is present. However, to say that it must be because collections are fast, is like a drag-racer saying a cheetah is a dragster because it's fast. Maybe they crammed a dragster (or a cheetah) into a computer box, and that's what collections are.

DEX, at one point, I thought we were making some genuine progress to get this sorted, but I no longer believe that's the case.

I'm out'a this one.

You Take Care,
Elroy

[Tanner_H]

Alright, probably my last post on this as well. As others have suggested, I strongly believe this error is caused by a failed text comparison when trying to match keys on a .Item() call, where the hash table index in question contains multiple items (so the .Item() function has to search the linked list, comparing key values as it goes).

We know VB collections implement a case-insensitive, locale-specific text comparison much like StrComp + vbTextCompare. (dilettante confirmed this in #5.) The underlying C function for a string comparison like this is _wcsicoll (MSDN: https://msdn.microsoft.com/en-us/library/2w46a1da.aspx). As MSDN says, this function can fail if certain conditions are met:

_wcsicoll can fail if either string1 or string2 contains wide-character codes outside the domain of the collating sequence. When an error occurs, _wcsicoll may set errno to EINVAL.

EINVAL is the C equivalent of RTE 5, just a generic "invalid argument" error (https://msdn.microsoft.com/en-us/library/5814770t.aspx). As dilettante previously suggested, this could "bubble up" as the RTE 5 we're seeing here.

I don't know how optimized _wcsicoll is, but it may attempt a binary comparison before dropping back to a full locale-sensitive, collation comparison. This may explain why the .Item() function works if there's only one entry in that hash index (if it attempts a binary comparison and finds a match, it can immediately exit without performing the problematic collate operation that triggers the error). This is wandering way into the realm of wild guesses, though.

I'd be curious to see a disassembly that could confirm/refute this explanation, but beyond this, I'm not sure what else to add to the OP's original question. pekko already provided a great paper on the actual implementation of VB collections (in #19), and DEXWERX has painstakingly laid out a full CS 101 lesson in hash tables for beginners.

Anyway, thanks @Donar for the post. It's always good to have hard evidence of Collection shortcomings. I think the tl;dr of this discussion is: if you plan on using non-ANSI characters in your Collection keys, you should roll your own implementation, or normalize/manually hash your Unicode strings prior to using them as keys.

[dseaman]

On my machine (Win10 Pro x64) the demo fails in IDE at 4217.
Don't know if this helps but Hex D8BA is not valid Unicode.

4217 Attempt to access: 1192 BB0B 80D9 D8BA 0534 5374 -
ᆒ묋胙�Դ却
Character Hex D8BA is not valid Unicode according to BabelMap.
According to Unicode.Org:
High Surrogate Area
Range: D800-DBFF
Isolated surrogate code points have no interpretation; consequently, no character code charts or names lists are provided for this range.
See http://www.unicode.org/charts/ for access to a complete list of the latest character code charts.

More info on range D800-DFFF:

^ Unicode range D800–DFFF is used for surrogate pairs in UTF-16 (used by Windows) and CESU-8 transformation formats, allowing these encodings to represent the supplementary plane code points, whose values are too large to fit in 16 bits. A pair of 16-bit code points — the first from the high surrogate area (D800–DBFF), and the second from the low surrogate area (DC00–DFFF) — are combined to form a 32-bit code point from the supplementary planes.

Unicode and ISO/IEC 10646 do not assign actual characters to any of the code points in the D800–DFFF range — these code points only have meaning when used in surrogate pairs. Hence an individual code point from a surrogate pair does not represent a character, is invalid unless used in a surrogate pair, and is unconditionally invalid in UTF-32 and UTF-8 (if strict conformance to the standard is applied).

[Schmidt]

@Elroy and Dex (referring to his small HashList-CodeSnippet)

Here's another, fully implemented Class (kinda comparable to The Tricks HashList),
but with much less code - and not a single API-Declare.

http://www.vbforums.com/showthread.p...lass-(no-APIs)

These about 100 Lines of VB-Class-Code should help with studying a fully working HashList-implementation
(which doesn't necessarily need to be implemented as a Linked-List).

Edit: ... BTW - it runs the thread-opener-example without complaints...

Olaf

[The trick]

Here's another, fully implemented Class (kinda comparable to The Tricks HashList),
but with much less code - and not a single API-Declare.

My hash table has the additional code because it supports ForEach enumeration with the different modes and has single-class implementation.
By topic, i'll investigate Add method of collection. As soon as i'll find out how does it work i'll publish results here.

[DEXWERX]

I truly apologize for making the digs.

[Shaggy Hiker]

The discussion about the technical side of this issue has been interesting. The discussion about hash tables has also been interesting, but it appears to be degenerating into a discussion that is sure to just rile people up to no good end.

I think it would be good for somebody to write a concise post explaining how to avoid this issue, but let's not get back to personal comments.

[Elroy]

DEXWERX, I appreciate the apology.

If I've offended, which I'm sure I'm capable of, I offer an apology as well.

You have a great day,
Elroy

[DEXWERX]

@Elroy - I would like to formally take back the insults and passive aggressive jabs. I'm also sorry you read the continuation, before Shaggy got to them. I'll keep the frustration off the forums, and stick to the discussion at hand.
@Shaggy I'll try this again without insults... because I think the information is valuable.

A Hashtable is more accurately called a HashMap because with the most typical design, the Map itself is an Array of pointers to Bucket's and must be a contiguous array. Each entry in the Map has or is a pointer to a Bucket. Using a table of pointers, solves the issue of growing the Entries without having to allocate a bunch of Empty entries. Each bucket is dynamically allocated. This means it does not need to be contiguous in memory. It can be, (like Schmidt's example that simplifies allocation by using a VB Dynamic Array), but it doesn't have to be.

If one were to allocate memory in Between calls to .Add, Let's say by calling Add on another collection, would the entries of one Collection still be contiguous? Or could they be interleaved?

VBA.Collection is not sorted, it is however Ordered because you an access it by index, .Add allows inserting before or After an Index, and Enumerating uses the same order. The purpose of the doubly linked list in a Collection, is to maintain this Order.

.NET has both an OrderedDictionary and a SortedDictionary class. The SortedDictionary allows Retrieval by Index or Key, Where the SortedDictionary only allows Retrieval by Key.


A cheat sheet on Algorithm performance. http://bigocheatsheet.com/
You can measure performance, and deduce what can't be seen - similar to physics.

There's very few algorithms that can even approach O(log n) the performance (and simplicity) of a HashTable O(1) at retrieval by Key.

[DEXWERX]

Back on Topic:
If memory serves me right, I think it was someone on here that posted code that patches msvbvm60.dll in memory, to make VBA.Collection case sensitive.
He identified the the specific Collation API (in ole32 or oleaut32) that was used, and patched the flags in the 2 API calls to be case sensitive.

I'm sure Trick will probably find out a lot of specifics though. It would be nice to know what APIs are being used, where the HashMap is, and What HashFunction is used.

[pekko]

Back on Topic:
If memory serves me right, I think it was someone on here that posted code that patches msvbvm60.dll in memory, to make VBA.Collection case sensitive.

maybe this one
http://lmgtfy.com/?q=collection+msvb...3Avbforums.com

[DEXWERX]

touche, your google fu exceeds my own.

VarBstrCmp it is.
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

[Elroy]

@pekko, that's certainly an interesting piece of code. There's not a great deal that makes me nervous, but altering the memory-loaded machine code (actually, data, I suppose), of what is essentially now an OS file, does. We'd have to thoroughly test anytime the checksum of the MSVBVM60.DLL file changed.

I suppose I'm doing something similar when I fetch the string keys from memory. However, at least that's based on my own executable, and not a file provided by the OS (and I'm only reading memory). I also wonder how the change affects other things, like how StrComp works, and whether or not Option Compare will still have the same effect.

Again, it's certainly interesting though. It's too bad they didn't just expose such a property on Collections (possibly disabling writing to it once items are added). I cringe to bring it up, but I also wonder what effect it'll have on the operation of any "under the hood" hash-table. Clearly, we'd have a mess if we made this PatchCollection(IsCaseSensitive = True) call, added keys like "asdf", "ASDF", etcetera, and then called PatchCollection(IsCaseSensitive = False).

Regards,
Elroy

[The trick]

What i've found out.
VB6 collection is binary tree. An collection object contains all the items in the double linked list and all the items with keys in the tree. When you try to access to an item with key it searches one in the tree and if you access to item by the index it enumerates all the item until the specified item found. I've created an analog of Add method and Item property using reverse-engineering of code of MSVBVM60 runtime on Windows 7 x64. Because of VB6 doesn't supports pointers to UDT i've implemented it through classes.
All the offsets correspond to the native Collection structure (for example, if you change classes to udt, change work with the references and use the native VB memory allocator you can pass an collection object to Add/Item functions - it'll work correctly. If somebody will wonder i can implement Remove method too (i glance at Remove method and it uses some unknown structures (pvUnk4 for example)).
Class CVBCollection:

' //
' // Native VB collection
' // Decompiled by The trick
' //

Option Explicit

Private Const DISP_E_PARAMNOTFOUND        As Long = &H80020004
Private Const CTL_E_ILLEGALFUNCTIONCALL   As Long = &H800A0005
Private Const DISP_E_OVERFLOW             As Long = &H8002000A
Private Const E_OUTOFMEMORY               As Long = &H8007000E

Public pInterface1         As IUnknown            ' // 0x00
Public pInterface2         As IUnknown            ' // 0x04
Public pInterface3         As IUnknown            ' // 0x08
Public lRefCounter         As Long                ' // 0x0C
Public lNumOfItems         As Long                ' // 0x10
Public pvUnk1              As Long                ' // 0x14
Public pFirstIndexedItem   As CVBCollectionItem   ' // 0x18
Public pLastIndexedItem    As CVBCollectionItem   ' // 0x1C
Public pvUnk4              As Long                ' // 0x20
Public pFirstItem          As CVBCollectionItem   ' // 0x24
Public pRootItem           As CVBCollectionItem   ' // 0x28
Public pvUnk5              As Long                ' // 0x2C

' // Get item
Public Property Get Item( _
                    ByRef vKeyIndex As Variant) As Variant
    Dim hr      As Long
    Dim pItem   As CVBCollectionItem
    
    hr = GetItemByKey(vKeyIndex, pItem)
    
    If hr < 0 Then
        Err.Raise hr
        Exit Property
    End If
    
    If IsObject(pItem.vtItem) Then
        Set Item = pItem.vtItem
    Else
        Item = pItem.vtItem
    End If
    
End Property

' // Add item to collection
Public Sub Add( _
           ByRef vItem As Variant, _
           Optional ByRef vKey As Variant, _
           Optional ByRef vBefore As Variant, _
           Optional ByRef vAfter As Variant)
    Dim bIsEmptyKey     As Boolean
    Dim bIsEmptyBefore  As Boolean
    Dim bIsEmptyAfter   As Boolean
    Dim vIndex          As Variant
    Dim pNewItem        As CVBCollectionItem
    Dim pItem           As CVBCollectionItem
    Dim pTempItem       As CVBCollectionItem
    Dim bstrKey         As String
    Dim hr              As Long
    
    bIsEmptyKey = IsMissingParam(vKey)
    bIsEmptyBefore = IsMissingParam(vBefore)
    bIsEmptyAfter = IsMissingParam(vAfter)
    
    If bIsEmptyBefore Then
        If Not bIsEmptyAfter Then
            vIndex = vAfter
        End If
    Else
        If Not bIsEmptyAfter Then
            Err.Raise CTL_E_ILLEGALFUNCTIONCALL
            Exit Sub
        End If
        vIndex = vBefore
    End If
    
    If lNumOfItems < 0 Then
        Err.Raise DISP_E_OVERFLOW
        Exit Sub
    End If
    
    If bIsEmptyKey Then
        Set pNewItem = New CVBCollectionItem
    Else
        
        hr = GetItemByKey(vKey, pNewItem)
        If hr >= 0 Then
            Err.Raise &H800A01C9
            Exit Sub
        End If
        
        ' // 48
        Set pNewItem = New CVBCollectionItem
        
        bstrKey = BSTRKeyFromVariant(vKey)
        
        If Len(bstrKey) = 0 Then
            Err.Raise &H800A000D
            Exit Sub
        End If
        
        pNewItem.bstrKey = bstrKey
        pNewItem.bFlag = False
        
        Set pNewItem.pRight = pRootItem
        Set pNewItem.pLeft = pRootItem
        
    End If
    
    ' // VariantCopyInd
    pNewItem.vtItem = vItem
   
    If IsEmpty(vIndex) Then
        Set pItem = pLastIndexedItem
    Else
    
        hr = GetItemByKey(vIndex, pItem)
        If hr < 0 Then
            Err.Raise hr
            Exit Sub
        End If
        
        If Not bIsEmptyBefore Then
            Set pItem = pItem.pPrevIndexedItem
        End If
        
    End If
    
    If Not bIsEmptyBefore And pItem Is Nothing Then
    
        Dim pTmpItem As CVBCollectionItem
        
        Set pTmpItem = pFirstIndexedItem
        Set pFirstIndexedItem = pNewItem
        Set pTmpItem.pPrevIndexedItem = pNewItem
        Set pNewItem.pPrevIndexedItem = Nothing
        Set pNewItem.pNextIndexedItem = pTmpItem
        
    Else
    
        If Not pItem Is Nothing Then
        
            Set pNewItem.pNextIndexedItem = pItem.pNextIndexedItem
            
            If Not pItem.pNextIndexedItem Is Nothing Then
                Set pNewItem.pNextIndexedItem.pPrevIndexedItem = pNewItem
            Else
                Set pLastIndexedItem = pNewItem
            End If
            
            Set pItem.pNextIndexedItem = pNewItem
            
        Else
        
            Set pNewItem.pNextIndexedItem = Nothing
            Set pFirstIndexedItem = pNewItem
            Set pLastIndexedItem = pNewItem
          
        End If
        
    End If
    
    Set pNewItem.pPrevIndexedItem = pItem

    If Not bIsEmptyKey Then
        AddItemWithKeyToTree pNewItem
    End If
    
    lNumOfItems = lNumOfItems + 1
    
End Sub

' // Get item by variant key/index
Private Function GetItemByKey( _
                 ByRef vKey As Variant, _
                 ByRef pOutItem As CVBCollectionItem) As Long
    Dim bIsEmptyKey As Boolean
    Dim bstrKey     As String
    Dim lIndex      As Long
    Dim pItem       As CVBCollectionItem
    
    bIsEmptyKey = IsMissingParam(vKey)

    If bIsEmptyKey Or pFirstIndexedItem Is Nothing Then
        GetItemByKey = CTL_E_ILLEGALFUNCTIONCALL
        Exit Function
    End If
    
    bstrKey = BSTRKeyFromVariant(vKey)
    
    ' // This is string key
    If Len(bstrKey) Then
        
        Set pOutItem = FindItemFrom(pFirstItem, bstrKey)
        
        If pOutItem Is pRootItem Then
            GetItemByKey = CTL_E_ILLEGALFUNCTIONCALL
            Exit Function
        End If
        
    Else
    
        lIndex = Int(vKey)
        
        If lIndex <= 0 Or lIndex > lNumOfItems Then
            GetItemByKey = &H800A000D
            Exit Function
        End If

        Set pOutItem = pFirstIndexedItem

        Do Until lIndex = 1
            Set pOutItem = pOutItem.pNextIndexedItem
            lIndex = lIndex - 1
        Loop
        
    End If
    
End Function

' // Add item that has a key to tree
Private Function AddItemWithKeyToTree( _
                 ByVal pItem As CVBCollectionItem) As Long
    Dim pCurItem            As CVBCollectionItem
    Dim pParentItem         As CVBCollectionItem
    Dim pParentParentItem   As CVBCollectionItem
    Dim pParentLeft         As CVBCollectionItem

    ' // Insert item to tree
    InsertItemToTree pItem
    
    pItem.bFlag = False
    
    Set pCurItem = pItem
    
    Do Until pCurItem Is pFirstItem
    
        Set pParentItem = pCurItem.pParentItem
        
        If pParentItem.bFlag Then Exit Do
        
        Set pParentParentItem = pParentItem.pParentItem
        Set pParentLeft = pParentParentItem.pLeft
        
        If pParentItem Is pParentLeft Then
            
            Set pParentLeft = pParentParentItem.pRight
            
            If Not pParentLeft.bFlag Then
            
                pParentItem.bFlag = True
                pParentLeft.bFlag = True
                pParentItem.pParentItem.bFlag = False
                Set pCurItem = pCurItem.pParentItem.pParentItem
                
            Else
            
                If pCurItem Is pParentItem.pParentItem Then
                
                    Set pCurItem = pCurItem.pParentItem
                    MoveDownRight pParentItem
                    
                Else
                
                    pParentItem.bFlag = True
                    pParentItem.pParentItem.bFlag = False
                    MoveDownLeft pCurItem.pParentItem.pParentItem
                
                End If
                
            End If
            
        Else
            
            If pParentLeft.bFlag Then
            
                If pCurItem Is pParentItem.pLeft Then
                
                    Set pCurItem = pCurItem.pParentItem
                    MoveDownLeft pParentItem
                
                Else
                    
                    pParentItem.bFlag = True
                    pParentItem.pParentItem.bFlag = False
                    MoveDownRight pCurItem.pParentItem.pParentItem
                    
                End If
                
            Else
            
                pParentItem.bFlag = True
                pParentLeft.bFlag = True
                pParentItem.pParentItem.bFlag = False
                Set pCurItem = pCurItem.pParentItem.pParentItem
                
            End If

        End If
    
    Loop
    
    pFirstItem.bFlag = True
    
End Function

' // Move tree item down and left
Private Sub MoveDownLeft( _
            ByVal pItem As CVBCollectionItem)
    Dim pParentLeft   As CVBCollectionItem
    
    Set pParentLeft = pItem.pLeft
    Set pItem.pLeft = pParentLeft.pRight
    
    If Not pParentLeft.pRight Is pRootItem Then
        Set pParentLeft.pRight.pParentItem = pItem
    End If
    
    Set pParentLeft.pParentItem = pItem.pParentItem
    
    If pItem.pParentItem Is pRootItem Then
        Set pFirstItem = pParentLeft
    Else
        If pItem Is pItem.pParentItem.pRight Then
            Set pItem.pParentItem.pRight = pParentLeft
        Else
            Set pItem.pParentItem.pLeft = pParentLeft
        End If
    End If
    
    Set pParentLeft.pRight = pItem
    Set pItem.pParentItem = pParentLeft
    
End Sub

' // Move tree item down and right
Private Sub MoveDownRight( _
            ByVal pItem As CVBCollectionItem)
    Dim pRight  As CVBCollectionItem
    
    Set pRight = pItem.pRight
    Set pItem.pRight = pRight.pLeft
    
    If Not pRight.pLeft Is pRootItem Then
        Set pRight.pLeft.pParentItem = pItem
    End If
    
    Set pRight.pParentItem = pItem.pParentItem
    
    If pItem.pParentItem Is pRootItem Then
        Set pFirstItem = pRight
    Else
        If pItem Is pItem.pParentItem.pLeft Then
            Set pItem.pParentItem.pLeft = pRight
        Else
            Set pItem.pParentItem.pRight = pRight
        End If
    End If
    
    Set pRight.pLeft = pItem
    Set pItem.pParentItem = pRight
    
End Sub

' // Insert item to tree
Private Function InsertItemToTree( _
                 ByVal pItem As CVBCollectionItem) As Long
    Dim pCurItem    As CVBCollectionItem
    Dim pParentItem As CVBCollectionItem
    Dim hr          As Long
    
    Set pParentItem = pRootItem
    Set pCurItem = pFirstItem
    
    ' // Check if item exists
    If Not pParentItem Is pCurItem Then
        
        ' // Find tree node for passed item
        Do
        
            Set pParentItem = pCurItem
            
            hr = StrComp(pItem.bstrKey, pCurItem.bstrKey, vbTextCompare) + 1
            
            Select Case hr
            Case 0
                Set pCurItem = pCurItem.pLeft
            Case 1
                ' // Error. Specified item already exists
                InsertItemToTree = &H800A01C9
                Exit Function
            Case 2
                Set pCurItem = pCurItem.pRight
            End Select
            
        Loop Until pCurItem Is pRootItem
        
    Else:   hr = ObjPtr(pItem)
    End If
    
    ' // Set parent node for passed item
    Set pItem.pParentItem = pParentItem
    
    ' // Check if it is the root node
    If pParentItem Is pRootItem Then
        Set pFirstItem = pItem
    Else
        ' // Place item depending on value
        If hr Then
            Set pParentItem.pRight = pItem
        Else
            Set pParentItem.pLeft = pItem
        End If
    End If
    
End Function
                 
' // Find an item by key from specified item
Private Function FindItemFrom( _
                 ByVal pStartItem As CVBCollectionItem, _
                 ByRef bstrKey As String) As CVBCollectionItem
    Dim pCurItem    As CVBCollectionItem
    
    Set pCurItem = pStartItem
    
    Do Until pCurItem Is pRootItem
    
        Select Case StrComp(bstrKey, pCurItem.bstrKey, vbTextCompare)
        Case -1:    Set pCurItem = pCurItem.pLeft
        Case 0:     Exit Do
        Case 1:     Set pCurItem = pCurItem.pRight
        End Select
        
    Loop
    
    Set FindItemFrom = pCurItem
    
End Function

' // Convert a variant value to string
Private Function BSTRKeyFromVariant( _
                 ByRef vKey As Variant) As String
    Dim vTemp   As Variant
    Dim pTmpObj As Object
    
    If IsObject(vKey) Then
    
        Set pTmpObj = vKey
        
        If Not pTmpObj Is Nothing Then
            vTemp = CStr(vKey)
        Else
            Set vTemp = vKey
        End If
    
    Else
        vTemp = vKey
    End If
     
    If VarType(vTemp) = vbString Then
        BSTRKeyFromVariant = CStr(vTemp)
    End If
    
End Function

Private Function IsMissingParam( _
                 ByRef vParam As Variant) As Boolean
                 
#If COMPILED Then
    
    If IsError(vParam) Then
        If CInt(vParam) = DISP_E_PARAMNOTFOUND Then
            IsMissingParam = True
        End If
    End If
    
#Else

    IsMissingParam = IsMissing(vParam)
    
#End If

End Function

Private Sub Class_Initialize()

    Set pRootItem = New CVBCollectionItem
    Set pFirstItem = pRootItem
    
#If Not COMPILED Then
    
    pRootItem.bstrKey = "root"
    
#End If

End Sub

Class CVBCollectionItem:

' //
' // Native VB collection item
' // Decompiled by The trick
' //

Option Explicit

Public vtItem              As Variant
Public bstrKey             As String
Public pPrevIndexedItem    As CVBCollectionItem
Public pNextIndexedItem    As CVBCollectionItem
Public pvUnknown           As Long
Public pParentItem         As CVBCollectionItem
Public pRight              As CVBCollectionItem
Public pLeft               As CVBCollectionItem
Public bFlag               As Boolean

When you skip Key, Before, After in Add method of the native collection it passes VT_ERROR with DISP_E_PARAMNOTFOUND value indeed.

[dilettante]

Makes sense. Hashes and trees are the two most common ways of implementing an indexed data structure, so it almost had to be one or the other.

A lot of the Collection alternatives you see out there tend to use one type of tree or another. I suppose you could even use both: a relatively fast but short hash (8 to 12 bits?) to select among multiple shallower trees.

[The trick]

Related topic with collection structure,
and (if you are interested) with Dictionary structure.

It would be nice to know what APIs are being used, where the HashMap is, and What HashFunction is used.

This function is used for key comparison:

VarBstrCmp(bstr1, bstr2, 1, &H30001)

[Tanner_H]

Trick, you are amazing, as always. Thank you for sharing your findings.

Thanks also to dseaman earlier in the thread for conclusively demonstrating that the problems seem to occur with malformed surrogate pair markers.

I'm still confused why the error only appears intermittently. You'd think it would occur every time that VarBstrCmp() call attempts to match a malformed key string. I'm also confused by the specific compare flags used - &H1 is "ignore case", which makes sense, but what on earth is &h30000? An undocumented internal flag?

[Elroy]

Yes, I've got to give a shout-out to Trick as well. That's amazing stuff. VB6 collections finally completely revealed.

Regards,
Elroy

[The trick]

but what on earth is &h30000? An undocumented internal flag?

Generally VarBstrCmp calls CompareString function and passes dwFlags as dwCmpFlags. If you see to description 0x00030000 means NORM_IGNOREWIDTH|NORM_IGNOREKANATYPE. I guess it's just an error in the documentation of VarBstrCmp function.

[Elroy]

Say Trick, I was just playing around (and looking at the code of) your Dictionary Viewer. That's super cool stuff.

Now that we have a way to retrieve the keys of dictionary items, we should all probably switch over to the Dictionary, rather than using Collections.

From other threads, it seems to be much faster.

I guess the only thing we lose is the ability to have an index-order in addition to the keys, but that doesn't seem like much of a loss to me.

I haven't used the Microsoft Scripting Runtime that much (scrrun.dll). Can we depend on that being available on all contemporary versions of Windows? (Anyone is welcome to answer this.)

Again, Trick, SUPER-cool stuff.

Elroy

[dilettante]

Yes, the Scripting Runtime library ships in Windows and has for ages.

These classes do different things and which to choose depends on the task.

There are some things about the Dictionary that can be inefficient such as its flawed iteration model. That retrieves a copy of Items() as a temporary array that you iterate over. Heavy use of small Dictionaries (e.g. in object hierarchies) seems to use more memory too. So you have a ton more memory allocation and deallocation going on unless you are doing trivial things.

Collection wrapper classes with efficient iteration are fairly trivial to implement. Code similar to that of the VB.Collection is widely used by Microsoft ActiveX controls anyway. Code similar to that is used in MSHTML and MSXML DOMs. If there was a batter way that made sense they probably would have used it.

There are other things about Dictionary that run in its favor. For example easy access to the Keys() array can make Dictionary easier to persist when necessary.

Both have plusses and minuses, so pick the one that fits. Sometimes neither one fits, so you either get tricky and force it or create some ad hoc alternative data structure.

[The trick]

@Elroy, my clsTrickHashTable has the same features as Dictionary plus additional. You can use it just add the single class.
BTW, there is the many tree-algorithms as well. For example, when i was doing my COFF parser i needed the fast access to item using pointer. This is example:

' //
' // Simple tree by The trick (access to item by Long index)
' //

Option Explicit

' // Tree node. It is used to associate objects and indices
Private Type TreeNode
    ChildNodesIndices()         As Long         ' // Indices of the children nodes
    IsInitialized               As Boolean      ' // Determine if ChildNodes array is initialized
    ItemIndex                   As Long         ' // Item index from 1
End Type

' // Tree item
Private Type TreeItem
    lItemValue                  As Long
    sItemString                 As String
    ' // You can add any other values
End Type

' // Tree object
Private Type Tree
    NumberOfNodes               As Long
    NumberOfItems               As Long
    Children()                  As TreeNode
    Items()                     As TreeItem
End Type

Private Sub Form_Load()
    Dim pTree   As Tree
    Dim index   As Long
    
    InitTree pTree
    
    For index = 0 To 10000
        
        Select Case index
        Case 0:     AddItemToTree pTree, 0, CreateTreeItem(1245232, "Item5")
        Case 1345:  AddItemToTree pTree, 12345434, CreateTreeItem(123, "Item1")
        Case 112:   AddItemToTree pTree, 346235, CreateTreeItem(5, "Item2")
        Case 12:    AddItemToTree pTree, 1212342, CreateTreeItem(8, "Item3")
        Case 5674:  AddItemToTree pTree, 56456, CreateTreeItem(2349, "Item4")
        Case Else
            AddItemToTree pTree, Int(Rnd * 1241254121), CreateTreeItem(Int(Rnd * 12312), "Item" & index)
        End Select
        
    Next

    PrintItem TreeItemByKey(pTree, 56456)
    PrintItem TreeItemByKey(pTree, 1212342)
    PrintItem TreeItemByKey(pTree, 346235)
    PrintItem TreeItemByKey(pTree, 12345434)
    PrintItem TreeItemByKey(pTree, 0)
    
End Sub

' // Print item
Private Function PrintItem( _
                 ByRef pItem As TreeItem) As Boolean
    Debug.Print pItem.lItemValue, pItem.sItemString
End Function

' // Create item
Private Function CreateTreeItem( _
                 ByVal lValue As Long, _
                 ByRef sString As String) As TreeItem
    CreateTreeItem.lItemValue = lValue
    CreateTreeItem.sItemString = sString
End Function

' // Initialize tree
Private Sub InitTree( _
            ByRef treObject As Tree)
                
    treObject.NumberOfItems = 0
    treObject.NumberOfNodes = 1
    
    ReDim treObject.Children(0)
    ReDim treObject.Items(100)
    
End Sub

' // Get element by key
Private Function TreeItemByKey( _
            ByRef treObject As Tree, _
            ByVal lngKeyValue As Long) As TreeItem
    Dim pathIndex   As Long
    Dim pathItem    As Long
    Dim curItem     As Long
    Dim nextItem    As Long
    Dim nullPath    As Boolean
    
    nullPath = True
    curItem = 0
    
    With treObject
        
        For pathIndex = 0 To 7
            
            ' // Get path element
            pathItem = ((lngKeyValue And &HF0000000) \ &H10000000) And &HF
            
            ' // Remove previous zeros
            If nullPath And pathItem Then
                nullPath = False
            End If
            
            If Not nullPath Then

                ' // Check if array of child nodes is initialized
                If Not .Children(curItem).IsInitialized Then
                    
                    Err.Raise 389
                    Exit Function
                    
                End If

                nextItem = .Children(curItem).ChildNodesIndices(pathItem) - 1
                
                ' // Node is not allocated
                If nextItem = -1 Then

                    Err.Raise 389
                    Exit Function
                    
                Else
                    
                    nextItem = nextItem + 1
                    
                End If
                
                curItem = nextItem
                
            End If
            
            ' // Next path element
            lngKeyValue = lngKeyValue And &HFFFFFFF
            
            If lngKeyValue And &H8000000 Then
                lngKeyValue = (lngKeyValue And &H7FFFFFF) * &H10 Or &H80000000
            Else
                lngKeyValue = lngKeyValue * &H10
            End If

        Next
        
        ' // Check if element exist
        If .Children(curItem).ItemIndex = 0 Then
            
            Err.Raise 389
            Exit Function
            
        End If
        
        TreeItemByKey = .Items(.Children(curItem).ItemIndex - 1)
        
    End With
  
End Function

' // Add value to tree
Private Sub AddItemToTree( _
            ByRef treObject As Tree, _
            ByVal lngKeyValue As Long, _
            ByRef pValue As TreeItem)
    Dim pathIndex   As Long
    Dim pathItem    As Long
    Dim curItem     As Long
    Dim nextItem    As Long
    Dim nullPath    As Boolean
    
    nullPath = True
    curItem = 0
    
    With treObject
        
        For pathIndex = 0 To 7
            
            ' // Get path element
            pathItem = ((lngKeyValue And &HF0000000) \ &H10000000) And &HF
            
            ' // Remove previous zeros
            If nullPath And pathItem Then
                nullPath = False
            End If
            
            If Not nullPath Then

                ' // Check if array of child nodes is initialized
                If Not .Children(curItem).IsInitialized Then
                    
                    ReDim .Children(curItem).ChildNodesIndices(&HF)
                    .Children(curItem).IsInitialized = True
                    
                End If

                nextItem = .Children(curItem).ChildNodesIndices(pathItem) - 1
                
                ' // Node is not allocated
                If nextItem = -1 Then
                    
                    If .NumberOfNodes > UBound(.Children) Then
                    
                        ReDim Preserve .Children(.NumberOfNodes + 100)
                        
                    End If
                    
                    .Children(curItem).ChildNodesIndices(pathItem) = .NumberOfNodes
                    nextItem = .NumberOfNodes
                    .NumberOfNodes = .NumberOfNodes + 1
                
                Else
                    
                    nextItem = nextItem + 1
                    
                End If
                
                curItem = nextItem
                
            End If
            
            ' // Next path element
            lngKeyValue = lngKeyValue And &HFFFFFFF
            
            If lngKeyValue And &H8000000 Then
                lngKeyValue = (lngKeyValue And &H7FFFFFF) * &H10 Or &H80000000
            Else
                lngKeyValue = lngKeyValue * &H10
            End If

        Next
        
        ' // Check if element exist
        If .Children(curItem).ItemIndex Then
            
            Err.Raise 457
            Exit Sub
            
        End If
        
        If .NumberOfItems > UBound(.Items) Then
        
            ReDim Preserve .Items(.NumberOfItems + 100)
            
        End If
        
        .Items(.NumberOfItems) = pValue
        .NumberOfItems = .NumberOfItems + 1
        
        .Children(curItem).ItemIndex = .NumberOfItems
        
    End With
    
End Sub

This code creates the path using nibbles of the key value as path components. You can change it to access to item by string key as well.

[Elroy]

Cool stuff, Trick. Thank you!

I grabbed the clsTrickHashTable and the little demo from the link, and will take a look at it.

It's truly amazing to see some of the stuff you've dug out of VB6. I think you're the guy who should write a 100% compatible VB6 Open Source compiler.

Then, all we'd need is for someone to write an Open Source p-code interpreter (with break-points) and we'd be in business. Heck, I could learn to use Eclipse or Notepad++ to write my source code.

Well anyway, all just pipe-dreams I suspect.

You take care,
Elroy

[Elroy]

I guess I couldn't help myself. Based heavily on the information The Trick gave us, here's how to search a VBA.Collection sort-of-the-hard way. Logically, it does it the same way the Collection itself does it. However, it's moving memory around quite a bit more, just because that's required by VB6 to not corrupt memory.

So.... here's the code:

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
'

Private Type VbCollectionHeader
    pInterface1         As Long   '  Ox00 
    pInterface2         As Long   '  Ox04 
    pInterface3         As Long   '  Ox08 
    lRefCounter         As Long   '  Ox0C 
    Count               As Long   '  Ox10 
    pvUnk1              As Long   '  Ox14 
    pFirstIndexedItem   As Long   '  Ox18 
    pLastIndexedItem    As Long   '  Ox1C 
    pvUnk4              As Long   '  Ox20 
    pRootTreeItem       As Long   '  Ox24 ' This is actually a pointer to what's typically thought of as the root. 
    pEndTreePtr         As Long   '  Ox28 ' This is effectively an EOF marker for the tree (bottom of it).  It points to the end of the VbCollectionHeader (HdrPtr + &h30) 
    pvUnk5              As Long   '  Ox2C 
End Type                          '  Ox30 ' Length. 

Private Type VbCollectionItem
    Data                As Variant  '  Ox00 
    Key                 As String   '  Ox10 
    pPrevIndexedItem    As Long     '  Ox14 
    pNextIndexedItem    As Long     '  Ox18 
    pvUnknown           As Long     '  Ox1C 
    pParentItem         As Long     '  Ox20 
    pRightBranch        As Long     '  Ox24 
    pLeftBranch         As Long     '  Ox28 
    bFlag               As Boolean  '  Ox2C 
End Type                            '  Ox30 ' Length. (boolean padded to 4) 

Private Sub Form_Load()
    Dim c As New Collection
    Dim uHead As VbCollectionHeader
    Dim uItem As VbCollectionItem
    Dim ptr As Long
    Dim b As Boolean
    Dim vData As Variant
    Dim i As Long
    Dim s As String
    Dim sKeyToSearchFor As String


    For i = 1 To 8
        s = Right$("000" & CStr(Int(Rnd * 1000)), 4)
        c.Add s & "Data", s & "Key"
        '
        If i = 6 Then sKeyToSearchFor = s & "Key"
    Next i


    ' First, let's just list the items in the debug window. 
    ptr = uHead.pFirstIndexedItem
    Do While ptr
        uItem = GetCollectionItem(ptr)
        Debug.Print uItem.Key, uItem.Data, "My ptr: "; Hex$(ptr)  ', "Next ptr: "; uItem.pNextIndexedItem 
        ptr = uItem.pNextIndexedItem
    Loop


    ' Now, we're going to search for a key in the collection, but doing it ourselves with the B-Tree. 
    MsgBox "We're going to look for: " & sKeyToSearchFor
    b = GetItemByKey(c, sKeyToSearchFor, vData)
    If b Then
        MsgBox "Data is: " & vData
    Else
        MsgBox "not found"
    End If


    Unload Me
End Sub

Private Function GetCollectionHeader(c As Collection) As VbCollectionHeader
    CopyMemory GetCollectionHeader, ByVal ObjPtr(c), LenB(GetCollectionHeader)
End Function

Private Function GetCollectionItem(ptr As Long) As VbCollectionItem
    ' This will work for either Next or Prev, because it just uses pointer. 
    ' It will also work with the BTree pointers. 
    ' Be careful.  This does NOT check the validity of the pointer. 
    ' Index pointer will be ZERO when end has been reached. 
    ' Tree pointers will be VbCollectionHeader.pEndTreePtr when end has been reached. 
    '
    ' This is a bit tricky because we don't want to alias the Data or Key variables from the actual Collection data. 
    ' VB6 doesn't particularly like aliasing non-object variable types, particularly when one of the aliases may go out of scope. 
    '
    Dim s As String
    Dim t(0 To 4) As Long ' 20 bytes. 
    Dim i As Long
    Dim v As Variant
    '
    CopyMemory t(0), ByVal VarPtr(GetCollectionItem.Data), &H14                     ' Save original variant and string pointer stuff. 
    CopyMemory ByVal VarPtr(GetCollectionItem), ByVal ptr, LenB(GetCollectionItem)  ' Copy the structure. 
    CopyMemory GetCollectionItem.Data, t(0), &H14                                   ' Put back original variant and string pointer.  We must handle this differently. 
    '
    ' Now, get the key, borrowing another string for a moment. 
    i = StrPtr(s)                                           ' Save string pointer because we're going to borrow the string. 
    CopyMemory ByVal VarPtr(s), ByVal ptr + &H10, &H4       ' Key string of collection item. 
    GetCollectionItem.Key = s                               ' Move key into structure. 
    CopyMemory ByVal VarPtr(s), i, &H4                      ' Put string pointer back to keep memory straight. 
    '
    ' Now, get the data, borrowing another variant for a moment. 
    CopyMemory t(0), ByVal VarPtr(v), &H10                  ' Save variant data (16 bytes, including any pointers).  We're going to borrow it. 
    CopyMemory ByVal VarPtr(v), ByVal ptr, &H10             ' Copy item's variant into our temp variant. 
    If IsObject(v) Then
        Set GetCollectionItem.Data = v                      ' Put temp variant into structure. 
    Else
        GetCollectionItem.Data = v                          ' Put temp variant into structure. 
    End If
    CopyMemory ByVal VarPtr(v), t(0), &H10                  ' Put original variant data back to keep memory straight. 
End Function

Private Function GetItemByKey(c As Collection, Key As String, vData As Variant) As Boolean
    ' Returns TRUE if found. 
    ' Returns FALSE if not found. 
    ' Returns FALSE if Len(Key) = 0. 
    Dim pItem As Long
    Dim Header As VbCollectionHeader
    Dim Item As VbCollectionItem
    '
    If Len(Key) = 0 Then Exit Function
    '
    Header = GetCollectionHeader(c)
    pItem = Header.pRootTreeItem
    '
    Do Until pItem = Header.pEndTreePtr
        Item = GetCollectionItem(pItem)
        Select Case StrComp(Item.Key, Key, vbTextCompare) ' <---- Donar's identified issue in post #1.
        Case 1:     pItem = Item.pLeftBranch
        Case 0:     Exit Do
        Case -1:    pItem = Item.pRightBranch
        End Select
    Loop
    '
    If pItem <> Header.pEndTreePtr Then
        If IsObject(Item.Data) Then
            Set vData = Item.Data
        Else
            vData = Item.Data
        End If
        GetItemByKey = True ' Found it. 
    End If
End Function

To do it yourself, just throw the above code into a new project's Form1.

This was for rather purely academic pursuits, and my own edification. I really see little, if any, reason someone would use this, as I'm sure just using "vData = Collection.Item(Key)" is much faster. However, it was an interesting pursuit, and truly does unravel the mysteries of the VBA.Collection object.

While doing this, I did also learn that the Collection items are not always in contiguous memory. They often are. However, if you take the above code and bump up the number of random items added (while hopefully not creating a dupe, or putting in a bit of OnErrorResumeNext), you can see this in the immediate window by looking at the pointers. For me, they often skip around in memory. Each item does seem to take 88 (&h58) bytes, which is larger than the VbCollectionItem's structure. And I have no idea why this is.

I thought of writing an AddItemWithKeyToTree procedure (following The Trick's lead), but this would involve allocating memory, and I wasn't up for those details. And "Collection.Add..." works just fine.

To return all the way to the OP #1 post, I'm now convinced that his problems are all to do with idiosyncrasies in "StrComp(str1, str2, vbTextCompare)", and could be discussed entirely outside of any mention of the VBA.Collection.

Best Regards To Everyone,
Elroy

EDIT1: I also snooped around quite a bit in the unknown sections of the VbCollectionHeader. I was hoping to find some StrComp-Compare flag (like the value of vbTextCompare), but I couldn't find anything. It seemed a logical place for it, if it existed, but no cigar (at least from me). Would have been nice though. If I truly want speed and binary keys, I guess I'll have to bite-the-bullet and use the Scripting.Dictionary object.

[The trick]

Elroy,

Option Explicit

Private Declare Function VariantCopyInd Lib "oleaut32.dll" ( _
                         ByRef pvarDest As Any, _
                         ByRef pvargSrc As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef Dst As Any) As Long
Private Declare Function VarBstrCmp Lib "oleaut32.dll" ( _
                         ByRef bstrLeft As Any, _
                         ByRef bstrRight As Any, _
                         ByVal lcid As Long, _
                         ByVal dwFlags As Long) As Long

Private Sub Form_Load()
    Dim c As New Collection
    
    c.Add Me, "key 1"
    c.Add 12345, "the trick"
    c.Add "String var", "blabla"
    c.Add 1.43534, "float"
    
    Debug.Print ColItem("key 1", c).Name
    Debug.Print ColItem("the trick", c)
    Debug.Print ColItem("blabla", c)
    Debug.Print ColItem("float", c)
    
End Sub

Private Function ColItem(Key As String, Col As Collection) As Variant
    Dim lpStr As Long, Ptr1 As Long, Ptr2 As Long, sKey As String
 
    GetMem4 ByVal ObjPtr(Col) + 36, Ptr1
    GetMem4 ByVal ObjPtr(Col) + 40, Ptr2
 
    Do Until Ptr1 = Ptr2
        GetMem4 ByVal Ptr1 + 16, lpStr
        Select Case VarBstrCmp(ByVal StrPtr(Key), ByVal lpStr, 1, &H30001)
        Case 0: GetMem4 ByVal Ptr1 + 40, Ptr1
        Case 1
            VariantCopyInd ColItem, ByVal Ptr1
            Exit Function
        Case Else: GetMem4 ByVal Ptr1 + 36, Ptr1
        End Select
    Loop
    
    MsgBox "Element not found"
    
End Function

[Elroy]

@Trick, very nice!

It's also nice to learn about the VariantCopyInd and VarBstrCmp API functions. The VariantCopyInd is particularly nice. It saves all the gyrations I had to go through to make sure I didn't corrupt memory.


Now I'm wondering if there's an equivalent StringCopyInd function. I searched for that, but didn't find anything. The combination of those two would pretty much solve all the problems of copying a Variant or String into a VB6 variable, when all you have is a pointer.


Best Wishes,
Elroy

[The trick]

Now I'm wondering if there's an equivalent StringCopyInd function.

SysAllocString

[DEXWERX]

@Elroy A lot of API examples use SysReallocString for that.
@The Trick. I see VariantCopyInd used a lot internally, can we assume VariantCopyInd is equivelent to

If IsObject(Value) Then Set Prop = Value Else Prop = Value

[DEXWERX]

@Tanner_H

From WinNls.h

//
//  String Flags.
//
#define NORM_IGNORECASE           0x00000001  // ignore case
#define NORM_IGNORENONSPACE       0x00000002  // ignore nonspacing chars
#define NORM_IGNORESYMBOLS        0x00000004  // ignore symbols

#define LINGUISTIC_IGNORECASE     0x00000010  // linguistically appropriate 'ignore case'
#define LINGUISTIC_IGNOREDIACRITIC 0x00000020  // linguistically appropriate 'ignore nonspace'

#define NORM_IGNOREKANATYPE       0x00010000  // ignore kanatype
#define NORM_IGNOREWIDTH          0x00020000  // ignore width
#define NORM_LINGUISTIC_CASING    0x08000000  // use linguistic rules for casing

[Dragokas]

I haven't used the Microsoft Scripting Runtime that much (scrrun.dll). Can we depend on that being available on all contemporary versions of Windows? (Anyone is welcome to answer this.)

I refused using scrrun.dll in projects that require reliable operation because by our statistics 1 of 100 machines surely have problems like damaged reg. info, so, I had to use something like this approach, or class-analogue, like The Trick's one.

[Elroy]

Thanks for the info, Dragokas.

I was thinking I'd probably stick to the Collection object unless something came up where I just really needed the speed.

Elroy

[The trick]

@The Trick. I see VarCopyInd used a lot internally, can we assume VarCopyInd is equivelent to

If IsObject(Value) Then Set Prop = Value Else Prop = Value

I don't know that function. There are __vbaVarCopy, __vbaVargVarCopy function from MSVBVM60. VariantCopy(Ind) calls AddRef for object variables.

If pvargSrc is a VT_DISPATCH or VT_UNKNOWN, AddRef is called to increment the object's reference count.