VB in the implementation of multithreading!

Source: Internet
Author: User
Tags thread thread class
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

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.