用 CopyMemory 拷贝 Type 为何会死机 ?

[bobogg]

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

Private Type QQ
v1 As Long
a() As Long
b() As Long
End Type

Private Sub Form_Load()

Dim a As QQ
Dim b As QQ

Call Redim_QQ(a)

Select Case 1

Case 1: CopyMemory VarPtr(b), VarPtr(a), Len(a) ' 只是要复制指针所以速度快

Case 2: Copy_QQ b, a

Case 3: b = a ' 这当然一定 ok, 但是复制次数一多会慢很多, 因为它一值重新配置 Array() + 复制

End Select


With b

For w = 1 To 10
Debug.Print .a(w) ' 全部 ok, 都可以看到正确数值
Next
End With

' 惟独 跳出 sub 时会死机

End Sub

Private Sub Copy_QQ(Store As QQ, Src As QQ)
CopyMemory VarPtr(Store), VarPtr(Src), Len(Src)
End Sub
Private Sub Redim_QQ(b As QQ)
With b
ReDim .a(1 To 10)
ReDim .b(1 To 10)

For w = 1 To 10
.a(w) = w
.b(w) = w + 10
Next
End With

End Sub

[Jia_H]

b看起来没有初始化呀，内存中指到哪里去了。用API涉及到地址、指针的地方一定要小心，否则很容易出问题的。

[嗷嗷叫的老马]

结构中的数组,CopyMemory函数并不能识别,因此复制的仅是数组的指针,却没有复制实际上数组的内容.

我没有跟踪以确认,不过从现象来看,虽然你能从第二个结构中正确读到内容,但那些内容全是指向第一个结构中的实际数据区的,所以在退出时,第一个结构变量的内存区域被回收了两次,导致出错.

因此,我认为在复制之后,查看结构A与结构B中数组元素的地址时,会发现是一样的,试试如下代码:

debug.paint hex(varptr(a.a(1))),hex(varptr(b.a(1)))

因为CopyMemory会认为你的结构是这样的:

Private Type QQ
   v1 As Long
   a As Long
   b As Long
 End Type

所以调用CopyMemory后,第二个结构变量中三个成员的值与第一个会是一样.

而V1本身就是值,因此地址不会一样,但值会一样.

至于A()与B()数组,直接就是指向了第一个结构变量中的内存区域了.

因此在退出时,VB自动回收了第一个结构变量的空间,但是在回收第二个结构变量的空间时,却又回收了刚刚才回收过的内存区域,所以肯定会挂的.

要想让它能工作,还是要自己处理数组.

不然就还是老实地用VB的等于号吧,嘿嘿.

[Jia_H]

好好看看CopyMemory API的说明吧。你的做法符合要求吗，和你想要的结果一致吗？

[bobogg]

谢谢老马回覆

(1)

我正是只要复制指针, 不想复制内容, 要复制内容就得配置内存

配置内存次数一旦过多, 会大幅影响速度

如果写成

Sub test ( b as QQ )

End Sub

改用 sub 来传, 这个 b 就是个指针

我原本目的就是想如上 sub 一样仿造指针 (并非想复制一份新的)

所以用 CopyMemory VarPtr(b), VarPtr(a), Len(a) 来试试看



(2)

老马的答案应该正确

因此在退出时,VB自动回收了第一个结构变量的空间,但是在回收第二个结构变量的空间时,却又回收了刚刚才回收过的内存区域,所以肯定会挂的.


不过 VB 不是有自己的内存管理器吗 ?
当 管理器查寻纪录表 时
正当第2次要重复释放时
应该就会发现纪录表里面早已经不存在这个内存区域配置的纪录
为何不会自动跳过 ? ( 如果有自动忽略 , 就不会死机 )

内存管理器查询 结构变量a 所指的内存位置 ---> 找到配置纪录 ---> 释放内存
内存管理器查询 结构变量b 所指的内存位置 ---> 找不到配置纪录(因为上面已经被释放) ---> 不執行释放

[嗷嗷叫的老马]

[Quote=引用 3 楼 的回复:]
不过 VB 不是有自己的内存管理器吗 ?
[/Quote]
确实是有,而且几乎不会出错.

但这是有条件的,条件就是要使用VB的内存管理接口来操作内存,比如REDIM分配数组空间,ERASE清除数组空间等.

而你使用的是COPYMEMORY,绕过了VB的内存管理机制,就好象你吃饭时站起来夹了一下菜,我却在你坐下时突然把凳子抽走.....

按你自己的"凳子管理机制",你的凳子一定是在你PP下面的,但是我绕过了你的"凳子管理机制",在你不知道的情况下操作了你的凳子,那么接下来,你会怎么样呢

[嗷嗷叫的老马]

扯远了,还是说你的问题吧.

现在的问题是,你需要快速复制自定义结构,这可以实现,只是有使用上的限制.

限制就是需要手工针对自定义结构进行代码编写,就是说,对于每个自定义类型中的成员针对性地写代码复制.

拿你的类型来说,就得这么写:

private sub CopyMyType(byref inType as qq,byref outType as qq)
    with outtype
        .v1=intype.v1

        redim .a(ubound(intype.a))
        call copymemory(byval varptr(.a(0)),byval varptr(intype.a(0)),ubound(intype.a)+1)
        redim .b(ubound(intype.b))
        call copymemory(byval varptr(.b(0)),byval varptr(intype.b(0)),ubound(intype.b)+1)
    end with
end sub

如果想要无视结构具体元素成员,那就比较麻烦了,先要得到这个变量的地址,然后要分析结构,再分析出每一个成员的类型,然后使用针对性代码来进行复制.

这些需要仔细研究VB的自定义类型的内存结构才行,比较麻烦,我是没有研究过.

不过要是研究出来后,就可以写一个万能的自定义结构快速复制了.

加油加油!

另外,我做了一个速度测试代码:

Option Explicit
 
 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
 Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
 
 Private Type QQ
     V1 As Long
     a() As Long
     b() As Long
 End Type
 
 Private Const nCount As Long = 1000
 Private Const nCount2 As Long = 50000
 
 Dim V1() As QQ, V2() As QQ
 
 Private Sub CopyMyType(ByRef inType As QQ, ByRef outType As QQ)
     With outType
         .V1 = inType.V1
 
         ReDim .a(UBound(inType.a))
         Call CopyMemory(ByVal VarPtr(.a(0)), ByVal VarPtr(inType.a(0)), UBound(inType.a) + 1)
         ReDim .b(UBound(inType.b))
         Call CopyMemory(ByVal VarPtr(.b(0)), ByVal VarPtr(inType.b(0)), UBound(inType.b) + 1)
     End With
 End Sub
 
 Private Sub Command1_Click()
     Dim nTM As Long
     
     nTM = GetTickCount
     V2() = V1()
     Print GetTickCount - nTM
 End Sub
 
 Private Sub Command2_Click()
     Dim nTM As Long, I As Long
         
     nTM = GetTickCount
     For I = 0 To nCount
         Call CopyMyType(V1(I), V2(I))
     Next
     Print GetTickCount - nTM
 End Sub
 
 Private Sub Form_Load()
     Dim I As Long, KK() As Long
     
     ReDim V1(nCount)
     ReDim V2(nCount)
     ReDim KK(nCount2)
     
     For I = 0 To nCount2
         KK(I) = I
     Next
     
     For I = 0 To nCount
         With V1(I)
             .V1 = I
             ReDim .a(nCount2)
             Call CopyMemory(ByVal VarPtr(.a(0)), ByVal VarPtr(KK(0)), nCount2 + 1)
             
             ReDim .b(nCount2)
             Call CopyMemory(ByVal VarPtr(.b(0)), ByVal VarPtr(KK(0)), nCount2 + 1)
         End With
     Next
 End Sub

[yachong]

进来学习一下，都是高人