VB6 Problem with array memory copy operation in simple stack (FIFO) implementation

You have incorrectly assumed that the strings are actually being stored in your string array.

THEY ARE NOT...

POINTERS to the strings are what really get stored in the string array...so each entry in the string array is really a LONG value (4 bytes long).  You would need to modify the CopyMemory() calls to change the length to copy.  This should be 4 * (the number of elements to copy).

I fiddled with it a bit but couldn't the arrays to copy the last element properly for some reason.

In the meantime...how about this appproach as an alternative?
(really don't know what your end goal is so this might not be appropriate)

' ------------------------------
'  Form1
' ------------------------------
Private Sub Command1_Click()
    Dim stack As New ConstSizeStringStack
    stack.Initialize 5
    
    Dim i As Integer
    For i = 0 To 8
        Dim itm As String * 10
        itm = "STR" & CStr(i)
        Dim rtn As String
        rtn = stack.Pop(itm)
        Debug.Print "Returned: " & rtn
    Next i
    
    ' show what is currently in the stack
    Dim value As Variant
    For Each value In stack
        Debug.Print value
    Next
End Sub
 
' ------------------------------
'  Class ConstSizeStringStack
' ------------------------------
Option Explicit
 
Private size_ As Integer
Private stack As Collection
 
Private Sub Class_Initialize()
    size_ = 1
    Set stack = New Collection
End Sub
 
Public Sub Initialize(size As Integer)
    size_ = size
    Set stack = New Collection
End Sub
 
Public Function Pop(push As String) As String
    If stack.Count = size_ Then
        ' a Collection is ONE based
        Pop = stack.Item(1)
        stack.Remove 1
    End If
    stack.Add push
End Function
 
Public Property Get NewEnum() As IUnknown
    ' Click on Tools --> Procedure Attributes
    ' Select "NewEnum" in the DropDown
    ' Now Click on the "Advanced" Button
    ' Change the "Procedure ID" to "-4"
   Set NewEnum = stack.[_NewEnum]
End Property

Select allOpen in new window

Idle_Mind,

Thanks for your comment.
I tried what you suggested, but the result is the same. The first time I loop over second Part of Pop method with CopyMemory call it works fine, (as seen in debugger), but the next time I call the Pop method, I get all kind of garbage inside stack() array.
I need very efficient implementation, so your Collection-based does not work for me.

Thank you

Hello Idle_Mind,

Since you seem idle enough, this is what I am trying to accomplish...

I am trying to implement a simple LRU cache, based on Scripting.Dictionary object. Therefore I need an efficient way to find oldest items in the Dictionary. I tried looping over items in Dictionary, but that is vastly inefficient. (I am holding my cached object inside custom CacheItem, that is time-stamped on creation&).
Other way to track order by which items were added to cache is to place string key into the FIFO, as I explained in the post.
Let me test your solution, and if I find that your Collection based solution is performant enough, no dogma on my part and I will give you the points.

' Class Cache
 
'Simple LRU cache based on Scripting.Dictionary
 
Option Explicit
 
Private size_ As Integer
Private dictionary As Scripting.dictionary
Private keyStack As New ConstSizeStringStack
 
Private hitCount As Long
Private missCount As Long
 
Public Function GetFromCache(key As String) As Object
    If dictionary.Exists(key) Then
        Set GetFromCache = dictionary.Item(key).ItemInCache
    Else
        Set GetFromCache = Nothing
    End If
End Function
 
'OLD , too slow
Public Sub PutToCache2(key As String, object As Object)
    Dim cItem As New CacheItem
    If dictionary.Exists(key) Then
        dictionary.Remove (key)
    End If
    cItem.ItemInCache = object
    If dictionary.Count >= size_ Then
        dictionary.Remove (FindOldestItemKey())
    End If
    dictionary.Add key, cItem
End Sub
 
Public Sub PutToCache(key As String, object As Object)
    If keyStack.Pop(key) = "" Then
        dictionary.Add key, object
    Else
        dictionary.Remove (keyStack.Pop(key))
        dictionary.Add key, object
    End If
End Sub
 
 
Public Function InCache(key As String) As Boolean
    InCache = dictionary.Exists(key)
End Function
 
Private Sub Class_Initialize()
    'set default size
    size_ = 1001
    keyStack.Initialize (1001)
    Set dictionary = CreateObject("Scripting.Dictionary")
    dictionary.CompareMode = vbTextCompare
End Sub
 
Public Property Get size() As Integer
    size = size_
End Property
 
 
'VERY slow
Public Function FindOldestItemKey() As String
    Dim oldestKey As String
    Dim oldest As CacheItem
    Dim key As String
    oldestKey = ""
    Dim i As Integer
    
    For i = 0 To UBound(dictionary.Keys)
        key = dictionary.Keys(i)
        If oldestKey = "" Then
            oldestKey = key
            Set oldest = dictionary.Item(key)
        Else
            If CDbl(dictionary.Item(key).InCacheDate) > CDbl(oldest.InCacheDate) Then
                oldestKey = key
                Set oldest = dictionary.Item(key)
            End If
        End If
    Next i
    FindOldestItemKey = oldestKey
End Function
 
 
Public Sub Clear()
    dictionary.RemoveAll
End Sub
 
 
Private Sub Miss()
    On Error Resume Next
    missCount = missCount + 1
End Sub
 
Private Sub Hit()
    On Error Resume Next
    hitCount = hitCount + 1
End Sub
 
Public Sub Initialize(size As Integer)
    On Error Resume Next
    size_ = size
    keyStack.Initialize (size)
End Sub

Select allOpen in new window

Idle_Mind:
I found your solution satisfactory for my needs. Thank you.