VB多用户Winsock控件通讯实例

 有一位CSDN的朋友不明白如何利用Winsock控件进行多用户之间的网络通讯，于是俺写了一个，希望对有此方面需要的朋友有所帮助！

    本代码可以同时支持多个客户端的连接、识别和通讯，主要思路是在连接成功后，由客户主动发送一个用户名，服务器端以此用户名对客户进行区分，为防止同名客户，服务器端在用户名后加了一个后缀。由于写得匆忙，难免有失误，恳请指正！

    服务器代码如下：

Option Explicit  
'* ************************************************************** *  
'*    程序名称：frmServer  
'*    程序功能：服务器  
'*    作者：lyserver  
'*    联系方式：http://blog.csdn<a href="http://lib.csdn.net/base/dotnet" class='replace_word' title=".NET知识库" target='_blank' style='color:#df3434; font-weight:bold;'>.NET</a>/lyserver  
'* ************************************************************** *  
  
Dim UserCookie() As Long  
  
Private Sub Form_Load()  
    ReDim UserCookie(0)  
    btnSend.Enabled = False  
    wskListen.Bind 9999, "127.0.0.1"            '绑定到127.0.0.1的9999端口  
    wskListen.Listen                            '监听网络连接  
End Sub  
  
Private Sub Form_Unload(Cancel As Integer)  
    Dim i As Long  
      
    On Error Resume Next  
    Erase UserCookie  
    For i = wskServer.UBound To 1 Step -1  
        wskServer(i).Close  
        Unload wskServer(i)  
    Next  
    wskListen.Close  
End Sub  
  
Private Sub btnSend_Click()  
    Dim i As Integer  
    For i = 1 To wskServer.UBound  
        If wskServer(i).Tag = cmbClient Then  
            wskServer(i).SendData txtSend  
            Exit Sub  
        End If  
    Next  
End Sub  
  
Private Sub btnClose_Click()  
    Unload Me  
End Sub  
  
Private Sub wskListen_ConnectionRequest(ByVal requestID As Long)  
    Dim i As Long  
      
    For i = 1 To wskServer.UBound  
        If wskServer(i).State = sckClosed Then  
            UserCookie(i) = requestID  
            wskServer(i).Accept requestID  
            Exit Sub  
        End If  
    Next  
    Load wskServer(i)  
    wskServer(i).Accept requestID  
    ReDim Preserve UserCookie(i)  
    UserCookie(i) = requestID  
End Sub  
  
Private Sub wskServer_Close(Index As Integer)  
    wskServer(Index).Close  
    wskServer(Index).Tag = ""  
    cmbClient.RemoveItem Index  
    cmbClient.ListIndex = cmbClient.ListCount - 1  
    cmbClient.Tag = cmbClient.Text  
    btnSend.Enabled = (cmbClient.ListCount > 0)  
End Sub  
  
Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)  
    Dim strData As String  
      
    wskServer(Index).GetData strData, vbString  
  
    If Len(wskServer(Index).Tag) = 0 Then  
        If InStr(strData, "UserName=") = 1 Then  
            wskServer(Index).Tag = Mid(strData, 10) & "-" & UserCookie(Index)  
            cmbClient.AddItem wskServer(Index).Tag  
            cmbClient.ListIndex = cmbClient.ListCount - 1  
            cmbClient.Tag = cmbClient.Text  
            btnSend.Enabled = (cmbClient.ListCount > 0)  
        End If  
    Else  
        strData = "[" & wskServer(Index).Tag & "]说：" & strData  
        If Len(txtReceive) > 0 Then strData = vbCrLf & strData  
        txtReceive = txtReceive & strData  
    End If  
End Sub  
  
Private Sub wskServer_SendComplete(Index As Integer)  
    'MsgBox "给[" & cmbClient.Tag & "]的内容已发送完毕!", vbInformation, "提示"  
End Sub  
  
Private Sub cmbClient_Click()  
    btnSend.Enabled = (cmbClient.ListCount > 0)  
End Sub  
  
Private Function FindUser(ByVal lCookie As Long) As String  
    Dim i As Long  
      
    For i = 0 To cmbClient.ListCount - 1  
        If InStr(cmbClient.List(i), "-" & lCookie) > 0 Then Exit For  
    Next  
    FindUser = cmbClient.List(i)  
End Function  

客户端代码如下：

Option Explicit  
'* ************************************************************** *  
'*    程序名称：frmClient  
'*    程序功能：客户端  
'*    作者：lyserver  
'*    联系方式：http://blog.csdn<a href="http://lib.csdn.net/base/dotnet" class='replace_word' title=".NET知识库" target='_blank' style='color:#df3434; font-weight:bold;'>.Net</a>/lyserver  
'* ************************************************************** *  
Dim m_bSuccess As Boolean  
  
Private Sub Form_Load()  
    btnSend.Enabled = False  
    btnDisconnect.Enabled = False  
End Sub  
  
Private Sub Form_Unload(Cancel As Integer)  
    wskClient.Close  
End Sub  
  
Private Sub btnConnect_Click()  
    If Len(txtUserName) = 0 Then  
        MsgBox "用户名不能为空!", vbCritical, "提示"  
    Else  
        wskClient.Connect "127.0.0.1", 9999  
        btnDisconnect.Enabled = True  
    End If  
End Sub  
  
Private Sub btnDisconnect_Click()  
    wskClient.Close  
    btnConnect.Enabled = True  
    btnSend.Enabled = False  
    btnDisconnect.Enabled = False  
    txtUserName.Locked = False  
End Sub  
  
Private Sub btnSend_Click()  
    wskClient.SendData txtSend  
End Sub  
  
Private Sub btnClose_Click()  
    Unload Me  
End Sub  
  
Private Sub wskClient_Close()  
    m_bSuccess = False  
    btnSend.Enabled = False  
    btnDisconnect.Enabled = False  
    wskClient.Close  
    'MsgBox "对方已断开连接", vbCritical, "警告"  
End Sub  
  
Private Sub wskClient_Connect()  
    m_bSuccess = True  
    wskClient.SendData "UserName=" & txtUserName  
    btnSend.Enabled = True  
    btnConnect.Enabled = False  
    txtUserName.Locked = True  
End Sub  
  
Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)  
    Dim strData As String  
      
    wskClient.GetData strData, vbString  
    If Len(txtReceive) > 0 Then strData = vbCrLf & strData  
    txtReceive = txtReceive & strData  
End Sub