threadobject.cls

来自「此为用vb编写的usb高速数据采集实例 如果没有相应的驱动」· CLS 代码 · 共 53 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ThreadObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

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
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 TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long

Public ThreadStatus As Boolean
Public Thread As Long
Public Property Let Enable(ByVal vNewValue As Boolean)
    If vNewValue = True And Me.ThreadStatus = False Then
        ResumeThread Me.Thread
        Me.ThreadStatus = True
    ElseIf Me.ThreadStatus = True Then
        SuspendThread Me.Thread
        Me.ThreadStatus = False
    End If
End Property

Public Sub Initialize(lpfnBasFunc As Long)
    Dim dwStackSize As Long
    Dim dwCreationFlags As Long
    Dim lpThreadID As Long
    Dim lpParameter As Long
    Dim myNull As Long
    myNull = vbNull
    dwStackSize = 0
    dwCreationFlags = 4
    Me.Thread = CreateThread(0&, dwStackSize, lpfnBasFunc, myNull, dwCreationFlags, lpThreadID)
    If Me.Thread = 0 Then
        MsgBox "Create thread failed"
    End If
End Sub

Public Function TerminateCurrentThread()
    On Error Resume Next
    Call TerminateThread(mThreadHandle, ByVal 0&)
    mCreated = False
End Function