查看: 117  |  回复: 0
  VB6 更高效的数组
楼主
发表于 2024年11月13日 00:01

了解数组的内部实现,是为了更高效地利用数组。

首先要知道如何获取数组变量的地址,VarPtr函数不支持数组变量作为参数,所以要自己Declare一个:

Private 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

Private Sub Command1_Click()
    Main
End Sub

运行结果:

19F138

但是这个函数不能用于字符串数组,因为字符串数组在调用该函数之前会将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 LongDeclare 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 LongEnd TypeConst FADF_AUTO As Long = &H1Const FADF_FIXEDSIZE As Long = &H10Sub 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 = "http://manongku.com"
    StrToUpper s
    Debug.Print sEnd SubSub 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


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com