Hey all this is an example of how to do a multi-threaded com component with events for Visual Basic. Everyone knows if you create threads in vb it crashes.
Code:
'--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : The source code is provided to show how to create a ' multi threaded com component that can be safely be used ' in VB. We all know that VB doesnt act nicely when it comes ' to threads so any event that needs to be triggered must ' be done from the main thread. The only part I do not like ' is the fact that the "EVENT HANDLER" sub "DOIT" is exposed ' in the type library. I would prefer it to be invisible. ' this is very close to the PREFERED way of doing it, as far as ' I can tell :) ' Date : '--------------------------------------------------------------------- #COMPILE DLL #DIM ALL #COM NAME "VBASICEventLibrary", 1.0 #COM TLIB ON #COM DOC "Visual Basic Event Test Server" #COM GUID GUID$("{81587687-D0F2-43FB-8D8C-D163FFD0CFDE}")) #INCLUDE "Win32API.inc" GLOBAL ghInstance AS DWORD GLOBAL hDlg AS DWORD %MSG = %WM_USER + 500 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 FUNCTION TestThread(BYVAL OBJECTPTR AS DWORD) AS DWORD '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Test thread to send messages with the object pointer ' To the dialog ' Date : '--------------------------------------------------------------------- LOCAL iCount AS LONG LOCAL tObject AS DISPATCH LOCAL lObject AS DWORD LOCAL vResult AS VARIANT LOCAL lReserved AS LONG lReserved = 0 FOR iCount = 1 TO 5 DIALOG SEND hDlg, %MSG, OBJECTPTR, iCount SLEEP 1000 NEXT iCount END FUNCTION THREAD FUNCTION DoeventsThread(BYVAL DUMMY AS DWORD) AS DWORD '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Do Events thread to keep the dialog from choking ' Date : '--------------------------------------------------------------------- LOCAL X AS LONG DO DIALOG DOEVENTS DIALOG GET SIZE hDlg TO x, x LOOP WHILE x& ' When x& = 0, dialog has ended END FUNCTION CALLBACK FUNCTION ConnectProc() AS LONG '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Dialog Procedure to handle object messages and to fire ' Events on the main thread ' Date : '--------------------------------------------------------------------- LOCAL tObject AS DISPATCH LOCAL dObject AS DWORD LOCAL lProgress AS LONG SELECT CASE AS LONG CBMSG CASE %MSG dObject = CBWPARAM POKE DWORD,VARPTR(tObject),dObject OBJECT CALL tObject.Doit(lProgress) POKE DWORD,VARPTR(tObject), 0 CASE ELSE 'Do nothing END SELECT END FUNCTION INTERFACE EVENT_TEST GUID$("{39B83F43-1108-48B7-9751-0194B62339F8}") AS EVENT '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Main Event Interface ' Date : '--------------------------------------------------------------------- INHERIT IUNKNOWN METHOD Progress(BYVAL Percent AS LONG) END INTERFACE CLASS CAPPLICATION GUID$("{5BE00DB6-9E7B-47D9-8B18-76712765E86F}") AS COM '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : The Application Class ' Date : '--------------------------------------------------------------------- CLASS METHOD CREATE ALIAS "Create"() '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Create Our main dialog to handle object event messages ' Date : '--------------------------------------------------------------------- LOCAL Result AS LONG LOCAL lResult AS LONG LOCAL lReserved AS LONG lReserved = 0 CoinitializeEx lReserved,0 DIALOG NEW 0, "",,, 0, 0 TO hDlg DIALOG SHOW MODELESS hDlg CALL ConnectProc TO Result DIALOG SHOW STATE %SW_HIDE, hDlg 'now lets call our doevents thread THREAD CREATE doeventsthread(1) TO lResult THREAD CLOSE lResult TO lResult END METHOD CLASS METHOD Destroy ALIAS "Destroy"() '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Close the dialog when the object is destroyed ' Date : '--------------------------------------------------------------------- 'Close the dialog DIALOG END hDlg,%TRUE CoUninitialize END METHOD 'CLASS METHOD TriggerEvent(BYVAL i AS LONG) '--------------------------------------------------------------------- ' Author : ' Purpose : ' Date : '--------------------------------------------------------------------- ' RAISEEVENT EVENT_TEST.Progress(i) 'END METHOD INTERFACE APPLICATION GUID$("{85B6D13D-0E6A-4E9B-9934-F420DFE6C6F4}") INHERIT DUAL METHOD Doit ALIAS "Doit"(BYVAL lProgress AS LONG) '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Main "EVENT" handler function call. ' Date : '--------------------------------------------------------------------- RAISEEVENT EVENT_TEST.Progress(lProgress) END METHOD METHOD Submit ALIAS "Submit"() AS LONG '--------------------------------------------------------------------- ' Author : Thomas Tierney ' Purpose : Sets the object to me, and passes "ME" off to the test thread ' This is so we can pass the entire object off in the CBWPARAM ' in the send message ' Date : '--------------------------------------------------------------------- LOCAL tResult AS LONG LOCAL tObject AS DISPATCH LET tObject = ME THREAD CREATE TestThread(OBJPTR(tObject)) TO tResult THREAD CLOSE tResult TO tResult END METHOD END INTERFACE EVENT SOURCE EVENT_TEST END CLASS