根据点睛工作室的多线程类改写的,不过没有经过严格测试,好像工作不是很稳定,如果使用不当会出错的说。
Option ExplicitPrivate Type SECURITY_ATTRIBUTESnLength As LonglpSecurityDescriptor As LongbInheritHandle As LongEnd TypePrivate 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 LongPrivate 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 LongPrivate Declare Function TerminateThread Lib “kernel32″ (ByVal hThread As Long, ByVal dwExitCode As Long) As LongPrivate Declare Function SetThreadPriority Lib “kernel32″ (ByVal hThread As Long, ByVal nPriority As Long) As LongPrivate Declare Function GetThreadPriority Lib “kernel32″ (ByVal hThread As Long) As LongPrivate Declare Function ResumeThread Lib “kernel32″ (ByVal hThread As Long) As LongPrivate Declare Function SuspendThread Lib “kernel32″ (ByVal hThread As Long) As LongPrivate Declare Function GetCurrentThread Lib “kernel32″ () As LongPrivate Declare Function GetCurrentThreadId Lib “kernel32″ () As LongPrivate 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 = -15Private Const THREAD_BASE_PRIORITY_LOWRT = 15Private Const THREAD_BASE_PRIORITY_MAX = 2Private Const THREAD_BASE_PRIORITY_MIN = -2Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAXPrivate Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLEPrivate Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MINPrivate Const THREAD_PRIORITY_NORMAL = 0Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRTPrivate 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 = 2Private Const CREATE_NEW = 1Private Const CREATE_NEW_CONSOLE = &H10Private Const CREATE_NEW_PROCESS_GROUP = &H200Private Const CREATE_NO_WINDOW = &H8000000Private Const CREATE_PROCESS_DEBUG_EVENT = 3Private Const CREATE_SUSPENDED = &H4Private Const CREATE_THREAD_DEBUG_EVENT = 2‘ 线程优先级结构Public Enum ThreadPriorityLowest = THREAD_PRIORITY_LOWESTBelowNormal = THREAD_PRIORITY_BELOW_NORMALNormal = THREAD_PRIORITY_NORMALAboveNormal = THREAD_PRIORITY_ABOVE_NORMALHighest = THREAD_PRIORITY_HIGHESTEnd EnumPrivate mAttrib As SECURITY_ATTRIBUTESPrivate mEnabled As BooleanPrivate mThreadHandle As LongPrivate mThreadID As LongPrivate mTerminate As BooleanPublic Property Get ThreadID() As LongThreadID = mThreadIDEnd PropertyPublic Property Get ThreadHandle() As LongThreadHandle = mThreadHandleEnd PropertyPublic Function Create(ByVal cFunction As Long, Optional ByVal cPriority As ThreadPriority, Optional ByVal cEnabled As Boolean = True) As LongDim CreateFlag As LongIf mThreadHandle <> 0 Then TerminateMemEnabled = cEnabledIf mEnabled ThenCreateFlag = CREATE_NEWElseCreateFlag = CREATE_SUSPENDEDEnd IfmAttrib.nLength = Len(mAttrib)mThreadHandle = CreateThreadL(0, 0, cFunction, 0&, CreateFlag, mThreadID)If mThreadHandle = 0 ThenMsgBox “Create thread failed!Error code:” & GetLastError, vbOKOnly Or vbCritical, “Error”End IfEnd FunctionPublic Sub SuspendMe()If mThreadHandle = 0 Or mEnabled = False Then Exit SubIf SuspendThread(mThreadHandle) <> -1 ThenmEnabled = FalseElseMsgBox “Suspend thread failed!Error code:” & GetLastError, vbOKOnly Or vbCritical, “Error”End IfEnd SubPublic Sub ResumeMe()If mThreadHandle = 0 Or mEnabled = True Then Exit SubIf ResumeThread(mThreadHandle) <> -1 ThenmEnabled = TrueElseMsgBox “Resume thread failed!Error code:” & GetLastError, vbOKOnly Or vbCritical, “Error”End IfEnd SubPublic Sub TerminateMe()If mThreadHandle = 0 Then Exit SubTerminateThread mThreadHandle, 0mThreadHandle = 0‘mTerminate = True‘Do‘ DoEvents‘Loop Until mTerminateEnd SubPrivate Sub Class_Terminate()‘TerminateThread mThreadHandle, 0End Sub
Recent Comments