Problems with EVENTS

[Cliff Nichols]

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

'*************************************************************************************************************
'*** 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

#include "resource.h"
1 typelib "XT_TEST.TLB"