TCP/IP集团通讯演示程序，在WIN98调试通过，详细请自行下载进行学习测试，程序大小4K

下载地址:http://www.lshdic.com/download/lshdic/vb_winsock.zip

代码浏览：

Private Sub Check3_Click()      '客户端二开启及中断对服务器的连接
If Check3.Value = 1 Then
On Error Resume Next
w3.RemoteHost = Text9.Text: w3.RemotePort = Text10.Text: w3.Connect
If Err.Number <> 0 Then MsgBox "被连接的主机地址或连接端口号错误", vbCritical, "找不到服务器": Check3.Value = 0: Exit Sub
Else
If w3.State = 7 Then w3.SendData "职员2[" & w3.RemoteHostIP & "]终止连接，退出系统": DoEvents: Text11.Text = ""
w3.Close
End If
End Sub

Private Sub Command1_Click()    '服务器发送数据
str0 = 0
For i = 0 To w1.Count - 1
DoEvents
If w1(i).State = 7 Then w1(i).SendData "企业管理员公告:" & Text4.Text: str0 = str0 + 1
Next
If str0 = 0 Then MsgBox "未用客户正连接服务器，无法发送数据", vbCritical, "未有用户"
End Sub

Private Sub Command2_Click()     '客户端一发送数据
If w2.State <> 7 Then MsgBox "未连接主机或连接主机工作正在进行，无法发送数据", vbCritical, "连接不正常": Exit Sub
w2.SendData "职员1:" & Text8.Text
End Sub

Private Sub Command3_Click()
If w3.State <> 7 Then MsgBox "未连接主机或连接主机工作正在进行，无法发送数据", vbCritical, "连接不正常": Exit Sub
w3.SendData "职员2:" & Text12.Text
End Sub

Private Sub Form_Load()          '启动时开启服务器监听
Text1.Text = w1(0).LocalIP: Text5.Text = w1(0).LocalIP: Text9.Text = w1(0).LocalIP
w1(0).LocalPort = Text2.Text: w1(0).Listen
End Sub

Private Sub check1_Click()       '开启及关闭服务器端
If Check1.Value = 1 Then
w1(0).LocalPort = Text2.Text: w1(0).Listen
Else
For i = 0 To w1.Count - 1
If w1(i).State = 7 Then w1(i).SendData "服务器以关闭，停止接收用户资料": DoEvents
w1(i).Close
If i <> 0 Then Unload w1(i)
Next
Text3.Text = "": Text7.Text = "": Text11.Text = ""
End If
End Sub

Private Sub check2_Click()     '客户端一开启及中断与服务器的连接
If Check2.Value = 1 Then
On Error Resume Next
w2.RemoteHost = Text5.Text: w2.RemotePort = Text6.Text: w2.Connect
If Err.Number <> 0 Then MsgBox "被连接的主机地址或连接端口号错误", vbCritical, "找不到服务器": Check2.Value = 0: Exit Sub
Else
If w2.State = 7 Then w2.SendData "职员1[" & w2.RemoteHostIP & "]终止连接，退出系统": DoEvents: Text7.Text = ""
w2.Close
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
w3.Close: w2.Close
For i = 0 To w1.Count - 1
DoEvents
w1(i).Close
Next
End
End Sub

Private Sub Timer1_Timer()
users = 0
For i = 0 To w1.Count - 1
str1 = str1 & w1(i).State & ","
If w1(i).State = 7 Then users = users + 1
Next
Me.Caption = "主机状态:" & Left(str1, Len(str1) - 1) & "，客户端一状态:" & w2.State & "，客户端二状态:" & w3.State
Label3.Caption = "用户连接数:" & users & "，TCP/IP集团通讯演示原程序" & vbCrLf & "原作者:风云舞(http://www.lshdic.com)"
Text3.SelStart = Len(Text3.Text): Text7.SelStart = Len(Text7.Text): Text11.SelStart = Len(Text11.Text)
End Sub

Private Sub w1_Close(index As Integer)
If Check1.Value = 0 Then  '如果是服务器端工作人员关机则关闭
For i = 0 To w1.Count - 1
w1(i).Close
If i <> 0 Then Unload w1(i)
Next
Else
w1(index).Close
End If
End Sub

Private Sub w1_ConnectionRequest(index As Integer, ByVal requestID As Long) '服务器接到连接申请
If w1.Count = 1 Then
Load w1(w1.Count)
w1(w1.Count - 1).Close
w1(w1.Count - 1).Accept requestID
Exit Sub
End If
len1 = 0
For i = 1 To w1.Count - 1
If w1(i).State = 0 Then w1(i).Accept requestID: Exit Sub
Next
Load w1(w1.Count): w1(w1.Count - 1).Accept requestID
End Sub

Private Sub w1_DataArrival(index As Integer, ByVal bytesTotal As Long)   '服务器接到数据
Dim w1str As String
w1(index).GetData w1str
Text3.Text = Text3.Text & w1str & vbCrLf
For i = 0 To w1.Count - 1
DoEvents
If w1(i).State = 7 Then w1(i).SendData w1str
Next
End Sub

Private Sub w2_Close()       '客户端一即将关闭连接
w2.Close
If Check2.Value = 1 Then Check2.Value = 0
End Sub

Private Sub w2_Connect()
w2.SendData "系统消息:职员1 成功登陆集团通讯系统"
End Sub

Private Sub w2_DataArrival(ByVal bytesTotal As Long)    '客户端一收到数据
Dim w2str As String
w2.GetData w2str
Text7.Text = Text7.Text & w2str & vbCrLf
End Sub

Private Sub w2_Error(ByVal Number As Integer, Des cription As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox "出现错误，连接服务器失败，可能服务器未开启或连接端口及地址错误", vbCritical, "出错": Check2.Value = 0
w2.Close
End Sub

Private Sub w3_Close()       '客户端二即将关闭连接
w3.Close: If Check3.Value = 1 Then Check3.Value = 0
End Sub

Private Sub w3_Connect()
w3.SendData "系统消息:职员2 成功登陆集团通讯系统"
End Sub

Private Sub w3_DataArrival(ByVal bytesTotal As Long)    '客户端二收到数据
Dim w3str As String
w3.GetData w3str
Text11.Text = Text11.Text & w3str & vbCrLf
End Sub

Private Sub w3_Error(ByVal Number As Integer, Des cription As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox "出现错误，连接服务器失败，可能服务器未开启或连接端口及地址错误", vbCritical, "出错": Check3.Value = 0
w3.Close
End Sub