dll内の関数を実行する例
Unicode文字列を用いる関数を実行する例
ここまででDispCallFuncの呼出し手順はご理解いただけたかと思いますが、実際にはVBA内の関数をDispCallFuncで呼び出したいケースはあまりないと思われます。
また、標準的なWIN32APIもstdcall呼び出し規約で作成されているので、Declare Functionすれば呼び出すことができます。この場合もDispCallFuncで呼び出したいケースはあまりないと思われます。
そこで、cdecl呼び出し規約で作られた関数を呼び出してみます。ただし、このためにDLLを作成するのは少し手間なのでWIN32APIの中で例外的にcdecl呼び出し規約で作成されているwsprintf関数を呼び出してみます。この関数は可変個の引数を持つがためにstdcallではなくcdeclで作成されています。従って、VBAでDeclare Functionしても呼び出せません。
wsprintf関数はUnicode用のwsprintfW関数とANSI用のwsprintfA関数がありますが、まずは、VBAのString型と親和性の高いwsprintfW関数で試してみます。
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" _
(ByVal lpFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" _
(ByVal hModule As Long) As Long
Private Declare Function DispCallFunc Lib "OleAut32.dll" _
(ByVal pvInstance As Long, _
ByVal oVft As Long, _
ByVal cc As Long, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByVal prgvt As Long, _
ByVal prgpvarg As Long, _
ByVal pvargResult As Long) As Long
Enum tagCALLCONV
CC_FASTCALL = 0
CC_CDECL = 1
CC_MSCPASCAL = CC_CDECL + 1
CC_PASCAL = CC_MSCPASCAL
CC_MACPASCAL = CC_PASCAL + 1
CC_STDCALL = CC_MACPASCAL + 1
CC_FPFASTCALL = CC_STDCALL + 1
CC_SYSCALL = CC_FPFASTCALL + 1
CC_MPWCDECL = CC_SYSCALL + 1
CC_MPWPASCAL = CC_MPWCDECL + 1
CC_MAX = CC_MPWPASCAL
End Enum
Public Sub Test3()
'Test1,2で説明した注釈は省いてあります。
Dim lDispCallFuncResult As Long
Dim vFuncResult As Variant
vFuncResult = Empty
Dim lLibraryHandle As Long
lLibraryHandle = LoadLibrary("user32.dll")
If lLibraryHandle = 0 Then
Debug.Print "LoadLibrary 失敗"
Exit Sub
End If
Dim lProcAddress As Long
lProcAddress = GetProcAddress(lLibraryHandle, "wsprintfW")
If lProcAddress = 0 Then
FreeLibrary lLibraryHandle
Debug.Print "GetProcAddress 失敗"
Exit Sub
End If
'wsprintfW は 次の引数を持っています。
'LPTSTR lpOut , LPCTSTR lpFmt , ...
'wsprintfは、C言語のsprintfとほぼ同等の働きをします。
'第1引数に整形後の文字列を格納する文字列バッファ
'第2引数に整形したい書式文字列
'第3引数以降に埋め込みたい文字列なり数値なり
'今回は "Param1 = %d , Param2 = %s"という書式で数値(%d)と文字列(%s)を埋め込みます。
Dim sOut As String
Dim sFormat As String
Dim lParam1 As Long
Dim sParam2 As String
sOut = String(200, vbNullChar) 'Unicode200文字文の領域を確保し、\0で埋めます。(=400バイト)
sFormat = "Param1 = %d , Param2 = %s"
lParam1 = 123456
sParam2 = "abc"
'今回 wsprintfWには4つに引数を渡しますので、4つのVariant変数を用意します。
'今回は、4つ別個に用意するのは手間なので、配列で用意します。
Dim vParams(0 To 3) As Variant
'wsprintfWでのLP(C)TSTRは 最終的には wchar_t* なので、VBAのStrPtr(文字列変数)を渡す必要があります。
vParams(0) = StrPtr(sOut)
vParams(1) = StrPtr(sFormat)
vParams(2) = lParam1
vParams(3) = StrPtr(sParam2)
'今回は、他のコードでの流用を考えて、次の変数の配列数を動的に宣言します。
Dim iVarTypes() As Integer '見にくいですが最初のiは小文字のIです。
Dim lVarPtrs() As Long
ReDim iVarTypes(0 To UBound(vParams))
ReDim lVarPtrs(0 To UBound(vParams))
Dim i As Long
For i = 0 To UBound(vParams)
iVarTypes(i) = VarType(vParams(i))
lVarPtrs(i) = VarPtr(vParams(i))
Next
'第2引数にGetProcAdressの戻り値を指定します。
'wsprintfW関数の呼び出し規約はcdeclなので、第3引数にCC_CDECLを指定します。
'今回はVC++でのint型=VBでのLong型が戻り値なので
'vbLong(=3)を戻り値の型として指定します。
'引数は4つありますが、今回は、他のコードでの流用を考えて、直接4を指定せず
'Ubound(vParams)+1 により配列の上限数から設定します。
lDispCallFuncResult = DispCallFunc(0, lProcAddress, _
tagCALLCONV.CC_CDECL, VbVarType.vbLong, _
UBound(vParams) + 1, VarPtr(iVarTypes(0)), VarPtr(lVarPtrs(0)), VarPtr(vFuncResult))
FreeLibrary lLibraryHandle
Debug.Print "Test3"
Debug.Print "lDispCallFuncResult = " & lDispCallFuncResult
Debug.Print "vFuncResult = " & vFuncResult
'第1引数にsOutのUnicode文字列バッファのアドレスを指定したので
'wsprintfW APIは、200文字のChrW(0)で埋められたsOutの先頭部分をnull終端文字列で上書きします。
'よって、VB側で欲しい文字列は、最初に見つかったChrW(0)(=vbNullChar)より左側の文字列です。
Debug.Print Left(sOut, InStr(1, sOut, vbNullChar) - 1)
'ただInStrを使わなくても、wsprintfWは整形した文字列の長さを返しますので
Debug.Print Left(sOut, vFuncResult)
'とすることができます。
End Sub
