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を使う
- VBで
hostfxr
を読み込む - 実行できるアセンブリコードの制約
- .NETオブジェクトをラップする vb2net アセンブリの作成
- ダウンロード・ソースコードなど
ネイティブコードから.NETを使う
通常、.NETは.NETアセンブリとセットでビルドされたexeファイル、または dotnet
コマンド経由でアセンブリを実行しますが、それとは別にC++などのネイティブコードから.NETを使うための機能が用意されています。そのサンプルはGitHub dotnet/sample リポジトリ内の「.NET Hosting Sample」として公開されています。
実際にアセンブリを実行する方法はいくつかありますが、そのうち「アセンブリ内の関数を実行する」流れは以下の通りです。
hostfxr
ライブラリをロードするhostfxr
内の初期化関数hostfxr_initialize_for_runtime_config
を実行するhostfxr_get_runtime_delegate
関数を使ってhdt_load_assembly_and_get_function_pointer
(= 5) の関数を取得する- 取得した
load_assembly_and_get_function_pointer
の関数を実行してアセンブリの読み込みと関数の取得を行う - 取得した関数を実行する
「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
にその型に定義されているスタティックメソッドを指定することで、そのメソッドを呼び出すための関数ポインターを取得することができます。
※ 上記のコードにおける strTypeName
と strMethodName
は次のセクションで紹介するメソッドとなります。
ただし、関数ポインターを取得できるメソッドには以下の制約があります。
- メソッドは公開されたスタティックメソッドである
- そのメソッドは以下のいずれかを満たす
- 引数が2つで1つ目が IntPtr 型、2つ目が Int32 型、かつ戻り値が Int32 型 (C#だと「
public static int method(IntPtr arg1, int arg2)
」) - 公開されている Delegate とシグネチャが一致
load_assembly_and_get_function_pointer
の第4引数にその Delegate の型名を指定します。
- (.NET 5以降のみ)
System.Runtime.InteropServices.UnmanagedCallersOnlyAttribute
属性を付与したメソッド (この属性を付与した場合、メソッドの引数や戻り値に制約が発生します (例: C#のref
は使用不可))- このメソッドを呼び出す場合、
load_assembly_and_get_function_pointer
の第4引数に「-1」を指定します。
- このメソッドを呼び出す場合、
- 引数が2つで1つ目が IntPtr 型、2つ目が Int32 型、かつ戻り値が Int32 型 (C#だと「
そのため、自由に.NETの処理を呼び出せるわけではなく、呼び出すアセンブリ側もそれに合わせた準備をする必要があります。
また、.NETの主要アセンブリが提供するクラスは、ほとんどが IDispatch
を実装していないため、オブジェクトを IDispatch
に変換してネイティブコードに返すということができません。
.NETオブジェクトをラップする vb2net アセンブリの作成
そこで、以下のようなメソッドを実装したアセンブリを用意することにします。
UnmanagedCallersOnlyAttribute
属性を持つ- アセンブリの名前またはファイル名を
IntPtr
で受け取る - 「
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
および DispatchImpl
、HResults
はページの最後に記載したリポジトリからご確認ください。
上記のように UnmanagedCallersOnlyAttribute
を用いているので ref
や out
は使えませんが、Marshal
クラスのメソッドを用いることで、データの受け渡しを実現しています。
また、オブジェクトをネイティブコード(VB)から利用できるようにするため、返すオブジェクトを DispatchImpl
クラスでラップして IDispatch
に変換ののち返しています。DispatchImpl
では、IDispatch
の GetIDsOfNames
と Invoke
をハンドルし、ラップしたオブジェクトのメソッドを呼び出せるようにしています。
このように定義したメソッドを、以下のように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_NEWENUM
を DispatchImpl
内でハンドルすることで利用可能にしています。
ダウンロード・ソースコードなど
vb2net アセンブリとソースコード(アセンブリのソースコードおよびVBのソースコード)は GitHub で公開しています。以下のリポジトリからアクセスをお願いいたします。
- https://github.com/jet2jet/vb2net
- ダウンロード (添付ファイルの
vb2net.zip
を展開してください)
- ダウンロード (添付ファイルの
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)としています。