实用的内存块操作类(vb源码)

(声明：魏滔序原创，转贴请注明出处。)
Option Explicit
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpStringDest As String, ByVal lpStringSrc As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal ByteLen As Long)

Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const PAGE_EXECUTE_READWRITE = &H40

Private m_Handle As Long

Public Property Get Handle() As Long
    Handle = m_Handle
End Property

'分配内存
Public Sub Allocate(ByVal lCount As Long)
    Call Release
    m_Handle = VirtualAlloc(ByVal 0&, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    VirtualLock m_Handle, lCount
End Sub

'读取
Public Sub ReadFromPointer(ByVal hWritePointer As Long, ByVal lLength As Long)
    If IsBadWritePtr(hWritePointer, lLength) = 0 And IsBadReadPtr(Handle, lLength) = 0 Then
        CopyMemory hWritePointer, Handle, lLength
    End If
End Sub

'写入
Public Sub WriteToPointer(ByVal hReadPointer As Long, ByVal lLength As Long)
    If IsBadReadPtr(hReadPointer, lLength) = 0 And IsBadWritePtr(Handle, lLength) = 0 Then
        CopyMemory Handle, hReadPointer, lLength
    End If
End Sub

'释放内存
Public Sub Release()
    Dim lLength As Long
    If m_Handle <> 0 Then
        VirtualUnlock m_Handle, lLength
        VirtualFree m_Handle, lLength, MEM_DECOMMIT
        VirtualFree m_Handle, 0, MEM_RELEASE
        m_Handle = 0
    End If
End Sub

Private Sub Class_Terminate()
    Call Release
End Sub