VBAでの関数ポインタの利用方法

cdecl呼び出し規約のDLL関数をVBAから利用する方法

ANSI（≒SJIS）文字列を用いる関数を実行する例

　つぎに、VBAのString型と親和性の低いwsprintfA関数で試してみます。文字列バッファはすべてANSI文字列（≒SJIS文字列）である必要があるため、Unicode文字列バッファを持つString型を処理するには、コード上で明示的にUnicodeとANSIの相互変換を行う必要があります。

　これは本質的にはDispCallFuncとは別の話ですが、cdecl呼び出し体系を使うケースではANSI文字列体系を使ったレガシーなモジュールとのやり取りが多いと予想されるので、ここで取り上げておきます。

　なお、VBAのDeclare Functionでは、As Stringとした場合に、この変換を自動的に行ってくれています。

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 Test4()
    'Test1,2,3で説明した注釈は省いてあります。
    
    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
    'Test3と異なり、wsprintfA関数へのポインタを保持します。
    lProcAddress = GetProcAddress(lLibraryHandle, "wsprintfA")
    If lProcAddress = 0 Then
       FreeLibrary lLibraryHandle
       Debug.Print "GetProcAddress 失敗"
       Exit Sub
    End If
    
    'wsprintfA は 次の引数を持っています。
    'LPTSTR lpOut , LPCTSTR lpFmt , ...
    
    'wsprintfは、C言語のsprintfとほぼ同等の働きをします。
    
    '第1引数に整形後の文字列を格納する文字列バッファ
    '第2引数に整形したい書式文字列
    '第3引数以降に埋め込みたい文字列なり数値なり
    
    '今回は "Param1 = %d , Param2 = %s"という書式で数値(%d)と文字列(%s)を埋め込みます。
    
    Dim sOut As String
    Dim bOut() As Byte 'sOutをANSIに変換した結果を保持させます。
    Dim sFormat As String
    Dim bFormat() As Byte 'sFormatをANSIに変換した結果を保持させます。
    Dim lParam1 As Long
    Dim sParam2 As String
    Dim bParam2() As Byte 'sParam2をANSIに変換した結果を保持させます。
    
    sOut = String(200, vbNullChar) 'Unicode200文字文の領域を確保し、\0で埋めます。(=400バイト)
    bOut = StrConv(sOut, vbFromUnicode)  'sOutをANSIに変換した結果を保持させます。
    
    sFormat = "Param1 = %d , Param2 = %s"
    bFormat = StrConv(sFormat, vbFromUnicode) 'sFormatをANSIに変換した結果を保持させます。
    
    lParam1 = 123456
    
    sParam2 = "abc"
    bParam2 = StrConv(sParam2, vbFromUnicode) 'sParam2をANSIに変換した結果を保持させます。
    
    '今回 wsprintfAには4つに引数を渡しますので、4つのVariant変数を用意します。
    '今回は、4つ別個に用意するのは手間なので、配列で用意します。
    Dim vParams(0 To 3) As Variant
        
    
    'wsprintfAでのLP(C)TSTRは 最終的には char* なので、StringをANSI文字列に変換してByte配列に
    '格納し、そのByte配列の先頭アドレスを渡す必要があります。
    vParams(0) = VarPtr(bOut(0))
    vParams(1) = VarPtr(bFormat(0))
    vParams(2) = lParam1
    vParams(3) = VarPtr(bParam2(0))
    
    Dim iVarTypes() As Integer
    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
    
    'wsprintfA関数の呼び出し規約はcdeclなので、第3引数にCC_CDECLを指定します。
    
    '今回はVC++でのint型=VBでのLong型が戻り値なので
    'vbLong(=3)を戻り値の型として指定します。
        
    lDispCallFuncResult = DispCallFunc(0, lProcAddress, _
                                       tagCALLCONV.CC_CDECL, VbVarType.vbLong, _
                                        UBound(vParams) + 1, VarPtr(iVarTypes(0)), VarPtr(lVarPtrs(0)), VarPtr(vFuncResult))

    
    FreeLibrary lLibraryHandle
    
    Debug.Print "Test4"
    Debug.Print "lDispCallFuncResult = " & lDispCallFuncResult
    
    Debug.Print "vFuncResult = " & vFuncResult
    
    '第1引数にbOutのANSI文字列バッファのアドレスを指定したので
    'wsprintfA APIは、200文字のChrA(0)で埋められたbOutの先頭部分をnull終端文字列で上書きします。
    '従って、今度はbOutをANSIからUnicodeに変換してVBA側で扱えるようにする必要があります。
    'さらに、VB側で欲しい文字列は、最初に見つかったChrW(0)(=vbNullChar)より左側の文字列です。
    sOut = StrConv(bOut, vbUnicode)
    Debug.Print Left(sOut, InStr(1, sOut, vbNullChar) - 1)
End Sub

最後に

　この方法でdllを利用する大きな利点は、declare functionで不可能な、cdecl呼び出し規約の関数呼び出しが可能になることと、動的なdll名の決定が可能になることです。実際にこの技術が必要になるケースはあまり多くはないと思いますが、VBA開発者として、「VBAはCと比べて～ができない」とC言語経験者から言われるのが精神的苦痛であったりしませんか？ そのときの反論の一手段としても、本稿をご活用いただければと思います。

　なお、VBでもParamArrayというキーワードを使うと、関数に可変個引数を設定することができます。これと上記のサンプルコードを組み合わせると、wsprintfの完全なラッパー関数を作ることができます。これは皆さん自身でコーディングしてみてください。