VB多用户Winsock控件通讯实例

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

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

服务器代码如下：

Option Explicit '* ************************************************************** * '* 程序<a href="https://www.jb51.cc/tag/mingcheng/" target="_blank" class="keywords">名称</a>：frmServer '* 程序<a href="https://www.jb51.cc/tag/gongneng/" target="_blank" class="keywords">功能</a>：服务器 '* 作者：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) 'Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "给[" & cmbClient.Tag & "]的<a href="https://www.jb51.cc/tag/neirong/" target="_blank" class="keywords">内容</a>已发送完毕!",vb<a href="https://www.jb51.cc/tag/informat/" target="_blank" class="keywords">informat</a>ion,"<a href="https://www.jb51.cc/tag/tishi/" target="_blank" class="keywords">提示</a>" 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 '* ************************************************************** * '* 程序<a href="https://www.jb51.cc/tag/mingcheng/" target="_blank" class="keywords">名称</a>：frmClient '* 程序<a href="https://www.jb51.cc/tag/gongneng/" target="_blank" class="keywords">功能</a>：客户端 '* 作者：lyserver '* 联系方式：http://blog.csdn.net/lyserver '* ************************************************************** * Dim m_bSuccess As Boolean Private Sub Form_Load() btnSend.Enabled = False btn<a href="https://www.jb51.cc/tag/dis/" target="_blank" class="keywords">dis</a>connect.Enabled = False End Sub Private Sub Form_Unload(Cancel As Integer) wskClient.Close End Sub Private Sub btnConnect_Click() If Len(txtUserName) = 0 Then Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "<a href="https://www.jb51.cc/tag/yonghuming/" target="_blank" class="keywords">用户名</a>不能为空!",vbCritical,"<a href="https://www.jb51.cc/tag/tishi/" target="_blank" class="keywords">提示</a>" Else wskClient.Connect "127.0.0.1",9999 btn<a href="https://www.jb51.cc/tag/dis/" target="_blank" class="keywords">dis</a>connect.Enabled = True End If End Sub Private Sub btn<a href="https://www.jb51.cc/tag/dis/" target="_blank" class="keywords">dis</a>connect_Click() wskClient.Close btnConnect.Enabled = True btnSend.Enabled = False btn<a href="https://www.jb51.cc/tag/dis/" target="_blank" class="keywords">dis</a>connect.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 btn<a href="https://www.jb51.cc/tag/dis/" target="_blank" class="keywords">dis</a>connect.Enabled = False wskClient.Close 'Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "对方已断开连接","警告" 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

原文地址：https://www.jb51.cc/vb/263118.html