VB6 PRO DOCS

English

中文

English

中文

Appearance

cWinsock Best Practices ​

📖 Table of Contents ​

Performance Optimization ​

1️⃣ Event Processing Optimization ​

Avoid executing time-consuming operations in event handlers

vb
' ❌ Wrong: Processing large data in event
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    ' Time-consuming operations in event
    ProcessLargeData sData ' May take long
    SaveToDatabase sData     ' May timeout
End Sub

' ✅ Correct: Put time-consuming operations in queue
Private m_oWorkQueue As Collection

Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    ' Add to work queue
    m_oWorkQueue.Add Array(Client.Tag, sData)
    
    ' Timer processes queue
    tmrWorkQueue_Timer
End Sub

Private Sub tmrWorkQueue_Timer()
    Dim vItem As Variant
    Dim sTag As String
    Dim sData As String
    
    If m_oWorkQueue.Count > 0 Then
        vItem = m_oWorkQueue(1)
        sTag = vItem(0)
        sData = vItem(1)
        
        ' Process data
        ProcessData sTag, sData
        
        ' Remove from queue
        m_oWorkQueue.Remove 1
    End If
End Sub

2️⃣ Buffer Size Optimization ​

Adjust buffer size according to application scenarios

vb
' Small data frequent transmission
Private Const SMALL_BUFFER_SIZE As Long = 1024 ' 1KB

' Large data block transmission
Private Const LARGE_BUFFER_SIZE As Long = 65536 ' 64KB

' File transfer
Private Const FILE_CHUNK_SIZE As Long = 8192 ' 8KB

' Usage example
Private Sub SendOptimal(ByVal sData As String)
    Dim lSize As Long
    lSize = Len(sData)
    
    If lSize < SMALL_BUFFER_SIZE Then
        ' Small data, send directly
        m_oClient.SendData sData
    Else
        ' Large data, send in chunks
        Dim lOffset As Long
        lOffset = 1
        
        Do While lOffset <= lSize
            Dim sChunk As String
            sChunk = Mid$(sData, lOffset, FILE_CHUNK_SIZE)
            
            m_oClient.SendData sChunk
            lOffset = lOffset + FILE_CHUNK_SIZE
            
            ' Wait for send completion
            Do While m_bSending
                DoEvents
            Loop
        Loop
    End If
End Sub

3️⃣ Connection Pool Management ​

Use connection pool for scenarios requiring frequent connections

vb
' Connection pool class
Private Type tConnection
    Socket As cWinsock
    InUse As Boolean
    LastUsed As Date
End Type

Private m_oConnections() As tConnection
Private m_lPoolSize As Long

' Initialize connection pool
Private Sub InitConnectionPool(ByVal lSize As Long)
    ReDim m_oConnections(0 To lSize - 1) As tConnection
    m_lPoolSize = lSize
    
    Dim i As Long
    For i = 0 To lSize - 1
        Set m_oConnections(i).Socket = New cWinsock
        m_oConnections(i).InUse = False
        m_oConnections(i).LastUsed = Now
    Next
End Sub

' Get connection
Private Function GetConnection() As cWinsock
    Dim i As Long
    
    ' Find available connection
    For i = 0 To m_lPoolSize - 1
        If Not m_oConnections(i).InUse Then
            If m_oConnections(i).Socket.State = sckConnected Then
                m_oConnections(i).InUse = True
                Set GetConnection = m_oConnections(i).Socket
                Exit Function
            End If
        End If
    Next
    
    ' No available connection, return Nothing
    Set GetConnection = Nothing
End Function

' Release connection
Private Sub ReleaseConnection(ByVal oSocket As cWinsock)
    Dim i As Long
    For i = 0 To m_lPoolSize - 1
        If m_oConnections(i).Socket Is oSocket Then
            m_oConnections(i).InUse = False
            m_oConnections(i).LastUsed = Now
            Exit For
        End If
    Next
End Sub

4️⃣ Batch Sending Optimization ​

vb
' Batch send
Private Sub SendBatch(ByVal vData() As Variant)
    Const BATCH_SIZE As Long = 100
    
    Dim lStart As Long
    lStart = LBound(vData)
    
    Do While lStart <= UBound(vData)
        Dim lEnd As Long
        lEnd = Min(lStart + BATCH_SIZE - 1, UBound(vData))
        
        Dim lBatchCount As Long
        lBatchCount = lEnd - lStart + 1
        
        ' Send multiple data packets at once (using separator)
        Dim i As Long
        Dim sBatch As String
        
        For i = lStart To lEnd
            sBatch = sBatch & vData(i) & vbCrLf
        Next
        
        m_oClient.SendData sBatch
        
        ' Wait for send completion
        Do While m_bSending
            DoEvents
        Loop
        
        lStart = lEnd + 1
    Loop
End Sub

Error Handling ​

1️⃣ Unified Error Handling ​

vb
' Error handling module
Public Enum ErrorLevel
    elInfo = 0
    elWarning = 1
    elError = 2
    elCritical = 3
End Enum

' Unified error log
Public Sub LogError(ByVal eLevel As ErrorLevel, ByVal sSource As String, ByVal sMessage As String, ByVal lErrNum As Long)
    Dim sPrefix As String
    
    Select Case eLevel
        Case elInfo:      sPrefix = "[INFO]"
        Case elWarning:   sPrefix = "[WARN]"
        Case elError:     sPrefix = "[ERROR]"
        Case elCritical:  sPrefix = "[CRIT]"
    End Select
    
    Dim sLog As String
    sLog = Format$(Now, "yyyy-mm-dd hh:mm:ss") & " " & sPrefix & " [" & sSource & "] " & sMessage & " (Error " & lErrNum & ")"
    
    Debug.Print sLog
    
    ' Write to file
    WriteToLogFile sLog
End Sub

' Usage example
Private Sub m_oClient_Error(Client As cWinsock, ByVal Number As Long, Description As String, ByVal Scode As Long)
    LogError elError, "Client", Description, Number
    
    Select Case Number
        Case 10053, 10054
            ' Connection closed, normal
            LogError elInfo, "Client", "Connection closed by remote", Number
            
        Case 10060
            ' Connection timeout
            LogError elWarning, "Client", "Connection timeout", Number
            
        Case Else
            ' Other errors
            LogError elError, "Client", Description, Number
    End Select
End Sub

2️⃣ Retry Mechanism ​

vb
' Operation with retry
Private Function DoWithRetry(ByVal sFuncName As String, ByVal lMaxRetries As Long, ByVal vFunc As Variant) As Boolean
    Dim lRetry As Long
    Dim bSuccess As Boolean
    
    For lRetry = 1 To lMaxRetries
        On Error Resume Next
        bSuccess = CallByName(vFunc, sFuncName, VbMethod)
        
        If bSuccess And Err.Number = 0 Then
            LogError elInfo, "Retry", sFuncName & " success (attempt " & lRetry & "/" & lMaxRetries & ")", 0
            DoWithRetry = True
            Exit Function
        End If
        
        LogError elWarning, "Retry", sFuncName & " failed (attempt " & lRetry & "/" & lMaxRetries & ")", Err.Number
        
        ' Wait before retry
        Sleep 1000 * lRetry
    Next
    
    LogError elError, "Retry", sFuncName & " failed, exceeded max retries", 0
    DoWithRetry = False
End Function

' Usage example
Private Function SendDataWithRetry(ByVal sData As String) As Boolean
    On Error Resume Next
    m_oClient.SendData sData
    SendDataWithRetry = (Err.Number = 0)
End Function

Private Sub SendImportantData(ByVal sData As String)
    If Not DoWithRetry("SendDataWithRetry", 3, Me) Then
        LogError elCritical, "Send", "Cannot send important data", 0
    End If
End Sub

3️⃣ Resource Cleanup ​

vb
' Ensure resource cleanup
Private Sub SafeCloseSocket(ByRef oSocket As cWinsock)
    On Error Resume Next
    
    If Not oSocket Is Nothing Then
        If oSocket.State <> sckClosed Then
            oSocket.Close_
            Debug.Print "Socket closed"
        End If
        Set oSocket = Nothing
    End If
End Sub

' Clean up all resources when form unloads
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    
    ' Close all sockets
    SafeCloseSocket m_oClient
    SafeCloseSocket m_oServer
    SafeCloseSocket m_oUdp
    
    ' Stop all timers
    tmrHeartbeat.Enabled = False
    tmrCleanup.Enabled = False
    
    ' Clean up collections
    Set m_oWorkQueue = Nothing
    Set m_oClients = Nothing
    
    Debug.Print "All resources cleaned up"
End Sub

Security Recommendations ​

1️⃣ Connection Validation ​

vb
' Validate before connection
Private Function ValidateConnection(ByVal sHost As String, ByVal lPort As Long) As Boolean
    ' Check whitelist
    If Not IsWhitelisted(sHost) Then
        LogError elWarning, "Security", sHost & " not in whitelist", 0
        ValidateConnection = False
        Exit Function
    End If
    
    ' Check port range
    If lPort < 1024 Or lPort > 65535 Then
        LogError elWarning, "Security", "Port " & lPort & " out of allowed range", 0
        ValidateConnection = False
        Exit Function
    End If
    
    ' Check connection count limit
    If m_oServer.ClientCount >= MAX_CONNECTIONS Then
        LogError elWarning, "Security", "Maximum connections reached", 0
        ValidateConnection = False
        Exit Function
    End If
    
    ValidateConnection = True
End Function

' Use
Private Sub m_oServer_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)
    If Not ValidateConnection(Client.RemoteHostIP, Client.RemotePort) Then
        DisConnect = True
    End If
End Sub

2️⃣ Data Validation ​

vb
' Validate received data
Private Function ValidateData(ByVal sData As String) As Boolean
    ' Check length
    If Len(sData) > MAX_DATA_SIZE Then
        LogError elWarning, "Security", "Data size exceeds limit", 0
        ValidateData = False
        Exit Function
    End If
    
    ' Check dangerous characters
    If InStr(sData, "<script") > 0 Or InStr(sData, "javascript:") > 0 Then
        LogError elWarning, "Security", "Detected dangerous content", 0
        ValidateData = False
        Exit Function
    End If
    
    ' Custom validation
    If Not CustomValidation(sData) Then
        ValidateData = False
        Exit Function
    End If
    
    ValidateData = True
End Function

' Use
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    If Not ValidateData(sData) Then
        LogError elError, "Security", "Reject invalid data", 0
        Client.Close_
        Exit Sub
    End If
    
    ' Process data
    ProcessData sData
End Sub

3️⃣ Prevent Buffer Overflow ​

vb
' Limit buffer size
Private Const MAX_BUFFER_SIZE As Long = 1048576 ' 1MB

Private Sub m_oClient_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    ' Check buffer size
    If Client.BytesReceived > MAX_BUFFER_SIZE Then
        LogError elCritical, "Security", "Buffer overflow, closing connection", 0
        Client.Close_
        Exit Sub
    End If
    
    ' Read data
    Dim sData As String
    Client.GetData sData
End Sub

4️⃣ Rate Limiting ​

vb
' Rate limiting
Private Type tRateLimit
    Window As Date
    RequestCount As Long
End Type

Private m_oRateLimits As Collection
Private Const MAX_REQUESTS_PER_MINUTE As Long = 60

Private Function CheckRateLimit(ByVal sIP As String) As Boolean
    Dim tLimit As tRateLimit
    On Error Resume Next
    tLimit = m_oRateLimits(sIP)
    
    ' If new IP, create record
    If Err.Number <> 0 Then
        tLimit.Window = Now
        tLimit.RequestCount = 0
        m_oRateLimits.Add tLimit, sIP
    End If
    
    ' Check time window
    If DateDiff("s", tLimit.Window, Now) > 60 Then
        ' Exceeded 1 minute, reset
        tLimit.Window = Now
        tLimit.RequestCount = 0
    End If
    
    ' Check request count
    If tLimit.RequestCount >= MAX_REQUESTS_PER_MINUTE Then
        LogError elWarning, "Security", sIP & " exceeded rate limit", 0
        CheckRateLimit = False
    Else
        tLimit.RequestCount = tLimit.RequestCount + 1
        m_oRateLimits.Remove sIP
        m_oRateLimits.Add tLimit, sIP
        CheckRateLimit = True
    End If
End Function

' Use
Private Sub m_oServer_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)
    If Not CheckRateLimit(Client.RemoteHostIP) Then
        DisConnect = True
    End If
End Sub

Debugging Techniques ​

1️⃣ Detailed Logging ​

vb
' Log levels
Public Enum LogLevel
    llDebug = 0
    llInfo = 1
    llWarning = 2
    llError = 3
End Enum

Public m_eLogLevel As LogLevel

' Logging with levels
Public Sub Log(ByVal eLevel As LogLevel, ByVal sSource As String, ByVal sMessage As String)
    If eLevel < m_eLogLevel Then Exit Sub
    
    Dim sPrefix As String
    Select Case eLevel
        Case llDebug:   sPrefix = "[DEBUG]"
        Case llInfo:    sPrefix = "[INFO]"
        Case llWarning:  sPrefix = "[WARN]"
        Case llError:   sPrefix = "[ERROR]"
    End Select
    
    Dim sLog As String
    sLog = Format$(Now, "hh:mm:ss") & " " & sPrefix & " [" & sSource & "] " & sMessage
    
    Debug.Print sLog
    
    ' Write to log file
    WriteLogToFile sLog
End Sub

' Use
Private Sub m_oClient_Connect(Client As cWinsock)
    Log llInfo, "Client", "Connected to " & Client.RemoteHostIP & ":" & Client.RemotePort
End Sub

Private Sub m_oClient_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Log llDebug, "Client", "Received " & bytesTotal & " bytes"
    
    Dim sData As String
    Client.GetData sData
    
    Log llDebug, "Client", "Data content: " & Left$(sData, 100) ' Only log first 100 chars
End Sub

2️⃣ Packet Capture ​

vb
' Packet capture
Private Type tPacketCapture
    Timestamp As Date
    Direction As String ' "IN" or "OUT"
    Data As String
    Size As Long
End Type

Private m_oPackets As Collection

Private Sub CapturePacket(ByVal sDir As String, ByVal sData As String)
    Dim tPacket As tPacketCapture
    
    tPacket.Timestamp = Now
    tPacket.Direction = sDir
    tPacket.Data = Left$(sData, 200) ' Limit length
    tPacket.Size = Len(sData)
    
    m_oPackets.Add tPacket
    
    Debug.Print "[" & sDir & "] " & Format$(tPacket.Timestamp, "hh:mm:ss") & " " & Len(sData) & " bytes"
End Sub

' Use
Private Sub m_oClient_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    CapturePacket "IN", sData
End Sub

Private Sub cmdSend_Click()
    Dim sData As String
    sData = txtSend.Text
    
    m_oClient.SendData sData
    CapturePacket "OUT", sData
End Sub

3️⃣ Performance Monitoring ​

vb
' Performance statistics
Private Type tPerformanceStats
    TotalPackets As Long
    TotalBytes As Long
    StartTime As Date
    PacketsPerSecond As Double
    BytesPerSecond As Double
End Type

Private m_oStats As tPerformanceStats

' Initialize statistics
Private Sub InitStats()
    m_oStats.TotalPackets = 0
    m_oStats.TotalBytes = 0
    m_oStats.StartTime = Now
End Sub

' Update statistics
Private Sub UpdateStats(ByVal lBytes As Long)
    m_oStats.TotalPackets = m_oStats.TotalPackets + 1
    m_oStats.TotalBytes = m_oStats.TotalBytes + lBytes
    
    Dim lElapsed As Double
    lElapsed = DateDiff("s", m_oStats.StartTime, Now)
    
    If lElapsed > 0 Then
        m_oStats.PacketsPerSecond = m_oStats.TotalPackets / lElapsed
        m_oStats.BytesPerSecond = m_oStats.TotalBytes / lElapsed
    End If
End Sub

' Display statistics
Private Sub ShowStats()
    Debug.Print "===== Performance Statistics ====="
    Debug.Print "Runtime: " & DateDiff("s", m_oStats.StartTime, Now) & " seconds"
    Debug.Print "Total packets: " & m_oStats.TotalPackets
    Debug.Print "Total bytes: " & m_oStats.TotalBytes
    Debug.Print "Packets/sec: " & Format$(m_oStats.PacketsPerSecond, "0.00")
    Debug.Print "Bytes/sec: " & Format$(m_oStats.BytesPerSecond, "0.00")
    Debug.Print "=================================="
End Sub

Common Pitfalls ​

1️⃣ Forgetting DoEvents ​

vb
' ❌ Wrong: Long processing blocks UI
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    ' Long operation, UI freezes
    ProcessLargeData sData
End Sub

' ✅ Correct: Periodically release control
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    Dim i As Long
    For i = 1 To 1000
        ProcessDataChunk sData, i
        
        ' Periodically release control
        If i Mod 10 = 0 Then
            DoEvents
        End If
    Next
End Sub

2️⃣ Memory Leaks ​

vb
' ❌ Wrong: Not releasing objects in time
Private Sub ProcessClients()
    Dim oClient As cWinsock
    For Each oClient In m_oServer.Clients
        Dim oData As New CDataObject
        oData.Data = "xxx"
        
        ' oData not released
    Next
End Sub

' ✅ Correct: Release in time
Private Sub ProcessClients()
    Dim oClient As cWinsock
    For Each oClient In m_oServer.Clients
        Dim oData As New CDataObject
        oData.Data = "xxx"
        
        ' Release immediately after use
        Set oData = Nothing
    Next
End Sub

3️⃣ Ignoring State Check ​

vb
' ❌ Wrong: Operating without checking state
Private Sub cmdSend_Click()
    m_oClient.SendData "Hello" ' May fail
End Sub

' ✅ Correct: Check state first
Private Sub cmdSend_Click()
    If m_oClient.State = sckConnected Then
        m_oClient.SendData "Hello"
    Else
        MsgBox "Not connected", vbExclamation
    End If
End Sub

4️⃣ Wrong Encoding Usage ​

vb
' ❌ Wrong: Inconsistent encoding
m_oClient.SendData "中文", ScpUtf8  ' UTF-8
' When receiving
Client.GetData sData  ' Default ACP → garbled

' ✅ Correct: Keep consistent
m_oClient.SendData "中文", ScpUtf8  ' UTF-8
' When receiving
Client.GetData sData, , , ScpUtf8  ' UTF-8

Last Updated: 2026-01-09

VB6 and LOGO copyright of Microsoft Corporation

VBMAN copyright © 2019-2026 woeoio