Visual COM Control Work In Progress

[Dominic Mitchell]

I can't do that.  According to the 'Transitive Rule' of QueryInterface, if one has an interface
pointer on an object supporting multiple interfaces, one should be able to navigate to any other interface
supported by the object.

That does not apply to outgoing interfaces. The object should ignore QueryInteface calls for
outgoing interfaces.
Why do you think the following method exists?

Code Select Expand


IConnectionPointContainer::FindConnectionPoint

Anyway, each object can have as many outgoing interfaces as it sees fit.
Each one of those outgoing interfaces is managed by an IConnectionPoint interface.
So, for example, given the following scenario for an object:

Code Select Expand


$DIID_ITREEEVENTS           $IID_IPROPERTYNOTIFYSINK
      |                              |
IConnectionPoint 1             IConnectionPoint 2


Can you explain to me how QueryInterface(IID_ICONNECTIONPOINT) on this control will return a meaningful value?

       
Also, your class factory code is raising a lot of red flags for me. I will have to take a closer look at it.

[Frederick J. Harris]

Ahh!  It just sank in what you are saying Dominic.  Perhaps I didn't get it right away because I wasn't doing in my clients what you are saying my COM object is allowing, that is, making a direct QueryInterface for IConnectionPoint from perhaps the initial IUnknown or IComControl interfaces.  In my fifth post is the only low level client I posted and that is the C++ program and there I got my initial IUnknown/IComControl pointer, queried for IConnectionPointContainer off of it, called IConnectionPointContainer::FindConnectionPoint, then called IConnectionPoint::Advise, just like its supposed to be I believe.  But the setup as I have it now would allow for a QueryInterface for IConnectionPoint right off the initial IUnknown pointer.  I've gotta go to bed now as its late here, but tomorrow I'll look at that and can probably easily fix it.  That will actually reduce the code bulk I believe.

[Frederick J. Harris]

Well, I tried to do what Dominic is recommending but it isn't working.  Before I get into the details, let me first describe what my understanding is of what Dominic is recommending.  He is saying that an object should not support a QueryInterface() call for IID_IConnectionPoint because the IConnectionPointContainer::FindConnectionPoint() method was designed to produce that interface pointer.  I agree with that so I commented out the Case clause of my IComCtrl_QueryInterface() function containing the code to return a IConnectionPoint pointer so that E_NOINTERFACE would be returned if that request was made (see below)....

Code Select Expand


Function IComCtrl_QueryInterface(ByVal this As IComCtrl Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  Prnt "      Entering IComCtrl_QueryInterface()"
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      Prnt "        Trying To Get IUnknown"
      Call IComCtrl_AddRef(this)
      @ppv=this
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_ICOMCtrl
      Prnt "        Trying To Get IComCtrl"
      Call IComCtrl_AddRef(this)
      @ppv=this
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPointContainer
      Prnt "        Trying To Get IConnectionPointContainer"   
      Prnt "        this = " & Str$(this) 
      Incr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    'Case $IID_IConnectionPoint
    '  Prnt "        Trying To Get IConnectionPoint"
    '  Prnt "        this = " & Str$(this) 
    '  Incr this : Incr this
    '  @ppv=this
    '  Call IConnectionPoint_AddRef(this)
    '  Prnt "        this = " & Str$(this) 
    '  Prnt "      Leaving IComCtrl_QueryInterface()"
    '  Function=%S_OK
    '  Exit Function
    Case Else
      Prnt "        Looking For Something I Ain't Got!"
      Prnt "      Leaving IComCtrl_QueryInterface()" 
  End Select

  Function=%E_NoInterface
End Function



When I recompiled and attempted to run the VB.NET program it crashed, and here is the error report it gave me...

Code Select Expand


An unhandled exception of type 'System.InvalidOperationException' occurred in prjCD.exe

Additional information: An error occurred creating the form. See Exception.InnerException for details. 
The error is: Unable to cast COM object of type 'CDLibrary.CDClass' to interface type

'System.Runtime.InteropServices.ComTypes.IConnectionPoint'.

This operation failed because the QueryInterface call on the COM component for the interface with IID
'{B196B286-BAB4-101A-B69C-00AA00341D07}' failed due to the following error: No such interface supported
(Exception from HRESULT: 0x80004002 (E_NOINTERFACE)).


So I uncommented those lines back 'in', recompiled, and ran the .NET program again.  Below is the rather lengthy output from that run.  Check out about 55% of the way down in this output where I have several method calls blocked out with five spaces on either side so as to highlight them.  What is really odd is that .NET is making that IComCtrl_QueryInterface(IID_IConnectionPoint) call after it has already called IConnectionPointContainer::FindConnectionPoint() and already has a IConnectionPoint pointer from that!

Code Select Expand


Entering DllGetClassObjectImpl()
  Entering IClassFactory_QueryInterface()
    Entering IClassFactory_AddRef()
      g_lObjs =  1
    Leaving IClassFactory_AddRef()
    this =  53196788
  Leaving IClassFactory_QueryInterface()
  IClassFactory_QueryInterface() For iid Succeeded!
Leaving DllGetClassObjectImpl()

Entering IClassFactory_AddRef()
  g_lObjs =  2
Leaving IClassFactory_AddRef()

Entering IClassFactory_Release()
  g_lObjs =  1
Leaving IClassFactory_Release()

Entering IClassFactory_QueryInterface()
  Entering IClassFactory_AddRef()
    g_lObjs =  2
  Leaving IClassFactory_AddRef()
  this =  53196788
Leaving IClassFactory_QueryInterface()

Entering IClassFactory_Release()
  g_lObjs =  1
Leaving IClassFactory_Release()

Entering IClassFactory_QueryInterface()
Leaving IClassFactory_QueryInterface() Empty Handed!

Entering IClassFactory_CreateInstance()
  pCD                        =  1667768
  Varptr(@pCD.lpComCtrlVtbl) =  1667768
  Varptr(@pCD.lpICPCVtbl)    =  1667772
  Varptr(@pCD.lpICPVtbl)     =  1667776
  @ppv                       =  0  << Before QueryInterface() Call
  Entering IComCtrl_QueryInterface()
    Trying To Get IUnknown
    Entering IComCtrl_AddRef()
      @pCD.m_cRef =  1
    Leaving IComCtrl_AddRef()
    this =  1667768
  Leaving IComCtrl_QueryInterface()
  @ppv                       =  1667768  << After QueryInterface() Call
Leaving IClassFactory_CreateInstance()

Entering IComCtrl_QueryInterface()
  Trying To Get IUnknown
  Entering IComCtrl_AddRef()
    @pCD.m_cRef =  2
  Leaving IComCtrl_AddRef()
  this =  1667768
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_QueryInterface()
  Looking For Something I Ain't Got!
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  3
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Looking For Something I Ain't Got!
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  4
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Looking For Something I Ain't Got!
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_Release()
  @pCD.m_cRef =  4
Leaving IComCtrl_Release()

Entering IComCtrl_Release()
  @pCD.m_cRef =  3
Leaving IComCtrl_Release()

Entering IClassFactory_Release()
  g_lObjs =  1
Leaving IClassFactory_Release()

Entering IComCtrl_Release()
  @pCD.m_cRef =  2
Leaving IComCtrl_Release()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  2
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Trying To Get IConnectionPointContainer
  this =  1667768
  this =  1667772
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_Release()
  @pCD.m_cRef =  3
Leaving IComCtrl_Release()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  3
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Trying To Get IConnectionPointContainer
  this =  1667768
  this =  1667772
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_Release()
  @pCD.m_cRef =  4
Leaving IComCtrl_Release()

Entering IConnectionPointContainer_Release()
Leaving IConnectionPointContainer_Release()

Entering IConnectionPointContainer_Release()
Leaving IConnectionPointContainer_Release()





Entering IConnectionPointContainer_FindConnectionPoint()
  this  =  1667772
  @ppCP =  0
  Entering IConnectionPointContainer_QueryInterface()
    Looking For IID_IConnectionPoint
  Leaving IConnectionPointContainer_QueryInterface()
  @ppCP =  1667776
Leaving IConnectionPointContainer_FindConnectionPoint()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  5
Leaving IComCtrl_AddRef()

Entering IComCtrl_Release()
  @pCD.m_cRef =  5
Leaving IComCtrl_Release()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  5
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Trying To Get IConnectionPoint
  this =  1667768
  this =  1667776
Leaving IComCtrl_QueryInterface()





Entering IComCtrl_Release()
  @pCD.m_cRef =  6
Leaving IComCtrl_Release()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  6
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Trying To Get IConnectionPoint
  this =  1667768
  this =  1667776
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_Release()
  @pCD.m_cRef =  7
Leaving IComCtrl_Release()

Entering IConnectionPoint_Release()
Leaving IConnectionPoint_Release()

Entering IConnectionPoint_Release()
Leaving IConnectionPoint_Release()

Entering IConnectionPoint_Release()
Leaving IConnectionPoint_Release()

Entering IConnectionPointContainer_Release()
Leaving IConnectionPointContainer_Release()

Entering IConnectionPoint_Release()
Leaving IConnectionPoint_Release()

Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
  pUnkSink      =  53280812
  @pUnkSink     =  3548000
  Vtbl          =  3548000
  @Vtbl[0]      =  2046397480
  g_ptrOutGoing =  0  << Before Call Of QueryInterface() On Sink
  g_ptrOutGoing =  53280816  << After Call Of QueryInterface() On Sink
  Call Dword Succeeded!
Leaving IConnectionPoint_Advise() And Still In One Piece!

Entering IConnectionPoint_Release()
Leaving IConnectionPoint_Release()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  4
Leaving IComCtrl_AddRef()

Entering IComCtrl_QueryInterface()
  Trying To Get IComCtrl
  Entering IComCtrl_AddRef()
    @pCD.m_cRef =  5
  Leaving IComCtrl_AddRef()
  this =  1667768
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_Release()
  @pCD.m_cRef =  5
Leaving IComCtrl_Release()

Entering IComCtrl_AddRef()
  @pCD.m_cRef =  5
Leaving IComCtrl_AddRef()

Entering IComCtrl_Initialize()
  this =  1667768
Leaving IComCtrl_Initialize()

Entering IComCtrl_Release()
  @pCD.m_cRef =  5
Leaving IComCtrl_Release()

Entering IComCtrl_CreateControl()
  this =  1667768
Leaving IComCtrl_CreateControl()

Entering IComCtrl_SetColor()
Leaving IComCtrl_SetColor()

WM_LBUTTONDOWN
g_ptrOutGoing =  53280816



This problem only occurred with .NET.  VB6 tolerated it as well as my PowerBASIC and C++ clients. 

After Dominic made his comment about this and it finally dawned on me what he was saying I thought back to the Connection Points example I had followed in Guy And Henry Eddon's book "Inside Distributed COM" from Microsoft Press, and I realized that example probably didn't provide a IConnectionPoint* either in its QueryInterface, and I had provided it in my CD.bas just through over zealousness and wanting to support all interface calls.  When I looked, however, I found that IID_IConnectionPoint was supported in that example, although due to the way C++ sets up Vtables its not entirely or even partially analogous to my code. Here is that C++ code...

Code Select Expand


//local.cpp -- Compile: cl local.cpp component_i.c registry.cpp /FeComponent.exe UUID.lib Advapi32.lib Ole32.lib oleaut32.lib component.obj
#define     _WIN32_DCOM
#include    <stdio.h>
#include    <olectl.h>
#include    "component.h" // Generated by MIDL
#include    "registry.h"  // Add This!!!

long        g_cComponents  = 0;
long        g_cServerLocks = 0;
HANDLE      g_hEvent;
IOutGoing*  g_pOutGoing    = 0;


class CInsideDCOM : public ISum, IConnectionPointContainer, IConnectionPoint
{
public:
//IUnknown
ULONG __stdcall AddRef();
ULONG __stdcall Release();
HRESULT __stdcall QueryInterface(REFIID iid, void** ppv);

//ISum
HRESULT __stdcall Sum(int x, int y, int* retval);

//IConnectionPointContainer
HRESULT __stdcall EnumConnectionPoints(IEnumConnectionPoints** ppEnum);
HRESULT __stdcall FindConnectionPoint(REFIID riid, IConnectionPoint** ppCP);

//IConnectionPoint
HRESULT __stdcall GetConnectionInterface(IID* pIID);
HRESULT __stdcall GetConnectionPointContainer(IConnectionPointContainer** ppCPC);
HRESULT __stdcall Advise(IUnknown* pUnknown, DWORD* pdwCookie);
HRESULT __stdcall Unadvise(DWORD dwCookie);
HRESULT __stdcall EnumConnections(IEnumConnections** ppEnum);

CInsideDCOM() : m_cRef(0) { g_cComponents++; }
~CInsideDCOM()
{
  puts("Component: CInsideDCOM::~CInsideDCOM()\n");
  g_cComponents--;
}

private:
long m_cRef;
};

ULONG CInsideDCOM::AddRef()
{
printf("Component: CInsideDCOM::AddRef()  m_cRef = %u\n", m_cRef + 1);
return ++m_cRef;
}

ULONG CInsideDCOM::Release()
{
printf("Component: CInsideDCOM::Release()  m_cRef = %u\n", m_cRef - 1);
if(--m_cRef != 0)
    return m_cRef;
SetEvent(g_hEvent);
delete this;

return 0;
}

HRESULT CInsideDCOM::QueryInterface(REFIID riid, void** ppv)
{
if(riid == IID_IUnknown)
{
    *ppv = reinterpret_cast<IUnknown*>(this);
    printf("CInsideDCOM::QueryInterface(IID_IUnknown) = %u\n",*ppv);
}
else if(riid == IID_ISum)
{
    *ppv = (ISum*)this;
    printf("CInsideDCOM::QueryInterface(IID_ISum) = %u\n",*ppv);
}
else if(riid == IID_IConnectionPointContainer)
{
    *ppv = (IConnectionPointContainer*)this;
    printf("CInsideDCOM::QueryInterface(IID_IConnectionPointContainer) = %u\n",*ppv);
}
else if(riid == IID_IConnectionPoint)
{
    *ppv = (IConnectionPoint*)this;
    printf("CInsideDCOM::QueryInterface(IID_IConnectionPoint) = %u\n",*ppv);
}
else
{
    *ppv = NULL;
    return E_NOINTERFACE;
}
AddRef();

return S_OK;
}

HRESULT CInsideDCOM::Sum(int x, int y, int* retval)
{
*retval = x + y;
return S_OK;
}

HRESULT CInsideDCOM::EnumConnectionPoints(IEnumConnectionPoints** ppEnum)
{
return E_NOTIMPL;
}

HRESULT CInsideDCOM::FindConnectionPoint(REFIID riid, IConnectionPoint** ppCP)
{
if(riid == IID_IOutGoing)
{
    printf("Component: CInsideDCOM::FindConnectionPoint() for IID_IOutGoing\n");
    return QueryInterface(IID_IConnectionPoint, (void**)ppCP);
}

return E_NOINTERFACE;
}

HRESULT CInsideDCOM::GetConnectionInterface(IID* pIID)
{
return E_NOTIMPL;
}

HRESULT CInsideDCOM::GetConnectionPointContainer(IConnectionPointContainer** ppCPC)
{
return E_NOTIMPL;
}

HRESULT CInsideDCOM::Advise(IUnknown* pUnknown, DWORD* pdwCookie)    //HRESULT CInsideDCOM::Advise(IUnknown* pUnknown, DWORD* pdwCookie)
{                                                                    //{
HRESULT hr;                                                         // printf("Entering CInsideDCOM::Advise\n");
                                                                     // *pdwCookie=1;
printf("\nEntering CInsideDCOM::Advise\n");                         // return pUnknown->QueryInterface(IID_IOutGoing, (void**)&g_pOutGoing);
printf("  pUnknown     = %u\n",pUnknown);                           //}
printf("  g_pOutGoing  = %u\n",g_pOutGoing);                       
*pdwCookie=1;                                                       
hr=pUnknown->QueryInterface(IID_IOutGoing, (void**)&g_pOutGoing);
printf("  &g_pOutGoing = %u\n",&g_pOutGoing);
printf("  g_pOutGoing  = %u\n",g_pOutGoing);
printf("Leaving CInsideDCOM::Advise()\n\n");

return hr;
}

HRESULT CInsideDCOM::Unadvise(DWORD dwCookie)
{
printf("Unadvise\n");
g_pOutGoing->Release();

return NOERROR;
}

HRESULT CInsideDCOM::EnumConnections(IEnumConnections** ppEnum)
{
return E_NOTIMPL;
}


If I want the program to run in .NET it looks like it has to stay. 

[Dominic Mitchell]

Code Select Expand


FUNCTION IConnectionPointContainer_FindConnectionPoint(BYVAL this AS IConnectionPointContainer1 PTR, BYREF iid AS GUID, BYVAL ppCP AS DWORD PTR) AS LONG
  LOCAL hr AS LONG

  Prnt "    Entering IConnectionPointContainer_FindConnectionPoint()"
  IF iid=$IID_IOUTGOING THEN
     Prnt "      this  = " & STR$(this)
     Prnt "      @ppCP = " & STR$(@ppCP)
     hr=IConnectionPointContainer_QueryInterface(this, $IID_ICONNECTIONPOINT, ppCP)
     Prnt "      @ppCP = " & STR$(@ppCP)
     Prnt "    Leaving IConnectionPointContainer_FindConnectionPoint()"
     FUNCTION=hr
     EXIT FUNCTION
  END IF


Isn't it your implementation of IConnectionPointContainer::FindConnectionPoint that is doing
QueryInterface(IID_ICONNECTIONPOINT) rather than .NET?

The way I would implement this method, is to just simply return an AddRef'ed pointer to the requested interface.

By the way, why are you using global variables?  Try creating five controls on a form, deleting three of them and
interacting with the remaining two.

[Frederick J. Harris]

Isn't it your implementation of IConnectionPointContainer::FindConnectionPoint that is doing
QueryInterface(IID_ICONNECTIONPOINT) rather than .NET?

No.  The whole ::FindConnectionPoint() thing seems to me to be just a wrapper around a QueryInterface()
call for IConnectionPoint off the IConnectionPointContainer interface.  At least that is what I gathered
from studying the implementation from my book which I essentially just copied to my specific control
I'm building here.  If there is more to it than that I simply havn't gotten that far yet.

What caused the VB.NET crash after I commented out the IConnectionPoint Case from IComCtrl_QueryInterface()
is that VB.NET made that call after it had already obtained an IConnectionPoint pointer from
::FindConnectionPoint() in the customary manner, and it made the call off the IComCtrl interface which you
have been stating all along shouldn't support a direct call for the IConnectionPoint interface.  I can
assure you that that IComCtrl_QueryInterface($IID_IConnectionPoint) call revealed and explained in the below
notes was not made by my dll but rather by .NET...

Code Select Expand


Entering IComCtrl_QueryInterface()                          'At this point VB.NET is calling the
 Trying To Get IConnectionPointContainer                   'base or 'default' interface to get
 this =  1667768                                           'an IConnectionPointContainer pointer.
 this =  1667772                                           'The way I have the object built is
Leaving IComCtrl_QueryInterface()                           'that IComCtrl is the 1st interface
                                                           'pointer stored at the base allocation
Entering IComCtrl_Release()                                 'of COM Object CD - here 1667768.  The
 @pCD.m_cRef =  4                                          'next pointer occupying bytes 1667772
Leaving IComCtrl_Release()                                  'through 1667775 would be the
                                                           'IConnectionPointContainer VTable Ptr.
Entering IConnectionPointContainer_Release()                'The 3rd slot in CD - 1667776 through
Leaving IConnectionPointContainer_Release()                 '1667779 would be the IConnectionPoint
                                                           'pointer
Entering IConnectionPointContainer_Release()
Leaving IConnectionPointContainer_Release()

Entering IConnectionPointContainer_FindConnectionPoint()    'Here you see that VB.NET is using its
 this  =  1667772                                          'just acquired IConnectionPointContainer
 @ppCP =  0                                                'pointer to call ::FindConnectionPoint(),
 Entering IConnectionPointContainer_QueryInterface()       'and of course it got it, which would be
   Looking For IID_IConnectionPoint                        'the number 1667776.
 Leaving IConnectionPointContainer_QueryInterface()
 @ppCP =  1667776
Leaving IConnectionPointContainer_FindConnectionPoint()

Entering IComCtrl_AddRef()           'Now here's the strange part:  As you can see above VB.NET                          
 @pCD.m_cRef =  5                   'successfully obtained its IConnectionPoint pointer in that it
Leaving IComCtrl_AddRef()            'would have gotten both an address and a successful HRESULT
                                    'from its FindConnectionPoint() call off the
Entering IComCtrl_Release()          'IConnectionPointContainer Interface.  Nontheless just below and
 @pCD.m_cRef =  5                   'left you can see an 'Entering IComCtrl_QueryInterface() call trying
Leaving IComCtrl_Release()           'to get another IConnectionPoint pointer.  This is the call that
                                    'raised the VB.NET exception when I commented out the
Entering IComCtrl_AddRef()           'IConnectionPoint Case in IComCtrl_QueryInterface().  Here is
 @pCD.m_cRef =  5                   'the exact error message generated by that which specifically
Leaving IComCtrl_AddRef()            'states...

Entering IComCtrl_QueryInterface()   'Unable to cast COM object of type 'CDLibrary.CDClass' to interface type
 Trying To Get IConnectionPoint     'type 'System.Runtime.InteropServices.ComTypes.IConnectionPoint'.  This
 this =  1667768                    'operation failed because the QueryInterface call on the COM component for
 this =  1667776                    'the interface with IID {B196B286-BAB4-101A-B69C-00AA00341D07} failed due
Leaving IComCtrl_QueryInterface()    'due to the following error: No such interface supported Exception from
                                    'HRESULT: 0x80004002 (E_NOINTERFACE)).  

                                    'The E_NOINTERFACE referred to above came from the bottom of my
                                    'IComCtrl_QueryInterface() call after I commented out the IConnectionPoint
                                    'Case.


All I can think of why .NET would call my IComCtrl_QueryInterface() for IConnectionPoint after it already
successfully got one in the customary fashion of using FindConnectionPoint() is that it is wanting to
compare the values and that the result of that comparison is in some way meaningful to the algorithm it
is running.  If they match then maybe its algorithm thinks to itself "Hey!  Here's a component with a real
high regard to the 'Transitive Rule' Of QueryInterface."  I don't know.  All I know is that if I don't
return a valid IConnectionPoint interface pointer off the default interface .NET will crash.  

The way I would implement this method, is to just simply return an AddRef'ed pointer to the requested interface.

Wow!  Why didn't I think of that!  

Incr this
@ppCP=this

Too easy I guess!  All kidding aside, I just copied from my Eddon "Inside Distributed COM" book, and that's
what they did.  

I'll address your other comments in a bit, because they raise some important issues.  Thanks again for looking at this Dominic.  Your input is
valuable to me.

[Frederick J. Harris]

By the way, why are you using global variables?

I hate globals and don't use them at all in my GUI Windows programming.  My typical protocol is to allocate memory for a type and stash the variables I need to persist across function calls in that type, then stash a pointer to it in .cbWndExtra bytes, properties, or something like that.  However, it seems with this COM programming all the book authors use a good number of globals, and I've just got in the habit of trying to ignore them and look the other way, kind of like what a policeman might do if he sees someone running a stop sign, then realizes its his wife's brother and in the interests of domestic tranquility decides to do nothing about it. 

I did try to eliminate some though and met with a modicum of success.  I got rid of the three Asciiz string variables containing ProgIds and such, and two object variables that were never even instantiated but needed to be declared due to their presence in function parameter lists.  However, the VTables themselves simply seem to have to persist.  So I don't know what else to do with them.  I'll shortly post an updated version of the program, and if anyone has any ideas as to how to eliminate any of the remaining globals, why, I'm all ears!

[Frederick J. Harris]

By the way, why are you using global variables?  Try creating five controls on a form, deleting three of them and
interacting with the remaining two.

Up to this point I had been more interested in just getting the thing to work at all even in the simplest case of just one object being instantiated.  However, I don't think I was completely oblivious to the issue of multiple instantiations.  Every time IClassFactory_CreateInstance() gets called CoTaskMemAlloc() was used to obtain a new and independent allocation for a CD object.  In the CreateControl() method I incremented the global g_CtrlId variable so each window would get a unique Control ID.  However, I hadn't really given it any concerted thought until you mentioned it, and upon examining the situation I found I had to make a couple very minor changes. 

First off, in the FindConnectionPoint::Unadvise() method I had this little nasty...

@g_ptrOutGoing=0

Don't know where or how exactly I came up with that but its now gone.  Also, in the Window Procedure that services any/all controls created I passed the message parameter back to the sink.  If one is interested in which one of several windows the message is coming from that bit of information isn't particularly useful.  So I changed the Call Dword function there to pass the hWnd instead.  Other than that, I believe those were the only changes I made to the control.  Here is the updated control as it now stands...

Code Select Expand


#Compile                              Dll
#Dim                                  All
#Include                              "Win32api.inc"
#Include                              "ObjBase.inc"
#Resource                             "CD.pbr"
Declare Function ptrQueryInterface    (Byval this As Dword Ptr, Byref iid As Guid, Byval pUnknown As Dword) As Long 
Declare Function ptrRelease           (Byval this As Dword Ptr) As Long           
Declare Function ptrControlEvent      (Byval this As Dword Ptr, Byval iMessage As Long) As Long
$IID_IUnknown                         = Guid$("{00000000-0000-0000-C000-000000000046}")
$IID_IClassFactory                    = Guid$("{00000001-0000-0000-C000-000000000046}")
$IID_IConnectionPoint                 = Guid$("{B196B286-BAB4-101A-B69C-00AA00341D07}")
$IID_IConnectionPointContainer        = Guid$("{B196B284-BAB4-101A-B69C-00AA00341D07}")
$CLSID_CD                             = Guid$("{20000000-0000-0000-0000-000000000040}")
$IID_ICOMCtrl                         = Guid$("{20000000-0000-0000-0000-000000000041}")
$IID_IOutGoing                        = Guid$("{20000000-0000-0000-0000-000000000042}")
$IID_LIBID_CD                         = Guid$("{20000000-0000-0000-0000-000000000043}")


Type IComCtrlVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Initialize                          As Dword Ptr
  CreateControl                       As Dword Ptr
  SetColor                            As Dword Ptr
  GetColor                            As Dword Ptr
  GetCtrlId                           As Dword Ptr
  GetHWND                             As Dword Ptr
End Type

Type IComCtrl
  lpVtbl                              As IComCtrlVtbl Ptr
End Type


Type IConnectionPointContainerVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  EnumConnectionPoints                As Dword Ptr
  FindConnectionPoint                 As Dword Ptr
End Type

Type IConnectionPointContainer1
  lpVtbl                              As IConnectionPointContainerVtbl Ptr
End Type


Type IConnectionPointVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  GetConnectionInterface              As Dword Ptr
  GetConnectionPointContainer         As Dword Ptr
  Advise                              As Dword Ptr
  Unadvise                            As Dword Ptr
  EnumConnections                     As Dword Ptr
End Type

Type IConnectionPoint1
  lpVtbl                              As IConnectionPointVtbl Ptr
End Type


Type CD
  lpComCtrlVtbl                       As IComCtrlVtbl Ptr
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr
  lpICPVtbl                           As IConnectionPointVtbl Ptr
  hContainer                          As Dword
  hControl                            As Dword
  m_cRef                              As Long
End Type


Type IEnumConnectionPointsVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Next                                As Dword Ptr
  Skip                                As Dword Ptr
  Reset                               As Dword Ptr
  Clone                               As Dword Ptr
End Type

Type IEnumConnectionPoints1
  lpVtbl                              As IEnumConnectionPointsVtbl Ptr
End Type


Type IEnumConnectionsVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Next                                As Dword Ptr
  Skip                                As Dword Ptr
  Reset                               As Dword Ptr
  Clone                               As Dword Ptr
End Type

Type IEnumConnections1
  lpVtbl                              As IEnumConnectionsVtbl Ptr
End Type


Type IOutGoingVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  ControlEvent                        As Dword Ptr
End Type

Type IOutGoing
  lpVtbl                              As IOutGoingVtbl Ptr
End Type


Type IClassFactoryVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  CreateInstance                      As Dword Ptr
  LockServer                          As Dword Ptr
End Type

Type IClassFactory1
  lpVtbl                              As IClassFactoryVtbl Ptr
End Type


Global CDClassFactory                 As IClassFactory1        'Function Addresses
Global IClassFactory_Vtbl             As IClassFactoryVtbl
Global IComCtrl_Vtbl                  As IComCtrlVtbl
Global IConnPointContainer_Vtbl       As IConnectionPointContainerVtbl
Global IConnPoint_Vtbl                As IConnectionPointVtbl
Global g_hModule                      As Dword                 'Actual Variables
Global g_lLocks                       As Long
Global g_lObjs                        As Long
Global g_CtrlId                       As Long
Global g_ptrOutGoing                  As Dword Ptr


Sub Prnt(strLn As String)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As String
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)     
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Function IComCtrl_QueryInterface(ByVal this As IComCtrl Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  Prnt "      Entering IComCtrl_QueryInterface()"
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      Prnt "        Trying To Get IUnknown"
      Call IComCtrl_AddRef(this)
      @ppv=this
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_ICOMCtrl
      Prnt "        Trying To Get IComCtrl"
      Call IComCtrl_AddRef(this)
      @ppv=this
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPointContainer
      Prnt "        Trying To Get IConnectionPointContainer"   
      Prnt "        this = " & Str$(this) 
      Incr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPoint
      Prnt "        Trying To Get IConnectionPoint"
      Prnt "        this = " & Str$(this) 
      Incr this : Incr this
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      Prnt "        this = " & Str$(this) 
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case Else
      Prnt "        Looking For Something I Ain't Got!"
      Prnt "      Leaving IComCtrl_QueryInterface()" 
  End Select

  Function=%E_NoInterface
End Function


Function IComCtrl_AddRef(ByVal this As IComCtrl Ptr) As Long
  Local pCD As CD Ptr
 
  Prnt "  Entering IComCtrl_AddRef()"
  pCD=this
  Incr @pCD.m_cRef
  Prnt "    @pCD.m_cRef = " & Str$(@pCD.m_cRef)
  Prnt "  Leaving IComCtrl_AddRef()"
 
  IComCtrl_AddRef=@pCD.m_cRef
End Function


Function IComCtrl_Release(ByVal this As IComCtrl Ptr) As Long
  Local pCD As CD Ptr

  Prnt "  Entering IComCtrl_Release()"
  pCD=this
  Prnt "    @pCD.m_cRef = " & Str$(@pCD.m_cRef)
  Decr @pCD.m_cRef
  If @pCD.m_cRef=0 Then
     Call SendMessage(@pCD.hControl,%WM_CLOSE,0,0)
     Call CoTaskMemFree(this)
     Call InterlockedDecrement(g_lObjs)
     Prnt "    @pCD.m_cRef = " & Str$(@pCD.m_cRef)
     Prnt "    CD Was Deleted!"
  End If
  Prnt "  Leaving IComCtrl_Release()"
 
  Function=@pCD.m_cRef
End Function


Function fnWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case As Long Msg
    Case %WM_CREATE
      Call SetWindowLong(hWnd,0,RGB(255,255,0))
      Function=0
      Exit Function
    Case %WM_PAINT
      Local hDC,hNewBrush As Dword
      Local ps As PAINTSTRUCT
      Local rc As RECT
      hDC=BeginPaint(hWnd,ps)
      hNewBrush=CreateSolidBrush(GetWindowLong(hWnd,0))
      Call FillRect(hDC,ps.rcPaint,hNewBrush)
      Call GetClientRect(hWnd,rc)
      Call DrawText(hDC, "Click Me!",-1,rc,%DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER)
      Call DeleteObject(hNewBrush)
      Call EndPaint(hWnd,ps)
      Function=0
      Exit Function
    Case %WM_LBUTTONDOWN
      Local Vtbl As Dword Ptr
      Local hr As Long
      Prnt "WM_LBUTTONDOWN"
      Prnt "g_ptrOutGoing = " & Str$(g_ptrOutGoing)
      Vtbl=@g_ptrOutGoing
      Call Dword @Vtbl[3] Using ptrControlEvent(g_ptrOutGoing, hWnd) To hr
      Function=0
      Exit Function
  End Select

  Function=DefWindowProc(hWnd,Msg,wParam,lParam)
End Function


Function IComCtrl_Initialize(ByVal this As IComCtrl Ptr) As Long
  Local szClassName As Asciiz*16
  Local wc As WndClassEx

  Prnt "  Entering IComCtrl_Initialize()"
  Prnt "    this = " & Str$(this)
  szClassName="ComCtrl"
  wc.cbSize=SizeOf(wc)
  wc.style=%CS_PARENTDC
  wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0
  wc.cbWndExtra=4  'Four extra bytes to store RGB color.
  wc.hInstance=g_hModule
  wc.hIcon=LoadIcon(Byval %NULL, Byval %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)
  wc.hbrBackground=GetStockObject(%WHITE_BRUSH)
  wc.lpszMenuName=%NULL
  wc.lpszClassName=VarPtr(szClassName)
  wc.hIconSm=%NULL
  If RegisterClassEx(wc) Then
     Function=%S_OK
  Else
     Function=%S_FALSE
  End If
  Prnt "  Leaving IComCtrl_Initialize()"
End Function


Function IComCtrl_CreateControl(ByVal this As IComCtrl Ptr, Byval hContainer As Long) As Long
  Local pCD As CD Ptr
  Local hCtl As Dword
  Local rc As RECT

  Prnt "Entering IComCtrl_CreateControl()"
  Prnt "  this = " & Str$(this)
  Call GetClientRect(hContainer,rc)
  hCtl=CreateWindow("ComCtrl","",%WS_CHILD Or %WS_VISIBLE,0,0,rc.nRight,rc.nBottom,hContainer,g_CtrlId,g_hModule,Byval 0)
  Incr g_CtrlId
  pCD=this
  @pCD.hContainer=hContainer
  @pCD.hControl=hCtl
  Call ShowWindow(hCtl,%SW_SHOWNORMAL)
  Call SetFocus(hCtl)
  Prnt "Leaving IComCtrl_CreateControl()"
 
  Function=%S_OK
End Function


Function IComCtrl_SetColor(Byval this As IComCtrl Ptr, Byval iColor As Long) As Long
  Local pCD As CD Ptr
 
  Prnt "Entering IComCtrl_SetColor()"
  pCD=this
  Call SetWindowLong(@pCD.hControl,0,iColor)
  Call InvalidateRect(@pCD.hControl,Byval %NULL, %TRUE)
  Prnt "Leaving IComCtrl_SetColor()"
 
  Function=%S_OK
End Function


Function IComCtrl_GetColor(Byval this As IComCtrl Ptr, Byref ptrColor As Long) As Long
  Local pCD As CD Ptr
 
  pCD=this
  ptrColor=GetWindowLong(@pCD.hControl,0)
 
  Function=%S_OK
End Function


Function IComCtrl_GetCtrlId(Byval this As IComCtrl Ptr, Byref ptrCtrlId As Long) As Long
  Local pCD As CD Ptr
 
  pCD=this
  ptrCtrlId=GetDlgCtrlId(@pCD.hControl)
 
  Function=%S_OK
End Function


Function IComCtrl_GetHWND(Byval this As IComCtrl Ptr, Byref ptrWindowHandle As Long) As Long
  Local pCD As CD Ptr
 
  pCD=this
  ptrWindowHandle=@pCD.hControl
   
  Function=%S_OK
End Function


Function IConnectionPointContainer_QueryInterface(ByVal this As IConnectionPointContainer1 Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  Prnt "      Entering IConnectionPointContainer_QueryInterface()"
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      Decr this
      @ppv=this
      Call IComCtrl_AddRef(this)
      Function=%S_OK
      Exit Function
    Case $IID_ICOMCtrl 
      Decr this
      @ppv=this
      Call IComCtrl_AddRef(this)
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPointContainer
      Call IConnectionPointContainer_AddRef(this)
      @ppv=this
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPoint
      Prnt "      Looking For IID_IConnectionPoint"
      Incr this
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      Prnt "      Leaving IConnectionPointContainer_QueryInterface()"
      Function=%S_OK
      Exit Function
  End Select
 
  Function=%E_NOINTERFACE
End Function


Function IConnectionPointContainer_AddRef(ByVal this As IConnectionPointContainer1 Ptr) As Long
  Local pCD As CD Ptr
 
  Decr this
  pCD=this
  Incr @pCD.m_cRef
 
  Function=@pCD.m_cRef
End Function


Function IConnectionPointContainer_Release(ByVal this As IConnectionPointContainer1 Ptr) As Long
  Local pCD As CD Ptr
 
  Prnt "  Entering IConnectionPointContainer_Release()"
  Decr this
  pCD=this
  Decr @pCD.m_cRef
  If @pCD.m_cRef=0 Then
     Prnt "    @pCD.m_cRef = 0 And Will Now Delete pCD!"
     Call CoTaskMemFree(this)
     Call InterlockedDecrement(g_lObjs)
  End If
  Prnt "  Leaving IConnectionPointContainer_Release()"
 
  Function=@pCD.m_cRef
End Function


Function IConnectionPointContainer_EnumConnectionPoints(ByVal this As IConnectionPointContainer1 Ptr, Byval ppEnum As IEnumConnectionPoints1 Ptr) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPointContainer_FindConnectionPoint(ByVal this As IConnectionPointContainer1 Ptr, ByRef iid As Guid, ByVal ppCP As Dword Ptr) As Long
  Local hr As Long
 
  Prnt "    Entering IConnectionPointContainer_FindConnectionPoint()"
  If iid=$IID_IOutGoing Then
     Prnt "      this  = " & Str$(this)
     Prnt "      @ppCP = " & Str$(@ppCP)
     hr=IConnectionPointContainer_QueryInterface(this, $IID_IConnectionPoint, ppCP)
     Prnt "      @ppCP = " & Str$(@ppCP)
     Prnt "    Leaving IConnectionPointContainer_FindConnectionPoint()"
     Function=hr
     Exit Function
  End If

  Function=%E_NOINTERFACE
End Function


Function IConnectionPoint_QueryInterface(ByVal this As IConnectionPoint1 Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      Decr this : Decr this
      @ppv=this
      Call IComCtrl_AddRef(this)
      Function=%S_OK
      Exit Function
    Case $IID_ICOMCtrl 
      Decr this : Decr this
      @ppv=this
      Call IComCtrl_AddRef(this)
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPointContainer
      Decr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPoint
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      Function=%S_OK
      Exit Function
  End Select
 
  Function=%E_NOINTERFACE
End Function


Function IConnectionPoint_AddRef(ByVal this As IConnectionPoint1 Ptr) As Long
  Local pCD As CD Ptr
 
  Decr this : Decr this
  pCD=this
  Incr @pCD.m_cRef
 
  Function=@pCD.m_cRef
End Function


Function IConnectionPoint_Release(ByVal this As IConnectionPoint1 Ptr) As Long
  Local pCD As CD Ptr

  Prnt "  Entering IConnectionPoint_Release()"
  Decr this : Decr this
  pCD=this
  Decr @pCD.m_cRef
  If @pCD.m_cRef=0 Then
     Prnt "    @pCD.m_cRef = 0 And Will Now Delete pCD!"
     Call CoTaskMemFree(this)
     Call InterlockedDecrement(g_lObjs)
  End If
  Prnt "  Leaving IConnectionPoint_Release()"
   
  Function=@pCD.m_cRef
End Function


Function IConnectionPoint_GetConnectionInterface(Byval this As IConnectionPoint1 Ptr, Byref iid As Guid) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPoint_GetConnectionPointContainer(Byval this As IConnectionPoint1 Ptr, Byval ppCPC As IConnectionPointContainer1 Ptr) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPoint_Advise(Byval this As IConnectionPoint1 Ptr, Byval pUnkSink As Dword Ptr, Byval pdwCookie As Dword Ptr) As Long
  Local Vtbl As Dword Ptr
  Local hr As Long
 
  Prnt "    Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!"
  Prnt "      pUnkSink      = " & Str$(pUnkSink)
  Prnt "      @pUnkSink     = " & Str$(@pUnkSink)
  Vtbl=@pUnkSink
  Prnt "      Vtbl          = " & Str$(Vtbl)
  Prnt "      @Vtbl[0]      = " & Str$(@Vtbl[0])
  Prnt "      g_ptrOutGoing = " & Str$(g_ptrOutGoing) & "  << Before Call Of QueryInterface() On Sink"
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IOutGoing,Varptr(g_ptrOutGoing)) To hr
  Prnt "      g_ptrOutGoing = " & Str$(g_ptrOutGoing) & "  << After Call Of QueryInterface() On Sink"
  If SUCCEEDED(hr) Then
     Prnt "      Call Dword Succeeded!"
     @pdwCookie=1
  Else
     @pdwCookie=0
  End If     
  Prnt "    Leaving IConnectionPoint_Advise() And Still In One Piece!" 
 
  Function=hr
End Function


Function IConnectionPoint_Unadvise(Byval this As IConnectionPoint1 Ptr, Byval dwCookie As Dword) As Long
  Local Vtbl As Dword Ptr
  Local iReturn As Long
 
  Prnt "Entering IConnectionPoint_Unadvise()"
  VTbl=@g_ptrOutGoing
  Call Dword @Vtbl[2] Using ptrRelease(g_ptrOutGoing) To iReturn
  Prnt "  Release() Returned " & Str$(iReturn)
  Prnt "Leaving IConnectionPoint_Unadvise()"
  '@g_ptrOutGoing=0   'this is poison!  get rid of it!
 
  Function=%NOERROR
End Function


Function IConnectionPoint_EnumConnections(Byval this As IConnectionPoint1 Ptr, Byval ppEnum As IEnumConnections1 Ptr) As Long
  Function=%E_NOTIMPL 
End Function


Function IClassFactory_AddRef(ByVal this As IClassFactory1 Ptr) As Long
  Prnt "    Entering IClassFactory_AddRef()"
  Call InterlockedIncrement(g_lObjs)
  Prnt "      g_lObjs = " & Str$(g_lObjs)
  Prnt "    Leaving IClassFactory_AddRef()"
  IClassFactory_AddRef=g_lObjs
End Function


Function IClassFactory_Release(ByVal this As IClassFactory1 Ptr) As Long
  Prnt "    Entering IClassFactory_Release()"
  Call InterlockedDecrement(g_lObjs)
  Prnt "      g_lObjs = " & Str$(g_lObjs)
  Prnt "    Leaving IClassFactory_Release()"
  IClassFactory_Release=g_lObjs
End Function


Function IClassFactory_QueryInterface(ByVal this As IClassFactory1 Ptr, ByRef RefIID As Guid, ByVal pCF As Dword Ptr) As Long
  Prnt "  Entering IClassFactory_QueryInterface()"
  @pCF=0
  If RefIID=$IID_IUnknown Or RefIID=$IID_IClassFactory Then
     Call IClassFactory_AddRef(this)
     @pCF=this
     Prnt "    this = " & Str$(this)
     Prnt "  Leaving IClassFactory_QueryInterface()"
     Function=%NOERROR
     Exit Function
  End If
  Prnt "  Leaving IClassFactory_QueryInterface() Empty Handed!"

  Function=%E_NoInterface
End Function


Function IClassFactory_CreateInstance(ByVal this As IClassFactory1 Ptr, ByVal pUnknown As Dword, ByRef RefIID As Guid, Byval ppv As Dword Ptr) As Long
  Local pComCtrl As IComCtrl Ptr
  Local pCD As CD Ptr
  Local hr As Long

  Prnt "  Entering IClassFactory_CreateInstance()"
  @ppv=%NULL
  If pUnknown Then
     hr=%CLASS_E_NOAGGREGATION
  Else
     pCD=CoTaskMemAlloc(SizeOf(CD))
     Prnt "    pCD                        = " & Str$(pCD)
     If pCD Then
        @pCD.lpComCtrlVtbl = VarPtr(IComCtrl_Vtbl)
        @pCD.lpICPCVtbl    = VarPtr(IConnPointContainer_Vtbl)
        @pCD.lpICPVtbl     = Varptr(IConnPoint_Vtbl)
        Prnt "    Varptr(@pCD.lpComCtrlVtbl) = " & Str$(Varptr(@pCD.lpComCtrlVtbl))
        Prnt "    Varptr(@pCD.lpICPCVtbl)    = " & Str$(Varptr(@pCD.lpICPCVtbl))
        Prnt "    Varptr(@pCD.lpICPVtbl)     = " & Str$(Varptr(@pCD.lpICPVtbl))
        @pCD.m_cRef=0
        @pCD.hContainer=0 : @pCD.hControl=0
        pComCtrl=pCD
        Prnt "    @ppv                       = " & Str$(@ppv) & "  << Before QueryInterface() Call"
        hr= IComCtrl_QueryInterface(pComCtrl,RefIID,ppv)
        Prnt "    @ppv                       = " & Str$(@ppv) & "  << After QueryInterface() Call"
        If SUCCEEDED(hr) Then
           Call InterlockedIncrement(g_lObjs)
        Else
           Call CoTaskMemFree(pCD)
        End If
     Else
        hr=%E_OutOfMemory
     End If
  End If
  Prnt "  Leaving IClassFactory_CreateInstance()"

  IClassFactory_CreateInstance=hr
End Function


Function IClassFactory_LockServer(ByVal this As IClassFactory1 Ptr, Byval flock As Long) As Long
  If flock Then
     Call InterlockedIncrement(g_lLocks)
  Else
     Call InterlockedDecrement(g_lLocks)
  End If

  IClassFactory_LockServer=%NOERROR
End Function


Function DllCanUnloadNow Alias "DllCanUnloadNow" () Export As Long
  Prnt "Entering DllCanUnloadNow()"
  If g_lObjs = 0 And g_lLocks = 0 Then
     Prnt "  I'm Outta Here!"
     Function=%S_OK
  Else
     Prnt "  The System Wants Rid Of Me But I Won't Go!"
     Function=%S_FALSE
  End If
  Prnt "Leaving DllCanUnloadNow()"
End Function


Function DllGetClassObjectImpl Alias "DllGetClassObject" (ByRef RefClsid As Guid, ByRef iid As Guid, ByVal pClassFactory As Dword Ptr) Export As Long
  Local hr As Long

  Prnt "Entering DllGetClassObjectImpl()"
  If RefClsid=$CLSID_CD Then
     IClassFactory_Vtbl.QueryInterface               = CodePtr(IClassFactory_QueryInterface)
     IClassFactory_Vtbl.AddRef                       = CodePtr(IClassFactory_AddRef)
     IClassFactory_Vtbl.Release                      = CodePtr(IClassFactory_Release)
     IClassFactory_Vtbl.CreateInstance               = CodePtr(IClassFactory_CreateInstance)
     IClassFactory_Vtbl.LockServer                   = CodePtr(IClassFactory_LockServer)
     CDClassFactory.lpVtbl                           = VarPtr(IClassFactory_Vtbl)
     
     IComCtrl_Vtbl.QueryInterface                    = CodePtr(IComCtrl_QueryInterface)
     IComCtrl_Vtbl.AddRef                            = CodePtr(IComCtrl_AddRef)
     IComCtrl_Vtbl.Release                           = CodePtr(IComCtrl_Release)
     IComCtrl_Vtbl.Initialize                        = CodePtr(IComCtrl_Initialize)
     IComCtrl_Vtbl.CreateControl                     = CodePtr(IComCtrl_CreateControl)
     IComCtrl_Vtbl.SetColor                          = CodePtr(IComCtrl_SetColor)
     IComCtrl_Vtbl.GetColor                          = CodePtr(IComCtrl_GetColor)
     IComCtrl_Vtbl.GetCtrlId                         = CodePtr(IComCtrl_GetCtrlId)
     IComCtrl_Vtbl.GetHWND                           = CodePtr(IComCtrl_GetHWND)
     
     IConnPointContainer_Vtbl.QueryInterface         = CodePtr(IConnectionPointContainer_QueryInterface)
     IConnPointContainer_Vtbl.AddRef                 = CodePtr(IConnectionPointContainer_AddRef)
     IConnPointContainer_Vtbl.Release                = CodePtr(IConnectionPointContainer_Release)
     IConnPointContainer_Vtbl.EnumConnectionPoints   = CodePtr(IConnectionPointContainer_EnumConnectionPoints)
     IConnPointContainer_Vtbl.FindConnectionPoint    = CodePtr(IConnectionPointContainer_FindConnectionPoint)
     
     IConnPoint_Vtbl.QueryInterface                  = CodePtr(IConnectionPoint_QueryInterface)
     IConnPoint_Vtbl.AddRef                          = CodePtr(IConnectionPoint_AddRef)
     IConnPoint_Vtbl.Release                         = CodePtr(IConnectionPoint_Release)
     IConnPoint_Vtbl.GetConnectionInterface          = CodePtr(IConnectionPoint_GetConnectionInterface)
     IConnPoint_Vtbl.GetConnectionPointContainer     = CodePtr(IConnectionPoint_GetConnectionPointContainer)
     IConnPoint_Vtbl.Advise                          = CodePtr(IConnectionPoint_Advise)
     IConnPoint_Vtbl.Unadvise                        = CodePtr(IConnectionPoint_Unadvise)
     IConnPoint_Vtbl.EnumConnections                 = CodePtr(IConnectionPoint_EnumConnections)
     
     hr=IClassFactory_QueryInterface(VarPtr(CDClassFactory),iid,pClassFactory)
     If FAILED(hr) Then
        pClassFactory=0
        hr=%CLASS_E_CLASSNOTAVAILABLE
     Else
        Prnt "  IClassFactory_QueryInterface() For iid Succeeded!"   
     End If
  End If
  Prnt "Leaving DllGetClassObjectImpl()"

  Function=hr
End Function


Function SetKeyAndValue(Byref szKey As Asciiz, Byref szSubKey As Asciiz, Byref szValue As Asciiz) As Long
  Local szKeyBuf As Asciiz*1024
  Local lResult As Long
  Local hKey As Dword

  If szKey<>"" Then
     szKeyBuf=szKey
     If szSubKey<>"" Then
        szKeyBuf=szKeyBuf+"\"+szSubKey
     End If
     lResult=RegCreateKeyEx(%HKEY_CLASSES_ROOT,szKeyBuf,0,Byval %NULL,%REG_OPTION_NON_VOLATILE,%KEY_ALL_ACCESS,Byval %NULL,hKey,%NULL)
     If lResult<>%ERROR_SUCCESS Then
        Function=%FALSE
        Exit Function
     End If
     If szValue<>"" Then
        Call RegSetValueEx(hKey,Byval %NULL, Byval 0, %REG_SZ, szValue, Len(szValue)+1)
     End If
     Call RegCloseKey(hKey)
  Else
     Function=%FALSE
     Exit Function
  End If

  Function=%TRUE
End Function


Function RecursiveDeleteKey(Byval hKeyParent As Dword, Byref lpszKeyChild As Asciiz) As Long
  Local dwSize,hKeyChild As Dword
  Local szBuffer As Asciiz*256
  Local time As FILETIME
  Local lRes As Long

  dwSize=256
  lRes=RegOpenKeyEx(hKeyParent,lpszKeyChild,0,%KEY_ALL_ACCESS,hKeyChild)
  If lRes<>%ERROR_SUCCESS Then
     Function=lRes
     Exit Function
  End If
  While(RegEnumKeyEx(hKeyChild,0,szBuffer,dwSize,0,Byval 0,Byval 0,time)=%S_OK)
    lRes=RecursiveDeleteKey(hKeyChild,szBuffer)  'Delete the decendents of this child.
    If lRes<>%ERROR_SUCCESS Then
       Call RegCloseKey(hKeyChild)
       Function=lRes
       Exit Function
    End If
    dwSize=256
  Loop
  Call RegCloseKey(hKeyChild)

  Function=RegDeleteKey(hKeyParent,lpszKeyChild)  'Delete this child.
End Function


Function RegisterServer(Byref szFileName As Asciiz, Byref ClassId As Guid, Byref LibId As Guid, Byref szFriendlyName As Asciiz, Byref szVerIndProgID As Asciiz, Byref szProgID As Asciiz) As Long
  Local szClsid As Asciiz*48, szLibid As Asciiz*48, szKey As Asciiz*64
  Local iReturn As Long

  szClsid=GuidTxt$(ClassId)
  szLibid=GuidTxt$(LibId)
  If szClsid <> "" And szLibid <> "" Then
     szKey="CLSID\" & szClsid
     If IsFalse(SetKeyAndValue(szKey, Byval %NULL, szFriendlyName)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "InprocServer32", szFileName)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "ProgID", szProgID)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "VersionIndependentProgID", szVerIndProgID)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "TypeLib", szLibid)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szVerIndProgID,Byval %NULL, szFriendlyName)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szVerIndProgID, "CLSID", szClsid)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szVerIndProgID, "CurVer", szProgID)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szProgID, Byval %NULL, szFriendlyName)) Then
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szProgID, "CLSID", szClsid)) Then
        Function=%E_FAIL : Exit Function
     End If
     Function=%S_OK
     Exit Function
  Else
     Function=%E_FAIL
     Exit Function
  End If
End Function


Function UnregisterServer(Byref ClassId As Guid, Byref szVerIndProgID As Asciiz, Byref szProgID As Asciiz) As Long
  Local szClsid As Asciiz*48, szKey As Asciiz*64
  Local lResult As Long

  szClsid=GuidTxt$(ClassId)
  If szClsid<>"" Then
     szKey="CLSID\"+szClsid
     lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT,szKey)
     If lResult<>%ERROR_SUCCESS Then
        Function=%E_FAIL
        Exit Function
     End If
     lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT, szVerIndProgID)    'Delete the version-independent ProgID Key.
     If lResult<>%ERROR_SUCCESS Then
        Function=%E_FAIL
        Exit Function
     End If
     lResult=recursiveDeleteKey(%HKEY_CLASSES_ROOT, szProgID)          'Delete the ProgID key.
     If lResult<>%ERROR_SUCCESS Then
        Function=%E_FAIL
        Exit Function
     End If
  Else
     Function=%E_FAIL
     Exit Function
  End If

  Function=%S_OK
End Function


Function DllRegisterServer Alias "DllRegisterServer" () Export As Long
  Local szFriendlyName As Asciiz*16, szVerIndProgID As Asciiz*16, szProgID As Asciiz*16
  Local strAsciPath,strWideCharPath,strPath As String
  Local hr,iBytesReturned As Long
  Local szPath As Asciiz*256
  Local pTypeLib As ITypeLib
 
  If GetModuleFileName(g_hModule, szPath, 256) Then
     strPath=szPath
     strAsciPath=szPath
     strWideCharPath=UCode$(strAsciPath & $Nul)
     hr=LoadTypeLibEx(Strptr(strWideCharPath), %REGKIND_REGISTER, pTypeLib)
     If SUCCEEDED(hr) Then
        Set pTypeLib    = Nothing
        szFriendlyName  =  "Com Control CD"
        szVerIndProgID  =  "ComCtrl.CD"
        szProgID        =  "ComCtrl.CD.1"
        hr=RegisterServer(szPath, $CLSID_CD, $IID_LIBID_CD, szFriendlyName, szVerIndProgID, szProgID)
     Else
        Local dwFlags As Dword
        Local szError As Asciiz*256
        Local strError As String
        iBytesReturned=FormatMessage(dwFlags,Byval 0,hr,MAKELANGID(%LANG_NEUTRAL,%SUBLANG_DEFAULT),Byval Varptr(szError),256,Byval %NULL)
        If iBytesReturned=0 Then
           iBytesReturned=MsgBox("...And That Is To Use PBTyp.exe To Embed The Type Library In The Exe!", %MB_ICONWARNING, "I Know What You Forgot...")
        End If
        strError=szError
     End If
  End If

  Function=hr
End Function


Function DllUnregisterServer Alias "DllUnregisterServer" () Export As Long
  Local szVerIndProgID As Asciiz*16, szProgID As Asciiz*16
  Local hr As Long

  hr=UnRegisterTypeLib($IID_LIBID_CD, 1, 0, %LANG_NEUTRAL, %SYS_WIN32)
  If SUCCEEDED(hr) Then
     szVerIndProgID  =  "ComCtrl.CD"
     szProgID        =  "ComCtrl.CD.1"
     hr=UnregisterServer($CLSID_CD, szVerIndProgID, szProgID)
  Else
     MsgBox("UnRegisterTypeLib() Failed!")
  End If
 
  Function=hr
End Function               


Function DllMain(ByVal hInstance As Long, ByVal fwdReason As Long, ByVal lpvReserved As Long) Export As Long
  If fwdReason=%DLL_PROCESS_ATTACH Then
     Call DisableThreadLibraryCalls(hInstance)
     g_hModule         =  hInstance
     g_CtrlId          =  1500
  End If

  DllMain=%TRUE
End Function


[Frederick J. Harris]

In terms of that code, the first client I coded to test it was a C++ one and I modified my earlier C++ example I believe in post #5 of this thread to contain two controls, one under the other.  So I made the parent form higher and wider.  Associated with each control on the left were the three buttons to turn it blue, green, or red.  Then on the right of each control I put another button to kill that particular control.  What I wanted to test was what would happen if I killed one control and attempted to interact with its buttons or the other control.  I trust that whatever ill would result from your example of creating five controls, deleting three, then interacting with the remaining two would occur by creating two and deleting one.  I did have a fair bit of trouble with it but the trouble all involved my client/host - not the control.  I used the same sink for both controls.  Anyway, here is that C++ code followed by the console screen output.  I particularly like the C++ version because I'm picking up all the events right from entering my WM_CREATE handler in the client to the DllUnload event in the COM object.  The output is right after this Main.cpp code, and reflects a scenerio where I destroyed one of the controls, interacted with what's left, then x'ed out...

Code Select Expand


//Main.cpp
#include <windows.h>
#include <tchar.h>
#include <fcntl.h>
#include <io.h>       
#include <stdio.h>
#include <ocidl.h>
#include "Main.h"
#include "CSink.h"
extern "C" const    CLSID CLSID_CD      ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40}};
extern "C" const    IID   IID_ICOMCtrl  ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x41}};
extern "C" const    IID   IID_IOutGoing ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x42}};
IConnectionPointContainer* pConnectionPointContainer1=NULL;
IConnectionPointContainer* pConnectionPointContainer2=NULL;
IConnectionPoint* pConnectionPoint1=NULL;   
IConnectionPoint* pConnectionPoint2=NULL;   
EVENTHANDLER EventHandler[3];
ICOMCtrl* pComCtrl1=NULL;
ICOMCtrl* pComCtrl2=NULL;
DWORD dwCookie1=NULL;
DWORD dwCookie2=NULL;
CSink* mySink=NULL;                                               


long fnWndProc_OnCreate(lpWndEventArgs Wea)           
{
HWND hButton,hContainer1,hContainer2;
IClassFactory* pCF=NULL;
HRESULT hr;
FILE* hf;
int hCrt; 
                                                     
Wea->hIns=((LPCREATESTRUCT)Wea->lParam)->hInstance;
AllocConsole();
hCrt=_open_osfhandle((long)GetStdHandle(STD_OUTPUT_HANDLE),_O_TEXT);
hf = _fdopen( hCrt, "w" );
_iob[1]=*hf;
printf(_T("Entering fnWndProc_OnCreate()\n"));
hr=CoInitialize(NULL);
if(SUCCEEDED(hr))
{
    printf("  CoInitialize() Succeeded!\n");
    hr=CoGetClassObject(CLSID_CD,CLSCTX_INPROC_SERVER,NULL,IID_IClassFactory,(void**)&pCF);
    if(SUCCEEDED(hr))
    {
       printf("  CoGetClassObject() Succeeded!  We Now Have A IClassFactory Pointer!\n");
       hr=pCF->CreateInstance(NULL,IID_ICOMCtrl,(void**)&pComCtrl1);
       if(SUCCEEDED(hr))
       {
          printf("    pCF->CreateInstance() Succeeded!\n");
          hr=pComCtrl1->Initialize();
          if(SUCCEEDED(hr))
          {
             printf("  pComCtrl->Initialize() Succeeded!\n");
             hButton=CreateWindowEx(0,"button","Blue",WS_CHILD|WS_VISIBLE,8,10,80,25,Wea->hWnd,(HMENU)IDC_BUTTON1,Wea->hIns,0);
             hButton=CreateWindowEx(0,"button","Green",WS_CHILD|WS_VISIBLE,8,40,80,25,Wea->hWnd,(HMENU)IDC_BUTTON2,Wea->hIns,0);
             hButton=CreateWindowEx(0,"button","Red",WS_CHILD|WS_VISIBLE,8,70,80,25,Wea->hWnd,(HMENU)IDC_BUTTON3,Wea->hIns,0);
             hContainer1=CreateWindowEx(WS_EX_CLIENTEDGE,_T("static"),_T(""),WS_CHILD|WS_VISIBLE|WS_THICKFRAME,100,12,275,80,Wea->hWnd,(HMENU)1600,Wea->hIns,0);
             hButton=CreateWindowEx(0,"button","Kill #1",WS_CHILD|WS_VISIBLE,385,40,80,25,Wea->hWnd,(HMENU)IDC_KILL_CTL1,Wea->hIns,0);
             hr=pComCtrl1->QueryInterface(IID_IConnectionPointContainer,(void**)&pConnectionPointContainer1);
             if(SUCCEEDED(hr))
             {
                printf("  Got pConnectionPointContainer1 = %u\n",pConnectionPointContainer1);
                hr = pConnectionPointContainer1->FindConnectionPoint(IID_IOutGoing, &pConnectionPoint1);
                if(SUCCEEDED(hr))
                {
                   printf("  Got pConnectionPoint1 = %u\n",pConnectionPoint1);
                   mySink = new CSink;
                   printf("  mySink = %u\n",mySink);
                   hr=pConnectionPoint1->Advise((IUnknown*)mySink, &dwCookie1);
                   if(SUCCEEDED(hr))
                   {
                      printf("  pConnectionPoint1->Advise() Succeeded!\n");
                      hr=pComCtrl1->CreateControl((int)hContainer1);
                      if(SUCCEEDED(hr))
                         printf("  pComCtrl1->CreateControl(hContainer) Succeeded!\n");
                      else
                      {
                         printf("  pComCtrl1->CreateControl(hContainer) Failed!\n");
                         return 0;
                      }
                   }
                   else
                   {
                      puts("  pConnectionPoint1->Advise() Failed!");
                      return 0;
                   }
                }
                else
                {
                   printf("  Failed To Get pConnectionPoint1!\n");
                   return 0;
                }
             }
             else
             {
                printf("  Failed To Get IConnectionPointContainer*\n");
                return 0;
             }
          }
          else
          {
             printf("pComCtrl1->Initialize() Failed!\n");
             return 0;
          }
       }
       else
       {
          printf("    pCF->CreateInstance() Failed!\n");
          return 0;
       }


       hContainer2=CreateWindowEx(WS_EX_CLIENTEDGE,_T("static"),_T(""),WS_CHILD|WS_VISIBLE|WS_THICKFRAME,100,110,275,80,Wea->hWnd,(HMENU)1605,Wea->hIns,0);
       hButton=CreateWindowEx(0,"button","Blue",WS_CHILD|WS_VISIBLE,8,110,80,25,Wea->hWnd,(HMENU)IDC_BUTTON4,Wea->hIns,0);
       hButton=CreateWindowEx(0,"button","Green",WS_CHILD|WS_VISIBLE,8,140,80,25,Wea->hWnd,(HMENU)IDC_BUTTON5,Wea->hIns,0);
       hButton=CreateWindowEx(0,"button","Red",WS_CHILD|WS_VISIBLE,8,170,80,25,Wea->hWnd,(HMENU)IDC_BUTTON6,Wea->hIns,0);
       hButton=CreateWindowEx(0,"button","Kill #2",WS_CHILD|WS_VISIBLE,385,140,80,25,Wea->hWnd,(HMENU)IDC_KILL_CTL2,Wea->hIns,0);
       hr=pCF->CreateInstance(NULL,IID_ICOMCtrl,(void**)&pComCtrl2);
       if(SUCCEEDED(hr))
       {
          printf("    pCF->CreateInstance() For pComCtrl2 Succeeded!\n");
          hr=pComCtrl2->CreateControl((int)hContainer2);
          if(SUCCEEDED(hr))
          {
             printf("    pComCtrl2->CreateControl((int)hContainer2) Succeeded!\n");
             hr=pComCtrl2->QueryInterface(IID_IConnectionPointContainer,(void**)&pConnectionPointContainer2);
             if(SUCCEEDED(hr))
             {
                printf("  Got pConnectionPointContainer2 = %u\n",pConnectionPointContainer2);
                hr = pConnectionPointContainer2->FindConnectionPoint(IID_IOutGoing, &pConnectionPoint2);
                if(SUCCEEDED(hr))
                {
                   printf("  Got pConnectionPoint2 = %u\n",pConnectionPoint2);
                   hr=pConnectionPoint2->Advise((IUnknown*)mySink, &dwCookie2);
                   if(SUCCEEDED(hr))
                   {
                      printf("  pConnectionPoint2->Advise() Succeeded!\n");
                   }
                   else
                   {
                      puts("  pConnectionPoint1->Advise() Failed!");
                      return 0;
                   }
                }
                else
                {
                   printf("  Couldn't Get pConnectionPoint2!\n");
                }
             }
             else
             {
                printf("  Failed To Get pConnectionPointContainer2!\n");
             }
          }
          else
          {
             printf("    pComCtrl2->CreateControl((int)hContainer2) Failed!\n");   
          }
       }
       else
       {
          printf("    pCF->CreateInstance() For pComCtrl2 Failed!\n");
       }
       pCF->Release();
    }
    else
       printf("  CoGetClassObject() Failed!\n");
}
else
    printf(_T("  CoInitialize() Failed!\n"));
printf(_T("Leaving fnWndProc_OnCreate()\n\n"));

return 0;
}


long fnWndProc_OnCommand(lpWndEventArgs Wea)
{
switch(LOWORD(Wea->wParam))
{
   case IDC_BUTTON1:  //Blue
     if(pComCtrl1)
        pComCtrl1->SetColor((int)RGB(0,0,255));
     break;
   case IDC_BUTTON2:  //Green
     if(pComCtrl1)
        pComCtrl1->SetColor((int)RGB(0,255,0));
     break;
   case IDC_BUTTON3:  //Red
     if(pComCtrl1)
        pComCtrl1->SetColor((int)RGB(255,0,0));
     break;
   case IDC_KILL_CTL1:
     printf("\nEntering fnWndProc_OnCommand() : Case IDC_KILL_CTL1\n");
     if(pComCtrl1)
     {
        printf("  pComCtrl1 = %u\n",(unsigned)pComCtrl1);
        printf("  The Control Apparently Exists, And Will ow Be Destroyed!\n");
        if(dwCookie1 && pConnectionPoint1)
        {
           pConnectionPoint1->Unadvise(dwCookie1);
           dwCookie1=0;
        }
        if(pConnectionPoint1)
        {
           pConnectionPoint1->Release();
           pConnectionPoint1=0;
        }
        if(pConnectionPointContainer1)
        {
           pConnectionPointContainer1->Release();
           pConnectionPointContainer1=0;
        }
        pComCtrl1->Release();
        pComCtrl1=0;
     }
     printf("Leaving fnWndProc_OnCommand() : Case IDC_KILL_CTL1\n\n");
     break;
   case IDC_BUTTON4:  //Blue
     if(pComCtrl2)
        pComCtrl2->SetColor((int)RGB(0,0,255));
     break;
   case IDC_BUTTON5:  //Green
     if(pComCtrl2)
        pComCtrl2->SetColor((int)RGB(0,255,0));
     break;
   case IDC_BUTTON6:  //Red
     if(pComCtrl2)
        pComCtrl2->SetColor((int)RGB(255,0,0));
     break;
   case IDC_KILL_CTL2:
     printf("\nEntering fnWndProc_OnCommand() : Case IDC_KILL_CTL2\n");
     if(pComCtrl2)
     {
        printf("  pComCtrl2 = %u\n",(unsigned)pComCtrl2);
        printf("  The Control Apparently Exists, And Will ow Be Destroyed!\n");
        if(dwCookie2 && pConnectionPoint2)
        {
           pConnectionPoint2->Unadvise(dwCookie2);
           dwCookie2=0;
        }
        if(pConnectionPoint2)
        {
           pConnectionPoint2->Release();
           pConnectionPoint2=0;
        }
        if(pConnectionPointContainer2)
        {
           pConnectionPointContainer2->Release();
           pConnectionPointContainer2=0;
        }
        pComCtrl2->Release();
        pComCtrl2=0;
     }
     printf("Leaving fnWndProc_OnCommand() : Case IDC_KILL_CTL2\n\n");
     break;
}

return 0;
}


long fnWndProc_OnClose(lpWndEventArgs Wea)           
{
printf(_T("Entering fnWndProc_OnClose()\n"));

//1st Deal With 1st Object...
if(dwCookie1 && pConnectionPoint1)
{
    pConnectionPoint1->Unadvise(dwCookie1);
    dwCookie1=0;
}
if(pConnectionPoint1)
    pConnectionPoint1->Release();
if(pConnectionPointContainer1)
    pConnectionPointContainer1->Release();
if(pComCtrl1)
{
    printf("\n\nGot In Where pComCtrl Is True!!!\n\n");
    pComCtrl1->Release();
}
else
{
    printf("\n\npComCtrl Is FALSE!!!!!!!!!!!!!!\n\n");
}

//...Then With 2nd...
if(dwCookie2 && pConnectionPoint2)
{
    pConnectionPoint2->Unadvise(dwCookie2);
    dwCookie2=0;
}
if(pConnectionPoint2)
    pConnectionPoint2->Release();
if(pConnectionPointContainer2)
    pConnectionPointContainer2->Release();
if(pComCtrl2)
{
    printf("\n\nGot In Where pComCtr2 Is True!!!\n\n");
    pComCtrl2->Release();
}
else
{
    printf("\n\npComCtr2 Is FALSE!!!!!!!!!!!!!!\n\n");
}

printf(_T("Leaving fnWndProc_OnClose()\n\n"));   
CoUninitialize();
MessageBox
(
  Wea->hWnd,
  _T("Have Just Released Object!  You Can Copy The Output From The Console If You Want Though!"),
  _T("Will Close App!"),
  MB_OK
);
DestroyWindow(Wea->hWnd);
PostQuitMessage(0);
                                 
return 0;                                           
}


void AttachEventHandlers(void)         //This procedure maps windows messages to the
{                                      //procedure which handles them.
EventHandler[0].Code=WM_CREATE,       EventHandler[0].fnPtr=fnWndProc_OnCreate;
EventHandler[1].Code=WM_COMMAND,      EventHandler[1].fnPtr=fnWndProc_OnCommand;
EventHandler[2].Code=WM_CLOSE,        EventHandler[2].fnPtr=fnWndProc_OnClose;
}


long __stdcall fnWndProc(HWND hwnd, unsigned int msg, WPARAM wParam,LPARAM lParam)
{
WndEventArgs Wea;                  //This procedure loops through the EVENTHANDER array
                                    //of structs to try to make a match with the msg parameter
for(unsigned int i=0; i<3; i++)    //of the WndProc.  If a match is made the event handling
{                                  //procedure is called through a function pointer -
     if(EventHandler[i].Code==msg)  //(EventHandler[i].fnPtr).  If no match is found the
     {                              //msg is passed onto DefWindowProc().
        Wea.hWnd=hwnd, Wea.lParam=lParam, Wea.wParam=wParam;
        return (*EventHandler[i].fnPtr)(&Wea);
     }
}

return (DefWindowProc(hwnd, msg, wParam, lParam));
}


int __stdcall WinMain(HINSTANCE hIns, HINSTANCE hPrevIns, LPSTR lpszArgument, int iShow)
{
TCHAR szClassName[]=_T("Form1");
WNDCLASSEX wc;
MSG messages;
HWND hWnd;

AttachEventHandlers();
wc.lpszClassName=szClassName;                         wc.lpfnWndProc=fnWndProc;
wc.cbSize=sizeof (WNDCLASSEX);                        wc.style=CS_DBLCLKS;
wc.hIcon=LoadIcon(NULL,IDI_APPLICATION);              wc.hInstance=hIns;
wc.hIconSm=LoadIcon(NULL, IDI_APPLICATION);           wc.hCursor=LoadCursor(NULL,IDC_ARROW);
wc.hbrBackground=(HBRUSH)COLOR_BTNSHADOW;             wc.cbWndExtra=0;
wc.lpszMenuName=NULL;                                 wc.cbClsExtra=0;
RegisterClassEx(&wc);
hWnd=CreateWindowEx(0,szClassName,szClassName,WS_OVERLAPPEDWINDOW,400,550,500,240,HWND_DESKTOP,0,hIns,0);
ShowWindow(hWnd,iShow);
while(GetMessage(&messages,NULL,0,0))
{
    TranslateMessage(&messages);
    DispatchMessage(&messages);
}

return messages.wParam;
}

/*
Entering fnWndProc_OnCreate()
  CoInitialize() Succeeded!

  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  9746228
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_AddRef()
    g_lObjs =  2
  Leaving IClassFactory_AddRef()

  Entering IClassFactory_Release()
    g_lObjs =  1
  Leaving IClassFactory_Release()

  Entering IClassFactory_QueryInterface()
    Entering IClassFactory_AddRef()
      g_lObjs =  2
    Leaving IClassFactory_AddRef()
    this =  9746228
  Leaving IClassFactory_QueryInterface()
   
  Entering IClassFactory_Release()
    g_lObjs =  1
  Leaving IClassFactory_Release()

  CoGetClassObject() Succeeded!  We Now Have A IClassFactory Pointer!
 
  Entering IClassFactory_CreateInstance()
    pCD                        =  1396744
    Varptr(@pCD.lpComCtrlVtbl) =  1396744
    Varptr(@pCD.lpICPCVtbl)    =  1396748
    Varptr(@pCD.lpICPVtbl)     =  1396752
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IComCtrl_QueryInterface()
      Trying To Get IComCtrl
      Entering IComCtrl_AddRef()
        @pCD.m_cRef =  1
      Leaving IComCtrl_AddRef()
      this =  1396744
    Leaving IComCtrl_QueryInterface()
    @ppv                       =  1396744  << After QueryInterface() Call
  Leaving IClassFactory_CreateInstance()
 
  pCF->CreateInstance() Succeeded!

  Entering IComCtrl_Initialize()
    this =  1396744
  Leaving IComCtrl_Initialize()

  pComCtrl->Initialize() Succeeded!

  Entering IComCtrl_QueryInterface()
    Trying To Get IConnectionPointContainer
      this =  1396744
      this =  1396748
  Leaving IComCtrl_QueryInterface()

  Got pConnectionPointContainer1 = 1396748
 
  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  1396748
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
    Looking For IID_IConnectionPoint
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  1396752
  Leaving IConnectionPointContainer_FindConnectionPoint()
 
  Got pConnectionPoint1 = 1396752

  Entering CSink Constructor!
    this = 8849240
  Leaving CSink Constructor!
 
  mySink = 8849240
 
  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    pUnkSink      =  8849240
    @pUnkSink     =  4227344
    Vtbl          =  4227344
    @Vtbl[0]      =  4198656
    g_ptrOutGoing =  0  << Before Call Of QueryInterface() On Sink
    Called CSink::QueryInterface() -- this = 8849240
    Client: CSink::QueryInterface() for IOutGoing  -- this = 8849240
    *ppv = 8849240
    Entering CSink::AddRef()
      this->m_cRef = 1
    Leaving CSink::AddRef()
    g_ptrOutGoing =  8849240  << After Call Of QueryInterface() On Sink
    Call Dword Succeeded!
  Leaving IConnectionPoint_Advise() And Still In One Piece!
 
  pConnectionPoint1->Advise() Succeeded!

  Entering IComCtrl_CreateControl()
    this =  1396744
  Leaving IComCtrl_CreateControl()
 
  pComCtrl1->CreateControl(hContainer) Succeeded!
 
  Entering IClassFactory_CreateInstance()
    pCD                        =  1400160
    Varptr(@pCD.lpComCtrlVtbl) =  1400160
    Varptr(@pCD.lpICPCVtbl)    =  1400164
    Varptr(@pCD.lpICPVtbl)     =  1400168
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IComCtrl_QueryInterface()
      Trying To Get IComCtrl
    Entering IComCtrl_AddRef()
    @pCD.m_cRef =  1
    Leaving IComCtrl_AddRef()
      this =  1400160
    Leaving IComCtrl_QueryInterface()
    @ppv                       =  1400160  << After QueryInterface() Call
  Leaving IClassFactory_CreateInstance()
   
  pCF->CreateInstance() For pComCtrl2 Succeeded!

  Entering IComCtrl_CreateControl()
    this =  1400160
  Leaving IComCtrl_CreateControl()
 
  pComCtrl2->CreateControl((int)hContainer2) Succeeded!

  Entering IComCtrl_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  1400160
    this =  1400164
  Leaving IComCtrl_QueryInterface()

  Got pConnectionPointContainer2 = 1400164

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  1400164
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
      Looking For IID_IConnectionPoint
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  1400168
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Got pConnectionPoint2 = 1400168

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    pUnkSink      =  8849240
    @pUnkSink     =  4227344
    Vtbl          =  4227344
    @Vtbl[0]      =  4198656
    g_ptrOutGoing =  8849240  << Before Call Of QueryInterface() On Sink
    Called CSink::QueryInterface() -- this = 8849240
    Client: CSink::QueryInterface() for IOutGoing  -- this = 8849240
    *ppv = 8849240
    Entering CSink::AddRef()
      this->m_cRef = 2
    Leaving CSink::AddRef()
    g_ptrOutGoing =  8849240  << After Call Of QueryInterface() On Sink
    Call Dword Succeeded!
  Leaving IConnectionPoint_Advise() And Still In One Piece!
 
  pConnectionPoint2->Advise() Succeeded!
 
  Entering IClassFactory_Release()
    g_lObjs =  2
  Leaving IClassFactory_Release()
Leaving fnWndProc_OnCreate()

Entering IComCtrl_SetColor()
Leaving IComCtrl_SetColor()
Entering IComCtrl_SetColor()
Leaving IComCtrl_SetColor()

Entering fnWndProc_OnCommand() : Case IDC_KILL_CTL1
  pComCtrl1 = 1396744
  The Control Apparently Exists, And Will ow Be Destroyed!
  Entering IConnectionPoint_Unadvise()
    Entering CSink::Release()
      this = 8849240
      m_cRef != 0 : m_cRef=1
    Release() Returned  1
  Leaving IConnectionPoint_Unadvise()
  Entering IConnectionPoint_Release()
  Leaving IConnectionPoint_Release()
  Entering IConnectionPointContainer_Release()
  Leaving IConnectionPointContainer_Release()
  Entering IComCtrl_Release()
    @pCD.m_cRef =  1
    @pCD.m_cRef =  0
    CD Was Deleted!
  Leaving IComCtrl_Release()
Leaving fnWndProc_OnCommand() : Case IDC_KILL_CTL1

WM_LBUTTONDOWN
g_ptrOutGoing =  8849240

Entering CSink::ControlEvent()
  CSink::ControlEvent From hWnd 1115418
Leaving CSink::GotMessage()

Entering IComCtrl_SetColor()
Leaving IComCtrl_SetColor()

Entering fnWndProc_OnClose()
  pComCtrl Is FALSE!!!!!!!!!!!!!!
  Entering IConnectionPoint_Unadvise()
    Entering CSink::Release()
      this = 8849240
      m_cRef == 0 And Will Now Delete CSink!
    Leaving CSink::Release()
    Release() Returned  0
  Leaving IConnectionPoint_Unadvise()
  Entering IConnectionPoint_Release()
  Leaving IConnectionPoint_Release()
  Entering IConnectionPointContainer_Release()
  Leaving IConnectionPointContainer_Release()
  Got In Where pComCtr2 Is True!!!
  Entering IComCtrl_Release()
    @pCD.m_cRef =  1
    @pCD.m_cRef =  0
    CD Was Deleted!
  Leaving IComCtrl_Release()
Leaving fnWndProc_OnClose()

Entering DllCanUnloadNow()
  I'm Outta Here!
Leaving DllCanUnloadNow()
*/


Here is Main.h

Code Select Expand


//Main.h
#define  IDC_BUTTON1         1300  //Control ID For Blue' Button
#define  IDC_BUTTON2         1305  //Control ID For Green' Button
#define  IDC_BUTTON3         1310  //Control ID For Red' Button
#define  IDC_KILL_CTL1       1315  //Control ID For Kill CD
#define  IDC_BUTTON4         1320  //Control ID For Blue' Button
#define  IDC_BUTTON5         1325  //Control ID For Green' Button
#define  IDC_BUTTON6         1330  //Control ID For Red' Button
#define  IDC_KILL_CTL2       1335  //Control ID For Kill COM Ctrl2

interface ICOMCtrl : IUnknown
{
virtual HRESULT __stdcall Initialize    (         )=0;
virtual HRESULT __stdcall CreateControl (const int)=0;
virtual HRESULT __stdcall SetColor      (int      )=0;
virtual HRESULT __stdcall GetColor      (int*     )=0;
virtual HRESULT __stdcall GetCtrlId     (int*     )=0;
virtual HRESULT __stdcall GetHWND       (int*     )=0;
};

typedef struct    WindowsEventArguments
{
HWND             hWnd;
WPARAM           wParam;
LPARAM           lParam;
HINSTANCE        hIns;
}WndEventArgs, *lpWndEventArgs;

struct EVENTHANDLER
{
unsigned int    Code;
long            (*fnPtr)(lpWndEventArgs);
};


Here is CSink.cpp

Code Select Expand


//CSink.cpp
#include <windows.h>
#include <tchar.h>
#include <stdio.h>
#include <ocidl.h>
#include "Main.h"
#include "CSink.h"
extern   ICOMCtrl* pComCtrl1;
extern   ICOMCtrl* pComCtrl2;
extern   "C" const  IID IID_IOutGoing;

CSink::CSink() : m_cRef(0)
{
printf(_T("Entering CSink Constructor!\n"));
printf(_T("  this = %u\n"),this);
printf(_T("Leaving CSink Constructor!\n"));
}


ULONG CSink::AddRef()
{
printf("Entering CSink::AddRef()\n");
this->m_cRef++;
printf(_T("  this->m_cRef = %u\n"),this->m_cRef);    
printf(_T("Leaving CSink::AddRef()\n"));

return m_cRef;
}


ULONG CSink::Release()
{
printf("Entering CSink::Release()\n");
printf(_T("  this = %u\n"),this);
if(--m_cRef != 0)
{
   printf("  m_cRef != 0 : m_cRef=%u\n",m_cRef);
   return m_cRef;
}
else
{
   printf("  m_cRef == 0 And Will Now Delete CSink!\n");
   delete this;
}
printf("Leaving CSink::Release()\n");

return 0;
}


HRESULT CSink::QueryInterface(REFIID riid, void** ppv)
{
printf("Called CSink::QueryInterface() -- this = %u\n",this);
if(riid == IID_IUnknown)
{
   *ppv = (IUnknown*)this;
}
else if(riid == IID_IOutGoing)
{
   printf("Client: CSink::QueryInterface() for IOutGoing  -- this = %u\n", (IOutGoing*)this);
   *ppv = (IOutGoing*)this;
   printf("*ppv = %u\n", *ppv);
}
else
{
   *ppv = NULL;
   return E_NOINTERFACE;
}
AddRef();

return S_OK;
}

HRESULT CSink::ControlEvent(int hWindow)                              
{
TCHAR szBuffer[256];        //,szTmp[64];
int iWndHdl1=0,iWndHdl2=0;  //iColor,iCtlId,
HWND hContainer=0,hMain=0;

_tprintf(_T("\nEntering CSink::ControlEvent()\n"));
printf("  CSink::ControlEvent From hWnd %u\n", hWindow);
if(pComCtrl1)
   pComCtrl1->GetHWND(&iWndHdl1);
if(pComCtrl2)
   pComCtrl2->GetHWND(&iWndHdl2);
if(iWndHdl1)
{
   hContainer=GetParent((HWND)iWndHdl1);
   hMain=GetParent(hContainer);
}
else
{
   if(iWndHdl2)
   {
      hContainer=GetParent((HWND)iWndHdl1);
      hMain=GetParent(hContainer);
   }
else
      hMain=0;
}
if(iWndHdl1==hWindow)
{
   _tcscpy(szBuffer,_T("You Clicked On The Top COM Control!"));
   MessageBox(hMain,szBuffer,_T("Report From Control #1!"),MB_OK);
}
if(iWndHdl2==hWindow)
{
   _tcscpy(szBuffer,_T("You Clicked On The Bottom COM Control!"));
   MessageBox(hMain,szBuffer,_T("Report From Control #2!"),MB_OK);
}
printf("Leaving CSink::GotMessage()\n\n");    
             
return S_OK;                                                      
}                                                                  


And finally CSink.h

Code Select Expand


//CSink.h
#ifndef CSINK_H
#define CSINK_H

interface IOutGoing : IUnknown                    //IOutGoing
{
virtual HRESULT __stdcall ControlEvent(int) = 0;
};

class CSink : public IOutGoing                    //CSink
{
public:
CSink();
~CSink() { }
HRESULT __stdcall QueryInterface(REFIID iid, void** ppv);
ULONG   __stdcall AddRef();                                   //IUnknown
ULONG   __stdcall Release();
HRESULT __stdcall ControlEvent(int Message);                  //IOutGoing

private:
long m_cRef;
};

#endif


[Frederick J. Harris]

One thing I might point out about that code is that since I was creating two controls I first called CoGetClassObject() instead of CoCreateInstance() and used that instead to create both controls.  Now here is a PowerBASIC PB9 version that seems to be working but I'm pretty certain isn't quite right, simply because I'm not very good yet with handling sinks and sink interfaces in PowerBASIC.  You can see some commented out code down in the WM_CLOSE handler that causes a crash after one x's out.  If I kill one or the other of the controls then x out I'll get a crash if I try to disconnect the sink.  However, the program works fine otherwise.  You can kill one or the other of the controls, interact with it however you want, etc., but something still isn't right.

Code Select Expand


'CDClient2.inc

%IDC_CONTAINER1   = 1300    'Container For Top COM Control
%IDC_BUTTON1      = 1305    'Control ID For Blue' Button
%IDC_BUTTON2      = 1310    'Control ID For Green' Button
%IDC_BUTTON3      = 1315    'Control ID For Red' Button
%IDC_KILL_CTL1    = 1320    'Releases COM Control CD

%IDC_CONTAINER2   = 1400    'Container For Bottom COM Control
%IDC_BUTTON4      = 1405    'Control ID For Blue' Button
%IDC_BUTTON5      = 1410    'Control ID For Green' Button
%IDC_BUTTON6      = 1415    'Control ID For Red' Button
%IDC_KILL_CTL2    = 1420    'Releases COM Control CD

Interface IComCtrl $IID_IComCtrl : Inherit IAutomation
  Method Initialize()
  Method CreateControl(Byval hParent As Long)
  Method SetColor(Byval iColor As Long)
  Method GetColor() As Long
  Method GetCtrlId() As Long
  Method GetHWND() As Long
End Interface

Type WndEventArgs
  wParam As Long
  lParam As Long
  hWnd   As Dword
  hInst  As Dword
End Type

Type MessageHandler
  wMessage As Long
  dwFnPtr As Dword
End Type

Declare   Function FnPtr(wea As WndEventArgs) As Long


Code Select Expand


'CDClient2.bas
#Compile       Exe
#Include       "Win32api.inc"
$CLSID_CE      = GUID$("{20000000-0000-0000-0000-000000000040}")
$IID_ICOMCtrl  = GUID$("{20000000-0000-0000-0000-000000000041}")
$IID_IOutGoing = GUID$("{20000000-0000-0000-0000-000000000042}")
#Include       "CDClient2.inc"
Global         MsgHdlr() As MessageHandler
Global         pComCtrl1  As IComCtrl
Global         pComCtrl2  As IComCtrl


Class EventClass As Event
  Interface IOutGoing $IID_IOutGoing As Event : Inherit IAutomation
    Method ControlEvent(Byval iHandle As Long)
      Local iCtrlId1, iWndHdl1,iCtrlId2,iWndHdl2 As Long
      Local strMessage As String

      If IsObject(pComCtrl1) Then
         iWndHdl1=pComCtrl1.GetHWND()
      End If
      If IsObject(pComCtrl2) Then
         iWndHdl2=pComCtrl2.GetHWND()
      End If
      If iHandle=iWndHdl1 Then
         Select Case As Long pComCtrl1.GetColor()
           Case RGB(255,255,0)
             strMessage = "The Top COM Control Is Yellow!  Its Control ID Is" & $CrLf
           Case RGB(0,0,255)
             strMessage = "The Top COM Control Is Blue!  Its Control ID Is" & $CrLf
           Case RGB(0,255,0)
             strMessage = "The Top COM Control Is Green!  Its Control ID Is" & $CrLf
           Case RGB(255,0,0)
             strMessage = "The Top COM Control Is Red!  Its Control ID Is" & $CrLf
         End Select
         iCtrlId1=pComCtrl1.GetCtrlId()
         strMessage = strMessage & Str$(iCtrlId1) & " And Its hWnd Is " & Str$(iWndHdl1) & "."
         MsgBox(strMessage)
      End If
      If iHandle=iWndHdl2 Then
         Select Case As Long pComCtrl2.GetColor()
           Case RGB(255,255,0)
             strMessage = "The Bottom COM Control Is Yellow!  Its Control ID Is" & $CrLf
           Case RGB(0,0,255)
             strMessage = "The Bottom COM Control Is Blue!  Its Control ID Is" & $CrLf
           Case RGB(0,255,0)
             strMessage = "The Bottom COM Control Is Green!  Its Control ID Is" & $CrLf
           Case RGB(255,0,0)
             strMessage = "The Bottom COM Control Is Red!  Its Control ID Is" & $CrLf
         End Select
         iCtrlId2=pComCtrl2.GetCtrlId()
         strMessage = strMessage & Str$(iCtrlId2) & " And Its hWnd Is " & Str$(iWndHdl2) & "."
         MsgBox(strMessage)
      End If
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long
  Local hContainer1,hContainer2,hButton,dwStyle As Dword
  Local pCreateStruct As CREATESTRUCT Ptr
  Global pSink As IOutGoing

  pCreateStruct=wea.lParam
  wea.hInst=@pCreateStruct.hInstance
  dwStyle=%WS_CHILD Or %WS_VISIBLE Or %WS_THICKFRAME
  hButton=CreateWindowEx(0,"button","Blue",%WS_CHILD Or %WS_VISIBLE,8,10,80,25,wea.hWnd,%IDC_BUTTON1,wea.hInst,ByVal 0)
  hButton=CreateWindowEx(0,"button","Green",%WS_CHILD Or %WS_VISIBLE,8,40,80,25,wea.hWnd,%IDC_BUTTON2,wea.hInst,ByVal 0)
  hButton=CreateWindowEx(0,"button","Red",%WS_CHILD Or %WS_VISIBLE,8,70,80,25,wea.hWnd,%IDC_BUTTON3,wea.hInst,ByVal 0)
  hButton=CreateWindowEx(0,"button","Kill #1",%WS_CHILD Or %WS_VISIBLE,385,40,80,25,wea.hWnd,%IDC_KILL_CTL1,wea.hInst,ByVal 0)
  hContainer1=CreateWindowEx(%WS_EX_CLIENTEDGE,"static","",dwStyle,100,12,275,80,Wea.hWnd,%IDC_CONTAINER1,Wea.hInst,Byval 0)
  hButton=CreateWindowEx(0,"button","Blue",%WS_CHILD Or %WS_VISIBLE,8,110,80,25,wea.hWnd,%IDC_BUTTON4,wea.hInst,ByVal 0)
  hButton=CreateWindowEx(0,"button","Green",%WS_CHILD Or %WS_VISIBLE,8,140,80,25,wea.hWnd,%IDC_BUTTON5,wea.hInst,ByVal 0)
  hButton=CreateWindowEx(0,"button","Red",%WS_CHILD Or %WS_VISIBLE,8,170,80,25,wea.hWnd,%IDC_BUTTON6,wea.hInst,ByVal 0)
  hButton=CreateWindowEx(0,"button","Kill #2",%WS_CHILD Or %WS_VISIBLE,385,140,80,25,wea.hWnd,%IDC_KILL_CTL2,wea.hInst,ByVal 0)
  hContainer2=CreateWindowEx(%WS_EX_CLIENTEDGE,"static","",dwStyle,100,110,275,80,Wea.hWnd,%IDC_CONTAINER2,Wea.hInst,Byval 0)
  Call AllocConsole()
  Let pComCtrl1 = NewCom "ComCtrl.CD"
  Let pComCtrl2 = NewCom "ComCtrl.CD"
  Let pSink    = Class  "EventClass"
  Events From pComCtrl1 Call pSink
  Events From pComCtrl2 Call pSink
  pComCtrl1.Initialize()
  pComCtrl1.CreateControl(hContainer1)
  pComCtrl2.CreateControl(hContainer2)

  fnWndProc_OnCreate=0
End Function


Function fnWndProc_OnCommand(wea As WndEventArgs) As Long
  Select Case As Long LoWrd(Wea.wParam)
    Case %IDC_BUTTON1   'Blue
      If IsObject(pComCtrl1) Then
         pComCtrl1.SetColor(RGB(0,0,255))
      End If
    Case %IDC_BUTTON2   'Green
      If IsObject(pComCtrl1) Then
         pComCtrl1.SetColor(RGB(0,255,0))
      End If
    Case %IDC_BUTTON3   'Red
      If IsObject(pComCtrl1) Then
         pComCtrl1.SetColor(RGB(255,0,0))
      End If
    Case %IDC_KILL_CTL1
      If IsObject(pComCtrl1) Then
         pComCtrl1.Release()
         Set pComCtrl1=Nothing
         Events End pComCtrl1
      End If
    Case %IDC_BUTTON4   'Blue
      If IsObject(pComCtrl2) Then
         pComCtrl2.SetColor(RGB(0,0,255))
      End If
    Case %IDC_BUTTON5   'Green
      If IsObject(pComCtrl2) Then
         pComCtrl2.SetColor(RGB(0,255,0))
      End If
    Case %IDC_BUTTON6   'Red
      If IsObject(pComCtrl2) Then
         pComCtrl2.SetColor(RGB(255,0,0))
      End If
    Case %IDC_KILL_CTL2
      If IsObject(pComCtrl2) Then
         pComCtrl2.Release()
         Set pComCtrl2=Nothing
         Events End pComCtrl2
      End If
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnClose(wea As WndEventArgs) As Long
  'If IsObject(pComCtrl1) Then
  '   Events End pComCtrl1
  '   Set pComCtrl1=Nothing
  'End If
  'If IsObject(pComCtrl2) Then
  '   Events End pComCtrl2
  '   Set pComCtrl2=Nothing
  'End If
  ''Events End pSink
  ''Set pSink=Nothing

  MsgBox("Just Released COM Control")
  Call DestroyWindow(Wea.hWnd)
  Call PostQuitMessage(0)

  fnWndProc_OnClose=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_CLOSE    :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnClose)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As Asciiz*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="CEClient2"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbSize=SizeOf(wc)                            : wc.style=%CS_HREDRAW Or %CS_VREDRAW
  wc.cbClsExtra=0                                 : wc.cbWndExtra=0
  wc.hInstance=hIns                               : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindow(szAppName,"Visual COM Control Example",%WS_OVERLAPPEDWINDOW Xor %WS_MAXIMIZEBOX,400,550,500,240,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend

  Function=msg.wParam
End Function