Visual COM Control Work In Progress

[Frederick J. Harris]

Below is a work in progress.  It is my attempt to create Visual COM controls low level using Microsoft’s ‘Connectable Objects’ interfaces.  What I have done is convert my custom control demo from here…

http://www.jose.it-berater.org/smfforum/index.php?topic=2907.0

to a visual COM control.  What the control does is create a colored window within a parent container window on the main Form.  There are three buttons on the host app which loads the control, and by clicking the ‘Blue’, ‘Green’, or ‘Red’ button COM calls are made to change the color of the control.  The direction of communication in this case is the simple case of a host doing a method call on the object.  However, when the user clicks on the control, the control fires an event in the client’s ‘Sink’ object, and the client then presents various information obtainable from the COM object such as its window handle, color, and control ID.

I’ll present quite a few various clients/hosts to try it on.  However, I am having some problems with it.  I can’t get it to work in Visual Basic 6 no matter what I do, although near as I can tell it is working perfectly using Visual Basic .NET, PowerBASIC 9, and various C++ clients I’ve tried.  The VB6 thing is a real mystery to me.  I’ll probably not rest ‘till I get to the bottom of the problem, but I have to say at this point I’m mystified.  What I did was first write this program using low level C without ATL, MFC or anything like that.  I wanted to create something I could translate to PowerBASIC as easily as possible, and C code is usually easily converted to PowerBASIC.  The program in C works perfectly with Visual Basic 6 and the PowerBASIC one doesn’t even though it works perfectly in everything else I’ve tried.  So if you are interested in this and can figure out what my error is, I’d certainly be grateful.  At some point I’d like to add explanatory comments to this and perhaps a tutorial, but at this point I consider it a ‘work in progress’.

There are piles of console output statements in the dll that will print to a console window if the host creates one.  I’ve typically been doing that.

Code: [Select]

#if 0
CD.bas produces a Dll containing a visual COM control, or, ActiveX control, if you'll permit me that term.

After compiling it using Jose's includes, embed the type library file CD.tlb (included in CD.zip) into CD.dll
as follows...

C:\.....>PBTyp.exe CD.dll CD.rc

CD.rc is included in the zip but simply comprises this...

 1  typelib CD.TLB
 
After embedding the type library you need to register the dll with Windows with RegSvr32.exe something
like this...

C:\.........YourDir\>RegSvr32 CD.dll

You can unregister it with the /u switch after the 'CD.dll' part.  All the code to produce the dll is in
this file for simplicity sake, even the registry code which I usually keep in a seperate file.  The only thing
you need not in this file are the CD.rc and CD.tlb files which I'll put in a zip.
#endif

#Compile                              Dll            'You need Jose's Includes, but I don't think much would have to
#Dim                                  All            'change if the PowerBASIC includes were to be used.
#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 g_szFriendlyName               As Asciiz*64
Global g_szVerIndProgID               As Asciiz*64
Global g_szProgID                     As Asciiz*64
Global CDClassFactory                 As IClassFactory1
Global IClassFactory_Vtbl             As IClassFactoryVtbl
Global IComCtrl_Vtbl                  As IComCtrlVtbl
Global IConnPointContainer            As IConnectionPointContainer1
Global IConnPointContainer_Vtbl       As IConnectionPointContainerVtbl
Global IConnPoint                     As IConnectionPoint1
Global IConnPoint_Vtbl                As IConnectionPointVtbl
Global g_hModule                      As Dword
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

  pCD=this
  Incr @pCD.m_cRef

  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
      hDC=BeginPaint(hWnd,ps)
      hNewBrush=CreateSolidBrush(GetWindowLong(hWnd,0))
      Call FillRect(hDC,ps.rcPaint,hNewBrush)
      Call DrawText(hDC, "Click Me!",-1,ps.rcPaint,%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
      Prnt "@Vtbl         = " & Str$(@Vtbl)
      Prnt "@Vtbl[0] = " & Str$(@Vtbl[0])
      Call Dword @Vtbl[3] Using ptrControlEvent(g_ptrOutGoing, Msg) 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_GLOBALCLASS
  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=LoadIcon(Byval %NULL, Byval %IDI_APPLICATION)  
  '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
  
  pCD=this
  Call SetWindowLong(@pCD.hControl,0,iColor)
  Call InvalidateRect(@pCD.hControl,Byval %NULL, %TRUE)
  
  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
  @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
      Incr this
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      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
  
  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
  Call InterlockedIncrement(g_lObjs)
  IClassFactory_AddRef=g_lObjs
End Function


Function IClassFactory_Release(ByVal this As IClassFactory1 Ptr) As Long
  Call InterlockedDecrement(g_lObjs)
  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()"
  Prnt "    this = " & Str$(this)
  @pCF=0
  If RefIID=$IID_IUnknown Or RefIID=$IID_IClassFactory Then
     Prnt "    Somebody's Looking For IID_IUnknown Or IID_IClassFactory!"
     Call IClassFactory_AddRef(this)
     @pCF=this
     Prnt "  Leaving IClassFactory_QueryInterface()"
     Function=%NOERROR
     Exit Function
  End If
  Prnt "     Whatever It Was They Were Looking For, We Ain't Got It!"
  Prnt "  Leaving IClassFactory_QueryInterface()"
  
  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)
     Prnt "  Varptr(CDClassFactory) = " & Str$(Varptr(CDClassFactory))
     hr=IClassFactory_QueryInterface(VarPtr(CDClassFactory),iid,pClassFactory)
     If SUCCEEDED(hr) Then
        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)
        Prnt "  IClassFactory_QueryInterface() Succeeded!"
     Else  
        @pClassFactory=0
        hr=%CLASS_E_CLASSNOTAVAILABLE
        Prnt "  IClassFactory_QueryInterface() Failed!"
     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 strAsciPath,strWideCharPath,strPath As String
  Local hr,iBytesReturned As Long
  Local szPath As Asciiz*256
  Local pTypeLib As ITypeLib
  'Local fp As Integer
  
  'fp=Freefile
  'Open "C:\Code\PwrBasic\PBWin90\CD\Output.txt" For Output As #fp
  'Print #fp, "  Entering ExeRegisterServer()"
  If GetModuleFileName(g_hModule, szPath, 256) Then
     strPath=szPath
     'Print #fp, "    szPath         = " strPath
     strAsciPath=szPath
     strWideCharPath=UCode$(strAsciPath & $Nul)
     hr=LoadTypeLibEx(Strptr(strWideCharPath), %REGKIND_REGISTER, pTypeLib)
     If SUCCEEDED(hr) Then
        'Print #fp, "    LoadTypeLib() Succeeded!"
        Set pTypeLib = Nothing
        hr=RegisterServer(szPath, $CLSID_CD, $IID_LIBID_CD, g_szFriendlyName, g_szVerIndProgID, g_szProgID)
     Else
        Local dwFlags As Dword
        Local szError As Asciiz*256
        Local strError As String
        'Print #fp, "    LoadTypeLib() Failed!"
        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
        'Print #fp, "    iBytesReturned = " iBytesReturned
        'Print #fp, "szBuffer           = " strError
     End If
  End If
  'Print #fp, "  Leaving ExeRegisterServer()"
  'Close #fp

  Function=hr
End Function


Function DllUnregisterServer Alias "DllUnregisterServer" () Export As Long
  Local hr As Long

  hr=UnRegisterTypeLib($IID_LIBID_CD, 1, 0, %LANG_NEUTRAL, %SYS_WIN32)
  If SUCCEEDED(hr) Then
     hr=UnregisterServer($CLSID_CD, g_szVerIndProgID, g_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
     g_szFriendlyName  =  "Com Control CD"
     g_szVerIndProgID  =  "ComCtrl.CD"
     g_szProgID        =  "ComCtrl.CD.1"
     g_hModule         =  hInstance
     g_CtrlId          =  1500
     Call DisableThreadLibraryCalls(hInstance)
  End If

  DllMain=%TRUE
End Function

Added Later (9/21/2010):

Fixed problem with VB6, so ignore comments relating to that above.

[Frederick J. Harris]

Here is CD.zip which includes the above code as well as CD.tlb (needed to embed type library) and a PB9 client you can use once you've registered the CD.dll.

[Frederick J. Harris]

Here is a VB.NET project that seems to work perfectly.  That amazed me.  I expected problems due to the VB6 thing but at least for me this is working perfectly.  I might even stop bad mouthing .NET at this point.

Hopefully you'll be able to recreate my project with only the attached several files.  If you must recreate the project from scratch, the important thing is to bring up the 'References' dialog box where you'll have to select the 'COM' tab and find a reference to "COM Ctrl Typelib CD" or something like that.

[Frederick J. Harris]

Here's the VB6 project that doesn't work.  What happens is the program starts completely normal and the control appears just like its supposed to in the picture box container I created for it.  When you interact with the program in any way, even moving your mouse over the app, you'll get an immediate crash.  I thought the problem might be something I did in the connection point code, but just today I removed the WithEvents keyword from the Dim statement that created the object in the VB program, figuring with the capacity removed to create a sink and receive events from the control, it might work.  However, to my surprise, that didn't change anything.  That gave me the idea that perhaps my error was somewhere in the more basic code involving the class factory or creating the object, so I studied that real close today without finding anything. 

Added Later:

That problem was fixed (see several posts down in this thread).  The above VB6 project works fine with the updated zip file code.

[Frederick J. Harris]

And here is an SDK style C++ host that I originally did in VC6 but just compiled using GNU CodeBlocks in the hope it would crash like the VB6 program, but no luck.  It works perfect too.  I'll also include the console window output from this where I clicked on he control once then closed out.

Code: [Select]

//C++
//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* pConnectionPointContainer=NULL;
IConnectionPoint* pConnectionPoint=NULL;
EVENTHANDLER EventHandler[3];
ICOMCtrl* pComCtrl=NULL;
DWORD dwCookie=NULL;
CSink* mySink=NULL;


long fnWndProc_OnCreate(lpWndEventArgs Wea)
{
 HWND hButton,hContainer;
 IUnknown* pUnk=0;
 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=CoCreateInstance(CLSID_CD,NULL,CLSCTX_INPROC_SERVER,IID_ICOMCtrl,(void**)&pComCtrl);
    if(SUCCEEDED(hr))
    {
       printf("  CoCreateInstance() Succeeded! -- pComCtrl = %u\n",(unsigned)pComCtrl);
       hr=pComCtrl->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);
          //hButton=CreateWindowEx(0,"button","Kill COM Control",WS_CHILD|WS_VISIBLE,203,100,120,25,Wea->hWnd,(HMENU)IDC_KILL_CD,Wea->hIns,0);
          hContainer=CreateWindowEx(WS_EX_CLIENTEDGE,_T("static"),_T(""),WS_CHILD|WS_VISIBLE|WS_THICKFRAME,100,12,325,80,Wea->hWnd,(HMENU)1600,Wea->hIns,0);
          hr=pComCtrl->QueryInterface(IID_IUnknown,(void**)&pUnk);
          if(SUCCEEDED(hr))
          {
             printf("  Got IUnknown From CLSID_CD! -- pUnk = %u\n",(unsigned)pUnk);
             hr = pUnk->QueryInterface(IID_IConnectionPointContainer, (void**)&pConnectionPointContainer);
             if(SUCCEEDED(hr))
             {
                printf("  Got pConnectionPointContainer = %u\n",(unsigned)pConnectionPointContainer);
                hr = pConnectionPointContainer->FindConnectionPoint(IID_IOutGoing, &pConnectionPoint);
                if(SUCCEEDED(hr))
                {
                   printf("  Got pConnectionPoint = %u\n",(unsigned)pConnectionPoint);
                   mySink = new CSink;
                   printf("  mySink = %u\n",(unsigned)mySink);
                   hr=pConnectionPoint->Advise((IUnknown*)mySink, &dwCookie);
                   if(SUCCEEDED(hr))
                   {
                      printf("  pConnectionPoint->Advise() Succeeded!\n");

                      hr=pComCtrl->CreateControl((int)hContainer);
                      if(SUCCEEDED(hr))
                         printf("  pComCtrl->CreateControl(hContainer) Succeeded!\n");
                      else
                         printf("  pComCtrl->CreateControl(hContainer) Failed!\n");

                   }
                   else
                      puts("  pConnectionPoint->Advise() Failed!");
                }
                else
                   printf("  Failed To Get pConnectionPoint!\n");
             }
             else
                printf("  Failed To Get IConnectionPointContainer*\n");
             pUnk->Release();
          }
          else
             printf("QueryInterface(IUnknown) Failed!\n");
       }
       else
          printf("pComCtrl->Initialize() Failed!\n");
    }
    else
       printf(_T("  CoCreateInstance() 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:
     pComCtrl->SetColor((int)RGB(0,0,255));
     break;
   case IDC_BUTTON2:
     pComCtrl->SetColor((int)RGB(0,255,0));
     break;
   case IDC_BUTTON3:
     pComCtrl->SetColor((int)RGB(255,0,0));
     break;
 }

 return 0;
}


long fnWndProc_OnClose(lpWndEventArgs Wea)
{
 printf(_T("Entering fnWndProc_OnClose()\n"));
 if(dwCookie && pConnectionPoint)
    pConnectionPoint->Unadvise(dwCookie);
 if(pConnectionPoint)
    pConnectionPoint->Release();
 if(pConnectionPointContainer)
    pConnectionPointContainer->Release();
 if(pComCtrl)
    pComCtrl->Release();
 delete mySink;
 CoUninitialize();
 printf(_T("Leaving fnWndProc_OnClose()\n\n"));
 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("C++ Visual COM Control Demo");
 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,440,140,HWND_DESKTOP,0,hIns,0);
 ShowWindow(hWnd,iShow);
 while(GetMessage(&messages,NULL,0,0))
 {
    TranslateMessage(&messages);
    DispatchMessage(&messages);
 }

 return messages.wParam;
}

Main.h

Code: [Select]

//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_CD         1315  //Control ID For Kill CD

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);
};


Code: [Select]

//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


Code: [Select]

//CSink.cpp
#include <windows.h>
#include <tchar.h>
#include <stdio.h>
#include <ocidl.h>
#include "Main.h"
#include "CSink.h"
extern   ICOMCtrl* pComCtrl;
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()
{
 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("      Entering 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();
 printf("      Leaving CSink::QueryInterface()\n");

 return S_OK;
}


HRESULT CSink::ControlEvent(int Message)                             
{
 TCHAR szBuffer[256],szTmp[64];
 int iColor,iCtlId,iWndHdl;
 HWND hContainer,hMain;

 _tprintf(_T("\nEntering CSink::ControlEvent()\n"));
 printf("  CSink::ControlEvent is %u\n", Message); 
 switch(Message)
 {
   case WM_CREATE:
     printf("  WM_CREATE\n");
     break;
   case WM_CHAR:
     printf("  WM_CHAR\n");
     break;
   case WM_LBUTTONDOWN:
     printf("  WM_LBUTTONDOWN\n");
     pComCtrl->GetColor(&iColor);
     pComCtrl->GetCtrlId(&iCtlId);
     pComCtrl->GetHWND(&iWndHdl);
     hContainer=GetParent((HWND)iWndHdl);
     hMain=GetParent(hContainer);
     _tprintf(_T("  hContainer = %u\n"),hContainer);
     _tprintf(_T("  hMain      = %u\n"),hMain);
     if(iColor==(int)RGB(0,0,255))
        _tcscpy(szBuffer,_T("The COM Control Is Blue!  Its Control ID Is\r\n"));
     if(iColor==(int)RGB(255,255,0))
        _tcscpy(szBuffer,_T("The COM Control Is Yellow!  Its Control ID Is\r\n"));
     if(iColor==(int)RGB(0,255,0))
        _tcscpy(szBuffer,_T("The COM Control Is Green!  Its Control ID Is\r\n"));
     if(iColor==(int)RGB(255,0,0))
        _tcscpy(szBuffer,_T("The COM Control Is Red!  Its Control ID Is\r\n")); 
     _stprintf(szTmp,_T("%u"),iCtlId);
     _tcscat(szBuffer,szTmp);
     _tcscat(szBuffer,_T(" And Its HWND Is "));
     _stprintf(szTmp,_T("%u"),iWndHdl);
     _tcscat(szBuffer,szTmp);
     _tcscat(szBuffer,_T("."));
     MessageBox(hMain,szBuffer,_T("Report From Control!"),MB_OK);
     break;
   case WM_CLOSE:
     printf("  WM_CLOSE\n");
     break;
 }
 printf("Leaving CSink::GotMessage()\n\n");     
             
 return S_OK;                                                       
}                                                                   

Here is the output from the console window from above...

Code: [Select]

Entering fnWndProc_OnCreate()
  CoInitialize() Succeeded!

  Entering DllGetClassObjectImpl()
    Varptr(CDClassFactory) =  10860532
    Entering IClassFactory_QueryInterface()
      this =  10860532
      Somebody's Looking For IID_IUnknown Or IID_IClassFactory!
    Leaving IClassFactory_QueryInterface()

    IClassFactory_QueryInterface() Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()
    pCD                        =  2446624
    Varptr(@pCD.lpComCtrlVtbl) =  2446624
    Varptr(@pCD.lpICPCVtbl)    =  2446628
    Varptr(@pCD.lpICPVtbl)     =  2446632
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IComCtrl_QueryInterface()
      Trying To Get IComCtrl
      this =  2446624
    Leaving IComCtrl_QueryInterface()

    @ppv                       =  2446624  << After QueryInterface() Call
  Leaving IClassFactory_CreateInstance()

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

  Entering IComCtrl_QueryInterface()
    Trying To Get IComCtrl
    this =  2446624
  Leaving IComCtrl_QueryInterface()

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

  CoCreateInstance() Succeeded! -- pComCtrl = 2446624

  Entering IComCtrl_Initialize()
    this =  2446624
  Leaving IComCtrl_Initialize()

  pComCtrl->Initialize() Succeeded!

  Entering IComCtrl_QueryInterface()
    Trying To Get IUnknown
    this =  2446624
  Leaving IComCtrl_QueryInterface()

  Got IUnknown From CLSID_CD! -- pUnk = 2446624

  Entering IComCtrl_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  2446624
    this =  2446628
  Leaving IComCtrl_QueryInterface()

  Got pConnectionPointContainer = 2446628

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  2446628
    @ppCP =  0
    @ppCP =  2446632
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Got pConnectionPoint = 2446632

  Entering CSink Constructor!
    this = 9775280
  Leaving CSink Constructor!

  mySink = 9775280

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    pUnkSink      =  9775280
    @pUnkSink     =  4226576
    Vtbl          =  4226576
    @Vtbl[0]      =  4202364
    g_ptrOutGoing =  0  << Before Call Of QueryInterface() On Sink
    Entering CSink::QueryInterface() -- this = 9775280
      Client: CSink::QueryInterface() for IOutGoing  -- this = 9775280
      *ppv = 9775280
    Leaving CSink::QueryInterface()
    g_ptrOutGoing =  9775280  << After Call Of QueryInterface() On Sink
    Call Dword Succeeded!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  pConnectionPoint->Advise() Succeeded!

  Entering IComCtrl_CreateControl()
    this =  2446624
  Leaving IComCtrl_CreateControl()

  pComCtrl->CreateControl(hContainer) Succeeded!

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

WM_LBUTTONDOWN
g_ptrOutGoing =  9775280
@Vtbl         =  4202364
@Vtbl[0]      =  4202364

Entering CSink::ControlEvent()
  CSink::ControlEvent is 513
  WM_LBUTTONDOWN
  hContainer = 329166
  hMain      = 853550
Leaving CSink::GotMessage()

Entering fnWndProc_OnClose()
  Entering IConnectionPoint_Unadvise()
    Entering CSink::Release()
      this = 9775280
      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()
  Entering IComCtrl_Release()
    @pCD.m_cRef =  1
    @pCD.m_cRef =  0
    CD Was Deleted!
  Leaving IComCtrl_Release()
Leaving fnWndProc_OnClose()

 

[Frederick J. Harris]

Finally, I'll attach my entire Visual Studio 6 C project that I did before the PowerBASIC project.  The PowerBASIC project is an exact translation of this one, although this one works perfect in Visual Basic 6.  Also, these both can be registered because it uses different CLSIDs and program IDs than the PB project's numbers.  This is CE not CD.  The code in Main.c is pretty much what's in CD.bas.

[Frederick J. Harris]

On the way home from work today a thought occurred to me.  I had been studying the console output from the COM object when VB6 crashes, and I noted two QueryInterface calls VB was making for interfaces I didn't support in my object.  It wouldn't surprise me if those calls related to some of the IEnumConnectionPoint functionality I wasn't supporting, but was returning E_NOTIMPL.  However, pointers to those interfaces appear as parameters in my various IConnectionPointContainer and IConnectionPoint interfaces.  I got off easy with my C program and had to do nothing to support those data types because they are in various C headers included anyway.  However, in my PowerBASIC code I had to deal with them even though I wasn't using those variable types.  At first I thought I'd try to get away with just defining them as pointers figuring it didn't much matter what they were pointing to since I was returning E_NOTIMPL from the functions, but when I started getting the VB6 crashes I translated the Interfaces and made pointers to them.  Perhaps I messed that up somehow.  I'm not going to have much time to work with this over the next couple days, but as soon as I can I'm gonna put calls for those interfaces in the C++ program and see if that is causing the problem.  Here is the console output from VB 6 when it goes belly up...

Code: [Select]

Entering DllGetClassObjectImpl()
  Varptr(CDClassFactory) =  20101108
  Entering IClassFactory_QueryInterface()
    this =  20101108
    Somebody's Looking For IID_IUnknown Or IID_IClassFactory!
  Leaving IClassFactory_QueryInterface()
  IClassFactory_QueryInterface() Succeeded!
Leaving DllGetClassObjectImpl()

Entering IClassFactory_CreateInstance()
  pCD                        =  1343400
  Varptr(@pCD.lpComCtrlVtbl) =  1343400
  Varptr(@pCD.lpICPCVtbl)    =  1343404
  Varptr(@pCD.lpICPVtbl)     =  1343408
  @ppv                       =  0  << Before QueryInterface() Call
  Entering IComCtrl_QueryInterface()
    Trying To Get IUnknown
    this =  1343400
  Leaving IComCtrl_QueryInterface()
  @ppv                       =  1343400  << After QueryInterface() Call
Leaving IClassFactory_CreateInstance()

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

Entering IComCtrl_QueryInterface()
  Trying To Get IUnknown
  this =  1343400
Leaving IComCtrl_QueryInterface()

Entering IComCtrl_QueryInterface()
  Trying To Get IComCtrl
  this =  1343400
Leaving IComCtrl_QueryInterface()

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

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

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

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

Entering IComCtrl_QueryInterface()
  Trying To Get IConnectionPointContainer
  this =  1343400
  this =  1343404
Leaving IComCtrl_QueryInterface()

Entering IConnectionPointContainer_FindConnectionPoint()
  this  =  1343404
  @ppCP =  0
  @ppCP =  1343408
Leaving IConnectionPointContainer_FindConnectionPoint()

Entering IConnectionPointContainer_Release()
Leaving IConnectionPointContainer_Release()

Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
  pUnkSink      =  1283888
  @pUnkSink     =  4201212
  Vtbl          =  4201212
  @Vtbl[0]      =  4198916
  g_ptrOutGoing =  0  << Before Call Of QueryInterface() On Sink
  g_ptrOutGoing =  1283888  << 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_Release()
  @pCD.m_cRef =  2
Leaving IComCtrl_Release()

Entering IComCtrl_Initialize()
  this =  1343400
Leaving IComCtrl_Initialize()

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

Entering IComCtrl_CreateControl()
  this =  1343400
Leaving IComCtrl_CreateControl()

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


[Dominic Mitchell]

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

It is very easy to find out what intefaces it is looking for.  Just record the Guid and look it up.
It is probably an interface that is optional or IMarshalXXX.  If it, however, is an interface that
was once required, you will have to implement it.

I have not yet found the time to look at your code, but are the intefaces in your control dual?
If they are not, then they should be.

[Frederick J. Harris]

The interfaces are not dual but I'm not completely opposed to adding that support, even though I have no use for it.  This is the idl...

Code: [Select]

// CD.idl
import "unknwn.idl";

[object, uuid(20000000-0000-0000-0000-000000000041), oleautomation]
interface IComCtrl : IUnknown
{
 HRESULT Initialize   (                          );
 HRESULT CreateControl([in] int hParent          );
 HRESULT SetColor     ([in] int iColor           );
 HRESULT GetColor     ([out, retval] int* iColor );
 HRESULT GetCtrlId    ([out, retval] int* iCtrlId);
 HRESULT GetHWND      ([out, retval] int* hWnd   );
}

[object, uuid(20000000-0000-0000-0000-000000000042), oleautomation]
interface IOutGoing : IUnknown
{
 HRESULT ControlEvent(int Message);
}

[uuid(20000000-0000-0000-0000-000000000043), helpstring("COM Ctrl TypeLib CD"), version(1.0)]
library CDLibrary
{
 importlib("stdole32.tlb");
 interface IComCtrl;
 interface IOutGoing;
 [uuid(20000000-0000-0000-0000-000000000040)]
 coclass CD
 {
           interface IComCtrl;
  [source] interface IOutGoing;
 }
};

I chose not to implement IDispatch because my understanding is that even though it is highly recommended to support it, it is not an absolute necessity (I have sources supporting that view).  My goal in creating this code was to explore alternate vehicles besides custom controls for encapsulating functionality in my Windows programming.   I don't do anything with scripting languages or the internet.  What I learned about this stuff came from an example not closely related at all to my code here.  It was an example using connectable objects that used two Exe out of process servers that pumped characters between the consoles. It did work with Visual Basic though, and it didn't support IDispatch either.  That's why I didn't fool with it. 

[Frederick J. Harris]

Having said that though, if implementing IDispatch would solve my VB6 crash problem, I'd likely get at it 1st thing Monday morning.  I don't think that's the problem though, because my C program works perfectly with everything I've tested it with, and it doesn't implement dual interfaces.  Nope, I've made a mistake somewhere in the C to PB conversion, thinks I.

[Dominic Mitchell]

Code: [Select]

FUNCTION XXX_QueryInterface(...)

...

  SELECT CASE iid
...
    CASE $IID_ICONNECTIONPOINT
...
      FUNCTION=%S_OK
      EXIT FUNCTION
  END SELECT
 
...

END FUNCTION 
 

Remove all occurrences of QueryInterface on IConnectionPoint in your code, the server should
not allow a QueryInterface on an outgoing interface.  Did you read the Bible on OLE?

Remember this call by the client?

Code: [Select]

IConnectionPointContainer::FindConnectionPoint


Code: [Select]

FUNCTION DllGetClassObjectImpl ALIAS "DllGetClassObject" ...
  LOCAL hr AS LONG
...

  Prnt "Entering DllGetClassObjectImpl()"
  IF RefClsid=$CLSID_CD OR RefClsid=$IID_ICLASSFACTORY THEN 
   
Under what circumstances would you see the value of RefClsid being IID_ICLASSFACTORY in here?


In my opinion, this stuff

Code: [Select]

        IComCtrl_Vtbl.QueryInterface                   = CODEPTR(IComCtrl_QueryInterface)
        IComCtrl_Vtbl.AddRef                           = CODEPTR(IComCtrl_AddRef)
        IComCtrl_Vtbl.Release                          = CODEPTR(IComCtrl_Release)
        IComCtrl_Vtbl.Initialize                       = CODEPTR(IComCtrl_Initialize)
should be done in IClassFactory::CreateInstance.

I think DllGetClassObject should be concentrating on returning a class factory for the requested class
and not be bothered with setting up virtual tables.  Where was IComCtrl created?

[Frederick J. Harris]

Thanks for taking the time to examine this Dominic!  I appreciate it.  Since I posted it all last Friday (9/1) I havn't had much time to work with it due to some family matters needing to be attended to, but tomorrow I want to get once more back at it.  About your last comment though about where I had initialized the VTables in DllGetClassObject(), I wasn't sure the best place to do that, but it occurred to me that any client would likely only call DllGetClassObject() once (or COM would do it on behalf of a client once), whereas if that code was in IClassFactory::CreateInstance(), this initialization could occur every time a client created an instance of the control.  This wouldn't hurt anything because none of those addresses would change, but it just seemed to me to be unnecessary extra effort if that scenerio occurred. 

I'll be thinking about your other comments and will get back tomorrow.

[Frederick J. Harris]

Well, I solved the problem completely and with 100% certainty.  I now know why the VB6 crash was occurring, and in truth its surprising the others weren't too.  Like I suspected, it was a dumb error on my part and I was right when I said I'm going to take a beating solving this.  I did.  My guess is it cost me 14 hours, and that doesn't include musing on the problem while not directly working on it.  

Since I'm relatively new to using Connection Points I was figuring the problem was there somewhere, but it wasn't.  I wasted a lot of time making absolutely certain my Call Dword stuff in Advise() and Unadvise() was right.  It all was.  What finally got me to suspecting that the problem was elsewhere was when I removed the WithEvents part of the Dim statement in the VB6 app that instantiated the ComCtrl, and it still crashed.  I thought it would work once I removed that term and there was no more exchange of pointers.  

Seeing that it was still crashing I decided to strip the code down to a bare nothing to see how far I had to rip stuff out until it finally worked.  I ripped out all the connection point code, the window procedure for the COM Control, everything.  It was still crashing.  At that point the code bulk was down to about half and I realized the problem must be in the boilerplate COM Dll setup code involving the Class Factory and the exported functions.  For quite some time I had been casting an evil eyeball on DllCanUnloadNow(), and I even put output statements in it to see when it was being called.  The crashes I was getting made me wonder in COM was unloading the Dll prematurely.  Here is the code for DllCanUnloadNow()...

Code: [Select]

Function DllCanUnloadNow Alias "DllCanUnloadNow" () Export As Long
  If g_lObjs Or g_lLocks Then
     Prnt "  The System Wants Rid Of Me But I Won't Go!"
     Function=%FALSE
  Else
     Prnt "  I'm Outta Here!"
     Function=%TRUE
  End If
End Function


Well, here is what I have in CD.c which works...

Code: [Select]

HRESULT __stdcall DllCanUnloadNow()
{
 if(g_lObjs||g_lLocks)
    return S_FALSE;
 else
    return S_OK;
}

Not exactly the same, but close.  Close until you check out the values of those equates with this little PB CC program...

Code: [Select]

'#Compile Exe
'#Dim All
'#Include "Win32Api.inc"

'Function PBMain() As Long
'  Print "%TRUE    = " %TRUE
'  Print "%S_OK    = " %S_OK
'  Print "%FALSE   = " %FALSE
'  Print "%S_FALSE = " %S_FALSE
'  Waitkey$

'  PBMain=0
'End Function

'%TRUE    =  1
'%S_OK    =  0
'%FALSE   =  0
'%S_FALSE =  1            

How 'bout that!

So the fixed procedure should be something like this...

Code: [Select]

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


[Frederick J. Harris]

Hi Dominic!

    Thanks for spotting that $IID_IClassFactory in DllGetClassObjectImpl().  You're right of course. It shouldn't be there.

    In terms of this comment though...

Remove all occurrences of QueryInterface on IConnectionPoint in your code, the server should
not allow a QueryInterface on an outgoing interface.  Did you read the Bible on OLE?

     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.  My object contains three interfaces, i.e., IComCtrl, IConnectionPointContainer,
and IConnectionPoint.  I need QueryInterface functionality on all those interfaces so as to navigate between
them.  What am I not understanding, or am I not understanding your comment?

[Frederick J. Harris]

I made those corrections discussed above and re-attached the corrected code in the original CD.zip in the 2nd post of this thread.  There had been three downloads of the original zip, so those who downloaded it might want the updated files. 

So at this point it looks like its working with PB 9, C++, VB6 and VB.NET.