Describe what this does and give me an thorough overview and user guide for it.


https://github.com/cristianbuse/VBA-MemoryTools?tab=readme-ov-file
Also read the link and whats provided there please.


Module Mem

    Attribute VB_Name = "Mem"
    '''=============================================================================
    ''' VBA MemoryTools
    ''' -----------------------------------------------
    ''' https://github.com/cristianbuse/VBA-MemoryTools
    ''' -----------------------------------------------
    ''' MIT License
    '''
    ''' Copyright (c) 2020 Ion Cristian Buse
    '''
    ''' Permission is hereby granted, free of charge, to any person obtaining a copy
    ''' of this software and associated documentation files (the "Software"), to
    ''' deal in the Software without restriction, including without limitation the
    ''' rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
    ''' sell copies of the Software, and to permit persons to whom the Software is
    ''' furnished to do so, subject to the following conditions:
    '''
    ''' The above copyright notice and this permission notice shall be included in
    ''' all copies or substantial portions of the Software.
    '''
    ''' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
    ''' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
    ''' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
    ''' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
    ''' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
    ''' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
    ''' IN THE SOFTWARE.
    '''=============================================================================

    Option Explicit
    Option Private Module

    '*******************************************************************************
    '' Methods in this library module allow direct native memory manipulation in VBA
    '' regardless of:
    ''  - the host Application (Excel, Word, AutoCAD etc.)
    ''  - the operating system (Mac, Windows)
    ''  - application environment (x32, x64)
    '*******************************************************************************

    #If Mac Then
        #If VBA7 Then
            Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
            Private Declare PtrSafe Function FillMemory Lib "/usr/lib/libc.dylib" Alias "memset" (Destination As Any, ByVal Fill As Byte, ByVal Length As LongPtr) As LongPtr
            Public Declare PtrSafe Function MemCopy Lib "/usr/lib/libc.dylib" Alias "memmove" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As LongPtr) As LongPtr
        #Else
            Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long
            Private Declare Function FillMemory Lib "/usr/lib/libc.dylib" Alias "memset" (Destination As Any, ByVal Fill As Byte, ByVal Length As Long) As Long
            Public Declare Function MemCopy Lib "/usr/lib/libc.dylib" Alias "memmove" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) As Long
        #End If
    #Else 'Windows
        'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx
        #If VBA7 Then
            Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
            Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As LongPtr, ByVal Fill As Byte)
            #If TWINBASIC Then
                Public Declare PtrSafe Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As LongPtr)
            #End If
        #Else
            Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
            Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
            Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
            Public Declare Sub MemFill Lib "kernel32" Alias "RtlFillMemory" (ByVal Destination As Long, ByVal Length As Long, ByVal Fill As Byte)
        #End If
    #End If

    #If VBA7 = 0 Then       'LongPtr trick discovered by @Greedo (https://github.com/Greedquest)
        Public Enum LongPtr
            [_]
        End Enum
    #End If                 'https://github.com/cristianbuse/VBA-MemoryTools/issues/3

    #If Win64 Then
        Public Const PTR_SIZE As Long = 8
        Public Const VARIANT_SIZE As Long = 24
        Public Const NULL_PTR As LongLong = 0^
    #Else
        Public Const PTR_SIZE As Long = 4
        Public Const VARIANT_SIZE As Long = 16
        Public Const NULL_PTR As Long = 0&
    #End If

    Private Const BYTE_SIZE As Long = 1
    Private Const INT_SIZE As Long = 2
    Private Const LONG_SIZE As Long = 4
    
    

    #If Win64 Then
        #If Mac Then
            Public Const vbLongLong As Long = 20 'Apparently missing for x64 on Mac
        #End If
        Public Const vbLongPtr As Long = vbLongLong
    #Else
        Public Const vbLongLong As Long = 20 'Useful in Select Case logic
        Public Const vbLongPtr As Long = vbLong
    #End If

    'https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-oaut/3fe7db9f-5803-4dc4-9d14-5425d3f5461f
    'https://docs.microsoft.com/en-us/windows/win32/api/oaidl/ns-oaidl-variant?redirectedfrom=MSDN
    'Flag used to simulate ByRef Variants
    Public Const VT_BYREF As Long = &H4000

    Public Type SAFEARRAYBOUND
        cElements As Long
        lLbound As Long
    End Type
    Public Type SAFEARRAY_1D
        cDims As Integer
        fFeatures As Integer
        cbElements As Long
        cLocks As Long
        pvData As LongPtr
        rgsabound0 As SAFEARRAYBOUND
    End Type
    Public Enum SAFEARRAY_FEATURES
        FADF_AUTO = &H1
        FADF_STATIC = &H2
        FADF_EMBEDDED = &H4
        FADF_FIXEDSIZE = &H10
        FADF_RECORD = &H20
        FADF_HAVEIID = &H40
        FADF_HAVEVARTYPE = &H80
        FADF_BSTR = &H100
        FADF_UNKNOWN = &H200
        FADF_DISPATCH = &H400
        FADF_VARIANT = &H800
        FADF_RESERVED = &HF008
    End Enum
    Public Enum SAFEARRAY_OFFSETS
        cDimsOffset = 0
        fFeaturesOffset = cDimsOffset + INT_SIZE
        cbElementsOffset = fFeaturesOffset + INT_SIZE
        cLocksOffset = cbElementsOffset + LONG_SIZE
        pvDataOffset = cLocksOffset + PTR_SIZE
        rgsaboundOffset = pvDataOffset + PTR_SIZE
        rgsabound0_cElementsOffset = rgsaboundOffset
        rgsabound0_lLboundOffset = rgsabound0_cElementsOffset + LONG_SIZE
    End Enum
    Public Const SAFEARRAY_SIZE As Long = rgsabound0_lLboundOffset + LONG_SIZE

    '*******************************************************************************
    'A new way to copy memory via UDTs - faster than using ByRef Variant
    'Last commit that used ByRef Variant:
    'https://github.com/cristianbuse/VBA-MemoryTools/tree/5058e3333c
    '*******************************************************************************
    Private Type Byte8:   l As Long:     r As Long:     End Type
    Private Type Byte16:  l As Byte8:    r As Byte8:    End Type
    Private Type Byte32:  l As Byte16:   r As Byte16:   End Type
    Private Type Byte64:  l As Byte32:   r As Byte32:   End Type
    Private Type Byte128: l As Byte64:   r As Byte64:   End Type
    Private Type Byte256: l As Byte128:  r As Byte128:  End Type
    Private Type Byte512: l As Byte256:  r As Byte256:  End Type
    Private Type Byte1K:  l As Byte512:  r As Byte512:  End Type
    Private Type Byte2K:  l As Byte1K:   r As Byte1K:   End Type
    Private Type Byte4K:  l As Byte2K:   r As Byte2K:   End Type
    Private Type Byte8K:  l As Byte4K:   r As Byte4K:   End Type
    Private Type Byte16K: l As Byte8K:   r As Byte8K:   End Type
    Private Type Byte32K: l As Byte16K:  r As Byte16K:  End Type
    Private Type ArrayAccessor
        'For working directly with data types
        dPtr() As LongPtr:  dByte() As Byte:  dBool() As Boolean
        dInt() As Integer:  dLong() As Long:  dSng()  As Single
        dCur() As Currency: dDate() As Date:  dDbl()  As Double
        dVar() As Variant:  dObj() As Object: dStr() As String
    #If Win64 Then
        dLongLong() As LongLong
    #End If
        'For copying memory without overlap (faster than String)
        b16()  As Byte16:  b32()  As Byte32:  b64()  As Byte64
        b128() As Byte128: b256() As Byte256: b512() As Byte512
        b1K()  As Byte1K:  b2K()  As Byte2K:  b4K()  As Byte4K
        b8K()  As Byte8K:  b16K() As Byte16K: b32K() As Byte32K
        'For copying memory with overlap (slower than Byte)
        s16()  As String * 8:    s32()  As String * 16:   s64()  As String * 32
        s128() As String * 64:   s256() As String * 128:  s512() As String * 256
        s1K()  As String * 512:  s2K()  As String * 1024: s4K()  As String * 2048
        s8K()  As String * 4096: s16K() As String * 8192: s32K() As String * 16384
        'For referencing fake SAFE ARRAYs
        sa() As SAFEARRAY_1D
    End Type
    Private Type ByteInfo
        bit(0 To 7) As Boolean
    End Type
    Public Type MEMORY_ACCESSOR
        isSet As Boolean
        ac As ArrayAccessor
        sa As SAFEARRAY_1D
    End Type

    'Storage for memory allocated via 'MemAlloc'. Can be deallocated via 'MemFree'
    Private m_allocMemory As New Collection

    '*******************************************************************************
    'Returns an initialized (linked) MEMORY_ACCESSOR struct
    'Links all arrays under 'ac' accessor to the 'sa' SAFEARRAY
    '*******************************************************************************
    Public Sub InitMemoryAccessor(ByRef maToInit As MEMORY_ACCESSOR)
        If maToInit.isSet Then Exit Sub
        '
        Static ma As MEMORY_ACCESSOR
        Dim saPtr As LongPtr: saPtr = VarPtr(maToInit.sa)
        Dim i As Long
        '
        If Not ma.isSet Then
            With ma.sa
                .cDims = 1
                .cbElements = PTR_SIZE
                .cLocks = 1
                .fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
            End With
            CopyMemory ByVal VarPtr(ma.ac), VarPtr(ma.sa), PTR_SIZE
            ma.isSet = True
        End If
        '
        With maToInit.sa
            .cDims = 1
            .cLocks = 1
            .fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
        End With
        '
        ma.sa.pvData = VarPtr(maToInit.ac)
        ma.sa.rgsabound0.cElements = LenB(maToInit.ac) / PTR_SIZE
        '
        For i = 0 To ma.sa.rgsabound0.cElements - 1
            ma.ac.dPtr(i) = saPtr
        Next i
        '
        ma.sa.rgsabound0.cElements = 0
        ma.sa.pvData = NULL_PTR
        '
        maToInit.isSet = True
    End Sub

    '*******************************************************************************
    'Read/Write a Byte from/to memory
    '*******************************************************************************
    Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
        #If Mac Or (VBA7 = 0) Then
            CopyMemory MemByte, ByVal memAddress, 1
        #ElseIf TWINBASIC Then
            GetMem1 memAddress, MemByte
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemByte = ma.ac.dByte(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
        #If Mac Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 1
        #ElseIf TWINBASIC Then
            PutMem1 memAddress, newValue
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dByte(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 2 Bytes (Integer) from/to memory
    '*******************************************************************************
    Public Property Get MemInt(ByVal memAddress As LongPtr) As Integer
        #If Mac Or (VBA7 = 0) Then
            CopyMemory MemInt, ByVal memAddress, 2
        #ElseIf TWINBASIC Then
            GetMem2 memAddress, MemInt
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemInt = ma.ac.dInt(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemInt(ByVal memAddress As LongPtr, ByVal newValue As Integer)
        #If Mac Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 2
        #ElseIf TWINBASIC Then
            PutMem2 memAddress, newValue
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dInt(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 2 Bytes (Boolean) from/to memory
    '*******************************************************************************
    Public Property Get MemBool(ByVal memAddress As LongPtr) As Boolean
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory MemBool, ByVal memAddress, 2
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemBool = ma.ac.dBool(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemBool(ByVal memAddress As LongPtr, ByVal newValue As Boolean)
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 2
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dBool(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 4 Bytes (Long) from/to memory
    '*******************************************************************************
    Public Property Get MemLong(ByVal memAddress As LongPtr) As Long
        #If Mac Or (VBA7 = 0) Then
            CopyMemory MemLong, ByVal memAddress, 4
        #ElseIf TWINBASIC Then
            GetMem4 memAddress, MemLong
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemLong = ma.ac.dLong(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemLong(ByVal memAddress As LongPtr, ByVal newValue As Long)
        #If Mac Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 4
        #ElseIf TWINBASIC Then
            PutMem4 memAddress, newValue
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dLong(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 4 Bytes (Single) from/to memory
    '*******************************************************************************
    Public Property Get MemSng(ByVal memAddress As LongPtr) As Single
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory MemSng, ByVal memAddress, 4
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemSng = ma.ac.dSng(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemSng(ByVal memAddress As LongPtr, ByVal newValue As Single)
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 4
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dSng(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 8 Bytes (LongLong) from/to memory
    '*******************************************************************************
    #If Win64 Or TWINBASIC Then 'TB supports LongLong (8 bytes) in both x32 and x64
    Public Property Get MemLongLong(ByVal memAddress As LongLong) As LongLong
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory MemLongLong, ByVal memAddress, 8
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemLongLong = ma.ac.dLongLong(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemLongLong(ByVal memAddress As LongLong, ByVal newValue As LongLong)
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 8
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dLongLong(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    #End If

    '*******************************************************************************
    'Read/Write 4 Bytes (Long on x32) or 8 Bytes (LongLong on x64) from/to memory
    'Note that wrapping MemLong and MemLongLong is about 25% slower because of the
    '   extra stack frame! Performance was chosen over code repetition!
    '*******************************************************************************
    Public Property Get MemLongPtr(ByVal memAddress As LongPtr) As LongPtr
        #If Mac Or (VBA7 = 0) Then
            CopyMemory MemLongPtr, ByVal memAddress, PTR_SIZE
        #ElseIf TWINBASIC Then
            GetMemPtr memAddress, MemLongPtr
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemLongPtr = ma.ac.dPtr(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
        #If Mac Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, PTR_SIZE
        #ElseIf TWINBASIC Then
            PutMemPtr memAddress, newValue
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dPtr(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 8 Bytes (Currency) from/to memory
    '*******************************************************************************
    Public Property Get MemCur(ByVal memAddress As LongPtr) As Currency
        #If Mac Or (VBA7 = 0) Then
            CopyMemory MemCur, ByVal memAddress, 8
        #ElseIf TWINBASIC Then
            GetMem8 memAddress, MemCur
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemCur = ma.ac.dCur(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemCur(ByVal memAddress As LongPtr, ByVal newValue As Currency)
        #If Mac Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 8
        #ElseIf TWINBASIC Then
            PutMem8 memAddress, newValue
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dCur(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 8 Bytes (Date) from/to memory
    '*******************************************************************************
    Public Property Get MemDate(ByVal memAddress As LongPtr) As Date
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory MemDate, ByVal memAddress, 8
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemDate = ma.ac.dDate(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemDate(ByVal memAddress As LongPtr, ByVal newValue As Date)
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 8
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dDate(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Read/Write 8 Bytes (Double) from/to memory
    '*******************************************************************************
    Public Property Get MemDbl(ByVal memAddress As LongPtr) As Double
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory MemDbl, ByVal memAddress, 8
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            MemDbl = ma.ac.dDbl(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property
    Public Property Let MemDbl(ByVal memAddress As LongPtr, ByVal newValue As Double)
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            CopyMemory ByVal memAddress, newValue, 8
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = memAddress: ma.sa.rgsabound0.cElements = 1
            ma.ac.dDbl(0) = newValue
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Property

    '*******************************************************************************
    'Dereference an object by it's pointer
    '*******************************************************************************
    Public Function MemObj(ByVal memAddress As LongPtr) As Object
        If memAddress = NULL_PTR Then Exit Function
        '
        #If Mac Or TWINBASIC Or (VBA7 = 0) Then
            Dim obj As Object
            #If TWINBASIC Then
                PutMemPtr ByVal VarPtr(obj), memAddress
            #Else
                CopyMemory obj, memAddress, PTR_SIZE
            #End If
            Set MemObj = obj
            CopyMemory obj, NULL_PTR, PTR_SIZE
        #Else
            Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
            ma.sa.pvData = VarPtr(memAddress): ma.sa.rgsabound0.cElements = 1
            Set MemObj = ma.ac.dObj(0)
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        #End If
    End Function

    'Method purpose explanation at:
    'https://gist.github.com/cristianbuse/b9cc79164c1d31fdb30465f503ac36a9
    '
    'Practical note Jan-2021 from Vladimir Vissoultchev (https://github.com/wqweto):
    'This is mostly not needed in client application code even for LARGEADDRESSAWARE
    '   32-bit processes nowadays as a reliable technique to prevent pointer
    '   arithmetic overflows is to VirtualAlloc a 64KB sentinel chunk around 2GB
    '   boundary at application start up so that the boundary is never (rarely)
    '   crossed in normal pointer operations.
    'This same sentinel chunk fixes native PropertyBag as well which has troubles
    '   when internal storage crosses 2GB boundary.
    Public Function UnsignedAdd(ByVal unsignedPtr As LongPtr _
                            , ByVal signedOffset As LongPtr) As LongPtr
        #If Win64 Then
            Const minNegative As LongLong = &H8000000000000000^
        #Else
            Const minNegative As Long = &H80000000
        #End If
        UnsignedAdd = ((unsignedPtr Xor minNegative) + signedOffset) Xor minNegative
    End Function

    '*******************************************************************************
    'Redirects the instance of a class to another instance of the same class within
    '   the scope of a private class Function (not  Sub) where the call happens
    '
    'Warning! ONLY call this method from a Private Function of a class!
    '         You must pass the return of the function as the 'funcReturn' argument
    '         You must pass the address for the return of the function using VarPtr
    '
    'All function return types are supported with the exception User Defined Types
    '   (UDTs) ar Arrays of UDT type
    'Example usage:
    '   Private Function Init(...) As Boolean
    '       RedirectInstance Init, VarPtr(Init), Me, TheOtherInstance
    '       'Run code on private members of TheOtherInstance
    '   End Function
    '*******************************************************************************
    Public Sub RedirectInstance(ByRef funcReturn As Variant _
                            , ByVal funcReturnPtr As LongPtr _
                            , ByVal currentInstance As stdole.IUnknown _
                            , ByVal targetInstance As stdole.IUnknown)
        Const methodName As String = "RedirectInstance"
        If currentInstance Is Nothing Or targetInstance Is Nothing Then
            Err.Raise 91, methodName, "Object not set"
        End If
        '
        Static ma As MEMORY_ACCESSOR
        Dim originalPtr As LongPtr
        Dim newPtr As LongPtr
        Dim ptr As LongPtr
        Dim swapAddress As LongPtr
        Dim temp As Object
        '
        Set temp = currentInstance: originalPtr = ObjPtr(temp)
        Set temp = targetInstance:  newPtr = ObjPtr(temp)
        '
        If Not ma.isSet Then
            InitMemoryAccessor ma
            ma.sa.cbElements = PTR_SIZE
        End If
        ma.sa.pvData = originalPtr
        ma.sa.rgsabound0.cElements = 1
        ptr = ma.ac.dPtr(0)
        ma.sa.pvData = newPtr
        If ptr <> ma.ac.dPtr(0) Then 'Faster to compare vTable than TypeName
            ma.sa.rgsabound0.cElements = 0
            ma.sa.pvData = NULL_PTR
            Err.Raise 5, methodName, "Expected same VB class"
        End If
        '
        'On x64 the shadow stack space is allocated next to the Function Return
        'On x32 the stack space has a fixed offset (found through testing)
        #If Win64 Then
            Const memOffsetNonVariant As LongLong = PTR_SIZE
            Const memOffsetVariant As LongLong = PTR_SIZE * 3
        #Else
            Const memOffsetNonVariant As Long = PTR_SIZE * 28
            Const memOffsetVariant As Long = PTR_SIZE * 31
        #End If
        '
        ma.sa.pvData = VarPtr(funcReturn)
        If (ma.ac.dInt(0) And VT_BYREF) = 0 Then
            ma.sa.pvData = ma.sa.pvData + memOffsetVariant
            #If Win64 = 0 Then
                ma.sa.pvData = ma.ac.dPtr(0) + PTR_SIZE * 2
            #End If
            If ma.ac.dPtr(0) = originalPtr Then swapAddress = ma.sa.pvData
        Else
            Const variantPtrOffset As Long = 8
            Dim vt As Integer: vt = ma.ac.dInt(0) Xor VT_BYREF
            '
            If (vt = vbObject) Or (vt = vbDataObject) Then
                ptr = funcReturnPtr
            Else
                ma.sa.pvData = ma.sa.pvData + variantPtrOffset
                ptr = ma.ac.dPtr(0)
                #If Mac Or (Win64 = 0) Then 'Align for Bool/Byte/Int return type
                    ptr = ptr - (ptr Mod PTR_SIZE)
                #End If
            End If
            '
            ma.sa.pvData = ptr + memOffsetNonVariant
            #If Win64 = 0 Then
                If vt = vbCurrency Or vt = vbDate Or vt = vbDouble Then
                    ma.sa.pvData = ma.sa.pvData + PTR_SIZE
                End If
                ma.sa.pvData = ma.ac.dPtr(0) + PTR_SIZE * 2
            #End If
            If ma.ac.dPtr(0) = originalPtr Then swapAddress = ma.sa.pvData
        End If
        '
        If swapAddress = NULL_PTR Then
            ma.sa.rgsabound0.cElements = 0
            ma.sa.pvData = NULL_PTR
            Err.Raise 5, methodName, "Not called from class Func or UDT Func Return"
        End If
        '
        ma.sa.pvData = swapAddress
        ma.ac.dPtr(0) = newPtr 'Redirect Instance
        ma.sa.rgsabound0.cElements = 0
        ma.sa.pvData = NULL_PTR
    End Sub

    '*******************************************************************************
    'Returns the default interface for an object
    'Casting from IUnknown to IDispatch (Object) forces a call to QueryInterface for
    '   the IDispatch interface (which knows about the default interface)
    '*******************************************************************************
    Public Function GetDefaultInterface(ByVal obj As stdole.IUnknown) As Object
        Set GetDefaultInterface = obj
    End Function

    '*******************************************************************************
    'Returns the memory address of a variable of array type
    'Returns error 5 for a non-array
    '*******************************************************************************
    Public Function VarPtrArr(ByRef arr As Variant) As LongPtr
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        ma.sa.pvData = VarPtr(arr): ma.sa.rgsabound0.cElements = 1
        '
        Dim vt As VbVarType: vt = ma.ac.dInt(0) 'VarType(arr) ignores VT_BYREF
        If vt And vbArray Then
            Const pArrayOffset As Long = 8
            VarPtrArr = ma.sa.pvData + pArrayOffset
            If vt And VT_BYREF Then
                ma.sa.pvData = VarPtrArr
                VarPtrArr = ma.ac.dPtr(0)
            End If
        Else
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
            Err.Raise 5, "VarPtrArr", "Array required"
        End If
        ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
    End Function

    '*******************************************************************************
    'Returns the pointer to the underlying SAFEARRAY structure of a VB array
    'Returns error 5 for a non-array
    '*******************************************************************************
    Public Function ArrPtr(ByRef arr As Variant) As LongPtr
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        ma.sa.pvData = VarPtr(arr): ma.sa.rgsabound0.cElements = 1
        '
        Dim vt As VbVarType: vt = ma.ac.dInt(0) 'VarType(arr) ignores VT_BYREF
        If vt And vbArray Then
            Const pArrayOffset As Long = 8
            ma.sa.pvData = ma.sa.pvData + pArrayOffset
            ArrPtr = ma.ac.dPtr(0)
            If vt And VT_BYREF Then
                ma.sa.pvData = ArrPtr
                ArrPtr = ma.ac.dPtr(0)
            End If
        Else
            ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
            Err.Raise 5, "ArrPtr", "Array required"
        End If
        ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
    End Function

    '*******************************************************************************
    'Alternative for CopyMemory - not affected by API speed issues on Windows VBA7
    '--------------------------
    'Mac - wrapper around CopyMemory/memmove
    'Win - bytesCount 1 to 33,554,432 - no API calls. Uses MEMORY_ACCESSOR structs
    '    - bytesCount < 0 or > 33,554,432 - wrapper around CopyMemory/RtlMoveMemory
    '*******************************************************************************
    #If (Mac = 0) And (TWINBASIC = 0) And VBA7 Then
    Public Sub MemCopy(ByVal destinationPtr As LongPtr _
                    , ByVal sourcePtr As LongPtr _
                    , ByVal bytesCount As LongPtr)
        Const maxSizeSpeedGain As Long = &H2000000 'Beyond this use API directly
        If bytesCount < 0 Or bytesCount > maxSizeSpeedGain Then
            CopyMemory ByVal destinationPtr, ByVal sourcePtr, bytesCount
            Exit Sub
        ElseIf destinationPtr = sourcePtr Then
            Exit Sub
        End If
        '
        Static src As MEMORY_ACCESSOR
        Static trg As MEMORY_ACCESSOR
        Static byteMap(0 To 255) As ByteInfo
        Dim i As Long
        Dim j As Long
        '
        If Not src.isSet Then
            InitMemoryAccessor src
            InitMemoryAccessor trg
            For i = &H1 To &HFF&
                With byteMap(i)
                    For j = 0 To 7
                        .bit(j) = i And 2 ^ j
                    Next j
                End With
            Next i
        End If
        '
        src.sa.pvData = sourcePtr
        trg.sa.pvData = destinationPtr
        '
        If bytesCount <= 8 Then 'Optional optimization - small gain
            src.sa.rgsabound0.cElements = 1
            trg.sa.rgsabound0.cElements = 1
            Select Case bytesCount
                Case 0: GoTo Clean
                Case 1: trg.ac.dByte(0) = src.ac.dByte(0): GoTo Clean
                Case 2: trg.ac.dInt(0) = src.ac.dInt(0): GoTo Clean
                Case 4: trg.ac.dLong(0) = src.ac.dLong(0): GoTo Clean
                Case 8: trg.ac.dCur(0) = src.ac.dCur(0): GoTo Clean
            End Select
        End If
        '
        Dim b As Long: b = CLng(bytesCount)
        Dim chunk As Long
        Dim overlapR As Boolean
        '
        overlapR = (destinationPtr > sourcePtr) And (sourcePtr + b > destinationPtr)
        '
        If b And &H7FFF8000 Then
            src.sa.cbElements = &H8000&
            trg.sa.cbElements = &H8000&
            src.sa.rgsabound0.cElements = b \ src.sa.cbElements
            trg.sa.rgsabound0.cElements = src.sa.rgsabound0.cElements
            '
            chunk = src.sa.rgsabound0.cElements * src.sa.cbElements
            b = b - chunk
            '
            If overlapR Then
                src.sa.pvData = src.sa.pvData + b
                trg.sa.pvData = trg.sa.pvData + b
                For i = src.sa.rgsabound0.cElements - 1 To 0 Step -1
                    trg.ac.s32K(i) = src.ac.s32K(i)
                Next i
            Else
                For i = 0 To src.sa.rgsabound0.cElements - 1
                    trg.ac.b32K(i) = src.ac.b32K(i)
                Next i
                src.sa.pvData = src.sa.pvData + chunk
                trg.sa.pvData = trg.sa.pvData + chunk
            End If
            chunk = &H8000&
        ElseIf overlapR Then
            src.sa.pvData = src.sa.pvData + b
            trg.sa.pvData = trg.sa.pvData + b
        End If
        src.sa.rgsabound0.cElements = 1
        trg.sa.rgsabound0.cElements = 1
        '
        i = b And &HFF&
        If i Then
            With byteMap(i)
                If overlapR Then
                    If .bit(0) Then src.sa.pvData = src.sa.pvData - 1: trg.sa.pvData = trg.sa.pvData - 1: trg.ac.dByte(0) = src.ac.dByte(0)
                    If .bit(1) Then src.sa.pvData = src.sa.pvData - 2: trg.sa.pvData = trg.sa.pvData - 2: trg.ac.dInt(0) = src.ac.dInt(0)
                    If .bit(2) Then src.sa.pvData = src.sa.pvData - 4: trg.sa.pvData = trg.sa.pvData - 4: trg.ac.dLong(0) = src.ac.dLong(0)
                    If .bit(3) Then src.sa.pvData = src.sa.pvData - 8: trg.sa.pvData = trg.sa.pvData - 8: trg.ac.dCur(0) = src.ac.dCur(0)
                    If .bit(4) Then src.sa.pvData = src.sa.pvData - 16: trg.sa.pvData = trg.sa.pvData - 16: trg.ac.s16(0) = src.ac.s16(0)
                    If .bit(5) Then src.sa.pvData = src.sa.pvData - 32: trg.sa.pvData = trg.sa.pvData - 32: trg.ac.s32(0) = src.ac.s32(0)
                    If .bit(6) Then src.sa.pvData = src.sa.pvData - 64: trg.sa.pvData = trg.sa.pvData - 64: trg.ac.s64(0) = src.ac.s64(0)
                    If .bit(7) Then src.sa.pvData = src.sa.pvData - 128: trg.sa.pvData = trg.sa.pvData - 128: trg.ac.s128(0) = src.ac.s128(0)
                Else
                    If .bit(0) Then trg.ac.dByte(0) = src.ac.dByte(0): src.sa.pvData = src.sa.pvData + 1: trg.sa.pvData = trg.sa.pvData + 1
                    If .bit(1) Then trg.ac.dInt(0) = src.ac.dInt(0): src.sa.pvData = src.sa.pvData + 2: trg.sa.pvData = trg.sa.pvData + 2
                    If .bit(2) Then trg.ac.dLong(0) = src.ac.dLong(0): src.sa.pvData = src.sa.pvData + 4: trg.sa.pvData = trg.sa.pvData + 4
                    If .bit(3) Then trg.ac.dCur(0) = src.ac.dCur(0): src.sa.pvData = src.sa.pvData + 8: trg.sa.pvData = trg.sa.pvData + 8
                    If .bit(4) Then trg.ac.b16(0) = src.ac.b16(0): src.sa.pvData = src.sa.pvData + 16: trg.sa.pvData = trg.sa.pvData + 16
                    If .bit(5) Then trg.ac.b32(0) = src.ac.b32(0): src.sa.pvData = src.sa.pvData + 32: trg.sa.pvData = trg.sa.pvData + 32
                    If .bit(6) Then trg.ac.b64(0) = src.ac.b64(0): src.sa.pvData = src.sa.pvData + 64: trg.sa.pvData = trg.sa.pvData + 64
                    If .bit(7) Then trg.ac.b128(0) = src.ac.b128(0): src.sa.pvData = src.sa.pvData + 128: trg.sa.pvData = trg.sa.pvData + 128
                End If
            End With
        End If
        '
        i = (b And &H7F00&) / &H100&
        If i Then
            With byteMap(i)
                If overlapR Then
                    If .bit(0) Then src.sa.pvData = src.sa.pvData - 256: trg.sa.pvData = trg.sa.pvData - 256: trg.ac.s256(0) = src.ac.s256(0)
                    If .bit(1) Then src.sa.pvData = src.sa.pvData - 512: trg.sa.pvData = trg.sa.pvData - 512: trg.ac.s512(0) = src.ac.s512(0)
                    If .bit(2) Then src.sa.pvData = src.sa.pvData - 1024: trg.sa.pvData = trg.sa.pvData - 1024: trg.ac.s1K(0) = src.ac.s1K(0)
                    If .bit(3) Then src.sa.pvData = src.sa.pvData - 2048: trg.sa.pvData = trg.sa.pvData - 2048: trg.ac.s2K(0) = src.ac.s2K(0)
                    If .bit(4) Then src.sa.pvData = src.sa.pvData - 4096: trg.sa.pvData = trg.sa.pvData - 4096: trg.ac.s4K(0) = src.ac.s4K(0)
                    If .bit(5) Then src.sa.pvData = src.sa.pvData - 8192: trg.sa.pvData = trg.sa.pvData - 8192: trg.ac.s8K(0) = src.ac.s8K(0)
                    If .bit(6) Then src.sa.pvData = src.sa.pvData - 16384: trg.sa.pvData = trg.sa.pvData - 16384: trg.ac.s16K(0) = src.ac.s16K(0)
                Else
                    If .bit(0) Then trg.ac.b256(0) = src.ac.b256(0): src.sa.pvData = src.sa.pvData + 256: trg.sa.pvData = trg.sa.pvData + 256
                    If .bit(1) Then trg.ac.b512(0) = src.ac.b512(0): src.sa.pvData = src.sa.pvData + 512: trg.sa.pvData = trg.sa.pvData + 512
                    If .bit(2) Then trg.ac.b1K(0) = src.ac.b1K(0): src.sa.pvData = src.sa.pvData + 1024: trg.sa.pvData = trg.sa.pvData + 1024
                    If .bit(3) Then trg.ac.b2K(0) = src.ac.b2K(0): src.sa.pvData = src.sa.pvData + 2048: trg.sa.pvData = trg.sa.pvData + 2048
                    If .bit(4) Then trg.ac.b4K(0) = src.ac.b4K(0): src.sa.pvData = src.sa.pvData + 4096: trg.sa.pvData = trg.sa.pvData + 4096
                    If .bit(5) Then trg.ac.b8K(0) = src.ac.b8K(0): src.sa.pvData = src.sa.pvData + 8192: trg.sa.pvData = trg.sa.pvData + 8192
                    If .bit(6) Then trg.ac.b16K(0) = src.ac.b16K(0): src.sa.pvData = src.sa.pvData + 16384: trg.sa.pvData = trg.sa.pvData + 16384
                End If
            End With
        End If
    Clean:
        src.sa.rgsabound0.cElements = 0
        trg.sa.rgsabound0.cElements = 0
        src.sa.pvData = NULL_PTR
        trg.sa.pvData = NULL_PTR
    End Sub
    #End If

    '*******************************************************************************
    'Copy a param array to another array of Variants while preserving ByRef elements
    'If the paramarray name is 'args' then the call needs to look like this:
    '   CloneParamArray Not Not args, outArray
    '*******************************************************************************
    Public Sub CloneParamArray(ByVal paramPtr As LongPtr, ByRef out() As Variant)
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        Dim v As Variant
        Dim sa As SAFEARRAY_1D
        '
        MemCopy VarPtr(sa), paramPtr, LenB(sa)
        v = VarPtr(sa)
        sa.cLocks = 1
        '
        ma.sa.pvData = VarPtr(v): ma.sa.rgsabound0.cElements = 1
        ma.ac.dInt(0) = vbArray + vbVariant
        out = v
        ma.ac.dInt(0) = vbLongPtr
        ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
    End Sub

    '*******************************************************************************
    'Returns the input array wrapped in a ByRef Variant without copying the array
    '*******************************************************************************
    Public Function GetArrayByRef(ByRef arr As Variant) As Variant
        If IsArray(arr) Then
            GetArrayByRef = VarPtrArr(arr)
            MemInt(VarPtr(GetArrayByRef)) = VarType(arr) Or VT_BYREF
        Else
            Err.Raise 5, "GetArrayByRef", "Array required"
        End If
    End Function

    '*******************************************************************************
    'Reads the memory of a String to an Array of Integers
    'Notes:
    '   - Ignores the last byte if input has an odd number of bytes
    '   - If 'outLength' is -1 (default) then the remaining length is returned
    '   - Excess length is ignored
    '*******************************************************************************
    Public Function StringToIntegers(ByRef s As String _
                                , Optional ByVal startIndex As Long = 1 _
                                , Optional ByVal outLength As Long = -1 _
                                , Optional ByVal outLowBound As Long = 0) As Integer()
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        Const methodName As String = "StringToIntegers"
        Dim cLen As Long: cLen = Len(s)

        If startIndex < 1 Then
            Err.Raise 9, methodName, "Invalid Start Index"
        ElseIf outLength < -1 Then
            Err.Raise 5, methodName, "Invalid Length for output"
        ElseIf outLength = -1 Or startIndex + outLength - 1 > cLen Then
            outLength = cLen - startIndex + 1 'Excess length is ignored
            If outLength < 0 Then outLength = 0
        End If
        '
        ma.sa.pvData = StrPtr(s) + (startIndex - 1) * INT_SIZE
        ma.sa.cbElements = INT_SIZE
        ma.sa.rgsabound0.lLbound = outLowBound
        ma.sa.rgsabound0.cElements = outLength
        StringToIntegers = ma.ac.dInt
        ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
    End Function

    '*******************************************************************************
    'Reads the memory of an Array of Integers into a String
    'Notes:
    '   - If 'outLength' is -1 (default) then the remaining length is returned
    '   - Excess length is ignored
    '*******************************************************************************
    Public Function IntegersToString(ByRef ints() As Integer _
                                , Optional ByVal startIndex As Long = 0 _
                                , Optional ByVal outLength As Long = -1) As String
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        Const methodName As String = "IntegersToString"

        If GetArrayDimsCount(ints) <> 1 Then
            Err.Raise 5, methodName, "Expected 1D Array of Integers"
        ElseIf startIndex < LBound(ints) Then
            Err.Raise 9, methodName, "Invalid Start Index"
        ElseIf outLength < -1 Then
            Err.Raise 5, methodName, "Invalid Length for output"
        ElseIf outLength = -1 Or startIndex + outLength - 1 > UBound(ints) Then
            outLength = UBound(ints) - startIndex + 1
            If outLength < 0 Then Exit Function
        End If
        '
        ma.sa.pvData = VarPtr(ints(startIndex))
        ma.sa.cbElements = BYTE_SIZE
        ma.sa.rgsabound0.cElements = outLength * INT_SIZE
        IntegersToString = ma.ac.dByte
        ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
    End Function

    '*******************************************************************************
    'Returns an empty array of the requested size and type
    '*******************************************************************************
    Public Function EmptyArray(ByVal numberOfDimensions As Long _
                            , ByVal vType As VbVarType) As Variant
        Const methodName As String = "EmptyArray"
        Const MAX_DIMENSION As Long = 60
        '
        If numberOfDimensions < 1 Or numberOfDimensions > MAX_DIMENSION Then
            Err.Raise 5, methodName, "Invalid number of dimensions"
        End If
        Select Case vType
        Case vbByte, vbInteger, vbLong, vbLongLong 'Integers
        Case vbCurrency, vbDecimal, vbDouble, vbSingle, vbDate 'Decimal-point
        Case vbBoolean, vbString, vbObject, vbDataObject, vbVariant 'Other
        Case Else
            Err.Raise 13, methodName, "Type mismatch"
        End Select
        '
        Static fakeSafeArray() As Long
        Static ma As MEMORY_ACCESSOR
        Static v As Variant
        #If Win64 Then
            Const safeArraySize = 6
        #Else
            Const safeArraySize = 4
        #End If
        Const fFeaturesHi As Long = FADF_HAVEVARTYPE * &H10000
        Dim i As Long
        '
        If Not ma.isSet Then
            InitMemoryAccessor ma
            ReDim fakeSafeArray(0 To safeArraySize + MAX_DIMENSION * 2 - 1)
            fakeSafeArray(1) = 1 'cbElements member - needs to be non-zero
            v = VarPtr(fakeSafeArray(0)) 'The fake ArrPtr
            '
            'Set 'cElements' to 1 for each SAFEARRAYBOUND
            For i = safeArraySize To UBound(fakeSafeArray, 1) Step 2
                fakeSafeArray(i) = 1
            Next i
        End If
        fakeSafeArray(0) = fFeaturesHi + numberOfDimensions 'cDims and fFeatures
        i = safeArraySize + (numberOfDimensions - 1) * 2 'Highest dimension position
        '
        fakeSafeArray(i) = 0 'Highest dimension must have 0 'cElements'
        ma.sa.pvData = VarPtr(v): ma.sa.rgsabound0.cElements = 1
        ma.ac.dInt(0) = vbArray + vType
        EmptyArray = v
        ma.ac.dInt(0) = vbLongPtr
        ma.sa.rgsabound0.cElements = 0: ma.sa.pvData = NULL_PTR
        fakeSafeArray(i) = 1
    End Function

    '*******************************************************************************
    'Allows user to update the LBound Index for an array dimension
    '*******************************************************************************
    Public Sub UpdateLBound(ByRef arr As Variant _
                        , ByVal dimension As Long _
                        , ByVal newLB As Long)
        Const bOffset As Long = rgsaboundOffset + 4
        Const methodName As String = "UpdateLBound"
        Const maxL As Long = &H7FFFFFFF
        Dim dimensionCount As Long: dimensionCount = GetArrayDimsCount(arr)
        '
        If dimension < 1 Or dimension > dimensionCount Then
            Err.Raise 5, methodName, "Invalid dimension or not array"
        ElseIf maxL - UBound(arr, dimension) + LBound(arr, dimension) < newLB Then
            Err.Raise 5, methodName, "New bound overflow"
        End If
        MemLong(ArrPtr(arr) + bOffset + (dimensionCount - dimension) * 8) = newLB
    End Sub

    '*******************************************************************************
    'Returns the Number of dimensions for an input array
    'Returns 0 if array is uninitialized or input not an array
    'Note that a zero-length array has 1 dimension! Ex. Array() bounds are (0 to -1)
    '*******************************************************************************
    Private Function GetArrayDimsCount(ByRef arr As Variant) As Long
        Const MAX_DIMENSION As Long = 60 'VB limit
        Dim dimension As Long
        Dim tempBound As Long
        '
        On Error GoTo FinalDimension
        For dimension = 1 To MAX_DIMENSION
            tempBound = LBound(arr, dimension)
        Next dimension
    FinalDimension:
        GetArrayDimsCount = dimension - 1
    End Function

    '*******************************************************************************
    'Fills target memory with zero
    '*******************************************************************************
    Public Sub MemZero(ByVal destinationPtr As LongPtr, ByVal bytesCount As LongPtr)
        MemFill destinationPtr, bytesCount, 0
    End Sub

    '*******************************************************************************
    'Fills target memory with the specified Byte value
    '*******************************************************************************
    #If Mac Or VBA7 Then
    Public Sub MemFill(ByVal destinationPtr As LongPtr _
                    , ByVal bytesCount As LongPtr _
                    , ByVal fillByte As Byte)
    #If Mac Then
        FillMemory ByVal destinationPtr, fillByte, bytesCount
    #Else
        If bytesCount = 0 Then Exit Sub
        Const maxSizeSpeedGain As Long = &H100000 'Beyond this use API directly
        If bytesCount < 0 Or bytesCount > maxSizeSpeedGain Then
            FillMemory ByVal destinationPtr, bytesCount, fillByte
            Exit Sub
        End If
        '
        Const maxSizeMidB As Long = &H2000 'Beyond this use MemCopy
        Dim bytesLeft As Long
        Dim bytes As Long
        Dim chunk As Long
        '
        If bytesCount > maxSizeMidB Then
            bytes = maxSizeMidB
            bytesLeft = CLng(bytesCount) - maxSizeMidB
            chunk = maxSizeMidB
        Else
            bytes = CLng(bytesCount)
        End If
        '
        Const bstrPrefixSize As Long = 4
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        Dim i As Long
        '
        ma.sa.pvData = destinationPtr
        ma.sa.cbElements = BYTE_SIZE
        If bytes > 5 Then 'Use MidB
            Dim s As String
            '
            ma.sa.rgsabound0.cElements = 5
            ma.ac.dLong(0) = bytes - bstrPrefixSize
            ma.ac.dByte(4) = fillByte
            ma.sa.pvData = VarPtr(s)
            ma.ac.dPtr(0) = destinationPtr + bstrPrefixSize
            MidB$(s, 2) = s 'The actual fill
            ma.ac.dPtr(0) = NULL_PTR
            ma.sa.pvData = destinationPtr
            bytes = 4
        End If
        ma.sa.rgsabound0.cElements = bytes
        For i = 0 To bytes - 1
            ma.ac.dByte(i) = fillByte
        Next i
        ma.sa.rgsabound0.cElements = 0
        ma.sa.pvData = NULL_PTR
        '
        Do While bytesLeft > 0
            If chunk > bytesLeft Then bytes = bytesLeft Else bytes = chunk
            MemCopy destinationPtr + chunk, destinationPtr, bytes
            bytesLeft = bytesLeft - bytes
            chunk = chunk * 2
        Loop
    #End If
    End Sub
    #End If

    '*******************************************************************************
    'Allocates persistent memory
    'Allocated memory is deallocated automatically on state loss or via 'MemFree'
    '*******************************************************************************
    Public Function MemAlloc(ByVal byteSize As Long) As LongPtr
        Static ma As MEMORY_ACCESSOR: If Not ma.isSet Then InitMemoryAccessor ma
        Static i As stdole.IEnumVARIANT
        Static nextItemAddr As LongPtr
        Static arr() As Byte
        Static arrAddr As LongPtr
        Dim aPtr As LongPtr
        Dim pvPtr As LongPtr
        '
        If byteSize < 1 Then Exit Function
        ReDim arr(0 To byteSize - 1)
        '
        pvPtr = VarPtr(arr(0))
        '
        If nextItemAddr = NULL_PTR Then
            Set i = m_allocMemory.[_NewEnum]
            nextItemAddr = ObjPtr(i) + PTR_SIZE * 2
            arrAddr = VarPtrArr(arr)
        End If
        If m_allocMemory.Count = 0 Then
            m_allocMemory.Add Empty, CStr(pvPtr)
        Else
            m_allocMemory.Add Empty, CStr(pvPtr), 1
        End If
        i.Reset 'Update pointer at 'nextItemAddr' to the latest item
        '
        ma.sa.pvData = arrAddr
        ma.sa.rgsabound0.cElements = 1
        aPtr = ma.ac.dPtr(0) 'Same as ArrPtr(arr)
        ma.ac.dPtr(0) = NULL_PTR 'Clear 'arr' variable
        ma.sa.pvData = nextItemAddr
        ma.sa.pvData = ma.ac.dPtr(0) + 8
        ma.ac.dPtr(0) = aPtr
        ma.sa.pvData = ma.sa.pvData - 8
        ma.ac.dInt(0) = vbArray + vbByte
        ma.sa.rgsabound0.cElements = 0
        ma.sa.pvData = NULL_PTR
        '
        MemAlloc = pvPtr
    End Function

    '*******************************************************************************
    'Deallocates memory that was allocated with 'MemAlloc'
    '*******************************************************************************
    Public Sub MemFree(ByVal memAddress As LongPtr)
        On Error Resume Next
        m_allocMemory.Remove CStr(memAddress)
        On Error GoTo 0
    End Sub

End Module