用 CopyMemory 拷贝 Type 为何会死机 ?
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
[最优解释]
结构中的数组,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
b看起来没有初始化呀,内存中指到哪里去了。用API涉及到地址、指针的地方一定要小心,否则很容易出问题的。
[其他解释]
谢谢老马回覆
(1)
我正是只要复制指针, 不想复制内容, 要复制内容就得配置内存
配置内存次数一旦过多, 会大幅影响速度
如果写成
Sub test ( b as QQ )
End Sub
改用 sub 来传, 这个 b 就是个指针
我原本目的就是想如上 sub 一样仿造指针 (并非想复制一份新的)
所以用 CopyMemory VarPtr(b), VarPtr(a), Len(a) 来试试看
(2)
老马的答案应该正确
因此在退出时,VB自动回收了第一个结构变量的空间,但是在回收第二个结构变量的空间时,却又回收了刚刚才回收过的内存区域,所以肯定会挂的.
不过 VB 不是有自己的内存管理器吗 ?
当 管理器查寻纪录表 时
正当第2次要重复释放时
应该就会发现纪录表里面早已经不存在这个内存区域配置的纪录
为何不会自动跳过 ? ( 如果有自动忽略 , 就不会死机 )
内存管理器查询 结构变量a 所指的内存位置 ---> 找到配置纪录 ---> 释放内存
内存管理器查询 结构变量b 所指的内存位置 ---> 找不到配置纪录(因为上面已经被释放) ---> 不執行释放
[其他解释]
好好看看CopyMemory API的说明吧。你的做法符合要求吗,和你想要的结果一致吗?
[其他解释]
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
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