Private MaxChan As Integer


Private Sub Command1_Click()

Text1.Text = Empty

End Sub

Private Sub Command2_Click()
Command2.Enabled = False
Dim s As String
Dim i As Integer
Dim num, count As Integer

count = 0

If List1.ListCount > 0 Then
    For i = List1.ListCount - 1 To 0 Step -1
        If List1.Selected(i) = True Then
            s = Trim(List1.List(i))
            num = Val(Right(s, 1))
            tcpServer(num).SendData Text3.Text
        Else
            count = count + 1
        End If
    Next i
    If count = List1.ListCount Then
        MsgBox "您没有选择接收的对象！", vbOKOnly, "【消息提示】"
    End If
Else
     MsgBox "还没有客户端连接到服务器！", vbOKOnly, "【消息提示】"
End If

Command2.Enabled = True

End Sub

Private Sub Command3_Click()

Dim i As Integer

MaxChan = Val(Text5.Text)

For i = 1 To MaxChan - 1

    Load tcpServer(i)

Next i

tcpListen.LocalPort = Val(Text2.Text)

Text4.Text = tcpListen.LocalIP

tcpListen.Listen

Command3.Enabled = False

Shape1.BackColor = RGB(0, 255, 0)

End Sub

Private Sub Command4_Click()
Command4.Enabled = False
 
Dim i, j As Integer
Dim s As String
For i = 0 To MaxChan - 1

    If tcpServer(i).State = 0 Then

        For j = List1.ListCount - 1 To 0 Step -1
            s = Trim(List1.List(j))
            If i = Val(Right(s, 1)) Then
                List1.RemoveItem j
            End If
        Next j
    End If
Next i
Command4.Enabled = True
End Sub

Private Sub Command5_Click()

End

End Sub

Private Sub Command6_Click()
Dim i, j As Integer
Dim flag As Boolean
flag = False
If List1.ListCount > 0 Then
    For i = List1.ListCount - 1 To 0 Step -1
        If List1.Selected(i) = True Then
            s = Trim(List1.List(i))
            j = Val(Right(s, 1))
            tcpServer(j).Close
            List1.RemoveItem i
            flag = True
        End If
    Next i
    If flag = False Then
        MsgBox "您没有选择要分离的对象！", vbOKOnly, "【消息提示】"
    End If
Else
     MsgBox "还没有客户端连接到服务器！", vbOKOnly, "【消息提示】"
End If
End Sub

Private Sub tcpBusy_Close()

tcpBusy.Close

End Sub

Private Sub tcpBusy_DataArrival(ByVal bytesTotal As Long)

tcpBusy.SendData "服务器忙，请稍后再连接！"

DoEvents

End Sub

Private Sub tcpBusy_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

tcpBusy.Close

End Sub

Private Sub tcpListen_ConnectionRequest(ByVal requestID As Long)

Dim i As Integer
Dim s As String

'决定由哪一Winsock接受请求

For i = 0 To MaxChan - 1

    If tcpServer(i).State = 0 Then

    Exit For

    End If

Next i

'如果有空闲的Winsock则让其接受请求

If i < MaxChan Then
    If tcpServer(i).State = 0 Then

        tcpServer(i).Accept requestID
        
        s = tcpServer(i).RemoteHostIP
        
        List1.AddItem "IP:" & Trim(s) & "连接 " & " 通道" & Trim(Str(i))

        Exit Sub
    End If
End If

'如果所有Winsock都用完则由专门的“忙”Winsock接受请求，以免用户要求得不到响应

tcpBusy.Close

tcpBusy.Accept requestID

End Sub

Private Sub tcpListen_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

tcpListen.Close

tcpListen.LocalPort = Val(Text2.Text)

tcpListen.Listen

End Sub

Private Sub tcpServer_Close(Index As Integer)
Dim i As Integer
Dim s As String

tcpServer(Index).Close

For i = List1.ListCount - 1 To 0 Step -1
    s = Trim(List1.List(i))
    If Index = Val(Right(s, 1)) Then
        List1.RemoveItem i
    End If
Next i

End Sub

Private Sub tcpServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)

Dim s As String

Dim i As Integer

Dim s_ip As String

tcpServer(Index).GetData s

s_ip = tcpServer(Index).RemoteHostIP

If UCase(Left(Trim(s), 2)) = "PT" Then '判断是否为悄悄话，点对点方式

    If IsNumeric(Mid(Trim(s), 3, 1)) Then

    i = Mid(Trim(s), 3, 1)

    tcpServer(i).SendData "Channel " & Index & " " & Right(Trim(s), Len(Trim(s)) - 3)

    DoEvents

    End If

Else '广播方式

   For i = 0 To MaxChan - 1

   '利用winsock的State属性给所有连接在服务器上的客户发消息

   If tcpServer(i).State = 7 Then

       tcpServer(i).SendData "Channel " & Index & " " & Trim(s)

       DoEvents

   End If

   Next i

  End If

Text1.Text = Text1.Text & "Channel:" & Index & " " & "IP:" & s_ip & " " & "Data:" & Trim(s)
End Sub

Private Sub tcpServer_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

tcpServer(Index).Close

End Sub

Private Sub Text2_Change()
Dim i As Integer
For i = 1 To Len(Text2.Text)
    If Asc(Mid(Text2.Text, i, 1)) > 0 Then
Else
    MsgBox "端口号只能为数字！", vbOKOnly, "【消息提示】"
    Text2.Text = Empty
End If
Next

End Sub

Private Sub Text3_Change()
Dim i As Integer

For i = 1 To Len(Text3.Text)
    If Asc(Mid(Text3.Text, i, 1)) > 0 Then
Else
    MsgBox "发送内容只能为字符格式！", vbOKOnly, "【消息提示】"
    Text3.Text = Empty
End If
Next

End Sub

Private Sub Text5_Change()

Dim i As Integer

For i = 1 To Len(Text5.Text)
    If Asc(Mid(Text5.Text, i, 1)) > 0 Then
Else
    MsgBox "连接数量只能为数字！", vbOKOnly, "【消息提示】"
    Text5.Text = Empty
End If
Next

If Val(Text5.Text) > 10 Then
    MsgBox "本程序最多支持10个客户端！", vbOKOnly, "【消息提示】"
    Text5.Text = 10
End If

End Sub