Architecting Life

根据点睛工作室的多线程类改写的，不过没有经过严格测试，好像工作不是很稳定，如果使用不当会出错的说。

Option Explicit

Private Type SECURITY_ATTRIBUTES

nLength As Long

lpSecurityDescriptor As Long

bInheritHandle As Long

End Type

Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Private Declare Function CreateThreadL Lib "kernel32" Alias "CreateThread" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long

Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long

Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long

Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long

Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long

Private Declare Function GetCurrentThread Lib "kernel32" () As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Sub ExitThread Lib "kernel32" (Optional ByVal dwExitCode As Long = 0)

Private Declare Function GetLastError Lib "kernel32" () As Long

' 常数常量

Private Const MAXLONG = &H7FFFFFFF

' 线程优先级常量

Private Const THREAD_BASE_PRIORITY_IDLE = -15

Private Const THREAD_BASE_PRIORITY_LOWRT = 15

Private Const THREAD_BASE_PRIORITY_MAX = 2

Private Const THREAD_BASE_PRIORITY_MIN = -2

Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX

Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE

Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN

Private Const THREAD_PRIORITY_NORMAL = 0

Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT

Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)

Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)

Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)

' 线程创建标志

Private Const CREATE_ALWAYS = 2

Private Const CREATE_NEW = 1

Private Const CREATE_NEW_CONSOLE = &H10

Private Const CREATE_NEW_PROCESS_GROUP = &H200

Private Const CREATE_NO_WINDOW = &H8000000

Private Const CREATE_PROCESS_DEBUG_EVENT = 3

Private Const CREATE_SUSPENDED = &H4

Private Const CREATE_THREAD_DEBUG_EVENT = 2

' 线程优先级结构

Public Enum ThreadPriority

Lowest = THREAD_PRIORITY_LOWEST

BelowNormal = THREAD_PRIORITY_BELOW_NORMAL

Normal = THREAD_PRIORITY_NORMAL

AboveNormal = THREAD_PRIORITY_ABOVE_NORMAL

Highest = THREAD_PRIORITY_HIGHEST

End Enum

Private mAttrib As SECURITY_ATTRIBUTES

Private mEnabled As Boolean

Private mThreadHandle As Long

Private mThreadID As Long

Private mTerminate As Boolean

Public Property Get ThreadID() As Long

ThreadID = mThreadID

End Property

Public Property Get ThreadHandle() As Long

ThreadHandle = mThreadHandle

End Property

Public Function Create(ByVal cFunction As Long, Optional ByVal cPriority As ThreadPriority, Optional ByVal cEnabled As Boolean = True) As Long

Dim CreateFlag As Long

If mThreadHandle <> 0 Then TerminateMe

mEnabled = cEnabled

If mEnabled Then

CreateFlag = CREATE_NEW

Else

CreateFlag = CREATE_SUSPENDED

End If

mAttrib.nLength = Len(mAttrib)

mThreadHandle = CreateThreadL(0, 0, cFunction, 0&, CreateFlag, mThreadID)

If mThreadHandle = 0 Then

MsgBox "Create thread failed!Error code:" & GetLastError, vbOKOnly Or vbCritical, "Error"

End If

End Function

Public Sub SuspendMe()

If mThreadHandle = 0 Or mEnabled = False Then Exit Sub

If SuspendThread(mThreadHandle) <> -1 Then

mEnabled = False

Else

MsgBox "Suspend thread failed!Error code:" & GetLastError, vbOKOnly Or vbCritical, "Error"

End If

End Sub

Public Sub ResumeMe()

If mThreadHandle = 0 Or mEnabled = True Then Exit Sub

If ResumeThread(mThreadHandle) <> -1 Then

mEnabled = True

Else

MsgBox "Resume thread failed!Error code:" & GetLastError, vbOKOnly Or vbCritical, "Error"

End If

End Sub

Public Sub TerminateMe()

If mThreadHandle = 0 Then Exit Sub

TerminateThread mThreadHandle, 0

mThreadHandle = 0

'mTerminate = True

'Do

'    DoEvents

'Loop Until mTerminate

End Sub

Private Sub Class_Terminate()

'TerminateThread mThreadHandle, 0

End Sub