Contents in this wiki are for entertainment purposes only
This is not fiction ∞ this is psience of mind

Robust Winsock VB6 Class

From Catcliffe Development
Jump to navigation Jump to search 



Option Explicit

' RobustWinsock Class
' A robust VB6 winsock implementation designed to handle large data transfers,
' connection failures, and error recovery.
'
' Features:
' - Automatic reconnection on failure
' - Chunked data transfer for large files
' - Timeout handling
' - CRC checking for data integrity
' - Session management
' - Event-based architecture
' - Comprehensive error handling
' - Buffer management for large transfers

' Constants for socket states
Private Const SOCKET_CLOSED = 0
Private Const SOCKET_OPEN = 1
Private Const SOCKET_LISTENING = 2
Private Const SOCKET_CONNECTION_PENDING = 3
Private Const SOCKET_RESOLVING_HOST = 4
Private Const SOCKET_HOST_RESOLVED = 5
Private Const SOCKET_CONNECTING = 6
Private Const SOCKET_CONNECTED = 7
Private Const SOCKET_CLOSING = 8
Private Const SOCKET_ERROR = 9

' Constants for CRC calculation
Private Const CRC32_POLYNOMIAL = &HEDB88320

' Constants for error handling
Private Const ERR_WINSOCK_BASE = 10000
Private Const ERR_CONNECTION_TIMEOUT = ERR_WINSOCK_BASE + 1
Private Const ERR_CONNECTION_RESET = ERR_WINSOCK_BASE + 2
Private Const ERR_DATA_INTEGRITY = ERR_WINSOCK_BASE + 3
Private Const ERR_BUFFER_OVERFLOW = ERR_WINSOCK_BASE + 4

' Constants for data transfer
Private Const DEFAULT_BUFFER_SIZE = 8192      ' 8KB default buffer
Private Const MAX_BUFFER_SIZE = 1048576       ' 1MB max buffer
Private Const DEFAULT_TIMEOUT = 30000         ' 30 seconds
Private Const DEFAULT_RETRY_COUNT = 3         ' Default number of retries
Private Const DEFAULT_HEARTBEAT_INTERVAL = 5000 ' 5 seconds

' Member variables
Private m_Winsock As Winsock               ' The actual Winsock control
Private m_BufferSize As Long               ' Size of the buffer
Private m_SendBuffer() As Byte             ' Buffer for sending data
Private m_ReceiveBuffer() As Byte          ' Buffer for receiving data
Private m_SendBufferLength As Long         ' Current length of send buffer
Private m_ReceiveBufferLength As Long      ' Current length of receive buffer
Private m_Timeout As Long                  ' Timeout in milliseconds
Private m_RetryCount As Integer            ' Number of retries
Private m_CurrentRetry As Integer          ' Current retry count
Private m_RemoteHost As String             ' Remote host name or IP
Private m_RemotePort As Long               ' Remote port
Private m_LocalPort As Long                ' Local port
Private m_Connected As Boolean             ' Connection state
Private m_LastError As Long                ' Last error code
Private m_LastErrorMessage As String       ' Last error message
Private m_AutoReconnect As Boolean         ' Auto reconnect flag
Private m_HeartbeatTimer As Timer          ' Timer for heartbeats
Private m_HeartbeatInterval As Long        ' Heartbeat interval
Private m_TransferInProgress As Boolean    ' Flag for transfer in progress
Private m_TotalBytesSent As Long           ' Total bytes sent in current transfer
Private m_TotalBytesReceived As Long       ' Total bytes received in current transfer
Private m_ConnectionTimer As Timer         ' Timer for connection timeout
Private m_SessionID As String              ' Unique session identifier
Private m_CRCTable(0 To 255) As Long       ' Table for CRC calculation
Private m_TransferID As Long               ' Current transfer ID
Private m_ChunkSize As Long                ' Size of data chunks
Private m_PacketSequence As Long           ' Packet sequence number

' Event declarations
Public Event Connected()
Public Event Disconnected()
Public Event DataArrival(ByVal bytesTotal As Long)
Public Event SendComplete()
Public Event Error(ByVal Number As Long, ByVal Description As String)
Public Event ConnectionRequest(ByVal requestID As Long)
Public Event ProgressUpdate(ByVal bytesSent As Long, ByVal bytesTotal As Long)
Public Event TransferComplete(ByVal transferID As Long, ByVal success As Boolean)
Public Event Timeout()
Public Event Reconnecting(ByVal attemptNumber As Integer)

' Class initialization
Private Sub Class_Initialize()
    ' Initialize default values
    m_BufferSize = DEFAULT_BUFFER_SIZE
    m_Timeout = DEFAULT_TIMEOUT
    m_RetryCount = DEFAULT_RETRY_COUNT
    m_CurrentRetry = 0
    m_Connected = False
    m_AutoReconnect = True
    m_HeartbeatInterval = DEFAULT_HEARTBEAT_INTERVAL
    m_TransferInProgress = False
    m_TotalBytesSent = 0
    m_TotalBytesReceived = 0
    m_ChunkSize = DEFAULT_BUFFER_SIZE
    m_PacketSequence = 0
    
    ' Initialize buffers
    ReDim m_SendBuffer(0 To m_BufferSize - 1)
    ReDim m_ReceiveBuffer(0 To m_BufferSize - 1)
    
    ' Create a unique session ID
    m_SessionID = GenerateSessionID()
    
    ' Initialize CRC table
    InitializeCRCTable
    
    ' Create the Winsock control
    Set m_Winsock = New Winsock
    
    ' Set up timers
    Set m_HeartbeatTimer = New Timer
    m_HeartbeatTimer.Interval = m_HeartbeatInterval
    m_HeartbeatTimer.Enabled = False
    
    Set m_ConnectionTimer = New Timer
    m_ConnectionTimer.Interval = m_Timeout
    m_ConnectionTimer.Enabled = False
End Sub

' Class termination
Private Sub Class_Terminate()
    ' Clean up
    If m_Connected Then
        DisconnectSocket
    End If
    
    ' Stop timers
    m_HeartbeatTimer.Enabled = False
    m_ConnectionTimer.Enabled = False
    
    ' Clean up objects
    Set m_Winsock = Nothing
    Set m_HeartbeatTimer = Nothing
    Set m_ConnectionTimer = Nothing
End Sub

' Initialize the CRC table for data integrity checks
Private Sub InitializeCRCTable()
    Dim i As Long, j As Long, crc As Long
    
    For i = 0 To 255
        crc = i
        For j = 0 To 7
            If (crc And 1) Then
                crc = (crc \ 2) Xor CRC32_POLYNOMIAL
            Else
                crc = crc \ 2
            End If
        Next j
        m_CRCTable(i) = crc
    Next i
End Sub

' Calculate CRC32 for data integrity
Private Function CalculateCRC32(data() As Byte, ByVal length As Long) As Long
    Dim crc As Long, i As Long
    
    crc = &HFFFFFFFF
    
    For i = 0 To length - 1
        crc = ((crc \ 256) And &HFFFFFF) Xor m_CRCTable((crc And &HFF) Xor data(i))
    Next i
    
    CalculateCRC32 = Not crc
End Function

' Generate a unique session ID
Private Function GenerateSessionID() As String
    Dim guid As String
    guid = Format$(Now, "yyyymmddhhnnss") & Format$(Timer, "000000") & Format$(Rnd() * 1000000, "000000")
    GenerateSessionID = guid
End Function

' Connect to a remote host
Public Function Connect(ByVal remoteHost As String, ByVal remotePort As Long) As Boolean
    On Error GoTo ErrorHandler
    
    ' Store connection parameters
    m_RemoteHost = remoteHost
    m_RemotePort = remotePort
    
    ' Reset counters
    m_CurrentRetry = 0
    m_TotalBytesSent = 0
    m_TotalBytesReceived = 0
    
    ' Attempt to connect
    AttemptConnection
    
    ' Start connection timeout timer
    m_ConnectionTimer.Enabled = True
    
    Connect = True
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    Connect = False
End Function

' Internal connection attempt
Private Sub AttemptConnection()
    On Error GoTo ErrorHandler
    
    ' Close any existing connection
    If m_Connected Then
        DisconnectSocket
    End If
    
    ' Attempt to connect
    m_Winsock.Connect m_RemoteHost, m_RemotePort
    
    Exit Sub
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    
    ' Handle connection failure with retry
    If m_AutoReconnect And m_CurrentRetry < m_RetryCount Then
        m_CurrentRetry = m_CurrentRetry + 1
        RaiseEvent Reconnecting(m_CurrentRetry)
        
        ' Wait a bit before retrying (exponential backoff)
        Dim waitTime As Long
        waitTime = 1000 * (2 ^ m_CurrentRetry)
        
        ' Use a timer to retry
        Dim retryTimer As Timer
        Set retryTimer = New Timer
        retryTimer.Interval = waitTime
        retryTimer.Enabled = True
        
        ' Retry after wait
        AttemptConnection
    Else
        ' Failed after all retries
        RaiseEvent Error(m_LastError, m_LastErrorMessage)
    End If
End Sub

' Listen for incoming connections
Public Function Listen(ByVal localPort As Long) As Boolean
    On Error GoTo ErrorHandler
    
    ' Store local port
    m_LocalPort = localPort
    
    ' Close any existing connection
    If m_Connected Then
        DisconnectSocket
    End If
    
    ' Start listening
    m_Winsock.LocalPort = localPort
    m_Winsock.Listen
    
    Listen = True
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    Listen = False
End Function

' Accept an incoming connection
Public Function Accept(ByVal requestID As Long) As Boolean
    On Error GoTo ErrorHandler
    
    ' Accept the connection
    m_Winsock.Accept requestID
    m_Connected = True
    
    ' Start heartbeat timer
    m_HeartbeatTimer.Enabled = True
    
    ' Stop connection timeout timer
    m_ConnectionTimer.Enabled = False
    
    ' Raise connected event
    RaiseEvent Connected
    
    Accept = True
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    Accept = False
End Function

' Disconnect from the remote host
Public Sub Disconnect()
    On Error Resume Next
    
    DisconnectSocket
    
    ' Raise disconnected event
    RaiseEvent Disconnected
End Sub

' Internal disconnect method
Private Sub DisconnectSocket()
    On Error Resume Next
    
    ' Close the socket
    If m_Winsock.State <> SOCKET_CLOSED Then
        m_Winsock.Close
    End If
    
    ' Reset connection state
    m_Connected = False
    
    ' Stop timers
    m_HeartbeatTimer.Enabled = False
    m_ConnectionTimer.Enabled = False
    
    ' Reset buffers
    m_SendBufferLength = 0
    m_ReceiveBufferLength = 0
    m_TransferInProgress = False
End Sub

' Send data over the connection
Public Function SendData(data() As Byte, ByVal length As Long) As Boolean
    On Error GoTo ErrorHandler
    
    ' Check if connected
    If Not m_Connected Then
        m_LastError = ERR_WINSOCK_BASE
        m_LastErrorMessage = "Not connected"
        RaiseEvent Error(m_LastError, m_LastErrorMessage)
        SendData = False
        Exit Function
    End If
    
    ' Initialize transfer
    m_TransferInProgress = True
    m_TotalBytesSent = 0
    m_TransferID = CLng(Timer * 1000) ' Create a unique transfer ID
    
    ' Send data in chunks for large transfers
    Dim remainingBytes As Long, currentChunk As Long, i As Long
    Dim sendBuffer() As Byte, headerBuffer(0 To 15) As Byte
    Dim crc As Long
    
    remainingBytes = length
    i = 0
    
    Do While remainingBytes > 0
        ' Determine chunk size
        currentChunk = IIf(remainingBytes > m_ChunkSize, m_ChunkSize, remainingBytes)
        
        ' Prepare chunk buffer
        ReDim sendBuffer(0 To currentChunk - 1)
        
        ' Copy data to chunk buffer
        CopyMemory sendBuffer(0), data(i), currentChunk
        
        ' Calculate CRC for this chunk
        crc = CalculateCRC32(sendBuffer, currentChunk)
        
        ' Create packet header
        ' Format: [SessionID(8)][TransferID(4)][SequenceNumber(2)][Length(2)][CRC(4)]
        m_PacketSequence = m_PacketSequence + 1
        
        ' Prepare packet header
        ReDim headerBuffer(0 To 19)
        CopyMemory headerBuffer(0), CLng(m_TransferID), 4
        CopyMemory headerBuffer(4), CInt(m_PacketSequence), 2
        CopyMemory headerBuffer(6), CInt(currentChunk), 2
        CopyMemory headerBuffer(8), CLng(crc), 4
        
        ' Send header
        m_Winsock.SendData headerBuffer
        
        ' Small delay to ensure header is sent
        Sleep 10
        
        ' Send data chunk
        m_Winsock.SendData sendBuffer
        
        ' Update counters
        m_TotalBytesSent = m_TotalBytesSent + currentChunk
        remainingBytes = remainingBytes - currentChunk
        i = i + currentChunk
        
        ' Raise progress event
        RaiseEvent ProgressUpdate(m_TotalBytesSent, length)
        
        ' Small delay between chunks to prevent buffer overflow
        If remainingBytes > 0 Then Sleep 50
    Loop
    
    SendData = True
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    m_TransferInProgress = False
    SendData = False
End Function

' Send a string over the connection
Public Function SendString(ByVal strData As String) As Boolean
    On Error GoTo ErrorHandler
    
    ' Convert string to byte array
    Dim dataBytes() As Byte
    Dim length As Long
    
    length = Len(strData)
    ReDim dataBytes(0 To length - 1)
    
    ' Copy string to byte array
    CopyMemory dataBytes(0), ByVal strData, length
    
    ' Send the data
    SendString = SendData(dataBytes, length)
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    SendString = False
End Function

' Send a file over the connection
Public Function SendFile(ByVal filePath As String) As Boolean
    On Error GoTo ErrorHandler
    
    ' Check if file exists
    If Not FileExists(filePath) Then
        m_LastError = ERR_WINSOCK_BASE
        m_LastErrorMessage = "File not found: " & filePath
        RaiseEvent Error(m_LastError, m_LastErrorMessage)
        SendFile = False
        Exit Function
    End If
    
    ' Open the file
    Dim fileNum As Integer
    Dim fileLength As Long
    Dim buffer() As Byte
    Dim bytesRead As Long
    
    fileNum = FreeFile
    
    ' Get file size
    fileLength = FileLen(filePath)
    
    ' Prepare buffer for file data
    ReDim buffer(0 To fileLength - 1)
    
    ' Read file into buffer
    Open filePath For Binary Access Read As #fileNum
    Get #fileNum, , buffer
    Close #fileNum
    
    ' Send the file data
    SendFile = SendData(buffer, fileLength)
    Exit Function
    
ErrorHandler:
    ' Close file if open
    If fileNum > 0 Then
        Close #fileNum
    End If
    
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    SendFile = False
End Function

' Check if a file exists
Private Function FileExists(ByVal filePath As String) As Boolean
    On Error Resume Next
    FileExists = (Dir(filePath) <> "")
End Function

' Get data from the receive buffer
Public Function GetData(ByRef data() As Byte, ByVal maxLength As Long) As Long
    On Error GoTo ErrorHandler
    
    ' Check if there's data in the buffer
    If m_ReceiveBufferLength = 0 Then
        GetData = 0
        Exit Function
    End If
    
    ' Determine how much data to copy
    Dim copyLength As Long
    copyLength = IIf(m_ReceiveBufferLength > maxLength, maxLength, m_ReceiveBufferLength)
    
    ' Resize the output buffer
    ReDim data(0 To copyLength - 1)
    
    ' Copy data from receive buffer
    CopyMemory data(0), m_ReceiveBuffer(0), copyLength
    
    ' Shift remaining data in buffer
    If copyLength < m_ReceiveBufferLength Then
        CopyMemory m_ReceiveBuffer(0), m_ReceiveBuffer(copyLength), m_ReceiveBufferLength - copyLength
    End If
    
    ' Update buffer length
    m_ReceiveBufferLength = m_ReceiveBufferLength - copyLength
    
    GetData = copyLength
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    GetData = 0
End Function

' Get all available data as a string
Public Function GetString() As String
    On Error GoTo ErrorHandler
    
    ' Check if there's data in the buffer
    If m_ReceiveBufferLength = 0 Then
        GetString = ""
        Exit Function
    End If
    
    ' Convert buffer to string
    Dim strData As String
    strData = Space(m_ReceiveBufferLength)
    
    ' Copy data to string
    CopyMemory ByVal strData, m_ReceiveBuffer(0), m_ReceiveBufferLength
    
    ' Reset buffer
    m_ReceiveBufferLength = 0
    
    GetString = strData
    Exit Function
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    GetString = ""
End Function

' Save received data to a file
Public Function SaveToFile(ByVal filePath As String) As Boolean
    On Error GoTo ErrorHandler
    
    ' Check if there's data in the buffer
    If m_ReceiveBufferLength = 0 Then
        SaveToFile = False
        Exit Function
    End If
    
    ' Open the file
    Dim fileNum As Integer
    fileNum = FreeFile
    
    ' Write buffer to file
    Open filePath For Binary Access Write As #fileNum
    Put #fileNum, , m_ReceiveBuffer
    Close #fileNum
    
    ' Reset buffer
    m_ReceiveBufferLength = 0
    
    SaveToFile = True
    Exit Function
    
ErrorHandler:
    ' Close file if open
    If fileNum > 0 Then
        Close #fileNum
    End If
    
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
    SaveToFile = False
End Function

' Winsock event handlers
Private Sub m_Winsock_Connect()
    ' Connection established
    m_Connected = True
    
    ' Reset retry counter
    m_CurrentRetry = 0
    
    ' Stop connection timeout timer
    m_ConnectionTimer.Enabled = False
    
    ' Start heartbeat timer
    m_HeartbeatTimer.Enabled = True
    
    ' Raise connected event
    RaiseEvent Connected
End Sub

Private Sub m_Winsock_Close()
    ' Connection closed
    m_Connected = False
    
    ' Stop timers
    m_HeartbeatTimer.Enabled = False
    m_ConnectionTimer.Enabled = False
    
    ' Reset transfer state
    m_TransferInProgress = False
    
    ' Raise disconnected event
    RaiseEvent Disconnected
    
    ' Auto reconnect if enabled
    If m_AutoReconnect Then
        AttemptConnection
    End If
End Sub

Private Sub m_Winsock_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo ErrorHandler
    
    ' Resize buffer if needed
    If m_ReceiveBufferLength + bytesTotal > UBound(m_ReceiveBuffer) + 1 Then
        ' Buffer overflow, resize
        ReDim Preserve m_ReceiveBuffer(0 To m_ReceiveBufferLength + bytesTotal - 1)
    End If
    
    ' Get data from winsock
    Dim tempBuffer() As Byte
    ReDim tempBuffer(0 To bytesTotal - 1)
    
    m_Winsock.GetData tempBuffer
    
    ' Process the packet
    ' Check for header
    If bytesTotal >= 12 Then
        ' Extract header information
        Dim transferID As Long, sequence As Integer, length As Integer, crc As Long
        
        CopyMemory transferID, tempBuffer(0), 4
        CopyMemory sequence, tempBuffer(4), 2
        CopyMemory length, tempBuffer(6), 2
        CopyMemory crc, tempBuffer(8), 4
        
        ' Verify this is a data packet with a valid header
        If bytesTotal >= 12 + length Then
            ' Calculate CRC of the data
            Dim dataCRC As Long
            
            ' Create temp buffer for CRC calculation
            Dim crcBuffer() As Byte
            ReDim crcBuffer(0 To length - 1)
            
            ' Copy data portion
            CopyMemory crcBuffer(0), tempBuffer(12), length
            
            ' Calculate CRC
            dataCRC = CalculateCRC32(crcBuffer, length)
            
            ' Verify CRC
            If dataCRC = crc Then
                ' Valid packet, copy to receive buffer
                CopyMemory m_ReceiveBuffer(m_ReceiveBufferLength), crcBuffer(0), length
                m_ReceiveBufferLength = m_ReceiveBufferLength + length
                
                ' Update total received
                m_TotalBytesReceived = m_TotalBytesReceived + length
                
                ' Raise data arrival event
                RaiseEvent DataArrival(length)
            Else
                ' CRC mismatch, data corruption
                m_LastError = ERR_DATA_INTEGRITY
                m_LastErrorMessage = "Data integrity check failed"
                RaiseEvent Error(m_LastError, m_LastErrorMessage)
            End If
        Else
            ' Not a valid packet, just append to buffer
            CopyMemory m_ReceiveBuffer(m_ReceiveBufferLength), tempBuffer(0), bytesTotal
            m_ReceiveBufferLength = m_ReceiveBufferLength + bytesTotal
            
            ' Update total received
            m_TotalBytesReceived = m_TotalBytesReceived + bytesTotal
            
            ' Raise data arrival event
            RaiseEvent DataArrival(bytesTotal)
        End If
    Else
        ' Not enough data for header, just append to buffer
        CopyMemory m_ReceiveBuffer(m_ReceiveBufferLength), tempBuffer(0), bytesTotal
        m_ReceiveBufferLength = m_ReceiveBufferLength + bytesTotal
        
        ' Update total received
        m_TotalBytesReceived = m_TotalBytesReceived + bytesTotal
        
        ' Raise data arrival event
        RaiseEvent DataArrival(bytesTotal)
    End If
    
    Exit Sub
    
ErrorHandler:
    m_LastError = Err.Number
    m_LastErrorMessage = Err.Description
    RaiseEvent Error(m_LastError, m_LastErrorMessage)
End Sub

Private Sub m_Winsock_Error(ByVal Number As Integer, ByVal Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal CancelDisplay As Boolean)
    ' Store error information
    m_LastError = Number
    m_LastErrorMessage = Description
    
    ' Handle connection reset errors with retry
    If Number = 10054 Then ' Connection reset by peer
        m_Connected = False
        
        ' Stop timers
        m_HeartbeatTimer.Enabled = False
        m_ConnectionTimer.Enabled = False
        
        ' Reset transfer state
        m_TransferInProgress = False
        
        ' Auto reconnect if enabled
        If m_AutoReconnect Then
            AttemptConnection
        End If
    End If
    
    ' Raise error event
    RaiseEvent Error(Number, Description)
End Sub

Private Sub m_Winsock_ConnectionRequest(ByVal requestID As Long)
    ' Forward connection request event
    RaiseEvent ConnectionRequest(requestID)
End Sub

Private Sub m_Winsock_SendComplete()
    ' Forward send complete event
    RaiseEvent SendComplete
    
    ' Check if transfer is complete
    If m_TransferInProgress And m_TotalBytesSent > 0 Then
        m_TransferInProgress = False
        RaiseEvent TransferComplete(m_TransferID, True)
    End If
End Sub

' Timer event handlers
Private Sub m_HeartbeatTimer_Timer()
    On Error Resume Next
    
    ' Send heartbeat packet to keep connection alive
    If m_Connected Then
        ' Create a small heartbeat packet
        Dim heartbeat(0 To 3) As Byte
        heartbeat(0) = &HFF
        heartbeat(1) = &HFF
        heartbeat(2) = &HFF
        heartbeat(3) = &HFF
        
        ' Send heartbeat
        m_Winsock.SendData heartbeat
    End If
End Sub

Private Sub m_ConnectionTimer_Timer()
    ' Connection timeout
    m_ConnectionTimer.Enabled = False
    
    ' Check if still not connected
    If Not m_Connected Then
        ' Stop connection attempt
        On Error Resume Next
        m_Winsock.Close
        
        ' Set error
        m_LastError = ERR_CONNECTION_TIMEOUT
        m_LastErrorMessage = "Connection timeout"
        
        ' Raise timeout event
        RaiseEvent Timeout
        
        ' Try to reconnect if auto reconnect is enabled
        If m_AutoReconnect And m_CurrentRetry < m_RetryCount Then
            AttemptConnection
        Else
            ' Raise error event
            RaiseEvent Error(m_LastError, m_LastErrorMessage)
        End If
    End If
End Sub

' Property procedures
Public Property Get BufferSize() As Long
    BufferSize = m_BufferSize
End Property

Public Property Let BufferSize(ByVal value As Long)
    ' Ensure buffer size is within limits
    If value > 0 And value <= MAX_BUFFER_SIZE Then
        m_BufferSize = value
        
        ' Resize buffers
        ReDim Preserve m_SendBuffer(0 To m_BufferSize - 1)
        ReDim Preserve m_ReceiveBuffer(0 To m_BufferSize - 1)
    End If
End Property

Public Property Get ChunkSize() As Long
    ChunkSize = m_ChunkSize
End Property

Public Property Let ChunkSize(ByVal value As Long)
    ' Ensure chunk size is reasonable
    If value > 0 And value <= MAX_BUFFER_SIZE Then
        m_ChunkSize = value
    End If
End Property

Public Property Get Timeout() As Long
    Timeout = m_Timeout
End Property

Public Property Let Timeout(ByVal value As Long)
    If value > 0 Then
        m_Timeout = value
        m_ConnectionTimer.Interval = value
    End If
End Property

Public Property Get RetryCount() As Integer
    RetryCount = m_RetryCount
End Property

Public Property Let RetryCount(ByVal value As Integer)
    If value >= 0 Then
        m_RetryCount = value
    End If
End Property

Public Property Get AutoReconnect() As Boolean
    AutoReconnect = m_AutoReconnect
End Property

Public Property Let AutoReconnect(ByVal value As Boolean)
    m_AutoReconnect = value
End Property

Public Property Get HeartbeatInterval() As Long
    HeartbeatInterval = m_HeartbeatInterval
End Property

Public Property Let HeartbeatInterval(ByVal value As Long)
    If value > 0 Then
        m_HeartbeatInterval = value
        m_HeartbeatTimer.Interval = value
    End If
End Property

Public Property Get SessionID() As String
    SessionID = m_SessionID
End Property

Public Property Get RemoteHost() As String
    RemoteHost = m_RemoteHost
End Property

Public Property Get RemotePort() As Long
    RemotePort = m_RemotePort
End Property

Public Property Get LocalPort() As Long
    LocalPort = m_LocalPort
End Property

Public Property Let LocalPort(ByVal value As Long)
    If value > 0 Then
        m_LocalPort = value
    End If
End Property

Public Property Get IsConnected() As Boolean
    IsConnected = m_Connected
End Property

Public Property Get LastError() As Long
    LastError = m_LastError
End Property

Public Property Get LastErrorMessage() As String
    LastErrorMessage = m_LastErrorMessage
End Property

Public Property Get BytesSent() As Long
    BytesSent = m_TotalBytesSent
End Property

Public Property Get BytesReceived() As Long
    BytesReceived = m_TotalBytesReceived
End Property

Public Property Get State() As Integer
    If Not m_Winsock Is Nothing Then
        State = m_Winsock.State
    Else
        State = SOCKET_CLOSED
    End If
End Property

' Utility function to copy memory (needs a declare statement in a module)
' Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Retrieved from "http://groupkos.com/dev/index.php?title=Robust_Winsock_VB6_Class&oldid=5040"