AddressOf for Class Methods (and other VTable exploration)?
Okay, this one is purely for my own edification. I feel like I've seen this, but I can't put my fingers on it.
And, if you guys are willing to play along, it'll be nice for me to get some of these concepts under my belt.
Also, thanks to Ben for spurring my thoughts on this subject.
Ok, simple question. Let's say we've got the following very simplistic class module:
Code:
Option Explicit
Public Sub Test(ByVal arg1 As Long, ByVal arg2 As Long, ByVal arg3 As Long, ByVal arg4 As Long)
MsgBox CStr(arg1) & " " & CStr(arg2) & " " & CStr(arg3) & " " & CStr(arg4)
End Sub
And, let's further say that I've instantiated this class with something like the following:
Code:
Dim c As Class1
Set c = New Class1
And I'll also throw in a nice function suggested by Dex:
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
'
Private Function DeRef(ByVal Address As Long) As Long
GetMem4 ByVal Address, DeRef
End Function
And we can throw in these declarations as well, just in case they're needed:
Code:
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal PPV As Long, ByVal oVft As Long, ByVal cc As Long, ByVal rtTYP As VbVarType, ByVal paCNT As Long, ByVal paTypes As Long, ByVal paValues As Long, ByRef fuReturn As Variant) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function VBObjPtr Lib "msvbvm60.dll" Alias "VarPtr" (ByVal pObj As IUnknown) As Long
Now, here's the question: How would one go about getting the address of that "Test" function, and then call it with that address?
I've tried a few different things, but all I do is keep crashing the VB6 IDE.
Thanks,
Elroy
Last edited by Elroy; Aug 6th, 2018 at 11:00 AM.
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.
The Trick can enlighten you and I'm sure he'll chime in when he sees this.
Each VB class object (form, class, uc, property page, etc) has an offset where the methods (subs, properties, functions) begin. You have to know that offset to begin with. Whether or not the object in question, implements other classes, affects these offsets, I'm not sure.
However, with a public method in a class, you don't need to call them by their pointers using DispCallFunc. You simply use VB's CallByName() function. With CallByName, I don't think I'd ever use DispCallFunc. Also, I think you can get the public method pointers by navigating IDispatch.
For private methods, I've fallen in love with Paul Caton's routines for locating a specific private method from the bottom of the class, upwards. I routinely use his logic to get the function pointer for use in thunks that call back to the class. No limitation I'm aware of, other than ensure that the private methods you are interested in are always at the end of the class.
BTW. You can't use CallWindowProc generically for calling anything but window procedures. Even with public functions in a bas module, you need to ensure that function has exactly 4 parameters. Though one might be able to overload the final parameter using a Long() array. In any case, CallWindowProc is limited from the start.
Last edited by LaVolpe; Jan 17th, 2018 at 10:30 PM.
Insomnia is just a byproduct of, "It can't be done"
And here's a simple example of calling a class function (1st function in the class)
The Class. Doesn't matter if function is public or private, just make it the first one for this example.
Code:
Option Explicit
Public Function AddTwoNumbers(ByVal A As Long, ByVal B As Long) As Long
AddTwoNumbers = A + B
End Function
The form. I've included a generic DispCallFunc wrapper.
Code:
Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByVal paTypes As Long, ByVal paValues As Long, ByRef retVAR As Variant) As Long
Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
Private Sub Command1_Click()
Dim c As Class1, lRtn As Long ' << holds the function's return value
Set c = New Class1
' 7& hardcoded below is the class offset for start of class functions (&H1C) divided by 4.
' reason divided by 4 is because my wrapper expects interface method ordinals, not actual byte-offsets
pvCallInterface ObjPtr(c), 7&, 5&, 10&, VarPtr(lRtn)
' note: a Sub() won't have a return value; therefore, no final parameter in above call
MsgBox "5 + 10 = " & lRtn
End Sub
Private Function pvCallInterface(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, _
ParamArray FunctionParameters() As Variant) As Variant
' Coded to call ActiveX or COM objects, not standard dlls
' If the function fails, the return value is: Empty and Err.LastDllError is reason
' Parameters:
' InterfacePointer. A pointer to an object/class, i.e., ObjPtr(IPicture)
' Passing invalid pointers likely to result in crashes
' VTableOffset. The zero-bound ordinal offset from the passed InterfacePointer where the virtual function exists.
' Example: call IUnknown::Release (3rd interface method (ordinal #2), no additional parameters):
' pvCallInterface InterfacePointer, 2
' FYI: SetLastError used in this routine so that you can call Err.LastDllError to see the reason for failure
' Optionally. This can be changed to raise an error instead.
Dim pIndex As Long, pCount As Long
Dim pTypes As Long, pValues As Long
Dim vParamPtr() As Long, vParamType() As Integer
Dim vRtn As Variant, vParams() As Variant
Const CallConvention As Long = 4& ' STDCALL
If VTableOffset < 0& Or InterfacePointer = 0& Then
pIndex = 5
Else
pCount = UBound(FunctionParameters) + 1&
If pCount Then ' else no parameters
vParams() = FunctionParameters() ' copy passed parameters, if any
ReDim vParamPtr(0 To pCount - 1&) ' need matching array of parameter types
ReDim vParamType(0 To pCount - 1&) ' and pointers to the parameters
For pIndex = 0& To pCount - 1&
vParamPtr(pIndex) = VarPtr(vParams(pIndex))
vParamType(pIndex) = VarType(vParams(pIndex))
Next
pTypes = VarPtr(vParamType(0)): pValues = VarPtr(vParamPtr(0))
End If
pIndex = DispCallFunc(InterfacePointer, VTableOffset * 4&, CallConvention, _
vbLong, pCount, pTypes, pValues, vRtn)
End If
If pIndex = 0& Then ' 0 = S_OK
pvCallInterface = vRtn ' return result
Else
SetLastError pIndex
End If
End Function
Edited: Why is the 1st class method the 7th ordinal function (zero-based)?
Every interface inherits IUnknown which has 3 methods
Every VB Object (class is an object) inherits IDispatch which has 4 methods
So the 1st function in the class is 8th method (or 7 as zero-based)
For classes, this is relatively easy. The other VB class objects (forms, etc) have several other interfaces in there and that offset is significantly different.
Last edited by LaVolpe; Jan 17th, 2018 at 11:03 PM.
Insomnia is just a byproduct of, "It can't be done"
@LaVolpe: VERY nice. I'm quite tired at the moment, so I'll study it later. But I did set it up, and it absolutely works. And yeah, you totally caught me with the CallWindowProc function. I guess it was a bit obvious with the way I had setup my Test function.
After I study this, I may ask for further clarification, but at another hour,
Thank You!,
Elroy
EDIT1: And yeah, I know there are possibly easier ways to do this. However, they're not quite as educational with respect to sorting out what's actually going on with these things.
EDIT2: Ok, I played around with it, and it works equally well for a Public, Friend, and/or Private method of a class. I haven't yet played around with multiple methods, possibly a mixture of Public, Private, and Friend. Nor have I tried Subs and Properties, but I will. Again, this is truly great.
Last edited by Elroy; Jan 18th, 2018 at 12:54 AM.
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.
Elroy, if you use my DispCallFunc wrapper, the one thing to keep in mind is that you must pass the correct vartypes. 99% of the calls will be ensuring you pass
- Hardcoded longs, i.e., 5& vs 5 (which is integer)
- Variables declared correctly, i.e., don't pass a variable Dim'd as Integer if target requires Long; else use conversions like CLng()
- Strings with StrPtr(). COM will be using BSTR
- ByRef with VarPtr()
As you noticed, the return value of a Class function is passed with an extra parameter. COM returns HRESULT, not some custom function vartype. The HRESULT value is returned by pvCallInterface. Typically, return of zero is success, but other values can be returned too; depends on interface being called. Usng DispCallFunc is low level -- screw it up and at best, wrong results, at worst: crash
Tip:
Nor have I tried Subs and Properties, but I will
Subs are addressed in the sample code comments. In VB, you see a property as just a single method when using a reference, i.e., Me.BackColor. You don't see that there are one to three methods within the code: Get, Let and/or Set methods. Note: Just one method = Read-Only or Write-Only property. When calling a property by pointer, each method has its own function address, as expected.
Another note about properties. Publicly declared variables in the declarations section of class objects (class, form, etc) are actually properties generated by VB at runtime. IIRC, the first declared is actually the &H1C offset, not the first method in the class. But been ages since I looked at that scenario and have opted for writing Get/Let properties vs. using publicly declared variables in classes since I learned that tidbit.
Last edited by LaVolpe; Jan 18th, 2018 at 09:10 AM.
Insomnia is just a byproduct of, "It can't be done"
The "basic-minimum"-example is covered in the Opener-Post (which describes the few lines of code in detail,
which you can later run as a project from the Tutorial-SubFolder: [0 - LightWeight COM without any Helpers].
This base-example is using a TypeLib, to make VB recognize the Interface (earlybound) of the little Class we implemented
(across 3 *.bas-Modules, to separate things into "Class-BluePrints" and "Class-Instancing").
This should help with your understanding, what the compiler does under the covers - and also:
- which parts of a Class are "static" (reside in static memory)
- and where the "dynamic parts" come in (when you create instances)
There is nothing "dangerous" in that first little tutorial-demo 0 (not even "Function-Calls per Pointer" are used),
so you can step through the entire thing with F8 without any problems (to see what's going on under the covers).
Required reading for any VB Developer should be
Advanced Visual Basic 6 (Curland)
Hardcore Visual Basic (McKinney)
Inside COM+ --> http://thrysoee.dk/InsideCOM+/ this is an easy read and a nice broad overview of COM
Last edited by DEXWERX; Jan 18th, 2018 at 09:32 AM.
DispCallFunc is really useful for calling VTable only interfaces if no TLBs are used to define interfaces. I do a lot of coding with VTable-only interfaces and am comfortable creating them via thunks or bas modules. Just requires a bit of research to get the correct VTable order and correct parameter information.
Insomnia is just a byproduct of, "It can't be done"
@LaVolpe's post #6: Yeah, I do know to be very careful when calling anything with an address. Also, I don't have any immediate need for this. Rather, just developing code that works is always a strong way for me to learn how things work. Also, there have been many times in the past when I learn something for the "fun" of it, and then start using it for production at some point in the near future.
I'm also one to avoid TypeLibs unless they're absolutely needed. I don't have anything specific against them, and have actually developed a "pure" VB6 solution to developing them (found in this thread). However, with my primary application being open source, I do have a few users who like to snoop (and also execute) from my source code. As such, getting TypeLibs registered would just be one more hurdle for them to get over before they could do that. As things stand now, once they get the IDE correctly installed, they're up and running.
Best Regards,
Elroy
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.
Alrighty, this is quite nice. Here's what I've played around with so far:
Code for a Class1 module:
Code:
Option Explicit
'
Public mlVar1 As Long
Private mlVar2 As Long ' This one is NOT in the VTable.
'
Private Function Test1(ByVal A As Long, ByVal B As Long) As Long
Test1 = A + B
End Function
Private Function Test2(ByVal A As Long, ByVal B As Long) As Long
Test2 = A - B
End Function
Private Sub Test3(ByVal A As Long, ByVal B As Long)
MsgBox CStr(A) & " " & CStr(B)
End Sub
Private Sub Test4(ByVal A As Long, ByRef B As Long)
B = A + 25
End Sub
Private Sub Class_Initialize() ' This IS included in the VTable.
mlVar1 = 99
End Sub
Code for a Form1 module (with a Command1):
Code:
Option Explicit
'
Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByVal paTypes As Long, ByVal paValues As Long, ByRef retVAR As Variant) As Long
Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
'
Private Sub Command1_Click()
Dim c As Class1
Dim lRtn As Long
Set c = New Class1
'
' This must !strictly! follow the order of Public (not Private) variables and ALL methods in the class.
' Note that even the location of things like Class_Initialize and Class_Terminate matters!
Const Var1OffsetGet = 7&
Const Var1OffsetLet = Var1OffsetGet + 1&
Const Test1Offset As Long = Var1OffsetGet + 2&
Const Test2Offset As Long = Var1OffsetGet + 3&
Const Test3Offset As Long = Var1OffsetGet + 4&
Const Test4Offset As Long = Var1OffsetGet + 5&
'
CallClassInterface ObjPtr(c), Var1OffsetGet, VarPtr(lRtn) ' Get the public variable.
MsgBox CStr(lRtn)
CallClassInterface ObjPtr(c), Var1OffsetLet, 88& ' Let the public variable.
CallClassInterface ObjPtr(c), Var1OffsetGet, VarPtr(lRtn) ' Check to see if we actually changed it.
MsgBox CStr(lRtn)
CallClassInterface ObjPtr(c), Test1Offset, 5&, 10&, VarPtr(lRtn)
MsgBox "5 + 10 = " & CStr(lRtn)
CallClassInterface ObjPtr(c), Test2Offset, 5&, 10&, VarPtr(lRtn)
MsgBox "5 - 10 = " & CStr(lRtn)
CallClassInterface ObjPtr(c), Test3Offset, 5&, 10& ' A Sub() won't have a return value; therefore, no final parameter.
lRtn = 0
CallClassInterface ObjPtr(c), Test4Offset, 5&, VarPtr(lRtn) ' Passing ByRef.
MsgBox CStr(lRtn)
End Sub
Private Function CallClassInterface(ByVal IPtr As Long, ByVal VTableEntry As Long, ParamArray FnArgs() As Variant) As Variant
' Originally developed by LaVolpe.
' Modifications by Elroy.
'
' Works on Public, Friend, or Private methods of a class.
' The VTable will also include Public variables, but NOT Private variables.
' Coded to call ActiveX or COM objects, not standard DLLs.
'
' Input:
' IPtr. A pointer to an object/class, i.e., ObjPtr(IPicture), ObjPtr(oClass)
' Passing invalid pointers likely to result in crashes.
' Note that this is not a pointer directly at the VTable.
' The call to DispCallFunc resolves (DeRefs) the VTable.
'
' VTableEntry. The zero-based ordinal offset from the passed IPtr where the virtual function exists.
' Example: call IUnknown::Release (3rd interface method (ordinal #2), no additional parameters):
' CallClassInterface IPtr, 2&
'
' VTableEntry:
' IUnknown:
' 0 = QueryInterface
' 1 = AddRef
' 2 = Release
' IDispatch
' 3 = GetIDsOfNames
' 4 = GetTypeInfo
' 5 = GetTypeInfoCount
' 6 = Invoke
' User defined members [All procedures (including events) Private, Friend, Public; and Public (not Private) variables]:
' 7, etc.
'
Dim pIndex As Long
Dim pCount As Long
Dim iError As Long
Dim pTypes As Long
Dim pValues As Long
Dim vParamPtr() As Long
Dim vParamType() As Integer
Dim vRtn As Variant
Dim vParams() As Variant
'
Const CallConvention As Long = 4& ' STDCALL
'
If VTableEntry < 0& Or IPtr = 0& Then
iError = 5&
Else
pCount = UBound(FnArgs) + 1& ' UBound will be -1 if nothing passed.
'
' Setup the parameters for the DispCallFunc call.
If pCount Then
vParams() = FnArgs() ' Copy passed parameters, if any.
ReDim vParamPtr(0 To pCount - 1&) ' Need matching array of parameter pointers,
ReDim vParamType(0 To pCount - 1&) ' and types to the parameters.
For pIndex = 0& To pCount - 1&
vParamPtr(pIndex) = VarPtr(vParams(pIndex))
vParamType(pIndex) = VarType(vParams(pIndex))
Next
pTypes = VarPtr(vParamType(0))
pValues = VarPtr(vParamPtr(0))
End If
'
iError = DispCallFunc(IPtr, VTableEntry * 4&, CallConvention, vbLong, pCount, pTypes, pValues, vRtn)
End If
'
If iError = 0& Then ' 0 = S_OK
' vRtn is actually the returned error status of the called code, but not whether-or-not the DispCallFunc was successful.
' With user defined (VB6) methods, there won't be an error return. However, when calling IUnknown and/or IDispatch, there will be.
' In cases where we're calling user defined (VB6) methods, we can ignore it, calling CallClassInterface as a SUB.
CallClassInterface = vRtn
Else
' If we think something went wrong, be sure to call GetLastError.
' However, this ONLY has to do with errors in DispCallFunc and has nothing to do with errors in the actual class members.
SetLastError iError
End If
End Function
I think that gets everything sorted with respect to exposed (and even non-exposed) members we might call in a class. I guess I still need to play around with strings, UDTs, Variants, and other objects, and see how to pass them.
Also, I'm thinking I'll play around with some of the IUnknown and IDispatch entry-points and see if I can make heads-or-tails of them.
I hope all are staying warm.
Elroy
EDIT1: Fixed my comments about vRtn, reflecting information provided by LaVolpe, below.
Last edited by Elroy; Jan 18th, 2018 at 01:45 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.
And try it compiled, in case VB does stuff to the VTable order afterwards -- just a thought.
I guess I still need to play around with strings, UDTs, Variants, and other objects, and see how to pass them.
^^ Strings: StrPtr(). UDTs: VarPtr(). Objects: ObjPtr(). Variants: Won't have many of these in VTable interfaces (though they do exist). In the only current example I can think of, I pass it using VarPtr() because the parameter documentation specifically says pointer to a variant. Regarding strings/objects... not sure about passing those if they are ByRef and the function can change them. Save your project before testing
Not exactly sure when vRtn is used. It's NOT the return of the class function. Also, it's not necessarily any error. In most cases, we can probably call our CallClassInterface as a SUB.
^^ Not true, it's always returned, barring an error. It's the HRESULT of the interface called. Zero = success.
Edited: Here's an example of what I mean.
Let's say you perform IUnknown::QueryInterface asking for an interface that is not implemented by the target class. DispCallFunc will return 0 because that API succeeded. However, since the class didn't support the requested interface, vRtn would contain the value E_NOINTERFACE which is the return value (HRESULT) from that queried interface.
Last edited by LaVolpe; Jan 18th, 2018 at 01:43 PM.
Insomnia is just a byproduct of, "It can't be done"
I didn't read all messages. When i made the old approach for calling a function by pointer i've made few examples, but it on Russian language. When i have time maybe i'll make the detailed description.
@LaVolpe (and anyone interested): I just tried the code in post #11 compiled, and everything looks copacetic.
Last edited by Elroy; Jan 18th, 2018 at 02:10 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.
FYI, if you ever get into creating your own thunks and calling back into private class object functions, I'd recommend Paul Caton's logic of finding private methods from the end of the class. This allows you to place those functions at end of the class and grouped together as needed. Then whether you add/remove class methods over time, you don't have to worry about its ordinal position within the class changing because they'll always be at the end, even if you add a new public variable in the declarations section. That assumption is that you don't add new stuff at the bottom. I typically add commented banners to remind myself, something like: DON'T ADD ANY CODE BELOW THIS POINT.
Why did Paul focus on private methods? Simply because you don't want to make those callbacks public/friend where some user could easily call them and likely crash your project.
Insomnia is just a byproduct of, "It can't be done"
Yeah, once-upon-a-time, I was actually pretty good at writing assembler. But that was mostly back in the days of 8080, for the CP/M OS. I've "played" with some assembler (and machine code) in more recent days, but I do believe those days are behind me. I still dabble in some C, and occasionally some Fortran. But 99.9% of my programming time these days is in VB6. As such, I'll probably be shying away from any thunks.
I've heard you talk about Paul Caton's work on several occasions (and even "played with" some of your stuff based on it). But I've never seriously considered incorporating it into any production project. I suppose, I just really haven't ever had a compelling need.
Even with this thread, it's really just out of fascination that I'm exploring alternative ways to call these class methods. I hear you guys talking about VTables all the time, so I decided it was time I get a good handle on what they are. That's still a learning curve, but I'm getting there.
All The Best,
Elroy
EDIT1: Also, the idea of "pure" VB6 solutions is fascinating to me. I suppose, in a certain sense, a thunk actually is a pure VB6 solution, since an assembler isn't actually involved. IDK, I guess that means I need to completely get my head around the architecture of a VB6 executable, and also make much larger distinctions between running in the IDE versus running compiled, than I currently do. I must admit though that writing a complete VB6 replacement (IDE, Compiler, and all), using VB6, does hold a certain fascination for me.
Last edited by Elroy; Jan 18th, 2018 at 03:23 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.
Within VB, I think VTable knowledge is interesting but not really as important, simply because VB does all that for you behind the scenes. And what VB doesn't do, TLBs can be used. But is nice to be able to dynamically create a functioning VTable and pass it to other code, i.e. APIs, and see that other code call back into your VTable. Playing with something like that, I was able to see that each time ObjPtr() was used, VB called QueryInterface before and after. I like playing with the low level stuff too -- more for curiosity and education than for actual use. However, with Windows moving more towards VTable-only interfaces since Vista, it doesn't hurt to know more about how they work.
Just for clarity. VTable-only means the interface does not support IDispatch, at least that's how I define it. IDispatch is what allows us to call methods via the object's reference and to use VB's CallByName().
Insomnia is just a byproduct of, "It can't be done"
Btw, IDispatch is fairly easy to implement on "VTable-only" interface -- you just create something like *typelib* chunk that describes the interface (w/ methods' params/retval using automation types only) and pass it to helper functions baked into the OS that do the heavy lifting to implement Invoke and the rest of the methods of your IDispatch.
So basicly even private VB6 classes do have "typelibs" generated by the VB6 compiler.
Re: AddressOf for Class Methods (and other VTable exploration)?
EDIT: There's a bug in the following concepts. See LaVolpe's post #21 below.
Ok, continuing on. I'd actually done something similar before (again following LaVolpe's lead), but I've successfully got AddRef and Release up and running.
But now, I'm trying to get my head around QueryInterface. If I understand it correctly, it returns an object pointer quite similar to ObjPtr(). It also internally calls AddRef when it's called.
So, it works only on already instantiated objects? Or maybe that's the way I initially want to understand it.
And, when I get that pointer, I could use CopyMemory (or GetMem4 or PutMem4) and patch up some object variable that was currently Nothing?
And also, what arguments would be passed to DispCallFunc? I know the offsetinVft would be 0, and that pvInstance would be the ObjPtr() to some existing object. But, can we send zeros for the rest of them? And, of course, a Variant to catch retVAR.
I haven't tested. I thought I'd ask before just charging down this path.
Also, I'm quite sure I'd need to be careful with the reference count. And also, early binding and late binding are a bit confusing to me here, but I suppose I'll just start my testing with all early binding (declaring my target object variable with the correct class).
Here's my working experimental code:
Form1:
Code:
Option Explicit
'
Private Enum CallConvEnum
CC_FASTCALL = 0&
CC_CDECL = 1&
CC_PASCAL = 2& ' Same as CC_MSCPASCAL
CC_MACPASCAL = 3&
CC_STDCALL = 4&
CC_FPFASTCALL = 5&
CC_SYSCALL = 6&
CC_MPWCDECL = 7&
CC_MPWPASCAL = 8&
CC_MAX = 9&
End Enum
#If False Then
Dim CC_FASTCALL, CC_CDECL, CC_PASCAL, CC_MACPASCAL, CC_STDCALL, CC_FPFASTCALL, CC_SYSCALL, CC_MPWCDECL, CC_MPWPASCAL, CC_MAX
#End If
'
Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByVal paTypes As Long, ByVal paValues As Long, ByRef retVAR As Variant) As Long
Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
'
Private Sub Command1_Click()
Dim c As Class1
Dim lRtn As Long
Set c = New Class1
'
Dim i As Long
i = ObjPtr(c)
MsgBox ObjRefCount(i)
MsgBox ObjAddRef(ObjPtr(c))
MsgBox ObjRelease(ObjPtr(c))
'
' This must !strictly! follow the order of Public (not Private) variables and ALL methods in the class.
' Note that even the location of things like Class_Initialize and Class_Terminate matters!
Const Var1OffsetGet = 7&
Const Var1OffsetLet = Var1OffsetGet + 1&
Const Test1Offset As Long = Var1OffsetGet + 2&
Const Test2Offset As Long = Var1OffsetGet + 3&
Const Test3Offset As Long = Var1OffsetGet + 4&
Const Test4Offset As Long = Var1OffsetGet + 5&
'
CallObjectInterface ObjPtr(c), Var1OffsetGet, VarPtr(lRtn) ' Get the public variable.
MsgBox CStr(lRtn)
CallObjectInterface ObjPtr(c), Var1OffsetLet, 88& ' Let the public variable.
CallObjectInterface ObjPtr(c), Var1OffsetGet, VarPtr(lRtn) ' Check to see if we actually changed it.
MsgBox CStr(lRtn)
CallObjectInterface ObjPtr(c), Test1Offset, 5&, 10&, VarPtr(lRtn)
MsgBox "5 + 10 = " & CStr(lRtn)
CallObjectInterface ObjPtr(c), Test2Offset, 5&, 10&, VarPtr(lRtn)
MsgBox "5 - 10 = " & CStr(lRtn)
CallObjectInterface ObjPtr(c), Test3Offset, 5&, 10& ' A Sub() won't have a return value; therefore, no final parameter.
lRtn = 0
CallObjectInterface ObjPtr(c), Test4Offset, 5&, VarPtr(lRtn) ' Passing ByRef.
MsgBox CStr(lRtn)
End Sub
Private Function ObjAddRef(ByVal iObjPtr As Long) As Long
' Returns the object count after reference count is incremented.
' Careful, this counter is critical to objects correctly destroying themselves when all references are gone.
'
ObjAddRef = CLng(CallObjectInterface(iObjPtr, 1&))
End Function
Private Function ObjRelease(ByVal iObjPtr As Long) As Long
' Returns the object count after reference count is incremented.
' Careful, this counter is critical to objects correctly destroying themselves when all references are gone.
'
ObjRelease = CLng(CallObjectInterface(iObjPtr, 2&))
End Function
Private Function ObjRefCount(ByVal iObjPtr As Long) As Long
' It's tricky to get the correct count, because just touching it in several ways will create a temporary reference.
' For instance, calling like this will create one temporary reference:
' MsgBox ObjRefCount(ObjPtr(obj))
' So, this would be accurate:
' MsgBox (ObjRefCount(ObjPtr(obj)) - 1)
' Whereas also, doing something like the following will be accurate:
' Dim i As Long
' i = ObjPtr(obj)
' MsgBox ObjRefCount(i)
'
ObjRefCount = ObjAddRef(iObjPtr)
ObjRefCount = ObjRelease(iObjPtr) ' We increment and then decrement, so no-harm-no-foul.
End Function
Private Function CallObjectInterface(ByVal iObjPtr As Long, ByVal VTableEntry As Long, ParamArray FnArgs() As Variant) As Variant
' Originally developed by LaVolpe.
' Modifications by Elroy.
'
' Works on Public, Friend, or Private methods of a class.
' The VTable will also include Public variables, but NOT Private variables.
' Coded to call ActiveX or COM objects, not standard DLLs.
'
' Input:
' iObjPtr. A pointer to an object/class, i.e., ObjPtr(IPicture), ObjPtr(oClass)
' Passing invalid pointers likely to result in crashes.
' Note that this is not a pointer directly at the VTable.
' The call to DispCallFunc resolves (DeRefs) the VTable.
' Error 5 if this doesn't point to an instantiated object.
'
' VTableEntry. The zero-based ordinal offset from the passed iObjPtr where the virtual function exists.
' Example: call IUnknown::Release (3rd interface method (ordinal #2), no additional parameters):
' CallObjectInterface iObjPtr, 2&
'
' VTableEntry:
' IUnknown:
' 0 = QueryInterface
' 1 = AddRef
' 2 = Release
' IDispatch
' 3 = GetIDsOfNames
' 4 = GetTypeInfo
' 5 = GetTypeInfoCount
' 6 = Invoke
' User defined members [All procedures (including events) Private, Friend, Public; and Public (not Private) variables]:
' 7, etc.
'
Dim iArgsIdx As Long
Dim iArgsCnt As Long
Dim iError As Long
Dim pTypes As Long
Dim pValues As Long
Dim vParamPtr() As Long
Dim vParamType() As Integer
Dim vRtn As Variant
Dim vParams() As Variant
Dim VTableOffset As Long
'
If VTableEntry < 0& Or iObjPtr = 0& Then
Error 5&
Exit Function
End If
'
iArgsCnt = UBound(FnArgs) + 1& ' UBound will be -1 if nothing passed.
'
' Setup the parameters for the DispCallFunc call.
If iArgsCnt Then
vParams() = FnArgs() ' Copy passed parameters, if any.
ReDim vParamPtr(0 To iArgsCnt - 1&) ' Need matching array of parameter pointers,
ReDim vParamType(0 To iArgsCnt - 1&) ' and types to the parameters.
For iArgsIdx = 0& To iArgsCnt - 1&
vParamPtr(iArgsIdx) = VarPtr(vParams(iArgsIdx))
vParamType(iArgsIdx) = VarType(vParams(iArgsIdx))
Next iArgsIdx
pTypes = VarPtr(vParamType(0))
pValues = VarPtr(vParamPtr(0))
End If
'
VTableOffset = VTableEntry * 4&
iError = DispCallFunc(iObjPtr, VTableOffset, CC_STDCALL, vbLong, iArgsCnt, pTypes, pValues, vRtn)
'
If iError = 0& Then ' S_OK
' vRtn is actually the returned error status of the called code, but not whether-or-not the DispCallFunc was successful.
' With user defined (VB6) methods, there won't be an error return. However, when calling IUnknown and/or IDispatch, there will be.
' In cases where we're calling user defined (VB6) methods, we can ignore it, calling CallObjectInterface as a SUB.
CallObjectInterface = vRtn
Else
' If we think something went wrong, be sure to call GetLastError.
' However, this ONLY has to do with errors in DispCallFunc and has nothing to do with errors in the actual class members (or IUnknown or IDispatch).
SetLastError iError
End If
End Function
Class1:
Code:
Option Explicit
'
Public mlVar1 As Long
Private mlVar2 As Long ' This one is NOT in the VTable.
'
Private Function Test1(ByVal A As Long, ByVal B As Long) As Long
Test1 = A + B
End Function
Private Function Test2(ByVal A As Long, ByVal B As Long) As Long
Test2 = A - B
End Function
Private Sub Test3(ByVal A As Long, ByVal B As Long)
MsgBox CStr(A) & " " & CStr(B)
End Sub
Private Sub Test4(ByVal A As Long, ByRef B As Long)
B = A + 25
End Sub
Private Sub Class_Initialize() ' This IS included in the VTable.
mlVar1 = 99
End Sub
Thanks,
Elroy
Last edited by Elroy; Feb 8th, 2018 at 08:39 AM.
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.
Re: AddressOf for Class Methods (and other VTable exploration)?
I can help you out a bit.
The parameters are 2: VarPtr(GUID), VarPtr(someIUnknownVariable)
You would have to know the GUID of the interface you want to query. These are typically shown in MSDN with IID_ prefix. IID = Interface ID. To use a GUID string, i.e., something like {43826d1e-e718-42ee-bc55-a1e261c37bfe}, I use IIDFromString API. The string is not case-sensitive and that API requires the curly brackets in the string.
Code:
Dim aGUID(0 to 3) As Long, oIUnknown As stdole.IUnknown
IIDFromString StrPtr(yourGUIDstring), VarPtr(aGUID(0)) ' in the API declaration, I use ByVal ... As Long for both params
If pvCallInterface(ObjPtr(interfaceToQuery), 0&, VarPtr(aGUID(0)), VarPtr(oIUnknown)) = 0& Then
' interface supported/inherited
End If
Note. IUnknown will not be NOTHING on success. AddRef/Release taken care of since we have it in a VB variable
Insomnia is just a byproduct of, "It can't be done"
Re: AddressOf for Class Methods (and other VTable exploration)?
@Elroy. Just a follow up.
The sample code you posted in #19 has 1 major flaw: crash potential
1. In your class, simply append dummy PUBLIC sub: Public Sub HouseOfCardsTumbleDown()
2. Now run your test project
3. When you get to the first private function, the msgbox shows: 5 + 10 = 88
Huh? PC can no longer add? Nope. Already on the road to a crash and possibly stack corrupted at this point. If you continue on with the project you will crash.
Reason and I hinted at it in post #6, but not completely because as I stated, haven't messed with it in quite awhile. Public methods are always listed first in the VTable. So, since your entire class is private methods, except the public variables, and by adding a Public method to the class, the private method ordinals get shifted by 1.
I think a more reliable formula maybe for private methods: Ordinal = position in class (among private methods) + Count(all public methods).
To fix the problem by adding that public sub (which could be added anywhere in the class), you would change your offsets like so:
Code:
Const Test1Offset As Long = Var1OffsetGet + 2& + 1 ' + 1 public sub
Const Test2Offset As Long = Var1OffsetGet + 3& + 1 ' + 1 public sub
Const Test3Offset As Long = Var1OffsetGet + 4& + 1 ' + 1 public sub
Const Test4Offset As Long = Var1OffsetGet + 5& + 1 ' + 1 public sub
Came across this problem elsewhere and remembered this thread. So I thought I'd add to it to highlight a problem you hadn't counted on
Last edited by LaVolpe; Feb 7th, 2018 at 10:26 PM.
Insomnia is just a byproduct of, "It can't be done"
Re: AddressOf for Class Methods (and other VTable exploration)?
@LaVolpe: Thanks for the pointer. As soon as I get a bit of time, I'll get that patched up with an appropriate note. I'll put a short note on that post #19 now.
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.
Re: AddressOf for Class Methods (and other VTable exploration)?
To be honest, from vba I'm interested to the first part of the question only, i.e., how to get the address of a class method, and still it is not clear to me. Assume I've a class (a functor) with a default function like
function f(x as Double) as double
....
end function
I need its address to be able to call it back from a C routine. A routine to which I will pass the object's address also (my guess is with VarPtr(obj)), and that
will call the function back (still my guess) as f(obj, x) to get the calculated function. How to do it?
Ironically, I can do it by defining a vb module function mimicking the c code like
Function callfunctor(f As iFunctor, x As Double) As Double
callfunctor = f(x)
End Function
and pass the AddressOf callfunctor. This works in vba, and so will work also its call from c.
But I don't like this extra indirection and the lack of generality.
Re: AddressOf for Class Methods (and other VTable exploration)?
Originally Posted by mnar53
Assume I've a class (a functor) with a default function like
function f(x as Double) as double
....
end function
I need its address to be able to call it back from a C routine.
Why does this function f(x as Double) has to sit in a Class?
If you place it in a (VBA)-Module, then you can pass it to your C-Dll directly without problems
(by using AddressOf) - perhaps using a little (VBA-defined) Indirection-HelperFunction like this:
Code:
Public Function GetFuncPtr(AddrOf As Long) As Long
GetFuncPtr = AddrOf
End Function
Re: AddressOf for Class Methods (and other VTable exploration)?
I'll jump in here too, and show some of my continuing ignorance.
I feel that I could possibly get the address of a class method (Sub or Function) with a bit of work. However, it seems that there are two additional problems:
1) When you do that, you're not necessarily guaranteed that the object will stay instantiated. It was probably instantiated when you got the address, because I wouldn't know another way to do it without using ObjPtr, and ObjPtr will be zero unless it's instantiated. But again, there's no guarantee that it'll stay instantiated. And, if it's not instantiated, I've got no idea where local (possibly even Static) and/or module level variables would be created. It feels like crash-time to me.
2) And this may be even more important. I'm not totally on-top of this, but I thought the calling convention for methods of objects was different than the calling convention for standard BAS methods. If that's the case, nothing is going to work correctly.
And, as Olaf says, if it's a callback procedure, it probably shouldn't be in a class anyway. Are you trying to possibly have several instantiations of a class, each with its own callback procedure? To my eyes, this would still be done better in a BAS module, and possibly let Collections take care of different variables for the callback procedures. Personally, I always use ComCtl32 to do my subclassing. If what I need to store wouldn't fit into dwRefData, I'd use a Collection. And callbacks, hooks, enumerations typically have a similar variable to dwRefData.
Good Luck,
Elroy
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.
@Elroy: you have to addref before passing your object (ByVal) to an outside DLL.
If the DLL properly manages the reference count you don't have to worry about being released early.
Code:
Private Declare Function SetCallbackObj lib "MyDLL" (ByVal MyObj As Object) As Long
Last edited by DEXWERX; Apr 2nd, 2018 at 12:49 PM.
Re: AddressOf for Class Methods (and other VTable exploration)?
Originally Posted by Schmidt
Why does this function f(x as Double) has to sit in a Class?
If you place it in a (VBA)-Module, then you can pass it to your C-Dll directly without problems
(by using AddressOf) - perhaps using a little (VBA-defined) Indirection-HelperFunction like this:
Code:
Public Function GetFuncPtr(AddrOf As Long) As Long
GetFuncPtr = AddrOf
End Function
Because a functor allows, among the other things, a parameters initialization before any function call is made.
The use of AddressOf on a function was implicit in my last sentence.
Re: AddressOf for Class Methods (and other VTable exploration)?
@Elroy,
if it is not possible to split the problem in two parts -- first get the address of a method, second call it (having of course learned its calling convention) -- then i'm back to CallByName.
Re: AddressOf for Class Methods (and other VTable exploration)?
Well, since we're all on the topic here, I'm also trying to replace AddressOf. Directly copied everything from a control where Paul Caton's self-callback is working, but in my project I just get a "Callback address not found" message.
Is there anything I have to do before calling scb_SetCallbackAddr? The ordinal and param count are definitely correct. Does something have to be initialized by some of the subclass code being used elsewhere? Only thing I can think of really. Copied in the full defs and it compiles without error, so wouldn't seem to be missing anything. It's a lot of complicated code it would take me months to understand.
The control where's it's working the usage is simply, If m_Adr = 0& Then m_Adr = scb_SetCallbackAddr(3, 1)
SendMessage LVM_SORTITEMS, ByVal m_Adr
(yes, I'm looking for the very last function in the control which has 3 args)
So I did the same thing, but get the error.
Re: AddressOf for Class Methods (and other VTable exploration)?
Just to clarify what i got till now, module .bas:
Code:
Private Declare PtrSafe Sub Hi Lib "mathlib" (ByVal f As LongPtr)
Private Declare PtrSafe Function functr Lib "mathlib" (c, x As Double, Optional y As Double = -999999, _
Optional z As Double = -999999, Optional v) As Double
Private Sub auto_open()
Hi AddressOf callfunctor
End Sub
Function callfunctor(f, x As Double, Optional y As Double = -999999, Optional z As Double = -999999) As Double
Dim i As iFunctor
Set i = f
callfunctor = i(x, y, z) ' calls Functor's default method
End Function
' functor example
Function fun1(x As Double, p) As Double
fun1 = p(1) * x + p(2)
End Function
sub testit
Dim p, f As iFunctor
p = Array(10, 20) ' Functor is a function creating a Functor, and
Set c = Functor(AddressOf fun1, p) ' initializing it with parameters p
Debug.Print functr(c, 4) ' prints 60
debug.print functr(c, 5) ' prints 70
......
end sub
I omit details about iFunctor, because they are trivial. In the given example the functor is initialized with the address of fun1, and yet again the
default method will call fun1 by means of another callback coded in C. But at this point the default method might be something coded directly in
the class.
The important point is that the C function functr works, and it can be repeatedly used in C in jobs like finding a root, integrating the function,
ordinary differential equation etc., in C coded routines (probably defining a macro (say F) to hide obj, and having the function call coded more
naturally as F(x) ).
Of course the same could be done using directly fun1 as callback, but then i've to pass directly the parameters to each routine.
I think the reached information hiding may be worth it. Anyway, the next logical step might be to have only one C routine, adapting
to accept either a function or a functor
Re: AddressOf for Class Methods (and other VTable exploration)?
Here are some routines that addresses the question "Is there an AddressOf for object modules?" These functions are heavily based on Paul Caton's code here and LaVolpe's code here. These have not been tested in VBA, so use at your own risk.
Code:
Option Explicit
Private Declare Function GetMem1 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Byte) As Long
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Long) As Long
Private Declare Function IsBadCodePtr Lib "kernel32.dll" (ByVal lpfn As Long) As Long
'Returns the procedure address of the first Public member (in declared order)
'or the first Private/Friend member (in declared order) if there's no Public member
'Public variables (which actually are Public Properties) are skipped
Public Function AddressOfFirstProc(ByVal pObj As Long) As Long
Const NATIVE_CODE As Byte = &HE9, PCODE As Byte = &H33
Dim JumpOpcode As Byte, pEntry As Long, pVTable As Long
GetMem4 pObj, pVTable
Do: GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Select Case JumpOpcode
Case NATIVE_CODE, PCODE
AddressOfFirstProc = pEntry
Exit Function
End Select
pVTable = UAdd(pVTable, 4&)
Else
Exit Function
End If
Loop
End Function
'Returns the procedure address of the last Private/Friend member (in declared order)
'or the last Public member (in declared order) if there's no Private/Friend member
'Public variables (which actually are Public Properties) are skipped
Public Function AddressOfLastProc(ByVal pObj As Long) As Long
Dim JumpOpcode As Byte, JumpOpcode1st As Byte
Dim VTOffset As Long, pEntry As Long, pVTable As Long
GetMem4 pObj, pVTable 'Get address of the object's VTable
VTOffset = OffsetOfFirstProc(pObj)
If VTOffset Then
pVTable = UAdd(pVTable, VTOffset) 'Bump to the user part of the object's VTable [Typically, &H1C for Classes, &H6F8 for Forms & &H7A4 for UCs]
GetMem4 pVTable, pEntry 'Read the address of the first entry point
GetMem1 pEntry, JumpOpcode1st 'Read the jump opcode at the first entry point [&H33 for pseudo code, &HE9 for native code]
AddressOfLastProc = pEntry
Else
Exit Function
End If
Do: pVTable = UAdd(pVTable, 4&) 'Next entry address
GetMem4 pVTable, pEntry 'Read the address of the entry point
If IsBadCodePtr(pEntry) = 0& Then 'Is the entry point address valid code?
GetMem1 pEntry, JumpOpcode 'Read the jump opcode at the entry point
Else
Exit Function
End If
If JumpOpcode = JumpOpcode1st Then 'Does the jump opcode match that of the first VTable entry?
AddressOfLastProc = pEntry
Else
Exit Function
End If
Loop
End Function
'Returns the procedure address of the specified Public or Private member
'The Ordinal argument is the 1-based order of the member. For example:
'The 1st Public member (or Private member if there are no Public members)
'in the declared source code order has an ordinal of 1. The 2nd Public member
'(or Private member if there are no Public members) has an ordinal of 2. And so on...
'Public members are counted first before Private/Friend members. If member(s) have
'been added/removed/rearranged, recalculate the Ordinal to make sure it is correct.
Public Function AddressOfMember(ByVal pObj As Long, ByVal Ordinal As Long) As Long
Const NATIVE_CODE As Byte = &HE9, PCODE As Byte = &H33
Dim JumpOpcode As Byte, Index As Long, pEntry As Long, pVTable As Long
If Ordinal > 0& Then GetMem4 pObj, pVTable Else Exit Function
Do: GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Select Case JumpOpcode
Case NATIVE_CODE, PCODE
Index = Index + 1&
If Index = Ordinal Then
AddressOfMember = pEntry
Exit Function
End If
End Select
pVTable = UAdd(pVTable, 4&)
Else
Exit Function
End If
Loop
End Function
'Returns the VTable offset (in Bytes) of the first Public member (in declared order)
'or the first Private/Friend member (in declared order) if there's no Public member
'Public variables (which actually are Public Properties) are skipped
Public Function OffsetOfFirstProc(ByVal pObj As Long) As Long
Const NATIVE_CODE As Byte = &HE9, PCODE As Byte = &H33
Dim JumpOpcode As Byte, pEntry As Long, pStart As Long, pVTable As Long
GetMem4 pObj, pStart
pVTable = pStart
Do: GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Select Case JumpOpcode
Case NATIVE_CODE, PCODE
OffsetOfFirstProc = UAdd(pVTable, -pStart)
Exit Function
End Select
pVTable = UAdd(pVTable, 4&)
Else
Exit Function
End If
Loop
End Function
'Returns the VTable offset (in Bytes) of the last Private/Friend member (in declared order)
'or the last Public member (in declared order) if there's no Private/Friend member
'Public variables (which actually are Public Properties) are skipped
Public Function OffsetOfLastProc(ByVal pObj As Long) As Long
Dim JumpOpcode As Byte, JumpOpcode1st As Byte, VTOffset As Long
Dim pEntry As Long, pStart As Long, pVTable As Long
GetMem4 pObj, pStart
VTOffset = OffsetOfFirstProc(pObj)
If VTOffset Then
pVTable = UAdd(pStart, VTOffset)
GetMem4 pVTable, pEntry
GetMem1 pEntry, JumpOpcode1st
OffsetOfLastProc = VTOffset
Else
Exit Function
End If
Do: pVTable = UAdd(pVTable, 4&)
GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Else
Exit Function
End If
If JumpOpcode = JumpOpcode1st Then
OffsetOfLastProc = UAdd(pVTable, -pStart)
Else
Exit Function
End If
Loop
End Function
Private Function UAdd(ByVal Base As Long, ByVal Offset As Long) As Long
Const SIGN_BIT = &H80000000
UAdd = (Base Xor SIGN_BIT) + Offset Xor SIGN_BIT 'Unsigned pointer arithmetic
End Function
Re: AddressOf for Class Methods (and other VTable exploration)?
Visual Studio? or another compiler?
Like i said if you know ATL/COM it's not hard to do the interop, and call the default member of a VB Object.
just mind your reference count
It would also be safer using an interface definition, and completely safe if you use a type library.
A typelib however would not be necessary, to get things working.
So not hard, but definitely not trivial, especially if you don't know COM.
If you ignore COM you can do something like the following though.
ICallback.cls
Code:
Option Compare Database
Option Explicit
' This is an interface definition, so leave this class and function empty.
Public Function Callback(ByVal A As Double, ByVal B As Double) As Double
End Function
CAdder.cls
Code:
Option Explicit
Implements ICallback
Private Function ICallback_Callback(ByVal A As Double, ByVal B As Double) As Double
ICallback_Callback = A + B
End Function
Whatever.bas
Code:
Declare Function MyDLLProc Lib "MyDLL" (ByVal MyObj As ICallback, Byval A as Double, ByVal B As Double, ByRef C As Double) As Long
You DLL Code
Code:
typedef HRESULT (__stdcall *Callback)(__int64 **pThis, double a, double b, double* retval);
STDMETHODIMP MyDLLProc(__int64 **obj, double a, double b, double * c)
{
Callback cb = (Callback) obj[0][7]; // first member after IDispatch
return cb(obj,a,b,c);
}
Last edited by DEXWERX; Apr 5th, 2018 at 05:35 PM.
Re: AddressOf for Class Methods (and other VTable exploration)?
@DEXWERX,
the last suggestion (going through pure interface) seems interesting, surely i'll give it a try, even though every data access will have
to be done using interface let/get methods, right? I guess the VTable is unique for every class implementing the interface, and that
the retrieved address is unique for all objects of that class, i.e. it can be retrieved in advance once for all.
I wonder if it is possible to pass in the real call a pointer to the concrete object, and then access some public fields of it directly from C.
@Victor Bravo,
I understand that this thread is labeled "Visual Basic 6 and earlier", but my current environment is VBA 64 bit. So I don't even
have GetMem1 and GetMem4, and all pointer arithmetic should be rewritten with LongLong. A little bit too much for me.
Re: AddressOf for Class Methods (and other VTable exploration)?
Originally Posted by mnar53
@DEXWERX,
the last suggestion (going through pure interface) seems interesting, surely i'll give it a try, even though every data access will have
to be done using interface let/get methods, right? I guess the VTable is unique for every class implementing the interface, and that
the retrieved address is unique for all objects of that class, i.e. it can be retrieved in advance once for all.
I wonder if it is possible to pass in the real call a pointer to the concrete object, and then access some public fields of it directly from C.
Not completely sure what you're saying, but an interface guarantees the offsets of the methods in the vtable.
Note the first 4 bytes of a COM object is a pointer that points to it's vtable.
The first 3 entries of every Object is occupied by IUnknown. All VB's Objects also implement IDispatch, so that's where the magic 7 came from. 0,1,2 for IUnknown; 3,4,5,6 For IDispatch, 7 is your first public method on the interface, and it's ordered by however they are defined in the .Cls module, with public members/methods arranged first.
Also you need to know that the reference to your object is only good for the life of the call to MyDLLProc().
If you need it longer, you have to call AddRef()/Release() appropriately.
Originally Posted by mnar53
@Victor Bravo,
I understand that this thread is labeled "Visual Basic 6 and earlier", but my current environment is VBA 64 bit. So I don't even
have GetMem1 and GetMem4, and all pointer arithmetic should be rewritten with LongLong. A little bit too much for me.
You do Have VarPrt and LongPtr and you can replace getmem with a PtrSafe Declare of CopyMemory.
Last edited by DEXWERX; Apr 6th, 2018 at 06:28 AM.
This discussion is a bit over my skillset, but I will ask my question anyway and hopefully get a response;
I created a VB6 service that runs without a form - great!
now I want to add a Winsock TCP server, but all of the online classes I could find for it ONLY work with a form for the callback.
How can I get this Winsock function:
WSAAsyncSelect Lib "Winsock.dll" (ByVal s As Integer, ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
To return to a Function I have in a .bas module rather than to the .hwnd of a form?
I searched and searched and cannot find a way.
How can I get this Winsock function:
WSAAsyncSelect Lib "Winsock.dll" (ByVal s As Integer, ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
To return to a Function I have in a .bas module rather than to the .hwnd of a form?
This question appears to be the same one in your other thread. Suggest you stay with that other thread. Posting same question in multiple thread always leads to duplicate answers, unresolved questions, and confusion when pertinent info exists in one thread and not both.
It does appear a valid answer was provided in your other thread. Welcome to the forums
Insomnia is just a byproduct of, "It can't be done"
Re: [RESOLVED] AddressOf for Class Methods (and other VTable exploration)?
Hi Levis,
Yeah, welcome to the forums. We're delighted to have you. However, please try and be careful about hijacking another person's thread.
I do wish you the best in finding a solid answer to your question.
Best Regards,
Elroy
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.
Re: AddressOf for Class Methods (and other VTable exploration)?
Originally Posted by Victor Bravo VI
Here are some routines that addresses the question "Is there an AddressOf for object modules?" These functions are heavily based on Paul Caton's code here and LaVolpe's code here. These have not been tested in VBA, so use at your own risk.
Code:
Option Explicit
Private Declare Function GetMem1 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Byte) As Long
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Long) As Long
Private Declare Function IsBadCodePtr Lib "kernel32.dll" (ByVal lpfn As Long) As Long
'Returns the procedure address of the first Public member (in declared order)
'or the first Private/Friend member (in declared order) if there's no Public member
'Public variables (which actually are Public Properties) are skipped
Public Function AddressOfFirstProc(ByVal pObj As Long) As Long
Const NATIVE_CODE As Byte = &HE9, PCODE As Byte = &H33
Dim JumpOpcode As Byte, pEntry As Long, pVTable As Long
GetMem4 pObj, pVTable
Do: GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Select Case JumpOpcode
Case NATIVE_CODE, PCODE
AddressOfFirstProc = pEntry
Exit Function
End Select
pVTable = UAdd(pVTable, 4&)
Else
Exit Function
End If
Loop
End Function
'Returns the procedure address of the last Private/Friend member (in declared order)
'or the last Public member (in declared order) if there's no Private/Friend member
'Public variables (which actually are Public Properties) are skipped
Public Function AddressOfLastProc(ByVal pObj As Long) As Long
Dim JumpOpcode As Byte, JumpOpcode1st As Byte
Dim VTOffset As Long, pEntry As Long, pVTable As Long
GetMem4 pObj, pVTable 'Get address of the object's VTable
VTOffset = OffsetOfFirstProc(pObj)
If VTOffset Then
pVTable = UAdd(pVTable, VTOffset) 'Bump to the user part of the object's VTable [Typically, &H1C for Classes, &H6F8 for Forms & &H7A4 for UCs]
GetMem4 pVTable, pEntry 'Read the address of the first entry point
GetMem1 pEntry, JumpOpcode1st 'Read the jump opcode at the first entry point [&H33 for pseudo code, &HE9 for native code]
AddressOfLastProc = pEntry
Else
Exit Function
End If
Do: pVTable = UAdd(pVTable, 4&) 'Next entry address
GetMem4 pVTable, pEntry 'Read the address of the entry point
If IsBadCodePtr(pEntry) = 0& Then 'Is the entry point address valid code?
GetMem1 pEntry, JumpOpcode 'Read the jump opcode at the entry point
Else
Exit Function
End If
If JumpOpcode = JumpOpcode1st Then 'Does the jump opcode match that of the first VTable entry?
AddressOfLastProc = pEntry
Else
Exit Function
End If
Loop
End Function
'Returns the procedure address of the specified Public or Private member
'The Ordinal argument is the 1-based order of the member. For example:
'The 1st Public member (or Private member if there are no Public members)
'in the declared source code order has an ordinal of 1. The 2nd Public member
'(or Private member if there are no Public members) has an ordinal of 2. And so on...
'Public members are counted first before Private/Friend members. If member(s) have
'been added/removed/rearranged, recalculate the Ordinal to make sure it is correct.
Public Function AddressOfMember(ByVal pObj As Long, ByVal Ordinal As Long) As Long
Const NATIVE_CODE As Byte = &HE9, PCODE As Byte = &H33
Dim JumpOpcode As Byte, Index As Long, pEntry As Long, pVTable As Long
If Ordinal > 0& Then GetMem4 pObj, pVTable Else Exit Function
Do: GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Select Case JumpOpcode
Case NATIVE_CODE, PCODE
Index = Index + 1&
If Index = Ordinal Then
AddressOfMember = pEntry
Exit Function
End If
End Select
pVTable = UAdd(pVTable, 4&)
Else
Exit Function
End If
Loop
End Function
'Returns the VTable offset (in Bytes) of the first Public member (in declared order)
'or the first Private/Friend member (in declared order) if there's no Public member
'Public variables (which actually are Public Properties) are skipped
Public Function OffsetOfFirstProc(ByVal pObj As Long) As Long
Const NATIVE_CODE As Byte = &HE9, PCODE As Byte = &H33
Dim JumpOpcode As Byte, pEntry As Long, pStart As Long, pVTable As Long
GetMem4 pObj, pStart
pVTable = pStart
Do: GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Select Case JumpOpcode
Case NATIVE_CODE, PCODE
OffsetOfFirstProc = UAdd(pVTable, -pStart)
Exit Function
End Select
pVTable = UAdd(pVTable, 4&)
Else
Exit Function
End If
Loop
End Function
'Returns the VTable offset (in Bytes) of the last Private/Friend member (in declared order)
'or the last Public member (in declared order) if there's no Private/Friend member
'Public variables (which actually are Public Properties) are skipped
Public Function OffsetOfLastProc(ByVal pObj As Long) As Long
Dim JumpOpcode As Byte, JumpOpcode1st As Byte, VTOffset As Long
Dim pEntry As Long, pStart As Long, pVTable As Long
GetMem4 pObj, pStart
VTOffset = OffsetOfFirstProc(pObj)
If VTOffset Then
pVTable = UAdd(pStart, VTOffset)
GetMem4 pVTable, pEntry
GetMem1 pEntry, JumpOpcode1st
OffsetOfLastProc = VTOffset
Else
Exit Function
End If
Do: pVTable = UAdd(pVTable, 4&)
GetMem4 pVTable, pEntry
If IsBadCodePtr(pEntry) = 0& Then
GetMem1 pEntry, JumpOpcode
Else
Exit Function
End If
If JumpOpcode = JumpOpcode1st Then
OffsetOfLastProc = UAdd(pVTable, -pStart)
Else
Exit Function
End If
Loop
End Function
Private Function UAdd(ByVal Base As Long, ByVal Offset As Long) As Long
Const SIGN_BIT = &H80000000
UAdd = (Base Xor SIGN_BIT) + Offset Xor SIGN_BIT 'Unsigned pointer arithmetic
End Function
This code doesn't work in VBA7 as the msvbvm60.dll is not part of office . I guess I could try replacing GetMem1 and GetMem4 with the corresponding CopyMemory aliases but I still have a problem because the above code was designed to work in 32bit memory layout whereas I want to make this work in 64bit vba.