如何将VARIANT转换为托管对象？

Question

这是原始VBA代码的来源：Original VBA code

我将这些功能转换为VB.Net

继承了我到目前为止的代码（注意我为了简洁而删除了一些代码）

Imports System.Runtime.InteropServices

Public Class VirtualCOMObject
    Private Const OPTION_BASE As Long = 0
    Private Const OPTION_FLAGS As Long = 2
    Private Const OPTION_INCLUDE_REFERENCEDOCS As Long = 0
    Private Const OPTION_DISABLEDCLASSES As String = ""
    Private Const DECOMPRESSED_EXT As Long = 56493
    Private Const SIZEOF_PTR32 As Long = &H4
    Private Const SIZEOF_PTR64 As Long = &H8
    Private Const PAGE_EXECUTE_RW As Long = &H40
    Private Const MEM_RESERVE_AND_COMMIT As Long = &H3000
    Private Const ERR_OUT_OF_MEMORY As Long = &H7

    Private m_ClassFactory As Object

    <DllImport("kernel32.dll", CharSet:=CharSet.None, ExactSpelling:=False, SetLastError:=True)>
    Private Shared Function VirtualAlloc(
                ByVal lpAddress As IntPtr,
                ByVal dwSize As UIntPtr,
                ByVal flAllocationType As AllocationType,
                ByVal flProtect As MemoryProtection) As IntPtr
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Public Shared Function GetModuleHandleA(ByVal lpModuleName As String) As IntPtr
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True)>
    Public Shared Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True, EntryPoint:="RtlMoveMemory")>
    Public Shared Sub CopyMemoryAnsi(ByVal Dest As IntPtr, ByVal Source As String, ByVal Size As IntPtr)
    End Sub

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True, EntryPoint:="RtlMoveMemory")>
    Public Shared Sub CastToObject(ByRef Dest As Object, ByRef Source As IntPtr, ByVal Size As IntPtr)
    End Sub

    Declare Sub CopyMemoryByref Lib "Kernel32.dll" Alias "RtlMoveMemory" (ByRef dest As Integer, ByRef source As Integer, ByVal numBytes As Integer)

    <Flags>
    Public Enum AllocationType As UInteger
        COMMIT = 4096
        RESERVE = 8192
        RESET = 524288
        TOP_DOWN = 1048576
        WRITE_WATCH = 2097152
        PHYSICAL = 4194304
        LARGE_PAGES = 536870912
    End Enum

    <Flags>
    Public Enum MemoryProtection As UInteger
        NOACCESS = 1
        [READONLY] = 2
        READWRITE = 4
        WRITECOPY = 8
        EXECUTE = 16
        EXECUTE_READ = 32
        EXECUTE_READWRITE = 64
        EXECUTE_WRITECOPY = 128
        GUARD_Modifierflag = 256
        NOCACHE_Modifierflag = 512
        WRITECOMBINE_Modifierflag = 1024
    End Enum


    Public Sub Class_Initialize()

        Dim NativeCode As String
        Dim LoaderVTable As IDispatchVTable
        Dim Ignore As Boolean
        Dim ClassFactoryLoader As Object

#If VBA7 = False Then
        Dim Kernel32Handle As Long
        Dim GetProcAddressPtr As Long
        Dim NativeCodeAddr As Long
        Dim LoaderVTablePtr As Long
        Dim LoaderObj As Long
#Else
        Dim Kernel32Handle As LongPtr
        Dim GetProcAddressPtr As LongPtr
        Dim NativeCodeAddr As LongPtr
        Dim LoaderVTablePtr As LongPtr
        Dim LoaderObj As LongPtr
#End If

        '#If Win64 = False Then
        '        Const SIZEOF_PTR = SIZEOF_PTR32
        '#Else
        Const SIZEOF_PTR = SIZEOF_PTR64
        '#End If

        'NativeCode string initialized here

        NativeCode = NativeCode & "%EEEE%::::RPZPPPh$#$$j PPPPH+T$ t5AYAZkDTX 5j7{{L3TQ@M3LR@A)DR@Xf5@@fA)AUXI3DR@ZZZZZZ?!, @RY3LDl3TA@PY,VH)DJ@XXXXXXXXXX%EEEE%::::VSPPPPj PPPPPPPP4T)D$04P)D$,4  '4 )D$($ PZ3D$@+D$ YQ3H +L$ XP3Q +T$0XPf55nf)BUR[YQ^VXP2Cf<0tF1+++ 
'==========================================================================     
'Code removed for brevity. The full string can be found on the links above
'==========================================================================
ij DdEXXZPEdkHOqrLSKGZT;pOCUHvFst;z??qapyyZtzrUuhX_;hnJmp;n;kGQF^AF oqvSDDS^;TufXPumRLDVQSzCbT]x]keCb?fWgTwFvTwEj0" 

        ClassFactoryLoader = New Object()
        ' Allocate the executable memory for the object
        NativeCodeAddr = VirtualAlloc(0, Len(NativeCode) + DECOMPRESSED_EXT, MEM_RESERVE_AND_COMMIT, PAGE_EXECUTE_RW)

        If NativeCodeAddr <> 0 Then

            ' Copy the x86 and x64 native code into the allocated memory
            Call CopyMemoryAnsi(NativeCodeAddr, NativeCode, Len(NativeCode))

            ' Force the memory address into an Object variable (also triggers the shell code)
            LoaderVTable.QueryInterface = NativeCodeAddr    'longptr
            LoaderVTablePtr = VarPtr(LoaderVTable)          'ptr to LoaderVTable(IDispatchVTable structure)
            LoaderObj = VarPtr(LoaderVTablePtr)

            '==========================================================================
            'ERROR: Managed Debugging Assistant 'InvalidVariant' : 'An invalid VARIANT was detected during a conversion from an unmanaged VARIANT to a managed object. Passing invalid VARIANTs to the CLR can cause unexpected exceptions, corruption or data loss.'
            '==========================================================================
            Call CastToObject(ClassFactoryLoader, LoaderObj, SIZEOF_PTR)    'CastToObject=RtlMoveMemory
            Ignore = TypeOf ClassFactoryLoader Is VBA.Collection            'ClassFactoryLoader(object type)
            m_ClassFactory = (ClassFactoryLoader)                       'object

            ' Initialize our COM object
            Kernel32Handle = GetModuleHandleA("kernel32")
            GetProcAddressPtr = GetProcAddress(Kernel32Handle, "GetProcAddress")

            'With m_ClassFactory
            '    Call .Init(Kernel32Handle, GetProcAddressPtr, OPTION_BASE + OPTION_FLAGS, NativeCode, New FilePropertyExplorer_Helper)
            '    Ignore = TypeOf .FileProperties Is FileProperties And TypeOf .FileProperty Is FileProperty
            'End With

        Else

            Err.Raise(ERR_OUT_OF_MEMORY)

        End If
    End Sub

    Function OpenFile(ByVal FilePath As String, Optional ByVal WriteSupport As Boolean = False) As FileProperties
        OpenFile = m_ClassFactory.OpenFile(FilePath, WriteSupport)
    End Function

End Class

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi, Pack:=1)>
Public Structure IDispatchVTable
    Public QueryInterface As IntPtr
    Public AddRef As IntPtr
    Public Release As IntPtr
    Public GetTypeInfoCount As IntPtr
    Public GetTypeInfo As IntPtr
    Public GetIDsOfNames As IntPtr
    Public Invoke As IntPtr
End Structure

VarToPtr。我不确定这段代码。在互联网上找到它并稍加修改

Module VarPtrSupport
    ' a delegate that can point to the VarPtrCallback method
    Private Delegate Function VarPtrCallbackDelegate(
       ByVal address As Integer, ByVal unused1 As Integer,
       ByVal unused2 As Integer, ByVal unused3 As Integer) As Integer

    ' two aliases for the CallWindowProcA Windows API method
    ' notice that 2nd argument is passed by-reference
    Private Declare Function CallWindowProc Lib "user32" _
       Alias "CallWindowProcA" _
       (ByVal wndProc As VarPtrCallbackDelegate, ByRef var As Short,
       ByVal unused1 As Integer, ByVal unused2 As Integer,
       ByVal unused3 As Integer) As Integer

    Private Declare Function CallWindowProc Lib "user32" _
       Alias "CallWindowProcA" _
       (ByVal wndProc As VarPtrCallbackDelegate, ByRef var As Integer,
       ByVal unused1 As Integer, ByVal unused2 As Integer,
       ByVal unused3 As Integer) As Integer
    ' ...add more overload to support other data types...

    Private Declare Function CallWindowProc Lib "user32" _
       Alias "CallWindowProcA" _
       (ByVal wndProc As VarPtrCallbackDelegate, ByRef var As IDispatchVTable,
       ByVal unused1 As Integer, ByVal unused2 As Integer,
       ByVal unused3 As Integer) As Integer
    Private Declare Function CallWindowProc Lib "user32" _
       Alias "CallWindowProcA" _
       (ByVal wndProc As VarPtrCallbackDelegate, ByRef var As Long,
       ByVal unused1 As Integer, ByVal unused2 As Integer,
       ByVal unused3 As Integer) As Integer
    Private Declare Function CallWindowProc Lib "user32" _
       Alias "CallWindowProcA" _
       (ByVal wndProc As VarPtrCallbackDelegate, ByRef var As IntPtr,
       ByVal unused1 As Integer, ByVal unused2 As Integer,
       ByVal unused3 As Integer) As Integer

    ' the method that is indirectly executed when calling CallVarPtrSupport 
    ' notice that 1st argument is declared by-value (this is the
    ' argument that receives the 2nd value passed to CallVarPtrSupport)
    Private Function VarPtrCallback(ByVal address As Integer,
          ByVal unused1 As Integer, ByVal unused2 As Integer,
          ByVal unused3 As Integer) As Integer
        Return address
    End Function

    ' two overloads of VarPtr
    Public Function VarPtr(ByRef var As Short) As Integer
        Return CallWindowProc(AddressOf VarPtrCallback, var, 0, 0, 0)
    End Function
    Public Function VarPtr(ByRef var As Integer) As Integer
        Return CallWindowProc(AddressOf VarPtrCallback, var, 0, 0, 0)
    End Function
    Public Function VarPtr(ByRef var As IDispatchVTable) As Integer
        Return CallWindowProc(AddressOf VarPtrCallback, var, 0, 0, 0)
    End Function
    Public Function VarPtr(ByRef var As Long) As Integer
        Return CallWindowProc(AddressOf VarPtrCallback, var, 0, 0, 0)
    End Function
    Public Function VarPtr(ByRef var As IntPtr) As Integer
        Return CallWindowProc(AddressOf VarPtrCallback, var, 0, 0, 0)
    End Function
    ' ...add more overload to support other data types...
End Module

现在我得到错误（我在代码中添加了注释）：错误：托管调试助手'InvalidVariant'：'在从非托管VARIANT到托管对象的转换过程中检测到无效的VARIANT。将无效的VARIANT传递给CLR可能会导致意外的异常，损坏或数据丢失。

但整体而言......我实际上不确定我是否正确地将正确转换VBA代码放在正确的轨道上，因为我不必安装excel来测试VBA。

该代码实质上创建了一个动态COM对象，然后用于获取扩展文件属性。

如果有人能告诉我我做错了什么，我们将不胜感激。此外，代码需要在.Net中，而不是导入任何VBA / VB DLL。