（3）Windows 多线程编程
2007-08-11 01:21开始我们的第3讲....
实例讲解及应用
一个完整，且很漂亮的线程类，拿出来写上注释
Option Explicit
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
'创建线程的Api, Any 型参数,我们视为 Long 型对待
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
'退出线程的Api, 由第3方中止线程的函数 (以线程本身为 1, 系统为 2 , 其他程序为 3 来区分)
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
'设置线程优先级Api的函数
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
'获取线程优先级Api的函数
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'关闭一个句柄, 关闭一个句柄意味着系统将回收占有此句柄的进程(线程,代码..)所使用的数据
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
'获取当前线程的1个伪句柄
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'获取当前线程的1个实例句柄
Private Const MAXLONG = &H7FFFFFFF
'定义设置优先级时错误返回的标识（错误号）
Private Const THREAD_BASE_PRIORITY_IDLE = -15
'定义一个线程的优先级为 IDLE
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
'定义一个线程的优先级为 LOWRT
Private Const THREAD_BASE_PRIORITY_MAX = 2
'定义一个线程的优先级为 MAX
Private Const THREAD_BASE_PRIORITY_MIN = -2
'定义一个线程的优先级为 MIN
Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
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 THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
'定义一个线程的优先级; 以上 8 个为优先级的扩充, 实际最多为 13 个
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
tpLowest = THREAD_PRIORITY_LOWEST
tpBelowNormal = THREAD_PRIORITY_BELOW_NORMAL
tpNormal = THREAD_PRIORITY_NORMAL
tpAboveNormal = THREAD_PRIORITY_ABOVE_NORMAL
tpHighest = THREAD_PRIORITY_HIGHEST
End Enum
'定义线程的基本优先级; 此 5 个优先级水平为最常用
Private mThreadHandle As Long
'定义一个变量存储被创建的线程句柄
Private mThreadID As Long
'定义一个变量存储被创建的线程的ID
Private mPriority As Long
'定义一个变量存储被创建的线程的优先级属性
Private mEnabled As Boolean
'定义一个变量存储被创建的线程的挂起状态
Private mCreated As Boolean
'定义一个变量存储是否成功的创建了一个线程
Public Function CreateNewThread(ByVal cFunction As Long, Optional ByVal lParam As Long, Optional ByVal cPriority As ThreadPriority = tpNormal, Optional ByVal cEnabled As Boolean = True)
'***************************************************
'** 函 数: 创建一个新线程
'** 返回值: 线程句柄; 为 Api CreateThread 函数的返回值,此返回值不为 0 ,说明调用成功
'** 参 数: ByVal cFunction As Long -> 新线程开始执行的地址(函数地址)
'** Optional ByVal lParam As Long -> 新线程开始执行的函数的参数,只有1个Long型参数,需要更多参数,则考虑用结构代替
'** Optional ByVal cPriority As ThreadPriority = tpNormal -> 新线程有用的默认优先级水平,默认为普通级别
'** Optional ByVal cEnabled As Boolean = True -> 新线程是否在创建后立即执行已指定的代码.
'***************************************************
Dim mHandle As Long
'临时变量,用于接收 Api 函数的返回值
Dim CreationFlags As Long
'临时变量,用于保存参数 cEnabled 所指定的操作选项
Dim lpThreadID As Long
'临时变量,用于接收 Api 函数所返回的线程 ID(句柄)
If mCreated = True Then Exit Function
'用于标识一个类模块中只能同时起动一个线程,如果已经有线程在运行中,则退出函数
If cEnabled = True Then
'如果指定了,在线程创建后立即执行,则 Api 函数参数 CreationFlags 赋值 0
CreationFlags = 0
Else
'如果指定了在线程创建后先挂起,等待信号在执行则,则 Api 函数参数 CreationFlags 赋值 CREATE_SUSPENDED
CreationFlags = CREATE_SUSPENDED
End If
mHandle = CreateThread(ByVal 0&, ByVal 1024&, cFunction, ByVal lParam, CreationFlags, lpThreadID)
'调用线程创建 Api 函数 CreateThread, 第1个参数指定:线程的安全属性,传值 O,表示由系统创建一个默认的安全属性
第2个参数指定:线程栈堆大小为默认(1般默认即为512k),系统可能随时根据需要自动调整.
第3个参数指定:线程代码执行的其实地址,一个函数地址.
第4个参数指定:为指定的函数传递一个 Long 型参数.
第5个参数指定:线程创建后的动作; 挂起 or 执行.
第6个参数指定:以传址的方式传递1个Long型变量,Api函数会将新线程的ID复制到这里(保持Windows一贯的谁使用谁申请风格)
If mHandle = 0 Then 'Failed creating the thread
'通过返回值 mHandle 判断,Api 函数是否执行成功,如果为 0 则说明不成功.
Else
'如果成功,保存线程句柄,线程ID,标志线程创建成功等操作
mThreadHandle = mHandle
mThreadID = lpThreadID
mCreated = True
End If
mEnabled = cEnabled
'标志属性 Enabled 的现值
CreateNewThread = mHandle
'函数调用完成,返回一个调用效果代码
Debug.Print mHandle
End Function
Public Function TerminateCurrentThread()
'***************************************************
'** 函 数: 退出一个线程
'** 返回值: 无
'** 参 数: 无
'***************************************************
On Error Resume Next
'无视调用错误
Call TerminateThread(mThreadHandle, ByVal 1&)
'调用退出线程的 Api 函数, 第1个参数指定要关闭的线程句柄, 第2个参数指定该线程的退出码
CloseHandle mThreadHandle
'关闭这个句柄,尽管它已经失效,但我们有必要做到工整,并且符合 Windows 的编程习惯性要求
mCreated = False
'标志此类模块实例中没有已打开的线程
End Function
Public Property Get ThreadHandle() As Long
'***************************************************
'** 函 数: 获取一个已创建的线程句柄
'** 返回值: 线程句柄
'** 参 数: 无
'***************************************************
ThreadHandle = mThreadHandle
End Property
Public Property Get ThreadID() As Long
'***************************************************
'** 函 数: 获取一个已创建的线程ID
'** 返回值: 线程ID
'** 参 数: 无
'***************************************************
ThreadID = mThreadID
End Property
Public Property Get Priority() As Long
'***************************************************
'** 函 数: 获取一个已创建的线程优先级属性
'** 返回值: 线程的优先级
'** 参 数: 无
'***************************************************
On Error Resume Next
Priority = GetThreadPriority(mThreadHandle)
End Property
Public Property Let Priority(ByVal tmpValue As ThreadPriority)
'***************************************************
'** 函 数: 设置一个已创建的线程优先级属性
'** 返回值: 无
'** 参 数: 预定义的优先级
'***************************************************
mPriority = tmpValue
Call SetThreadPriority(mThreadHandle, tmpValue)
End Property
Public Property Get Enabled() As Boolean
'***************************************************
'** 函 数: 获取一个已创建的线程是否在正常执行
'** 返回值: True/Flase
'** 参 数: 无
'***************************************************
Enabled = mEnabled
End Property
Public Property Let Enabled(ByVal tmpValue As Boolean)
'***************************************************
'** 函 数: 设置一个已创建的线程是否挂起/恢复执行
'** 返回值: 无
'** 参 数: true/false
'***************************************************
mEnabled = tmpValue
On Error Resume Next
If tmpValue = True Then
Call ResumeThread(mThreadHandle)
'恢复执行
ElseIf tmpValue = False Then
Call SuspendThread(mThreadHandle)
'挂起,停止执行
End If
End Property
Private Sub Class_Terminate()
Call TerminateCurrentThread
End Sub
