-
Oct 27th, 2022, 01:16 PM
#1
Call BAS Procedure By Address
This comes up occasionally, and it's probably been done before ... but I developed it for testing some other code I've been working on. So, I thought I'd post it.
It's all fairly well outlined in the comments to the procedure, so just read those. This code can be placed anywhere, but probably best in a BAS module somewhere.
Code:
Option Explicit
'
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
'
Public Function CallBasProcedureByAddress(ByVal ProcAddress As Long, _
ByVal ReturnType As VbVarType, _
ByRef vReturn As Variant, _
ParamArray vProcArguments() As Variant) As Boolean
'
' Regarding the actual procedure's address (ProcAddress), Private or Public
' doesn't matter, so long as you can get the procedure's address.
' This is typically done with the AddressOf operator.
'
' If there's any problem that can be trapped, this function returns FALSE.
' Caller is totally responsible for passing correct arguments,
' and correctly specifying the return type for Function or Property Get (ReturnType),
' or probable crash. Read on.
'
' If it's a Function or Property Get, the return is returned in vReturn.
' Otherwise, ReturnType should be specified as vbEmpty (vbEmpty=0&).
'
' vProcArguments:
' These MUST match the procedure being called.
' Be SURE to pass the correct variable TYPE. (or crash)
' If it's ByRef, pass VarPtr(value). (or crash)
' If it's ByVal, pass it directly. (or crash)
' Not tested for String, Array, UDT, or Object arguments (including when in a Variant).
' Variant arguments may also present challenges not considered herein,
' but they should work if they don't contain an address reference (i.e., String, Array, or Object).
'
' Get arguments into a more manageable array.
Dim vParams() As Variant: vParams() = vProcArguments()
' Figure out how many actual arguments we're passing to DispCallFunc.
Dim iParamCount As Long: iParamCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
'
' Setup memory pointers and types for DispCallFunc call.
Dim vParamPtr() As Long, vParamType() As Integer
If iParamCount Then
ReDim vParamPtr(iParamCount - 1&)
ReDim vParamType(iParamCount - 1&)
Else
ReDim vParamPtr(0&)
ReDim vParamType(0&)
End If
Dim iParamIndex As Long
For iParamIndex = 0& To iParamCount - 1& ' If iParamCount = 0& then loop won't execute.
vParamPtr(iParamIndex) = VarPtr(vParams(iParamIndex))
vParamType(iParamIndex) = VarType(vParams(iParamIndex))
Next
'
' Make our DispCallFunc call. Return value takes care of itself if it was specified correctly.
Const CC_STDCALL As Long = 4&
Dim iRet As Long
' Since it's a non-Object, we specify 0 for the pvInstance, so DispCallFunc understands.
iRet = DispCallFunc(0&, ProcAddress, CC_STDCALL, ReturnType, iParamCount, vParamType(0&), vParamPtr(0&), vReturn)
If iRet = 0& Then CallBasProcedureByAddress = True
End Function
---------------------------------
Here's a test of it with a Sub Main project and a single Sub procedure:
Code:
Private Sub Main()
Dim vRet As Variant ' Not used but needed for call.
' Notice that I'm careful that the TYPEs and Varptr (or not) are correct, or crash.
CallBasProcedureByAddress AddressOf TestSub1, vbEmpty, vRet, VarPtr(111), 222&, VarPtr(333!), 444#
End Sub
Private Sub TestSub1(ByRef arg1 As Integer, ByVal arg2 As Long, ByRef arg3 As Single, ByVal arg4 As Double)
' Notice that the arguments are a mixture of ByRef & ByVal.
' There is also a hodpodge of types.
'
Debug.Print TypeName(arg1); ":"; arg1, TypeName(arg2); ":"; arg2, TypeName(arg3); ":"; arg3, TypeName(arg4); ":"; arg4
' Prints: Integer: 111 Long: 222 Single: 333 Double: 444
End Sub
---------------------------------
Here's another test with a Sub Main project calling a Function:
Code:
Option Explicit
Private Sub Main()
Dim vRet As Variant
Dim arg1 As Integer: arg1 = 111
CallBasProcedureByAddress AddressOf TestFn1, vbDouble, vRet, VarPtr(arg1), 222&
Debug.Print "Return: "; TypeName(vRet); ":"; vRet, "Arg1: "; TypeName(arg1); ":"; arg1
' Prints: Return: Double: 333 Arg1: Integer: 999
End Sub
Private Function TestFn1(ByRef arg1 As Integer, ByVal arg2 As Long) As Double
TestFn1 = arg1 + arg2
arg1 = 999
' We can change arg2 but change won't be returned because it's ByVal.
End Function
---------------------------------
Feel free to test with Property procedures or other procedures with different types of arguments. It does have some limitations, and those are listed in the comments.
Last edited by Elroy; Oct 27th, 2022 at 01:22 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Oct 28th, 2022, 09:00 PM
#2
Hyperactive Member
Re: Call BAS Procedure By Address
what is the advantage of this vs Call bas.SubRoutine
-
Oct 29th, 2022, 10:30 AM
#3
Re: Call BAS Procedure By Address
Originally Posted by loquat
what is the advantage of this vs Call bas.SubRoutine
None, other than the fact that you can use a memory pointer address, rather than the procedure's name. It just occasionally comes up (someone asking for a "Call by Address" procedure).
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Nov 5th, 2022, 05:04 PM
#4
Re: Call BAS Procedure By Address
Not working with strings by ref
-
Nov 5th, 2022, 06:22 PM
#5
Re: Call BAS Procedure By Address
Georgekar, please give an example of the code you're using.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Nov 5th, 2022, 07:16 PM
#6
Re: Call BAS Procedure By Address
Code:
a = "hello"
CallBasProcedureByAddress AddressOf Test4, vbEmpty, vRet, 100&, StrPtr(a) ' works
CallBasProcedureByAddress AddressOf Test4, vbEmpty, vRet, 100&, a ' works
Private Sub Test4(ByVal a As Long, ByVal m As String)
Debug.Print a, m
End Sub
if we delete byval on second parameter, vb6 close..,
-
Nov 6th, 2022, 10:39 AM
#7
Re: Call BAS Procedure By Address
Ok, to pass a String as ByRef, you've got to pass a pointer to the entire BSTR, and not just the string's data. So, we've got to use VarPtr, and not StrPtr.
Using the above CallBasProcedureByAddress, I placed the following in a BAS module:
Code:
Option Explicit
Public Sub Test4(ByVal a As Long, ByRef m As String)
Debug.Print a, m
End Sub
And then did the following:
Code:
Option Explicit
Private Sub Form_Load()
Dim a As String
Dim vRet As Variant
a = "hello"
CallBasProcedureByAddress AddressOf Test4, vbEmpty, vRet, 100&, VarPtr(a)
End Sub
And it all worked fine.
This is all a good exercise for those wanting to know how all this works "under the hood".
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Nov 6th, 2022, 11:28 AM
#8
Re: Call BAS Procedure By Address
No good. Because you can't change the string in Test4 and get it back from the caller side.
-
Nov 6th, 2022, 11:36 AM
#9
Re: Call BAS Procedure By Address
Originally Posted by georgekar
No good. Because you can't change the string in Test4 and get it back from the caller side.
Good enough for me. It works here as expected and any string modification reaches the caller back.
cheers,
</wqw>
-
Nov 6th, 2022, 12:22 PM
#10
Re: Call BAS Procedure By Address
Ok ! I check it again and now seams to work good.
And now works for CallPointer
Code:
Public btASM As Long
Private Declare Function GetMem4 Lib "msvbvm60" ( _
ByRef Src As Any, _
ByRef Dst As Any) As Long
Public Declare Sub CpyMem Lib "kernel32" Alias "RtlMoveMemory" ( _
pDst As Any, pSrc As Any, ByVal dwLen As Long)
Public Declare Sub FillMem Lib "kernel32" Alias "RtlFillMemory" ( _
pDst As Any, ByVal dlen As Long, ByVal Fill As Byte)
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const MAXCODE As Long = &HEC00&
Private Declare Function CallWindowProcA Lib "user32" ( _
ByVal adr As Long, ByVal p1 As Long, ByVal p2 As Long, _
ByVal p3 As Long, ByVal p4 As Long) As Long
Private Declare Function EbGetExecutingProj Lib "vba6.dll" ( _
ByRef hProject As Long) As Long
Private Declare Function TipGetFunctionId Lib "vba6.dll" ( _
ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Private Declare Function TipGetLpfnOfFunctionId Lib "vba6.dll" ( _
ByVal hProject As Long, _
ByVal strFunctionId As String, _
ByRef lpfn As Long) As Long
Public Function AddrOf( _
ByRef sFuncName As String) As Long
Dim hProject As Long
Dim lResult As Long
Dim sID As String
Dim pfn As Long
Dim sUnicode As String
sUnicode = StrConv(sFuncName, vbUnicode)
EbGetExecutingProj hProject
If hProject <> 0 Then
If TipGetFunctionId(hProject, sUnicode, sID) = 0 Then
If TipGetLpfnOfFunctionId(hProject, sID, pfn) = 0 Then
AddrOf = pfn
End If
End If
End If
End Function
Public Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
If fnc = 0 Then Exit Function
If btASM = 0 Then
btASM = VirtualAlloc(ByVal 0&, MAXCODE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
End If
If btASM = 0 Then
CallPointer = -1
Exit Function
End If
VirtualLock btASM, MAXCODE
Dim pASM As Long
Dim i As Integer
Dim Addr1 As Long
pASM = btASM
FillMem ByVal pASM, MAXCODE, &HCC
AddByte pASM, &H58 ' POP EAX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H50 ' PUSH EAX
If UBound(params) = 0 Then
If IsArray(params(0)) Then
For i = UBound(params(0)) To 0 Step -1
AddPush pASM, CLng(params(0)(i)) ' PUSH dword
Next
Else
AddPush pASM, CLng(params(0)) ' PUSH dword
End If
Else
For i = UBound(params) To 0 Step -1
AddPush pASM, CLng(params(i)) ' PUSH dword
Next
End If
AddCall pASM, fnc ' CALL rel addr
AddByte pASM, &HC3 ' RET
CallPointer = CallWindowProcA(btASM, _
0, 0, 0, 0)
VirtualUnlock btASM, MAXCODE
End Function
Public Sub ReleaseMem()
If btASM <> 0 Then
VirtualFree btASM, MAXCODE, MEM_DECOMMIT
VirtualFree btASM, 0, MEM_RELEASE
End If
End Sub
Private Sub AddPush(pASM As Long, lng As Long)
AddByte pASM, &H68
AddLong pASM, lng
End Sub
Private Sub AddCall(pASM As Long, addr As Long)
AddByte pASM, &HE8
AddLong pASM, addr - pASM - 4
End Sub
Private Sub AddLong(pASM As Long, lng As Long)
CpyMem ByVal pASM, lng, 4
pASM = pASM + 4
End Sub
Private Sub AddByte(pASM As Long, bt As Byte)
CpyMem ByVal pASM, bt, 1
pASM = pASM + 1
End Sub
Public Function CallCdecl( _
ByVal lpfn As Long, _
ParamArray Args() As Variant _
) As Long
Dim btASM(&HEC00& - 1) As Byte
Dim pASM As Long
Dim btArgSize As Byte
Dim i As Integer
pASM = VarPtr(btASM(0))
If UBound(Args) = 0 Then
If IsArray(Args(0)) Then
For i = UBound(Args(0)) To 0 Step -1
AddPush pASM, CLng(Args(0)(i)) ' PUSH dword
btArgSize = btArgSize + 4
Next
Else
For i = UBound(Args) To 0 Step -1
AddPush pASM, CLng(Args(i)) ' PUSH dword
btArgSize = btArgSize + 4
Next
End If
Else
For i = UBound(Args) To 0 Step -1
AddPush pASM, CLng(Args(i)) ' PUSH dword
btArgSize = btArgSize + 4
Next
End If
AddByte pASM, &HB8
AddLong pASM, lpfn
AddByte pASM, &HFF
AddByte pASM, &HD0
AddByte pASM, &H83
AddByte pASM, &HC4
AddByte pASM, btArgSize
AddByte pASM, &HC2
AddByte pASM, &H10
AddByte pASM, &H0
CallCdecl = CallWindowProcA(VarPtr(btASM(0)), _
0, 0, 0, 0)
End Function
Last edited by georgekar; Nov 6th, 2022 at 12:27 PM.
-
Apr 15th, 2023, 08:30 AM
#11
Hyperactive Member
Re: Call BAS Procedure By Address
two questions
1.will you update code to support x64, such as office vba and twinbasic
2.can you achieve CallBasProcedureByName
-
Apr 15th, 2023, 04:41 PM
#12
Re: Call BAS Procedure By Address
Originally Posted by loquat
two questions
1.will you update code to support x64, such as office vba and twinbasic
2.can you achieve CallBasProcedureByName
Oh dear, loquat. I've got no interest in doing the first one, although I do believe it could be done. Maybe ask over in the VBA forum.
Regarding the second one, two thoughts: 1) If you mean the procedure's name in a string variable, that can't be done. Once BAS procedures are compiled, their name is gone gone gone. All the calls of the procedure are reduced to simple addresses. That's why you actually can call them by address.
And here's my second thought: Isn't that what we're doing when we just call it the way we always do? But I suspect you do mean calling it with the name in a string variable.
--------
Now interestingly, within the VBA (not compiled VB6 code), there probably is a way to get the procedure names within BAS modules. But again, that's just not my interest.
Good Luck.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Apr 15th, 2023, 05:48 PM
#13
Re: Call BAS Procedure By Address
With the code in the original post I don't see anything you'd need to do for x64 other than update the DispCallFunc def...
Public Declare PtrSafe Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Integer, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Any, ByRef prgpvarg As Any, ByRef pvargResult As Any) As Long
Assembly thunks like georgekar posted on the other hand, would need major changes. Only know of a couple people who have done any x64 asm work in VB; The trick might help.
Last edited by fafalone; Apr 15th, 2023 at 06:06 PM.
-
Apr 15th, 2023, 07:05 PM
#14
Re: Call BAS Procedure By Address
Originally Posted by fafalone
With the code in the original post I don't see anything you'd need to do for x64 other than update the DispCallFunc def...
Public Declare PtrSafe Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Integer, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Any, ByRef prgpvarg As Any, ByRef pvargResult As Any) As Long
Assembly thunks like georgekar posted on the other hand, would need major changes. Only know of a couple people who have done any x64 asm work in VB; The trick might help.
Well, the passed-in ProcAddress would have to be declared as a LongPtr. But, without thorough testing, I'm not sure if that's all or not.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Apr 15th, 2023, 08:59 PM
#15
Hyperactive Member
Re: Call BAS Procedure By Address
Regarding the second one, two thoughts: 1) If you mean the procedure's name in a string variable, that can't be done. Once BAS procedures are compiled, their name is gone gone gone. All the calls of the procedure are reduced to simple addresses. That's why you actually can call them by address.
And here's my second thought: Isn't that what we're doing when we just call it the way we always do? But I suspect you do mean calling it with the name in a string variable.
I guess with the trick's code GetCallingProcName, we should have a trick to make that done with a compiled debug symbol attached.
Now interestingly, within the VBA (not compiled VB6 code), there probably is a way to get the procedure names within BAS modules. But again, that's just not my interest.
i have seen some demo for vba to do CallBasProcByName, like CallByName but can call proc in stdModule
CallBasProcByName "modFunction", "SubProcedure1"
https://github.com/Greedquest/CodeReviewFiles
and
https://github.com/Greedquest/vbInvoke
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|