Announcement

Collapse
No announcement yet.

Problems with EVENTS

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • 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"
    Engineer's Motto: If it aint broke take it apart and fix it

    "If at 1st you don't succeed... call it version 1.0"

    "Half of Programming is coding"....."The other 90% is DEBUGGING"

    "Document my code????" .... "WHYYY??? do you think they call it CODE? "
Working...
X