VB多用户Winsock控件通讯实例

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

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

    服务器代码如下：

Option Explicit '* ************************************************************** * '* 程序名称：frmServer '* 程序功能：服务器 '* 作者：lyserver '* 联系方式：http://blog.csdn.net/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.net/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