Office365中VBA代码添加PtrSafe后出现ByRef参数类型不匹配错误求助

问题背景 #

原有VBA Hook函数在旧环境运行正常，切换到64位Office365后，添加PtrSafe解决编译错误，但出现byref argument type mismatch错误，报错指向Boolean类型。

核心问题分析 #

1. API参数类型不匹配：64位VBA下，Windows API的参数类型需严格对应，比如VirtualProtect的lpflOldProtect参数是指向32位DWORD的指针，不能用LongPtr，需用Long类型。
2. Boolean类型兼容问题：VBA的Boolean是2字节类型，但Windows API的BOOL是4字节int，直接赋值会导致类型不匹配，需显式转换。
3. 全局变量与指令适配64位：pFunc等指针变量需更新为LongPtr，同时32位的跳转指令在64位环境下无法正常工作，需要调整指令格式。

修复后的完整代码 #

首先在模块顶部添加64位兼容的API声明与全局变量：

' 64位兼容的API声明
#If VBA7 Then
    Public Declare PtrSafe Function GetModuleHandleA Lib "kernel32.dll" (ByVal lpModuleName As String) As LongPtr
    Public Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As LongPtr, ByVal lpProcName As String) As Long
    Public Declare PtrSafe Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As LongPtr, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Public Declare PtrSafe Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    ' 旧版32位兼容声明
    Public Declare Function GetModuleHandleA Lib "kernel32.dll" (ByVal lpModuleName As String) As Long
    Public Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Public Declare Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Public Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If

' 全局变量适配64位
Public pFunc As LongPtr
Public OriginBytes(0 To 5) As Byte
Public HookBytes(0 To 11) As Byte ' 64位跳转指令需要12字节空间
Public Flag As Boolean

' 获取过程地址的辅助函数（64位兼容）
#If VBA7 Then
    Public Function GetPtr(ByVal addr As LongPtr) As LongPtr
        GetPtr = addr
    End Function
#Else
    Public Function GetPtr(ByVal addr As Long) As Long
        GetPtr = addr
    End Function
#End If

' 自定义钩子函数框架（需补充具体逻辑）
#If VBA7 Then
    Public Function MyDialogBoxParam(ByVal hInstance As LongPtr, ByVal lpTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Long
        ' 此处编写钩子处理逻辑
        MyDialogBoxParam = 0
    End Function
#Else
    Public Function MyDialogBoxParam(ByVal hInstance As Long, ByVal lpTemplateName As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Long
        MyDialogBoxParam = 0
    End Function
#End If

修改后的Hook函数：

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As LongPtr
    Dim OriginProtect As Long ' 修正为Long，匹配API的DWORD指针类型
    Dim vRet As Long ' 用Long接收API返回值，避免Boolean类型不匹配

    Hook = False

    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
    If pFunc = 0 Then Exit Function ' 检查函数地址是否获取成功

    vRet = VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) ' PAGE_EXECUTE_READWRITE = &H40
    If vRet <> 0 Then
        MoveMemory TmpBytes(0), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then
            MoveMemory OriginBytes(0), ByVal pFunc, 6

            p = GetPtr(AddressOf MyDialogBoxParam)

            ' 64位环境下使用jmp指令跳转（替代原32位的push+ret）
            HookBytes(0) = &HFF
            HookBytes(1) = &H25
            MoveMemory HookBytes(2), ByVal VarPtr(p), 8 ' 写入64位目标地址
            HookBytes(10) = &H90
            HookBytes(11) = &H90

            MoveMemory ByVal pFunc, HookBytes(0), 12 ' 写入12字节的跳转指令
            Flag = True
            Hook = True
        End If
        ' 恢复内存保护属性
        VirtualProtect ByVal pFunc, 6, OriginProtect, OriginProtect
    End If
End Function

关键修复点说明 #

1. VirtualProtect参数修正：将OriginProtect从LongPtr改为Long，匹配API要求的LPDWORD类型。
2. API返回值处理：用Long类型变量接收VirtualProtect的返回值，再判断是否有效，避免直接与Boolean类型交互导致的不匹配。
3. 64位跳转指令调整：原32位的push+ret指令无法适配64位地址，改用jmp qword ptr [addr]指令，扩展数组长度以容纳12字节指令。
4. 全局变量类型适配：所有存储指针的变量统一改为LongPtr，确保64位环境下地址存储正确。

内容的提问来源于stack exchange，提问作者Madhusudan Dudhani