In the previous chapter we tried to call a function created with the STDCALL calling convention.
In this chapter we will try to call a function created with the CDECL calling convention.
Since standard WIN32API are created with the STDCALL calling convention, you can call them if you write a Declare Function. In such a case, there are few cases where calls are made with DispCallFunc.
Thus I will try to call functions created with the CDECL calling convention.
However, to do this requires some work to create DLLs, so I will try to call the wsprintf function, which is an WIN32API created with the CDECL calling convention, unlike other WIN32API.
This function has Variadic argument, so it is created with CDECL. Therefore, it cannot be called in VBA by using Declare Function.
The wsprintf function has wsprintfW function for Unicode and wsprintfA function for ANSI. I will try using the wsprintfW function, which is highly compatible with VBA's string format.
If you want to call the ANSI version of the function, the next chapter will explain how to call wsprintfA.
Example.3
The source code on this page needs to be pasted into the standard module. If you paste it into Sheet1 or ThisWorkBook, a compile error will occur.
Option Explicit
'You can use a sample code for this site freely.
'Though this is not a duty, I am grateful that you describe that you reffered this site(https://akihitoyamashiro.blogspot.com/2020/07/how-to-use-function-pointer-in-vba-3.html),
'when you present this sample code in your web site.
Private Declare PtrSafe Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" _
(ByVal lpFileName As String) As LongPtr
Private Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" _
(ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Private Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" _
(ByVal hModule As LongPtr) As Long
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, _
ByVal prgvt As LongPtr, _
ByVal prgpvarg As LongPtr, _
ByVal pvargResult As LongPtr) 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()
'The annotations that were explained in Test1,Test2 have been omitted.
Dim lDispCallFuncResult As Long
Dim vFuncResult As Variant
vFuncResult = Empty
Dim lLibraryHandle As LongPtr
lLibraryHandle = LoadLibrary("user32.dll")
If lLibraryHandle = 0 Then
Debug.Print "LoadLibrary failed."
Exit Sub
End If
Dim lProcAddress As LongPtr
lProcAddress = GetProcAddress(lLibraryHandle, "wsprintfW")
If lProcAddress = 0 Then
Debug.Print "GetProcAddress failed."
FreeLibrary lLibraryHandle
Exit Sub
End If
'wsprintfW has the following arguments.
'LPTSTR lpOut , LPCTSTR lpFmt , ...
'sprintf works almost exactly the same as sprintf in the C language.
'First argument: buffer that will store the formatted output
'Second argument: string specifying desired format
'Third argument (and additional arguments): strings and values you want to embed
'This time we will embed the phrase "Param1 = %d , Param2 = %s" with a number (%d) and a string (%s).
Dim sOut As String
Dim sFormat As String
Dim lParam1 As Long
Dim sParam2 As String
sOut = String(200, vbNullChar) 'Buffer for Unicode 200 characters is secured, embedded using \0(=400 bytes).
sFormat = "Param1 = %d , Param2 = %s"
lParam1 = 123456
sParam2 = "abc"
'This time, 4 arguments are passed to wsprintfW, so 4 Variant format variables are prepared.
'This time, preparing 4 separate variables takes work, so an array is prepared.
Dim vParams(0 To 3) As Variant
'LP(C)TSTR for wsprintfW is ultimately wchar_t*, so we must pass VBA's StrPtr(String type variable).
vParams(0) = StrPtr(sOut)
vParams(1) = StrPtr(sFormat)
vParams(2) = lParam1
vParams(3) = StrPtr(sParam2)
'This time, we consider the appropriation by other code, and declare the following array variables dynamically.
Dim iVarTypes() As Integer
Dim lVarPtrs() As LongPtr
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
'We specify the return value of GetProcAdress for the 2nd argument.
'wsprintfW function's calling convention is CDECL, so we specify CC_CDECL for the 3rd argument.
'This time, the return value is int type in VC++ ( = Long type in VB), so
'we specify the return value's type as vbLong(=3).
'There are 4 arguments. For portability reason, without directly specifying 4,
'the upper limit of the array is set using 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
'sOut's Unicode string buffer address is specified as the first argument
'so the wsprintfW API overwrites the beginning part of sOut which is padded with 200 ChrW(0) characters
'with a null terminated character string.
'Therefore, the character string wanted by VB is the left-hand string from the first seen ChrW(0)(=vbNullChar).
Debug.Print Left(sOut, InStr(1, sOut, vbNullChar) - 1)
'However, even without using InStr, wsprintfW returns the length of the formatted character string, so
'Debug.Print Left(sOut, vFuncResult)
' is what we can do.
End Sub
No comments:
Post a Comment