[RESOLVED] Is Object Pointer Valid?

[Elroy]

Ok, here's an unusual one. Let's say I'm saving an object pointer (probably with ObjPtr), and then later I'd like to use it to re-create a reference variable (probably with vbaObjSetAddref).

However, before I use vbaObjSetAddref, I'd like to figure out if the object (pointed to with my saved ObjPtr save) is still instantiated.

I'm at a bit of a loss as to how to do that. I'll be searching while waiting on any tips, but anything would be appreciated.

[Elroy]

Hmmm, well, I found a list of exposed functions in Msvbvm60.dll, and there's one named "__vbaObjIs" and another named "__vbaObjVar". Based on the names, both sound promising. However, I searched for both and can't find a single instance of where they've actually been used. So, I'd have no idea how to declare the API, nor how to actually use them.

[Elroy]

Basically, here's an outline of my problem. Just start a new project, add a module, point the "startup" to Sub Main, then add the following code to the Module1:

Option Explicit
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long

Sub Main()
    Debug.Print "---------------"

    Load Form1

    Dim p As Long

    p = ObjPtr(Form1)

    Unload Form1
    Set Form1 = Nothing

    ' Form is now unloaded with COM terminated.




    ' But, if I now try the following, it'll crash.
    ' How do I check whether p is any good????

    Dim frm As VB.Form
    Call vbaObjSetAddref(frm, ByVal p)




    Stop
End Sub

[Elroy]

Hmmm, I found this thread where wqweto says it can't be done.

I'm not gonna give up just yet though. The Trick, you out there?

[dilettante]

It's a pointer, either valid or not.

Even if there was some sort of "is where this points to an object instance" test... what if by then it points to some other object now?

Worthless.

Perhaps if you described what you want to do a better alternative might present itself?

[Elroy]

what if by then it points to some other object now?

Yes, I actually thought of that when I was writing the post. However, if it was valid, I could create a reference and check its TypeName and even other properties. Just knowing whether or not a pointer points toward a valid object would be of use to me. I could set a global variable and do it. I was just hoping there was a cleaner way.

And, for the life of me, I can't find anything that shows how to use either vbaObjIs or vbaObjVar, or whether the object pointer is what they'd want.

[Niya]

Basically, here's an outline of my problem. Just start a new project, add a module, point the "startup" to Sub Main, then add the following code to the Module1:

Option Explicit
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long

Sub Main()
    Debug.Print "---------------"

    Load Form1

    Dim p As Long

    p = ObjPtr(Form1)

    Unload Form1
    Set Form1 = Nothing

    ' Form is now unloaded with COM terminated.




    ' But, if I now try the following, it'll crash.
    ' How do I check whether p is any good????

    Dim frm As VB.Form
    Call vbaObjSetAddref(frm, ByVal p)




    Stop
End Sub

I think you have the right approach in principle. Looking up the structure and layout of a COM object in memory, I see that it's not that sophisticated. Raymond Chen explains here. I'm thinking that you could obtain the function pointers to AddRef and Release and call them through something that will not crash VB6, perhaps DispFuncCall can work. According to MS docs, Release returns the number of references a COM object has remaining. So you can call AddRef then call Release and if Release gives you a non-zero value, then you know the object is alive. If AddRef fails, then you know the object is dead. That's my theory anyway.

[The trick]

It's impossible to know if an object reference is still active if you didn't call AddRef. So if you use weak references you should notify holder when the object is destroyed. Why do you need such weak references?

[The trick]

I'm thinking that you could obtain the function pointers to AddRef and Release and call them through something that will not crash VB6, perhaps DispFuncCall can work. According to MS docs, Release returns the number of references a COM object has remaining. So you can call AddRef then call Release and if Release gives you a non-zero value, then you know the object is alive. If AddRef fails, then you know the object is dead. That's my theory anyway

There is __vbaObjAddref/__vbaObjSet pair.

[Niya]

There is __vbaObjAddref/__vbaObjSet pair.

According to Elroy, calling these crashes the application if the object behind the pointer is dead. And it doesn't crash in the clean way where you could trap the error with On Error Goto. I'm speculating that if you use something like DispCallFunc to call the pointers for these methods then it wouldn't crash the application. You could then check return values and whatnot and react accordingly.

[The trick]

Niya, __vbaObjAddref is used to call AddRef, __vbaObjSet/__vbaObjSetAddRef is used to call Release (if you specify Nothing). There is no need to call DispCallFunc here.

[Niya]

Well perhaps Elroy should explain because I was looking at what he showed here, specifically:-

    ' But, if I now try the following, it'll crash.
    ' How do I check whether p is any good????

    Dim frm As VB.Form
    Call vbaObjSetAddref(frm, ByVal p)

According to his comment it crashes when he calls it using a pointer to an object that was destroyed. I'm probably missing something here.

[Elroy]

Why I was wanting it:

I'm doing some subclassing and I'm storing an ObjPtr to another object (not the subclassed one) in the ComCtl32 dwRefData variable. So, when I'm in the subclass callback proc, I just wanted/needed to know if the dwRefData (as an object pointer) was still any good.

Truth be told, I worked it all out another way, but I was still curious. If it can't be (cleanly) done, I'll forget it.

p.s. I just love using that dwRefData storage, as it keeps my subclassing very clean (with no need for static or module variables) which means I can simultaneously use it many times without worrying about anything. In fact, in all of my subclassing, I don't use a single static or module_level variable.

[Elroy]

Well perhaps Elroy should explain because I was looking at what he showed here, specifically:-

    ' But, if I now try the following, it'll crash.
    ' How do I check whether p is any good????

    Dim frm As VB.Form
    Call vbaObjSetAddref(frm, ByVal p)

According to his comment it crashes when he calls it using a pointer to an object that was destroyed. I'm probably missing something here.

Ohhh, it crashes hard. Error trapping wouldn't save me.

[Niya]

I had some time and I was of a mood so decided to play with this for a bit. I can only conclude in the end that __vbaObjSetAddref is not hardened against invalid object references. You simply must make sure it never gets an invalid reference. I tried to work around it by using DispCallFunc hoping it would have just returned a failure value instead of crashing the whole process but it didn't. Here is the test code.

This is the module I wrote:-

Private Declare Function LoadLibraryW Lib "kernel32.dll" (ByVal lpLibFileName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function DispCallFunc Lib "OleAut32.dll" ( _
    ByVal pvInstance As Long, _
    ByVal oVft As Long, _
    ByVal cc As Long, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByVal prgvt As Long, _
    ByVal prgpvarg As Long, _
    ByVal pvargResult As Long _
    ) As Long

'********************************************************************************************************************************************
'This function was lifted from another project which can be found at the
'VBForums VB6 CodeBank here:-
'https://www.vbforums.com/showthread.php?893448-Executing-assembly-language-functions-in-VB6-using-DispCallFunc&p=5537069#post5537069
'********************************************************************************************************************************************
Public Function CallFunctionPointer(ByVal funcPtr As Long, ByVal returnType As VbVarType, ParamArray args() As Variant) As Variant
    'Use this function to call any function pointer with any amount
    'and types of parameters and any return value
    '****************************************************************
    
    Dim DispCallFuncResult As Long
    Dim i As Long
    Dim params() As Long
    Dim paramTypes() As Integer
    Dim args2() As Variant
    
    'VERY IMPORTANT
    '*******************************************************
    'params(i) = VarPtr(args(i))
    'The above assignment in the loop doesn't work correctly because it's working
    'directly on the ParamArray array. There are two ways to fix it.
    'You could do this:-
    'params(i) = VarPtr(CVar(args(i)))
    'or you could copy the ParamArray arguments to a local array of Variants
    'and loop on that instead. I chose this second approach.
    'Without this correction, wrong values can get passed as arguments to the function
    'we are going to call with DispCallFunc if those arguments were passed in using variables
    'when CallFunctionPointer was caled.
    'I have no idea why this happens. All I know this fixes it.
    '*******************************************************
    'UPDATE:-
    '*******************************************************
    'Credit to Olaf Schmidt for providing and answer to this.
    'It turns out that the bug was caused by the VT_BYREF flag
    'being set on Variants when a variable is passed as an argument in the
    'ParamArray parameter
    '*******************************************************
     args2 = args
    
    ReDim params(0 To UBound(args2))
    ReDim paramTypes(0 To UBound(args2))
        
    For i = 0 To UBound(args2)
        params(i) = VarPtr(args2(i))
        paramTypes(i) = VarType(args2(i))
    Next
    
    DispCallFuncResult = DispCallFunc(0, funcPtr, CLng(4), CInt(returnType), UBound(args2) + 1, VarPtr(paramTypes(0)), VarPtr(params(0)), VarPtr(CallFunctionPointer))
    
    If DispCallFuncResult <> 0 Then Err.Raise 12000, , "Function pointer call failed"
End Function

Public Function IsObjPtrValid(ByVal objPtr As Long) As Boolean

    Dim obj As Object
    Dim addRefFunc As Long
    Dim hLib As Long
    
    hLib = LoadLibraryW(StrPtr("msvbvm60"))
    
    If hLib = 0 Then Err.Raise vbObjectError + 40777, , "Failed to load msvbm60"
    
    addRefFunc = GetProcAddress(hLib, "__vbaObjSetAddref")
        
    If addRefFunc = 0 Then Err.Raise vbObjectError + 40778, , "Failed to find AddRef function"
        
    CallFunctionPointer addRefFunc, vbNull, VarPtr(obj), objPtr
    
    IsObjPtrValid = Not (obj Is Nothing)
End Function

And this is the test code:-

Private Sub Form_Load()
    Dim c As Class1
    Dim p As Long
    
    Set c = New Class1
       
    p = objPtr(c)
    
    'If this is uncommented, the process would crash
    'when testing the pointer
    '--------------------------
    'Set c = Nothing
    
    Debug.Print IsObjPtrValid(p)
End Sub

If the object variable c is set to Nothing, the process would crash when trying to validate the pointer. At this point, I'm thinking this is not worth the effort trying to make this work. It would probably be easier just to avoid having pointers to dead objects in the first place.

[The trick]

I'm doing some subclassing and I'm storing an ObjPtr to another object (not the subclassed one) in the ComCtl32 dwRefData variable.

Instead of assigning an ObjPtr value to dwRefData just use __vbaObjSetAddref.

Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" _
                         Alias "__vbaObjSetAddref" ( _
                         ByRef dstObject As Any, _
                         ByRef srcObjPtr As Any) As Long

Private Sub Form_Load()
    Dim dwRef   As Long
    
    ' // Add reference counter and put reference to dwRef
    vbaObjSetAddref dwRef, ByVal ObjPtr(Me)
    
    ' // ....
    
    ' // Release reference counter and release reference
    vbaObjSetAddref dwRef, ByVal 0&
    
End Sub

[Elroy]

Instead of assigning an ObjPtr value to dwRefData just use __vbaObjSetAddref.

Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" _
                         Alias "__vbaObjSetAddref" ( _
                         ByRef dstObject As Any, _
                         ByRef srcObjPtr As Any) As Long

Private Sub Form_Load()
    Dim dwRef   As Long
    
    ' // Add reference counter and put reference to dwRef
    vbaObjSetAddref dwRef, ByVal ObjPtr(Me)
    
    ' // ....
    
    ' // Release reference counter and release reference
    vbaObjSetAddref dwRef, ByVal 0&
    
End Sub

@The Trick: Brilliant as usual. I'm actually wanting this for some subclassing, but this concept will still totally work. I'll just increment the reference counter even though I don't have a variable. And then, when I undo my subclassing, decrement that reference counter. That'll make sure the object stays instantiated as long as I'm subclassing. I could even check the counter and, if it's 1, maybe I don't want to use it, but it's still a valid pointer. Absolutely perfect. And this has the advantage of knowing it's not some other object that re-used the address.

@Niya: Your idea looks good too. I'll hang onto your code and, if, for some reason I don't want to increment the reference counter, I'll play with it more. Thanks.

I think this one is resolved.