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=CONTINUATIONServer 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 SubClient 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 SubServer 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 TypeBuild 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 FunctionParse 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 sMessages2. 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 Sub3. 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 SubConnection 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 SubMessage 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