How much do you trust the Collection class?

[Elroy]

Alright, I'm just going to post my particular progress in figuring this out.

Here's how I modified the code, just to consolidate it and also add my own debug functions:

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
'

Private Sub Form_Load()
    Dim i As Long, j As Long
    Dim sKey As String
    Dim asKeys() As String
    Dim oColl As Collection



    Randomize 14


    ReDim asKeys(0 To 4837) As String
    Set oColl = New Collection

    'Generating ITEMS keys. 
    For i = 0 To 4837
        For j = 1 To 6
            asKeys(i) = asKeys(i) & ChrW(Int(Rnd() * 65535))
        Next j
    Next i

    'Adding ITEMS key into collection. 
    For i = 0 To 4836 ' <----------------------- it will crash on 4837. 
        oColl.Add i, asKeys(i)
    Next i

    '   NOW DELETE KEYS UNTIL THE ERROR GOES AWAY <--------- FINDING THE DUPLICATE!!!!!!!!!!! 
    On Error Resume Next
    Do
        oColl.Add 4837, asKeys(4837)
        If Err = 0 Then
            Debug.Print HexKey(asKeys(4837))
            Debug.Print HexKey(sKey)
            Debug.Print "The StrComp: " & StrComp(asKeys(4837), sKey, vbTextCompare)
            Stop
        End If
        sKey = CollectionItemKey(1, oColl)
        oColl.Remove 1
        Err.Clear
    Loop

    MsgBox "Done"
End Sub

Function HexKey(sKey As String) As String
    Dim j As Long
    For j = 1 To 6
        HexKey = HexKey & Right("000" & Hex$(AscW(Mid$(sKey, j, 1))), 4) & " "
    Next j
End Function


Public Function CollectionItemKey(idx As Long, Coll As Collection) As String
    ' Original by LaVolpe. 
    Dim i     As Long
    Dim ptr   As Long
    Dim sKey  As String
    '
    If Coll Is Nothing Then
        Err.Raise 91
        Exit Function
    End If
    '
    If idx < 1 Or idx > Coll.Count Then
        Err.Raise 9
        Exit Function
    End If
    '
    If idx <= Coll.Count / 2 Then                       ' Go from beginning or end. 
        CopyMemory ptr, ByVal ObjPtr(Coll) + &H18, 4    ' VbCollection.First 
        For i = 2 To idx
            CopyMemory ptr, ByVal ptr + &H18, 4         ' VbCollectionItem.Next 
        Next i
    Else                                                ' End is quicker. 
        CopyMemory ptr, ByVal ObjPtr(Coll) + &H1C, 4    ' VbCollection.Last 
        For i = Coll.Count - 1 To idx Step -1
            CopyMemory ptr, ByVal ptr + &H14, 4         ' VbCollectionItem.Prev 
        Next i
    End If
    '
    i = StrPtr(sKey)
    CopyMemory ByVal VarPtr(sKey), ByVal ptr + 16, 4
    CollectionItemKey = sKey
    CopyMemory ByVal VarPtr(sKey), i, 4
End Function

Public Property Let UniClipboard(sUniText As String)
    ' Puts a VB string in the clipboard without converting it to ASCII. 
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    '
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Property

The code does stop and reports the following in my Immediate window:

1056 1060 0BFD 15F1 31B1 A19E 
D9A2 2770 4DE5 1AF0 A28B 2F86 
The StrComp: 0

Just FYI, a StrComp=0 indicates it sees the two strings as equal.

The first thing I noticed was that D9A2 is outside of the valid Unicode range, and it's also the first character of the key. Therefore, while still in "Stop" mode, I tried this in the Immediate window:

? strcomp(asKeys(4837), left$(sKey, 1), vbTextCompare)

Voila, it still reported equality between the strings. Notice that this was the value I deleted (and not the one I was trying to add).

Now, I did more checking and found that the D9A2 2770 4DE5 1AF0 A28B 2F86 key was created in the key creation loop at i=3730.

It's still a puzzle to me why adding this specific key didn't cause a problem, and that it waited until adding where i=4837 caused the problem.

I must admit that it's still quite curious. The first thing I'm going to do is restrict the Unicode values to values between &h0020 and &hD7FF (the valid Unicode range).