一个VB数组指针类

    顾名思义了，这个代码就是将指定的内存地址绑定到一个VB数组，即COM中的SafeArray上。所谓绑定，是指在使用该内存地址之前，并不需要申请相应的本地内存缓冲区，也不需要进行内存复制，只是根据该地址凭空构造一个VB数组，并将数组的真实数据地址指向该地址。当然，该类的功能完全可以用CopyMemory函数直接代替。为什么又写了这个类呢？主要还是为了进一步展示VB中数组的内幕，同时避免在进行大块内存操作时的内存复制，节省内存占用，加快运行速度。该类在VB进行内存搜索等方面的应用上有较好的性能表现。当然，在类中也使用了CopyMemory，但只用来构造数组而已，并没有作大量的数据调动。

    好了，废话少好，言归正转，先建一个名为VbArrayPtr的类，代码如下：

Option Explicit

'自定义的数组类型枚举

Public Enum vbArray_Type

vbArrayByte = vbByte Or vbArray '1Bytes

vbArrayInteger = vbInteger Or vbArray '2Bytes

vbArrayLong = vbLong Or vbArray '4Bytes

vbArrayCurrency = vbCurrency Or vbArray '8Bytes

End Enum

Private Type SAFEARRAYBOUND

cElements As Long '这一维有多少个元素？

lLbound As Long '它的索引从几开始？

End Type

Private Const MAX_DIMS = 0 '数组最大维数为1维(下标为0)

Private Type SAFEARRAY '安全数组结构定义

cDims As Integer '维数

fFeatures As Integer '标志

cbElements As Long '单个元素的字节数

clocks As Long '锁定计数

pvData As Long '指向数组元素的指针

rgsabound(MAX_DIMS) As SAFEARRAYBOUND '定义维数边界

End Type

Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Const FADF_AUTO = &H1 '在栈上创建数组

Private Const FADF_STATIC = &H2 '在堆上创建数组

Private Const FADF_EMBEDDED = &H4 '在结构中创建

Private Const FADF_FIXEDSIZE = &H10 '不能改变数组大小

Private Const FADF_RECORD = &H20 '记录容器

Private Const FADF_HAVEIID = &H40 '有IID 身份标记 数组

Private Const FADF_HAVEVARTYPE = &H80 'VT 类型数组

Private Const FADF_BSTR = &H100 'BSTR数组

Private Const FADF_UNKNOWN = &H200 'IUnknown* 数组

Private Const FADF_DISPATCH = &H400 'IDispatch* 数组

Private Const FADF_VARIANT = &H800 'VARIANTs数组

Private Const FADF_RESERVED = &HF0E8 '保留，将来使用

Private Type MEMORY_BASIC_INFORMATION

BaseAddress As Long

AllocationBase As Long

AllocationProtect As Long

RegionSize As Long

State As Long

Protect As Long

lType As Long

End Type

Private Declare Function VirtualQueryEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long) As Long

Private Const PAGE_READONLY = &H2 '只读属性，如果试图进行写操作，将引发访问违规。如果系统区分只读、执行两种属性，那么试图在该区域执行代码也将引发访问违规

Private Const PAGE_READWRITE = &H4 '允许读写

Private Const PAGE_EXECUTE_READ = &H20 '允许读和执行代码

Private Const PAGE_EXECUTE_READWRITE = &O40 '允许读和执行代码

Dim m_pvArray() As Variant '通用指针数组

Dim m_nCountRef As Long '引用计数

'将一个VB一维数组绑定指定的内存地址上

Public Function Bind(ByVal lpMemoryAddress As Long, dwBytes As Long, Optional ByVal vtType As vbArray_Type = vbByte) As Variant

Dim SA As SAFEARRAY

'置默认返回值为Empty

Bind = Empty

'判断字节数是否合法

If dwBytes <= 0 Then Exit Function

'判断内存是否可读

Dim hProcess As Long

Dim MBI As MEMORY_BASIC_INFORMATION

Dim MBI_SIZE As Long

MBI_SIZE = Len(MBI)

hProcess = GetCurrentProcess()

If VirtualQueryEx(hProcess, lpMemoryAddress, MBI, MBI_SIZE) <> MBI_SIZE Then '函数运行失败

Exit Function

End If

If Not (((MBI.Protect And PAGE_READONLY) = PAGE_READONLY) Or ((MBI.Protect And PAGE_READWRITE) = PAGE_READWRITE) Or ((MBI.Protect And PAGE_EXECUTE_READ) = PAGE_EXECUTE_READ) Or ((MBI.Protect And PAGE_EXECUTE_READWRITE) = PAGE_EXECUTE_READWRITE)) Then

Exit Function

End If

'构造一个一维数组

Dim cbElem As Long

cbElem = Switch(vtType = vbArrayByte, 1, vtType = vbArrayInteger, 2, vtType = vbArrayLong, 4, vtType = vbArrayCurrency, 8)

SA.cDims = 1

SA.fFeatures = FADF_AUTO Or FADF_EMBEDDED Or FADF_FIXEDSIZE

SA.cbElements = cbElem

SA.clocks = 0

SA.pvData = lpMemoryAddress '真实数组(非安全数组结构)的地址(可用VarPtr(数组首个成员变量)获取)或指定内址地址，注意：绝对不能使用VarPtrArray获取地址

SA.rgsabound(0).cElements = dwBytes / cbElem '按数组单个元素的大小对齐

SA.rgsabound(0).lLbound = 0

'设置pV的数据类型为安全数组

m_nCountRef = m_nCountRef + 1

If m_nCountRef > UBound(m_pvArray) Then

ReDim Preserve m_pvArray(UBound(m_pvArray) + 10) '以10递增扩展VARIANT类型的指针数组

End If

'绑定数组到一个VARIANT变量上

Dim pSV As Long

Dim pSA As Long

pSA = VarPtr(SA)

pSV = VarPtr(m_pvArray(m_nCountRef))

CopyMemory ByVal pSV, vtType, 2

CopyMemory ByVal pSV + 8, pSA, 4

Bind = m_pvArray(m_nCountRef)

End Function

'此函数释放未被使用的m_pV数组的成员变量，并减少引用计数

Public Function UnBind(ByRef pvSA As Variant) As Boolean

Dim lpMemoryAddress As Long

On Error GoTo ErrHandle

If (VarType(pvSA) And vbArray) = vbArray Then '说明参数为数组

'获得数组的下标和维数

lpMemoryAddress = VarPtr(pvSA(0))

Else

If VarType(pvSA) = vbLong Then '说明参数为地址

End If

End If

ErrHandle:

End Function

Private Sub Class_Initialize()

m_nCountRef = 0

ReDim m_pvArray(1 To 10) '为了减少内存调整，预定义10个VARIANT类型的指针

End Sub

Private Sub Class_Terminate()

Dim i As Long

Dim pSV As Long

pSV = VarPtr(m_pvArray(1))

For i = 1 To m_nCountRef

CopyMemory ByVal pSV + 8 + (i - 1) * 16, 0&, 4

Next

Erase m_pvArray

End Sub

    调用代码如下：

Option Explicit

Sub main()

Dim s As String

Dim vbptr As New VbArrayPtr

Dim p As Variant

Dim i As Integer

s = "我爱你中国"

p = vbptr.Bind(StrPtr(s), LenB(StrConv(s, vbFromUnicode)), vbArrayInteger)

For i = 0 To UBound(p)

Debug.Print p(i)

Next

vbptr.UnBind (p)

End Sub

    如果用ReadProcessMemory取得的内存指针，亦可直接用vbptr.Bind绑定到一个数组即可，不用再将该指针指向的内容复制到本地，速度自然加快了不少。