none
[求助] 如何使用Socket讓Server端連接多台Client端? RRS feed

  • 問題

  • 範例程式是Server端連接一台Client端

    請問要如何修改才能讓Server端能同時連接多台Client端?

     

    謝謝回覆!!

     

    程式如下:

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

    Public Class Form1
        Dim intPort As Integer
        '宣告二個執行緒,用於監聽及接受連線
        Dim ListenThread As Thread 'New Thread(AddressOf StartListen)
        Dim AcceptThread As Thread 'New Thread(AddressOf AcceptConnection)

        Public mySocket As Socket    '監聽的Socket

        Dim MsgBuf, DataBuf As String, fListen, fAccept As Boolean

        Delegate Sub DelegateSetText(ByVal InputString As String) ' 委派的介面,須與執行的副程式相同

        '**************************************************************
        '表單的Load事件
        '將旗標設為False
        '**************************************************************
        Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
            fListen = False '監聽旗標
            fAccept = False '接受連線旗標
        End Sub

        '**************************************************************
        '監聽副程式
        '以特定的方式建立Socket,並且進行監聽程序
        '**************************************************************
        Private Sub StartListen()
            intPort = CType(txtPortNo.Text, Integer)
            Try
                'If fAccept = False Then
                mySocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
                'End If
                '監測本機的特定Port
                mySocket.Bind(New IPEndPoint(IPAddress.Parse(txtLocalIPAddress.Text), intPort))
                mySocket.Listen(15) '開始監聽
                Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "等待Socket用戶端連線中.....")
                fListen = True '已開始監聽
            Catch ex As SocketException
                MessageBox.Show(ex.Message)
            End Try
        End Sub

        '**************************************************************
        '接受連線及資料的副程式
        '以Accept接受連線
        '在連線建立後,開始接收來自遠端的資料
        '**************************************************************
        Private Sub AcceptConnection()
            Dim bteAcceptData(1024) As Byte
            Dim intAcceptData As Integer
            Try
                While Not fListen
                    Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "等待建立監測程序…")
                    TimeDelay(30)
                End While
                myAcceptSocket = mySocket.Accept() '接受連線
                fAccept = True
                '顯示遠端電腦資訊
                Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "遠端: " & myAcceptSocket.RemoteEndPoint.ToString)
                '此迴圈不斷接收資料
                Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "開始接受用戶端連線,收受連線資料....")
                While (True)
                    If fAccept Then
                        intAcceptData = myAcceptSocket.Receive(bteAcceptData) '接收資料
                        If intAcceptData > 0 Then '判斷是否結束傳輸
                            Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "接收了 " + intAcceptData.ToString + " 個位元組的資料 !!")
                            Call RxProcess(bteAcceptData)
                            Array.Clear(bteAcceptData, 0, intAcceptData) '清除陣列內容
                        Else    ' Receive lngAcceptData=0 when WinCE close the socket
                            Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "停止接收資料,結束程序")
                            CloseConnection() '關閉程序
                            fListen = False
                            fAccept = False
                            mySocket.Listen(15) '開始監聽
                            Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "等待Socket用戶端連線中.....")
                            fListen = True '已開始監聽
                            'TimeDelay(10000)
                            myAcceptSocket = mySocket.Accept() '接受連線
                            fAccept = True
                            Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, "開始接受用戶端連線,收受連線資料....")
                        End If
                    End If
                End While
            Catch ex As SocketException
                Call DisplayText(RxDataToTextBox_Type.CONNECT_MSG, ex.Message)
                myAcceptSocket.Close()
            End Try
        End Sub

        Public Sub RxProcess(ByVal bteRxDataArray() As Byte)

        End Sub


        '*************************************************************************************************
        '                        Delegate Process
        '*************************************************************************************************
        Private Sub DisplayText(ByVal ControlItem As RxDataToTextBox_Type, ByVal strData As String)
            RxDataToTextBox = ControlItem
            Me.BeginInvoke(New DelegateSetText(AddressOf DisplayTextToControl), New Object() {strData}) ' 開始委派呼叫()
            'Call TimeDelay(150)  ' Need delay to wait Delegate process finished
        End Sub

        Private Sub DisplayTextToControl(ByVal strText As String)
            If RxDataToTextBox = RxDataToTextBox_Type.CONNECT_MSG Then
                txtMessage.Text += strText & vbCrLf
                txtMessage.SelectionStart = txtMessage.TextLength
                txtMessage.ScrollToCaret()
            ElseIf RxDataToTextBox = RxDataToTextBox_Type.GET_PCNAME Then
                txtPCName.Text = strText
            End If
        End Sub

        '**************************************************************
        '監聽按鈕的Click事件
        '啟動監想聽,在延遲一段時間後,啟動接受程序
        '**************************************************************
        Private Sub btnListen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnListen.Click
            ListenThread = New Thread(AddressOf StartListen)
            AcceptThread = New Thread(AddressOf AcceptConnection)
            ListenThread.Start()  '監聽
            TimeDelay(10000)
            AcceptThread.Start() '接收
        End Sub

        '**************************************************************
        '關閉連線的副程式
        '將接聽的Socket及資料收送的Socket均予以關閉(Close方法)
        '**************************************************************
        Sub CloseConnection()
            Try
                myAcceptSocket.Shutdown(SocketShutdown.Both)
                myAcceptSocket.Close()
            Catch ex As SocketException
                MessageBox.Show(ex.Message)
            End Try

        End Sub

        '**************************************************************
        '結束按鈕的Click事件
        '將fEnd旗標設為True
        '最終程序會在計時器中執行
        '**************************************************************
        Private Sub btnEnd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnd.Click
            If fAccept Then
                AcceptThread.Abort()
                ListenThread.Abort()
            End If
            End
        End Sub

     

        Private Sub btnGetPCName_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGetPCName.Click
            If fAccept Then
                txtPCName.Text = ""
                Call SendData(TCPIP_CMD_GET_PCNAME, 1)
            End If
        End Sub

     

        Public Sub SendData(ByVal bytCmd As Byte, ByVal intLen As Integer)
            Dim temp_buf(), send_buf() As Byte
            Dim crc16(1) As Byte
            Dim i As Integer

            ReDim send_buf(intLen + 4)      ' STX1 + STX2 + LTH + FCS1 + FCS2
            send_buf(TCPIP_PACKET_Type.TCPIP_STX1) = TCPIP_STX1_CHAR : send_buf(TCPIP_PACKET_Type.TCPIP_STX2) = TCPIP_STX2_CHAR
            send_buf(TCPIP_PACKET_Type.TCPIP_LTH) = CByte(intLen)
            Select Case bytCmd
                Case TCPIP_CMD_GET_PCNAME
                    send_buf(TCPIP_PACKET_Type.TCPIP_CMD) = bytCmd

            End Select
            ReDim temp_buf(intLen - 1)
            For i = 0 To intLen - 1
                temp_buf(i) = send_buf(i + TCPIP_PACKET_Type.TCPIP_CMD)
            Next
            crc16 = fcs_calc(temp_buf, temp_buf.GetLength(0))
            send_buf(intLen + 3) = crc16(1) : send_buf(intLen + 4) = crc16(0)
            TCPIP_Write(send_buf)
        End Sub

     

        Public Sub TCPIP_Write(ByVal bytSend_Buf() As Byte)
            Dim intRxDataLen As Integer

            Try
                'intRxDataLen = mySocket.Send(Encoding.ASCII.GetBytes(strData))
                intRxDataLen = myAcceptSocket.Send(bytSend_Buf)
                Form1.txtMessage.Text += "傳送了 " + intRxDataLen.ToString + " 個位元組的資料 !!" & vbCrLf
            Catch ex As SocketException
                MessageBox.Show("Socket Error(Write): " + ex.Message)
            End Try
        End Sub

    End Class


     

    2008年12月11日 上午 01:20

解答

所有回覆