通过伪造数组在VB中使用"指针"

仙剑魔

如果你发现以下代码运行结果为FLASE，那么后面的内容全都不用看了，因为都是错的

1. 
   
2. Dim s() As String
   
3. ReDim s(1000)
   
4. Dim i As Long
   
5. For i = 0 To 1000
   
6. s(i) = i
   
7. Next
   
8. Dim j As Long
   
9. j = StrPtr(s(0))
   
10. ReDim Preserve s(500)
    
11. ReDim Preserve s(1000)
    
12. Dim k As Long
    
13. k = StrPtr(s(0))
    
14. MsgBox j = k
    

复制代码

如果以上代码运行结果为TRUE，那么我们能得到一个结论：
string数组在用Preserve重定义大小时，不会拷贝整个字符串，他只是拷贝了一个指针
稍后我会讲解BSTR的结构，你就知道怎么回事了

如同标题说的，我们需要伪造一个数组来实现类似指针的功能
例如dim a() as long
赋予他一个地址后x，我们可以通过下标来访问对应位置的内容a(1)=5 '地址为x+4开始的4字节被修改
但是a()并不是一个真正的指针，中间还是有些区别
这样使用只是为了处理大片连续的数据不需要反复copymemory而已

要想伪造一个数组，就必须清楚数组真实的结构（这里特指动态数组）
vb的数组（例如dim a() as long），a存的其实是一个地址，而这个地址的位置存着一个SAFEARRAY结构

1. 
   
2. Private Type SAFEARRAY
   
3.     cDims As Integer         '这个数组有几维？
   
4.     fFeature As Integer      '这个数组有什么特性？
   
5.     cbElements As Long       '数组的每个元素有多大？
   
6.     cLocks As Long           '这个数组被锁定过几次？
   
7.     pvData As Long           '这个数组里的数据放在什么地方？
   
8.     'rgsabound() As SFArrayBOUND
   
9. End Type
   

复制代码

而SAFEARRAY的末尾有若干个SFArrayBOUND结构，视数组维度而定

1. 
   
2. Private Type SFArrayBOUND
   
3.     cElements As Long        '这一维有多少个元素？
   
4.     lLbound As Long          '它的索引从几开始？
   
5. End Type
   

复制代码

而真正指向数据缓冲区的是SAFEARRAY里的pvData （如图）

要伪造一个数组，就必须伪造SFArrayBOUND和SFArrayBOUND结构

仙剑魔

伪造数组并不难，难的是维护伪造出来的数据
直接声明dim temp as SAFEARRAY是不现实的，因为出了作用域就被释放了
HeapAlloc之类的固然可以，但是我不喜欢用太多API
于是就要用到开头的那个结论了
把数据存在字符串里，哈哈
vb的string其实存的也是个地址，地址位置的内容是一个BSTR结构，头部是4字节表示长度，后面跟着缓冲区

所以preserve的时候，VB没有去动BSTR的数据，而是直接拷贝了地址
代码如下:
使用方法

1. 
   
2. Option Explicit
   
3. 
   
4. Private Sub Form_Load()
   
5. Dim a() As Long
   
6. Dim b As Long
   
7. 
   
8. Dim c() As Long
   
9. Dim d As Long
   
10. Call CallPtrProc(AddressOf SetPtrProc, a, VarPtr(b), LenB(b), &H7FFFFFFF)
    
11. Call CallPtrProc(AddressOf SetPtrProc, c, VarPtr(d), LenB(d), &H7FFFFFFF)
    
12. a(0) = 6
    
13. 
    
14. Call CallPtrProc(AddressOf ClearPtrProc, a, 1)
    
15. c(0) = 7
    
16. Call CallPtrProc(AddressOf ClearPtrProc, c, 1)
    
17. 
    
18. End Sub
    

复制代码

模块代码

1. 
   
2. Option Explicit
   
3. 
   
4. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
5. Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
   
6. Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
   
7. 
   
8. 'Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   
9. Public Declare Function CallPtrProc Lib "user32" Alias "CallWindowProcA" (ByVal Func As Long, ByRef PPtr() As Any, Optional ByVal Param1 As Long = 0, Optional ByVal Param2 As Long = 0, Optional ByVal Param3 As Long = 0) As Long
   
10. 
    
11. 
    
12. Private Type SAFEARRAY_KAI   'SAFEARRAY_改
    
13.     cDims As Integer         '这个数组有几维？
    
14.     fFeature As Integer      '这个数组有什么特性？
    
15.     cbElements As Long       '数组的每个元素有多大？
    
16.     cLocks As Long           '这个数组被锁定过几次？
    
17.     pvData As Long           '这个数组里的数据放在什么地方？
    
18.     'rgsabound() As SFArrayBOUND
    
19.     cElements As Long        '这一维有多少个元素？
    
20.     lLbound As Long          '它的索引从几开始？
    
21.    
    
22.     hHandle As Long
    
23. End Type
    
24. 
    
25. Private Buffer() As String
    
26. Private Count As Long
    
27. 
    
28. Public Sub SetPtrProc(ByVal PPtr As Long, _
    
29.                       ByVal Address As Long, _
    
30.              Optional ByVal ElementSize As Long = 4, _
    
31.              Optional ByVal ElementCount As Long = &H7FFFFFFF)
    
32.     Dim SA As SAFEARRAY_KAI
    
33.     Count = Count + 1
    
34.     With SA
    
35.         .cDims = 1
    
36.         .fFeature = 0
    
37.         .cbElements = ElementSize
    
38.         .cLocks = 0
    
39.         .pvData = Address
    
40.         .cElements = ElementCount
    
41.         .lLbound = 0
    
42.         .hHandle = Count
    
43.     End With
    
44.     ReDim Preserve Buffer(0 To Count)
    
45.     Buffer(Count) = String(Len(SA) \ 2, 0)
    
46.     Call CopyMemory(ByVal StrPtr(Buffer(Count)), SA, Len(SA))
    
47.     Call CopyMemory(ByVal PPtr, StrPtr(Buffer(Count)), 4)
    
48. End Sub
    
49. 
    
50. Public Sub ClearPtrProc(ByVal PPtr As Long, _
    
51.                Optional ByVal RemoveAll As Long = 0, _
    
52.                Optional ByVal Reserve1 As Long = 0, _
    
53.                Optional ByVal Reserve2 As Long = 0)
    
54.     'Debug.Print StrPtr(Buffer(1))
    
55.     Dim SA As SAFEARRAY_KAI
    
56.     Dim PSA As Long
    
57.     Dim i As Long
    
58.     Call CopyMemory(PSA, ByVal PPtr, 4)
    
59.     Call CopyMemory(SA, ByVal PSA, Len(SA))
    
60.     i = SA.hHandle
    
61.     Call CopyMemory(SA, ByVal StrPtr(Buffer(Count)), Len(SA))
    
62.     SA.hHandle = i
    
63.     Call CopyMemory(ByVal StrPtr(Buffer(Count)), SA, Len(SA))
    
64.     Call SwapString(Buffer(i), Buffer(Count))
    
65.     Count = Count - 1
    
66.     Call ZeroMemory(ByVal PPtr, 4)
    
67.    
    
68.     If RemoveAll Then
    
69.         'Dim SA As SAFEARRAY_KAI
    
70.         'Dim i As Long
    
71.         'Dim Offset As Long
    
72.         'Offset = VarPtr(SA.hHandle) - VarPtr(SA)
    
73.         'For i = Count To 1 Step -1
    
74.         '    Call CopyMemory(SA, ByVal StrPtr(Buffer(i)), Len(SA))
    
75.         '    If SA.hHandle = PPtr Then
    
76.         '        Call SwapString(Buffer(i), Buffer(Count))
    
77.         '        Count = Count - 1
    
78.         '    End If
    
79.         'Next
    
80.         ReDim Preserve Buffer(0 To Count)
    
81.     End If
    
82. End Sub
    
83. 
    
84. Public Sub IncPtrProc(ByVal PPtr As Long, _
    
85.              Optional ByVal Reserve1 As Long = 0, _
    
86.              Optional ByVal Reserve2 As Long = 0, _
    
87.              Optional ByVal Reserve3 As Long = 0)
    
88.     Dim SA As SAFEARRAY_KAI
    
89.     Dim PSA As Long
    
90.     Call CopyMemory(PSA, ByVal PPtr, 4)
    
91.     Call CopyMemory(SA, ByVal PSA, Len(SA))
    
92.     SA.pvData = SA.pvData + SA.cbElements
    
93.     Call CopyMemory(ByVal PSA, SA, Len(SA))
    
94. End Sub
    
95. 
    
96. 
    
97. Private Sub SwapString(ByRef s1 As String, ByRef s2 As String)
    
98.     Dim t As Long
    
99.     Call CopyMemory(t, ByVal VarPtr(s1), 4)
    
100.     Call CopyMemory(ByVal VarPtr(s1), ByVal VarPtr(s2), 4)
     
101.     Call CopyMemory(ByVal VarPtr(s2), t, 4)
     
102. End Sub
     

复制代码

整合一个新结构SAFEARRAY_KAI，所有的数据都以他为模板
每次申请新指针，buffer的下标count都+1
释放时交换释放位置和末尾的string（其实换的是指针）
至于为什么用CallWindowProc ？
好吧，那是为了用any绕过类型检查。。。
PS:
IncPtrProc是把指针往后移...
ElementCount 用&h7fffffff是为了避免VB的数组越界检查，当然你也可以为了防止指针越界自己定个大小

菜鸟学飞

我是这样子定义的 把他们绑一堆去
Public Type Plong
    pData() As long
    safearray As rawSAFEARRAY
End Type
直接 pData 指向 safearray
这样子safearray生命周期跟随pData,管理比较方便...

阿富

水很深，学习

tlwh163

我是这样构想的:

Private Declare Function VarPtrArray Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Pot0 As Integer, Pot1 As Integer, Pot2 As Long, Pot3 As Long, Pot As Long  'Pot用来指示目标地址
Public Pws As Long, Pot6 As Long, Pot7 As Long, Pot8 As Long, Pw() As Byte
'Pws用来设置需要多少个字节 Pw()用来覆盖目标内存
'使用的时候：Pot=Varptr(AnyAddress): Pws=xxx: Pw(Idx)=nnn

'====== 下面开始的2个函数 是做 指针变量 需要的 ================
Private Sub LinkPot2Pw() '构造一个指针变量 (Pot 和 Pw()) 配对
    ReDim Pw(0)
    MemCopy Pot7, VarPtrArray(Pw), 4&
    MemCopy Pot8, ByVal Pot7, 4&
    MemCopy Pot0, ByVal Pot8, 24&
    MemCopy ByVal Pot7, VarPtr(Pot0), 4&
End Sub

Private Sub FreePot2Pw() '释放 (Pot 和 Pw())
    MemCopy ByVal Pot7, Pot8, 4&
End Sub '====== 指针变量 结束 =================================