Skip to content

Advanced Usage Guide

This guide covers advanced features and best practices for the WebSocket library.


📡 Message Fragmentation

Concept

WebSocket allows splitting large messages into multiple frames:

First frame: FIN=0, OpCode=TEXT/BINARY  (Message start)
Following frames: FIN=0, OpCode=CONTINUATION
Last frame: FIN=1, OpCode=CONTINUATION

Server Fragmentation Handling

vb
Private Sub ProcessDataFrame(ByVal Client As cWebSocketServerClient, _
                            ByRef Payload() As Byte, _
                            ByVal OpCode As WsOpCode, _
                            ByVal IsFinal As Boolean)
    If IsFinal And Not Client.IsFragmented Then
        ' Complete single-frame message
        DeliverClientMessage Client, Payload, OpCode
    Else
        ' Start or continue fragmented message
        Client.IsFragmented = True
        Client.FragmentOpCode = OpCode
        Client.FragmentBuffer.Clear
        
        On Error Resume Next
        If UBound(Payload) >= 0 Then
            Client.FragmentBuffer.Append Payload
        End If
        On Error GoTo 0
        
        If IsFinal Then
            DeliverFragmentedMessage Client
        End If
    End If
End Sub

Private Sub DeliverFragmentedMessage(ByVal Client As cWebSocketServerClient)
    Dim baData() As Byte
    baData = Client.GetFragmentedData
    
    DeliverClientMessage Client, baData, Client.FragmentOpCode
    
    Client.ClearFragmentBuffer
End Sub

Client Fragmentation Sending

vb
' Fragment sending of large messages
Public Sub SendLargeMessage(ByVal sMessage As String)
    Dim baPayload() As Byte
    baPayload = StringToUTF8(sMessage)
    
    Dim lChunkSize As Long
    lChunkSize = 4096  ' 4KB per frame
    
    Dim lTotal As Long
    lTotal = UBound(baPayload) + 1
    
    Dim oFrame As New cWebSocketFrame
    Dim i As Long
    Dim lOffset As Long
    
    Do While lOffset < lTotal
        Dim lSize As Long
        lSize = lChunkSize
        If lOffset + lSize > lTotal Then
            lSize = lTotal - lOffset
        End If
        
        Dim baChunk() As Byte
        ReDim baChunk(lSize - 1) As Byte
        CopyMemory baChunk(0), baPayload(lOffset), lSize
        
        Dim baFrame() As Byte
        Dim bIsFinal As Boolean
        bIsFinal = (lOffset + lSize >= lTotal)
        
        If lOffset = 0 Then
            ' First frame
            baFrame = oFrame.BuildFrame(baChunk, WS_OPCODE_TEXT, True, bIsFinal)
        Else
            ' Subsequent frames
            baFrame = oFrame.BuildFrame(baChunk, WS_OPCODE_CONTINUATION, True, bIsFinal)
        End If
        
        m_Socket.SendData baFrame
        lOffset = lOffset + lSize
    Loop
End Sub

🔄 Auto-Reconnect Mechanism

Client Auto-Reconnect

vb
Option Explicit

Private WithEvents m_Client As cWebSocketClient
Private WithEvents tmrReconnect As Timer
Private m_bAutoReconnect As Boolean
Private m_sServerURL As String
Private m_lMaxRetries As Long
Private m_lRetryCount As Long

Private Sub Form_Load()
    Set m_Client = New cWebSocketClient
    Set tmrReconnect = New Timer
    
    m_bAutoReconnect = True
    m_sServerURL = "ws://127.0.0.1:8080"
    m_lMaxRetries = 5
    m_lRetryCount = 0
    tmrReconnect.Interval = 5000  ' 5 seconds
    
    ConnectToServer
End Sub

Private Sub ConnectToServer()
    If m_Client.State = WS_STATE_CLOSED Then
        Debug.Print "Connecting... (" & (m_lRetryCount + 1) & "/" & m_lMaxRetries & ")"
        On Error Resume Next
        m_Client.Connect m_sServerURL
        On Error GoTo 0
    End If
End Sub

Private Sub m_Client_OnOpen()
    Debug.Print "Connected"
    m_lRetryCount = 0
    tmrReconnect.Enabled = False
End Sub

Private Sub m_Client_OnClose(ByVal Code As WsCloseCode, ByVal Reason As String)
    Debug.Print "Connection closed: " & Reason
    
    If m_bAutoReconnect And Code <> WS_CLOSE_NORMAL Then
        m_lRetryCount = m_lRetryCount + 1
        
        If m_lRetryCount < m_lMaxRetries Then
            Debug.Print "Reconnecting in 5 seconds..."
            tmrReconnect.Enabled = True
        Else
            Debug.Print "Maximum retry attempts reached"
            MsgBox "Cannot connect to server, please try again later", vbExclamation
        End If
    End If
End Sub

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

📡 Heartbeat Keepalive

Client Auto Ping

vb
Option Explicit

Private WithEvents m_Client As cWebSocketClient
Private WithEvents tmrPing As Timer
Private m_bAutoPing As Boolean
Private m_lPingInterval As Long

Private Sub Form_Load()
    Set m_Client = New cWebSocketClient
    Set tmrPing = New Timer
    
    m_bAutoPing = True
    m_lPingInterval = 30000  ' 30 seconds
    tmrPing.Interval = m_lPingInterval
End Sub

Private Sub m_Client_OnOpen()
    If m_bAutoPing Then
        tmrPing.Enabled = True
        Debug.Print "Heartbeat enabled, interval: " & m_lPingInterval & " ms"
    End If
End Sub

Private Sub tmrPing_Timer()
    If m_Client.State = WS_STATE_OPEN Then
        ' Send Ping (with timestamp for latency measurement)
        Dim lTimestamp As Long
        lTimestamp = GetTickCount()
        
        Dim baData(3) As Byte
        baData(0) = (lTimestamp And &HFF000000) \ &H1000000
        baData(1) = (lTimestamp And &HFF0000) \ &H10000
        baData(2) = (lTimestamp And &HFF00&) \ &H100&
        baData(3) = lTimestamp And &HFF&
        
        m_Client.SendPing baData
        Debug.Print "Ping sent"
    End If
End Sub

Private Sub m_Client_OnPong(Data() As Byte)
    If UBound(Data) >= 3 Then
        Dim lSendTime As Long
        lSendTime = CLng(Data(0)) * 256& ^ 3 + CLng(Data(1)) * 256& ^ 2 + _
                  CLng(Data(2)) * 256& + CLng(Data(3))
        
        Dim lLatency As Long
        lLatency = GetTickCount() - lSendTime
        Debug.Print "Pong received, latency: " & lLatency & " ms"
    End If
End Sub

🔐 Authentication and Authorization

Client Token Authentication

vb
Public Sub ConnectWithToken(ByVal ServerURL As String, ByVal Token As String)
    ' Add Token to URL
    Dim sURL As String
    sURL = ServerURL & "?token=" & Token
    
    m_Client.Connect sURL
End Sub

' Or send after handshake
Private Sub m_Client_OnOpen()
    ' Send authentication info
    Dim sAuth As String
    sAuth = "{""type"":""auth"", ""token"":""abc123""}"
    
    m_Client.SendText sAuth
End Sub

Server Authentication Verification

vb
Private Sub m_Server_OnClientConnect(ByVal ClientID As String, ByVal RemoteAddress As String, ByVal RemotePort As Long)
    ' Get Token (assume in URL query parameters)
    ' Note: Need to extend handshake logic to get query parameters
    
    Dim sToken As String
    sToken = GetTokenFromHandshake(m_Server, ClientID)
    
    If Not ValidateToken(sToken) Then
        Debug.Print "Authentication failed: " & ClientID
        m_Server.DisconnectClient ClientID, WS_CLOSE_POLICY_VIOLATION, "Invalid Token"
        Exit Sub
    End If
    
    ' Authentication successful
    Debug.Print "Authentication successful: " & ClientID
End Sub

Private Function ValidateToken(ByVal Token As String) As Boolean
    ' Verify Token (example)
    If LenB(Token) = 0 Then
        ValidateToken = False
        Exit Function
    End If
    
    ' Check database or config
    ' ...
    
    ValidateToken = True
End Function

📦 Custom Protocol

Protocol Definition

vb
' Custom message types
Private Const MSG_TYPE_CHAT As Long = 1
Private Const MSG_TYPE_JOIN As Long = 2
Private Const MSG_TYPE_LEAVE As Long = 3
Private Const MSG_TYPE_SYSTEM As Long = 4

' Message header structure
Private Type tMessageHeader
    Type As Long       ' Message type
    Length As Long     ' Message length
    SenderID As String ' Sender ID
End Type

Build Custom Message

vb
Public Function BuildCustomMessage(ByVal MsgType As Long, ByVal SenderID As String, ByVal Content As String) As Byte()
    Dim baContent() As Byte
    baContent = StringToUTF8(Content)
    
    ' Build header
    Dim oBuffer As New cByteBuffer
    oBuffer.AppendByte (MsgType And &HFF000000) \ &H1000000
    oBuffer.AppendByte (MsgType And &HFF0000) \ &H10000
    oBuffer.AppendByte (MsgType And &HFF00&) \ &H100&
    oBuffer.AppendByte (MsgType And &HFF&)
    
    Dim lLen As Long
    lLen = UBound(baContent) + 1
    oBuffer.AppendByte (lLen And &HFF000000) \ &H1000000
    oBuffer.AppendByte (lLen And &HFF0000) \ &H10000
    oBuffer.AppendByte (lLen And &HFF00&) \ &H100&
    oBuffer.AppendByte (lLen And &HFF&)
    
    ' Add SenderID length and content
    Dim baSenderID() As Byte
    baSenderID = StringToUTF8(SenderID)
    oBuffer.AppendByte (UBound(baSenderID) + 1)
    If UBound(baSenderID) >= 0 Then
        oBuffer.Append baSenderID
    End If
    
    ' Add content
    If UBound(baContent) >= 0 Then
        oBuffer.Append baContent
    End If
    
    BuildCustomMessage = oBuffer.ToArray
End Function

Parse Custom Message

vb
Public Sub ParseCustomMessage(ByVal Data() As Byte)
    Dim oBuffer As New cByteBuffer
    oBuffer.Append Data
    
    ' Read type
    Dim lType As Long
    lType = CLng(oBuffer.PeekByte(0)) * 256& ^ 3 + _
             CLng(oBuffer.PeekByte(1)) * 256& ^ 2 + _
             CLng(oBuffer.PeekByte(2)) * 256& + _
             CLng(oBuffer.PeekByte(3))
    oBuffer.Consume 4
    
    ' Read length
    Dim lLength As Long
    lLength = CLng(oBuffer.PeekByte(0)) * 256& ^ 3 + _
               CLng(oBuffer.PeekByte(1)) * 256& ^ 2 + _
               CLng(oBuffer.PeekByte(2)) * 256& + _
               CLng(oBuffer.PeekByte(3))
    oBuffer.Consume 4
    
    ' Read SenderID
    Dim lSenderLen As Byte
    lSenderLen = oBuffer.PeekByte(0)
    oBuffer.Consume 1
    
    Dim baSenderID() As Byte
    ReDim baSenderID(lSenderLen - 1) As Byte
    If lSenderLen > 0 Then
        Dim i As Long
        For i = 0 To lSenderLen - 1
            baSenderID(i) = oBuffer.PeekByte(i)
        Next i
        oBuffer.Consume lSenderLen
    End If
    Dim sSenderID As String
    sSenderID = UTF8ToString(baSenderID)
    
    ' Read content
    Dim baContent() As Byte
    If lLength > 0 Then
        ReDim baContent(lLength - 1) As Byte
        For i = 0 To lLength - 1
            baContent(i) = oBuffer.PeekByte(i)
        Next i
    End If
    Dim sContent As String
    sContent = UTF8ToString(baContent)
    
    ' Process message
    Select Case lType
        Case MSG_TYPE_CHAT
            HandleChatMessage sSenderID, sContent
        Case MSG_TYPE_JOIN
            HandleJoinMessage sSenderID
        Case MSG_TYPE_LEAVE
            HandleLeaveMessage sSenderID
        Case MSG_TYPE_SYSTEM
            HandleSystemMessage sContent
    End Select
End Sub

📊 Performance Optimization

1. Batch Sending

vb
' ❌ Bad: Multiple SendText calls
For i = 0 To 100
    m_Client.SendText "Message " & i
Next i

' ✅ Good: Single send after concatenation
Dim sMessages As String
For i = 0 To 100
    sMessages = sMessages & "Message " & i & vbLf
Next i
m_Client.SendText sMessages

2. Use Events Instead of Polling

vb
' ✅ Good: Use events
Private Sub m_Client_OnTextMessage(ByVal Message As String)
    ProcessMessage Message
End Sub

' ❌ Bad: Polling check
Private Sub Timer1_Timer()
    If m_Client.State = WS_STATE_OPEN Then
        ' Poll data (not recommended)
    End If
End Sub

3. Limit Broadcast Frequency

vb
Private WithEvents tmrBroadcast As Timer
Private m_sBroadcastQueue As String

Private Sub QueueBroadcast(ByVal Message As String)
    m_sBroadcastQueue = m_sBroadcastQueue & Message & vbLf
End Sub

Private Sub tmrBroadcast_Timer()
    If LenB(m_sBroadcastQueue) > 0 Then
        m_Server.BroadcastText m_sBroadcastQueue
        m_sBroadcastQueue = ""
    End If
End Sub

🐛 Error Handling Best Practices

Unified Error Handling

vb
' Logging module
Public Sub LogError(ByVal ModuleName As String, ByVal Procedure As String, ByVal Description As String)
    Dim sLog As String
    sLog = "[" & Format$(Now, "yyyy-mm-dd hh:nn:ss") & "] "
    sLog = sLog & ModuleName & "." & Procedure & ": " & Description
    
    Debug.Print sLog
    
    ' Write to file
    Dim iFile As Integer
    iFile = FreeFile
    Open "error.log" For Append As #iFile
    Print #iFile, sLog
    Close #iFile
End Sub

' Usage example
Private Sub m_Client_OnError(ByVal Description As String)
    LogError "frmClient", "OnError", Description
End Sub

Connection State Check

vb
Public Sub SendMessageSafe(ByVal Message As String)
    If m_Client Is Nothing Then
        Debug.Print "Client not initialized"
        Exit Sub
    End If
    
    Select Case m_Client.State
        Case WS_STATE_OPEN
            ' Can send
            m_Client.SendText Message
            
        Case WS_STATE_CONNECTING
            Debug.Print "Connecting, please wait"
            
        Case WS_STATE_CLOSING
            Debug.Print "Connection closing"
            
        Case WS_STATE_CLOSED
            Debug.Print "Connection closed"
            
    End Select
End Sub

🔍 Debugging Tips

Log Output

vb
Private Sub DebugFrame(oFrame As cWebSocketFrame)
    Debug.Print "=== WebSocket Frame ==="
    Debug.Print "FIN: " & oFrame.FIN
    Debug.Print "OpCode: " & oFrame.OpCode
    Debug.Print "HasMask: " & oFrame.HasMask
    Debug.Print "PayloadLength: " & oFrame.PayloadLength
    Debug.Print "HeaderLength: " & oFrame.HeaderLength
    Debug.Print "TotalFrameLength: " & oFrame.TotalFrameLength
    Debug.Print "IsValid: " & oFrame.IsValid
    Debug.Print "==================="
End Sub

Message Tracking

vb
Private Sub LogMessage(ByVal ClientID As String, ByVal Direction As String, ByVal Message As String)
    Dim sLog As String
    sLog = Format$(Now, "hh:nn:ss") & " [" & Direction & "] " & ClientID & ": " & Message
    
    txtLog.Text = txtLog.Text & sLog & vbCrLf
    txtLog.SelStart = Len(txtLog.Text)
    
    ' Save to file
    Dim iFile As Integer
    iFile = FreeFile
    Open "messages.log" For Append As #iFile
    Print #iFile, sLog
    Close #iFile
End Sub

' Usage
LogMessage ClientID, "OUT", Message
LogMessage ClientID, "IN", Message

📚 References


Last Updated: 2026-01-10

VB6 and LOGO copyright of Microsoft Corporation