Attempt #1 to implement Matt Curland's Singleton [Resolved + New Complete Source]

[Dave Sell]

All,

I've tried to implement the Singleton project - discussed in Matt Curland's "Advanced Visual Basic 6". He supplies a sample project called TimeServer which implements the ROTHook lightweight Object.

Of course his code works fine. But when I tried to create a StateServer based on his Client and Server projects, I get a slightly broken scenario.

As seen from this figure (the 4 Clients are on the left, the Server is on the right):
http://www.vbforums.com/attachment.p...postid=1821655

The first client I load is never in sync with either the server or with the rest of the clients. However every other Client loaded after the 1st (2nd, 3rd, 4th, etc) works correctly and as expected.

You will need to own a copy of the book to run my projects, so if you do, here they are:
http://www.vbforums.com/attachment.p...postid=1821658

I've included both the Client EXE and the ActiveX EXE Server.

It's as if the 1st Client is getting it's own instance of "a" server, but not the one that's running. However, when the 1st client gets loaded, the server does get loaded.

[Dave Sell]

There can be only one...
http://www.vbforums.com/showthread.p...hreadid=310205

The source I am including does not contain the VBoost Objects.

[Wokawidget]

You are still missing the ROTHook objects

Can't get the project to run. Since this is where the most important code is based it would be a good idea to include it in the project

What is it you're trying to do exactly as I am not familiar with the book...?

Woka

[Dave Sell]

Originally posted by Wokawidget
You are still missing the ROTHook objects
Can't get the project to run. Since this is where the most important code is based it would be a good idea to include it in the project
What is it you're trying to do exactly as I am not familiar with the book...?
Woka

Hey, Woka.

Thanks for replying. I cannot post that ROTHook source as it is copyright'ed. You can get the source by getting the book. I think you can also get the source at the desaware website... I made the executables in the other thread so you don't have to compile it yourself. I will post them again here.

I tried explaining everything I am trying to do in that other thread:
http://www.vbforums.com/showthread.p...hreadid=310205

But basically I was successful at making many clients talk to the same ActiveX EXE server, as long as both client and server are on the same machine.

I went a step further and tried to make the clients work on remote client machines a-la DCOM. It works when the client is the 1st thing that instantiates the server, but no client can get a handle to a server that is running already.

So my original post here that was broken is now fixed. I just took it to a new level (DCOM) and it's still not where I need it to be.

I guess that means this thread should be resolved?

[Wokawidget]

Hmmm...copyrighted...Hmmmmmm...and when's that ever stopped anyone

I see your point though.

But it's hard for me to debug code, which I don't have

I don't have a clue what the code is doing soooo...I'll take your word for it that it's fixed

Woof

[Dave Sell]

These wouldn't upload before. I'll try again. You can run these executables.

[Cander]

Here is the ROT code I use, and dont recall any problems with it..

Private Type GUIDs
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
'Declares needed to register object in the ROT
Private Const ACTIVEOBJECT_STRONG = 0
Private Const ACTIVEOBJECT_WEAK = 1
Private Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal ProgID As Long, rclsid As GUIDs) As Long
Private Declare Function CoDisconnectObject Lib "ole32.dll" (ByVal pUnk As IUnknown, pvReserved As Long) As Long
Private Declare Function RegisterActiveObject Lib "oleaut32.dll" (ByVal pUnk As IUnknown, rclsid As GUIDs, ByVal dwFlags As Long, pdwRegister As Long) As Long
Private Declare Function RevokeActiveObject Lib "oleaut32.dll" (ByVal dwRegister As Long, ByVal pvReserved As Long) As Long
Dim OLEInstance As Long
 
 
Private Sub Class_Initialize()
'This code is responsible for creating the entry in the rot
 
Dim mGUID As GUIDs
Dim lp As Long
OLEInstance = 0
lp = CLSIDFromProgID(StrPtr("UserModule.clsUserMod"), mGUID)
If lp = 0 Then
    lp = RegisterActiveObject(Me, mGUID, ACTIVEOBJECT_WEAK, OLEInstance)
End If
 
End Sub
 
Private Sub Class_Terminate()
'Once we are done with the main program, lets clean up the rot
'by removing the entry for our ActiveX Server
 
If OLEInstance <> 0 Then
    RevokeActiveObject OLEInstance, 0
End If
 
CoDisconnectObject Me, 0
 
End Sub

[Dave Sell]

I think this code may suffer from the dreaded "circular reference" paradox.

IE.. the code to remove yourself from the ROT is in the Class_Terminate, which cannot be called because the Object is referenced by the ROT. As long as any object holds a reference to you, you will not be destroyed and won't get a chance to run your Termination code.

I will definately try it tonight to see how it works.

[Wokawidget]

To get round this use the pointer to an object and then use:

Private Function PtrObj(ByVal Pointer As Long) As Object
Dim objObject   As Object
    CopyMemory objObject, Pointer, 4&
    Set PtrObj = objObject
    CopyMemory objObject, 0&, 4&
End Function

To retrieve the object.
This removes any circular reference.

Woka

[Cander]

Always worked fine for me. When I set it to nothing, the terminate is still going to attempt to fire. Then the code in there handles removing it from the ROT

[Dave Sell]

Originally posted by Wokawidget
To get round this use the pointer to an object and then use:

Private Function PtrObj(ByVal Pointer As Long) As Object
Dim objObject   As Object
    CopyMemory objObject, Pointer, 4&
    Set PtrObj = objObject
    CopyMemory objObject, 0&, 4&
End Function

To retrieve the object.
This removes any circular reference.
Woka

How do you get the Pointer to the Object? With AddressOf? Could you show an example of this function in use from code? Just a single line should do it.

[Wokawidget]

Option Explicit
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
 
Private mlngPtr As Long
 
Private Sub Form_Load()
    mlngPtr = ObjPtr(Combo1)
    AddItem
End Sub
 
Private Sub AddItem()
Dim objCombo    As ComboBox
    Set objCombo = PtrObj(mlngPtr)
    objCombo.AddItem "Woof"
    Set objCombo = Nothing
End Sub
 
Private Function PtrObj(ByVal Pointer As Long) As Object
Dim objObject   As Object
    CopyMemory objObject, Pointer, 4&
    Set PtrObj = objObject
    CopyMemory objObject, 0&, 4&
End Function

Works for objects and controls.

This means that when you have 2 classes that need to reference each other, ie Parent child collections, you only need to store ref to one object, and the other object stores a pointer back to the parent.
This way there is only ever 1 instance of an object, although 100's of other classes may reference it but by using it's Ptr

Woka

[Dave Sell]

Originally posted by Cander
Here is the ROT code I use, and dont recall any problems with it..

I really like this code. Well done. I will poke around with it more tonight, but so far I don't seem to have any problems with it, as you stated.

I hope I can get this to work as a DCOM service - something that has continued to escape me.

[Dave Sell]

Here is a complete project example based on Cander's code:

Compile each executable, then you can run a server instance, and then start running alot of client instances. They will all do the same thing.

I know its not very interesting, but things will get more interesting if I ever get this to work on remote machines using DCOM...