vbAccelerator - Contents of code file: mMalloc.bas

Attribute VB_Name = "mMalloc"
Option Explicit

Private Declare Function SHGetMalloc Lib "shell32" (ppMalloc As IMalloc) As Long
' Defined as an HRESULT that corresponds to S_OK.
Private Const NOERROR = 0
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

' Returns a reference to the IMalloc interface.
Public Function isMalloc() As IMalloc
Static im As IMalloc
   If (im Is Nothing) Then
      If Not (SHGetMalloc(im) = NOERROR) Then
         ' Fatal error
         Err.Raise 7
      End If
   End If
   Set isMalloc = im
End Function