home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / MThreadVB_882945292002.psc / MCThread.bas < prev    next >
Encoding:
BASIC Source File  |  2001-09-23  |  1.7 KB  |  53 lines
  1. Attribute VB_Name = "Module2"
  2. Public Type TDataEx
  3.     CLASSID As CLSID
  4.     cStream As Long
  5.     ThreadClass As ThreadEX
  6. '   Funcname As String
  7.     FuncParam As Variant
  8.     ClientObject As Object
  9.     ThreadIndex As Long
  10.     EventHandle As Long
  11. End Type
  12.  
  13. Function TProcEx(NewThreadInfo As TDataEx) As Long
  14. Dim hr As Long
  15. Dim pUnk As IUnknown
  16. Dim IID_IUnknown As VBGUID, Obj As Object
  17. Dim FuncName As String
  18. 'Initialize the OLE/COM subsystem
  19. Call CoInitialize(0)
  20. Call WaitForSingleObject(NewThreadInfo.EventHandle, INFINITE)
  21. CloseHandle (NewThreadInfo.EventHandle)
  22.         'Initialize the IUnknown interface ID structure
  23.         With IID_IUnknown
  24.             .Data4(0) = &HC0
  25.             .Data4(7) = &H46
  26.         End With
  27. 'Create a dummy object referencing the ILaunch class
  28. Call CoCreateInstance(NewThreadInfo.CLASSID, Nothing, CLSCTX_INPROC_SERVER, IID_IUnknown, pUnk)
  29. 'Raise the OnThreadStart event
  30. Call WaitForSingleObject(NewThreadInfo.EventHandle, INFINITE)
  31. CloseHandle (NewThreadInfo.EventHandle)
  32. Set Obj = CoGetInterfaceAndReleaseStream(NewThreadInfo.cStream, IID_IUnknown)
  33. NewThreadInfo.ThreadClass.RaiseStart NewThreadInfo.ThreadIndex
  34. 'Call the function which is to be multithreaded
  35.  
  36. FuncName = NewThreadInfo.ThreadClass.GetFunctionName(NewThreadInfo.ThreadIndex)
  37. NewThreadInfo.ThreadClass.SetContextObject NewThreadInfo.ThreadIndex, Obj
  38.  
  39. CallByName NewThreadInfo.ClientObject, FuncName, VbMethod, NewThreadInfo.FuncParam
  40.  
  41. 'Raise the OnThreadFinish event
  42. NewThreadInfo.ThreadClass.RaiseEND NewThreadInfo.ThreadIndex
  43. Call NewThreadInfo.ThreadClass.SetContextObject(NewThreadInfo.ThreadIndex, Nothing)
  44. Set pUnk = Nothing
  45. Set Obj = Nothing
  46. 'Uninitialize the OLE/COM subsystem
  47. Call CoUninitialize
  48. End Function
  49.  
  50.  
  51.  
  52.  
  53.