Option Explicit
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemoryPut Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, Source As Any, ByVal Length As Long)
Private Declare Sub CopyMemoryRead Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Type Node
Data As Long
Next As Long
End Type
Private Sub Form_Load()
' Place this code in any Sub or Function
Dim lngStart As Long, lngFinish As Long, lngCounter As Long, lngItems As Long, lngData As Long
Dim lngCnt1 As Long, lngCnt2 As Long, lngCnt3 As Long, lngCnt4 As Long, lngCnt5 As Long
Dim cNode As Node, i As Long, pCurrent As Long, hHeap As Long, pStart As Long
lngItems = 30000
lngStart = GetTickCount() ' Record the start time
' Collection (fast to create, but slow to retrieve/delete)
Dim MyCollection As New Collection
For lngCounter = 1 To lngItems
MyCollection.Add lngCounter
Next
lngCnt1 = GetTickCount()
For lngCounter = lngItems To 1 Step -1
lngData = MyCollection.Item(lngCounter)
MyCollection.Remove (lngCounter)
Next
lngCnt2 = GetTickCount()
' Memory API linked-list
hHeap = GetProcessHeap()
pStart = HeapAlloc(hHeap, 0, 8)
pCurrent = pStart
For lngCounter = 1 To lngItems
cNode.Data = lngCounter
cNode.Next = HeapAlloc(hHeap, 8, 8)
CopyMemoryPut pCurrent, cNode, 8
pCurrent = cNode.Next
Next
lngCnt3 = GetTickCount()
pCurrent = pStart
For lngCounter = 1 To lngItems
CopyMemoryRead cNode, pCurrent, 8
HeapFree GetProcessHeap(), 0, pCurrent
pCurrent = cNode.Next
lngData = cNode.Data
Next
lngCnt4 = GetTickCount()
' Array
ReDim MyArray(lngItems) As Long
For lngCounter = 1 To lngItems
MyArray(lngCounter) = lngCounter
Next
lngCnt5 = GetTickCount()
For lngCounter = 1 To lngItems
lngData = MyArray(lngCounter)
Next
Erase MyArray
lngFinish = GetTickCount() ' Record the finish "time"
' Display the difference
' 30000 item Collection: Create = 50 Create, Touch & Remove = 24144
' 30000 item API l-list: Create = 40 Create, Touch & Remove = 60
' 30000 item Array: Create = 10 Create, Touch & Remove = 10
Debug.Print lngItems & " item Collection: Create = " & lngCnt1 - lngStart & _
" Create, Touch & Remove = " & lngCnt2 - lngStart
Debug.Print lngItems & " item API l-list: Create = " & lngCnt3 - lngCnt2 & _
" Create, Touch & Remove = " & lngCnt4 - lngCnt2
Debug.Print lngItems & " item Array: Create = " & lngCnt5 - lngCnt4 & _
" Create, Touch & Remove = " & lngFinish - lngCnt4
End Sub