VB6 TCP通讯服务端、客户端源码

tcp协议读卡器介绍：https://item.taobao.com/item.htm?spm=a1z10.5-c.w4002-17663462238.13.b9e75b43TtVpFy&id=601009585329https://item.taobao.com/item.htm?spm=a1z10.5-c.w4002-17663462238.13.b9e75b43TtVpFy&id=601009585329  

 

'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

源码下载：VB6TCP通讯示例.rar-VB文档类资源-CSDN下载vb6使用Winsock控件开发Server、clien之间TCP协议收、发数据示例，Server端更多下载资源、学习资料请访问CSDN下载频道.https://download.csdn.net/download/zhangjin7422/15364199