'TCP服务端源码
Option Explicit
Const BUSY As Boolean = False '定义常量
Const FREE As Boolean = True
Dim ConnectState() As Boolean '定义连接状态
Private Sub Command1_Click()
initsock
End Sub
Private Sub Command2_Click()
Dim i As Integer
Dim sockid As Integer
Dim dispinf As String
On Error GoTo err1
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
sockid = Val(Mid(List1.List(i), 1, 2))
Sock(sockid).SendData Text2.Text
End If
Next
Exit Sub
err1:
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",连接 " & sockid & " 传送数据时出错:" & Err.Description
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
List1.RemoveItem i
End Sub
Private Sub Command3_Click()
Dim i As Integer
Dim sockid As Integer
Dim dispinf As String
On Error Resume Next
For i = List1.ListCount - 1 To 0 Step -1 '要用倒序
If List1.Selected(i) = True Then
sockid = Val(Mid(List1.List(i), 1, 2))
Sock(sockid).Close
ConnectState(sockid) = FREE
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",连接 " & sockid & " 已关闭"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
List1.RemoveItem i
End If
Next
End Sub
Private Sub Form_Load()
Command1_Click
End Sub
Private Sub Listener_Close()
'MsgBox "close"
Dim dispinf As String
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",监听服务已关闭!"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
End Sub
Private Sub Listener_ConnectionRequest(ByVal requestID As Long)
Dim SockIndex As Integer
Dim SockNum As Integer
Dim dispinf As String
Dim onlines As String
On Error Resume Next
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & "," & requestID & "连接请求"
SockNum = UBound(ConnectState) '查找连接的用户数
If SockNum > 100 Then
dispinf = dispinf & SockIndex & " ,当前连接数>100,系统不接受新连接!"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
Exit Sub
End If
SockIndex = FindFreeSocket() '查找空闲的sock
If SockIndex > SockNum Then '如果已有的sock都忙,而且sock数不超过15个,动态添加sock
Load Sock(SockIndex)
End If
ConnectState(SockIndex) = BUSY
Sock(SockIndex).LocalPort = 0
Sock(SockIndex).Tag = SockIndex
Sock(SockIndex).Accept (requestID) '接受请求
onlines = Format(SockIndex, "00") & "|" & Format(requestID, "00000") & "|" & Listener.RemoteHostIP & ":" & Listener.RemotePort
dispinf = dispinf & SockIndex & "接受请求," & Listener.RemoteHostIP & ":" & Listener.RemotePort
List1.AddItem (onlines)
List1.ListIndex = List1.ListCount - 1
List1.Selected(List1.ListCount - 1) = True
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
End Sub
Private Sub Listener_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 "err"
Dim dispinf As String
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",监听到异常错误!"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
End Sub
Private Sub Sock_Close(Index As Integer)
Dim dispinf As String
Dim i As Integer
If Sock(Index).State <> sckClosed Then
Sock(Index).Close
End If
ConnectState(Index) = FREE
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",连接 " & Index & " 已关闭"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
For i = 0 To List1.ListCount - 1
If Val(Mid(List1.List(i), 1, 2)) = Index Then
List1.RemoveItem i
Exit For
End If
Next
End Sub
Private Sub Sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim dx As String
Dim dispinf As String
Sock(Index).GetData dx
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",数据来自" & Index & ":" & dx
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
Sock(Index).SendData Text2.Text
End Sub
Public Function FindFreeSocket() '寻找空闲的sock
Dim SockCount, i As Integer
SockCount = UBound(ConnectState)
For i = 0 To SockCount
If ConnectState(i) = FREE Then
FindFreeSocket = i
Exit Function
End If
Next i
ReDim Preserve ConnectState(0 To SockCount + 1)
FindFreeSocket = UBound(ConnectState)
End Function
Private Sub initsock()
Dim dispinf As String
ReDim Preserve ConnectState(0 To 1)
On Error GoTo err1
ConnectState(0) = FREE
ConnectState(1) = FREE
If Listener.State = sckClosed Then
Listener.LocalPort = CLng(Text1.Text) '指定网络端口号
Listener.Listen '开始侦听
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",已创建监听服务!可以接收客户端的连接请求。"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
Command1.Caption = "关闭监听服务"
Else
Listener.Close
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",已关闭监听服务!不再接受新的客户端连接请求,已连接的客户端还可以通讯。"
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
Command1.Caption = "创建监听服务"
End If
Exit Sub
err1:
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",开启监听服务时出现错误:" & Err.Number & Err.Description
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
End Sub
Private Sub Sock_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)
Dim dispinf As String
Dim i As Integer
If Sock(Index).State <> sckClosed Then
Sock(Index).Close
End If
ConnectState(Index) = FREE
dispinf = Format(Now, "YYYY-MM-DD HH:MM:SS") & ",连接 " & Index & " 错误提示:" & Description
List2.AddItem (dispinf)
List2.ListIndex = List2.ListCount - 1
For i = 0 To List1.ListCount - 1
If Val(Mid(List1.List(i), 1, 2)) = Index Then
List1.RemoveItem i
Exit For
End If
Next
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command2_Click
End Sub
Private Sub Text5_Click()
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe " & Trim(Text5)
End Sub
'TCP客户端源码
Private Sub Command1_Click()
SockC1.SendData Text2.Text
End Sub
Private Sub Command2_Click()
On Error GoTo connerr
If Command2.Caption = "连接服务器" Then
Command2.Enabled = False
Timer1.Enabled = True
SockC1.RemoteHost = Trim(Text3.Text)
SockC1.RemotePort = CLng(Text4.Text)
SockC1.Connect
Else
SockC1.Close
Command1.Enabled = False
Command2.Caption = "连接服务器"
End If
Exit Sub
connerr:
SockC1.Close
MsgBox "未能连接上服务器,请稍后再试......", vbCritical + vbOKOnly, "提示"
End Sub
Private Sub Command3_Click()
End Sub
Private Sub Form_Unload(Cancel As Integer)
SockC1.Close
End Sub
Private Sub SockC1_Close()
SockC1.Close
Command1.Enabled = False
Command2.Caption = "连接服务器"
End Sub
Private Sub SockC1_Connect()
Timer1.Enabled = False
Command2.Enabled = True
Command2.Caption = "断开与服务器的连接"
Command1.Enabled = True
End Sub
Private Sub SockC1_ConnectionRequest(ByVal requestID As Long)
MsgBox requestID
End Sub
Private Sub SockC1_DataArrival(ByVal bytesTotal As Long)
Dim s As String
SockC1.GetData s
List1.AddItem (Format(Now, "YYYY-MM-DD HH:MM:SS") & " " + SockC1.RemoteHostIP + ":" + Format(SockC1.RemotePort, "0"))
List1.AddItem s
List1.ListIndex = List1.ListCount - 1
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
End Sub
Private Sub Text5_Click()
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe " & Trim(Text5)
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Command2.Enabled = True
Command2.Caption = "连接服务器"
SockC1.Close
End Sub