Imports System
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading

Public Class StateObject
    Public workSocket As Socket = Nothing
    Public buffer(1024) As Byte
    Public sb As New StringBuilder()
End Class
Public Class WaitFlgObject
    Public Flg As Integer = 0
End Class

Public Class Form1
    Inherits System.Windows.Forms.Form
    Private MREventAccept As New ManualResetEvent(False)
    Private AcceptThread As Thread
    Private ReceiveThread(0) As Thread
    Private ClientAccesses As ArrayList
    Private FSocketHandler As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
    Private MREventReceiveList As ArrayList
    Private MREventReceive As New ManualResetEvent(False)
    Private MREventUser As New ManualResetEvent(False)
    Private WaitFlg As New WaitFlgObject()

    Private AcceptCount As Integer = 0
    Private ThreadNumber As Integer
    Private ThreadUserCount(0) As Integer
    Private Thread_ClientAccesses(0) As Integer

    Private DispDataBuf As String

#Region " Windows フォーム デザイナで生成されたコード "

    Public Sub New()
        MyBase.New()

        ' この呼び出しは Windows フォーム デザイナで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後に初期化を追加します。

    End Sub

    ' Form は dispose をオーバーライドしてコンポーネント一覧を消去します。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    ' Windows フォーム デザイナで必要です。
    Private components As System.ComponentModel.IContainer

    ' メモ : 以下のプロシージャは、Windows フォーム デザイナで必要です。
    ' Windows フォーム デザイナを使って変更してください。  
    ' コード エディタは使用しないでください。
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents LabelS As System.Windows.Forms.Label
    Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
    Friend WithEvents ListBox1 As System.Windows.Forms.ListBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.Button1 = New System.Windows.Forms.Button()
        Me.LabelS = New System.Windows.Forms.Label()
        Me.TextBox1 = New System.Windows.Forms.TextBox()
        Me.ListBox1 = New System.Windows.Forms.ListBox()
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Name = "Button1"
        Me.Button1.TabIndex = 0
        Me.Button1.Text = "Start"
        '
        'LabelS
        '
        Me.LabelS.Location = New System.Drawing.Point(152, 8)
        Me.LabelS.Name = "LabelS"
        Me.LabelS.Size = New System.Drawing.Size(64, 16)
        Me.LabelS.TabIndex = 4
        Me.LabelS.Text = "スレッド数"
        '
        'TextBox1
        '
        Me.TextBox1.Location = New System.Drawing.Point(216, 8)
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.Size = New System.Drawing.Size(32, 19)
        Me.TextBox1.TabIndex = 3
        Me.TextBox1.Text = "3"
        Me.TextBox1.TextAlign = System.Windows.Forms.HorizontalAlignment.Right
        '
        'ListBox1
        '
        Me.ListBox1.ItemHeight = 12
        Me.ListBox1.Location = New System.Drawing.Point(8, 32)
        Me.ListBox1.Name = "ListBox1"
        Me.ListBox1.Size = New System.Drawing.Size(240, 88)
        Me.ListBox1.TabIndex = 5
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 12)
        Me.ClientSize = New System.Drawing.Size(256, 125)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.ListBox1, Me.LabelS, Me.TextBox1, Me.Button1})
        Me.MaximizeBox = False
        Me.Name = "Form1"
        Me.Text = "AsyncServer"
        Me.ResumeLayout(False)

    End Sub

#End Region
    Private Delegate Sub AsyncServerDelegate()

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        ThreadNumber = Val(TextBox1.Text)
        MREventReceiveList = New ArrayList()
        Dim i As Integer
        For i = 0 To ThreadNumber - 1
            MREventReceiveList.Add(MREventReceive)
            ReDim Preserve ReceiveThread(i + 1)
            ReDim Preserve ThreadUserCount(i + 1)
            ThreadUserCount(i) = 0
            ReceiveThread(i) = New Thread(AddressOf Receive)
            ReceiveThread(i).Start()
        Next

        TextBox1.Enabled = False
        AcceptThread = New Thread(AddressOf Accept)
        AcceptThread.Start()

        Button1.Enabled = False
    End Sub
    Private Sub Accept()
        Dim ipHostInfo As IPHostEntry = Dns.Resolve(Dns.GetHostName())
        Dim ipAddress As IPAddress = ipHostInfo.AddressList(0)
        Dim localEndPoint As New IPEndPoint(ipAddress, 11000)

        Dim SocketListener As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
        ClientAccesses = New ArrayList()
        SocketListener.Bind(localEndPoint)
        SocketListener.Listen(100)

        While True
            MREventAccept.Reset()
            SocketListener.BeginAccept(New AsyncCallback(AddressOf CallbackAccept), SocketListener)
            MREventAccept.WaitOne()
        End While

    End Sub
    Private Sub CallbackAccept(ByVal ar As IAsyncResult)
        Dim intMREvent As Integer
        AcceptCount = AcceptCount + 1
        intMREvent = AcceptCount Mod ThreadNumber

        MREventUser.Reset()
        SyncLock WaitFlg
            If WaitFlg.Flg = 1 Then
                MREventUser.WaitOne()
            End If
            WaitFlg.Flg = 1
        End SyncLock

        Dim SocketHandler As Socket = ar.AsyncState.EndAccept(ar)
        MREventAccept.Set()
        ClientAccesses.Add(SocketHandler)

        FSocketHandler = SocketHandler

        'ユーザー数の少ないスレッドを探す
        Dim i As Integer
        Dim num As Integer
        Dim MinThreadNo As Integer
        num = ThreadUserCount(0)
        MinThreadNo = 0
        For i = 1 To ThreadNumber - 1
            If num > ThreadUserCount(i) Then
                num = ThreadUserCount(i)
                MinThreadNo = i
            End If
        Next
        intMREvent = MinThreadNo
        ReDim Preserve Thread_ClientAccesses(ClientAccesses.Count)
        Thread_ClientAccesses(ClientAccesses.Count) = intMREvent

        MREventReceive = MREventReceiveList(intMREvent)
        MREventReceive.Set()

        ThreadUserCount(intMREvent) = ThreadUserCount(intMREvent) + 1

        DispDataBuf = "■接続したユーザーのスレッド番号：" & intMREvent
        ' Form1のリストボックスに表示
        Me.Invoke(New AsyncServerDelegate(AddressOf DispReceiveData))
        For i = 0 To ThreadNumber - 1
            DispDataBuf = "スレッド" & i & "のユーザー数：" & ThreadUserCount(i)
            'Form1のリストボックスに表示
            Me.Invoke(New AsyncServerDelegate(AddressOf DispReceiveData))
        Next
    End Sub

    Private Sub Receive()
        MREventReceive = MREventReceiveList(MREventReceiveList.Count - 1)
        While True
            MREventReceive.WaitOne()
            Dim state As New StateObject()
            state.workSocket = FSocketHandler
            FSocketHandler.BeginReceive(state.buffer, 0, 1024, 0, New AsyncCallback(AddressOf CallbackReceive), state)
            MREventReceive.Reset()

            WaitFlg.Flg = 0
            MREventUser.Set()
        End While

    End Sub
    Private Sub CallbackReceive(ByVal ar As IAsyncResult)
        Dim state As StateObject = CType(ar.AsyncState, StateObject)
        Dim SocketHandler As Socket = state.workSocket
        Dim bytesRead As Integer
        Try
            bytesRead = SocketHandler.EndReceive(ar)
        Catch
        End Try

        Dim strindex As Integer
        If bytesRead > 0 Then
            state.sb.Append(Encoding.Default.GetString(state.buffer, 0, bytesRead))
            strindex = InStr(state.sb.ToString, "[messageend]")
            If strindex > 0 Then
                Send(SocketHandler, Mid(state.sb.ToString(), 1, strindex - 1), ClientAccesses)
                state.sb.Remove(0, state.sb.Length)
            End If
            SocketHandler.BeginReceive(state.buffer, 0, 1024, 0, New AsyncCallback(AddressOf CallbackReceive), state)
        End If
    End Sub

    Private Sub Send(ByVal SocketHandler As Socket, ByVal data As String, ByVal ClientAcc As ArrayList)
        Dim byteData As Byte() = Encoding.Default.GetBytes(data)
        Dim SocketH As Socket
        Dim i, j As Integer
        Dim ErrNo(0) As Integer
        For i = 0 To ClientAcc.Count - 1
            Try
                SocketH = CType(ClientAcc(i), Socket)
                SocketH.BeginSend(byteData, 0, byteData.Length, 0, New AsyncCallback(AddressOf CallbackSend), SocketH)
            Catch e As Exception
                ReDim Preserve ErrNo(UBound(ErrNo) + 1)
                ErrNo(UBound(ErrNo)) = i
            End Try
        Next

        If UBound(ErrNo) > 0 Then
            For i = UBound(ErrNo) To 1 Step -1
                'スレッド配列からユーザー数を1減らす
                ThreadUserCount(Thread_ClientAccesses(ErrNo(i) + 1)) = ThreadUserCount(Thread_ClientAccesses(ErrNo(i) + 1)) - 1
                For j = ErrNo(i) + 1 To ClientAcc.Count - 1
                    '配列要素を前に詰める
                    Thread_ClientAccesses(j) = Thread_ClientAccesses(j + 1)
                Next
                ClientAcc.RemoveAt(ErrNo(i))
            Next
        End If
    End Sub

    Private Sub CallbackSend(ByVal ar As IAsyncResult)
        Dim bytesSent As Integer = ar.AsyncState.EndSend(ar)

    End Sub
    Private Sub DispReceiveData()
        Me.ListBox1.Items.Add(DispDataBuf)
    End Sub

    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        If Button1.Enabled = False Then
            AcceptThread.Abort()
            Dim i As Integer
            For i = 0 To ThreadNumber - 1
                ReceiveThread(i).Abort()
            Next
        End If
    End Sub
End Class
