我编写了一个VB-Class来提供数据表，它允许您处理类似于ADO记录集的二维数组（类型变体）中的数据。
为了提高处理速度，在向数组中添加记录，对数组进行排序（即在数组中移动记录）或从数组中读取记录时，我想使用Windows API的kernel32.dll的RtlMoveMemory例程。虽然我已经能够成功地在数组中移动记录，但是将数据写入数组的特定索引或从数组的特定索引读取数据似乎在某种程度上混合了进一步处理的数据。
我已经做了很多阅读以获得以下内容：
正如您将看到的，我的代码是链接号的改编。 3以上。我不是一个真正的专业人士，但我不是一个绝对的初学者，我必须错过一些东西，但我无法弄清楚是什么。
以下是今天的代码：
Option Explicit
Option Base 1
'#======================================================================================================================
'# References
'#======================================================================================================================
#If Win64 Then
Private Const PTR_LENGTH As Long = 8
Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#Else
Private Const PTR_LENGTH As Long = 4
Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
'#======================================================================================================================
'# API Constants, Enumerations & Types
'#======================================================================================================================
'Type Declarations needed for SafeArray hacks
'The bounds of the SafeArray
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type
Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type
'#======================================================================================================================
'# Private Variables
'#======================================================================================================================
Private m_List() As Variant ' The list array.
'#======================================================================================================================
'# Test Routines
'#======================================================================================================================
Private Sub MainTest()
Dim iIdx As Long
Dim aSingleRec() As Variant
Dim i As Long
LoadRange ActiveSheet.Range("dataInput")
DataRowMove 5, 2
DebugRecord 5
DebugRecord 2
ReDim aSingleRec(LBound(m_List, 1) To UBound(m_List, 1))
aSingleRec(1) = "Test Gender (m)"
aSingleRec(2) = "Steve"
aSingleRec(3) = "Rogers"
aSingleRec(4) = "425 Lafayette St"
aSingleRec(5) = 10003
aSingleRec(6) = "New York"
DataRowPush 4, aSingleRec
DebugRecord 4
DebugSingleRecord aSingleRec
aSingleRec(1) = "Test Gener (f)"
aSingleRec(2) = "Wanda"
aSingleRec(3) = "Maximoff"
aSingleRec(4) = "72 W 36th St"
aSingleRec(5) = 10018
aSingleRec(6) = "New York"
DataRowPush 6, aSingleRec
DebugRecord 6
DebugSingleRecord aSingleRec
aSingleRec = DataRowGet(7)
DebugSingleRecord aSingleRec
DumpToRange ActiveSheet, ActiveSheet.Cells(10, 2)
Debug.Print "Done..."
End Sub
Private Sub LoadRange(rInput As Range)
m_List = rInput
End Sub
Private Sub DumpToRange(TargetWorksheet As Worksheet, TargetCell As Range)
Dim iRow As Integer: iRow = TargetCell.Row
Dim iCol As Integer: iCol = TargetCell.Column
TargetWorksheet.Cells(iRow, iCol).Resize(UBound(m_List), UBound(m_List, 2)) = m_List
End Sub
Private Sub DebugRecord(iIdx As Long, Optional stInProcedure = "Main")
Dim i As Long
Debug.Print "---------------------------"
Debug.Print "Record " & iIdx & " (in Procedure '" & stInProcedure & "')" & vbCrLf
For i = 1 To UBound(m_List, 1)
Debug.Print vbTab & "Field " & i & "[" & TypeName(m_List(i, iIdx)) & "] -> " & m_List(i, iIdx)
Next i
Debug.Print vbCrLf
End Sub
Private Sub DebugSingleRecord(aRec() As Variant)
Dim i As Long
Debug.Print "---------------------------"
Debug.Print "Single Record " & vbCrLf
For i = 1 To UBound(aRec)
Debug.Print vbTab & "Field " & i & "[" & TypeName(aRec(i)) & "] -> " & aRec(i)
Next i
Debug.Print vbCrLf
End Sub
'#======================================================================================================================
'# Data Handling Routines
'#======================================================================================================================
Private Function DataRowGet(ByVal idxFrom As Long) As Variant()
Dim ptrToArrayVar As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrToArrayData2 As LongPtr
Dim uSAFEARRAY As SAFEARRAY1D
Dim ptrCursor As LongPtr
Dim cbElements As Long
Dim atsBound1 As Long
Dim elSize As Long
Dim aSingleRec() As Variant
Dim m_NumCols As Long
m_NumCols = UBound(m_List, 1)
ReDim aSingleRec(LBound(m_List, 1) To UBound(m_List, 1))
'determine bound1 of source array (ie row Count)
atsBound1 = m_NumCols
'get pointer to source array Safearray
ptrToArrayVar = VarPtrArray(m_List)
CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
'get the safearray structure
CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
'get the pointer to the data elemets
ptrToArrayData = uSAFEARRAY.pvData
'determine byte size of source elements
cbElements = uSAFEARRAY.cbElements
'get pointer to destination array Safearray
ptrToArrayVar = VarPtrArray(aSingleRec)
CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
ptrToArrayData2 = uSAFEARRAY.pvData
'determine elements size
elSize = m_NumCols
'determine start position of data in source array
ptrCursor = ptrToArrayData + (((idxFrom - 1) * atsBound1) * cbElements)
'Copy source array to destination array
CopyMemory ByVal ptrToArrayData2, ByVal ptrCursor, cbElements * elSize
DataRowGet = aSingleRec
ReDim aSingleRec(0 To 0)
End Function
Private Sub DataRowPush(ByVal idxTo As Long, ByRef sourceArray() As Variant)
Dim ptrToArrayVar As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrToArrayData2 As LongPtr
Dim uSAFEARRAY As SAFEARRAY1D
Dim ptrCursor As LongPtr
Dim ptrCursorSource As LongPtr
Dim cbElementsS As Long
Dim cbElementsT As Long
Dim atsBound1 As Long
Dim elSize As Long
Dim m_NumCols As Long
Dim aSingleRec() As Variant
aSingleRec = sourceArray
m_NumCols = UBound(m_List, 1)
'determine bound1 of source array (ie row Count)
atsBound1 = m_NumCols
'get pointer to target array Safearray
ptrToArrayVar = VarPtrArray(m_List)
CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
'get the safearray structure
CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
'get the pointer to the data elemets
ptrToArrayData = uSAFEARRAY.pvData
'determine byte size of source elements
cbElementsT = uSAFEARRAY.cbElements
'get pointer to source array Safearray
ptrToArrayVar = VarPtrArray(aSingleRec)
CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
'get the safearray structure
CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
'get the pointer to the data elemets
ptrToArrayData2 = uSAFEARRAY.pvData
'determine byte size of source elements
cbElementsS = uSAFEARRAY.cbElements
'determine elements size
elSize = m_NumCols
'determine start position of data in target array
ptrCursor = ptrToArrayData + (((idxTo - 1) * atsBound1) * cbElementsT)
'Copy source array to destination array
CopyMemory ByVal ptrCursor, ByVal ptrToArrayData2, cbElementsS * elSize
'Debugging only
DebugRecord idxTo, "DataRowPush"
End Sub
Private Sub DataRowMove(ByVal idxFrom As Long, ByVal idxTo As Long)
Dim ptrToArrayVar As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrToArrayData2 As LongPtr
Dim uSAFEARRAY As SAFEARRAY1D
Dim ptrCursorFrom As LongPtr
Dim ptrCursorTo As LongPtr
Dim cbElements As Long
Dim atsBound1 As Long
Dim elSize As Long
Dim m_NumCols As Long
m_NumCols = UBound(m_List, 1)
'determine bound1 of source array (ie row Count)
atsBound1 = m_NumCols
'get pointer to source array Safearray
ptrToArrayVar = VarPtrArray(m_List)
CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
'get the safearray structure
CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
'get the pointer to the data elemets
ptrToArrayData = uSAFEARRAY.pvData
'determine byte size of source elements
cbElements = uSAFEARRAY.cbElements
'determine elements size
elSize = m_NumCols
'determine start position of data source in array
ptrCursorFrom = ptrToArrayData + (((idxFrom - 1) * atsBound1) * cbElements)
'determine start position of data target in array
ptrCursorTo = ptrToArrayData + (((idxTo - 1) * atsBound1) * cbElements)
'Copy source array to destination array
CopyMemory ByVal ptrCursorTo, ByVal ptrCursorFrom, cbElements * elSize
End Sub
这导致以下输出：
---------------------------
Record 5 (in Procedure 'Main')
Field 1[String] -> Mr
Field 2[String] -> Peter
Field 3[String] -> Parker
Field 4[String] -> 401 7th Ave
Field 5[Double] -> 10001
Field 6[String] -> New York
---------------------------
Record 2 (in Procedure 'Main')
Field 1[String] -> Mr
Field 2[String] -> Peter
Field 3[String] -> Parker
Field 4[String] -> 401 7th Ave
Field 5[Double] -> 10001
Field 6[String] -> New York
---------------------------
Record 4 (in Procedure 'DataRowPush')
Field 1[String] -> Test Gender (m)
Field 2[String] -> Steve
Field 3[String] -> Rogers
Field 4[String] -> 425 Lafayette St
Field 5[Integer] -> 10003
Field 6[String] -> New York
---------------------------
Record 4 (in Procedure 'Main')
Field 1[String] -> Test Gender (m)
Field 2[String] -> Steve
Field 3[String] -> Field
Field 4[String] -> Field 4[String
Field 5[Integer] -> 10003
Field 6[String] -> New York
---------------------------
Single Record
Field 1[String] -> Test Gender (m)
Field 2[String] -> Steve
Field 3[String] -> Rogers
Field 4[String] -> 425 Lafayette St
Field 5[Integer] -> 10003
Field 6[String] -> New York
---------------------------
Record 6 (in Procedure 'DataRowPush')
Field 1[String] -> Test Gener (f)
Field 2[String] -> Wanda
Field 3[String] -> Maximoff
Field 4[String] -> 72 W 36th St
Field 5[Integer] -> 10018
Field 6[String] -> New York
---------------------------
Record 6 (in Procedure 'Main')
Field 1[String] -> Test Gener (f)
Field 2[String] -> Field
Field 3[String] -> Maximoff
Field 4[String] -> 72 W 36th St
Field 5[Integer] -> 10018
Field 6[String] -> New York
---------------------------
Single Record
Field 1[String] -> Test Gener (f)
Field 2[String] -> Wanda
Field 3[String] -> Maximoff
Field 4[String] -> 72 W 36th St
Field 5[Integer] -> 10018
Field 6[String] -> New York
---------------------------
Single Record
Field 1[String] -> Mr
Field 2[String] -> Bruce
Field 3[String] -> Banner
Field 4[String] -> 222 W 51st St
Field 5[Double] -> 10019
Field 6[String] -> New York
Done...
我的主要问题是'DataRowPush'，它在程序本身内似乎工作正常但是一旦程序返回到调用过程，目标数组的内容似乎就会改变。您可以在上面的记录4和6的调试输出中看到这一点。
类似地，当使用'DataRowGet'读取数据时，目标单维数组被正确填充，但似乎m_List（二维数组）中的原始数据似乎也被改变。用'DataRowGet'读取数据后记录没有。 7读作
Mr
Resize
6
Field 6
10019
Field 6[
在m_List中。感谢任何帮助如何更改我的代码以防止更改数据。