Question

求vb winsock实现1对多通信的代码

要实现一个服务器，对应多个客户端，MSDN上说用winsock数组，但没有例子，我想要个例子。能互相发送字符串就行，多余的代码都不要，要实现这个功能最简化的代码。

Answer 1

仅为有用的代码

服务器：
' We'll limit it to 101 users at a time! ;)
Dim Users(0 To 100) As String

Private Sub Form_Load()
wsListen.Listen ' make it listen
End Sub

Private Sub SendCommand_Click()
Dim User As Integer

'First, check to make sure someone's logged in
If lstUsers.ListCount = 0 Then

'Display popup
MsgBox "Nobody to send to!", vbExclamation, "Cannot send"

'Clear input
txtSendMessage.Text = ""
Exit Sub
End If

' Loop through the users.
' There's better ways of doing this
For X = 0 To 100

' If there's a username listed for them
If Users(X) <> "" Then

'Send the message
wsArray(X).SendData "t" & Chr(1) & txtSendMessage.Text

' Don't know why this needs to be
' in here to work - someone tell me?
DoEvents
End If
Next X

txtSendMessage.Text = ""

End Sub

Private Sub wsArray_Close(Index As Integer)
' Let's cycle through the list, looking for their
' name
For X = 0 To lstUsers.ListCount - 1

' Check to see if it matches
If lstUsers.List(X) = Users(Index) Then

' It matches, so let's remove it form the
' list and the array
Users(Index) = ""
lstUsers.RemoveItem X

Exit For
End If
Next X
End Sub

Private Sub wsArray_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Data As String, CtrlChar As String
wsArray(Index).GetData Data

' Our format for our messages is this:
' CtrlChar & chr(1) & <info>
If InStr(1, Data, Chr(1)) <> 2 Then
' If the 2nd char isn't chr(1), we know we have a prob

MsgBox "Unknown Data Format: " & vbCrLf & _
Data, vbCritical, "Error receiving"
' Make sure to leave the sub so it doesn't
' try to process the invalid info!
Exit Sub
End If

'Retrieve First Character
CtrlChar = Left(Data, 1)

'Make sure to trim it, and chr(1), off
Data = Mid(Data, 3)

' Check what it is, without regard to case
Select Case LCase(CtrlChar)

Case "t"

ReceivedUserText.Text = Users(Index)

'txtReceived.SelStart = Len(txtReceived.Text)
txtReceived.Text = Data ' & vbCrLf

'This is their "login" key
Case "u"

'Add their name to the list
lstUsers.AddItem Data

'Add their name to the array
Users(Index) = Data

' We need to remember that both
' the winsock index and the user array
' index correspond. So you can find a
' users name by going "Users(<winsock index>)"
' or you can find the winsock index with
' a text name by cycling through the array.
' That's what the function "RetrieveUser"
' does - gets their winsock index from their
' username

End Select

End Sub

Private Sub wsArray_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)

' This sets the "cursor" to the end of the textbox
txtErrors.SelStart = Len(txtErrors.Text)

' This inserts the error message at the "cursor"
txtErrors.SelText = "wsArray(" & Index & ") - " & Number & " - " & Description & vbCrLf

' Close it =)
wsArray(Index).Close

End Sub

Private Sub wsListen_ConnectionRequest(ByVal requestID As Long)
Index = FindOpenWinsock

' Accept the request using the created winsock
wsArray(Index).Accept requestID
End Sub

Private Sub wsListen_Error(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)

' This sets the "cursor" to the end of the textbox
txtErrors.SelStart = Len(txtErrors.Text)

' This inserts the error message at the "cursor"
txtErrors.SelText = "wsListen - " & Number & " - " & Description & vbCrLf
End Sub

Private Function FindOpenWinsock()
Static LocalPorts As Integer ' Static keeps the
' variable's state

For X = 0 To wsArray.UBound
If wsArray(X).State = 0 Then

' We found one that's state is 0, which
' means "closed", so let's use it
FindOpenWinsock = X

' make sure to leave function
Exit Function
End If
Next X

' OK, none are open so let's make one
Load wsArray(wsArray.UBound + 1)

' Let's make sure we don't get conflicting local ports
LocalPorts = LocalPorts + 1
wsArray(wsArray.UBound).LocalPort = wsArray(wsArray.UBound).LocalPort + LocalPorts

' and then let's return it's index value
FindOpenWinsock = wsArray.UBound

End Function

客户：
Dim Ljzt As Integer

Private Sub CLTimer_Timer()
If wsMain.State <> 7 Then
Ljzt = 0

wsMain.Close
wsMain.Connect

Else

If Ljzt = 0 Then
wsMain.SendData "U" & Chr(1) & txtUserName.Text
txtUserName.Enabled = False
txtMessage.Enabled = True

End If

Ljzt = 1

End If
End Sub

Private Sub Form_Load()
'On Error Resume Next
Ljzt = 0
Dim Ls As String * 50

GetPrivateProfileString "Link", "ip", "", Ls, 50, App.Path + "\Ctrl.ini"
txtUserName.Text = Trim(Ls)

End Sub

Private Sub SendCommand_Click()
wsMain.SendData "t" & Chr(1) & txtMessage.Text
txtMessage.Text = ""
End Sub

Private Sub wsMain_DataArrival(ByVal bytesTotal As Long)
Dim Data As String, CtrlChar As String
wsMain.GetData Data
CtrlChar = Left(Data, 1) ' Let's get the first char
Data = Mid(Data, 3) ' Then cut it off
Select Case LCase(CtrlChar) ' Check what it is
Case "t" ' Do stuff depending on it

txtReceived.Text = Data
End Select
End Sub

Private Sub wsMain_Error(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)
MsgBox "Winsock Error: " & Number & vbCrLf & Description, vbCritical, "Winsock Error"
End Sub

Answer 2

给你上传了一个源代码，请好好研究：
http://files.7lx.com/data/2010-09/2010september19th215412_cs.rar