VB多使用者Winsock控制項通訊執行個體

    有一位CSDN的朋友不明白如何利用Winsock控制項進行多使用者之間的網路通訊，於是俺寫了一個，希望對有此方面需要的朋友有所協助！

    本代碼可以同時支援多個用戶端的串連、識別和通訊，主要思路是在串連成功後，由客戶主動發送一個使用者名稱，伺服器端以此使用者名稱對客戶進行區分，為防止同名客戶，伺服器端在使用者名稱後加了一個尾碼。由於寫得匆忙，難免有失誤，懇請指正！

    伺服器代碼如下：

Option Explicit<br />'* ************************************************************** *<br />'* 程式名稱：frmServer<br />'* 程式功能：伺服器<br />'* 作者：lyserver<br />'* 連絡方式：http://blog.csdn.net/lyserver<br />'* ************************************************************** *</p><p>Dim UserCookie() As Long</p><p>Private Sub Form_Load()<br /> ReDim UserCookie(0)<br /> btnSend.Enabled = False<br /> wskListen.Bind 9999, "127.0.0.1" '綁定到127.0.0.1的9999連接埠<br /> wskListen.Listen '監聽網路連接<br />End Sub</p><p>Private Sub Form_Unload(Cancel As Integer)<br /> Dim i As Long</p><p> On Error Resume Next<br /> Erase UserCookie<br /> For i = wskServer.UBound To 1 Step -1<br /> wskServer(i).Close<br /> Unload wskServer(i)<br /> Next<br /> wskListen.Close<br />End Sub</p><p>Private Sub btnSend_Click()<br /> Dim i As Integer<br /> For i = 1 To wskServer.UBound<br /> If wskServer(i).Tag = cmbClient Then<br /> wskServer(i).SendData txtSend<br /> Exit Sub<br /> End If<br /> Next<br />End Sub</p><p>Private Sub btnClose_Click()<br /> Unload Me<br />End Sub</p><p>Private Sub wskListen_ConnectionRequest(ByVal requestID As Long)<br /> Dim i As Long</p><p> For i = 1 To wskServer.UBound<br /> If wskServer(i).State = sckClosed Then<br /> UserCookie(i) = requestID<br /> wskServer(i).Accept requestID<br /> Exit Sub<br /> End If<br /> Next<br /> Load wskServer(i)<br /> wskServer(i).Accept requestID<br /> ReDim Preserve UserCookie(i)<br /> UserCookie(i) = requestID<br />End Sub</p><p>Private Sub wskServer_Close(Index As Integer)<br /> wskServer(Index).Close<br /> wskServer(Index).Tag = ""<br /> cmbClient.RemoveItem Index<br /> cmbClient.ListIndex = cmbClient.ListCount - 1<br /> cmbClient.Tag = cmbClient.Text<br /> btnSend.Enabled = (cmbClient.ListCount > 0)<br />End Sub</p><p>Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)<br /> Dim strData As String</p><p> wskServer(Index).GetData strData, vbString</p><p> If Len(wskServer(Index).Tag) = 0 Then<br /> If InStr(strData, "UserName=") = 1 Then<br /> wskServer(Index).Tag = Mid(strData, 10) & "-" & UserCookie(Index)<br /> cmbClient.AddItem wskServer(Index).Tag<br /> cmbClient.ListIndex = cmbClient.ListCount - 1<br /> cmbClient.Tag = cmbClient.Text<br /> btnSend.Enabled = (cmbClient.ListCount > 0)<br /> End If<br /> Else<br /> strData = "[" & wskServer(Index).Tag & "]說：" & strData<br /> If Len(txtReceive) > 0 Then strData = vbCrLf & strData<br /> txtReceive = txtReceive & strData<br /> End If<br />End Sub</p><p>Private Sub wskServer_SendComplete(Index As Integer)<br /> 'MsgBox "給[" & cmbClient.Tag & "]的內容已發送完畢!", vbInformation, "提示"<br />End Sub</p><p>Private Sub cmbClient_Click()<br /> btnSend.Enabled = (cmbClient.ListCount > 0)<br />End Sub</p><p>Private Function FindUser(ByVal lCookie As Long) As String<br /> Dim i As Long</p><p> For i = 0 To cmbClient.ListCount - 1<br /> If InStr(cmbClient.List(i), "-" & lCookie) > 0 Then Exit For<br /> Next<br /> FindUser = cmbClient.List(i)<br />End Function<br />

用戶端代碼如下：

Option Explicit<br />'* ************************************************************** *<br />'* 程式名稱：frmClient<br />'* 程式功能：用戶端<br />'* 作者：lyserver<br />'* 連絡方式：http://blog.csdn.net/lyserver<br />'* ************************************************************** *<br />Dim m_bSuccess As Boolean</p><p>Private Sub Form_Load()<br /> btnSend.Enabled = False<br /> btnDisconnect.Enabled = False<br />End Sub</p><p>Private Sub Form_Unload(Cancel As Integer)<br /> wskClient.Close<br />End Sub</p><p>Private Sub btnConnect_Click()<br /> If Len(txtUserName) = 0 Then<br /> MsgBox "使用者名稱不可為空!", vbCritical, "提示"<br /> Else<br /> wskClient.Connect "127.0.0.1", 9999<br /> btnDisconnect.Enabled = True<br /> End If<br />End Sub</p><p>Private Sub btnDisconnect_Click()<br /> wskClient.Close<br /> btnConnect.Enabled = True<br /> btnSend.Enabled = False<br /> btnDisconnect.Enabled = False<br /> txtUserName.Locked = False<br />End Sub</p><p>Private Sub btnSend_Click()<br /> wskClient.SendData txtSend<br />End Sub</p><p>Private Sub btnClose_Click()<br /> Unload Me<br />End Sub</p><p>Private Sub wskClient_Close()<br /> m_bSuccess = False<br /> btnSend.Enabled = False<br /> btnDisconnect.Enabled = False<br /> wskClient.Close<br /> 'MsgBox "對方已中斷連線", vbCritical, "警告"<br />End Sub</p><p>Private Sub wskClient_Connect()<br /> m_bSuccess = True<br /> wskClient.SendData "UserName=" & txtUserName<br /> btnSend.Enabled = True<br /> btnConnect.Enabled = False<br /> txtUserName.Locked = True<br />End Sub</p><p>Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)<br /> Dim strData As String</p><p> wskClient.GetData strData, vbString<br /> If Len(txtReceive) > 0 Then strData = vbCrLf & strData<br /> txtReceive = txtReceive & strData<br />End Sub<br />