[RESOLVED] Making a new object reference from ObjPtr.

[Elroy]

Ok, I've got a need to make a new reference when all I've got is the ObjPtr.

I tried the following code, but it crashed the IDE, and I was just certain that it'd work.

I need sleep, but this should be easy.

Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long
'

Private Sub Form_Click()
    SomeProcedure ObjPtr(Me)
End Sub

Private Sub SomeProcedure(SomeObjPtrToForm As Long)
    Dim frm As VB.Form
    GetMem4 ByVal SomeObjPtrToForm, frm
    frm.SomeMethodThatExists
    GetMem4 ByVal 0&, frm
End Sub

Friend Sub SomeMethodThatExists()
    MsgBox "we got to here"
End Sub

Thanks In Advance,
Elroy


Edit1: Obviously, I used the approach of just "borrowing" a reference for a moment, without actually informing the instantiated object that there was another reference. But I still thought it would work.

[Elroy]

Ahhhh, I got it. The method has to be public, and I had some extra ByVals in there.

Here it is working:

Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long
'

Private Sub Form_Click()
    SomeProcedure ObjPtr(Me)
End Sub

Private Sub SomeProcedure(SomeObjPtrToForm As Long)
    Dim frm As VB.Form
    GetMem4 SomeObjPtrToForm, frm
    frm.SomeMethodThatExists
    GetMem4 0&, frm
End Sub

Public Sub SomeMethodThatExists()
    MsgBox "we got to here"
End Sub

[The trick]

Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" _
                         Alias "__vbaObjSetAddref" ( _
                         ByRef dstObject As Any, _
                         ByRef srcObjPtr As Any) As Long
                         
Private Sub Form_Load()
    Dim frm As Form1
    
    Set frm = COMObjectFromPtr(ObjPtr(Me))
    
    frm.Circle (100, 100), 100
    
End Sub

' //
' // Get COM object from pointer
' //
Public Function COMObjectFromPtr( _
                ByVal ptr As Long) As IUnknown
    vbaObjSetAddref COMObjectFromPtr, ByVal ptr
End Function

[DEXWERX]

you _have_ to do the AddRef to use new object references. Otherwise it can be unpredictable the lifetime of an object. Usually the runtime will Release it right before you try and use it. (crash)

This is part of what the Set keyword does. it's a combination of QI/AddRef.

The original code used by McKinney and Curland does it in multiple steps. You'll see a form of this pretty much everywhere on the net, but using CopyMem

    Dim TempObj as IUnknown
    GetMem4 SomeObjPtrToForm, TempObj  'No AddRef
    Set frm = TempObj      'QI + AddRef
    frm.SomeMethodThatExists
    GetMem4 0&, TempObj ' Zero TempObj

Of course using the built in runtime function as The trick has shown makes it even easier.

I use something closer to this.

Private Declare Function PtrObj Lib "msvbvm60" Alias "VarPtr" (ByVal Ptr As Long) As IUnknown

Set frm = PtrObj(SomeObjPtrToForm)

[Elroy]

Ahhh, thanks for the options.

@DEXWERX: Yeah, I'm quite aware that I was sort of "borrowing" an object reference that I must clean up myself. In fact, I've already got it all implemented, something like the following:

Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long
'

Private Sub Form_Click()
    SomeProcedure ObjPtr(Me)
End Sub

Private Sub SomeProcedure(SomeObjPtrToForm As Long)
    Dim frmBorrowed As VB.Form
    Dim frm As VB.Form
    GetMem4 SomeObjPtrToForm, frmBorrowed
    Set frm = frmBorrowed
    GetMem4 0&, frmBorrowed


    frm.SomeMethodThatExists


End Sub

Public Sub SomeMethodThatExists()
    MsgBox "we got to here"
End Sub

@Trick: I wasn't familiar with the vbaObjSetAddref call. That's a pretty neat trick. As usual, you truly amaze with your knowledge of the various calls into the bowels of various DLLs.

[Elroy]

Ok, I tested all three, and sadly, Dex, your way seems to cause a crash. Here's what I did:

Option Explicit
'
Private Declare Function GetMem4 Lib "MSVBVM60.DLL" (ByRef Source As Any, ByRef Dest As Any) As Long
Private Declare Function PtrObj Lib "msvbvm60" Alias "VarPtr" (ByVal ptr As Long) As IUnknown
Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
'

Private Sub Form_Click()
    SomeProcedure1 ObjPtr(Me)
    'SomeProcedure2 ObjPtr(Me) ' <------- This one causes crash.
    SomeProcedure3 ObjPtr(Me)
End Sub

Private Sub SomeProcedure1(SomeObjPtrToForm As Long)
    Dim frmBorrowed As VB.Form
    Dim frm As VB.Form
    GetMem4 SomeObjPtrToForm, frmBorrowed
    Set frm = frmBorrowed
    GetMem4 0&, frmBorrowed

    frm.SomeMethodThatExists
End Sub

Private Sub SomeProcedure2(SomeObjPtrToForm As Long)
    Dim frm As VB.Form

    Set frm = PtrObj(SomeObjPtrToForm)

    frm.SomeMethodThatExists
End Sub

Private Sub SomeProcedure3(SomeObjPtrToForm As Long)
    Dim frm As VB.Form

    vbaObjSetAddref frm, ByVal SomeObjPtrToForm

    frm.SomeMethodThatExists
End Sub




Public Sub SomeMethodThatExists()
    MsgBox "we got to here"
End Sub

[The trick]

I use something closer to this.

Private Declare Function PtrObj Lib "msvbvm60" Alias "VarPtr" (ByVal Ptr As Long) As IUnknown

Set frm = PtrObj(SomeObjPtrToForm)

Sorry, you can't use that because you'll get the error with the references counter.
When you declare an API function with an object return value it assumes that the API returns the object with incremented counter, but you get it via ObjPtr that just returns pointer without incrementing counter:

Option Explicit

Private Declare Function PtrObj Lib "msvbvm60" Alias "VarPtr" (ByVal Ptr As Long) As IUnknown
Private Declare Sub vbaObjAddref Lib "msvbvm60" Alias "__vbaObjAddref" (ByVal Ptr As IUnknown)

Private Sub Form_Load()
    Dim frm As Form
    
    Set frm = PtrObj(ObjPtr(Me))
    
    vbaObjAddref frm
    
    frm.Circle (100, 100), 200
    
End Sub

That's the proper way but that work is made via vbaObjSetAddref.

[DEXWERX]

My Bad, It's been so long since I've used something other than a typelib. Turns out I use __vbaObjSetAddref also.

[entry("__vbaObjSetAddref"),propput,helpstring("Set a strong reference to an Object, by calling AddRef. (Write Only). ObjSetAddref()")]
HRESULT ObjSet(	[in] void* Ref, [in] PTR Address);

stupid mistake.

edit: Also note Trick's (COMObjectFromPtr) method is safer than just

ObjSet(frm) = SomeObjPtrToForm

because his method does the necessary QueryInterface.

@Elroy you definitely want to wrap __vbaObjSetAddref if you want type safety, since VB will use early bound calls.
If it's not the same Object type, you'll get weird crashes as well.

edit: I also should have known because I use VarPtr as an ObjRelease() in the same typelib...

		[entry("__vbaObjAddref"),helpstring("Add a reference."),hidden]
		void ObjAddRef([in] IUnknown* Obj);
		[entry("VarPtr"),helpstring("Release an object reference. Call as a sub."),hidden]
		IUnknown* ObjRelease([in] IUnknown* Obj);

[Elroy]

Ok, I fixed my example so that all three methods work:

Option Explicit
'
Private Declare Function GetMem4 Lib "MSVBVM60.DLL" (ByRef Source As Any, ByRef Dest As Any) As Long
Private Declare Function PtrObj Lib "msvbvm60" Alias "VarPtr" (ByVal Ptr As Long) As IUnknown
Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
Private Declare Sub vbaObjAddref Lib "msvbvm60" Alias "__vbaObjAddref" (ByVal Ptr As IUnknown)
'

Private Sub Form_Click()
    SomeProcedure1 ObjPtr(Me)
    SomeProcedure2 ObjPtr(Me)
    SomeProcedure3 ObjPtr(Me)
End Sub

Private Sub SomeProcedure1(SomeObjPtrToForm As Long)
    Dim frmBorrowed As VB.Form
    Dim frm As VB.Form
    GetMem4 SomeObjPtrToForm, frmBorrowed
    Set frm = frmBorrowed
    GetMem4 0&, frmBorrowed

    frm.SomeMethodThatExists
End Sub

Private Sub SomeProcedure2(SomeObjPtrToForm As Long)
    Dim frm As VB.Form

    Set frm = PtrObj(SomeObjPtrToForm)
    vbaObjAddref frm

    frm.SomeMethodThatExists
End Sub

Private Sub SomeProcedure3(SomeObjPtrToForm As Long)
    Dim frm As VB.Form

    vbaObjSetAddref frm, ByVal SomeObjPtrToForm

    frm.SomeMethodThatExists
End Sub


Public Sub SomeMethodThatExists()
    MsgBox "we got to here"
End Sub

I do believe that this thread is resolved.

Thanks Guys,
Elroy

[DEXWERX]

your third method (SomeProcedure3) has no type safety. (not that it matters in this case)

just something to keep note of.