Programming Field

VBから.NET(旧.NET Core)を利用してみる

以前「VBからCLR(.NET)を利用する」にてVBから.NET Frameworkを利用する方法を紹介しましたが、.NET(旧.NET Core)は枠組みが異なるため同じ方法を使うことはできません。しかし.NETにはネイティブコードから.NETアセンブリなどを利用するための機能が用意されているため、それを使ってCOMラッパーを使わずにVB(VBA)から.NETにアクセスしてみた内容を紹介します。

※ なお、以下ではVBA 7.0を前提に、.NET 6以降のバージョンの利用を想定して記述しています。

ネイティブコードから.NETを使う

通常、.NETは.NETアセンブリとセットでビルドされたexeファイル、または dotnet コマンド経由でアセンブリを実行しますが、それとは別にC++などのネイティブコードから.NETを使うための機能が用意されています。そのサンプルはGitHub dotnet/sample リポジトリ内の「.NET Hosting Sample」として公開されています。

実際にアセンブリを実行する方法はいくつかありますが、そのうち「アセンブリ内の関数を実行する」流れは以下の通りです。

  1. hostfxr ライブラリをロードする
  2. hostfxr 内の初期化関数 hostfxr_initialize_for_runtime_config を実行する
  3. hostfxr_get_runtime_delegate 関数を使って hdt_load_assembly_and_get_function_pointer(= 5) の関数を取得する
  4. 取得した load_assembly_and_get_function_pointer の関数を実行してアセンブリの読み込みと関数の取得を行う
  5. 取得した関数を実行する

hostfxr ライブラリをロードする」については、ネイティブC/C++で書く場合は nethost ライブラリにある関数を使うことで、決められた検索方法に沿って hostfxr ライブラリが検索されてそのパスが取得できるため、それを使って読み込み(LoadLibrary)します。

しかし厳密な処理を必要としないのであれば、「dotnet.exe が存在するディレクトリから見て host\fxr\<version> ディレクトリにある hostfxr.dll を探してロードする」というやり方でもなんとかなります。

VBで hostfxr を読み込む

VBのコードで簡易的に hostfxr.dll を探すコードは以下のようになります。(最新バージョンの hostfxr.dll を検索します。)

Private Declare PtrSafe Function SearchPath Lib "kernel32.dll" Alias "SearchPathA" _
    (ByVal lpPath As String, ByVal lpFileName As String, ByVal lpExtension As String, _
    ByVal nBufferLength As Long, ByVal lpBuffer As String, ByRef lpFilePart As LongPtr) As Long

Private Function CompareVersionString(ByRef a() As String, ByRef b() As String) As Integer
    If CInt(a(0)) <> CInt(b(0)) Then
        CompareVersionString = CInt(a(0)) - CInt(b(0))
        Exit Function
    End If
    If UBound(a) = 0 Then
        CompareVersionString = IIf(UBound(b) = 0, 0, -1)
        Exit Function
    ElseIf UBound(b) = 0 Then
        CompareVersionString = 1
        Exit Function
    End If
    If CInt(a(1)) <> CInt(b(1)) Then
        CompareVersionString = CInt(a(1)) - CInt(b(1))
        Exit Function
    End If
    If UBound(a) = 1 Then
        CompareVersionString = IIf(UBound(b) = 1, 0, -1)
        Exit Function
    ElseIf UBound(b) = 1 Then
        CompareVersionString = 1
        Exit Function
    End If
    If CInt(a(2)) <> CInt(b(2)) Then
        CompareVersionString = CInt(a(2)) - CInt(b(2))
        Exit Function
    End If
    If UBound(a) = 2 Then
        CompareVersionString = IIf(UBound(b) = 2, 0, -1)
        Exit Function
    ElseIf UBound(b) = 2 Then
        CompareVersionString = 1
        Exit Function
    End If
    CompareVersionString = CInt(a(3)) - CInt(b(3))
End Function

Private Function SearchHostFXR() As String
    ' search 'dotnet.exe'
    Dim lnLength As Long
    Dim strBuffer As String, p As LongPtr
    strBuffer = String$(260, 0)
    lnLength = SearchPath(vbNullString, "dotnet.exe", vbNullString, 260, strBuffer, p)
    If lnLength = 0 Then
        SearchHostFXR = ""
        Exit Function
    End If
    ' If in C++ I use 'p', but in VB 'p' is not a valid address, so
    ' I search '\' to extract directory path name
    Dim strDotNetPath As String
    strDotNetPath = Left$(strBuffer, lnLength)
    lnLength = InStrRev(strDotNetPath, "\")
    If lnLength > 0 Then
        ' including '\'
        strDotNetPath = Left$(strDotNetPath, lnLength)
    Else
        strDotNetPath = ""
    End If
    Dim strHostFXRBasePath As String
    Dim sLargestVersion() As String
    Dim strTargetLargest As String
    ReDim sLargestVersion(0)
    sLargestVersion(0) = "0"
    strTargetLargest = ""
    strHostFXRBasePath = strDotNetPath + "host\fxr\"
    strBuffer = Dir(strHostFXRBasePath + "*.*", vbDirectory)
    Do While strBuffer <> ""
        Dim s() As String
        If strBuffer <> "." And strBuffer <> ".." Then
            On Error Resume Next
            s = Split(strBuffer, ".")
            If Err.Number = 0 Then
                If CompareVersionString(sLargestVersion, s) < 0 Then
                    sLargestVersion = s
                    strTargetLargest = strHostFXRBasePath + strBuffer
                End If
            End If
            Call Err.Clear
            On Error GoTo 0
        End If
        strBuffer = Dir()
    Loop
    If strTargetLargest <> "" Then
        strTargetLargest = strTargetLargest + "\hostfxr.dll"
    End If
    SearchHostFXR = strTargetLargest
End Function

このコードにおける SearchHostFXR 関数を使ってパスを取得し、LoadLibrary に渡します。

Private Declare PtrSafe Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" _
    (ByVal lpModuleName As String) As LongPtr
Private Declare PtrSafe Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" _
    (ByVal lpLibFileName As String) As LongPtr
Private Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" _
    (ByVal hLibModule As LongPtr) As Long

' In initialization process

    Dim strHostFXR As String
    strHostFXR = SearchHostFXR()
    If strHostFXR = "" Then
        Call Err.Raise(53)
        Exit Sub
    End If
    Dim hInstHostFXR As LongPtr
    hInstHostFXR = GetModuleHandle(strHostFXR)
    If hInstHostFXR = 0 Then
        hInstHostFXR = GetModuleHandle("hostfxr.dll")
        If hInstHostFXR <> 0 Then
            Call Err.Raise(5, "hostfxr.dll is already initialized with different version")
            Exit Sub
        End If
        hInstHostFXR = LoadLibrary(strHostFXR)
        If hInstHostFXR = 0 Then
            ' Report an error
            Call RaiseWin32Error(Err.LastDllError)
            Exit Sub
        End If
    End If

読み込みが完了したら、.NETの初期化に使う関数のポインターを取得します。

' In global declaration
Private m_pfnClose As LongPtr

' In initialization process

    Dim pfnInitialize As LongPtr
    Dim pfnGetRuntimeDelegate As LongPtr
    pfnInitialize = GetProcAddress(hInstHostFXR, "hostfxr_initialize_for_runtime_config")
    m_pfnClose = GetProcAddress(hInstHostFXR, "hostfxr_close")
    pfnGetRuntimeDelegate = GetProcAddress(hInstHostFXR, "hostfxr_get_runtime_delegate")

これらを使って初期化を行い、.NETのアセンブリの読み込みなどを行います。

※ 関数ポインターを使ってVBから関数を呼び出すには、DispCallFunc 関数を使うのが楽です(第1引数に 0、第2引数に関数ポインターを指定します)。
hostfxr.dll のエクスポート関数はすべて cdecl 呼び出し規約になっています。

Private Declare PtrSafe Function DispCallFunc Lib "oleaut32.dll" _
    (ByVal pvInstance As LongPtr, _
    ByVal oVft As LongPtr, _
    ByVal cc As Long, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByRef prgvt As Integer, _
    ByRef prgpvarg As LongPtr, _
    ByRef pvargResult As Variant) As Long

    Dim e As Long
    Dim avt() As Integer, avptr() As LongPtr, avarg() As Variant, vr As Variant
    Dim handle As LongPtr
    ReDim avt(2), avarg(2), avptr(2)
    avt(0) = VarType(handle) ' long-ptr var type
    avarg(0) = StrPtr(vb2netRuntimeConfig) ' ".runtimeconfig.json" file
    avptr(0) = VarPtr(avarg(0))
    avt(1) = VarType(handle)
    avarg(1) = CLngPtr(0)
    avptr(1) = VarPtr(avarg(1))
    avt(2) = VarType(handle)
    avarg(2) = VarPtr(handle)
    avptr(2) = VarPtr(avarg(2))
    ' 1: CC_CDECL
    e = DispCallFunc(0, pfnInitialize, 1, vbLong, 3, avt(0), avptr(0), vr)
    If e < 0 Then
        Call FreeLibrary(hInstHostFXR)
        Call Err.Raise(e)
        Exit Sub
    End If
    e = vr
    If e < 0 Then
        Call FreeLibrary(hInstHostFXR)
        Call Err.Raise(e)
        Exit Sub
    End If

実行できるアセンブリコードの制約

.NETアセンブリを読み込んで実行したい処理を関数ポインターとして取得するには、hostfxr_get_runtime_delegate 関数から load_assembly_and_get_function_pointer を取得し、その関数を呼び出します。

hostfxr.dll の関数は cdecl 呼び出し規約ですが、、hostfxr_get_runtime_delegate 関数で得られる関数は stdcall 呼び出し規約になります。

Private Sub hostfxr_close(ByVal handle As LongPtr)
    Dim avt() As Integer, avptr() As LongPtr, avarg() As Variant, vr As Variant
    Dim e As Long
    ReDim avt(0), avarg(0), avptr(0)
    avt(0) = VarType(handle)
    avarg(0) = handle
    avptr(0) = VarPtr(avarg(0))
    e = DispCallFunc(0, m_pfnClose, 1, vbLong, 1, avt(0), avptr(0), vr)
End Sub

    Dim pfnLoadAssemblyAndGetFunctionPointer As LongPtr
    avt(0) = VarType(handle)
    avarg(0) = handle
    avt(1) = vbLong
    avarg(1) = hdt_load_assembly_and_get_function_pointer
    avt(2) = VarType(handle)
    avarg(2) = VarPtr(pfnLoadAssemblyAndGetFunctionPointer)
    ' 1: CC_CDECL
    e = DispCallFunc(0, pfnGetRuntimeDelegate, 1, vbLong, 3, avt(0), avptr(0), vr)
    If e < 0 Then
        Call hostfxr_close(handle)
        'Call FreeLibrary(hInstHostFXR)
        Call Err.Raise(e)
        Exit Sub
    End If
    e = vr
    If e < 0 Then
        Call hostfxr_close(handle)
        'Call FreeLibrary(hInstHostFXR)
        Call Err.Raise(e)
        Exit Sub
    End If

    Dim strAssemblyFile As String, strTypeName As String, strMethodName As String
    strAssemblyFile = vb2netFile
    strTypeName = "vb2net.Global, vb2net"
    strMethodName = "LoadAssembly"
    ReDim avt(5), avarg(5), avptr(5)
    avt(0) = VarType(handle) ' long-ptr var type
    avarg(0) = StrPtr(strAssemblyFile) ' assembly_path
    avptr(0) = VarPtr(avarg(0))
    avt(1) = VarType(handle) ' long-ptr var type
    avarg(1) = StrPtr(strTypeName) ' type_name
    avptr(1) = VarPtr(avarg(1))
    avt(2) = VarType(handle)
    avarg(2) = StrPtr(strMethodName) ' method_name
    avptr(2) = VarPtr(avarg(2))
    avt(3) = VarType(handle)
    avarg(3) = CLngPtr(-1) ' delegate_type_name (-1: UNMANAGEDCALLERSONLY_METHOD)
    avptr(3) = VarPtr(avarg(3))
    avt(4) = VarType(handle)
    avarg(4) = CLngPtr(0) ' reserved
    avptr(4) = VarPtr(avarg(4))
    avt(5) = VarType(handle)
    avarg(5) = VarPtr(m_pfnLoadAssembly) ' delegate
    avptr(5) = VarPtr(avarg(5))

    ' 4: CC_STDCALL
    e = DispCallFunc(0, pfnLoadAssemblyAndGetFunctionPointer, 4, vbLong, 6, avt(0), avptr(0), vr)
    If e < 0 Then
        Call hostfxr_close(handle)
        'Call FreeLibrary(hInstHostFXR)
        Call Err.Raise(e)
        Exit Sub
    End If
    e = vr
    If e < 0 Then
        Call LogErrorInfo(e)
        Call hostfxr_close(handle)
        'Call FreeLibrary(hInstHostFXR)
        Call Err.Raise(e)
        Exit Sub
    End If

上記のコードにおいて、strAssemblyFile にアセンブリのファイルパス、strTypeName に型の完全修飾名、strMethodName にその型に定義されているスタティックメソッドを指定することで、そのメソッドを呼び出すための関数ポインターを取得することができます。

※ 上記のコードにおける strTypeNamestrMethodName は次のセクションで紹介するメソッドとなります。

ただし、関数ポインターを取得できるメソッドには以下の制約があります。

  • メソッドは公開されたスタティックメソッドである
  • そのメソッドは以下のいずれかを満たす
    1. 引数が2つで1つ目が IntPtr 型、2つ目が Int32 型、かつ戻り値が Int32 型 (C#だと「public static int method(IntPtr arg1, int arg2)」)
    2. 公開されている Delegate とシグネチャが一致
      • load_assembly_and_get_function_pointer の第4引数にその Delegate の型名を指定します。
    3. (.NET 5以降のみ) System.Runtime.InteropServices.UnmanagedCallersOnlyAttribute 属性を付与したメソッド (この属性を付与した場合、メソッドの引数や戻り値に制約が発生します (例: C#の ref は使用不可))
      • このメソッドを呼び出す場合、load_assembly_and_get_function_pointer の第4引数に「-1」を指定します。

そのため、自由に.NETの処理を呼び出せるわけではなく、呼び出すアセンブリ側もそれに合わせた準備をする必要があります。

また、.NETの主要アセンブリが提供するクラスは、ほとんどが IDispatch を実装していないため、オブジェクトを IDispatch に変換してネイティブコードに返すということができません。

.NETオブジェクトをラップする vb2net アセンブリの作成

そこで、以下のようなメソッドを実装したアセンブリを用意することにします。

  1. UnmanagedCallersOnlyAttribute 属性を持つ
  2. アセンブリの名前またはファイル名を IntPtr で受け取る
  3. IDispatch を実装したオブジェクトラッパー」を返すためのポインターを IntPtr で受け取る

C#のコードは以下の通りです。

using System.Reflection;
using System.Runtime.InteropServices;

namespace vb2net
{
    public class Global
    {
        // C++ signature: HRESULT LoadAssembly(LPCWSTR assemblyNamePtr, IDispatch** pResult);
        [UnmanagedCallersOnly]
        public static int LoadAssembly(IntPtr assemblyNamePtr, IntPtr pResult)
        {
            if (assemblyNamePtr == IntPtr.Zero || pResult == IntPtr.Zero)
                return HResults.E_POINTER;
            try
            {
                var assemblyName = Marshal.PtrToStringUni(assemblyNamePtr);
                if (assemblyName == null)
                {
                    return HResults.E_POINTER;
                }
                var assembly = Assembly.Load(assemblyName);
                var dispImpl = new DispatchImpl(assembly);
                var disp = dispImpl as IDispatch;
                var dispPtr = Marshal.GetComInterfaceForObject(disp, typeof(IDispatch));
                Marshal.Copy(new IntPtr[] { dispPtr }, 0, pResult, 1);
                return 0;
            }
            catch (Exception e)
            {
                return Marshal.GetHRForException(e);
            }
        }

        // C++ signature: HRESULT LoadAssemblyFromFile(LPCWSTR fileNamePtr, IDispatch** pResult);
        [UnmanagedCallersOnly]
        public static int LoadAssemblyFromFile(IntPtr fileNamePtr, IntPtr pResult)
        {
            if (fileNamePtr == IntPtr.Zero || pResult == IntPtr.Zero)
                return HResults.E_POINTER;
            try
            {
                var fileName = Marshal.PtrToStringUni(fileNamePtr);
                if (fileName == null)
                {
                    return HResults.E_POINTER;
                }
                var assembly = Assembly.LoadFile(fileName);
                var dispImpl = new DispatchImpl(assembly);
                var disp = dispImpl as IDispatch;
                var dispPtr = Marshal.GetComInterfaceForObject(disp, typeof(IDispatch));
                Marshal.Copy(new IntPtr[] { dispPtr }, 0, pResult, 1);
                return 0;
            }
            catch (Exception e)
            {
                return Marshal.GetHRForException(e);
            }
        }
    }
}

※ 上記に出てくる IDispatch および DispatchImplHResults はページの最後に記載したリポジトリからご確認ください。

上記のように UnmanagedCallersOnlyAttribute を用いているので refout は使えませんが、Marshal クラスのメソッドを用いることで、データの受け渡しを実現しています。

また、オブジェクトをネイティブコード(VB)から利用できるようにするため、返すオブジェクトを DispatchImpl クラスでラップして IDispatch に変換ののち返しています。DispatchImpl では、IDispatchGetIDsOfNamesInvoke をハンドルし、ラップしたオブジェクトのメソッドを呼び出せるようにしています。

このように定義したメソッドを、以下のようにVBから利用しやすい形にします。

Public Function LoadAssembly(ByVal AssemblyName As String) As Object
    ' (一部省略)
    Dim avt() As Integer, avptr() As LongPtr, avarg() As Variant, vr As Variant
    Dim e As Long
    ReDim avt(1), avarg(1), avptr(1)
    avt(0) = VarType(avptr(0))
    avarg(0) = StrPtr(AssemblyName)
    avptr(0) = VarPtr(avarg(0))
    avt(1) = VarType(avptr(1))
    avarg(1) = VarPtr(LoadAssembly)
    avptr(1) = VarPtr(avarg(1))
    e = DispCallFunc(0, m_pfnLoadAssembly, 4, vbLong, 2, avt(0), avptr(0), vr)
    If e < 0 Then
        Call Err.Raise(e)
        Exit Function
    End If
    e = vr
    If e < 0 Then
        Call Err.Raise(e)
        Exit Function
    End If
End Function

これを利用すると、以下のように.NETの機能をVBから(ほぼ)直接扱うことができます。

    ' Get type of System.String
    Dim asmMscorlib As Object, typeString As Object
    Set asmMscorlib = LoadAssembly("mscorlib")
    Set typeString = asmMscorlib.GetType_2("System.String")
    ' Get constructor of System.Text.RegularExpressions.Regex (with parameters: System.String)
    Dim asmRegex As Object, typeRegex As Object, ctorRegex As Object
    Set asmRegex = LoadAssembly("System.Text.RegularExpressions")
    Set typeRegex = asmRegex.GetType_2("System.Text.RegularExpressions.Regex")
    Set ctorRegex = typeRegex.GetConstructor(Array(typeString))
    ' Create System.Text.RegularExpressions.Regex instance
    Dim regex As Object
    Set regex = ctorRegex.Invoke_3(Array("(\d+) (\d+)"))
    ' Executes Match
    Dim m As Object
    Set m = regex.Match_4("123 456")
    Dim v As Variant
    Debug.Print m.Groups.Count
    For Each v In m.Groups
        Debug.Print v.Value
    Next v

DispatchImpl ではオーバーロードされたメソッドを「_2」などの接尾辞を付けて区別するようにしています。現時点では型情報の中の出現順で番号が付けられているため、どれがどのメソッドに対応するかは実際に試さないとわかりません。
※ コード例では For Each ステートメントを使っていますが、これは DISPID_NEWENUMDispatchImpl 内でハンドルすることで利用可能にしています。

ダウンロード・ソースコードなど

vb2net アセンブリとソースコード(アセンブリのソースコードおよびVBのソースコード)は GitHub で公開しています。以下のリポジトリからアクセスをお願いいたします。

vb2net.zip を展開後、「vb2net.bas」と「ExitHandler.bas」をVBプロジェクトにインポートして利用してください。また、アセンブリを利用するには InitializeVb2net 関数を呼び出す必要があります。(引数には vb2net.dll のパスを指定してください。)

※ 実装の都合上、vb2net.dll と同じディレクトリに vb2net.runtimeconfig.json ファイルを置いてください。(この制約は「vb2net.bas」の実装を調整することで変えることができます。)

使い方の例は「vb2net.bas」にある「Sample」プロシージャをご覧ください。

なお、ライセンスは「修正BSDライセンス」(3条項BSDライセンス; BSD-3-Clause)としています。