揭秘编译器：Visual Basic 6.0 中的函数指针

Bogdan Apostol

4.97/5 (66投票s)

2007年6月18日

CPOL

26分钟阅读

153614

1264

使 Visual Basic 6 编写的应用程序能够使用函数指针，并展示如何嵌入原生代码。

下载示例源代码 - 24.5 KB

引言

本研究的目的是使使用Visual Basic 6编写的应用程序能够使用函数指针。还可以发现其他优点，例如在Visual Basic应用程序中嵌入本地代码，从而扩展了可能性，而无需外部DLL。为了尽可能地保持简洁明了，忽略了所用技术的其他变体，重点放在详细介绍一种处理更常见情况的方法。在阅读全面检查之前，我假设您想先看到一个可行的示例项目：NativeCode.zip。

由于指针通常不是Visual Basic 6特有的，所以在Visual Basic 6中谈论函数指针可能听起来很疯狂。那么，让我们首先看看在Visual Basic 6中通常如何获取函数指针。AddressOf运算符？是的，但不仅仅是它！还有来自kernel32.dll的GetProcAddress Win32 API，可以在运行时用于检索其他DLL导出的函数的地址。同样，也不仅仅是这个...还有其他情况！但是，当可以简单地使用Declare语句时，为什么要使用运行时加载呢？原因与C/C++程序员会使用的原因相同，例如，根据应用程序运行的环境使用不同的DLL（或相同DLL的版本）。

事实上，插件的整个概念都基于加载（可能是按需加载）导出预期功能的外部组件。例如，一些编解码器甚至按需下载，然后由使用它们的应用程序加载。此外，函数指针可能由外部模块作为回调（又称委托）给出，其值可能取决于某些对象的状态。在面向对象编程中，一个著名的行为模式称为“模板方法”，其特点是运行时改变控制流。使用函数指针可以通过减少需要定义的类的数量来显著减少其实现所需的工作。

使用非类型安全指针

如果您曾经在 Visual Basic 6 中使用过 EnumWindows API，您可能已经注意到，没有任何东西强制您传递一个具有正确原型的函数地址作为回调。代码会在运行时失败，但编译时不会报错。Visual Basic .NET 中的委托（Delegates）解决了这个问题，尽管它们的主要目的可能是为了确保代码的可用性，因为 CLR 可能会丢弃未被引用的已编译代码。虽然其他语言有声明类型安全指针的方法（如 C/C++ 中的 typedef），但在 Visual Basic 6 中，我们只能将它们视为有符号的 4 字节数字。开发人员将负责类型检查，而无需编译器的任何帮助。

进行调用

将地址存储为Long并进行调用的首选方法是替换类的“虚函数表”（VFT）中的条目，因为它提供了足够的灵活性，同时易于使用。它在IDE、本地代码和P代码中具有相同的行为，这有助于调试。vftable是编程语言实现中用于支持动态多态性（即运行时方法绑定）的机制。虽然一些在线资源描述了Visual C++ 6.0编译器如何为类创建vftable，但我没有找到任何关于Visual Basic 6.0编译器的资料。

通常，编译器为每个类创建一个单独的 vftable，并将其指针作为每个基类的一个隐藏成员存储，通常是第一个成员。Visual C++ 编译器以类似于字符串字面量的方式，在代码段的只读页面中为每个类构建 vftable。为了修改其内容，需要使用 VirtualProtect API 临时更改访问权限。Visual C++ 创建的 vftable 中的第一个地址指向类的标量析构函数，然后是按声明顺序的虚函数地址。

虽然Visual C++支持多重继承并处理纯虚函数调用，但我们的目标可以通过识别Visual Basic如何根据类实例的地址检索public方法的地址来简单实现。需要对类实例进行目视检查，以确定vftable的位置和内容。通过显示同一类两个实例地址的内存内容，我们应该能够识别哪个是指向vftable的指针。由于两个实例都指向相同的vftable，因此指针值必须相同，并且必须属于我们的Visual Basic模块（默认情况下，起始地址为0x00400000）。正如您所看到的，指向vftable的指针作为前4个字节存储在类实例中。

图2： 两个共享相同 VFT 的对象。

图3： 偏移量 &H1C 处的地址属于我们的模块。

vftable 中的前七个地址指向 msvbvm60.dll 中的代码。通过添加更多 public 方法修改类定义将从偏移量 &H1C 开始更改 vftable 内容。为了巩固理论，我编写了一个外部 DLL，用于中断 Visual Basic 对对象方法的调用，并使用 Visual C++ 调试器读取反汇编。

这比听起来容易得多。有一个全局过程创建一个 Visual Basic 类实例并调用其第一个 public 方法。在运行时，显示全局函数的地址、类实例的地址以及指向 vftable 的指针。通过按 F11 使用 Visual C++ 调试器加载进程。记下当前指令指针（应用程序入口点的 eip），并将其更改为全局过程的地址（在 Registers 窗口中输入并按 Enter）。在此地址设置一个断点。将 eip 更改为旧值并恢复执行。

当达到断点时，单步执行代码并观察寄存器值，直到调用类的成员方法。屏幕截图显示了 eax 寄存器如何获取对象的地址 (0x14BE70)，从中复制 4 字节到 ecx 寄存器，表示 VFT 的地址 (0x4033B8)。地址 0x402391 处的指令是对该类的第一个公共方法的调用，正如您所看到的，它在 vftable 中的偏移量是 &H1C。

图4： 反汇编显示如何从vftable获取地址。

我的调查继续进行，以查看 private 成员数据或方法是否影响 vftable 的位置或内容。答案是否定的，但是 public 成员变量通过插入访问器和修饰符来改变 vftable 的内容，这些访问器和修饰符将在类外部使用成员数据时调用。为了验证概念，我编写了以下测试

VERSION 1.0 CLASS
Attribute VB_Name = "DynamicVFT"
'Byte offset of first index in Virtual Function Table (VFT).
Private Const OffsetToVFT = &H1C
'Swaps the addresses of 2 public methods with the same prototype.
Private Sub SwapPlayers()
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address.
  Dim fnAddress As Long
  CopyMemory fnAddress, ByVal pVFT + OffsetToVFT, 4 'get AddressOf Play.
  CopyMemory ByVal pVFT + OffsetToVFT, ByVal pVFT + OffsetToVFT + 4, 4
                'replace Play address with Replay address.
  CopyMemory ByVal pVFT + OffsetToVFT + 4, fnAddress, 4 _
            'replace Replay address with Play address.
End Sub
'Address of this method can be found at first index in the VFT.
Public Sub Play()
  Debug.Print "Dynamic VFT plays: White move."
  Call SwapPlayers
End Sub
'Address of this method can be found at second index in the VFT.
Public Sub Replay()
  Debug.Print "Dynamic VFT plays: Black move."
  Call SwapPlayers
End Sub
Sub Main()
  'Phase 1: Making the call.
  Dim dynObj As New DynamicVFT
  Dim idx As Long
  For idx = 0 To 9
    dynObj.Play
  Next idx
End Sub

请注意，这些方法具有相同的原型。交换vftable中的地址按预期工作，上述代码的输出如下所示

Dynamic VFT: White move.
Dynamic VFT: Black move.
Dynamic VFT: White move.
Dynamic VFT: Black move.
...

因此，更改 Visual Basic 6 类 VFT 中的值将替换该类的方法。修改 vftable 时还需要记住一件重要的事情，那就是它们由该类的所有实例共享。

传递参数

假设我们将更改类 VFT 中的地址，则需要进一步检查这些方法的调用方式。本节将描述所使用的调用约定，以及堆栈上参数的位置。从 VFT 显示一个接受一个 Long 参数（堆栈上 4 字节）的成员过程的地址，并在 Visual C++ 调试器中加载进程，可以观察到该地址处的汇编代码。它属于一个 跳转表

00401451 jmp         004025A0

跳转表的每个条目都指向已定义的成员方法的编译代码位置

004025A0 push        ebp
004025A1 mov         ebp,esp
004025A3 sub         esp,0Ch
004025A6 push        401136h
004025AB mov         eax,fs:[00000000]
004025B1 push        eax
004025B2 mov         dword ptr fs:[0],esp
004025B9 sub         esp,8
004025BC push        ebx
004025BD push        esi
004025BE push        edi
004025BF mov         dword ptr [ebp-0Ch],esp
004025C2 mov         dword ptr [ebp-8],401118h
004025C9 mov         dword ptr [ebp-4],0
004025D0 mov         eax,dword ptr [ebp+8]
004025D3 push        eax
004025D4 mov         ecx,dword ptr [eax]
004025D6 call        dword ptr [ecx+4]
004025D9 mov         eax,dword ptr [ebp+8]
004025DC push        eax
004025DD mov         edx,dword ptr [eax]
004025DF call        dword ptr [edx+8]
004025E2 mov         eax,dword ptr [ebp-4]
004025E5 mov         ecx,dword ptr [ebp-14h]
004025E8 pop         edi
004025E9 pop         esi
004025EA mov         dword ptr fs:[0],ecx
004025F1 pop         ebx
004025F2 mov         esp,ebp
004025F4 pop         ebp
004025F5 ret         8

图5： 堆栈差异。

对于经验丰富的汇编语言读者来说，上面的列表是相当直截了当的。在这一点上，重点在于修改堆栈的指令。事实上，最后一条指令几乎告诉了我们所有需要知道的信息。首先，被调用者清理堆栈，而不是调用者。因此，调用约定不可能是__cdecl或__fastcall。既然这个方法只接受一个Long参数（4字节大小），为什么这个方法从堆栈中移除了8字节呢？因为在调用之前有一个额外的参数被压入堆栈：指向我们正在调用过程的对象的指针（又称this指针）。

为了确认未使用__thiscall调用约定，请再次查看汇编列表。您会看到ecx寄存器在地址4025D4处首次使用时，正在被写入，而不是被读取。因此，指向对象的指针既没有通过ecx寄存器传递，也没有通过其他寄存器传递。甚至不需要查看调用者做了什么，我们就可以将调用约定视为__stdcall，并将对象指针作为最后一个参数压入堆栈。这并不奇怪，因为Visual Basic 6以广泛使用它而闻名。需要进行另一次测试，以确认压入堆栈的最后一个额外参数的值。请记住，在__stdcall调用约定中，参数按声明的顺序从右向左压入。

VERSION 1.0 CLASS
Attribute VB_Name = "MemberVsGlobal"
'Replaces address of MemberProcedure with given address at which
'should reside a procedure using
'__stdcall calling convention and accepts 2 parameters of type Long;
'restores the original address
'of MemberProcedure when given address is 0
Private Sub ReplaceMemberWithGlobal(ByVal fnAddress As Long)
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address
  Static oldAddress As Long
    'static variable which stores the original MemberProcedure address
  If (oldAddress = 0) Then
    CopyMemory oldAddress, ByVal pVFT + OffsetToVFT, 4
                'get MemberProcedure address
  End If
  If (fnAddress = 0) Then
    CopyMemory ByVal pVFT + OffsetToVFT, oldAddress, 4
                'restores original MemberProcedure address
  Else
    CopyMemory ByVal pVFT + OffsetToVFT, _
      fnAddress, 4 'replace MemberProcedure address with given global address
  End If
End Sub
'Restores the original MemberProcedure address
Private Sub Class_Terminate()
  ReplaceMemberWithGlobal 0
End Sub
'Its address in the VFT will be replaced with given fnAddress
'after the first call, thus becoming inaccessible after its first return
Public Sub MemberProcedure(ByVal fnAddress As Long)
  Debug.Print Hex$(ObjPtr(Me)) & ".MemberProcedure(0x" & Hex$(fnAddress) & ")"
  ReplaceMemberWithGlobal fnAddress
End Sub
'Procedure for replacing a member procedure
Private Sub GlobalProcedure(ByVal objInstance As Long, ByVal parameter As Long)
  Debug.Print Hex$(objInstance) & ".GlobalProcedure(0x" & Hex$(parameter) & ")"
End Sub
Sub Main()
  'Phase 2: Passing parameters
  Dim MvsG As New MemberVsGlobal
  MvsG.MemberProcedure AddressOf GlobalProcedure
  MvsG.MemberProcedure &HB0A
End Sub

请注意，在输出中，通过ObjPtr(Me)在类方法中获得的值与替换它的全局过程的objInstance参数相同，从而证实了我们的理论，即在调用之前，一个指向对象的指针被压入堆栈

2499D8.MemberProcedure(0xAB16B4)
2499D8.GlobalProcedure(0xB0A)

在IDE下运行上一个示例时，观察到了一种有趣的现象。如果您删除了Class_Terminate实现，则两次运行代码将不会调用原始的MemberProcedure，除非重新生成（Alt+F K）可执行文件或重新加载项目。为此目的，不需要在IDE下检查此行为，但值得知道的是，如果您在调试时观察到损坏的对象，则应在重新启动执行之前重新生成。

嵌入本地代码

目前，我们知道可以使用全局过程替换类的成员过程，如果该全局过程具有相同的原型，但带有一个额外参数：指向正在调用方法的对象的指针。嗯，但我们需要的几乎是相反的！我们不需要调用将对象指针作为第一个参数的全局过程。如何在调用到达全局过程之前移除额外参数？我们将嵌入用汇编语言编写的本地代码。

这种实现称为存根（stub）或代理（proxy）。在其他情况下，它可以用于日志记录或子类化。我们的目的是根据预期调整调用。当对成员过程的调用完成时，堆栈将包含返回地址、对象指针，然后是所调用方法的参数。我们的存根应该移除对象指针，以便返回地址紧跟着参数，然后跳转到所需转发地址。请记住，我们在此阶段假设转发地址指向一个过程，而不是函数（不返回任何内容），并且其调用约定是 __stdcall。完成此任务的汇编代码如下

   pop         eax // remove return address from stack
   pop         ecx // remove pointer to object from stack
   push        eax // push return address onto stack
   mov         eax,XXXXXXXXh // XXXXXXXX can be replaced here with
                // any forwarding address
   jmp         eax // jump to forwarding address

您可以使用任何汇编器从上面生成本地代码。我将其编写为 Visual C++ __asm 块，然后从反汇编视图中复制生成的本地代码。如果您设置 Visual C++ 编译器选项 /FAc 或 /FAcs（列表文件类型：Assembly with Machine Code 或 Assembly, Machine Code, and Source），则可以在关联的 *.cod 文件（汇编列表文件）中找到本地代码。我们如何将本地代码嵌入 Visual Basic 6？复制列表；删除每行开头的地址和汇编源代码，只保留机器代码字节作为十六进制字符；删除它们之间的任何空格；将其格式化为 Visual Basic 常量字符串，您应该会得到类似这样的内容："58" & "59" & "50" & "B8XXXXXXXX" & "FFE0"。

XXXXXXXX 可以是您想要的任何值，因为它将在运行时被替换为我们需要调用的转发地址，即我们的函数指针。声明一个十六进制字符串作为常量；将其转换为 Byte 数组；使用 GlobalAlloc API 分配相同数量的字节并复制 Byte 数组；将内存句柄用作我们本地代码的地址；当不再需要本地代码时，使用 GlobalFree API 释放分配。为了演示嵌入本地代码的工作原理以及存根如何成功地用相同原型的非成员过程替换成员过程，我在以下类实现和使用类的示例测试中提供了一种更通用的方法

VERSION 1.0 CLASS
Attribute VB_Name = "StubCallToSub"
Private Const hexStub4ProcedureCall = "58" & "59" & "50" & "B822114000" & _
                                    "FFE0"
'An array that saves the original addresses to the member procedures
Private VFTable() As Long
'An array that saves addresses of allocations made for stubs,
'in order to be freed
Private VFArray() As Long
'Sets initial state of the private arrays,
'thus UBound will not fail on first call
Private Sub Class_Initialize()
  ReDim VFTable(0)
  VFTable(0) = 0
  ReDim VFArray(0)
  VFArray(0) = 0
End Sub
'Removes only existing stub for member specified by index
Private Sub RemoveStub(ByVal index As Long)
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address
  If (index < 1) Then Exit Sub
  If (index > UBound(VFTable)) Then Exit Sub
  If (VFTable(index) <> 0) Then 'stub exists for this member
    Dim oldAddress As Long
    oldAddress = VFTable(index)
    CopyMemory ByVal pVFT + OffsetToVFT + index * 4, oldAddress, 4
        'restore original member address
    VFTable(index) = 0
    GlobalFree VFArray(index)
        'discard the allocated memory for stub implementation
    VFArray(index) = 0
  End If
End Sub
'Replaces / restores the address of a member procedure of this class
Public Sub ReplaceMemberSubWithStub(ByVal index As Long, _
                    ByVal fnAddress As Long)
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address
  If (index < 1) Then 'restore all the original addresses
    For index = 1 To UBound(VFTable)
      RemoveStub index
    Next index
  Else
    If (fnAddress = 0) Then 'restore only the address for the index specified
      RemoveStub index
    Else 'replace the address of a member specified by index
      If (index > UBound(VFTable)) Then
        ReDim Preserve VFTable(index)
            'resize the array to save original addresses
        VFTable(index) = 0
        ReDim Preserve VFArray(index)
            'resize the array to save changes in the VFT
        VFArray(index) = 0
      End If
      RemoveStub index 'check if a stub exists for this member
            'and needs to be removed first
      Dim oldAddress As Long
      CopyMemory oldAddress, ByVal pVFT + OffsetToVFT + index * 4, 4
            'get original member address
      VFTable(index) = oldAddress
      Dim hexCode As String
      hexCode = hexStub4ProcedureCall
      Dim nBytes As Long 'number of code bytes to allocate
      nBytes = Len(hexCode) \ 2
      Dim Bytes() As Byte 'array of code bytes converted from hex
      ReDim Preserve Bytes(1 To nBytes)
      Dim idx As Long 'loop counter
      'convert each pair of hex chars to a byte code
      For idx = 1 To nBytes
        Bytes(idx) = Val("&H" & Mid$(hexCode, idx * 2 - 1, 2))
      Next idx
      CopyMemory Bytes(5), fnAddress, 4
            'replace the forwarding address in the native code
      Dim addrStub As Long 'address where the code bytes will be copied
      addrStub = GlobalAlloc(GMEM_FIXED, nBytes)
            'allocate memory to store the code bytes
      CopyMemory ByVal addrStub, Bytes(1), nBytes 'copy given code bytes
      CopyMemory ByVal pVFT + OffsetToVFT + index * 4, _
        addrStub, 4 'replace member address with stub address
      VFArray(index) = addrStub 'save the handle to the stub for cleanup
    End If
  End If
End Sub
'Restores the original addresses in the VFT and discards
'the allocated memory for stub implementations
Private Sub Class_Terminate()
  ReplaceMemberSubWithStub 0, 0
End Sub
'Member procedure can be replaced by a stub by
'calling ReplaceMemberSubWithStub(1,address)
Public Sub PrintMessage(ByVal msg As String)
  Debug.Print "PrintMessage says: " & msg
End Sub
'Procedure called through embedded stub
Private Sub PrintFirstParameter(ByVal msg As String)
  Debug.Print "PrintFirstParameter says: " & msg
End Sub
Sub Main()
  'Phase 3: Embedding native code
  Dim fwdSub As New StubCallToSub
  fwdSub.PrintMessage "Hello!"
  fwdSub.ReplaceMemberSubWithStub 1, AddressOf PrintFirstParameter
  fwdSub.PrintMessage "A stub called me instead!"
  fwdSub.ReplaceMemberSubWithStub 1, 0
  fwdSub.PrintMessage "My address has been restored in VFT!"
End Sub

请观察输出中每次调用 ReplaceMemberSubWithStub 方法后是哪个代码打印的消息

PrintMessage says: Hello!
PrintFirstParameter says: A stub called me instead!
PrintMessage says: My address has been restored in VFT!

在此类中可以声明具有不同原型的其他成员过程（非函数），并通过调用 ReplaceMemberSubWithStub 方法来更改它们的目标。该类在 Class_Terminate 中自清理，因此您只需在选择方法索引时小心，您正在为其设置指针。对于大型项目，我建议使用 Enum，它以某种方式将函数指针名称与其原型关联起来

Public Enum FwdSubIdx
  idxPrintMessage = 1
  'index of second public sub (ReplaceMemberSubWithStub is not to be replaced)
  idxOtherSub
  idxAnotherSub
End Enum

返回值

这就是事情变得复杂的地方。如果你觉得需要休息一下，这可能是一个好时机来反思所说的一切并吸收这里提出的想法。看起来我们似乎已经找到了一种处理函数指针的通用方法，但事实是需要更多的调查。简单地将前面示例中的成员过程更改为成员函数将无法按要求工作。返回值将丢失，堆栈将无法正确调整，函数调用后的控制流将是未定义的。其背后的原因是成员函数的调用方式与全局函数不同。由于全局函数可以用作API调用的回调，因此它们的行为非常有名。例如，如果它应该返回一个Long，我们将使用eax寄存器，如下所示

Private Function GlobalFunction(ByVal param As Long) As Long
  GlobalFunction = param
End Function

这将变成

00402AA0   mov         eax,dword ptr [esp+4] // GlobalFunction = param
00402AA4   ret         4 // removes param from stack on return

另一方面，成员函数有不同的机制。它们由调用者告知将返回值复制到何处，我将向您展示如何操作。再一次，需要找到、读取和理解Visual Basic 6编译器生成的本地代码的反汇编，这个过程既令人愉快又令人痛苦。

Public Function MemberFunction(ByVal param As Long) As Long
  MemberFunction = param
End Function

这将变成

00404230   push        ebp
    // 'ebp' register is saved on the stack bellow the return address
00404231   mov         ebp,esp
    // stack frame established (new ebp points to old ebp)
00404233   sub         esp,0Ch
00404236   push        4011E6h // exception handler address
0040423B   mov         eax,fs:[00000000]
00404241   push        eax
00404242   mov         dword ptr fs:[0],esp
    // register exception handler frame
00404249   sub         esp,0Ch
0040424C   push        ebx
0040424D   push        esi // 'esi' register saved
0040424E   push        edi
0040424F   mov         dword ptr [ebp-0Ch],esp
00404252   mov         dword ptr [ebp-8],4011D0h
00404259   xor         esi,esi // esi set to zero
0040425B   mov         dword ptr [ebp-4],esi // local temp0 gets zero value
0040425E   mov         eax,dword ptr [ebp+8] // gets pointer to object
00404261   push        eax
00404262   mov         ecx,dword ptr [eax]
00404264   call        dword ptr [ecx+4]
    // the address called here belongs to 'msvbvm60.dll'
00404267   mov         edx,dword ptr [ebp+0Ch]
    // 'edx' register gets the value of param
0040426A   mov         dword ptr [ebp-18h],esi
0040426D   mov         dword ptr [ebp-18h],edx
    // local temp2 stores value of param
00404270   mov         eax,dword ptr [ebp+8] // gets pointer to object
00404273   push        eax
00404274   mov         ecx,dword ptr [eax]
00404276   call        dword ptr [ecx+8]
    // the address called here belongs to 'msvbvm60.dll'
00404279   mov         edx,dword ptr [ebp+10h]
    // given 'return value' address is copied in 'edx'!!!
0040427C   mov         eax,dword ptr [ebp-18h]
    // 'eax' register gets value of param from local temp2
0040427F   mov         dword ptr [edx],eax
    // param value is copied at given 'return value' address!!!
00404281   mov         eax,dword ptr [ebp-4]
    // 'eax' register gets zero value from local temp0
00404284   mov         ecx,dword ptr [ebp-14h]
00404287   pop         edi
00404288   pop         esi // restores 'esi' register
00404289   mov         dword ptr fs:[0],ecx
    // restores previous exception handler frame
00404290   pop         ebx
00404291   mov         esp,ebp // removes stack frame
00404293   pop         ebp // restores 'ebp' register
00404294   ret         0Ch // removes 12 bytes from the stack on return!!!

我们已经了解到，成员过程会传递一个额外的参数，表示正在调用该方法的对象的指针。现在我们发现成员函数还会给定一个参数，表示返回值需要存储的地址。不幸的是，它作为最后一个参数（在定义的参数之前，最先被压入堆栈）给出，这使得情况变得非常复杂。如何替换这样的成员函数实现，同时准确处理返回值？请看下面的例子

VERSION 1.0 CLASS
Attribute VB_Name = "StubFctCall"
'Replaces address of MemberFunction with given address at which
'should reside a function using
'__stdcall calling convention and accepts 3 parameters of type Long;
'restores the original address
'of MemberFunction when given address is 0
Private Sub ReplaceMemberWithGlobal(ByVal fnAddress As Long)
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address
  Static oldAddress As Long
    'static variable which stores the original MemberFunction address
  If (oldAddress = 0) Then
    CopyMemory oldAddress, ByVal pVFT + OffsetToVFT, 4
    'get MemberFunction address
  End If
  If (fnAddress = 0) Then
    CopyMemory ByVal pVFT + OffsetToVFT, oldAddress, 4
    'restores original MemberFunction address
  Else
    CopyMemory ByVal pVFT + OffsetToVFT, _
      fnAddress, 4 'replace MemberFunction address with given global address
  End If
End Sub
'Its address in the VFT will be replaced with given fnAddress
'after the first call, thus
'becoming inaccessible after its first return
Public Function MemberFunction(ByVal fnAddress As Long) As Long
  Debug.Print Hex$(ObjPtr(Me)) & ".MemberFunction(0x" & Hex$(fnAddress) & ")"
  ReplaceMemberWithGlobal fnAddress
  MemberFunction = fnAddress
End Function
'Function for replacing a member function
Private Function GlobalFunction(ByVal objInstance As Long, _
  ByVal parameter As Long, ByRef retVal As Long) As Long
  Debug.Print Hex$(objInstance) & ".GlobalFunction(0x" & Hex$(parameter) & ")"
  retVal = parameter 'copy return value at given location
  GlobalFunction = 0 'return success
End Function
Sub Main()
  'Phase 4: Returning values
  Dim FwdFct As New StubFctCall
  Dim retVal As Long
  retVal = FwdFct.MemberFunction(AddressOf GlobalFunction)
  Debug.Print "StubFctCall.MemberFunction() returned value: " & Hex$(retVal)
  retVal = FwdFct.MemberFunction(&HB0AB0A)
  Debug.Print "GlobalFunction() returned value: " & Hex$(retVal)
End Sub

上述测试的输出显示了返回相同 Long 参数的正确行为

1729D0.MemberFunction(0xAB1BD4)
StubFctCall.MemberFunction() returned value: AB1BD4
1729D0.GlobalFunction(0xB0AB0A)
GlobalFunction() returned value: B0AB0A

但是，为什么我们在返回之前将 eax 寄存器设置为零 (GlobalFunction = 0)？因为在成员函数被调用后存在某种验证机制

  Dim retVal As Long
  retVal = FwdFct.MemberFunction(&HB0AB0A)

这将变成

00402E52   lea         edx,[ebp-0C8h]
    // 'edx' register gets address of return value
00402E58   push        edx // push address of return value
00402E59   push        0B0AB0Ah // push parameter
00402E5E   push        eax // push pointer to object 'FwdFct'
00402E5F   mov         ebx,eax // save pointer to object
00402E61   call        dword ptr [ecx+1Ch]
    // call first public member of the class
00402E64   cmp         eax,esi
    // here, 'esi' register is zero!!! success is returned as 0!!!
00402E66   fnclex
00402E68   jge         00402E79 // if success returned, jump after next call
00402E6A   push        1Ch
00402E6C   push        4022A8h
00402E71   push        ebx
00402E72   push        eax
00402E73   call        dword ptr ds:[401024h]
00402E79   mov         eax,dword ptr [ebp-0C8h]
    // 'eax' register gets return value
00402E7F   lea         edx,[ebp-94h]
00402E85   lea         ecx,[ebp-24h]
00402E88   push        edx
00402E89   mov         dword ptr [ebp-24h],eax
    // retVal variable gets return value

超越基本

相同的行为可以扩展到Double、Date、Currency等返回类型。返回Currency类型的API使用eax和edx寄存器，我们必须将其复制到给定地址，该地址指向调用者期望返回值的存储位置。Double和Date类型通过浮点寄存器返回。重要的是要理解，我们需要根据函数指针的返回类型编写不同的存根。我的计划是为过程、返回32位和64位类型的函数以及通过浮点寄存器返回四字（quad-words）的函数提供一个通用解决方案。

字符串通过引用返回，这意味着它们可以作为 32 位指针处理，在 eax 寄存器中返回。对于不返回任何内容的过程，已经提供的转发存根可以安全使用。但是，对于函数，我们需要编写不同的存根，这些存根将一个或两个寄存器值，或者浮点寄存器，复制到调用者期望返回值的给定位置。此外，由于调用者提供了额外的最后一个参数，我们的存根还应该移除指向返回值的指针，以便在返回给调用者时正确调整堆栈指针。

显然，这样的存根实现不能简单地跳转到转发地址，就像我们为过程调用转发所做的那样。相反，必须调用转发地址，以便返回到我们的存根，而不是返回到原始调用者。当进行转发调用时，返回到我们存根的地址被压入堆栈，并且必须紧随我们正在调用的函数所期望的参数之后发生。然而，这意味着我们必须从堆栈中移除Visual Basic调用者的地址，并将其保存到某个安全位置，以便在转发调用之后可用。

我发现的一个解决方案是将其保存到调用者为返回值提供的位置。这可行，但它涉及到为我们正在转发调用的函数的每个原型更改存根实现。这意味着我们必须向替换 VFT 中方法地址的代码段提供函数所接受的所有参数的字节大小。嗯，这不是一项容易完成的任务...

幸运的是，还有另一种方法！如果您还不熟悉，让我向您介绍“线程信息块”（TIB）。TIB 结构的格式可以在许多在线资源中找到（例如，Matt Pietrek 撰写的“Under The Hood - MSJ，1996 年 5 月”），此处不再赘述。为了我们的利益，TIB 结构包含一个可供应用程序使用的条目 pvArbitrary。很少有应用程序使用此位置，因此不会通过覆盖其数据而影响其他组件。由于 TIB 结构是按线程提供的，因此我们的实现将是线程安全的。

将返回地址存储在TIB的pvArbitrary中是否足够？恐怕答案是否定的。在重入调用或任何存根替换另一个存根的返回地址的情况下，它将失败。一个常见场景是，通过我们的转发技术调用API，并传递一个也通过存根调用API的回调。如何在同一线程上进行两次嵌套调用而不覆盖其返回地址？我们创建一个链表，该链表充当LIFO（后进先出）堆栈。pvArbitrary将始终指向列表的头部，其中存储了最后一次调用的返回地址。

这样的链表需要分配和删除，为此我选择了 kernel32.dll 中的 GlobalAlloc 和 GlobalFree API，因为它们始终可用。下面解释了可用于形成处理 Double / Date（64 位浮点寄存器）、Currency（eax 和 edx 寄存器）以及 Long / Integer / Boolean / ByVal String（eax 寄存器）返回值的存根的最终汇编代码

   push        8 // we need 8 bytes allocated
   push        0 // we need fixed memory (GMEM_FIXED)
   mov         eax,XXXXXXXXh
        // replace here XXXXXXXX with the address of GlobalAlloc
   call        eax // allocate new list node
   pop         ecx // remove return address from stack
   mov         dword ptr [eax],ecx // store return address in list node
   pop         ecx // remove pointer to object from stack
   mov         ecx,dword ptr fs:[18h] // get pointer to TIB structure
   mov         edx,dword ptr [ecx+14h]
        // get pointer to previous list node from pvArbitrary
   mov         dword ptr [eax+4],edx // link list nodes
   mov         dword ptr [ecx+14h],eax
        // store new head of list at pvArbitrary
   mov         eax,XXXXXXXXh
        // XXXXXXXX can be replaced here with any forwarding address
   call        eax // call the forwarding address
   pop         ecx
        // get the location where return value is expected by VB caller
#ifdef _RETURN64_DOUBLE_ // return 64-bit floating point value
   fstp        qword ptr [ecx] // return value gets double result
#else
   mov         dword ptr [ecx],eax // copy first 32-bit of the return value
#ifdef _RETURN64_ // return 64-bit value
   mov         dword ptr [ecx+4],edx
        // copy second 32-bit of the return value
#endif
#endif
   mov         ecx,dword ptr fs:[18h] // get pointer to TIB structure
   mov         eax,dword ptr [ecx+14h]
        // get pointer to head of list from pvArbitrary
   mov         edx,dword ptr [eax] // get return address from list node
   push        edx // restore return address onto stack
   mov         edx,dword ptr [eax+4] // get pointer to previous list node
   mov         dword ptr [ecx+14h],edx
        // store pointer to previous node at pvArbitrary
   push        eax // we need to free the list node
   mov         eax,XXXXXXXXh
        // replace here XXXXXXXX with the address of GlobalFree
   call        eax // free list node
   ret // return to VB caller

成员函数调用后的验证机制会发生什么？在返回给 Visual Basic 调用者之前，eax 寄存器需要设置为零。GlobalFree API 的文档说，如果函数成功，它将返回零。我期望成功丢弃已分配的节点，就像我期望成功分配它一样。如果您愿意，可以在 ret 指令上方插入 xor eax,eax（本地代码为 "33C0"）。此存根的任何其他改进都留作读者的练习。存根实现甚至可以编写为处理 __stdcall 到 __cdecl 转发。可能性的世界是无限的。由上述汇编生成的本地代码可以分为 3 部分，以便通过简单地连接字符串来轻松形成处理所需返回类型的存根

VERSION 1.0 CLASS
Attribute VB_Name = "StubFwdWithStackOnTIB"
Private Const hexStub4FunctionProlog = "6A08" & "6A00" & _
        "B8XXXXXXXX" & "FFD0" & "59" & "8908" & _
        "59" & "648B0D18000000" & "8B5114" & "895004" & "894114" & _
        "B8XXXXXXXX" & "FFD0" & "59"
'The hex string bellow represents the code bytes compiled
'from a short assembly described as follows:
'   fstp        qword ptr [ecx] // return value gets double result
Private Const hexStub4ReturnDbl = "DD19"
'The hex string bellow represents the code bytes compiled
'from a short assembly described as follows:
'   mov         dword ptr [ecx],eax // copy first 32-bit of the return value
Private Const hexStub4Return32bit = "8901"
'The hex string bellow represents the code bytes compiled
'from a short assembly described as follows:
'   mov         dword ptr [ecx],eax // copy first 32-bit of the return value
'   mov         dword ptr [ecx+4],edx
    // copy second 32-bit of the return value
Private Const hexStub4Return64bit = "8901" & "895104"
Private Const hexStub4FunctionEpilog = "648B0D18000000" & _
        "8B4114" & "8B10" & "52" & "8B5004" & _
        "895114" & "50" & "B8XXXXXXXX" & "FFD0" & "C3"
Private Enum StubTypes 'supported stub types
  ret0bit 'method is a procedure and does not return a value
  ret32bit 'method is a function that returns 32-bit type
    '(String included, since returned ByRef)
  ret64bit 'method is a function that returns 64-bit type (ex. Currency)
  retDbl 'method is a function that returns 64-bit float type
    '(ex. Double, Date)
End Enum
'An array that saves the original addresses to the member procedures
Private VFTable() As Long
'An array that saves addresses of allocations made for stubs,
'in order to be freed
Private VFArray() As Long
'address of GlobalAlloc from kernel32.dll
Private pGlobalAlloc As Long
'address of GlobalFree from kernel32.dll
Private pGlobalFree As Long
'Sets initial state of the private arrays, thus UBound will not fail
'on first call;
'also, obtains the addresses of GlobalAlloc and GlobalFree used
'for the linked list stored at pvArbitrary entry in the TIB
Private Sub Class_Initialize()
  ReDim VFTable(0)
  VFTable(0) = 0
  ReDim VFArray(0)
  VFArray(0) = 0
  Dim hKernel32 As Long 'handle to kernel32.dll
  hKernel32 = LoadLibrary("kernel32.dll")
  pGlobalAlloc = GetProcAddress(hKernel32, "GlobalAlloc")
  pGlobalFree = GetProcAddress(hKernel32, "GlobalFree")
End Sub
'Restores the original addresses in the VFT and discards
'the allocated memory for stub implementations
Private Sub Class_Terminate()
  ReplaceMethodWithStub 0, 0, 0
End Sub
'Removes only existing stub for method specified by index
Private Sub RemoveStub(ByVal index As VFTidxs)
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address
  If (index < 1) Then Exit Sub
  If (index > UBound(VFTable)) Then Exit Sub
  If (VFTable(index) <> 0) Then 'stub exists for this member
    Dim oldAddress As Long
    oldAddress = VFTable(index)
    CopyMemory ByVal pVFT + OffsetToVFT + index * 4, oldAddress, 4
    'restore original member address
    VFTable(index) = 0
    GlobalFree VFArray(index)
    'discard the allocated memory for stub implementation
    VFArray(index) = 0
  End If
End Sub
'Replaces / restores the address of a method of this class
'If given index is 0 then all original addresses are restored in the VFT
Private Sub ReplaceMethodWithStub(ByVal index As VFTidxs, _
    ByVal fnType As StubTypes, ByVal fnAddress As Long)
  Dim pVFT As Long
  CopyMemory pVFT, ByVal ObjPtr(Me), 4 'get the VFT address
  If (index < 1) Then 'restore all the original addresses
    For index = 1 To UBound(VFTable)
      RemoveStub index
    Next index
  Else
    If (fnAddress = 0) Then 'restore only the address for the index specified
      RemoveStub index
    Else 'replace the address of a member specified by index
      If (index > UBound(VFTable)) Then
        ReDim Preserve VFTable(index)
        'resize the array to save original addresses
        VFTable(index) = 0
        ReDim Preserve VFArray(index)
        'resize the array to save changes in the VFT
        VFArray(index) = 0
      End If
      RemoveStub index
    'check if a stub exists for this member and needs to be removed first
      Dim oldAddress As Long
      CopyMemory oldAddress, ByVal pVFT + OffsetToVFT + index * 4, 4
    'get original member address
      VFTable(index) = oldAddress
      Dim hexCode As String
      Select Case fnType
      Case StubTypes.retDbl
    'method is a function that returns 64-bit float type
        hexCode = hexStub4FunctionProlog & hexStub4ReturnDbl & _
                        hexStub4FunctionEpilog
      Case StubTypes.ret64bit 'method is a function that returns 64-bit type
        hexCode = hexStub4FunctionProlog & hexStub4Return64bit & _
                        hexStub4FunctionEpilog
      Case StubTypes.ret32bit 'method is a function that returns 32-bit type
        hexCode = hexStub4FunctionProlog & hexStub4Return32bit & _
                        hexStub4FunctionEpilog
      Case Else 'method is a procedure and does not return a value
        '(default:StubTypes.ret0bit)
        hexCode = hexStub4ProcedureCall
      End Select
      Dim nBytes As Long 'number of code bytes to allocate
      nBytes = Len(hexCode) \ 2
      Dim Bytes() As Byte 'array of code bytes converted from hex
      ReDim Preserve Bytes(1 To nBytes)
      Dim idx As Long 'loop counter
      'convert each pair of hex chars to a byte code
      For idx = 1 To nBytes
        Bytes(idx) = Val("&H" & Mid$(hexCode, idx * 2 - 1, 2))
      Next idx
      If (fnType = ret0bit) Then
        'method is a procedure and does not return a value
        CopyMemory Bytes(5), fnAddress, 4
        'replace the forwarding address in the native code
      Else 'method is a function returning a 32-bit, 64-bit or
        '64-bit float type
        CopyMemory Bytes(6), pGlobalAlloc, 4
        'replace the address of GlobalAlloc
        CopyMemory Bytes(33), fnAddress, 4
        'replace the forwarding address in the native code
        CopyMemory Bytes(nBytes - 6), pGlobalFree, 4
        'replace the address of GlobalFree
      End If
      Dim addrStub As Long 'address where the code bytes will be copied
      addrStub = GlobalAlloc(GMEM_FIXED, nBytes)
        'allocate memory to store the code bytes
      CopyMemory ByVal addrStub, Bytes(1), nBytes 'copy given code bytes
      CopyMemory ByVal pVFT + OffsetToVFT + index * 4, _
        addrStub, 4 'replace member address with stub address
      VFArray(index) = addrStub 'save the handle to the stub for cleanup
    End If
  End If
End Sub

提供的示例项目展示了一个类实现，它测试了所有讨论的返回类型，以及一个使用调用转发的回调。这样做是为了确保当我们的返回地址作为存储在 TIB 的 pvArbitrary 条目中的链表保存时，它们不会被替换。

使用无类型转发

虽然C++有函数指针原型定义的typedef、__asm块、内部__asm __emit和__declspec(naked)函数声明规范，但我能在Visual Basic 6中编写的最佳方案就是这最后一节中描述的类，我相信它能够实现C++所能实现的一切。对于那些编写代码过于自信的人来说，传递给函数指针的参数的类型检查可以完全去除。在大多数情况下，开发人员在编译时就会知道一个函数指针的原型。很少有应用程序会要求在运行时构造调用，参数数量和类型不确定。

几年前，我正在寻找一个应用程序，它可以读取某种脚本，在那里我可以定义如何测试我开发的一些 DLL。这将有助于回归测试，并且可以由非开发测试人员轻松维护。有了示例项目中提供的 TypelessFwd 类，这样的应用程序可以仅作为一个 Visual Basic 6 模块编写。

当您在编译时知道函数的原型时，我不建议使用无类型转发。这种技术仅仅有助于理解函数调用和参数传递。它应该很少使用，并且要谨慎使用，就像编写汇编代码一样。因为它将参数的压入和调用本身分开，所以编译器无法测试或理解任何关联。如果您能够接受这一点并承担检查通过指针调用的函数所期望的参数类型的全部责任，那么它最大的灵活性将是回报

  'Phase 6: Spreading thin with typeless forwarding
  Dim pFn As New TypelessFwd
  Dim sqValue As Double
  sqValue = 5
  'Function SquareRoot(ByVal value As Double) As Double
  Dim hVBVM As Long, pSquareRoot As Long
  pSquareRoot = pFn.AddressOfHelper(hVBVM, "msvbvm60.dll", "rtcSqr")
                    'already loaded msvbvm60
  pFn.ByRefPush VarPtr(sqValue) + 4
  pFn.ByRefPush VarPtr(sqValue)
  Debug.Print "Sqr(" & sqValue & ") = " & pFn.CallDblReturn(pSquareRoot)
  pFn.AddressOfHelper hVBVM, vbNullString, vbNullString
                    'unload runtime module, if required
  Dim interval As String, number As Double, later As Date
  interval = "h"
  number = 10
  'Function DateFromNow(ByVal interval As String, ByRef number As Double)
  'As Date
  pFn.ByValPush VarPtr(number)
  pFn.ByValPush StrPtr(interval)
  later = pFn.CallDblReturn(AddressOf DateFromNow)
  Debug.Print "In " & number & " " & interval & " will be: " & later
  Dim sSentence As String
  sSentence = "The third character in this sentence is:"
  'Function SubString(ByRef sFrom As String, ByVal start As Long,
  'ByVal length As Long) As String
  pFn.ByValPush 1
  pFn.ByValPush 3
  pFn.ByValPush VarPtr(sSentence)
  Dim retVal As String
  Debug.Print sSentence & " '" & pFn.CallStrReturn(AddressOf SubString) & "'."
  Dim sCpuVendorID As String
  sCpuVendorID = Space$(12) 'pre-allocate 12 bytes (don't use String * 12)
  'Sub Get_CPU_VendorID(ByVal sCpuVendorID As String)
  Dim pGet_CPU_VendorID As Long
  pFn.NativeCodeHelper pGet_CPU_VendorID, hexGet_CPU_VendorID
                'allocate memory storing native code
  pFn.ByValPush StrPtr(sCpuVendorID)
  pFn.Call0bitReturn pGet_CPU_VendorID
  pFn.NativeCodeHelper pGet_CPU_VendorID, vbNullString
                'free memory storing native code
  Debug.Print "CPU Vendor ID: " & sCpuVendorID & "."

该类提供了两种用于获取函数指针的辅助方法。AddressOfHelper 可用于在运行时加载和卸载 DLL，并按名称或序号检索导出函数的指针，就像使用 GetProcAddress API 一样。NativeCodeHelper 将分配和释放存储为十六进制字符串的本地代码的内存。每当您发现 Visual Basic 代码中存在瓶颈时，编写一些执行速度更快的汇编代码，并通过十六进制字符串嵌入本地代码。关于嵌入式本地代码，需要注意一点：edi、esi 和 ebx 寄存器值应该保留，因为 Visual Basic 似乎使用其中一个来验证返回值。示例项目演示了如何通过调用嵌入式本地代码来检索一些 CPU 信息（使用 cpuid 指令）。

该类的另外两个方法（与前两个一样，被存根替换）将帮助您在调用函数指针之前将参数压入堆栈。ByValPush 接受一个 Long 值（32 位），并将其原样留在堆栈上。当函数参数以 ByRef 传递时，值的指针应该被压入堆栈。例如，ByRef param As Double 意味着在调用之前，double 变量的地址应该被压入堆栈，这可以通过使用 ByValPush VarPtr(param) 实现。这就像说：“压入 double 参数地址的 32 位值。” 如何将 Double 类型以 ByVal 而不是 ByRef 传递？使用 ByRefPush 方法解引用任何地址，通过将它指向的 32 位值压入堆栈。由于 Double 是 64 位类型，我们必须调用 ByRefPush 两次。

首先，我们将压入 Double 的后 32 位的值，然后压入前 32 位，因为参数及其内容是从右到左压入的。对于那些还没有理解的人，原因是 esp 寄存器（堆栈指针）在 push 指令后会减少 4 字节（堆栈向下增长）。不要被这些方法的命名混淆，因为它们不应该与函数原型中参数的 ByVal / ByRef 声明相关联。调用 'ByRefPush VarPtr(param) + 4' 就像说：“将 4 字节添加到 double 参数的地址，并使用生成的地址读取一个 32 位值，该值必须压入堆栈。”

通常，自定义类型通过引用传递。但是，即使按值传递，也可以在考虑其大小和字节对齐的情况下应用相同的策略。将结构的每个 32 位值压入，将其地址传递给 ByRefPush 方法，将实现自定义类型的 ByVal 参数传递。String 类型直接映射 BSTR（一种通常通过 COM 使用的表示基本字符串的自动化类型），您可以获得封装缓冲区的指针以及对象的指针。

当 String 类型的参数定义为 ByVal 时，表示函数需要实际缓冲区的指针，这可以通过 StrPtr 检索。当 String 参数定义为 ByRef 时，表示函数需要对象的指针（缓冲区的双指针），这可以通过 VarPtr 检索。在两种情况下，都使用 ByValPush 和适当的地址。您可以在我的测试中找到接收以 ByVal 和 ByRef 传递的字符串和双精度浮点数的调用。

该类的其他五个方法，与前两个一样被存根替换，目的是调用给定地址，同时处理不同类型的返回值：无（无返回值的过程）、32 位值、字符串指针（32 位地址）、64 位值（例如 Currency）和双精度浮点数（64 位浮点值）。请注意，字符串指针返回被特别声明（不能使用 Long 代替），因为 Visual Basic 必须将返回视为 ByVal String。将 Long 复制到 String 的赋值运算符将导致表示缓冲区地址的文本数字，而不是缓冲区内容。查看用于这些方法的存根汇编代码，您会发现我们保存在 TIB 结构 pvArbitrary 中的列表也存储了返回值的位置。这是因为，在调用时，它在转发调用的参数之后被压入堆栈。因此，它必须被移除并保存为 Visual Basic 调用者的返回地址。

结论

在阅读示例代码并尝试根据您的需求进行修改之前，让我总结一下讨论的主题

类的公共方法通过跳转表调用，对应的地址存储在“虚函数表”（VFT）中。指向vftable的指针作为每个类实例中的前4个字节（隐藏成员数据）存储。
编译器将为类的公共变量（成员数据）生成访问器和修饰符，它们的地址将被插入 VFT 中。对于没有公共成员数据的类，VFT 将包含从偏移量 &H1C（28 字节）开始的我们定义的方法的地址，按其声明顺序排列。
替换 VFT 中的地址将把调用重定向到我们需要的任何代码，并且只要原型和调用约定不变，调用就会成功返回。
每个 vftable 由同一类的所有实例共享。因此，为某个对象更改它意味着它甚至会影响在该代码段生命周期内（直到相应的 Visual Basic DLL 被卸载，或者当它驻留在主可执行文件中时，整个进程）稍后创建的对象。
成员过程会获得一个额外的参数（最后压入堆栈），表示我们进行调用的对象的指针。
成员函数会获得两个额外的参数：对象指针（作为第一个参数，最后压入堆栈）和调用者期望返回值的位置（作为最后一个参数，最先压入堆栈）。
参数不会进行字符串转换或其他类型转换，不像使用 Declare 语句定义的函数调用那样。对于返回类型，也可以这样假设。按值传递或返回的字符串可以作为指向封装缓冲区的 32 位指针处理，这与 BSTR 类型描述中已知的一样。
本地代码可以通过将等效的十六进制字符串转换为使用 GlobalAlloc 动态分配的固定内存缓冲区来轻松嵌入。嵌入本地代码后，存根函数可以替换类的方法。这些存根可以转发我们的调用，同时根据其类型调整堆栈并处理返回值。这里没有显示，但甚至可以将使用 __stdcall 调用约定进行的调用转换为由使用 __cdecl 调用约定编写的函数接收。
当这些存根在转发调用返回后需要控制时，它们必须临时存储 Visual Basic 调用者的返回地址。不同的设计也可能需要存储指向返回值的指针，或者（此处未显示）甚至一些上下文寄存器。为了实现线程安全和可重入能力，这些可以保存在作为 LIFO 堆栈动态管理的链表中。指向其头节点的指针可以复制到“线程信息块”（TIB）结构的 pvArbitrary 成员中。
Visual Basic 生成一些验证代码，将 eax 寄存器与 edi、esi、ebx 中的一个寄存器进行比较。如果嵌入的本地代码使用这些寄存器，则必须保存它们并将 eax 设置为零才能返回。

我希望你没有觉得它太晦涩难懂。非常感谢您的阅读，希望它能在您未来的实现中发挥作用。任何形式的反馈都将不胜感激。

修订历史

2007-06-06：原始版本。

已知问题：由于时间不足，示例代码中发现的一个未解决问题留待进一步调查。我可以描述其行为和原因，以便您了解该问题。在 Visual Basic 的 IDE 中运行代码不会报告任何问题，因为第一次机会异常不会显示给用户。堆管理器报告说，将相同的无效地址提供给了 RtlSizeHeap 和 RtlFreeHeap。这似乎发生在返回 String 类型的方法被一个不返回可丢弃 BSTR 的函数替换时。如果该方法被另一个 Visual Basic 实现替换，则一切正常。但是，测试返回 const 缓冲区而不是可丢弃 BSTR 的 GetCommandLine API 时，Visual Basic 尝试删除返回的内存。因此，堆管理器抱怨地址无效。对于返回常量字符串缓冲区的 API，可以使用一种变通方法。将其声明为返回 Long，并从返回的指针复制内存，直到空终止字符。

揭秘编译器：Visual Basic 6.0 中的函数指针

目录

引言

你说的是函数指针吗？

使用非类型安全指针

进行调用

传递参数

嵌入本地代码

返回值

超越基本

使用无类型转发

结论

修订历史