Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Example for Visual Basic Multi Threaded Com Component

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

  • Example for Visual Basic Multi Threaded Com Component

    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
    Sr. Software Development Engineer and Sr. Information Security Analyst,
    CEH, Digital Forensic Examiner
Working...
X