VB6 PRO DOCS

中文

English

中文

English

Appearance

cWinsock 事件详解 ​

📋 事件列表 ​

事件名说明触发时机
Connect客户端连接成功TCP 客户端成功连接到服务器
CloseEvent连接关闭TCP 连接被关闭
ConnectionRequest新连接请求服务器收到新的连接请求
DataArrival数据到达接收到新数据
MessageArrival完整消息到达协议解析后的完整消息到达（仅设置 PacketProtocol 时触发）
SendProgress发送进度数据发送过程中触发
SendComplete发送完成数据发送完成
Error发生错误发生 Socket 错误
ClientTimeout客户端超时服务端检测到客户端空闲超时
HeartbeatSent心跳已发送客户端心跳包已发送

🔗 Connect 事件 ​

说明 ​

当 TCP 客户端成功连接到服务器时触发。

语法 ​

vb
Private Sub object_Connect(Client As cWinsock)

参数 ​

参数类型说明
ClientcWinsock触发事件的客户端对象（即 Me）

使用示例 ​

vb
Private WithEvents m_oClient As cWinsock

Private Sub m_oClient_Connect(Client As cWinsock)
    Debug.Print "已连接到服务器"
    Debug.Print "远程地址: " & Client.RemoteHostIP
    Debug.Print "远程端口: " & Client.RemotePort
    
    ' 连接成功后发送登录请求
    Client.SendData "LOGIN|user|password"
End Sub

🚪 CloseEvent 事件 ​

说明 ​

当 TCP 连接被关闭时触发。

语法 ​

vb
Private Sub object_CloseEvent(Client As cWinsock)

参数 ​

参数类型说明
ClientcWinsock触发事件的客户端对象

重要说明 ​

对于服务器接受的客户端，CloseEvent 触发时会自动：

  1. 从服务器的 Clients 集合中移除该客户端
  2. 清理相关资源

使用示例 ​

vb
Private Sub m_oClient_CloseEvent(Client As cWinsock)
    Debug.Print "连接已关闭"
    
    ' 可以在这里尝试重连
    If m_bAutoReconnect Then
        Debug.Print "3 秒后尝试重连..."
        tmrReconnect.Enabled = True
    End If
End Sub

服务器端示例：

vb
Private Sub m_oServer_CloseEvent(Client As cWinsock)
    Debug.Print "客户端 " & Client.Tag & " 已断开连接"
    
    ' 更新 UI
    Dim i As Long
    For i = 0 To lstClients.ListCount - 1
        If lstClients.List(i) = Client.Tag Then
            lstClients.RemoveItem i
            Exit For
        End If
    Next
    
    ' 更新统计
    UpdateClientCount
End Sub

🔔 ConnectionRequest 事件 ​

说明 ​

服务器收到新的连接请求时触发。支持通过 DisConnect 参数拦截连接。

语法 ​

vb
Private Sub object_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)

参数 ​

参数类型说明
ClientcWinsock新的客户端对象
DisConnectBoolean设置为 True 可拒绝连接并清理资源

连接拦截机制 ​

vb
Private Sub m_oServer_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)
    ' 默认接受连接（DisConnect = False）
    
    ' 1. IP 黑名单检查
    If IsInBlacklist(Client.RemoteHostIP) Then
        Debug.Print "拒绝黑名单 IP: " & Client.RemoteHostIP
        DisConnect = True
        Exit Sub
    End If
    
    ' 2. 端口范围限制
    If Client.RemotePort < 1024 Then
        Debug.Print "拒绝特权端口: " & Client.RemotePort
        DisConnect = True
        Exit Sub
    End If
    
    ' 3. 白名单模式
    If m_bWhitelistMode Then
        If Not IsInWhitelist(Client.RemoteHostIP) Then
            Debug.Print "IP 不在白名单中: " & Client.RemoteHostIP
            DisConnect = True
            Exit Sub
        End If
    End If
    
    ' 4. 连接数限制
    If m_oServer.ClientCount >= m_lMaxClients Then
        Debug.Print "达到最大连接数限制"
        DisConnect = True
        Exit Sub
    End If
    
    ' 接受连接
    Debug.Print "接受新客户端: " & Client.RemoteHostIP & ":" & Client.RemotePort
    DisConnect = False
End Sub

高级示例：动态白名单 ​

vb
Private Sub m_oServer_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)
    ' 从数据库或配置文件加载白名单
    Dim sWhitelist() As String
    sWhitelist = LoadWhitelistFromDatabase()
    
    Dim bAllowed As Boolean
    bAllowed = False
    
    Dim i As Long
    For i = LBound(sWhitelist) To UBound(sWhitelist)
        If sWhitelist(i) = Client.RemoteHostIP Then
            bAllowed = True
            Exit For
        End If
    Next
    
    If Not bAllowed Then
        Debug.Print "拒绝未授权 IP: " & Client.RemoteHostIP
        DisConnect = True
    End If
End Sub

TCP vs UDP 中的触发 ​

协议触发时机
TCP收到新的连接请求（accept 系统调用）
UDP首次收到来自新地址:端口的数据包

📨 DataArrival 事件 ​

说明 ​

当接收到新数据时触发。这是最常用的事件之一。

语法 ​

vb
Private Sub object_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)

参数 ​

参数类型说明
ClientcWinsock接收数据的客户端对象
bytesTotalLong可用数据字节数

基本使用 ​

vb
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    
    ' 读取字符串数据
    Client.GetData sData
    
    Debug.Print "收到 " & bytesTotal & " 字节: " & sData
    
    ' 处理数据...
    ProcessData Client, sData
End Sub

读取字节数组 ​

vb
Private Sub m_oClient_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim baData() As Byte
    
    ' 读取字节数组
    Client.GetData baData
    
    Debug.Print "收到 " & bytesTotal & " 字节数据"
    
    ' 处理二进制数据...
    ProcessBinaryData baData
End Sub

部分读取数据 ​

vb
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sHeader As String
    Dim sBody As String
    
    ' 先读取前 10 字节作为头部
    Client.GetData sHeader, vbString, 10
    Debug.Print "头部: " & sHeader
    
    ' 读取剩余数据（仍在缓冲区中）
    Client.GetData sBody
    Debug.Print "正文: " & sBody
End Sub

指定编码读取 ​

vb
Private Sub m_oClient_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    
    ' 使用 UTF-8 编码读取
    Client.GetData sData, vbString, -1, ucsScpUtf8
    
    Debug.Print "UTF-8 数据: " & sData
End Sub

事件代理机制 ​

重要： 服务器接受的客户端对象，其 DataArrival 事件会通过父服务器对象触发。

vb
' 只需订阅服务器的事件，即可处理所有客户端的数据
Private WithEvents m_oServer As cWinsock

Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    ' Client 参数就是具体的客户端对象
    Debug.Print "来自 " & Client.Tag & " 的数据"
    
    Dim sData As String
    Client.GetData sData
    
    ' 可以直接向该客户端回复
    Client.SendData "Echo: " & sData
End Sub

📊 SendProgress 事件 ​

说明 ​

数据发送过程中定期触发，用于显示发送进度。

语法 ​

vb
Private Sub object_SendProgress(Client As cWinsock, ByVal bytesSent As Long, ByVal bytesRemaining As Long)

参数 ​

参数类型说明
ClientcWinsock发送数据的客户端对象
bytesSentLong已发送的字节数
bytesRemainingLong剩余待发送的字节数

使用示例 ​

vb
Private Sub m_oClient_SendProgress(Client As cWinsock, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    Dim lTotal As Long
    lTotal = bytesSent + bytesRemaining
    
    Dim dPercent As Double
    dPercent = (bytesSent / lTotal) * 100
    
    Debug.Print "发送进度: " & Format$(dPercent, "0.00") & "% (" & bytesSent & "/" & lTotal & ")"
    
    ' 更新进度条
    If Not prgProgress Is Nothing Then
        prgProgress.Value = CInt(dPercent)
    End If
End Sub

实际应用：文件传输进度 ​

vb
Private Sub m_oClient_SendProgress(Client As cWinsock, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    Static lStartTime As Long
    Static lLastUpdate As Long
    
    If lStartTime = 0 Then lStartTime = Timer
    If lLastUpdate = 0 Then lLastUpdate = lStartTime
    
    ' 每 0.5 秒更新一次 UI
    If Timer - lLastUpdate >= 0.5 Then
        Dim lTotal As Long
        lTotal = bytesSent + bytesRemaining
        
        Dim dElapsed As Double
        dElapsed = Timer - lStartTime
        
        Dim dSpeed As Double
        dSpeed = bytesSent / dElapsed ' 字节/秒
        
        ' 更新 UI
        lblStatus.Caption = "发送中: " & FormatSize(bytesSent) & " / " & FormatSize(lTotal)
        lblSpeed.Caption = "速度: " & FormatSize(dSpeed) & "/s"
        
        lLastUpdate = Timer
    End If
End Sub

✅ SendComplete 事件 ​

说明 ​

数据发送完成时触发。

语法 ​

vb
Private Sub object_SendComplete(Client As cWinsock)

参数 ​

参数类型说明
ClientcWinsock发送完成的客户端对象

使用示例 ​

vb
Private Sub m_oClient_SendComplete(Client As cWinsock)
    Debug.Print "数据发送完成"
    
    ' 重置发送状态
    m_bSending = False
    
    ' 更新 UI
    cmdSend.Enabled = True
    lblStatus.Caption = "就绪"
End Sub

实际应用：命令队列 ​

vb
Private m_lCommandQueue() As String
Private m_lQueueIndex As Long

Private Sub SendNextCommand()
    If m_lQueueIndex <= UBound(m_lCommandQueue) Then
        m_oClient.SendData m_lCommandQueue(m_lQueueIndex)
        m_lQueueIndex = m_lQueueIndex + 1
    End If
End Sub

Private Sub m_oClient_SendComplete(Client As cWinsock)
    Debug.Print "命令发送完成，发送下一个..."
    SendNextCommand
End Sub

❌ Error 事件 ​

说明 ​

发生 Socket 错误时触发。

语法 ​

vb
Private Sub object_Error(Client As cWinsock, ByVal Number As Long, Description As String, ByVal Scode As Long)

参数 ​

参数类型说明
ClientcWinsock发生错误的客户端对象
NumberLong错误代码
DescriptionString错误描述
ScodeLongSCODE（通常与 Number 相同）

常见错误代码 ​

错误代码说明
10053连接被远程主机强制关闭
10054远程主机关闭了连接
10060连接超时
10061连接被拒绝
10065无法到达目标主机
10048地址已被使用

使用示例 ​

vb
Private Sub m_oClient_Error(Client As cWinsock, ByVal Number As Long, Description As String, ByVal Scode As Long)
    Debug.Print "Socket 错误 [" & Number & "]: " & Description
    
    Select Case Number
        Case 10053, 10054
            ' 连接被关闭
            Debug.Print "远程主机已断开连接"
            
        Case 10060
            ' 连接超时
            Debug.Print "连接超时，请检查网络"
            
        Case 10061
            ' 连接被拒绝
            Debug.Print "服务器拒绝连接，请检查端口和防火墙"
            
        Case Else
            ' 其他错误
            Debug.Print "未知错误: " & Description
    End Select
End Sub

错误恢复 ​

vb
Private Sub m_oServer_Error(Client As cWinsock, ByVal Number As Long, Description As String, ByVal Scode As Long)
    Debug.Print "服务器错误 [" & Number & "]: " & Description
    
    ' 移除出错的客户端
    If Not Client Is Nothing Then
        m_oServer.RemoveClient Client
    End If
    
    ' 如果是严重错误，重启服务器
    If Number >= 10000 Then
        Debug.Print "严重错误，重启服务器..."
        m_oServer.Close_
        m_oServer.Listen m_lServerPort
    End If
End Sub

📨 MessageArrival 事件 ​

说明 ​

当设置了封包协议（PacketProtocol）后，接收到完整协议帧消息时触发。与 DataArrival 不同，此事件仅在完整消息组装完毕后触发，不会因分包/粘包而触发多次。

语法 ​

vb
Private Sub object_MessageArrival(Client As cWinsock, ByVal bytesTotal As Long)

参数 ​

参数类型说明
ClientcWinsock接收消息的客户端对象
bytesTotalLong完整消息的字节数

使用示例 ​

vb
' 设置分隔符协议
m_oServer.PacketProtocol = ppDelimiter
m_oServer.Delimiter = vbCrLf

' 接收完整消息
Private Sub m_oServer_MessageArrival(Client As cWinsock, ByVal bytesTotal As Long)
    ' 此时缓冲区中已是完整消息，可直接读取
    Dim sData As String
    sData = Client.GetDataText()
    Debug.Print "完整消息: " & sData
End Sub

与 DataArrival 的区别 ​

事件触发时机数据完整性
DataArrival每次收到原始数据（无协议模式）可能是分片或粘包数据
MessageArrival协议解析出完整消息后（协议模式）保证是一条完整消息

事件触发规则 ​

  • 无协议（ppNone）：仅触发 DataArrival
  • 有协议：仅触发 MessageArrival，不触发 DataArrival

协议模式下不会同时触发两个事件，避免同一数据被重复读取。

💓 ClientTimeout 事件 ​

说明 ​

服务端检测到客户端空闲时间超过 HeartbeatTimeout 时触发。触发后客户端会被自动断开并移除。

语法 ​

vb
Private Sub object_ClientTimeout(Client As cWinsock)

参数 ​

参数类型说明
ClientcWinsock超时的客户端对象

使用示例 ​

vb
' 启用服务器心跳
m_oServer.AutoHeartbeat = True
m_oServer.HeartbeatTimeout = 120  ' 2分钟无活动则超时

Private Sub m_oServer_ClientTimeout(Client As cWinsock)
    Debug.Print "客户端超时: " & Client.Tag & " (" & Client.RemoteHostIP & ")"
    ' 客户端已被自动断开，可做清理（如更新UI、记录日志等）
    UpdateClientList
End Sub

工作原理 ​

  1. 心跳管理器内嵌 cTimer，每 10 秒触发一次 Tick
  2. 每次 Tick 检查所有客户端的 IdleSeconds
  3. 如果 IdleSeconds >= HeartbeatTimeout，触发 ClientTimeout 事件并自动断开
  4. 每次收发数据自动重置 LastActivityTime

💓 HeartbeatSent 事件 ​

说明 ​

客户端发送心跳包后触发。仅在 AutoHeartbeat = True 且客户端模式时触发。

语法 ​

vb
Private Sub object_HeartbeatSent(Client As cWinsock)

参数 ​

参数类型说明
ClientcWinsock发送心跳的客户端对象

使用示例 ​

vb
' 客户端启用心跳
m_oClient.AutoHeartbeat = True
m_oClient.HeartbeatInterval = 50  ' 50秒无活动则发心跳

Private Sub m_oClient_HeartbeatSent(Client As cWinsock)
    Debug.Print "心跳已发送，当前空闲: " & Client.IdleSeconds & "秒"
End Sub

智能跳过 ​

心跳具有智能跳过机制：如果在上次心跳后有数据收发（LastActivityTime 被更新），且空闲时间未达到 HeartbeatInterval，则跳过本次心跳。这避免了不必要的网络流量。

🎯 事件触发顺序 ​

TCP 客户端连接流程 ​

1. Connect() 调用
2. 内部解析主机名
3. Connect 事件触发
4. 可以开始发送数据
5. SendProgress 事件（多次）
6. SendComplete 事件触发
7. DataArrival 事件（接收数据）
8. CloseEvent 事件（连接关闭）

TCP 服务器接受连接流程 ​

1. Listen() 调用
2. 收到新连接请求
3. ConnectionRequest 事件触发（可拦截）
4. 如果接受，创建客户端对象（自动继承协议和心跳配置）
5. 客户端 DataArrival 事件（通过服务器触发）
6. 客户端 MessageArrival 事件（协议模式下，通过服务器触发）
7. ClientTimeout 事件（心跳超时，自动断开）
8. 客户端 CloseEvent 事件（断开时触发）

UDP 通信流程 ​

1. Bind() 调用（UDP 服务器）
2. 收到数据包
3. 首次收到该地址:端口 → ConnectionRequest 事件
4. DataArrival 事件触发
5. 可以通过 SendData 回复

📌 注意事项 ​

  1. 事件处理时间

    • 避免在事件处理中执行耗时操作
    • 使用 DoEvents 释放控制权
    • 或将耗时操作放入队列异步处理

  2. 对象生命周期

    • 不要在事件处理中 Set Client = Nothing
    • 客户端对象由服务器管理，自动清理

  3. 线程安全

    • 事件在主线程触发，可直接访问 UI
    • 但避免重入问题

  4. 错误处理

    • 总是使用 On Error GoTo 处理事件中的错误
    • 防止一个客户端的错误影响其他客户端

最后更新: 2026-06-09

VB6及其LOGO版权为微软公司所有

VBMAN 版权所有 © 2019-2026 邓伟