[求助]Variant数组变换时怎样才能不崩溃？

吕?布

看到论坛上的贴子，突然有个想法：数组可不可以只部分复制？数组可不可以随意变换维数？然后到网上找了一些资料。明确了两点：

1. Variant变量的前2字节保存其真实的类型，从第8字节后面用8个字节保存了数据的值，这个值对简单类型(长度小于等于8byte)便是真实的值,对串和数组等复杂类型,用这8byte的前4byte保存一个具体值的一个指针.

2. VB中的数组是全是安全数组(SAFEARRAY)结构.该结构的第13byte开始,用四个byte保存"真正"数组的地址,这个真数组是连续的.

拼了一些代码来部分拷贝数组的值.感觉简单的类型好象还好,一旦数组元素是字串或是Variant类型.Excel容易崩溃,有时一次没问题,多运行几次再保存便出现出现问题了.

 

Option Explicit

Private Type SAFEARRAY
    cDims As Integer        'Count of dimensions in this array.
    fFeatures As Integer    'Flags used by the SafeArray
    cbElements As Long      'Size of an element of the array.Does not include size of pointed-to data.
    cLocks As Long          'Number of times the array has been
    pvData As Long          'Pointer to the data.
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SafeArrayAccessData Lib "Oleaut32" (ByVal pSA As Long, pvData As Long) As Long
Private Declare Function SafeArrayUnaccessData Lib "Oleaut32" (ByVal pSA As Long) As Long

Sub Test2()
    Dim vArrSource(1 To 3, 1 To 3, 1 To 3)
    Dim i As Integer, j As Integer, k As Integer
    Dim vArrDest(1 To 30)
    Dim varSource As Variant
    Dim varDest As Variant
    Dim pSASource As Long   'Pointer to SAFEARRAY
    Dim hr As Long      'HRESULT
    Dim pDataSource As Long

    Dim pSADest As Long
    Dim pDataDest As Long


    'load up some test data
    For i = LBound(vArrSource, 1) To UBound(vArrSource, 1)
        For j = LBound(vArrSource, 2) To UBound(vArrSource, 2)
            For k = LBound(vArrSource, 3) To UBound(vArrSource, 3)
                vArrSource(i, j, k) = i & j & k
            Next k
        Next j
    Next i
    For i = LBound(vArrDest, 1) To UBound(vArrDest, 1)
        vArrDest(i) = i
    Next i

    'this creates a variant of subtype byte array (8209 according to vartype)
    varSource = vArrSource
    varDest = vArrDest

    Dim sa1 As SAFEARRAY
    Dim sa2 As SAFEARRAY

    'WARNING: You need to make sure Variant contains what is expected
    If InStr(1, TypeName(varSource), "()") Then   '是数组
        CopyMemory pSASource, ByVal VarPtr(varSource) + 8, 4    '取得variant变量的数据,这里是一个SAFEARRAY的指针
        CopyMemory sa1, ByVal pSASource, 16
        CopyMemory pSADest, ByVal VarPtr(varDest) + 8, 4
        CopyMemory sa2, ByVal pSADest, 16
        hr = SafeArrayAccessData(pSADest, pDataDest)
        hr = SafeArrayAccessData(pSASource, pDataSource)    'Now obtain a pointer to the array data
        If hr = 0 Then  'If function succeeded
            CopyMemory vArrDest(1), ByVal pDataSource + 3 * 16, 24 * 16    'WARNING: This code assumes at least 4 bytes of data,You should verify this first
            ' CopyMemory ByVal pDataDest, ByVal pDataSource + 3 * 16, 23 * 16
            Dim lTmp As Long
            CopyMemory lTmp, ByVal (sa1.pvData), 4
            Debug.Print VarPtr(vArrDest(1)), pDataDest, lTmp
            CopyMemory lTmp, ByVal (sa2.pvData), 4
            Debug.Print VarPtr(vArrSource(1, 1, 1)), pDataSource, lTmp
            hr = SafeArrayUnaccessData(pSASource)    'Release lock on SAFEARRAY
            hr = SafeArrayUnaccessData(pSADest)
        End If
    End If

    For i = LBound(vArrDest, 1) To UBound(vArrDest, 1)
        Debug.Print i, vArrDest(i)
    Next i
End Sub
ctG3uHZX.rar (117.64 KB, 下载次数: 1)

2010-1-26 16:29 上传

点击文件名下载附件
[求助]Variant数组变换时怎样才能不崩溃？

吕?布

我自已猜想是内存动态分配的原因,当应用CopyMemory时,内存已经变化了.感觉要锁定内存,但是好象用SafeArrayAccessData没有用,有个GloalLock函数不知是不是要使用

吕?布

路过的都发表一下意见啊

BJ

不懂VBA，路过帮顶

和气生财

路过，不过也只是路过而已，哈哈。连学习都不知道如何入手呢，，，，

amulee

确实是由于动态分配的原因，在进行Copymemory时由于内存溢出而导致崩溃。。。而与Copymemory无关。像下面的语句执行N次也没关系，因为内存进行了事先的分配。

Sub Test()
    Dim MyStr1 As Variant
    Dim MyStr2 As Variant
    MyStr1 = "amulee"
    MyStr2 = String$(6, 0)
    CopyMemory ByVal MyStr2, ByVal MyStr1, 6
    Debug.Print MyStr2
End Sub

另外，这个类似的功能用For Each....Next...应该也能实现吧

吕?布

QUOTE:

以下是引用amulee在2010-1-27 15:43:00的发言：

确实是由于动态分配的原因，在进行Copymemory时由于内存溢出而导致崩溃。。。而与Copymemory无关。像下面的语句执行N次也没关系，因为内存进行了事先的分配。

Sub Test()
    Dim MyStr1 As Variant
    Dim MyStr2 As Variant
    MyStr1 = "amulee"
    MyStr2 = String$(6, 0)
    CopyMemory ByVal MyStr2, ByVal MyStr1, 6
    Debug.Print MyStr2
End Sub

另外，这个类似的功能用For Each....Next...应该也能实现吧

如果把一个数组(2列)的值拷到另一个数组(10列)第5,6列，我觉得Copymemory可能真的比较方面便快速。另外我觉得好象真能实现。现在感觉是离成功只有一步之遥(差0.5步也是失败)

leolee82

可以直接copy吧，只要类型相同，数据段是连续的[em04]

leolee82

MSDN里有好多相关的数组操作函数

吕?布

QUOTE:

以下是引用leolee82在2010-1-27 20:25:00的发言：
可以直接copy吧，只要类型相同，数据段是连续的[em04]

老李，有没有拷贝多个数据但又不是整个数组的函数？我只查到整个数组的和某个元素的。