VBでの、関数ポインタによる関数の実行

後述のサンプル２では、CallFuncPtrという関数を定義している。この関数は、第一引数に呼び出したい関数のアドレス、第二引数以降にその関数へ渡したい引数を指定する。呼び出す関数に渡す引数には、文字列または32bit値を指定可能で、呼び出した関数内での引数の操作は反映されない。CallFuncPtrの戻り値は、呼び出した関数の戻り値と同値である。

例として、CallFuncPtrを使用してWin32のMessageBox関数によるメッセージボックスの表示を行う方法を示す。

サンプル１：

Private Sub Command1_Click()

    Dim hDll As Long
    Dim pMessageBox As Long
    
    hDll = LoadLibrary("user32.dll")
    pMessageBox = GetProcAddress(hDll, "MessageBoxA")
    
    CallFuncPtr pMessageBox, Me.hWnd, "hello world", "test message", MB_OK
  
    FreeLibrary hDll
    
End Sub

この例では、pMessageBoxという変数に、MessageBox関数のアドレスが格納され、CallFuncPtrによってそのアドレスが指す関数を実行している。

CallFuncPtr内ではどのような処理を行っているのだろうか? 実は、CallFuncPtrは、与えられた関数ポインタを実行するためのバイナリの実行コード(いわゆる「マシン語」コード)をメモリ上に生成し、これを実行することによって処理を実現している。具体的には、CallFuncPtr内部のpCodeDataという変数が指すメモリ領域に、以下のような実行コードを作成する。

55                   push        ebp

                     ;引数をスタックへ退避
68 ** ** ** **       push        n番目の引数
68 ** ** ** **       push        n-1番目のの引数
…
68 ** ** ** **       push        1番目の引数

                     ;ポインタが指す関数を実行
B8 ** ** ** **       mov         eax, 関数ポインタ
FF D0                call        eax

                     ;戻り値を退避
BA ** ** ** **       mov         edx, 返却格納場所
89 02                mov         dword ptr [edx], eax

                     ;終了
5D                   pop         ebp
33 C0                xor         eax,eax
C2 08 00             ret         8

次に、このバイナリの実行コードをどのようにVBから実行させるのだろうか? これは、コールバック関数を使用するWin32 API関数を呼び出すことによって実現できる。これには色々なAPI関数が候補として考えられるが、CallFuncPtrでは、EnumObjectsを使用している。上記実行コードは、二つの引数を持ち、0を返すPASCAL呼び出し形式の関数の形になっている。従って、EnumObjectsに上記実行コードが格納されているアドレスを渡すことにより、生成した実行コードを実行することができる。

以上で示した方法は、バイナリの実行コードを生成し、これをAPI関数によって間接的にコールバック関数として呼び出す方法であった。この方法を応用すれば色々なことができるが、実際のプログラミングでは素直にVCや市販のOCXなどを当たったほうが良いだろう。

サンプル２：

' ---------------- Form1.frmの内容 ----------------
Public Function CallFuncPtr(FuncPtr As Long, ParamArray Params() As Variant) As Long

    Const MAX_CODESIZE As Long = 65536

    Dim I As Long
    Dim pCodeData As Long
    Dim pParamData() As Long
    Dim PC As Long
    Dim Operand As Long
    Dim RetValue As Long
    Dim StrValue As String
    Dim LongValue As Long
    
    '初期化
    ReDim pParamData(UBound(Params)) As Long
    pCodeData = GlobalAlloc(GMEM_FIXED, MAX_CODESIZE)
    PC = pCodeData
   
    'プロローグコード生成
    AddByte PC, &H55
    
    '渡されたパラメータの設定コード生成
    For I = UBound(Params) To 0 Step -1
        If VarType(Params(I)) = vbString Then
            pParamData(I) = GlobalAlloc(GMEM_FIXED, LenB(Params(I)))
            StrValue = Params(I)
            MoveMemory ByVal pParamData(I), ByVal StrValue, LenB(StrValue)

            Operand = pParamData(I)
        Else
            Operand = Params(I)
        End If
        
        'Params(I)のパラメータ設定コード生成
                
        AddByte PC, &H68
        AddLong PC, Operand
    Next

    '呼び出しコード生成
    AddByte PC, &HB8
    AddLong PC, FuncPtr
    AddInt PC, &HD0FF
    
    'エピローグコード生成
    AddByte PC, &HBA
    AddLong PC, VarPtr(RetValue)
    
    AddInt PC, &H289
    AddByte PC, &H5D
    AddInt PC, &HC033
    AddByte PC, &HC2
    AddInt PC, &H8

    '呼び出し
    EnumObjects Me.hDC, OBJ_PEN, pCodeData, 0

    '後処理
    GlobalFree pCodeData
    For I = 0 To UBound(Params)
        If pParamData(I) <> 0 Then GlobalFree pParamData(I)
    Next

    CallFuncPtr = RetValue

End Function


'---------------- Module1.basの内容 ----------------

Declare Function GlobalAlloc Lib "kernel32" (ByVal Flags As Long, _
    ByVal Size As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal Mem As Long) As Long

Declare Function EnumObjects Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal ObjectType As Long, _
    ByVal pEnumProc As Long, _
    ByVal lParam As Long) As Long

Declare Function MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Dest As Any, ByRef Src As Any, ByVal Size As Long) As Long

Public Const GMEM_FIXED As Long = 0
Public Const OBJ_PEN As Long = 1


Public Sub AddByte(ByRef PC As Long, ByVal ByteValue As Byte)
    MoveMemory ByVal PC, ByteValue, 1
    PC = PC + 1
End Sub

Public Sub AddInt(ByRef PC As Long, ByVal IntValue As Integer)
    MoveMemory ByVal PC, IntValue, 2
    PC = PC + 2
End Sub

Public Sub AddLong(ByRef PC As Long, ByVal LongValue As Long)
    MoveMemory ByVal PC, LongValue, 4
    PC = PC + 4
End Sub