|
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, 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 = 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, 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 = 0
w3.Close
End Sub | 