Option Explicit On
Option Strict Off

Imports System.Threading
Imports System.Collections

Public Delegate Sub ThreadErrorHandlerDelegate(ByVal oWorkItem As ThreadPoolWorkItem, ByVal oError As Exception)

Public Class ThreadPoolWorkItem
    Public m_bStoreOutput As Boolean = False
    Public m_sName As String = ""
    Public m_pMethod As [Delegate] = Nothing
    Public m_pInput As Object() = Nothing
    Public m_oOutput As Object = Nothing
    Public m_oException As Exception = Nothing
    Public Sub New()
    End Sub
    Public Sub New(ByVal sName As String, ByVal pMethod As [Delegate], ByVal pInput As Object(), ByVal bStoreOutput As Boolean)
        m_sName = sName
        m_pMethod = pMethod
        m_pInput = pInput
        m_bStoreOutput = bStoreOutput
    End Sub
End Class

Public Class XYThreadPool
    Private m_htThreads As Hashtable = New Hashtable(256)
    Private m_nMinThreadCount As Integer = 5
    Private m_nMaxThreadCount As Integer = 10
    Private m_nShutdownPause As Integer = 200
    Private m_nServerPause As Integer = 25
    Private m_bContinue As Boolean = False
    Private m_oException As Exception = Nothing
    Private m_qInput As Queue = New Queue(1024)
    Private m_qOutput As Queue = New Queue(1024)
    Private m_delegateThreadErrorHandler As [Delegate] = New ThreadErrorHandlerDelegate(AddressOf OnThreadError)
    Private Sub ThreadProc()
        While m_bContinue
            Dim obj As Object = Nothing
            Monitor.Enter(Me)
            If m_qInput.Count > 0 Then obj = m_qInput.Dequeue()
            Monitor.Exit(Me)
            If obj Is Nothing Then
                Dim bQuit As Boolean = False
                Monitor.Enter(Me)
                If m_htThreads.Count > m_nMinThreadCount Then
                    m_htThreads.Remove(Thread.CurrentThread.Name)
                    bQuit = True
                End If
                Monitor.Exit(Me)
                If bQuit Then Return
                Thread.Sleep(10 * m_nServerPause)
            Else
                Dim oWorkItem As ThreadPoolWorkItem = CType(obj, ThreadPoolWorkItem)
                'oWorkItem.m_oOutput = oWorkItem.m_pMethod.DynamicInvoke(oWorkItem.m_pInput)
                Try
                    oWorkItem.m_oOutput = oWorkItem.m_pMethod.DynamicInvoke(oWorkItem.m_pInput)
                Catch oBug As Exception
                    If Not m_delegateThreadErrorHandler Is Nothing Then
                        Try
                            Dim pInput As Object() = {oWorkItem, oBug}
                            m_delegateThreadErrorHandler.DynamicInvoke(pInput)
                        Catch
                        End Try
                    End If
                End Try
                If oWorkItem.m_bStoreOutput Then
                    Monitor.Enter(m_qOutput)
                    m_qOutput.Enqueue(oWorkItem)
                    Monitor.Exit(m_qOutput)
                End If
                Thread.Sleep(m_nServerPause)
            End If
        End While
    End Sub
    Private Sub OnThreadError(ByVal oWorkItem As ThreadPoolWorkItem, ByVal oError As Exception)
        If oWorkItem Is Nothing Then
            m_oException = oError
        Else
            oWorkItem.m_oException = oError
        End If
    End Sub
    Public Sub SetThreadErrorHandler(ByVal pMethod As ThreadErrorHandlerDelegate)
        Monitor.Enter(Me)
        m_delegateThreadErrorHandler = pMethod
        Monitor.Exit(Me)
    End Sub
    Public Sub SetServerPause(ByVal nMilliseconds As Integer)
        Monitor.Enter(Me)
        If nMilliseconds > 9 And nMilliseconds < 101 Then m_nServerPause = nMilliseconds
        Monitor.Exit(Me)
    End Sub
    Public Sub SetShutdownPause(ByVal nMilliseconds As Integer)
        Monitor.Enter(Me)
        m_nShutdownPause = nMilliseconds
        Monitor.Exit(Me)
    End Sub
    Public Function GetException() As Exception
        Return m_oException
    End Function
    Public Sub InsertWorkItem(ByVal oWorkItem As ThreadPoolWorkItem)
        Try
            Monitor.Enter(Me)
            m_qInput.Enqueue(oWorkItem)
            If m_bContinue AndAlso m_qInput.Count > m_htThreads.Count AndAlso m_htThreads.Count < m_nMaxThreadCount Then
                Dim th As Thread = New Thread(AddressOf ThreadProc)
                th.Name = Guid.NewGuid.ToString()
                m_htThreads.Add(th.Name, th)
                th.Start()
            End If
        Catch oBug As Exception
            m_oException = oBug
        Finally
            Monitor.Exit(Me)
        End Try
    End Sub
    Public Sub InsertWorkItem(ByVal sName As String, ByVal pMethod As [Delegate], ByVal pArgs As Object(), ByVal bStoreOutput As Boolean)
        InsertWorkItem(New ThreadPoolWorkItem(sName, pMethod, pArgs, bStoreOutput))
    End Sub
    Public Function ExtractWorkItem() As ThreadPoolWorkItem
        Dim oWorkItem As Object = Nothing
        Monitor.Enter(m_qOutput)
        If m_qOutput.Count > 0 Then oWorkItem = m_qOutput.Dequeue()
        Monitor.Exit(m_qOutput)
        If oWorkItem Is Nothing Then Return Nothing
        Return CType(oWorkItem, ThreadPoolWorkItem)
    End Function
    Public Function StartThreadPool(Optional ByVal nMinThreadCount As Integer = 5, Optional ByVal nMaxThreadCount As Integer = 10) As Boolean
        Try
            Monitor.Enter(Me)
            If m_bContinue = False Then
                m_bContinue = True
                If nMinThreadCount > 0 Then
                    m_nMinThreadCount = nMinThreadCount
                End If
                If nMaxThreadCount > m_nMinThreadCount Then
                    m_nMaxThreadCount = nMaxThreadCount
                Else
                    m_nMaxThreadCount = 2 * m_nMinThreadCount
                End If
                Dim i As Integer
                For i = 1 To m_nMinThreadCount
                    Dim th As Thread = New Thread(AddressOf ThreadProc)
                    th.Name = Guid.NewGuid.ToString()
                    m_htThreads.Add(th.Name, th)
                    th.Start()
                Next i
            End If
            Return True
        Catch oBug As Exception
            m_bContinue = False
            m_oException = oBug
            Return False
        Finally
            Monitor.Exit(Me)
        End Try
    End Function
    Public Sub StopThreadPool()
        Monitor.Enter(Me)
        m_bContinue = False
        Thread.Sleep(Math.Max(200, m_nShutdownPause))
        If (m_nShutdownPause > 0) Then
            Dim dict As IDictionaryEnumerator = m_htThreads.GetEnumerator()
            While dict.MoveNext()
                Dim th As Thread = CType(dict.Value(), Thread)
                If th.IsAlive Then
                    Try
                        th.Abort()
                    Catch
                    End Try
                End If
            End While
        End If
        m_htThreads.Clear()
        m_qInput.Clear()
        ' m_qOutput.Clear()
        Monitor.Exit(Me)
    End Sub
    Public Function GetThreadCount() As Integer
        Monitor.Enter(Me)
        Dim nCount As Integer = m_htThreads.Count
        Monitor.Exit(Me)
        Return nCount
    End Function
End Class