[RESOLVED] objptr alternative

[Amervb]

Hi,
I have two questions:
1- is there another way to get object pointer rather than objptr?
2- is there any way to get object pointer from another application window?

[Wolfgang Enzinger]

1- is there another way to get object pointer rather than objptr?

Well, VarPrt() of any object variable points to the ObjPtr, so you would only have to dereference VarPrt(). I wonder, however, why you would want to do that?

2- is there any way to get object pointer from another application window?

Probably there is, but you cannot do anything useful with it since it's originating from a, say, "foreign" address space.

Wolfgang

[The trick]

2- is there any way to get object pointer from another application window?

Why do you need the pointer? To identify an object in COM you should use monikers. As the alternative of pointers you can use OBJREF moniker.

[Zvoni]

Well, VarPrt() of any object variable points to the ObjPtr, so you would only have to dereference VarPrt(). I wonder, however, why you would want to do that?

?

Sub main()
Dim AClass As MyClass

    Set AClass = New MyClass
    
    Debug.Print ObjPtr(AClass)
    Debug.Print VarPtr(AClass)

End Sub
'Returns
'413199992 
'2290512

EDIT: Just saw, that you wrote "dereference VarPtr", so that's actually quite correct what you wrote.

[Wolfgang Enzinger]

?

Sub main()
Dim AClass As MyClass

    Set AClass = New MyClass
    
    Debug.Print ObjPtr(AClass)
    Debug.Print VarPtr(AClass)

End Sub
'Returns
'413199992 
'2290512

!

Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)

Sub Main()
Dim c As VBA.Collection
Dim i As Long
Set c = New VBA.Collection
GetMem4 VarPtr(c), i
Debug.Assert i = ObjPtr(c)
End Sub

Wolfgang

[Amervb]

Well, VarPrt() of any object variable points to the ObjPtr, so you would only have to dereference VarPrt(). I wonder, however, why you would want to do that?

Wolfgang , Thank you for reply, yes CopyMemory returns the object pointer from variable pointer.
I'm just making an experiment with ReadProcessMemory.

Probably there is, but you cannot do anything useful with it since it's originating from a, say, "foreign" address space.

Is it possible to get object pointer or variable pointer from another process?

[Amervb]

Why do you need the pointer? To identify an object in COM you should use monikers. As the alternative of pointers you can use OBJREF moniker.

The Trick, Thank you for reply, I'm just making an experiment with ReadProcessMemory.
But i'm not sure about OBJREF moniker.
Is it possible to get object pointer or variable pointer from another process same as objptr(Form1)?

[Amervb]

Duplicated reply edited because there is no delete option.

[The trick]

The Trick, Thank you for reply, I'm just making an experiment with ReadProcessMemory.
But i'm not sure about OBJREF moniker.
Is it possible to get object pointer or variable pointer from another process same as objptr(Form1)?

I asked you why do you need the pointer? What do you want to do with that pointer? If you want to work with it to call the methods you should use marshaling. OBJREF moniker ensures that.

[Amervb]

If you want to work with it to call the methods you should use marshaling. OBJREF moniker ensures that.

Yes its OBJREF, Many thanks.

[The trick]

Yes its OBJREF, Many thanks.

Moreover, it even supports the calls between machines apart from processes. You can very easy connect two applications or VBScript or 64 bit applications to VB6 using the monikers.
This is the small example (on Russian) where i created a VBScript object in the one machine and call the method of that object from the second machine using VB6.
You can, for example, also create a object in VBA (even x64) and communicate with VB6 app using moniker.
The same behavior with x64 C++ application and VB6 application, or between two or more VB6 applications.

[wqweto]

This is the meat of the snippet from the link above

Public Function RegisterObject( _
                ByVal cObj As Object) As String
    Dim cMoniker    As IMoniker
    Dim cBind       As IBindCtx
    Dim pStr        As Long
   
    Set cBind = CreateBindCtx()
    Set cMoniker = CreateObjrefMoniker(cObj)
   
    cMoniker.GetDisplayName ObjPtr(cBind), 0, pStr
   
    RegisterObject = SysAllocString(pStr)
   
    CoGetMalloc(1).Free pStr
  
End Function

Now if someone can port cMoniker.GetDisplayName to DispCallFunc and provide the declares for CreateBindCtx, CreateObjrefMoniker and CoTaskMemFree. Unfortunately SysAllocString cannot be declared correctly (outside of typelib) and has to be mimiced w/ lstrlenW and CopyMemory.

Once you have this display string returned, pass it cross thread/process (e.g. using WM_COPYMEMORY/WM_SETTEXT) and just use VB's built-in GetObject to "hydrate" a proxy.

cheers,
</wqw>

[The trick]

Yes, or just create a process with the command line which contains the moniker name.
Just as proof, calling the methods of the VB6 form from the 64-bit C++ application:

[Schmidt]

Well, 15 years ago or so, I've posted the approach below into some NewsGroup -
which is using the ROT (in conjunction with a FileMoniker) - to allow CrossProcess-access to any (Singleton-) Object.

I've not bothered with API-Declares here - instead the Example needs a reference to Eduardo Morcillos OleLib.tlb:

Option Explicit
 
Private RegID As Long

Private Sub Form_Load()
  Dim Col As New Collection: Col.Add "Hello World", "Key" 'prepare an Obj with something in it
  
  With GetRunningObjectTable 'now we register the Col in the ROT globally under a FileMoniker
    RegID = .Register(ROTFLAGS_REGISTRATIONKEEPSALIVE, Col, CreateFileMoniker("MyMoniker"))
  End With
End Sub

Private Sub Form_Click() 'request the now global Collection over its Moniker
  Debug.Print GetObject("MyMoniker").Item("Key")
End Sub

Private Sub Form_Unload(Cancel As Integer) 'cleanup the registered Obj over its associated ID
  If RegID Then GetRunningObjectTable.Revoke RegID
End Sub

Forgot to mention...
To test this also cross-process, it is enough to copy the Form_Click-Handler -
into another (fresh started) IDE-instance - whilst the Main-instance is running (with the code above)...

HTH

Olaf

[wqweto]

Here is an implementation of PutObject (the opposite of the built-in GetObject) w/ no external typelibs.

Option Explicit
 
Private Declare Function CreateFileMoniker Lib "ole32" (ByVal lpszPathName As Long, pResult As IUnknown) As Long
Private Declare Function GetRunningObjectTable Lib "ole32" (ByVal dwReserved As Long, pResult As IUnknown) As Long
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
 
Private Sub Form_Load()
    Dim lCookie     As Long
    Dim oCol        As Collection
    Dim lColCookie  As Long
    
    lCookie = PutObject(Me, "MyMoniker")
    Debug.Print TypeName(GetObject("MyMoniker"))    '--- returns Form1
    '--- warning: "MyMoniker" path is "stacked"
    Set oCol = New Collection
    lColCookie = PutObject(oCol, "MyMoniker")
    Debug.Print TypeName(GetObject("MyMoniker"))    '--- still Form1
    '--- "pops" Form1
    RevokeObject lCookie
    Debug.Print TypeName(GetObject("MyMoniker"))    '--- returns Collection now
    RevokeObject lColCookie
End Sub
 
Private Function PutObject(oObj As Object, sPathName As String) As Long
    Const ROTFLAGS_REGISTRATIONKEEPSALIVE As Long = 1
    Const IDX_REGISTER  As Long = 3
    Dim pROT            As IUnknown
    Dim pMoniker        As IUnknown
    
    Call GetRunningObjectTable(0, pROT)
    Call CreateFileMoniker(StrPtr(sPathName), pMoniker)
    DispCallByVtbl pROT, IDX_REGISTER, ROTFLAGS_REGISTRATIONKEEPSALIVE, ObjPtr(oObj), ObjPtr(pMoniker), VarPtr(PutObject)
End Function
 
Private Sub RevokeObject(ByVal lCookie As Long)
    Const IDX_REVOKE    As Long = 4
    Dim pROT            As IUnknown
    
    Call GetRunningObjectTable(0, pROT)
    DispCallByVtbl pROT, IDX_REVOKE, lCookie
End Sub
 
Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
    Const CC_STDCALL    As Long = 4
    Dim lIdx            As Long
    Dim vParam()        As Variant
    Dim vType(0 To 63)  As Integer
    Dim vPtr(0 To 63)   As Long
    Dim hResult         As Long
    
    vParam = A
    For lIdx = 0 To UBound(vParam)
        vType(lIdx) = VarType(vParam(lIdx))
        vPtr(lIdx) = VarPtr(vParam(lIdx))
    Next
    hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
    If hResult < 0 Then
        Err.Raise hResult
    End If
End Function

You get RevokeObject too to test ROT registration at will.

Also note that you would probably need to use "MyMoniker" & App.hInstance just to be safe with these moniker paths cross-process "interferences".

cheers,
</wqw>

[Amervb]

Here is an implementation of PutObject (the opposite of the built-in GetObject) w/ no external typelibs.

Thank you wqweto, i appreciate it.

[JAAFAR]

Here is an implementation of PutObject (the opposite of the built-in GetObject) w/ no external typelibs.

Option Explicit
 
Private Declare Function CreateFileMoniker Lib "ole32" (ByVal lpszPathName As Long, pResult As IUnknown) As Long
Private Declare Function GetRunningObjectTable Lib "ole32" (ByVal dwReserved As Long, pResult As IUnknown) As Long
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
 
Private Sub Form_Load()
    Dim lCookie     As Long
    Dim oCol        As Collection
    Dim lColCookie  As Long
    
    lCookie = PutObject(Me, "MyMoniker")
    Debug.Print TypeName(GetObject("MyMoniker"))    '--- returns Form1
    '--- warning: "MyMoniker" path is "stacked"
    Set oCol = New Collection
    lColCookie = PutObject(oCol, "MyMoniker")
    Debug.Print TypeName(GetObject("MyMoniker"))    '--- still Form1
    '--- "pops" Form1
    RevokeObject lCookie
    Debug.Print TypeName(GetObject("MyMoniker"))    '--- returns Collection now
    RevokeObject lColCookie
End Sub
 
Private Function PutObject(oObj As Object, sPathName As String) As Long
    Const ROTFLAGS_REGISTRATIONKEEPSALIVE As Long = 1
    Const IDX_REGISTER  As Long = 3
    Dim pROT            As IUnknown
    Dim pMoniker        As IUnknown
    
    Call GetRunningObjectTable(0, pROT)
    Call CreateFileMoniker(StrPtr(sPathName), pMoniker)
    DispCallByVtbl pROT, IDX_REGISTER, ROTFLAGS_REGISTRATIONKEEPSALIVE, ObjPtr(oObj), ObjPtr(pMoniker), VarPtr(PutObject)
End Function
 
Private Sub RevokeObject(ByVal lCookie As Long)
    Const IDX_REVOKE    As Long = 4
    Dim pROT            As IUnknown
    
    Call GetRunningObjectTable(0, pROT)
    DispCallByVtbl pROT, IDX_REVOKE, lCookie
End Sub
 
Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
    Const CC_STDCALL    As Long = 4
    Dim lIdx            As Long
    Dim vParam()        As Variant
    Dim vType(0 To 63)  As Integer
    Dim vPtr(0 To 63)   As Long
    Dim hResult         As Long
    
    vParam = A
    For lIdx = 0 To UBound(vParam)
        vType(lIdx) = VarType(vParam(lIdx))
        vPtr(lIdx) = VarPtr(vParam(lIdx))
    Next
    hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
    If hResult < 0 Then
        Err.Raise hResult
    End If
End Function

You get RevokeObject too to test ROT registration at will.

Also note that you would probably need to use "MyMoniker" & App.hInstance just to be safe with these moniker paths cross-process "interferences".

cheers,
</wqw>

Hi wqweto,

Nice code. Thanks.

I want to add a new file moniker name to an item already existing in the Running Object Table so I can then Use GetObject("NEW MONIKER PATHNAME")

It works only if PutObject is executed from within the Process where the object being registered resides\lives... It doesn't work and I get an NULL cookie if PutObject is ran from different Application\Process.

This is what I am doing from a different process.

Set Obj= GetObject ("Exising Moniker PathName")
PutObject Obj, "New Moniker PathName"
then
Set Obj= GetObject ("New Moniker PathName") <= error - not registered in ROT.

Is there a way of using PutObject from a different process ?

Regards.

[wqweto]

Is there a way of using PutObject from a different process ?

Highly doubt it.

GetObject is returning a proxy to the original object and then you try to register this proxy under a new name (not the original object) so this use-case is either deliberately detected to fail or the proxy is not implementing enough interfaces to be ROT compatible (e.g. no enough typelib info but not sure exactly which interfaces or what is missing).

Private classes cannot be ROT registered too for some similar reason (not enough typelib info probably).

cheers,
</wqw>

[JAAFAR]

Highly doubt it.

GetObject is returning a proxy to the original object and then you try to register this proxy under a new name (not the original object) so this use-case is either deliberately detected to fail or the proxy is not implementing enough interfaces to be ROT compatible (e.g. no enough typelib info but not sure exactly which interfaces or what is missing).

Private classes cannot be ROT registered too for some similar reason (not enough typelib info probably).

cheers,
</wqw>

Thanks.

Also, I notice that in order to revoke an object, one needs the cookie which is returned when registering the object

Will it be possible to revoke an object that has registered itself automatically? ie:= without having its corresponding cookie