多人聊天室.txt

简单的聊天程序！很好用的。你会很容易地自己编写出自己的聊天程序。

Option Explicit
Dim Clients As Integer

Private Sub Form_Load()
Dim I As Integer
Label1.Caption = "连接状态"
Clients = 4
Winsock1.Protocol = sckTCPProtocol
Winsock1.LocalPort = 3333
Winsock1.Listen
For I = 1 To Clients
Load Winsock1(I)
Next
 Text1.Text = ""
End Sub

Private Sub Winsock1_Close()
Dim Index As Integer
RemoveList Index
Winsock1(Index).Close
Unload Winsock1(Index)
Load Winsock1(Index)
End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim I As Integer
Dim ClientData As Variant
Winsock1(Index).GetData ClientData, vbString
Text1.Text = Text1.Text & ClientData & vbCrLf
For I = 1 To Clients
If Winsock1(I).State = sckConnected Then
Winsock1(I).SendData ClientData
DoEvents
End If
Next
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Dim I As Integer
For I = 1 To Clients
If Winsock1(I).State = sckClosed Then
Winsock1(I).Accept requestID
ListReFresh I & " " & Winsock1(I).RemoteHostIP & " " & Winsock1(I).RemotePort
Exit For
End If
Next
End Sub
Private Sub ListReFresh(Optional ClientDatas As String)
If Trim(CkientDatas) <> "" Then
List1.AddItem ClientDatas
End If
End Sub
Private Function RemoveList(ByVal Index As Integer)
Dim I As Integer
Dim Datas
For I = 1 To List1.ListCount
List1.ListIndex = I - 1
Datas = Split(List1.Text = " ")
If Val(Datas(0)) = Index Then
List1.RemoveItem List1.ListIndex
List1.Refresh
Exit Function
End If
Next
End Function