vbAccelerator - Contents of code file: cStackIMalloc.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cStackIMalloc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' cStackIMalloc
' SP McMahon from vbAccelerator http://vbAccelerator.com
' requires mMalloc.bas
' and ISHF_Ex.tlb (design time only), available from
' http://www.mvps.org/btmtz

Implements IStack

Private m_lPtrTop As Long
Private m_iCount As Long

Private Type tStringStackItem
   lNextPtr As Long
   lSize As Long
End Type


Private Sub Class_Terminate()
Dim lNextPtr As Long
   Do While m_iCount
      CopyMemory lNextPtr, ByVal m_lPtrTop, 4
      isMalloc.Free ByVal m_lPtrTop
      m_lPtrTop = lNextPtr
      m_iCount = m_iCount - 1
   Loop
End Sub

Private Property Get IStack_Count() As Long
   IStack_Count = m_iCount
End Property

Private Function IStack_Pop() As String
Dim tSSI As tStringStackItem
Dim sRet As String

   If m_iCount Then
      ' Get the next item along:
      CopyMemory tSSI, ByVal m_lPtrTop, 8
      If tSSI.lSize > 0 Then
         ' Return the string data (if any):
         sRet = String$(tSSI.lSize \ 2, 0)
         CopyMemory ByVal StrPtr(sRet), ByVal m_lPtrTop + 8, tSSI.lSize
         IStack_Pop = sRet
         'ReDim b(0 To tSSI.lSize - 1) As Byte
         'CopyMemory b(0), ByVal m_lPtrTop + 8, tSSI.lSize
         'IStack_Pop = b
      End If
      ' free the data for the top item
      isMalloc.Free ByVal m_lPtrTop
      ' Change the head pointer to point to
      ' the next in the chain (or 0 if no
      ' more left):
      m_lPtrTop = tSSI.lNextPtr
      m_iCount = m_iCount - 1
   End If
   
End Function

Private Sub IStack_Push(sArg As String)
Dim b() As Byte
Dim lPtrTemp As Long
Dim tSSI As tStringStackItem

   ' Store current head pointer:
   tSSI.lNextPtr = m_lPtrTop
   ' Get byte representation of string:
   'b = sArg
   'tSSI.lSize = UBound(b) + 1
   tSSI.lSize = LenB(sArg)
   ' Allocate size for next item pointer, size
   ' and string data, and put this at the head
   ' of the chain:
   m_lPtrTop = isMalloc.Alloc(tSSI.lSize + 8)
   If Not m_lPtrTop = 0 Then
      ' Success. Store next pointer,size & data:
      CopyMemory ByVal m_lPtrTop, tSSI, 8
      'CopyMemory ByVal m_lPtrTop + 8, b(0), tSSI.lSize
      CopyMemory ByVal m_lPtrTop + 8, ByVal StrPtr(sArg), tSSI.lSize
   Else
      ' Failed.  NB: Must Keep previous head pointer!!!
      m_lPtrTop = tSSI.lNextPtr
      Err.Raise 7
   End If
   m_iCount = m_iCount + 1

End Sub