Workaround for GlobalMultiUse-Problem in ActiveX-EXE

VK
VK used Ask the Experts™
on
Hello Experts:

Context:

1. There is an OLE-server called vbpClock.clsClock.

2. The server can run on it's own (without ever been started from a client).

3. The server registers himself in the ROT, so that other vb-apps can get a reference to an existing instance via GetObject with missing 1. parameter.

4. Each time i call GetObject("", ...) from the Client, Class_Initialize is been fired in the same instance of the clock. All variables in a Module are global. So i can use the RefCount, which i need when i have to add or remove the ROT-Entry (only once each time).

5. In some cases i have to Refresh the Data the clock shows. This has to be done only if a clock already is running. In this case i call GetObject(, ...)

PROBLEM:

a.) Why GetObject("", ...)doesn't create a new instance ?
    Although it was curious i used this approach because it had no other workaround.

b. Because of 5. i get the 2nd curiosity:
   When i call GetObject(, ...) from the Client a reference to an existing instance of the clock is returned.

But:

Neither Class_Initialize nor Class_Terminate are fired for this call.

AND

m_ROTHook.HideObject (not the MsgBox before !!) seems to be executed when the reference is released at client-side.

There are other clients holding a reference to the clock but the ROT-Entry is been removed.

How can a code be executed which is not debugable. It seems that Class_Terminate is been executed, but it doesn't.

        ----------------------------------------------------------------------------------------------
        ActiveX-EXE (Starting with Sub main(),Thread Pool with 1 Tread)
        ----------------------------------------------------------------------------------------------

        FORM:
        ----------

        Private Sub Form_Unload(Cancel As Integer)
            Set myClock = Nothing
        End Sub
       
       
        MODULE:
        --------------

        Public m_ROTHook As IROTHook
        Public myOLEServer As vbpAXServer.clsAXServer
        Public myClock As clsClock
        Public RefCount As Long
       
        Public Function GetSmartObject(ClassName As String) As Object
            On Error GoTo hErr
            Set GetSmartObject = GetObject(, ClassName)
            Exit Function
        hErr:
            Set GetSmartObject = GetObject("", ClassName)
            Resume Next
        End Function
       
        Public Sub Main()
            If RefCount = 0 Then Set myClock = New clsClock
        End Sub
       
       
        CLASS (Global MultiUse)
        ------------------------------------
       
        Private Sub Class_Initialize()
            RefCount = RefCount + 1
            If RefCount = 1 Then
                Set myOLEServer = GetObject("", "vbpAXServer.clsAXServer")
                If Not App.PrevInstance Then
                    Set m_ROTHook = ROTHookEntries.NewROTHook
                    m_ROTHook.ExposeObject Me, "vbpClock.clsClock"
                End If
                frmClock.Visible = True
            End If
            frmClock.Text1(1).Text = RefCount
        End Sub
       
       
        Private Sub Class_Terminate()
            RefCount = RefCount - 1
            frmClock.Text1(1).Text = RefCount
           
            If RefCount = 0 Then
                If Not App.PrevInstance Then
                    If Not m_ROTHook Is Nothing Then
                        m_ROTHook.HideObject
                        Set m_ROTHook = Nothing
                    End If
                    Set myOLEServer = Nothing
                End If
            End If
        End Sub

Help needed, please :-)

V.K.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
>>When i call GetObject(, ...) from the Client a reference to an existing instance of the clock is returned.

>>But:

>>Neither Class_Initialize nor Class_Terminate are fired for this call



Isn't that what you want...to return a current existing instance of the clock?  If so, then Class_Initialize should not fire, as that event should fire only when a class is instantiated, i.e., when it was created.  Just grabbing a reference to the class will not fire its Initialize event.


VK

Author

Commented:
Hello AzraSound !

I agree with you. But my problem is the following scenario:

An App (A) has created the first instance of clock and created the first object. A later started second app (B) gets a reference to the running object. But for some reason, when i release the reference to clock holded by (B) Class_Terminate "seems" to have been fired (although i can't debug it). The next app (C) which needs a Clock creates a new instance although there is a running one because the ROT-Entry is lost !!

       Private Sub Class_Terminate()
           RefCount = RefCount - 1
           frmClock.Text1(1).Text = RefCount
           
           If RefCount = 0 Then
               If Not App.PrevInstance Then
                   If Not m_ROTHook Is Nothing Then
                       m_ROTHook.HideObject
                       Set m_ROTHook = Nothing
                   End If
                   Set myOLEServer = Nothing
               End If
           End If
       End Sub

I have no idea why the ROT-entry is lost.
Hope you can help.

Regardy

v.k.
You may want to add debugging code into the Class_Initialize and Class_Terminate events then.  Write out to a file what the class actually thinks the RefCount is and see if it corresponds to how you believe things "should" be working.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

VK

Author

Commented:
OK, i have began it already with messageboxes but i will try the file approach if it makes a difference ...ty

v.k.
VK

Author

Commented:
Hello AzraSound !

I found the error by writing debug information into a log file. The reason is the use of third party-code which i didn't read completely because of the lack of time:

ENSURE CORRECT TERMINATION

To support correct termination, the ROTHook object is designed to remove all information from the ROT when the last external connection is released. This is necessary to ensure correct termination of the server for objects initially created by another process. In the sample code I discussed previously, if the object is created initially by a client process, then GetObject will work indefinitely as long as there is at least one object still running.
However, if the object is created internally, as in the Load event of a form, and assigned to an internal variable, then the first GetObject will work. However,
this code snippet will fail when run from an external project:

Dim Obj As Object
Set Obj = GetObject(, "MyProj.TestObject")
Set Obj = Nothing
'The second GetObject fails
Set Obj = GetObject(, "MyProj.TestObject")

This code fails because the reference held by Obj when it is set to Nothing is the last external reference on the object. When the last external reference is gone, the ROTHook object removes itself from the ROT (the RevokeActiveObject call is required for correct server termination), so the second GetObject fails. You can take one of two approaches to maintaining the ROT entry. The first is to notify the controlling object when the last
external reference is released and repeat the call to RegisterActiveObject. However, reregistering an object is an expensive task, so it is best to avoid it altogether by
actually adding an extra external reference.
OLE provides the handy API call CoLockObjectExternal, which fits the bill nicely. The net effect of calling CoLockObjectExternal is that the system maintains an extra external reference, so releasing the last external reference held by another process no longer causes ROTHook
to revoke the registration.
The Locked property of the ROTHook object locks the entry in the ROT. You will generally set Locked to True if you have a visible UI element that corresponds to the registered object. If you set the Locked property to True, you are responsible for setting it to False when the UI element is not visible. If you fail to do so, your server
will keep running indefinitely and you will most likely crash VB5 if you’re running in the environment.

I will give you the points because:

1. If i ask hard questions, nearly no expert responds to.
2. Normally i give the points to the expert, who posted the best answer.
3. If nobody could solve the problem the expert who made the greatest effort will get the points.

I wish that ee becomes a place where "experts" can collaborate - not a place where experts give advice to novices.

regards

v.k.

Well I am glad that you found your answer...and I am always interested in collaborating on difficult questions.  I only wish others had participated here as well.  Good luck with everything!  

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial