x64FunctionPointerExample2

x64FunctionPointer1.vba

Declare PtrSafe Function DispCallFunc Lib "OleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr

Const CC_STDCALL = 4

Private VType(0 To 63) As Integer, VPtr(0 To 63) As LongPtr

Sub SayHello()
    
    Dim RetVal As LongPtr
    Dim Result() As String
    
    RetVal = stdCallA("kernel32", "LoadLibraryA", vbLongLong, "kernel32.dll")
    RetVal = stdCallA("kernel32", "GetProcAddress", vbLongLong, RetVal, "GetProcAddress")
    
    Debug.Print "Call with DispCallFunc"
    Debug.Print "GetProcAddress is at " + Hex(RetVal)
    
    Debug.Print "Standard API Call"
    Debug.Print "GetProcAddress is at " + Hex(GetProcAddress(LoadLibrary("kernel32"), "GetProcAddress"))
    

End Sub

Public Function stdCallA(sDll As String, sFunc As String, ByVal RetType As VbVarType, ParamArray P() As Variant)

    Dim i As Integer, V(), HRes As LongPtr
    ReDim V(0)
      
    V = P
    
    For i = 0 To UBound(V)
        If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbFromUnicode): V(i) = StrPtr(P(i))
            VType(i) = VarType(V(i))
            VPtr(i) = VarPtr(V(i))
        Next i
  
'MsgBox GetProcAddress(LoadLibrary(sDll), sFunc)
HRes = DispCallFunc(0, GetProcAddress(LoadLibrary(sDll), sFunc), CC_STDCALL, RetType, i, VType(0), VPtr(0), stdCallA)
  
End Function