VB in the implementation of multithreading!

Multithreading ' feature: Create multithreaded classes for initializing threads. Class Name: Cls_thread

' parameter: Longpointfunction is used to receive the function address value passed over by the keynote process

' Calling method: 1. Declaring thread class object variable Dim mythread as Cls_thread

' 2. Call form: With Mythread

' . Initialize AddressOf Custom procedure or function name ' (initialization thread).

' . threadenabled = True ' (set thread activation)

' End With

' 3. Abort call: Set mythread = Nothing

' Email:lixun007@163.net

' Test on:vb6.0+win2000 and Vb6.0+winxp It ' s pass!



Option Explicit

' Create the Thread API

' This API has been modified, lpthreadattributes changed to any type, lpstartaddress changed to a value reference:

' Because the entry address of the function is passed by the parametric, if you use the address, it will pass the parameter variable's addresses instead of the function's entry address.

Private Declare Function createthread Lib "kernel32" (ByVal lpthreadattributes as any, ByVal dwstacksize as Long, ByVal LP Startaddress as Long, lpparameter as any, ByVal dwcreationflags as Long, lpthreadid as long) as long

' Terminate the thread API

Private Declare Function terminatethread Lib "kernel32" (ByVal hthread as Long, ByVal Dwexitcode as long) as long

' Activate the thread API

Private Declare Function resumethread Lib "kernel32" (ByVal Hthread as long) as long

' Suspend the thread API

Private Declare Function suspendthread Lib "kernel32" (ByVal Hthread as long) as long



Private Const create_suspended = &h4 ' thread suspend constant



' Custom thread structure type

Private Type Udtthread

Handle as Long

Enabled as Boolean

End Type



Private Metheard as Udtthread

' Initialize the thread

Public Sub Initialize (ByVal longpointfunction as Long)

Dim longstacksize as Long, longcreationflags as long, lpthreadid as long, longnull as Long

On Error Resume Next

Longnull = 0

Longstacksize = 0

Longcreationflags = Create_suspended ' to suspend after creating thread, activate thread by program



' Create thread and return thread handle

Metheard.handle = CreateThread (Longnull, Longstacksize, ByVal longpointfunction, Longnull, Longcreationflags, Lpthreadid)



If Metheard.handle = Longnull Then

MsgBox "Thread creation failed! ", 48," wrong "

End If

End Sub



' Get whether the thread activates the property

Public Property Get Threadenabled () as Boolean

On Error Resume Next

Enabled = metheard.enabled

End Property



' Set whether the thread activates the property

Public Property Let Threadenabled (ByVal newvalue as Boolean)

On Error Resume Next

' Activate this thread if the activation thread (NewValue is True) is set to True and this thread was not originally activated

If NewValue and (not metheard.enabled) Then

ResumeThread Metheard.handle

metheard.enabled = True

Else ' Suspend this thread if the thread is activated (NewValue is true) and this thread was originally activated

If metheard.enabled Then

SuspendThread Metheard.handle

metheard.enabled = False

End If

End If

End Property



' Terminate thread events

Private Sub Class_Terminate ()

On Error Resume Next

Call TerminateThread (metheard.handle, 0)

End Sub