TCP/IP集团通讯演示程序，在WIN98调试通过，详细请自行下载进行学习测试，程序大小4K下载地址:http://www.lshdic.com/download/lshdic/vb_winsock.zip代码浏览：Private Sub Check3_Click() '客户端二开启及中断对服务器的连接If Check3.Value = 1 ThenOn Error Resume Nextw3.RemoteHost = Text9.Text: w3.RemotePort = Text10.Text: w3.ConnectIf Err.Number <> 0 Then MsgBox "被连接的主机地址或连接端口号错误", vbCritical, "找不到服务器": Check3.Value = 0: Exit SubElseIf w3.State = 7 Then w3.SendData "职员2[" & w3.RemoteHostIP & "]终止连接，退出系统": DoEvents: Text11.Text = ""w3.CloseEnd IfEnd SubPrivate Sub Command1_Click() '服务器发送数据str0 = 0For i = 0 To w1.Count - 1DoEventsIf w1(i).State = 7 Then w1(i).SendData "企业管理员公告:" & Text4.Text: str0 = str0 + 1NextIf str0 = 0 Then MsgBox "未用客户正连接服务器，无法发送数据", vbCritical, "未有用户"End SubPrivate Sub Command2_Click() '客户端一发送数据If w2.State <> 7 Then MsgBox "未连接主机或连接主机工作正在进行，无法发送数据", vbCritical, "连接不正常": Exit Subw2.SendData "职员1:" & Text8.TextEnd SubPrivate Sub Command3_Click()If w3.State <> 7 Then MsgBox "未连接主机或连接主机工作正在进行，无法发送数据", vbCritical, "连接不正常": Exit Subw3.SendData "职员2:" & Text12.TextEnd SubPrivate Sub Form_Load() '启动时开启服务器监听Text1.Text = w1(0).LocalIP: Text5.Text = w1(0).LocalIP: Text9.Text = w1(0).LocalIPw1(0).LocalPort = Text2.Text: w1(0).ListenEnd SubPrivate Sub check1_Click() '开启及关闭服务器端If Check1.Value = 1 Thenw1(0).LocalPort = Text2.Text: w1(0).ListenElseFor i = 0 To w1.Count - 1If w1(i).State = 7 Then w1(i).SendData "服务器以关闭，停止接收用户资料": DoEventsw1(i).CloseIf i <> 0 Then Unload w1(i)NextText3.Text = "": Text7.Text = "": Text11.Text = ""End IfEnd SubPrivate Sub check2_Click() '客户端一开启及中断与服务器的连接If Check2.Value = 1 ThenOn Error Resume Nextw2.RemoteHost = Text5.Text: w2.RemotePort = Text6.Text: w2.ConnectIf Err.Number <> 0 Then MsgBox "被连接的主机地址或连接端口号错误", vbCritical, "找不到服务器": Check2.Value = 0: Exit SubElseIf w2.State = 7 Then w2.SendData "职员1[" & w2.RemoteHostIP & "]终止连接，退出系统": DoEvents: Text7.Text = ""w2.CloseEnd IfEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)w3.Close: w2.CloseFor i = 0 To w1.Count - 1DoEventsw1(i).CloseNextEndEnd SubPrivate Sub Timer1_Timer()users = 0For i = 0 To w1.Count - 1str1 = str1 & w1(i).State & ","If w1(i).State = 7 Then users = users + 1NextMe.Caption = "主机状态:" & Left(str1, Len(str1) - 1) & "，客户端一状态:" & w2.State & "，客户端二状态:" & w3.StateLabel3.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 SubPrivate Sub w1_Close(index As Integer)If Check1.Value = 0 Then '如果是服务器端工作人员关机则关闭For i = 0 To w1.Count - 1w1(i).CloseIf i <> 0 Then Unload w1(i)NextElsew1(index).CloseEnd IfEnd SubPrivate Sub w1_ConnectionRequest(index As Integer, ByVal requestID As Long) '服务器接到连接申请If w1.Count = 1 ThenLoad w1(w1.Count)w1(w1.Count - 1).Closew1(w1.Count - 1).Accept requestIDExit SubEnd Iflen1 = 0For i = 1 To w1.Count - 1If w1(i).State = 0 Then w1(i).Accept requestID: Exit SubNextLoad w1(w1.Count): w1(w1.Count - 1).Accept requestIDEnd SubPrivate Sub w1_DataArrival(index As Integer, ByVal bytesTotal As Long) '服务器接到数据Dim w1str As Stringw1(index).GetData w1strText3.Text = Text3.Text & w1str & vbCrLfFor i = 0 To w1.Count - 1DoEventsIf w1(i).State = 7 Then w1(i).SendData w1strNextEnd SubPrivate Sub w2_Close() '客户端一即将关闭连接w2.CloseIf Check2.Value = 1 Then Check2.Value = 0End SubPrivate Sub w2_Connect()w2.SendData "系统消息:职员1 成功登陆集团通讯系统"End SubPrivate Sub w2_DataArrival(ByVal bytesTotal As Long) '客户端一收到数据Dim w2str As Stringw2.GetData w2strText7.Text = Text7.Text & w2str & vbCrLfEnd SubPrivate Sub w2_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 "出现错误，连接服务器失败，可能服务器未开启或连接端口及地址错误", vbCritical, "出错": Check2.Value = 0w2.CloseEnd SubPrivate Sub w3_Close() '客户端二即将关闭连接w3.Close: If Check3.Value = 1 Then Check3.Value = 0End SubPrivate Sub w3_Connect()w3.SendData "系统消息:职员2 成功登陆集团通讯系统"End SubPrivate Sub w3_DataArrival(ByVal bytesTotal As Long) '客户端二收到数据Dim w3str As Stringw3.GetData w3strText11.Text = Text11.Text & w3str & vbCrLfEnd SubPrivate Sub w3_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 "出现错误，连接服务器失败，可能服务器未开启或连接端口及地址错误", vbCritical, "出错": Check3.Value = 0w3.CloseEnd Sub

评论