API CallBacks Using an Object's Procedure
Attributions: Huge thanks goes out to The Trick, Wqweto, Dz32, Fafalone, and LaVolpe. They all provided insights, inspiration, and code toward what you see in this thread.
Prerequisite: It's assumed you know what an API CallBack is. If not, you really don't have to worry about any of this.
A bit on nomenclature: I tend to use "method" and "procedure" synonymously. I also tend to use "properties" and "public variables" as somewhat synonymous. If I want to talk about "methods" and "properties" together, I'll use the term "members". I also tend to use "argument" and "parameter" as synonymous.
--------------------------
This has been done before, and this is just my version of it. Also, I've documented it extensively so that anyone who's interested should be able to "think through" everything I've done.
Just to say it, it's a lot of code for a sort of small thing. I mean, we can always put our CallBacks in BAS modules, and they work just fine. But this is something I've wanted for years, so that I can create object modules (Classes, Forms, UserControls, PropertyPages, & DataReports) that use CallBacks that are all wrapped into their respective code areas.
This can also be used for subclassing, but that's not what it is. If you think about it, all subclassing does is make a "CallBack" with everything that's coming through the message pump for any particular window.
Also, just to try and eliminate confusion, I'm talking about a specific VB6 project and it's associated source code (and those source code objects). I'm not talking about referenced DLLs (ActiveX or otherwise). Some of this code could be used for those things, but that's not what this thread is about.
Downsides to the way I've done it:
- There's no IDE protection. But that's only a problem if you try to trace through the CallBack procedure and/or put breakpoints in it. Otherwise, everything should be fine regarding the rest of your code. Again, this isn't subclassing, but it could be used for subclassing. When used with subclassing, those other uses could provide IDE protection. That's up to the subclassing, and not these routines.
- I've limited the CallBack function to being a "Function" (no Subs, nor Properties), and it must have 1, 2, 3, or 4 arguments. Furthermore, those arguments must be either ByRef or 4-byte ByVal arguments. And the return must also be 4-bytes (preferably a Long). But this covers the vast majority of Microsoft API CallBacks.
- I haven't tested an object that has another object "Implemented". As soon as I get that tested, I'll report back on that one.
Upsides to the way I've done it:
- There's no modification to the actual code of the object. Basically, all of this is just a "wrapper" that turns a call for a standard BAS procedure into a call for a COM (object) procedure. But that's much easier said than done.
- It's (hopefully) extremely well documented so that anyone who wants to use it can see precisely what's going on.
- It works equally well when running in the IDE or compiled as either p-code or machine code.
- There's no special order in which the CallBack procedures need to appear in your code.
The challenges. There were many, but I'll go through them one-by-one, providing solutions for each as we go. And later on, I'll provide a few projects with complete examples that you could use to "mold" into your own uses and applications.
Challenge #1: Are we dealing with a VB6 object that has code, or some other kind of object?
In many of the procedures herein, an object is passed in. I didn't want to have any problems if someone tried to pass in a non-code object (such as a StdFont, StdPicture, or Collection object, etc., etc.). I also wanted to assure that the object was instantiated.
This problem is solved with the following function and API call: (Specific thanks to The Trick & Wqweto for this.)
Code:
Private Declare Function vbaCheckType Lib "msvbvm60" Alias "__vbaCheckType" (ByVal pObj As Any, ByRef pIID As Any) As Boolean
Public Function ObjectIsVb6ComCodeModule(ByRef o As IUnknown) As Boolean
' If it's an instantiated Class, Form, UC, PropPage, DataReport, returns TRUE, else FALSE.
If ObjPtr(o) = 0& Then Exit Function ' Make sure "something" is instantiated.
Dim aGUID(1&) As Currency ' Just to get 16 easily accessible bytes.
aGUID(0&) = 128347367577987.1845@ ' Const AreYouABasicInstance As String = "{0B6C9465-D082-11CF-8B4F-00A0C90F2704}"
aGUID(1&) = 29922525889064.5387@ ' turned into two numbers stuffed into our Currency array.
ObjectIsVb6ComCodeModule = vbaCheckType(o, aGUID(0)) ' Check and see if we are this "TYPE" (Class, Form, UC, PropPage, or DataRep).
End Function(Just to note, Private variables aren't in the vTable, and the compiler makes no distinction between Private or Friend procedures with respect to the vTable. Also, in terms of the vTable, there's no distinction between events and all other procedures. If you code up an event, it's in the vTable.)
So, our challenge #2 transforms into figuring out which address in the vTable is pointing toward our desired CallBack procedure. This basically breaks down into two parts: 1) getting the address of the vTable, and 2) getting an offset into the vTable for our CallBack procedure. Getting the address of any vTable is easy:
Code:
Dim pVtable As Long: GetMem4 ByVal ObjPtr(o), pVtable ' Get pointer to start of vTable.Code:
Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long
Private Declare Function GetMem2 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long
Private Declare Function GetMem1 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByRef lpString As Any) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByRef psz As Any, ByVal lSize As Long) As String
Public Function VtableOffsetForVb6ComMethod(ByVal o As Object, ByVal sMethodName As String, Optional ByRef lArgCount As Long) As Long
' Searches PUBLIC methods. It "could" find Private & Friend, but only in the IDE, not compiled.
' Does NOT search properties (i.e., Public variables or Get/Let/Set procedures).
' Returns an OFFSET address ready to be added to the vTable address.
' Optional bbArgCount return is a count of passed in arguments.
' ByRef/ByVal doesn't matter, and TYPE doesn't matter.
' If it's a Function the return isn't counted.
'
' If it can't be found, ZERO is returned.
'
If Not ObjectIsVb6ComCodeModule(o) Then Exit Function ' Make sure we're dealing with a VB6 COM-code object.
sMethodName = UCase$(sMethodName)
'
Dim pVTbl As Long: GetMem4 ByVal ObjPtr(o), pVTbl ' Pointer to vTable.
Dim pObjInfo As Long: GetMem4 ByVal pVTbl - 4&, pObjInfo ' Pointer to tObjectInfo structure.
Dim pPubDesc As Long: GetMem4 ByVal pObjInfo + &H18&, pPubDesc ' tObjectInfo.aObject which points to tObject structure.
Dim pPrivDesc As Long: GetMem4 ByVal pObjInfo + &HC&, pPrivDesc ' tObjectInfo.lpPrivateObject which points to tPrivateObj structure.
'
If pPrivDesc = 0& Then Exit Function ' Just a double-check.
'
Dim lIndex As Long
Dim pName As Long
'
' Search the procedures within the module.
Dim pMethDesc As Long
Dim iMethOffset As Integer
Dim bbArgs As Byte
Dim lMethodsCnt As Long: GetMem2 ByVal pPubDesc + &H1C&, lMethodsCnt ' tObject.ProcCount value.
Dim pNames As Long: GetMem4 ByVal pPubDesc + &H20&, pNames ' tObject.aProcNamesArray which points to an array of name pointers.
Dim pMethodsPtr As Long: GetMem4 ByVal pPrivDesc + &H18&, pMethodsPtr ' tPrivateObj.lpFuncTypeInfo which points to an array of pointers.
'
' Loop through methods and see if we can find the one we want.
For lIndex = 0& To lMethodsCnt - 1&
GetMem4 ByVal pMethodsPtr + lIndex * 4&, pMethDesc ' From the array, getting a pointer to a method structure (tMethInfo).
If pMethDesc Then ' Not sure if this ever returns zero, maybe for "Private" methods?
GetMem2 ByVal pMethDesc + 2&, iMethOffset ' Out of tMethInfo structure.
GetMem1 ByVal pMethDesc, bbArgs ' First two bits of bbArgs are: set=3, get=1, let=2, method=0 (Sub or Fn).
If (bbArgs And CByte(3)) = CByte(0) Then ' Make sure it's a method.
If iMethOffset And 1 Then ' First bit, 1=Public.
GetMem4 ByVal pNames + lIndex * 4&, pName ' Dig pointer to method name from array of name pointers.
If sMethodName = UCase$(SysAllocStringByteLen(ByVal pName, lstrlenA(ByVal pName))) Then
VtableOffsetForVb6ComMethod = CLng(iMethOffset And &HFFFC) ' First two bits are something else (first is Public=1,Private=0).
Dim bbFlags As Byte: GetMem1 ByVal pMethDesc + 1&, bbFlags ' Both bbArgs & bbFlags out of tMethInfo structure.
bbFlags = bbFlags And CByte(1) ' 0 (no return), 1 (return).
lArgCount = CLng(bbArgs \ CByte(4) - bbFlags) ' Calculate arguments, excluding any return argument. Tested for vbGet, vbLet, vbSet, vbMethod (both Function & Sub).
Exit Function
End If
End If
End If
End If
Next
'
' Return zero if not found.
End FunctionNote that this only works for Public procedures. Below, I'll discuss an alternative approach that can be taken if we'd like to keep our CallBack procedures Private.