一個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綁定到一個數組即可，不用再将該指針指向的内容複制到本地，速度自然加快了不少。