VB/VBA安全数组（SafeArray）研究
Private Type VariantAPI'Variant(): vt=8204(vbVariant or vbArray)'数组为单元格区域直接赋值时,类型为Variant() vt As Integer '类型，2字节 wReserved1 As Integer wReserved2 As Integer wReserved3 As Integer dwReserved1 As Long '数据 dwReserved2 As LongEnd TypePrivate Type SFArrayBOUND cElements As Long '这一维元素数量 lLbound As Long '索引开始值，即LBOUND值End TypePrivate Type SAFEARRAY cDims As Integer '数组维数 fFeature As Integer '数组特性 cbElements As Long '数组元素字节数 cLocks As Long '锁定次数 pvData As Long '数组数据指针 rgsabound() As SFArrayBOUNDEnd TypeConst VT_BYREF = &H4000Private Declare Function ppVariantArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr As Any) As LongPrivate Declare Function ppArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As LongPrivate Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByVal pSA As Long) As LongPrivate Declare Function SafeArrayLock Lib "oleaut32.dll" (ByVal pSA As Long) As LongPrivate Declare Function SafeArrayUnlock Lib "oleaut32.dll" (ByVal pSA As Long) As LongPrivate Declare Function SafeArrayAccessData Lib "oleaut32.dll" (ByVal pSA As Long, ppVdata As Long) As LongPrivate Declare Function SafeArrayUnaccessData Lib "oleaut32.dll" (ByVal pSA As Long) As LongPrivate Declare Function SafeArrayGetElemsize Lib "oleaut32.dll" (ByVal pSA As Long) As LongPrivate Sub MAIN() Dim v As VariantAPI, v1 As VariantAPI Dim sfArray As SAFEARRAY, sfArray1 As SAFEARRAY, sfArray2 As SAFEARRAY, sfArray3 As SAFEARRAY Dim pSA As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim arr0, arrr0(5) As Long ReDim arr0(5) As Long '元素为long类型 For i = 0 To UBound(arr0) arr0(i) = i Next '元素为long pSA = GetSafeArrayPointer(arr0) sfArray = GetSafeArray(pSA) 'copy数组 CopyArray VarPtr(arrr0(0)), sfArray.pvData, 4, 6'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''单元格数据数组 Dim arr1, arrr1(3) As Variant arr1 = [a1:b2] '元素为variant类型 pSA = GetSafeArrayPointer(arr1) sfArray = GetSafeArray(pSA) 'copy数组 CopyArray VarPtr(arrr1(0)), sfArray.pvData, 16, 4 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim ppVdata As Long r = SafeArrayAccessData(ByVal pSA, ppVdata) '这里ppvdata==sfArray.pvData r = SafeArrayUnaccessData(ByVal pSA)'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''数组的访问方式 Dim arr3() As Long, arrr3(12) As Long ReDim arr3(12) For i = 0 To UBound(arr3) arr3(i) = i Next '方式一： pSA = GetSafeArrayPointer(arr3) sfArray1 = GetSafeArray(pSA) '方式二：效果同方式一 Dim pArray As Long pArray = GetPointerFromPP(ppArray(arr3)) sfArray2 = GetSafeArray(pArray) '方式三：建议用方式一，ppvdata为数组数据指针 r = SafeArrayAccessData(pArray, ppVdata) r = SafeArrayUnaccessData(pArray)'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '复制字符串数组 Dim arr4() As String, arrr4(12) As String ReDim arr4(12) For i = 0 To UBound(arr4) arr4(i) = "s" & i Next pSA = GetSafeArrayPointer(arr4) sfArray = GetSafeArray(pSA) CopyArray VarPtr(arr4(0)), sfArray.pvData, 4, 13End SubPrivate Sub CopyArray(pDestinationArrayElement As Long, pSourceArrayElement As Long, cbElement As Long, iCount As Long) CopyMemory ByVal pDestinationArrayElement, ByVal pSourceArrayElement, iCount * cbElementEnd SubPrivate Function GetArrayDim(pArray As Long) As Long GetArrayDim = SafeArrayGetDim(pArray)End Function'解引用Private Function GetPointerFromPP(pPointer As Long) As Long CopyMemory GetPointerFromPP, ByVal pPointer, 4End FunctionPrivate Function GetVariant(arr) As VariantAPI CopyMemory GetVariant, (arr), LenB(GetVariant) PrintVar GetVariantEnd FunctionPrivate Function GetSafeArrayPointer(arr) As Long Dim v As VariantAPI CopyMemory v, ByVal VarPtr(arr), LenB(v) If CBool(v.vt And VT_BYREF) Then CopyMemory GetSafeArrayPointer, ByVal v.dwReserved1, 4 Else GetSafeArrayPointer = v.dwReserved1 End IfEnd FunctionPrivate Function GetSafeArray(pSafeArray As Long) As SAFEARRAY Dim v As VariantAPI, pSA As Long CopyMemory GetSafeArray, ByVal pSafeArray, ByVal (LenB(GetSafeArray) - 4) ReDim GetSafeArray.rgsabound(GetSafeArray.cDims - 1) CopyMemory GetSafeArray.rgsabound(0), ByVal pSafeArray + 16, GetSafeArray.cDims * 8' PrintSAFEARRAY GetSafeArrayEnd Function
