VB6 PRO DOCS

中文

English

中文

English

Appearance

cWinsock TCP 编程指南 ​

📖 目录 ​

概述 ​

TCP（Transmission Control Protocol）是一种面向连接的、可靠的传输协议，适合需要保证数据完整性和顺序的应用场景。

TCP 特点 ​

  • ✅ 面向连接: 需要先建立连接
  • ✅ 可靠传输: 保证数据到达、顺序和完整性
  • ✅ 流量控制: 避免网络拥塞
  • ✅ 拥塞控制: 自动调整传输速率
  • ❌ 开销较大: 相比 UDP 有更多协议开销

适用场景 ​

  • 文件传输
  • 聊天应用
  • 远程控制
  • 数据库连接
  • Web 服务

TCP 客户端编程 ​

基本流程 ​

1. 创建 cWinsock 对象
2. 设置协议为 TCP
3. 连接到服务器
4. 等待 Connect 事件
5. 发送/接收数据
6. 关闭连接

完整示例 ​

vb
' 声明客户端对象
Private WithEvents m_oClient As cWinsock

' 连接按钮
Private Sub cmdConnect_Click()
    On Error GoTo EH
    
    If m_oClient Is Nothing Then
        Set m_oClient = New cWinsock
    End If
    
    ' 设置协议
    m_oClient.Protocol = sckTCPProtocol
    
    ' 连接服务器
    m_oClient.Connect txtHost.Text, CLng(txtPort.Text)
    
    ' 更新 UI
    cmdConnect.Enabled = False
    cmdDisconnect.Enabled = False
    lblStatus.Caption = "连接中..."
    
    Exit Sub
    
EH:
    Debug.Print "连接错误: " & Err.Description
    lblStatus.Caption = "连接失败"
End Sub

' 连接成功事件
Private Sub m_oClient_Connect(Client As cWinsock)
    Debug.Print "已连接到 " & Client.RemoteHostIP & ":" & Client.RemotePort
    
    ' 更新 UI
    cmdConnect.Enabled = False
    cmdDisconnect.Enabled = True
    lblStatus.Caption = "已连接"
End Sub

' 断开连接按钮
Private Sub cmdDisconnect_Click()
    If Not m_oClient Is Nothing Then
        m_oClient.Close_
    End If
    
    ' 更新 UI
    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False
    lblStatus.Caption = "已断开"
End Sub

' 发送数据按钮
Private Sub cmdSend_Click()
    On Error GoTo EH
    
    If Not m_oClient Is Nothing And m_oClient.State = sckConnected Then
        m_oClient.SendData txtSend.Text
        Debug.Print "已发送: " & txtSend.Text
        
        ' 清空输入框
        txtSend.Text = ""
    Else
        MsgBox "未连接", vbExclamation
    End If
    
    Exit Sub
    
EH:
    Debug.Print "发送错误: " & Err.Description
End Sub

' 数据到达事件
Private Sub m_oClient_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    
    ' 接收数据
    Client.GetData sData
    
    Debug.Print "收到数据 (" & bytesTotal & " 字节): " & sData
    
    ' 显示在界面上
    txtReceive.SelStart = Len(txtReceive.Text)
    txtReceive.SelText = sData & vbCrLf
    txtReceive.SelStart = Len(txtReceive.Text)
End Sub

' 连接关闭事件
Private Sub m_oClient_CloseEvent(Client As cWinsock)
    Debug.Print "连接已关闭"
    
    ' 更新 UI
    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False
    lblStatus.Caption = "连接已关闭"
End Sub

' 错误事件
Private Sub m_oClient_Error(Client As cWinsock, ByVal Number As Long, Description As String, ByVal Scode As Long)
    Debug.Print "错误 [" & Number & "]: " & Description
    
    ' 更新 UI
    lblStatus.Caption = "错误: " & Description
End Sub

' 窗体卸载
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    m_oClient.Close_
End Sub

TCP 服务器编程 ​

基本流程 ​

1. 创建 cWinsock 对象
2. 设置协议为 TCP
3. 监听端口
4. 等待 ConnectionRequest 事件
5. 接受或拒绝连接
6. 通过 DataArrival 处理客户端数据
7. 客户端断开时清理

完整示例 ​

vb
' 声明服务器对象
Private WithEvents m_oServer As cWinsock

' 启动服务器按钮
Private Sub cmdStart_Click()
    On Error GoTo EH
    
    If m_oServer Is Nothing Then
        Set m_oServer = New cWinsock
    End If
    
    ' 设置协议
    m_oServer.Protocol = sckTCPProtocol
    
    ' 开始监听
    m_oServer.Listen CLng(txtPort.Text)
    
    Debug.Print "服务器已启动，监听端口: " & m_oServer.LocalPort
    
    ' 更新 UI
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    lblStatus.Caption = "监听中..."
    lblClientCount.Caption = "0"
    
    Exit Sub
    
EH:
    Debug.Print "启动服务器失败: " & Err.Description
    MsgBox "无法启动服务器: " & Err.Description, vbExclamation
End Sub

' 停止服务器按钮
Private Sub cmdStop_Click()
    On Error Resume Next
    
    If Not m_oServer Is Nothing Then
        m_oServer.Close_
    End If
    
    Debug.Print "服务器已停止"
    
    ' 更新 UI
    cmdStart.Enabled = True
    cmdStop.Enabled = False
    lblStatus.Caption = "已停止"
    lstClients.Clear
End Sub

' 新连接请求事件
Private Sub m_oServer_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)
    Debug.Print "新客户端连接: " & Client.RemoteHostIP & ":" & Client.RemotePort
    
    ' 检查连接数限制
    If m_oServer.ClientCount >= 100 Then
        Debug.Print "达到最大连接数，拒绝连接"
        DisConnect = True
        Exit Sub
    End If
    
    ' IP 黑名单检查
    If IsInBlacklist(Client.RemoteHostIP) Then
        Debug.Print "IP 在黑名单中，拒绝连接: " & Client.RemoteHostIP
        DisConnect = True
        Exit Sub
    End If
    
    ' 接受连接（DisConnect = False）
    Debug.Print "接受连接: " & Client.Tag
    
    ' 更新客户端列表
    UpdateClientList
End Sub

' 数据到达事件（所有客户端数据通过此事件触发）
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    
    ' 接收数据
    Client.GetData sData
    
    Debug.Print "来自 " & Client.Tag & " (" & Client.RemoteHostIP & ") 的数据: " & sData
    
    ' 显示在日志中
    LogMessage Client.Tag & ": " & sData
    
    ' 回显给客户端
    Client.SendData "Echo: " & sData
End Sub

' 连接关闭事件
Private Sub m_oServer_CloseEvent(Client As cWinsock)
    Debug.Print "客户端 " & Client.Tag & " 已断开"
    
    ' 更新客户端列表
    UpdateClientList
End Sub

' 错误事件
Private Sub m_oServer_Error(Client As cWinsock, ByVal Number As Long, Description As String, ByVal Scode As Long)
    Debug.Print "错误 [" & Number & "]: " & Description
    
    If Client.IsServer Then
        ' 服务器错误
        LogMessage "服务器错误: " & Description
    Else
        ' 客户端错误
        LogMessage "客户端 " & Client.Tag & " 错误: " & Description
    End If
End Sub

' 更新客户端列表
Private Sub UpdateClientList()
    lstClients.Clear
    lblClientCount.Caption = m_oServer.ClientCount
    
    Dim oClient As cWinsock
    For Each oClient In m_oServer.Clients
        lstClients.AddItem oClient.Tag & " - " & oClient.RemoteHostIP & ":" & oClient.RemotePort
    Next
End Sub

' 添加日志
Private Sub LogMessage(ByVal sMsg As String)
    txtLog.SelStart = Len(txtLog.Text)
    txtLog.SelText = Format$(Now, "hh:mm:ss") & " - " & sMsg & vbCrLf
    txtLog.SelStart = Len(txtLog.Text)
End Sub

' 窗体卸载
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    m_oServer.Close_
End Sub

' 黑名单检查
Private Function IsInBlacklist(ByVal sIP As String) As Boolean
    ' 从配置文件或数据库加载黑名单
    ' 这里简化演示
    IsInBlacklist = False
End Function

高级功能 ​

🔄 心跳检测 ​

cWinsock 内置心跳管理器，内嵌 cTimer 自动驱动，无需手动实现。

服务端：超时检测

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

' 超时事件
Private Sub m_oServer_ClientTimeout(Client As cWinsock)
    Debug.Print "客户端 " & Client.Tag & " 超时，已自动断开"
    UpdateClientList
End Sub

客户端：心跳保活

vb
' 连接后启用心跳
m_oClient.AutoHeartbeat = True
m_oClient.HeartbeatInterval = 50  ' 50秒无活动则发心跳

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

自定义心跳包

vb
' 默认心跳包为单字节 &H00，可自定义
Dim baHB(0 To 3) As Byte
baHB(0) = &H50  ' P
baHB(1) = &H49  ' I
baHB(2) = &H4E  ' N
baHB(3) = &H47  ' G
m_oClient.HeartbeatData = baHB

工作原理：

  • 心跳管理器内嵌 cTimer，每 10 秒触发一次检查
  • 服务端：检查所有客户端的 IdleSeconds，超时则触发 ClientTimeout 并自动断开
  • 客户端：如果空闲超过 HeartbeatInterval 则发送心跳包，有数据收发时智能跳过
  • 每次收发数据自动重置 LastActivityTime

📦 数据封包协议 ​

cWinsock 内置三种封包协议，自动处理 TCP 分包/粘包问题。

分隔符协议（适合文本协议）

vb
m_oServer.PacketProtocol = ppDelimiter
m_oServer.Delimiter = vbCrLf  ' 换行分隔，适合行式协议

' 发送自动追加分隔符
Client.SendData "Hello"  ' 实际发送: "Hello" + vbCrLf

' 接收自动解包
Private Sub m_oServer_MessageArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Debug.Print "完整消息: " & Client.GetDataText()
End Sub

定长协议（适合固定长度消息）

vb
m_oServer.PacketProtocol = ppFixedLength
m_oServer.FixedLength = 256  ' 每条消息固定256字节

长度头协议（适合二进制协议）

vb
m_oServer.PacketProtocol = ppLengthHeader
m_oServer.HeaderBytes = 4            ' 4字节长度头
m_oServer.HeaderEndian = eeLittleEndian  ' 小端序

' 发送自动添加长度头
Client.SendData "Hello"  ' 实际发送: [4字节长度] + "Hello"

' 接收自动剥离长度头
Private Sub m_oServer_MessageArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim baData() As Byte
    baData = Client.GetDataByteArray()
    ProcessBinaryMessage baData
End Sub

配置继承：新客户端自动继承服务器的协议和心跳配置，每个客户端持有独立实例，缓冲区互不干扰。

🔄 自动重连 ​

vb
' 自动重连客户端
Private WithEvents m_oClient As cWinsock
Private m_bAutoReconnect As Boolean
Private m_lReconnectInterval As Long

Private Sub StartClient()
    Set m_oClient = New cWinsock
    m_oClient.Protocol = sckTCPProtocol
    m_bAutoReconnect = True
    m_lReconnectInterval = 5 ' 5 秒
    
    ConnectToServer
End Sub

Private Sub ConnectToServer()
    On Error GoTo EH
    
    m_oClient.Connect "127.0.0.1", 8080
    Debug.Print "正在连接..."
    
    Exit Sub
    
EH:
    Debug.Print "连接失败: " & Err.Description
    
    If m_bAutoReconnect Then
        Debug.Print m_lReconnectInterval & " 秒后重连..."
        tmrReconnect.Interval = m_lReconnectInterval * 1000
        tmrReconnect.Enabled = True
    End If
End Sub

Private Sub m_oClient_CloseEvent(Client As cWinsock)
    Debug.Print "连接已关闭"
    
    If m_bAutoReconnect Then
        Debug.Print m_lReconnectInterval & " 秒后重连..."
        tmrReconnect.Interval = m_lReconnectInterval * 1000
        tmrReconnect.Enabled = True
    End If
End Sub

Private Sub tmrReconnect_Timer()
    tmrReconnect.Enabled = False
    ConnectToServer
End Sub

🚦 流量控制 ​

vb
' 带流量控制的文件传输
Private m_oClient As cWinsock
Private m_lChunkSize As Long
Private m_bSending As Boolean

Private Sub SendFile(ByVal sFilePath As String)
    Dim iFileNum As Integer
    Dim baChunk() As Byte
    Dim lFileSize As Long
    Dim lSent As Long
    
    iFileNum = FreeFile
    Open sFilePath For Binary As #iFileNum
    lFileSize = LOF(iFileNum)
    
    m_lChunkSize = 8192 ' 8KB 每块
    lSent = 0
    m_bSending = True
    
    Do While lSent < lFileSize And m_bSending
        ' 读取数据块
        ReDim baChunk(0 To m_lChunkSize - 1) As Byte
        Get #iFileNum, , baChunk
        
        ' 发送
        m_oClient.SendData baChunk
        lSent = lSent + m_lChunkSize
        
        ' 更新进度
        UpdateProgress lSent, lFileSize
        
        ' 等待发送完成
        Do While m_bSending
            DoEvents
            If Not m_oClient.State = sckConnected Then Exit Do
        Loop
        
        If Not m_oClient.State = sckConnected Then Exit Do
    Loop
    
    Close #iFileNum
    
    Debug.Print "文件传输完成"
End Sub

Private Sub m_oClient_SendComplete(Client As cWinsock)
    m_bSending = False
End Sub

常见问题 ​

❓ 问题 1: 连接被拒绝 ​

现象: Error 10061 - 连接被拒绝

原因:

  • 服务器未启动
  • 端口被防火墙阻止
  • IP 地址或端口错误

解决方案:

vb
' 检查服务器是否启动
If m_oServer.State <> sckListening Then
    MsgBox "服务器未启动", vbExclamation
    Exit Sub
End If

' 检查端口
If Not IsPortOpen(txtPort.Text) Then
    MsgBox "端口 " & txtPort.Text & " 未开放", vbExclamation
End If

❓ 问题 2: 连接超时 ​

现象: Error 10060 - 连接超时

原因:

  • 网络不通
  • 服务器响应慢
  • 防火墙阻止

解决方案:

vb
' 增加重试机制
Private Function ConnectWithRetry(ByVal sHost As String, ByVal lPort As Long, ByVal lRetries As Long) As Boolean
    Dim i As Long
    
    For i = 1 To lRetries
        On Error Resume Next
        m_oClient.Connect sHost, lPort
        
        If Err.Number = 0 Then
            ConnectWithRetry = True
            Exit Function
        End If
        
        Debug.Print "重连 " & i & "/" & lRetries & " 失败: " & Err.Description
        
        ' 等待后重试
        Sleep 2000
    Next
    
    ConnectWithRetry = False
End Function

❓ 问题 3: 数据丢失 ​

现象: 发送的数据对方没有收到

原因:

  • 网络问题
  • 缓冲区溢出
  • 对方未正确读取

解决方案:

vb
' 确认对方收到
Private Sub SendWithAck(ByVal sData As String)
    Dim sAck As String
    
    ' 发送数据
    m_oClient.SendData "DATA:" & sData
    
    ' 等待确认
    sAck = WaitForAck(5000) ' 5 秒超时
    
    If sAck = "ACK" Then
        Debug.Print "对方已确认收到"
    Else
        Debug.Print "未收到确认，重发"
        m_oClient.SendData "DATA:" & sData
    End If
End Sub

最后更新: 2026-06-09

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

VBMAN 版权所有 © 2019-2026 邓伟