Ensure single class instance but with multiple references to it

[hooksie2]

I have written a class module which creates a link to an ActiveX server
and provides some functions. Because the server doesn't seem to be
able to handle multiple references being set to it I am trying to
ensure that only one instance of my class is created and that all other
attempts to create a new instance merely set a pointer to the existing
instance. To do this I have the following in a standard module:

Private m_clsOpenServer As cOpenServer

Public Function GetOpenServer() As cOpenServer
If m_clsOpenServer Is Nothing Then
Set m_clsOpenServer = New cOpenServer
End If
Set GetOpenServer = m_clsOpenServer
End Function


I then reference the class by:
Dim clsOpenServer As cOpenServer
Set clsOpenServer = GetOpenServer

When I'm finished I destroy the object, ie.
Set clsOpenServer = Nothing

Now comes the problem. Even though clsOpenServer is destroyed,
m_clsOpenServer remains in memory and so there is still a reference to
my class object and to the ActiveX server.


I thought the thing to do here was to add a terminate procedure:
Public Sub TerminateOpenServer()
Set m_clsOpenServer = Nothing
End Sub
and then call this after clsOpenServer is set to nothing. If there
were other pointers set to m_clsOpenServer then I thought it would be
held in memory even though I set it to nothing. This is not the case
however (not sure why not??) and so the next time I call GetOpenServer
a new instance is created (and then pretty soon the application I am
calling freezes up).

Is there any robust way to handle this type of situation?

Thanks a lot,
Andrew

 

[Tushar Mehta]

You need to use variables that are shared by all instances of the
class. Unfortunately, VBA doesn't support that concept directly --
well, at least as far as I have been able to figure out, it doesn't. A
workaround, while easy, leaves you vulnerable to (future) lazy
programmers.

Create a new *standard* module called cOpenServerGlobals. This will
hold the globals for your cOpenServer class. This module will contain

Option Explicit
Option Private Module
Public OpenServerUserCount As Long
Public x 'reference to the activex component

In the cOpenServer class module, add Initialize and Terminate
procedures:
Option Explicit

Private Sub Class_Initialize()
OpenServerUserCount = OpenServerUserCount + 1
If OpenServerUserCount = 1 Then
'instantiate x
End If
End Sub

Private Sub Class_Terminate()
OpenServerUserCount = OpenServerUserCount - 1
If OpenServerUserCount = 0 Then
'close and release x
End If
End Sub

Now, you can use the cOpenServer class like any other class module. It
will correctly handle the linking to the ActiveX component.

Option Explicit

Dim aServerRef As cOpenServer
Sub doSomething()
Set aServerRef = New cOpenServer
'...
Set aServerRef = Nothing
End Sub
or

Option Explicit

Sub doSomething()
Dim aServerRef As cOpenServer
Set aServerRef = New cOpenServer
'...
End Sub

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[hooksie2]

Thanks for the reply - it certainly gave me some things to think about.

At the moment I instantiate the activeX object in the class and store
the reference there too, ie. cOpenServer class looks like:

Private m_objOpenServer as Object

Private Sub Class_Initialize()
If m_objOpenServer Is Nothing Then
Set m_objOpenServer = CreateObject("PX32.OpenServer.1")
End If
End Sub

Applying your suggestion directly would mean that only the first
instance of the class actually works. Subequent instances won't have
an ActiveX reference so the rest of the functions won't work.

I guess one option would be to make m_objOpenServer a global variable
in a standard module and if OpenServerUserCount > 1 then just set a new
reference to the global variable. Only thing I don't like about this
though is that now all the activeX stuff isn't encapsulated in my class
object which was the original intent.

The other option I see would be to apply your suggestion in my original
GetOpenServer and TerminateOpenServer module functions, ie.

Private m_clsOpenServer as cOpenServer
Public g_lngOpenServerObjCount As Long

Public Function GetOpenServer() As cOpenServer
If m_clsOpenServer Is Nothing Then
g_lngOpenServerObjCount = 1
Set m_clsOpenServer = New cOpenServer
Else
g_lngOpenServerObjCount = g_lngOpenServerObjCount + 1
End If
Set GetOpenServer = m_clsOpenServer
End Function

Public Sub TeminateOpenServer()
g_lngOpenServerObjCount = g_lngOpenServerObjCount - 1
If g_lngOpenServerObjCount <= 0 Then
Set m_clsOpenServer = Nothing
End If
End Sub

This seems pretty dangerous though since TerminateOpenServer could
easily be called when a real instance hadn't actually been created (ie.
as part of tidy up code after an error).

I'm still a bit surprised that m_clsOpenServer can be destroyed even
when another variable has a reference to my object through it but I
guess that's just my bad luck.

Please let me know if I've misunderstood anything or if there is
another approach that might work.

Thanks again,
Andrew

 

[Tushar Mehta]

In line...

Thanks for the reply - it certainly gave me some things to think about.

You are welcome.

At the moment I instantiate the activeX object in the class and store
the reference there too, ie. cOpenServer class looks like:

Private m_objOpenServer as Object

Private Sub Class_Initialize()
If m_objOpenServer Is Nothing Then
Set m_objOpenServer = CreateObject("PX32.OpenServer.1")
End If
End Sub

Applying your suggestion directly would mean that only the first
instance of the class actually works. Subequent instances won't have
an ActiveX reference so the rest of the functions won't work.

No, you missed the point. The ActiveX control is *outside* the class
module. You can always have a variable inside your class that refers
to it. Continuing with the global declarations in the new standard
module, the code in the class module would be

Private m_objOpenServer as Object

Private Sub Class_Initialize()
OpenServerUserCount = OpenServerUserCount + 1
If OpenServerUserCount = 1 Then
Set x = CreateObject("PX32.OpenServer.1")
End If
set m_objOpenServer =x
End If
End Sub

I guess one option would be to make m_objOpenServer a global variable
in a standard module and if OpenServerUserCount > 1 then just set a new
reference to the global variable. Only thing I don't like about this
though is that now all the activeX stuff isn't encapsulated in my class
object which was the original intent.

That is exactly what 'x' in my code did. And, as far as problems with
the workaround go, well, I did point that out in my post. Of course,
only the declaration of the activex control and a counter to the number
of objects using it are outside the class.

You could always switch to .Net, which, from what I remember, supports
the concept of a variable common to all instantiations of a class.

The other option I see would be to apply your suggestion in my original
GetOpenServer and TerminateOpenServer module functions, ie.

Private m_clsOpenServer as cOpenServer
Public g_lngOpenServerObjCount As Long

Public Function GetOpenServer() As cOpenServer
If m_clsOpenServer Is Nothing Then
g_lngOpenServerObjCount = 1
Set m_clsOpenServer = New cOpenServer
Else
g_lngOpenServerObjCount = g_lngOpenServerObjCount + 1
End If
Set GetOpenServer = m_clsOpenServer
End Function

Public Sub TeminateOpenServer()
g_lngOpenServerObjCount = g_lngOpenServerObjCount - 1
If g_lngOpenServerObjCount <= 0 Then
Set m_clsOpenServer = Nothing
End If
End Sub

This seems pretty dangerous though since TerminateOpenServer could
easily be called when a real instance hadn't actually been created (ie.
as part of tidy up code after an error).

No, I did not recommend adding that code to a public method that could
be called arbitrarily. The two methods I used were the built-in
Class_Initialize and Class_Terminate. AFAIK, neither is publicly
available and both are guaranteed to be called at the right time by the
OS/VBA.

Private Sub Class_Terminate()
set m_objOpenServer =nothing
OpenServerUserCount = OpenServerUserCount - 1
If OpenServerUserCount = 0 Then
'x.quit
set x=nothing
End If
End Sub

I'm still a bit surprised that m_clsOpenServer can be destroyed even
when another variable has a reference to my object through it but I
guess that's just my bad luck.

You shouldn't be surprised. That variable is local to your
instantiation. It can -- and will -- be removed when the object ceases
to exist.

I don't know how familiar you are with OOP but from your comment it is
possible you've misunderstood how variables inside a class module are
handled by the system.

Please let me know if I've misunderstood anything or if there is
another approach that might work.

Thanks again,
Andrew

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[hooksie2]

Okay - Now I'm with you. That's why you commented about future lazy
programmers - they might set a reference to my Public x directly rather
than going through my class object (?). If that's the only concern
it's not so bad since I will distribute the code as an xla and make
that module private so it's only my own laziness that I have to watch
out for.

Re my obvious confusion over variable scope. My thinking was:

Set m_objMyNewRef = GetOpenServer() -> GetOpenServer() -> Set
m_objOpenServer = OpenServerClass object, Set GetOpenServer() =
m_objOpenServer
So now there is a pointer from m_objMyNewRef to m_objOpenServer and
from m_objOpenServer to the actual OpenServer class

Now when I do, Set m_objOpenServer = Nothing, m_objMyNewRef is still
pointing to m_objOpenServer (or so I thought) so m_objOpenServer
wouldn't be destroyed. It seems the reference though is direcly from
m_objMyNewRef to the OpenServer class.

As I write this I've remembered something along these lines in the vba
developers handbook - will have to read again tonight. Caught out by
my own wishful thinking...

Once again thanks - I will go with your proposed solution.

Best Regards,
Andrew