In the previous chapter we tried to call the wsprintfW which has Unicode arguments and CDECL calling convention.
Next, let's take a look at the wsprintfA function, which has low compatibility with VBA's string format.
Because the entire character string buffer needs to be ANSI character string, explicit reciprocal conversion between Unicode character string and ANSI character string in the program code is required to process string format that has Unicode character string buffer.
The is really a different topic from DispCallFunc. But because I expect that you will be often be dealing with legacy modules using the ANSI character string system in cases of using the CDECL call system, I bring this up here.
Please note that when VBA's Declare Function is As String, this conversion takes place automatically.
Example.4
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-4.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 Test4()
'The annotations that were explained in Test1,Test2,Test3 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
'Unlike Test3, lProcAddress holds a pointer to the function wsprintfA.
lProcAddress = GetProcAddress(lLibraryHandle, "wsprintfA")
If lProcAddress = 0 Then
Debug.Print "GetProcAddress failed."
FreeLibrary lLibraryHandle
Exit Sub
End If
'wsprintfA 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 bOut() As Byte 'holds the result from the conversion of the Unicode character string
'in the string type variable sOut to an ANSI character string.
Dim sFormat As String
Dim bFormat() As Byte 'holds the result from the conversion of the Unicode character string
'in the string type variable sFormat to an ANSI character string.
Dim lParam1 As Long
Dim sParam2 As String
Dim bParam2() As Byte 'holds the result from the conversion of the Unicode character string
'in the string type variable sParam2 to an ANSI character string.
sOut = String(200, vbNullChar) 'Buffer for Unicode 200 characters is secured, embedded using \0(=400 bytes).
bOut = StrConv(sOut, vbFromUnicode) 'Convert the Unicode character string to an ANSI character Byte array.
sFormat = "Param1 = %d , Param2 = %s"
bFormat = StrConv(sFormat, vbFromUnicode) 'Convert the Unicode character string to an ANSI character Byte array.
'vbFromUnicode means a conversion from Unicode to ANSI.
lParam1 = 123456
sParam2 = "abc"
bParam2 = StrConv(sParam2, vbFromUnicode) 'Convert the Unicode character string to an ANSI character Byte array.
'This time, 4 arguments are passed to wsprintfA, 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
'Because LP(C)TSTR in wsprintfA is ultimately a char*, it is necessary to convert the string type variable to an ANSI character string,
'store it in a Byte type array, and then pass the beginning address of that Byte type array.
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 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.
'wsprintfA function's calling convention is CDECL, so we specify CC_CDECL for the 3rd argument.
'This time, the return value is int type under VC++ ( = Long type under VB), so
'we specify the return value's type as 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
'Because the address of bOut's ANSI character string buffer was specified as the first argument,
'wsprintfA API overwrites the beginning part of bOut which is padded with 200 ChrA(0) characters with a null-terminated string.
'Therefore, it is necessary here to convert bOut from ANSI to Unicode to make it possible to handle it in VBA.
'Further, in VB the left side character string is more desirable than the ChrW(0)(=vbNullChar) that was found first.
sOut = StrConv(bOut, vbUnicode) 'vbUnicode means a conversion from ANSI to Unicode.
Debug.Print Left(sOut, InStr(1, sOut, vbNullChar) - 1)
End Sub
No comments:
Post a Comment