すいません、VB４しかやってないんです、VBAはやったけど（ぼそ）　チラシの裏だって立派な書き込み空間なんだからねっ！資源の有効活用なんだからねっ！とか偉そうに言ってるけど、実は色々と書き残したいだけ

Imports System
Imports System.Threading

Module OrochMTA

    Delegate Sub DrinkingSAKE()

    '酒ツボに酒を準備 
    Public inSakeTubo As New SakeTubo(40000)

     _
    Public Sub Main()

        '本体で首が別々に酒飲みするのを身構える   

        Dim ts As New ThreadStart(AddressOf OrochiDrinking)

        Dim workerThread As New Thread(ts)

        '首は別々に動けるように、マルチスレッドで宣言
        workerThread.SetApartmentState(ApartmentState.MTA)

        workerThread.Start()

        workerThread.Join()

        Stop

    End Sub

    Private Sub OrochiDrinking()

        'まずは首を八本で飲んでみる   
        Dim headCount As Integer = 8

        '酔っ払い待ち行列を首の数だけ準備   
        Dim yoppa(headCount - 1) As WaitHandle

        For i As Integer = 1 To headCount

            '飲んだ首から酔っ払いへと   
            yoppa(i - 1) = HeadDrinking(i).AsyncWaitHandle

        Next

        '全部の首が酔っ払いになるまで待機   
        WaitHandle.WaitAll(yoppa)

    End Sub

    Private Function HeadDrinking(ByVal headNo As Integer) As IAsyncResult

        '指定した番号の首に酒を飲ませる   
        Dim myHead As New OrochiHead(headNo)

        Dim gubi As New DrinkingSAKE(AddressOf myHead.Drink)

        '酒飲み開始とともに、酔っ払い待ち行列へ戻す   
        Return gubi.BeginInvoke(Nothing, Nothing)

    End Function


    Public Class OrochiHead
        'おろちの首クラス   

        'お前は何番目なのかを保持
        Private meNumber As Integer

        '何番目の首？初期化ｗ 
        Public Sub New(ByVal headNo As Integer)

            meNumber = headNo

        End Sub

        '酒を飲むメソッド   
        Public Sub Drink()

            Dim nowDrink As Integer
            Dim nowNokori As Integer

            Dim oneDrink As New Random
            Dim oneBreath As New Random

            '酒ツボの中の酒を飲み干す   
            While Not (inSakeTubo.Nomihoshited)

                '一回飲むたびに息継ぎ   
                Thread.Sleep(oneBreath.Next(30, 60))

                '酒つぼから飲んでみる
                If inSakeTubo.Nomihoshited Then
                    Console.WriteLine("{0}番目の首「もう酒がねぇよ！！ぷんすか」", meNumber)
                    Exit Sub
                Else
                    '一回ぐび   
                    nowDrink = oneDrink.Next(1, 100)
                    nowNokori = inSakeTubo.Nokori
                    inSakeTubo.Gubi(nowDrink)
                    If inSakeTubo.Nomihoshited Then
                        Console.WriteLine("{0}番目の首「ちきしょう！足りねぇよ！{1}のみてぇのに{2}しかねぇ！」", meNumber, nowDrink, nowNokori)
                        Exit Sub
                    Else
                        Console.WriteLine("{0}番目の首が {1} リットル ぐびっ : 残り {2} リットル", meNumber, nowDrink, inSakeTubo.Nokori)
                    End If
                End If


            End While

            Console.WriteLine("ぷはーっ！ {0}番目の首、飲み終わり！", meNumber)

        End Sub

    End Class


    Public Class SakeTubo
        '酒つぼクラス
        'マルチスレッドでの読み書き保護処理を集約

        Private cacheLock As New ReaderWriterLockSlim()
        Private innerSake As Integer

        Public Sub New(ByVal litter As Integer)

            innerSake = litter

        End Sub

        Public Function Nokori() As Integer
            cacheLock.EnterReadLock()
            Try
                Return innerSake
            Finally
                cacheLock.ExitReadLock()
            End Try
        End Function

        Public Sub Gubi(ByVal gubigubi As Integer)

            Dim retFlag As Boolean = True

            cacheLock.EnterWriteLock()
            Try
                If innerSake > gubigubi Then
                    innerSake -= gubigubi
                Else
                    innerSake = 0
                End If
            Finally
                cacheLock.ExitWriteLock()
            End Try
        End Sub

        Public Sub Karappo()
            cacheLock.EnterWriteLock()
            Try
                innerSake = 0
            Finally
                cacheLock.ExitWriteLock()
            End Try
        End Sub

        Public Function Nomihoshited() As Boolean
            cacheLock.EnterReadLock()
            Try
                Return (innerSake.Equals(0))
            Finally
                cacheLock.ExitReadLock()
            End Try
        End Function

    End Class

End Module