标题: VB6拾遗：更高效的数组
作者: Demon
链接: https://demon.tw/programming/vb6-repick-efficient-array.html
版权: 本博客的所有文章，都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。
了解数组的内部实现，是为了更高效地利用数组。
首先要知道如何获取数组变量的地址，VarPtr函数不支持数组变量作为参数，所以要自己Declare一个：
Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
(ByRef Ptr() As Any) As Long
Sub Main()
Dim a(10) As Long
Debug.Print Hex$(VarPtrArray(a))
End Sub
但是这个函数不能用于字符串数组，因为字符串数组在调用该函数之前会将Unicode字符串转成ANSI字符串，用该函数获取到的是ANSI字符串数组的地址。
Sub Main()
Dim a(10) As String
Debug.Print Hex$(VarPtrArray(a))
End Sub
生成的汇编代码如下：
00401721 push 8 ; 构造ANSI数组 00401723 push 004013B4 ; 00401728 lea eax, [ebp-78] ; ANSI数组地址 0040172B push eax ; 0040172C call <jmp.&MSVBVM60.__vbaAryConstruct2> ; MSVBVM60.__vbaAryConstruct2 00401731 push 8 ; 构造Unicode数组 00401733 push 004013B4 ; 00401738 lea eax, [ebp-28] ; Unicode数组地址 0040173B push eax ; 0040173C call <jmp.&MSVBVM60.__vbaAryConstruct2> ; MSVBVM60.__vbaAryConstruct2 00401741 lea eax, [ebp-78] ; Unicode转ANSI 00401744 mov dword ptr [ebp-58], eax ; 00401747 lea eax, [ebp-28] ; 0040174A push eax ; 0040174B lea eax, [ebp-58] ; 0040174E push eax ; 0040174F call <jmp.&MSVBVM60.__vbaStrAryToAnsi> ; MSVBVM60.__vbaStrAryToAnsi 00401754 push eax 00401755 call 00401380 ; 调用VarPtrArray 0040175A mov dword ptr [ebp-60], eax 0040175D call <jmp.&MSVBVM60.__vbaSetSystemError> ; MSVBVM60.__vbaSetSystemError 00401762 lea eax, [ebp-28] ; ANSI转Unicode 00401765 mov dword ptr [ebp-5C], eax ; 00401768 lea eax, [ebp-78] ; 0040176B push eax ; 0040176C lea eax, [ebp-5C] ; 0040176F push eax ; 00401770 call <jmp.&MSVBVM60.__vbaStrAryToUnicode> ; MSVBVM60.__vbaStrAryToUnicode
要获取字符串数组的地址，不得不动用TLB（Type Library）：
[
uuid(C6799410-4431-11d2-A7F1-00A0C91110C3),
]
library PtrLib
{
[dllname("msvbvm60.dll")]
module ArrayPtr
{
[entry("VarPtr")]
long _stdcall VarPtrStringArray([in] SAFEARRAY (BSTR) *Ptr);
}
}
用midl.exe编译后在VB中添加引用即可使用VarPtrStringArray函数获取字符串数组的地址。
得到了数组的地址之后，就可以做一些有趣的事情，比如说自己人工构造数组：
Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
cElements As Long
lLbound As Long
End Type
Const FADF_AUTO As Long = &H1
Const FADF_FIXEDSIZE As Long = &H10
Sub Main()
Dim lVar As Long
Dim Bytes() As Byte
Dim SABytes As SAFEARRAY1D
With SABytes
.cDims = 1
.cbElements = 1
.cElements = 4
.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
.pvData = VarPtr(lVar)
End With
CopyMemory ByVal VarPtrArray(Bytes), VarPtr(SABytes), 4
Bytes(0) = &H12
Bytes(1) = &H34
Bytes(2) = &H56
Bytes(3) = &H78
Debug.Print Hex$(lVar)
End Sub
Dim Bytes()不会实际构造出数组的SAFEARRAY结构，而只是在堆栈上分配了一个NULL指针而已，然后我们自己构造了SAFEARRAY结构，用CopyMemory将Bytes指针指向我们的SAFEARRAY结构。
这一切都是在堆栈上进行的，没有涉及到堆上的内存分配和销毁，所以效率要比使用VB数组高一些。效率是次要的，关键是我们拥有了用数组来操作任意内存的能力，只要将pvData指向目标内存地址即可（前提是对该内存拥有读写权限），这将大大提高VB代码的灵活性。
再举一个例子，VB中的UCase函数可以将字符串改成大写，但是该函数并不是直接修改原字符串，而是拷贝一份以后再修改并返回该拷贝，所以也涉及到内存分配，当字符串较大时不少时间浪费在内存分配与拷贝上。运用上面的技巧，我们可以自己实现一个In-place版的函数（简单起见只考虑26个字母）：
Sub Main()
Dim s As String
s = "https://demon.tw"
StrToUpper s
Debug.Print s
End Sub
Sub StrToUpper(ByRef s As String)
Dim i As Long
Dim Ints() As Integer
Dim SAInts As SAFEARRAY1D
With SAInts
.cDims = 1
.cbElements = 2
.cElements = Len(s)
.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
.pvData = StrPtr(s)
End With
CopyMemory ByVal VarPtrArray(Ints), VarPtr(SAInts), 4
For i = LBound(Ints) To UBound(Ints)
If Ints(i) > &H61 And Ints(i) < &H7A Then
Ints(i) = Ints(i) - &H20
End If
Next
End Sub
赞赏
微信赞赏
支付宝赞赏
随机文章: