Skip to content

SSE 服务器端实时推送

简介

HttpServer 内置 SSE (Server-Sent Events) 支持,可实现服务器向客户端实时推送消息。适用于:

  • 实时通知
  • 在线聊天
  • 数据监控
  • 进度推送

客户端请求

客户端使用 cSSEClient 连接:

vb
Private WithEvents SSE As cSSEClient

Private Sub Connect()
    Set SSE = New cSSEClient
    SSE.Connect "http://localhost:8080/events"
End Sub

Private Sub SSE_OnMessage(EventName As String, Data As String, Id As String)
    Debug.Print "收到: " & EventName & " = " & Data
End Sub

服务端实现

基础推送

vb
' 在控制器中推送消息
Public Sub Events(ctx As cHttpServerContext)
    ' 设置 SSE 头
    ctx.Response.Header("Content-Type") = "text/event-stream"
    ctx.Response.Header("Cache-Control") = "no-cache"
    ctx.Response.Header("Connection") = "keep-alive"
    
    ' 获取 SSE 实例
    Dim sse As cSSE
    Set sse = ctx.SSE
    
    ' 发送消息
    Call sse.Send(ctx.ClientInfo.hSocket, "message", "Hello World", "1")
    
    ' 发送 JSON 数据
    Dim data As New Scripting.Dictionary
    data("time") = Now
    data("status") = "ok"
    Call sse.Send(ctx.ClientInfo.hSocket, "data", Json.Encode(data), "2")
End Sub

广播消息

vb
' cNotificationController.cls

' 发送给所有连接
Public Sub Broadcast(ctx As cHttpServerContext)
    Dim msg As String
    msg = ctx.Request.Form("message")
    
    ' 广播到所有 SSE 客户端
    Call ctx.SSE.Broadcast("notification", msg)
    
    ctx.Response.Json Nothing, 0, "已广播"
End Sub

' 发送给指定用户
Public Sub SendToUser(ctx As cHttpServerContext)
    Dim userId As String, msg As String
    userId = ctx.Request.Form("user_id")
    msg = ctx.Request.Form("message")
    
    ' 获取用户对应的 socket
    Dim hSocket As Long
    hSocket = GetUserSocket(userId)
    
    If hSocket > 0 Then
        Call ctx.SFE.Send(hSocket, "private", msg)
        ctx.Response.Json Nothing, 0, "已发送"
    Else
        ctx.Response.Json Nothing, 1, "用户不在线"
    End If
End Sub

实时数据流

vb
' cMonitorController.cls

' 实时系统监控
Public Sub Monitor(ctx As cHttpServerContext)
    ' 设置 SSE 头
    ctx.Response.Header("Content-Type") = "text/event-stream"
    
    Dim sse As cSSE
    Set sse = ctx.SSE
    Dim counter As Long
    counter = 0
    
    ' 持续推送(实际应用中用定时器)
    Do While sse.IsConnected(ctx.ClientInfo.hSocket)
        counter = counter + 1
        
        ' 收集系统数据
        Dim data As New Scripting.Dictionary
        data("cpu") = GetCPUUsage()
        data("memory") = GetMemoryUsage()
        data("time") = Now
        
        ' 发送
        Call sse.Send(ctx.ClientInfo.hSocket, "stats", Json.Encode(data), CStr(counter))
        
        ' 每秒推送一次
        Sleep 1000
    Loop
End Sub

进度推送

vb
' cTaskController.cls

' 执行任务并推送进度
Public Sub RunTask(ctx As cHttpServerContext)
    Dim taskId As String
    taskId = ctx.Request.Form("task_id")
    
    ' 设置 SSE
    ctx.Response.Header("Content-Type") = "text/event-stream"
    
    Dim sse As cSSE
    Set sse = ctx.SSE
    Dim i As Long
    
    ' 模拟长时间任务
    For i = 0 To 100 Step 10
        ' 执行任务...
        DoTaskWork i
        
        ' 推送进度
        Dim progress As New Scripting.Dictionary
        progress("percent") = i
        progress("task_id") = taskId
        
        Call sse.Send(ctx.ClientInfo.hSocket, "progress", Json.Encode(progress))
        
        Sleep 500
    Next i
    
    ' 完成
    Call sse.Send(ctx.ClientInfo.hSocket, "complete", "{\"status\":\"done\"}")
End Sub

完整聊天示例

vb
' ========== 服务端 ==========

' cChatController.cls
Option Explicit

' GET /chat/stream
Public Sub Stream(ctx As cHttpServerContext)
    ' 检查登录
    If Not ctx.Session.Exists("user_id") Then
        ctx.Response.State401 "请先登录"
        Exit Sub
    End If
    
    ' 设置 SSE 头
    ctx.Response.Header("Content-Type") = "text/event-stream"
    ctx.Response.Header("Cache-Control") = "no-cache"
    ctx.Response.Header("Connection") = "keep-alive"
    
    ' 注册到聊天室
    Dim userId As String, username As String
    userId = ctx.Session("user_id")
    username = ctx.Session("username")
    
    Call RegisterUser(userId, username, ctx.ClientInfo.hSocket)
    
    ' 发送欢迎消息
    Call ctx.SSE.Send(ctx.ClientInfo.hSocket, "system", _
        "{\"msg\":\"欢迎 \" & username & \" 加入聊天室\"}")
    
    ' 保持连接
    Do While ctx.SSE.IsConnected(ctx.ClientInfo.hSocket)
        DoEvents
        Sleep 100
    Loop
    
    ' 断开时移除用户
    Call UnregisterUser(userId)
End Sub

' POST /chat/send
Public Sub Send(ctx As cHttpServerContext)
    Dim msg As String
    msg = ctx.Request.Form("message")
    
    Dim username As String
    username = ctx.Session("username")
    
    ' 广播给所有用户
    Dim data As String
    data = "{\"user\":\"" & username & "\",\"msg\":\"" & msg & "\"}"
    
    Call ctx.SSE.Broadcast("message", data)
    
    ctx.Response.Json Nothing, 0, "已发送"
End Sub

' ========== 客户端 ==========

Private WithEvents SSE As cSSEClient

Private Sub JoinChat()
    Set SSE = New cSSEClient
    SSE.Connect "http://localhost:8080/chat/stream"
End Sub

Private Sub SendMessage(msg As String)
    Dim http As New cHttpClient
    http.RequestDataForm("message") = msg
    http.SendPost "http://localhost:8080/chat/send"
End Sub

Private Sub SSE_OnMessage(EventName As String, Data As String, Id As String)
    Select Case EventName
        Case "system"
            ' 显示系统消息
            ShowSystemMessage Data
        Case "message"
            ' 显示聊天消息
            ShowChatMessage Data
    End Select
End Sub

客户端管理

vb
' cSSE.cls (框架内置)

' 获取在线客户端数量
dim count as long
count = ctx.SSE.ClientCount

' 关闭指定客户端
call ctx.SSE.CloseClient(hSocket)

' 关闭所有客户端
call ctx.SSE.CloseAll()

最后更新: 2026-05-17

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