The Collection is 3-4 and more times faster then the Dictionary when adding items, and 2 times slower when retrieving.
Tested compiled and runned from the IDE in the Windows XP 64 and in the Windows 7 64 with different versions of msvbvm60.dll and vba6.dll.
So it is must be stable.
or with TLB (see my others posts to download it):
Tested compiled and runned from the IDE in the Windows XP 64 and in the Windows 7 64 with different versions of msvbvm60.dll and vba6.dll.
So it is must be stable.
VB Code:
Private Declare Sub GetMem1 Lib "msvbvm60" (ByVal Address As Long, n As Byte) Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Address As Long, ByVal n As Byte) Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Address As Long, n As Integer) Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Address As Long, n As Long) Private Const PAGE_EXECUTE_READWRITE = &H40& Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Sub Main() Dim c As New Collection PatchCollection c.Add 1, "Test" c.Add 2, "test" MsgBox c("Test") MsgBox c("test") End Sub Private Property Get MemByte(ByVal Address As Long) As Byte GetMem1 Address, MemByte End Property Private Property Let MemByte(ByVal Address As Long, ByVal n As Byte) PutMem1 Address, n End Property Private Function MemInt(ByVal Address As Long) As Integer GetMem2 Address, MemInt End Function Private Function Mem(ByVal Address As Long) As Long GetMem4 Address, Mem End Function Public Sub PatchCollection(Optional ByVal IsCaseSensitive As Boolean = True) Dim Addr As Long If InIDE = False Then addr = GetModuleHandle("MSVBVM60.DLL") Else Addr = GetModuleHandle("VBA6.DLL") End If Addr = SearchPatchBytes(Addr) PatchByte(Addr) = IsCaseSensitive + 1 Addr = SearchPatchBytes(Addr) PatchByte(Addr) = IsCaseSensitive + 1 End Sub Private Function InIDE() As Boolean On Error Resume Next Debug.Print 0 / 0 InIDE = Err.Number <> 0 End Function 'Patch calls to the oleaut32_VarBstrCmp function Private Function SearchPatchBytes(ByVal Addr As Long) Addr = Addr + 7 Do Do While MemByte(Addr) <> &H68 'push Addr = Addr + 1 Wend Addr = Addr + 1 Loop While (Mem(Addr) And &HFFFFFFFE) <> &H30000 'NORM_IGNORECASE = 0/1 Addr = Addr + 4 Loop While MemInt(Addr) <> &H16A 'push 1 (Locale identifier) SearchPatchBytes = Addr - 4 End Function Private Property Let PatchByte(ByVal Addr As Long, ByVal b As Byte) Dim OldProtect As Long VirtualProtect Addr, 1, PAGE_EXECUTE_READWRITE, OldProtect MemByte(Addr) = b End Property
or with TLB (see my others posts to download it):
VB Code:
Sub Main() Dim c As New Collection PatchCollection c.Add 1, "Test" c.Add 2, "test" MsgBox c("Test") MsgBox c("test") End Sub Public Sub PatchCollection(Optional ByVal IsCaseSensitive As Boolean = True) Dim addr As Long If InIDE = False Then addr = GetModuleHandle("MSVBVM60.DLL") Else addr = GetModuleHandle("VBA6.DLL") End If addr = SearchPatchBytes(addr) PatchByte(addr) = IsCaseSensitive + 1 addr = SearchPatchBytes(addr) PatchByte(addr) = IsCaseSensitive + 1 End Sub Private Function InIDE() As Boolean On Error Resume Next Debug.Print 0 / 0 InIDE = Err.Number <> 0 End Function 'Patch calls to the oleaut32_VarBstrCmp function Private Function SearchPatchBytes(ByVal addr As Long) addr = addr + 7 Do Do While MemByte(addr) <> &H68 'push addr = addr + 1 Wend addr = addr + 1 Loop While (Mem(addr) And &HFFFFFFFE) <> &H30000 'NORM_IGNORECASE = 0/1 addr = addr + 4 Loop While MemInt(addr) <> &H16A 'push 1 (Locale identifier) SearchPatchBytes = addr - 4 End Function Private Property Let PatchByte(ByVal addr As Long, ByVal b As Byte) Dim OldProtect As Long VirtualProtect addr, 1, PAGE_EXECUTE_READWRITE, OldProtect MemByte(addr) = b End Property