Got Events to work in Visual Basic, Somewhat

[Thomas Tierney]

I have a project that will actually trigger events now but it crashes when either the application is stopped or the object is destoyed via SET X = NOTHING.

here is the code.

#COMPILE DLL
#DIM ALL

#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}")

#INCLUDE "Win32API.inc"

GLOBAL ghInstance AS DWORD
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

INTERFACE EVENT_TEST GUID$("{56851471-46E7-4F3D-A34E-EDC15DE7F3A3}") AS EVENT
    INHERIT IUNKNOWN
    METHOD Progress(BYVAL Percent AS LONG)
END INTERFACE
    

CLASS CLASSTEST GUID$("{0AC20173-0CAB-426C-8D57-0805BF0543A0}") AS COM
    CLASS METHOD CREATE ALIAS "Create"()
     MSGBOX "CREATE"
        
    END METHOD
    CLASS METHOD Destroy ALIAS "Destroy"()
        MSGBOX "DESTROY"
    END METHOD
    INTERFACE ITEST GUID$("{55EAE149-6239-4EEF-AFA1-0F465E0DD0B5}") AS EVENT
        INHERIT IUNKNOWN
        METHOD SAVESETTINGS ALIAS "Save"() AS LONG
            LOCAL i AS LONG
            RAISEEVENT EVENT_TEST.PROGRESS(i)
        END METHOD
    END INTERFACE
    EVENT SOURCE EVENT_TEST
END CLASS

here is the rc

#include "resource.h"

// Windows 95 does not display icons for console applications in Explorer.


// Version information
VS_VERSION_INFO VERSIONINFO
FILEVERSION 1, 0, 0, 0
PRODUCTVERSION 1, 0, 0, 0
FILEOS VOS_WINDOWS32
FILETYPE VFT_APP
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    BEGIN
      VALUE "CompanyName",      "Something, Inc.\0"
      VALUE "FileDescription",  "Application\0"
      VALUE "FileVersion",      "Version 1.0\0"
      VALUE "InternalName",     "Something\0"
      VALUE "OriginalFilename", "Something.dll.DLL\0"
      VALUE "LegalCopyright",   "Copyright \251 1998,1999 Someone, Inc.\0"
      VALUE "ProductName",      "Something for Windows\0"
      VALUE "ProductVersion",   "Version 2.0\0"
      VALUE "Comments",         "!\0"
    END
  END
END
 1  typelib EVENTTEST.TLB

1. Compile the dll
2. run pbtyp


put this into a vb form and compile or run

Private WithEvents x As XT_TEST.CLASSTEST
Private Sub Form_Load()
    Set x = CreateObject("CLASSTEST")
    x.Save
End Sub
Private Sub x_PROGRESS(ByVal PARAM1 As Long)
    MsgBox Str$(PARAM1)
End Sub

and run, the x_PROGRESS method does run


When the application is closed or set x = nothing is called it crashes with
the exception privileged instruction C0000096 occurred

Any Ideas?

[Gianmarco Brundo]

Hi,
I have same problem and this is my code:

#COMPILER PBWIN 9
#COMPILE DLL
#DIM ALL

#COM NAME "VBTestPB"
#COM DOC  "VBTest by Softwise"
#COM TLIB ON

#RESOURCE "vbtest.pbr"

CLASS EVBTest GUID$("{DC2D5511-0872-4F05-A76C-D6CF36D97611}") AS EVENT

    INTERFACE Stat GUID$("{7ED438DD-4F9F-401C-9F43-DE60B0CC767D}") AS EVENT

        INHERIT IUNKNOWN

        METHOD Done ALIAS "Done"
        END METHOD

    END INTERFACE

END CLASS


CLASS CVBTest GUID$("{936841F8-EB32-420D-B583-2CD05D4D7CE2}") AS COM

    INTERFACE IVBTest GUID$("{F149B01A-4741-488A-A1EB-95DC94A1C001}")

    INHERIT IDISPATCH

    METHOD VisMsg ALIAS "VisMsg"
      MSGBOX "OK"
      RAISEEVENT Stat.Done
    END METHOD

  END INTERFACE

  EVENT SOURCE Stat

END CLASS

All help is appreciated...

Thanks
Gianmarco

[Cliff Nichols]

Any luck getting this to work?
I have been trying all week, including attempting wrappers to cleanly exit, but the only way Set x = Nothing works is if it were not declared WithEvents (which defeats the whole purpose for raising events)

I am still having no luck finding the right combination to make this work????