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 / CThread.bas < prev    next >
Encoding:
BASIC Source File  |  2002-02-28  |  4.8 KB  |  121 lines
  1. Attribute VB_Name = "Module1"
  2. '//////////////////////////////////////////////////////////
  3. 'SOME IMPORTANT NOTES !
  4. '//////////////////////////////////////////////////////////
  5. 'Many of you may be wondering how the CreateThread API works
  6. 'Normally it doesn't as far as VB 6 is concerned..
  7. 'In fact, I too, after trial and error had concluded that the
  8. 'only function that CreateThread works with is a blank one
  9. 'or one that only calls the Beep API !
  10.  
  11. 'But a sometime back, things changed ! I came across a demo
  12. 'program created BY AN EXTREMENLY TALENTED AND INNOVATIVE
  13. 'PROGRAMMER CALLED MATT CURLAND (Unfortunately he is not
  14. 'a member of PSC !)
  15.  
  16. 'And in his demo he showed
  17. 'the various OLE APIs that need to be called to make
  18. 'CreateThread safe... His example was very difficuilt to
  19. 'understand owing to the several class modules he used in
  20. 'the Demo and the zigzag nature of execution... After
  21. 'LOTS OF TRIALS AND ERRORS AND QUITE A FEW FREEZES AND REBOOTS
  22. 'I Managed to make the API somewhat safe and have now have
  23. 'Created a reasonably safe generic multithreader for VB.
  24. 'What you see now as I said before is the result of heavy
  25. 'experimentation and LOTS of reboots !
  26. '//////////////////////////////////////////////////////////
  27.  
  28.  
  29. '//////////////////////////////////////////////////////////
  30. 'TECHNICAL STUFF FOR TECH BUFFS AT PSC !!!
  31. '//////////////////////////////////////////////////////////
  32. 'How does the multithreader work ?
  33.  
  34. 'Normally, all VB programs are heavily dependent on the
  35. 'runtime DLL for its functioning
  36. 'In VB 6, within the multithreaded function, any calls
  37. 'to the runtime DLL fails(due to some reason) causing your
  38. 'program to crash immediately....
  39. 'Even an API call is not really compiled in "real" native
  40. 'code in VB and is interpreted by the runtime DLL...
  41. 'This ultimately involves calling the runtime DLL,
  42. 'that causes VB to crash.Most standard VB statements and
  43. 'functions such as Set = , For...Next etc also call the runtime
  44. 'DLL and ultimately even these fail... (So much for native
  45. 'code compilation !)
  46.  
  47. 'If an object could be created within the multithreaded
  48. 'procedure, the VB runtime starts behaving properly...
  49. 'The trouble is,the standard VB instantiator functions fail
  50. 'within the multithreaded procedures...
  51. 'Therefore, I have used the ThreadAPI.Tlb type library to
  52. 'bypass the Runtime and directly call the OLE/COM o
  53. 'APIs (This can be verified using the Dependency Viewer)
  54. 'and create a dummy object inside the multithreaded
  55. 'prodecure. After this has been done, the runtime DLL starts
  56. 'behaving properly and it is possible to call all VB functions
  57. 'safely...
  58. 'Once again I THANK MATT CURLAND, A VERY TALENTED PROGRAMMER
  59. 'FOR GIVING INFO ON USING THE OLE APIs IN VB.
  60. '//////////////////////////////////////////////////////////
  61.  
  62. 'THE THREADAPI.TLB TYPE LIBRARY USED FOR CALLING THE APIs
  63. 'SAFELY WITHIN THE MULTITHREADED PROCEDURE (TProc) Can be
  64. 'DOWNLOADED SEPERATELY FROM VBACCELERATOR.COM TOO...
  65. 'IT IS ALSO INCLUDED WITH THIS PACKAGE
  66.  
  67. Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
  68. Public Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
  69. Public Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
  70. Public Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
  71. Public Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
  72. Public Declare Function GetCurrentThread Lib "kernel32" () As Long
  73.  
  74.  
  75. Public Type TData
  76.     CLASSID As CLSID
  77.     cStream As Long
  78.     ThreadClass As Thread
  79.     FuncParam As Variant
  80.     ClientObject As Object
  81. End Type
  82.  
  83. Function TProc(NewThreadInfo As TData) As Long
  84. Dim hr As Long
  85. Dim pUnk As IUnknown
  86. Dim IID_IUnknown As VBGUID, Obj As Object
  87. Dim FuncName As String
  88. 'Initialize the OLE/COM subsystem
  89. Call CoInitialize(0)
  90.  
  91.         'Initialize the IUnknown interface ID structure
  92.         With IID_IUnknown
  93.             .Data4(0) = &HC0
  94.             .Data4(7) = &H46
  95.         End With
  96. 'Create a dummy object referencing the ILaunch class
  97. Call CoCreateInstance(NewThreadInfo.CLASSID, Nothing, CLSCTX_INPROC_SERVER, IID_IUnknown, pUnk)
  98. 'Raise the OnThreadStart event
  99. Set Obj = CoGetInterfaceAndReleaseStream(NewThreadInfo.cStream, IID_IUnknown)
  100. NewThreadInfo.ThreadClass.SetContextObject Obj
  101. FuncName = NewThreadInfo.ThreadClass.GetMTFuncName
  102. 'Call the function which is to be multithreaded
  103. NewThreadInfo.ThreadClass.RaiseStart
  104. CallByName NewThreadInfo.ClientObject, FuncName, VbMethod, NewThreadInfo.FuncParam
  105.  
  106.  
  107.  
  108.  
  109. 'Raise the OnThreadFinish event
  110. NewThreadInfo.ThreadClass.RaiseEND
  111. NewThreadInfo.ThreadClass.SetContextObject Nothing
  112. Set pUnk = Nothing
  113. Set Obj = Nothing
  114. 'Uninitialize the OLE/COM subsystem
  115. Call CoUninitialize
  116.  
  117. End Function
  118.  
  119.  
  120.  
  121.