threadcontrol.cls

此源码为vb圣经编码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ThreadControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     ThreadAPI.olb (VBoost: API declares used for threading)
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     ThreadData.cls
'     ThreadLaunch.cls
'     ThreadProc.bas
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1
'   Conditional Compilation Values:
'     NOVBOOST = 1 'Removes VBoost dependency
'
' This file is discussed in Chapter 13.
'***************************************************************
Option Explicit
Private m_RunningThreads As Collection   'Collection to hold ThreadData objects for each running thread
Private m_FinishedThreads As Collection  'Collection to hold ThreadData objects for each finished thread

'Called to create a new thread worker thread.
'CLSID can be obtained from a ProgID via CLSIDFromProgID
'InputData contains the data for the new thread. This
'  should never be an object reference.
'fKeepOutputData should be True if you want to retrieve
'  output data with GetWorkerOutput. This must be set for
'  a valid cookie to be returned in OutputDataCookie.
'OutputDataCookie retrieves a cookie that can be used
'  later to retrieve the exit code and output variant
'  from a completed worker thread.
'fStealInputData should be True if the data is large. If
'  this is set, then Data will be Empty on return.
'fReturnThreadHandle must explicitly be set to True to
'  return the created thread handle. This handle can be
'  used for calls like SetThreadPriority and must be
'  closed with CloseHandle.
Friend Function CreateWorkerThread(CLSID As CLSID, InputData As Variant, Optional ByVal fKeepOutputData As Boolean = False, Optional OutputDataCookie As Long, Optional ByVal fStealInputData As Boolean = False, Optional ByVal fReturnThreadHandle As Boolean = False) As Long
Dim InitThreadData As ThreadData
Dim ThreadID As Long
Dim ThreadHandle As Long
Dim hProcess As Long
Dim pThreadData As Long
Dim pThreadDataOutput As Long
Dim pIdleThreadData As Long
    pIdleThreadData = modThreadData.CleanThreads(m_RunningThreads, m_FinishedThreads)
    With InitThreadData
        .CLSID = CLSID
        Set .Controller = Me
        If fStealInputData Then
            #If NOVBOOST Then
                CopyMemory ByVal VarPtr(.InputData), ByVal VarPtr(InputData), 16
                CopyMemory ByVal VarPtr(InputData), 0, 2
            #Else
                VBoost.MoveVariant .InputData, InputData
            #End If
        'ElseIf IsObject(Data) Then
            'Don't support this case, no objects allowed in data
        Else
            .InputData = InputData
        End If
        .fKeepData = fKeepOutputData
    End With
    If pIdleThreadData Then
        ThreadHandle = modThreadData.WakeSleepingThread(pIdleThreadData, InitThreadData, pThreadDataOutput)
    Else
        pThreadData = modThreadData.NewThreadData(InitThreadData, pThreadDataOutput)
        m_RunningThreads.Add pThreadData, CStr(pThreadData)
        ThreadHandle = CreateThread(0, 0, AddressOf ThreadProc.ThreadStart, pThreadData, 0, ThreadID)
        If ThreadHandle Then
            'Turn ownership of the thread handle over to
            'the ThreadData object
            modThreadData.ThreadHandle(pThreadData) = ThreadHandle
        End If
    End If
    If fKeepOutputData Then
        OutputDataCookie = pThreadDataOutput
    End If
    If ThreadHandle Then
        If fReturnThreadHandle Then
            hProcess = GetCurrentProcess
            DuplicateHandle hProcess, ThreadHandle, hProcess, CreateWorkerThread
        End If
    End If
End Function

'Call StopWorkerThreads to signal all worker threads
'and spin until they terminate.
Friend Sub StopWorkerThreads()
    modThreadData.StopThreads m_RunningThreads, m_FinishedThreads
End Sub

'Releases ThreadData objects for all threads
'that are completed. Cleaning happens automatically
'when you call SignalWorkerThreads, StopWorkerThreads,
'and GetWorkerOutput.
Friend Sub CleanCompletedThreads(Optional ByVal fTossCompletedData As Boolean = False)
Dim Iter As Variant
    modThreadData.CleanThreads m_RunningThreads, m_FinishedThreads
    If fTossCompletedData Then
        With m_FinishedThreads
            Do While .Count
                modThreadData.DestroyThreadDataOutput .Item(1)
                .Remove 1
            Loop
        End With
    End If
End Sub

'Call to tell all running worker threads to
'terminate. If the thread hasn't set its
'ThreadSignalPtr yet, then it can't be signaled
'Unlike StopWorkerThreads, this does not block
'while the workers actually terminate.
'SignalWorkerThreads must be called by the owner
'of this class before the ThreadControl instance
'is released.
Friend Sub SignalWorkerThreads()
    modThreadData.SignalThreads m_RunningThreads, m_FinishedThreads
End Sub

'Call to retrieve the data and exit code from
'a worker thread launched with CreateWorkerThread.
'This will return False if the thread has not
'yet completed. You get one call to GetWorkerOutput
'for each cookie.
Friend Function GetWorkerOutput(ByVal OutputDataCookie As Long, hr As Long, ExitCode As Long, OutputData As Variant) As Boolean
Dim DataKey As String
    CleanCompletedThreads
    DataKey = CStr(OutputDataCookie)
    On Error Resume Next
    m_FinishedThreads.Item DataKey
    If Err Then
        On Error GoTo 0
        Exit Function
    End If
    On Error GoTo 0
    modThreadData.GetOutputData OutputDataCookie, hr, ExitCode, OutputData
    modThreadData.DestroyThreadDataOutput OutputDataCookie
    m_FinishedThreads.Remove DataKey
    GetWorkerOutput = True
End Function

Private Sub Class_Initialize()
    Set m_RunningThreads = New Collection
    Set m_FinishedThreads = New Collection
End Sub

Private Sub Class_Terminate()
    CleanCompletedThreads True
End Sub