VB中使用Sockets控件

1，主窗体

Private Sub chkAutoHold_Click()
    If chkAutoHold.Value = Checked Then
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "设置自动保持连接" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        TimerAutoConnect.Enabled = True
    Else
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "取消自动保持连接" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        TimerAutoConnect.Enabled = False
    End If
End Sub

Private Sub chkToppest_Click()
    If chkToppest.Value = Checked Then
        SetWindowPos frmMain.hWnd, -1, 0, 0, 0, 0, 3
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "设置窗体最上层显示" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    Else
        SetWindowPos frmMain.hWnd, -2, 0, 0, 0, 0, 3
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "取消窗体最上层显示" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    End If
End Sub

****清空接收区数据

Private Sub cmdCleanReceive_Click()
    If txtReceiveB.Text <> "" Or txtReceiveS.Text <> "" Then
        txtReceiveB.Text = ""
        txtReceiveS.Text = ""
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "清空接收窗口信息" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    End If
End Sub

***清空发送数据

Private Sub cmdCleanSend_Click()
    If txtSendB.Text <> "" Or txtSendS.Text <> "" Then
        txtSendB.Text = ""
        txtSendS.Text = ""
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "清空发送窗口信息" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    End If
End Sub

***手工连接

Private Sub cmdConnectListen_Click()
    Dim I As Integer
    If cmdConnectListen.Caption <> "关  闭" Then
        If comboCSType.Text = "服务端" Then
            txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "启动服务端监听" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
            If CreateListen() = False Then
                Exit Sub
            End If
            If comboSocketType.Text = "TCP" Then
                frmMain.Caption = "Socket测试工具（正在监听TCP" & txtLocalPort.Text & "端口）"
            Else
                frmMain.Caption = "Socket测试工具（正在监听UDP" & txtUDPLocalPort.Text & "端口）"
            End If
            comboRemoteIPID.ListIndex = 0
            cmdConnectListen.ToolTipText = "关闭本地监听端口"
        Else
            txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "启动客户端连接" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
            If CreateConnection() = False Then
                Exit Sub
            End If
            cmdConnectListen.ToolTipText = "关闭与远程Socket的连接"
        End If
        comboSocketType.Enabled = False
        comboCSType.Enabled = False
        cmdConnectListen.Caption = "关  闭"
    Else
        If comboCSType.Text = "服务端" Then
            If CloseConnection() = False Then
                Exit Sub
            End If
            For I = 1 To MaxConnecttionNum
                If wsckSocket(I).State = sckConnected Then
                    Exit Sub
                End If
            Next
            wsckSocket(0).Close
            frmMain.Caption = "Socket测试工具（无连接）"
            comboSocketType.Enabled = True
            comboCSType.Enabled = True
            frameServer.Visible = True
            frameClient.Visible = False
            cmdConnectListen.Caption = "监  听"
        Else
            If CloseConnection() = False Then
                Exit Sub
            End If
            frmMain.Caption = "Socket测试工具（无连接）"
            comboSocketType.Enabled = True
            comboCSType.Enabled = True
            frameClient.Visible = True
            frameServer.Visible = False
            cmdConnectListen.Caption = "连  接"
        End If
    End If
End Sub

****发送按钮

Private Sub cmdSend_Click()
    If lblSendB.Caption <> "二进制（当前发送类型）：" Then
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "向目标发送当前文本信息" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    Else
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "向目标发送当前二进制信息" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    End If
    Call SendData
End Sub

***选择协议类型

Private Sub comboCSType_Click()
    On Error Resume Next
    If comboCSType.Text = "服务端" Then
        frameServer.Visible = True
        frameClient.Visible = False
        cmdConnectListen.Caption = "监  听"
        cmdConnectListen.ToolTipText = "监听本地端口"
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "设置工具为服务端" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        txtLocalPort.SetFocus
    Else
        frameClient.Visible = True
        frameServer.Visible = False
        cmdConnectListen.Caption = "连  接"
        cmdConnectListen.ToolTipText = "连接远程Socket"
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "设置工具为客户端" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        txtRemoteIP.SetFocus
    End If
End Sub

***选择服务类型

Private Sub comboSocketType_Click()
    On Error Resume Next
    If comboSocketType.Text = "TCP" Then
        wsckSocket(0).Close
        wsckSocket(0).Protocol = sckTCPProtocol
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "设置通讯协议为TCP/IP协议" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        frameUDP.Visible = False
        If comboCSType.Text = "服务端" Then
            frameServer.Visible = True
            frameClient.Visible = False
            cmdConnectListen.Caption = "监  听"
            cmdConnectListen.ToolTipText = "监听本地端口"
        Else
            frameClient.Visible = True
            frameServer.Visible = False
            cmdConnectListen.Caption = "连  接"
            cmdConnectListen.ToolTipText = "连接远程Socket"
            txtRemoteIP.SetFocus
        End If
        comboCSType.Enabled = True
        cmdSend.Enabled = False
    Else
        comboCSType.ListIndex = 0
        wsckSocket(0).Close
        wsckSocket(0).Protocol = sckUDPProtocol
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "设置通讯协议为UDP协议" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        frameUDP.Visible = True
        comboCSType.Enabled = False
        frameClient.Visible = False
        frameServer.Visible = False
        txtUDPLocalPort.SetFocus
        If txtUDPRemoteIP.Text <> "" Then
            wsckSocket(0).RemoteHost = txtUDPRemoteIP.Text
        End If
        If txtUDPRemotePort.Text <> "" Then
            wsckSocket(0).RemotePort = txtUDPRemotePort.Text
        End If
        cmdConnectListen.Caption = "监  听"
        cmdSend.Enabled = True
    End If
End Sub

Private Sub Form_Activate()
    If cmdConnectListen.Caption <> "关  闭" Then
        comboSocketType.ListIndex = 0
        comboCSType.ListIndex = 1
    End If
    chkToppest.Value = Checked
    MaxConnecttionNum = 0
    CurrentSendNum = 0
End Sub

Private Sub imgAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub lblConsoleInfo_Click()
    txtConsoleMsg.Text = ""
End Sub

Private Sub lblSendB_Click()
    If lblSendB.Caption <> "二进制（当前发送类型）：" Then
        lblSendB.ForeColor = vbRed
        lblSendB.Caption = "二进制（当前发送类型）："
        lblSendS.ForeColor = vbBlue
        lblSendS.Caption = "文本："
        txtSendB.Locked = False
        txtSendS.Locked = True
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "切换当前发送类型为“二进制”" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        txtSendB.SetFocus
    End If
End Sub

Private Sub lblSendS_Click()
    If lblSendS.Caption <> "文本（当前发送类型）：" Then
        lblSendS.ForeColor = vbRed
        lblSendS.Caption = "文本（当前发送类型）："
        lblSendB.ForeColor = vbBlue
        lblSendB.Caption = "二进制："
        txtSendB.Locked = True
        txtSendS.Locked = False
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "切换当前发送类型为“文本”" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        txtSendS.SetFocus
    End If
End Sub

Private Sub TimerAutoConnect_Timer()
    If wsckSocket(0).State <> sckConnected Then
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "发现连接断开，启动自动保持连接！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        cmdSend.Enabled = False
        wsckSocket(0).Close
        Call cmdConnectListen_Click
    End If
End Sub

Private Sub txtSendB_Change()
    If lblSendS.Caption <> "文本（当前发送类型）：" Then
        If Int((Len(txtSendB.Text) + 1) / 3) = (Len(txtSendB.Text) + 1) / 3 Then
            If BackSpaceFlag = False Then
                txtSendB.Text = txtSendB.Text & " "
                txtSendB.SelStart = Len(txtSendB.Text)
            Else
                txtSendB.Text = Left(txtSendB.Text, Len(txtSendB.Text) - 1)
                txtSendB.SelStart = Len(txtSendB.Text)
            End If
        End If
        BackSpaceFlag = False
        txtSendS.Text = TxtBinToText(txtSendB.Text)
    End If
End Sub

Private Sub txtSendB_KeyPress(KeyAscii As Integer)
    Select Case Chr(KeyAscii)
        Case "0"
        Case "1"
        Case "2"
        Case "3"
        Case "4"
        Case "5"
        Case "6"
        Case "7"
        Case "8"
        Case "9"
        Case "A"
        Case "B"
        Case "C"
        Case "D"
        Case "E"
        Case "F"
        Case "a": KeyAscii = Asc("A")
        Case "b": KeyAscii = Asc("B")
        Case "c": KeyAscii = Asc("C")
        Case "d": KeyAscii = Asc("D")
        Case "e": KeyAscii = Asc("E")
        Case "f": KeyAscii = Asc("F")
        Case Chr(8):
            BackSpaceFlag = True
        Case Chr(13):
            If txtSendB.Locked = False Then
                KeyAscii = 0
                txtSendB.SelStart = 0
                txtSendB.SelLength = Len(txtSendB.Text)
                MsgBox "Send"
            End If
        Case Else
            KeyAscii = 0
    End Select
End Sub

Private Sub txtSendS_Change()
    If lblSendS.Caption = "文本（当前发送类型）：" Then
        txtSendB.Text = TextToTxtBin(txtSendS.Text)
    End If
End Sub

Private Function CloseConnection() As Boolean
    Dim I As Integer
    Dim TmpStr As String
    Dim TempStr As String
   
    On Error GoTo errHandler
    If comboCSType.Text = "服务端" Then
        If comboSocketType.Text = "TCP" Then
            If comboRemoteIPID.Text = "All" Then
                For I = 0 To MaxConnecttionNum
                    If wsckSocket(I).State = sckConnected Then
                        wsckSocket_Close I
                    End If
                    wsckSocket(I).Close
                Next
            Else
                TmpStr = comboRemoteIPID.Text
                TempStr = TmpStr
                wsckSocket_Close CInt(GetConnectElement(TmpStr, 1))
                wsckSocket(CInt(GetConnectElement(TempStr, 1))).Close
            End If
        Else
            wsckSocket(0).Close
        End If
    Else
        If comboSocketType.Text = "TCP" Then
            wsckSocket_Close 0
            wsckSocket(0).Close
        Else
        End If
    End If
    CloseConnection = True
    Exit Function
errHandler:
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "关闭连接失败！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    CloseConnection = False
End Function

Private Function CreateListen() As Boolean
    On Error GoTo errHandler
    Call CleanRemoteIPIDList
    txtConnectNum.Text = 0
    If comboSocketType.Text = "TCP" Then
        wsckSocket(0).Bind txtLocalPort.Text
        wsckSocket(0).Listen
    Else
        wsckSocket(0).Close
        wsckSocket(0).LocalPort = txtUDPLocalPort.Text
        wsckSocket(0).Bind txtUDPLocalPort.Text
    End If
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "启动服务端监听成功！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    CreateListen = True
    Exit Function
errHandler:
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "启动服务端监听失败！请检查端口设置！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    CreateListen = False
End Function

Private Function CreateConnection() As Boolean
    On Error GoTo errHandler
    If comboSocketType.Text = "TCP" Then
        wsckSocket(0).Close
        wsckSocket(0).Protocol = sckTCPProtocol
        wsckSocket(0).Connect txtRemoteIP.Text, txtRemotePort.Text
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "正在连接服务端……" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    Else
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "已准备好连接服务端！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        cmdSend.Enabled = True
        frmMain.Caption = "Socket测试工具（已连接" & txtRemoteIP.Text & "：" & txtRemotePort.Text & "）"
    End If
    CreateConnection = True
    Exit Function
errHandler:
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "启动客户端连接失败！请检查设置！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    CreateConnection = False
End Function

Private Sub CleanRemoteIPIDList()
    comboRemoteIPID.Clear
    comboRemoteIPID.AddItem "All"
End Sub

Private Sub txtUDPRemoteIP_Change()
    On Error Resume Next
    If txtUDPRemoteIP.Text <> "" Then
        wsckSocket(0).Close
        wsckSocket(0).RemoteHost = txtUDPRemoteIP.Text
        wsckSocket(0).RemotePort = txtUDPRemotePort.Text
    End If
End Sub

Private Sub txtUDPRemotePort_Change()
    On Error Resume Next
    If txtUDPRemotePort.Text <> "" Then
        wsckSocket(0).Close
        wsckSocket(0).RemoteHost = txtUDPRemoteIP.Text
        wsckSocket(0).RemotePort = txtUDPRemotePort.Text
    End If
End Sub

Private Sub wsckSocket_Close(Index As Integer)
    Dim I As Integer
    On Error Resume Next
    If comboCSType.Text = "服务端" Then
        If Index > 0 Then
            For I = 0 To comboRemoteIPID.ListCount - 1
                If GetConnectElement(comboRemoteIPID.List(I), 1) = CStr(Index) Then
                    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "来自“" & GetConnectElement(comboRemoteIPID.List(I), 2) & "”的连接关闭，ID为“" & GetConnectElement(comboRemoteIPID.List(I), 3) & "”！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
                    comboRemoteIPID.RemoveItem I
                    comboRemoteIPID.Refresh
                    comboRemoteIPID.ListIndex = 0
                    Exit For
                End If
            Next
            txtConnectNum.Text = txtConnectNum.Text - 1
            If txtConnectNum.Text = 0 Then
                cmdSend.Enabled = False
            End If
        Else
            If comboSocketType.Text = "TCP" Then
                txtConnectNum.Text = 0
            End If
            txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "关闭对端口“" & txtLocalPort & "”的监听！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
            cmdSend.Enabled = False
        End If
    Else
        wsckSocket(0).Close
        comboSocketType.Enabled = True
        comboCSType.Enabled = True
        frameClient.Visible = True
        frameServer.Visible = False
        cmdConnectListen.Caption = "连  接"
        frmMain.Caption = "Socket测试工具（无连接）"
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "与“" & txtRemoteIP & "：" & txtRemotePort & "”的连接关闭！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
        cmdSend.Enabled = False
    End If
End Sub

Private Sub wsckSocket_Connect(Index As Integer)
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "连接服务端成功！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    cmdSend.Enabled = True
    frmMain.Caption = "Socket测试工具（已连接" & txtRemoteIP.Text & "：" & txtRemotePort.Text & "）"
End Sub

Private Sub wsckSocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    Dim Flag As Boolean
    If MaxConnecttionNum > 0 Then
        For I = 1 To MaxConnecttionNum
            If wsckSocket(I).State <> sckConnected Then
                If wsckSocket(I).State <> sckClosed Then wsckSocket(I).Close
                wsckSocket(I).Accept requestID
                Flag = True
                comboRemoteIPID.AddItem I & "：" & wsckSocket(0).RemoteHostIP & "：" & requestID
                comboRemoteIPID.ListIndex = 0
                txtConnectNum.Text = txtConnectNum.Text + 1
                Exit For
            End If
        Next I
    End If
    If Flag = False Then
        txtConnectNum.Text = txtConnectNum.Text + 1
        Load wsckSocket(txtConnectNum.Text)
        If wsckSocket(txtConnectNum.Text).State <> sckClosed Then wsckSocket(txtConnectNum.Text).Close
        wsckSocket(txtConnectNum.Text).Protocol = sckTCPProtocol
        wsckSocket(txtConnectNum.Text).Accept requestID
        comboRemoteIPID.AddItem txtConnectNum.Text & "：" & wsckSocket(0).RemoteHostIP & "：" & requestID
        comboRemoteIPID.ListIndex = 0
        MaxConnecttionNum = CInt(txtConnectNum.Text)
    End If
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "接受来自“" & wsckSocket(0).RemoteHostIP & "”的连接请求，请求ID为“" & requestID & "”！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    cmdSend.Enabled = True
End Sub

****接收数据时触发

Private Sub wsckSocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim ReceivedData() As Byte
    Dim ReceivedB As String
    Dim ReceivedS As String
    Dim I As Integer
    On Error GoTo errHandler
    wsckSocket(Index).GetData ReceivedData
    ReceivedB = Now & "   "
    If comboCSType.Text = "服务端" And comboSocketType.Text = "TCP" Then
        For I = 0 To comboRemoteIPID.ListCount - 1
            If GetConnectElement(comboRemoteIPID.List(I), 1) = CStr(Index) Then
                ReceivedB = ReceivedB & GetConnectElement(comboRemoteIPID.List(I), 2) & "：" & GetConnectElement(comboRemoteIPID.List(I), 3) & Chr(13) & Chr(10)
                txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "收到来自“" & GetConnectElement(comboRemoteIPID.List(I), 2) & "”连接ID为“" & GetConnectElement(comboRemoteIPID.List(I), 3) & "”发送来的数据！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
                Exit For
            End If
        Next
    Else
        ReceivedB = ReceivedB & wsckSocket(Index).RemoteHostIP & "：" & wsckSocket(Index).RemotePort & Chr(13) & Chr(10)
        txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "收到来自“" & wsckSocket(Index).RemoteHostIP & "：" & wsckSocket(Index).RemotePort & "”的数据！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
    End If
    ReceivedS = ReceivedB
    ReceivedB = ReceivedB & BytesToTxtBin(ReceivedData) & Chr(13) & Chr(10)
    ReceivedB = ReceivedB & "----------------------------------------------" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
    txtReceiveB.Text = ReceivedB & txtReceiveB.Text
    ReceivedS = ReceivedS & StrConv(ReceivedData, vbUnicode) & Chr(13) & Chr(10)
    ReceivedS = ReceivedS & "----------------------------------------------" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
    txtReceiveS.Text = ReceivedS & txtReceiveS.Text
    Exit Sub
errHandler:
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & Err.Description & "，传输失败！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
End Sub

****发送数据

Private Sub SendData()
    Dim I As Integer
    Dim M As Integer
    On Error GoTo errHandler
    If comboSocketType.Text = "TCP" Then
        If comboCSType.Text = "服务端" Then
            If comboRemoteIPID.Text = "All" Then
                CurrentSendNum = 1
                If lblSendB.Caption <> "二进制（当前发送类型）：" Then
                    If wsckSocket(CurrentSendNum).State = sckConnected Then
                        wsckSocket(CurrentSendNum).SendData txtSendS.Text
                        For M = 0 To comboRemoteIPID.ListCount - 1
                            If GetConnectElement(comboRemoteIPID.List(M), 1) = CStr(CurrentSendNum) Then
                                ReceivedB = ReceivedB & GetConnectElement(comboRemoteIPID.List(M), 2) & "：" & GetConnectElement(comboRemoteIPID.List(M), 3) & Chr(13) & Chr(10)
                                txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "向“" & GetConnectElement(comboRemoteIPID.List(M), 2) & "”ID为“" & GetConnectElement(comboRemoteIPID.List(M), 3) & "”的连接发送当前文本信息！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
                                Exit For
                            End If
                        Next
                    End If
                Else
                    If wsckSocket(CurrentSendNum).State = sckConnected Then
                        wsckSocket(CurrentSendNum).SendData TxtBinToBytes(txtSendB.Text)
                        For M = 0 To comboRemoteIPID.ListCount - 1
                            If GetConnectElement(comboRemoteIPID.List(M), 1) = CStr(CurrentSendNum) Then
                                ReceivedB = ReceivedB & GetConnectElement(comboRemoteIPID.List(M), 2) & "：" & GetConnectElement(comboRemoteIPID.List(M), 3) & Chr(13) & Chr(10)
                                txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "向“" & GetConnectElement(comboRemoteIPID.List(M), 2) & "”ID为“" & GetConnectElement(comboRemoteIPID.List(M), 3) & "”的连接发送当前二进制信息！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
                                Exit For
                            End If
                        Next
                    End If
                End If
                cmdSend.Enabled = False
            Else
                If lblSendB.Caption <> "二进制（当前发送类型）：" Then
                    If wsckSocket(CInt(GetConnectElement(comboRemoteIPID.Text, 1))).State = sckConnected Then
                        wsckSocket(CInt(GetConnectElement(comboRemoteIPID.Text, 1))).SendData txtSendS.Text
                    End If
                Else
                    If wsckSocket(CInt(GetConnectElement(comboRemoteIPID.Text, 1))).State = sckConnected Then
                        wsckSocket(CInt(GetConnectElement(comboRemoteIPID.Text, 1))).SendData TxtBinToBytes(txtSendB.Text)
                    End If
                End If
            End If
        Else
            If lblSendB.Caption <> "二进制（当前发送类型）：" Then
                If wsckSocket(0).State = sckConnected Then
                    wsckSocket(0).SendData txtSendS.Text
                End If
            Else
                If wsckSocket(0).State = sckConnected Then
                    wsckSocket(0).SendData TxtBinToBytes(txtSendB.Text)
                End If
            End If
        End If
    Else
        If lblSendB.Caption <> "二进制（当前发送类型）：" Then
            wsckSocket(0).SendData txtSendS.Text
        Else
            wsckSocket(0).SendData TxtBinToBytes(txtSendB.Text)
        End If
    End If
    Exit Sub
errHandler:
    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & Err.Description & "，传输失败！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
End Sub

Private Sub wsckSocket_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)
    Dim I As Integer
    For I = 0 To comboRemoteIPID.ListCount - 1
        If GetConnectElement(comboRemoteIPID.List(I), 1) = CStr(Index) Then
            txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "来自“" & GetConnectElement(comboRemoteIPID.List(I), 2) & "”的Socket“" & GetConnectElement(comboRemoteIPID.List(I), 3) & "”发生错误！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
            Exit For
        End If
    Next
End Sub

Private Sub wsckSocket_SendComplete(Index As Integer)
    Dim M As Integer
   
    If CurrentSendNum > 0 Then
        If comboCSType.Text = "服务端" Then
            If comboRemoteIPID.Text = "All" Then
                CurrentSendNum = CurrentSendNum + 1
                If CurrentSendNum > MaxConnecttionNum Then
                    CurrentSendNum = 0
                    cmdSend.Enabled = True
                    Exit Sub
                End If
                If comboSocketType.Text = "TCP" Then
                    If lblSendB.Caption <> "二进制（当前发送类型）：" Then
                        If wsckSocket(CurrentSendNum).State = sckConnected Then
                            wsckSocket(CurrentSendNum).SendData txtSendS.Text
                            For M = 0 To comboRemoteIPID.ListCount - 1
                                If GetConnectElement(comboRemoteIPID.List(M), 1) = CStr(CurrentSendNum) Then
                                    ReceivedB = ReceivedB & GetConnectElement(comboRemoteIPID.List(M), 2) & "：" & GetConnectElement(comboRemoteIPID.List(M), 3) & Chr(13) & Chr(10)
                                    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "向“" & GetConnectElement(comboRemoteIPID.List(M), 2) & "”ID为“" & GetConnectElement(comboRemoteIPID.List(M), 3) & "”的连接发送当前文本信息！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
                                    Exit For
                                End If
                            Next
                        End If
                    Else
                        If wsckSocket(CurrentSendNum).State = sckConnected Then
                            wsckSocket(CurrentSendNum).SendData TxtBinToBytes(txtSendB.Text)
                            For M = 0 To comboRemoteIPID.ListCount - 1
                                If GetConnectElement(comboRemoteIPID.List(M), 1) = CStr(CurrentSendNum) Then
                                    ReceivedB = ReceivedB & GetConnectElement(comboRemoteIPID.List(M), 2) & "：" & GetConnectElement(comboRemoteIPID.List(M), 3) & Chr(13) & Chr(10)
                                    txtConsoleMsg.Text = Now & Chr(13) & Chr(10) & "向“" & GetConnectElement(comboRemoteIPID.List(M), 2) & "”ID为“" & GetConnectElement(comboRemoteIPID.List(M), 3) & "”的连接发送当前二进制信息！" & Chr(13) & Chr(10) & "----------------------------" & Chr(13) & Chr(10) & txtConsoleMsg.Text
                                    Exit For
                                End If
                            Next
                        End If
                    End If
                Else
                End If
            End If
        End If
    End If
End Sub

 

2，

*****module模块：函数据模块

Declare Function SetWindowPos& Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Public BackSpaceFlag As Boolean
Public MaxConnecttionNum As Integer
Public CurrentSendNum As Integer

'文本格式的16进制数转换成纯文本字符串格式
Function TxtBinToText(Source As String) As String
    Dim I As Integer
    Dim M As Integer
    Dim Tmp() As Byte
   
    ReDim Tmp(Len(Source))
    M = 0
    For I = 1 To Len(Source) Step 3
        Tmp(M) = CByte(Val("&h" & Trim(Mid(Source, I, 3))))
        M = M + 1
    Next
    TxtBinToText = CStr(Tmp)
End Function

'文本格式的16进制数转换成16进制字节流
Function TxtBinToBytes(Source As String) As Byte()
    Dim I As Integer
    Dim M As Integer
    Dim Tmp() As Byte
   
    ReDim Tmp(Len(Source))
    M = 0
    For I = 1 To Len(Source) Step 3
        Tmp(M) = CByte(Val("&h" & Trim(Mid(Source, I, 3))))
        M = M + 1
    Next
    TxtBinToBytes = Tmp
End Function

'16进制字节流转换成文本格式的16进制数
Function BytesToTxtBin(Source() As Byte) As String
    Dim I As Integer
    For I = 0 To UBound(Source)
        BytesToTxtBin = BytesToTxtBin & DecToHexS(CInt(Source(I))) & " "
    Next
End Function

'纯文本字符串格式转换成文本格式的16进制数
Function TextToTxtBin(Source As String) As String
    Dim Tmp() As Byte
    Dim I As Integer
   
    Tmp = Source
    For I = 0 To UBound(Tmp)
        TextToTxtBin = TextToTxtBin & DecToHexS(CInt(Tmp(I))) & " "
    Next
End Function

'格式化文本格式的16进制数
Function TrimTxtBin(Source As String) As String
    Dim I As Integer
    Dim Tmp As String
   
    Tmp = ""
    For I = 1 To Len(Source)
        If Mid(Source, I, 1) = "1" Or Mid(Source, I, 1) = "2" Or Mid(Source, I, 1) = "3" _
          Or Mid(Source, I, 1) = "4" Or Mid(Source, I, 1) = "5" Or Mid(Source, I, 1) = "6" _
          Or Mid(Source, I, 1) = "7" Or Mid(Source, I, 1) = "8" Or Mid(Source, I, 1) = "9" _
          Or Mid(Source, I, 1) = "0" Or Mid(Source, I, 1) = "a" Or Mid(Source, I, 1) = "b" _
          Or Mid(Source, I, 1) = "c" Or Mid(Source, I, 1) = "d" Or Mid(Source, I, 1) = "e" _
          Or Mid(Source, I, 1) = "f" Or Mid(Source, I, 1) = "A" Or Mid(Source, I, 1) = "B" _
          Or Mid(Source, I, 1) = "C" Or Mid(Source, I, 1) = "D" Or Mid(Source, I, 1) = "E" _
          Or Mid(Source, I, 1) = "F" Then
            Tmp = Tmp & Mid(Source, I, 1)
        End If
    Next
    Tmp = UCase(Tmp)
    TrimTxtBin = ""
    For I = 1 To Len(Tmp) Step 2
        TrimTxtBin = TrimTxtBin & Mid(Tmp, I, 2) & " "
    Next
End Function

'十进制256以内整数转换成2位16进制字符串格式数
Function DecToHexS(DecVal As Integer) As String
    Dim Tmp As Integer
    Dim Temp As Integer
    Tmp = Int(DecVal / 16)
    Temp = DecVal - Tmp * 16
    DecToHexS = ""
    Select Case Tmp
        Case 0: DecToHexS = DecToHexS & "0"
        Case 1: DecToHexS = DecToHexS & "1"
        Case 2: DecToHexS = DecToHexS & "2"
        Case 3: DecToHexS = DecToHexS & "3"
        Case 4: DecToHexS = DecToHexS & "4"
        Case 5: DecToHexS = DecToHexS & "5"
        Case 6: DecToHexS = DecToHexS & "6"
        Case 7: DecToHexS = DecToHexS & "7"
        Case 8: DecToHexS = DecToHexS & "8"
        Case 9: DecToHexS = DecToHexS & "9"
        Case 10: DecToHexS = DecToHexS & "A"
        Case 11: DecToHexS = DecToHexS & "B"
        Case 12: DecToHexS = DecToHexS & "C"
        Case 13: DecToHexS = DecToHexS & "D"
        Case 14: DecToHexS = DecToHexS & "E"
        Case 15: DecToHexS = DecToHexS & "F"
    End Select
    Select Case Temp
        Case 0: DecToHexS = DecToHexS & "0"
        Case 1: DecToHexS = DecToHexS & "1"
        Case 2: DecToHexS = DecToHexS & "2"
        Case 3: DecToHexS = DecToHexS & "3"
        Case 4: DecToHexS = DecToHexS & "4"
        Case 5: DecToHexS = DecToHexS & "5"
        Case 6: DecToHexS = DecToHexS & "6"
        Case 7: DecToHexS = DecToHexS & "7"
        Case 8: DecToHexS = DecToHexS & "8"
        Case 9: DecToHexS = DecToHexS & "9"
        Case 10: DecToHexS = DecToHexS & "A"
        Case 11: DecToHexS = DecToHexS & "B"
        Case 12: DecToHexS = DecToHexS & "C"
        Case 13: DecToHexS = DecToHexS & "D"
        Case 14: DecToHexS = DecToHexS & "E"
        Case 15: DecToHexS = DecToHexS & "F"
    End Select
End Function

'获取消息协议中的参数
Public Function GetMsgElement(Msg As String, Num As Integer) As String
    Dim I As Integer
    Dim StartPos As Integer
    Dim NowNum As Integer

    On Error Resume Next
   
    If Len(Msg) = 0 Then
        GetMsgElement = ""
        Exit Function
    End If
    For I = 1 To Len(Msg)
        Select Case Mid(Msg, I, 1)
            Case ">":
                StartPos = I
                NowNum = 1
            Case ",":
                If NowNum = Num Then
                    GetMsgElement = Mid(Msg, StartPos + 1, I - StartPos - 1)
                    Exit Function
                Else
                    StartPos = I
                    NowNum = NowNum + 1
                End If
            Case "<":
                If NowNum = Num Then
                    GetMsgElement = Mid(Msg, StartPos + 1, I - StartPos - 1)
                    Exit Function
                Else
                    GetMsgElement = ""
                    Exit Function
                End If
        End Select
    Next I
    GetMsgElement = ""
End Function

'获取连接字符串中的参数
Public Function GetConnectElement(Msg As String, Num As Integer) As String
    Dim I As Integer
    Dim StartPos As Integer
    Dim NowNum As Integer

    On Error Resume Next
   
    If Len(Msg) = 0 Or Msg = "All" Then
        GetConnectElement = ""
        Exit Function
    End If
    Msg = ">" & Msg & "<"
    For I = 1 To Len(Msg)
        Select Case Mid(Msg, I, 1)
            Case ">":
                StartPos = I
                NowNum = 1
            Case "：":
                If NowNum = Num Then
                    GetConnectElement = Mid(Msg, StartPos + 1, I - StartPos - 1)
                    Exit Function
                Else
                    StartPos = I
                    NowNum = NowNum + 1
                End If
            Case "<":
                If NowNum = Num Then
                    GetConnectElement = Mid(Msg, StartPos + 1, I - StartPos - 1)
                    Exit Function
                Else
                    GetConnectElement = ""
                    Exit Function
                End If
        End Select
    Next I
    GetConnectElement = ""
End Function