Pb9 Com Event Problems

[Cliff Nichols]

I posted this in the "Programming with Objects" forum, but 10 days later and over 100 views, not so much as a hint to what I am doing wrong?

Problems with EVENTS
I am trying to understand COM but my initial attempts to call this DLL from VB causes a crash of sorts, so I thought I would try to make a EXE in PB to demonstrate the problem.

Only problem is I keep getting myself lost in learning enough to even know how to ask the question????

Can anyone make an EXE to call this so I can learn what I do not understand and maybe be able to learn enough how to ask about what my problem really is????

Thanx to anyone that can help

Code:
'*************************************************************************************************************
'*** COMPILER DIRECTIVES
#COMPILE DLL
#DIM ALL
'*************************************************************************************************************
'*************************************************************************************************************
'*** COM Directives
#COM NAME "XT_TEST", 1.0
#COM TLIB ON
#COM DOC "XT Event Com Tester 1.0"
#COM GUID GUID$("{9C41D1BB-3B61-4BA3-A1F1-6FC09A46D9BF}")
'*************************************************************************************************************
'*************************************************************************************************************
'*** INCLUDES
#INCLUDE "Win32API.inc"
#INCLUDE "ErrorHandling.inc"
#RESOURCE "XT_TEST.pbr"
'*************************************************************************************************************
'*************************************************************************************************************
'*** CONSTANTS
$EVENT_TEST_GUID = GUID$("{56851471-46E7-4F3D-A34E-EDC15DE7F3A3}")
$CLASSTEST_GUID = GUID$("{0AC20173-0CAB-426C-8D57-0805BF0543A0}")
$CLASSTEST_INTERFACE_GUID = GUID$("{55EAE149-6239-4EEF-AFA1-0F465E0DD0B5}")
'%COINIT_MULTITHREADED = &H0
'*************************************************************************************************************
'*************************************************************************************************************
'*** GLOBALS
GLOBAL ghInstance AS DWORD
'*************************************************************************************************************
'*************************************************************************************************************
'*** DECLARES
'*************************************************************************************************************
DECLARE FUNCTION LIBMAIN (BYVAL hInstance AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) AS LONG
'*************************************************************************************************************
'*** FUNCTIONS
'*************************************************************************************************************
FUNCTION LIBMAIN (BYVAL hInstance AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) AS LONG
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH
ghInstance = hInstance
FUNCTION = 1 'success!
CASE %DLL_PROCESS_DETACH
FUNCTION = 1 'success!
CASE %DLL_THREAD_ATTACH
FUNCTION = 1 'success!
CASE %DLL_THREAD_DETACH
FUNCTION = 1 'success!
END SELECT
END FUNCTION
'*************************************************************************************************************
'*** COM FUNCTIONS
'*************************************************************************************************************
'*** Event to be raised in other languages
'*** Event Interface to be kept separate from classes so that each clase has the ability to raise the event
INTERFACE EVENT_TEST $EVENT_TEST_GUID AS EVENT
INHERIT IUNKNOWN '<--- IUNKNOWN Used to be seen by VB
METHOD Progress(BYVAL Percent AS LONG) '<--- Event as seen by other language
END INTERFACE
'*** Class as COM
'*** CLASSTEST is what is seen in VB as part of the Library.Class or the Class itself if declared that way
'*** Allows for setting and getting properties, and calling Methods (Functions) to perform procedures
CLASS CLASSTEST $CLASSTEST_GUID AS COM
CLASS METHOD CREATE ALIAS "Create"() '<--- Hidden from public, used to initialize COM Component
StartTrace
'CoInitializeEx byval 0, %COINIT_MULTITHREADED
LOCAL ObjExists AS ITEST
MSGBOX "CREATE Fired within PB"
END METHOD
CLASS METHOD Destroy ALIAS "Destroy"() '<--- Hidden from public, used to clean up, and should only be called when not copies of the object exist
LOCAL IsObj AS EVENT_TEST
' LET IsObj = GETCOM "XT_TEST.CLASSTEST"
'MSGBOX STR$(OBJPTR(IsObj))
'IsObj = ME
'EVENTS END IsObj
MSGBOX "DESTROY Fired within PB"
EndTrace
END METHOD
'*** CLASS INTERFACE as EVENT
'*** An event to be raised, to in turn raise an event available to all classes
INTERFACE ITEST $CLASSTEST_INTERFACE_GUID AS EVENT '<--- Internal Event to call the public Event
' INHERIT IUNKNOWN '<--- Since internal to class does not have to be unknown to be seen?
INHERIT Dual '<--- I have to find it, but one of the docs says to use DUAL because future (9.01) Versions will change how dispatch is used
METHOD SAVESETTINGS ALIAS "Save"() AS LONG
LOCAL i AS LONG 'Local variable
i = 6 'Change to whatever makes sense for demo
RAISEEVENT EVENT_TEST.PROGRESS(i) '<--- Raise the public event available to all classes and anything using this server-com
END METHOD
'*** CLASS METHOD (FUNCTION)
'*** This method was one of my attempts to cleanly release resources, till I found out that "Destroy" is to only be called
'*** When there are no references left to access the object, so all the below method should be ignored
METHOD DeAllocate ALIAS "DeAllocate"()AS LONG
' CoUnInitialize
' local Objvar as string
' let Objvar = nothing
' msgbox CLSID$(me.deallocate)
' local lResult as long
' lResult = OBJACTIVE(PROGID$(GUID$("{0AC20173-0CAB-426C-8D57-0805BF0543A0}")))
' lResult = isobject(me)
' MSGBOX STR$(RefCount)
' me.GetRefCount(me)
me.Destroy '<--- Do NOT call, although no crash at the moment it is done, does not mean its not a point of corruption
' CoFreeUnusedLibraries
' LOCAL ObjVar AS DWORD
' LET objvar = GETCOM CLSID GUID$("{0AC20173-0CAB-426C-8D57-0805BF0543A0}")
END METHOD
END INTERFACE
EVENT SOURCE EVENT_TEST '<--- Give the class the ability to raise the public event
END CLASS
and the resource file
Code:
#include "resource.h"
1 typelib "XT_TEST.TLB"

__________________

So far my test code in VB6 works, until I go to close, then it crashes out like it would if I had left a running thread running and still had a pointer to it???

'*********************************************************************************************************
'*** The below is my trimmed down attempts to make PB work as COM in another language
'***    I tried 2 objects, but trimmed to 1 to demo problems and questions
'*********************************************************************************************************
Private WithEvents x As XT_TEST.DLL_CLASS '<--- Full Library.ClassName and WithEvents
'Private WithEvents x As CLASSTEST                           '<--- Just the ClassName and WithEvents
'Private x As XT_TEST.CLASSTEST                              '<--- Full Library.ClassName Without Events
'Private x As CLASSTEST                                      '<--- Just the ClassName Without Events

Private Sub Form_Load()
    ChDir App.Path
'MsgBox App.Path + "\" + App.EXEName
    Set x = CreateObject("CLASSTEST")
    x.SaveSettings
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'*** If x is Full Library.ClassName and WithEvents then crash
'    x.DeAllocate
    Set x = Nothing                                         '<--- Notice without the events, then no crash
'    Set x = 0                                         '<--- Notice without the events, then no crash
MsgBox "Complete"                                           '<--- If event, you will never see this message, and instead see a crash
'End
End Sub
'*** Reguardless how the WithEvents is fired
'***    Notice without events, then this event does not fire and there is no crash
Private Sub x_PROGRESS(ByVal PARAM1 As Long)
    MsgBox "I Fired with x = " + Str$(PARAM1)               '<--- Messagebox with reply from Dll Event in PB
End Sub

I am REALLYYYY starting to get desperate cause I can not see that 1 tree from the woods, and my crash only occurs if I use an event, but no problem if using methods or properties.....

What am I missing?????????