Private Declare PtrSafe Function FindWindowW Lib "user32" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowTextLengthW Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
Private Declare PtrSafe Function FindWindowExW Lib "user32" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As LongPtr, ByVal lpsz2 As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowTextW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpString As LongPtr, ByVal cch As Long) As Long
Private Function GetPrompt(ByVal Caption As String) As String
Dim hWndDialog As LongPtr
Dim hWndMessage As LongPtr
Dim nLength As Long
Dim sText As String
hWndDialog = FindWindowW(0, StrPtr(Caption))
If hWndDialog Then
hWndMessage = GetDlgItem(hWndDialog, &HFFFF&)
If hWndMessage Then
nLength = GetWindowTextLengthW(hWndMessage) + 1
sText = String(nLength, vbNullChar)
nLength = GetWindowTextW(hWndMessage, StrPtr(sText), nLength)
GetPrompt = Mid(sText, 1, nLength)
End If
End If
End Function
Sub ma()
'Make a vbscript file like this.
' MsgBox "Something wrong",vbOKOnly, "Application Error"
'And run that vbscript file before running this excel macro.
'This macro retrives "Something wrong" by specifing the caption:"Application Error"
Debug.Print GetPrompt("Application Error")
End Sub
Saturday, July 25, 2020
How to lock a Windows user session
Private Declare PtrSafe Function LockWorkStation Lib "user32" () As Long
Sub LockTest()
LockWorkStation
End Sub
Sub LockTest()
LockWorkStation
End Sub
Thursday, July 23, 2020
How to set FormulaArray property to a formula with more than 255 characters
'https://docs.microsoft.com/en-us/office/vba/api/excel.range.formulaarray
'says "The FormulaArray property also has a character limit of 255."
'This is the workaround.
Sub SetTooLongArrayFormula(ByVal rn As Range, ByVal sFormula As String)
Dim sFormat As String
sFormat = rn.Cells(1, 1).NumberFormat
rn.FormulaArray = ""
rn.Cells(1, 1).NumberFormat = "@"
rn.Value = sFormula
rn.Cells(1, 1).NumberFormat = sFormat
rn.Select
DoEvents
SendKeys "{F2}", True
DoEvents
SendKeys "+^{ENTER}", True
End Sub
Sub Test()
'Do not run this macro from VBE Editor
'Run this macro from the Macros ribbon on the Developer tab with the Excel worksheet in front.
Dim sFormula As String
sFormula = "=""1"""
For i = 1 To 250
sFormula = sFormula & "&""1"""
Next
SetTooLongArrayFormula Range("A1:A2"), sFormula
End Sub
'says "The FormulaArray property also has a character limit of 255."
'This is the workaround.
Sub SetTooLongArrayFormula(ByVal rn As Range, ByVal sFormula As String)
Dim sFormat As String
sFormat = rn.Cells(1, 1).NumberFormat
rn.FormulaArray = ""
rn.Cells(1, 1).NumberFormat = "@"
rn.Value = sFormula
rn.Cells(1, 1).NumberFormat = sFormat
rn.Select
DoEvents
SendKeys "{F2}", True
DoEvents
SendKeys "+^{ENTER}", True
End Sub
Sub Test()
'Do not run this macro from VBE Editor
'Run this macro from the Macros ribbon on the Developer tab with the Excel worksheet in front.
Dim sFormula As String
sFormula = "=""1"""
For i = 1 To 250
sFormula = sFormula & "&""1"""
Next
SetTooLongArrayFormula Range("A1:A2"), sFormula
End Sub
Friday, July 17, 2020
How to use a function pointer in VBA #4 (ANSI function with CDECL calling convention)
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
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
How to use a function pointer in VBA #3 (Unicode function with CDECL calling convention)
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
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
How to use a function pointer in VBA #2 (function with arguments and return value)
How to use a function pointer in VBA.
VB6 and VBA come with no support for function pointers.
In the previous chapter we tried to execute a pointer to a function with no return value or argument. In this chapter we also try using pointers of functions with arguments and return values.
Example.2
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-2.html),
'when you present this sample code in your web site.
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 Function SixParamOneReturn( _
ByVal longVal As Long, ByRef longRef As Long, _
ByVal byteVal As Byte, ByRef byteRef As Byte, _
ByVal strVal As String, ByRef strRef As String _
) As Long
'ByVal...String in VB is equivalent to BSTR in VC++.
'ByRef...String in VB is equivalent to BSTR* in VC++.
Debug.Print "SixParamOneReturn"
Debug.Print "longVal = " & longVal
Debug.Print "longRef = " & longRef
Debug.Print "byteVal = " & byteVal
Debug.Print "byteRef = " & byteRef
Debug.Print "strVal = " & strVal
Debug.Print "strRef = " & strRef
Debug.Print
SixParamOneReturn = longVal + longRef
longVal = 100
longRef = 200
byteVal = 10
byteRef = 20
strVal = "strVal"
strRef = "strRef"
MsgBox "EightParamOneReturn is called."
End Function
Public Sub Test2()
'The annotations that were explained in Test1 have been omitted.
Dim lDispCallFuncResult As Long
Dim vFuncResult As Variant
vFuncResult = Empty
Dim lVal As Long, vlVal As Variant
Dim lRef As Long, vlRef As Variant
Dim bVal As Byte, vbVal As Variant
Dim bRef As Byte, vbRef As Variant
Dim sVal As String, vsVal As Variant
Dim sRef As String, vsRef As Variant
lVal = 12
lRef = 34
bVal = 56
bRef = 78
sVal = "string1"
sRef = "string2"
'DispCallFunc method
'The variables passed to the called function all have to
'be passed in Variant form so all the variables are
'declared as Variant variables.
'It is easier to create a Variant array and assign the
'array but to show there is no need for it to be an
'array, we will not create an array.
'Calling by reference, as instructed by VB's ByRef,
'involves not declaring variables, but we have to assign
'pointers to variables.
vlVal = lVal 'Because it is the ByVal variable, set a value.
vlRef = VarPtr(lRef) 'It is the ByVal variable so assign
'pointers. In C it corresponds to &IRef.
vbVal = bVal
vbRef = VarPtr(bRef)
vsVal = sVal
vsRef = VarPtr(sRef)
'After declaring the Variant variables
'along with set each Variant variable's type as an integer array.
'we set each Variant variable's address as a long array.
Dim iVarTypes(0 To 5) As Integer 'hard to tell, but
'first letter is a small letter i.
Dim lVarPtrs(0 To 5) As LongPtr
iVarTypes(0) = VarType(vlVal) 'VbVarType.vbLong is assigned
lVarPtrs(0) = VarPtr(vlVal) '"VarPtr(vlVal)" corresponds to
'"&vlVal" in C.
iVarTypes(1) = VarType(vlRef) 'The pointer is in Long form
'so VbVarType.vbLong is assigned.
lVarPtrs(1) = VarPtr(vlRef)
iVarTypes(2) = VarType(vbVal) 'VbVarType.vbByte is assigned.
lVarPtrs(2) = VarPtr(vbVal)
iVarTypes(3) = VarType(vbRef) 'The pointer is in Long form
'so VbVarType.vbLong is assigned.
lVarPtrs(3) = VarPtr(vbRef)
iVarTypes(4) = VarType(vsVal) 'VbVarType.vbString is assigned.
lVarPtrs(4) = VarPtr(vsVal)
iVarTypes(5) = VarType(vsRef) 'The pointer is in Long form
'so VbVarType.vbLong is assigned.
lVarPtrs(5) = VarPtr(vsRef)
'The returned value's type is long so we set the 4th argument
'(the returned value's type) as vbLong(=3).
'There are 6 variables, we set the 5th argument to 6.
'For the 6th argument we set the first address in the
'integer array that stores each variant variable's inner type.
'For the 7th argument we set the first address in the
'long array that stores each variant variable's address.
lDispCallFuncResult = DispCallFunc( _
0, _
AddressOf SixParamOneReturn, _
tagCALLCONV.CC_STDCALL, _
VbVarType.vbLong, _
6, _
VarPtr(iVarTypes(0)), _
VarPtr(lVarPtrs(0)), _
VarPtr(vFuncResult) _
)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'In this section, if the declaration of the DispCallFunc
'is as follows, then the 6th, 7th and 8th arguments VarPtr are
'unnecessary.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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, _
ByRef prgvt As Integer, _
ByRef prgpvarg As LongPtr, _
ByRef pvargResult As Variant) As Long
'Regarding the 6th, 7th and 8th arguments, we change
'ByVal pointer's type to ByRef variable's type
'6th argument ByVal ... Long to ByRef ... Integer
'7th argument ByVal ... LongPtr to ByRef ... LongPtr
'8th argument ByVal ... Long to ByRef ... Variant
'Because of this getting the address value is done
'automatically by VBA, and we can do the DispCallFunc
'part in the following way
'lDispCallFuncResult = DispCallFunc( _
0, _
AddressOf SixParamOneReturn, _
tagCALLCONV.CC_STDCALL, _
VbVarType.vbLong, _
6, _
iVarTypes(0), _
lVarPtrs(0), _
vFuncResult _
)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Debug.Print "Test2"
Debug.Print "lDispCallFuncResult = " & lDispCallFuncResult
Debug.Print "vFuncResult = " & vFuncResult
Debug.Print "lVal = " & lVal 'lVal value is left as is.
Debug.Print "lRef = " & lRef 'lRef value is passed to a pointer
'so the original value is affected
'by the changes where it is called.
Debug.Print "bVal = " & bVal
Debug.Print "bRef = " & bRef
Debug.Print "sVal = " & sVal
Debug.Print "sRef = " & sRef
End Sub
Until now, I assumed you understand DispCallFunc's call procedure. Actually, there are not many cases where functions within VBA is called with DispCallFunc.
Also, because standard WIN32API are created with the STDCALL calling convention, you can call them if you do 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 in the next section.
VB6 and VBA come with no support for function pointers.
In the previous chapter we tried to execute a pointer to a function with no return value or argument. In this chapter we also try using pointers of functions with arguments and return values.
Example.2
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-2.html),
'when you present this sample code in your web site.
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 Function SixParamOneReturn( _
ByVal longVal As Long, ByRef longRef As Long, _
ByVal byteVal As Byte, ByRef byteRef As Byte, _
ByVal strVal As String, ByRef strRef As String _
) As Long
'ByVal...String in VB is equivalent to BSTR in VC++.
'ByRef...String in VB is equivalent to BSTR* in VC++.
Debug.Print "SixParamOneReturn"
Debug.Print "longVal = " & longVal
Debug.Print "longRef = " & longRef
Debug.Print "byteVal = " & byteVal
Debug.Print "byteRef = " & byteRef
Debug.Print "strVal = " & strVal
Debug.Print "strRef = " & strRef
Debug.Print
SixParamOneReturn = longVal + longRef
longVal = 100
longRef = 200
byteVal = 10
byteRef = 20
strVal = "strVal"
strRef = "strRef"
MsgBox "EightParamOneReturn is called."
End Function
Public Sub Test2()
'The annotations that were explained in Test1 have been omitted.
Dim lDispCallFuncResult As Long
Dim vFuncResult As Variant
vFuncResult = Empty
Dim lVal As Long, vlVal As Variant
Dim lRef As Long, vlRef As Variant
Dim bVal As Byte, vbVal As Variant
Dim bRef As Byte, vbRef As Variant
Dim sVal As String, vsVal As Variant
Dim sRef As String, vsRef As Variant
lVal = 12
lRef = 34
bVal = 56
bRef = 78
sVal = "string1"
sRef = "string2"
'DispCallFunc method
'The variables passed to the called function all have to
'be passed in Variant form so all the variables are
'declared as Variant variables.
'It is easier to create a Variant array and assign the
'array but to show there is no need for it to be an
'array, we will not create an array.
'Calling by reference, as instructed by VB's ByRef,
'involves not declaring variables, but we have to assign
'pointers to variables.
vlVal = lVal 'Because it is the ByVal variable, set a value.
vlRef = VarPtr(lRef) 'It is the ByVal variable so assign
'pointers. In C it corresponds to &IRef.
vbVal = bVal
vbRef = VarPtr(bRef)
vsVal = sVal
vsRef = VarPtr(sRef)
'After declaring the Variant variables
'along with set each Variant variable's type as an integer array.
'we set each Variant variable's address as a long array.
Dim iVarTypes(0 To 5) As Integer 'hard to tell, but
'first letter is a small letter i.
Dim lVarPtrs(0 To 5) As LongPtr
iVarTypes(0) = VarType(vlVal) 'VbVarType.vbLong is assigned
lVarPtrs(0) = VarPtr(vlVal) '"VarPtr(vlVal)" corresponds to
'"&vlVal" in C.
iVarTypes(1) = VarType(vlRef) 'The pointer is in Long form
'so VbVarType.vbLong is assigned.
lVarPtrs(1) = VarPtr(vlRef)
iVarTypes(2) = VarType(vbVal) 'VbVarType.vbByte is assigned.
lVarPtrs(2) = VarPtr(vbVal)
iVarTypes(3) = VarType(vbRef) 'The pointer is in Long form
'so VbVarType.vbLong is assigned.
lVarPtrs(3) = VarPtr(vbRef)
iVarTypes(4) = VarType(vsVal) 'VbVarType.vbString is assigned.
lVarPtrs(4) = VarPtr(vsVal)
iVarTypes(5) = VarType(vsRef) 'The pointer is in Long form
'so VbVarType.vbLong is assigned.
lVarPtrs(5) = VarPtr(vsRef)
'The returned value's type is long so we set the 4th argument
'(the returned value's type) as vbLong(=3).
'There are 6 variables, we set the 5th argument to 6.
'For the 6th argument we set the first address in the
'integer array that stores each variant variable's inner type.
'For the 7th argument we set the first address in the
'long array that stores each variant variable's address.
lDispCallFuncResult = DispCallFunc( _
0, _
AddressOf SixParamOneReturn, _
tagCALLCONV.CC_STDCALL, _
VbVarType.vbLong, _
6, _
VarPtr(iVarTypes(0)), _
VarPtr(lVarPtrs(0)), _
VarPtr(vFuncResult) _
)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'In this section, if the declaration of the DispCallFunc
'is as follows, then the 6th, 7th and 8th arguments VarPtr are
'unnecessary.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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, _
ByRef prgvt As Integer, _
ByRef prgpvarg As LongPtr, _
ByRef pvargResult As Variant) As Long
'Regarding the 6th, 7th and 8th arguments, we change
'ByVal pointer's type to ByRef variable's type
'6th argument ByVal ... Long to ByRef ... Integer
'7th argument ByVal ... LongPtr to ByRef ... LongPtr
'8th argument ByVal ... Long to ByRef ... Variant
'Because of this getting the address value is done
'automatically by VBA, and we can do the DispCallFunc
'part in the following way
'lDispCallFuncResult = DispCallFunc( _
0, _
AddressOf SixParamOneReturn, _
tagCALLCONV.CC_STDCALL, _
VbVarType.vbLong, _
6, _
iVarTypes(0), _
lVarPtrs(0), _
vFuncResult _
)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Debug.Print "Test2"
Debug.Print "lDispCallFuncResult = " & lDispCallFuncResult
Debug.Print "vFuncResult = " & vFuncResult
Debug.Print "lVal = " & lVal 'lVal value is left as is.
Debug.Print "lRef = " & lRef 'lRef value is passed to a pointer
'so the original value is affected
'by the changes where it is called.
Debug.Print "bVal = " & bVal
Debug.Print "bRef = " & bRef
Debug.Print "sVal = " & sVal
Debug.Print "sRef = " & sRef
End Sub
Until now, I assumed you understand DispCallFunc's call procedure. Actually, there are not many cases where functions within VBA is called with DispCallFunc.
Also, because standard WIN32API are created with the STDCALL calling convention, you can call them if you do 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 in the next section.
How to use a function pointer in VBA #1 (function without arguments or return value)
VB6 and VBA come with no support for function pointers.
Also, when you wish to execute a function in a dll using the Declare function, you can only call functions created by the stdcall calling convention.
These constraints can be avoided by using the DispCallFunc API.
The DispCallFunc is widely used in VB6 when erasing the history of IE.
Although the DispCallFunc is known as API for calling the IUnknown interface, in fact, you can also perform other functions other than COM by passing the NULL to the first argument.
As explained in the http://msdn.microsoft.com/en-us/library/ms221473(v=vs.85).aspx , the DispCallFunc argument is as follows.
Use of the argument sixth and seventh is very peculiar, and there are few descriptions about it available. Therefore, I'll try to summarize it this time around.
First argument, pvInstance
In this time, I am going to call functions other than COM. Thus, always setting at 0.
Second argument, oVft
Passing the address of a function.
Third argument, cc
Passing the function's calling convention.
For CALLCONV type, the following values are defined for the OAIdl.h.
For a general WIN32API function, CC_STDCALL (= 4) is used.
For a function that is specifically designed for language C, CC_CDECL (= 1) is used.
Fourth argument, vtReturn
Setting the value of VbVarType enumerated type that indicates the type of the function's return value.
In the event where the function does not return a value (the Sub procedure referred to in VB), setting the vbEmpty.
VARTYPE type as defined in WTypes.h is shown below.
By ignoring 'unsigned', it is equivalent to the Integer type in VB.
Fifth argument, cActuals
Setting the number of function arguments.
Sixth argument, prgvt
Storing in an array of Integer type VbVarType enumerated values that indicate the type of the function's arguments, and then passing the address of the beginning of the array.
However, when the number of the arguments is 0, passing 0.
Seventh argument, prgpvarg
Once again, storing each function's argument in Variant type, and storing the address of each of the variant variable in the Long type array that is prepared separately, then passing the address of the beginning of the array.
However, when the number of arguments is 0, then passing 0.
Then, the return value of the DispCallFunc API is, if a call to the function is done successfully in the Long type, S_OK (= 0) is returned.
As an example, the API declaration and the declaration of the enumeration in VB are as follows.
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
First, I tried the simplest way with a pointer to a function with no defined arguments in a standard module of VBA.
In VBA, as long as functions that are defined in a standard module, you can obtain those addresses using AddressOf operator.
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.
Example.1
'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-1.html),
'when you present this sample code in your web site.
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 NoParamNoReturn()
MsgBox "NoParamNoReturn is called."
End Sub
Public Sub Test1()
Dim lDispCallFuncResult As Long
'Declare a Variant variable that will store the return value of the function called.
'This variable is needed even if the function does not return a value.
Dim vFuncResult As Variant
'In this case, there is no need to initialize the variable after declaring it.
'However, when using a Variant variable, it can be initialized like this
'by setting it to Empty.
vFuncResult = Empty
'You can get the address of a function in VBA by using the AddressOf operator.
'Enter the name of the enumerated type; at the point when you type in the period
'you will be able to use VBA's input support functionality.
'This time we are calling a sub procedure so there is no value to be returned.
'Hence we set the data type of the return variable to be vbEmpty(=0).
lDispCallFuncResult = DispCallFunc(0, AddressOf NoParamNoReturn, _
tagCALLCONV.CC_STDCALL, VbVarType.vbEmpty, _
0, 0, 0, VarPtr(vFuncResult))
'When the call to the DispCallFunc API is successful, it returns 0.
'However, this only means that the call to the DispCallFunc API was successful,
'and it does not indicate whether the target function call was successful or not.
Debug.Print lDispCallFuncResult
End Sub
In the next section we also try using pointers of functions defined in VBA's standard module.
However, in the next function there are arguments and return value.
Also, when you wish to execute a function in a dll using the Declare function, you can only call functions created by the stdcall calling convention.
These constraints can be avoided by using the DispCallFunc API.
The DispCallFunc is widely used in VB6 when erasing the history of IE.
Although the DispCallFunc is known as API for calling the IUnknown interface, in fact, you can also perform other functions other than COM by passing the NULL to the first argument.
As explained in the http://msdn.microsoft.com/en-us/library/ms221473(v=vs.85).aspx , the DispCallFunc argument is as follows.
HRESULT DispCallFunc( void *pvInstance, ULONG_PTR oVft, CALLCONV cc, VARTYPE vtReturn, UINT cActuals, VARTYPE *prgvt, VARIANTARG **prgpvarg, VARIANT *pvargResult );
Use of the argument sixth and seventh is very peculiar, and there are few descriptions about it available. Therefore, I'll try to summarize it this time around.
First argument, pvInstance
In this time, I am going to call functions other than COM. Thus, always setting at 0.
Second argument, oVft
Passing the address of a function.
Third argument, cc
Passing the function's calling convention.
For CALLCONV type, the following values are defined for the OAIdl.h.
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 + 1
} CALLCONV;
For a general WIN32API function, CC_STDCALL (= 4) is used.
For a function that is specifically designed for language C, CC_CDECL (= 1) is used.
Fourth argument, vtReturn
Setting the value of VbVarType enumerated type that indicates the type of the function's return value.
In the event where the function does not return a value (the Sub procedure referred to in VB), setting the vbEmpty.
VARTYPE type as defined in WTypes.h is shown below.
typedef unsigned short VARTYPE;
By ignoring 'unsigned', it is equivalent to the Integer type in VB.
Fifth argument, cActuals
Setting the number of function arguments.
Sixth argument, prgvt
Storing in an array of Integer type VbVarType enumerated values that indicate the type of the function's arguments, and then passing the address of the beginning of the array.
However, when the number of the arguments is 0, passing 0.
Seventh argument, prgpvarg
Once again, storing each function's argument in Variant type, and storing the address of each of the variant variable in the Long type array that is prepared separately, then passing the address of the beginning of the array.
However, when the number of arguments is 0, then passing 0.
Then, the return value of the DispCallFunc API is, if a call to the function is done successfully in the Long type, S_OK (= 0) is returned.
As an example, the API declaration and the declaration of the enumeration in VB are as follows.
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
First, I tried the simplest way with a pointer to a function with no defined arguments in a standard module of VBA.
In VBA, as long as functions that are defined in a standard module, you can obtain those addresses using AddressOf operator.
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.
Example.1
'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-1.html),
'when you present this sample code in your web site.
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 NoParamNoReturn()
MsgBox "NoParamNoReturn is called."
End Sub
Public Sub Test1()
Dim lDispCallFuncResult As Long
'Declare a Variant variable that will store the return value of the function called.
'This variable is needed even if the function does not return a value.
Dim vFuncResult As Variant
'In this case, there is no need to initialize the variable after declaring it.
'However, when using a Variant variable, it can be initialized like this
'by setting it to Empty.
vFuncResult = Empty
'You can get the address of a function in VBA by using the AddressOf operator.
'Enter the name of the enumerated type; at the point when you type in the period
'you will be able to use VBA's input support functionality.
'This time we are calling a sub procedure so there is no value to be returned.
'Hence we set the data type of the return variable to be vbEmpty(=0).
lDispCallFuncResult = DispCallFunc(0, AddressOf NoParamNoReturn, _
tagCALLCONV.CC_STDCALL, VbVarType.vbEmpty, _
0, 0, 0, VarPtr(vFuncResult))
'When the call to the DispCallFunc API is successful, it returns 0.
'However, this only means that the call to the DispCallFunc API was successful,
'and it does not indicate whether the target function call was successful or not.
Debug.Print lDispCallFuncResult
End Sub
In the next section we also try using pointers of functions defined in VBA's standard module.
However, in the next function there are arguments and return value.
Subscribe to:
Posts (Atom)