VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TransmissionTools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : Buffering
' Author    : Entity Reborn
' Date      : 9/18/2008
'
'       All code contained in this file/program/snippit is free for use, modifiation,
'       and distribution, under any context, given that credit, in partial or in whole,
'       be given to me, Entity Reborn.
' Info      : Various tools to aide in sending and receiving of network messages
' Note      : The buffering does not garrantee that the info in the
'             packets is valid, only that it arrives as was sent, and
'             in the correct order.
'---------------------------------------------------------------------------------------

Option Explicit

Private strBuffer As String 'Used when we don't have the full packet.

'Event that is raised when a complete packet is encountered.
Event StringReceived(Message As String, HasHeader As Boolean)

'When receiving a string, check to see if it is complete (contains vbNullChar
'at end). If not, store it in strBuffer, and if so, either raise an event
'or send to be de-headered, allowing the caller to further deal with the data.
Public Sub Add2Buffer(Message As String, Optional bRemoveHeader As Boolean = True)
    Dim tmpBufferArray() As String 'Used when string containes more than one packet
    Dim iPackets As Integer 'Count of packets if more than one.
    Dim LastPacketIsGood As Boolean
    'Add current string to buffer, in case packets were fragmented.
    strBuffer = strBuffer & Message
    
    'If string is one or more complete packets (characterised by vbNullChar
    'at end) then work on it right away, otherwise save it for later.
    If InStr(Len(strBuffer) - 1, strBuffer, vbNullChar, vbTextCompare) Then
        'As we are using vbNullChar to delineate the packets, we will have one
        'extraneous vbNullChar at the end of the string, so we need to remove it.
        strBuffer = Left$(strBuffer, Len(strBuffer) - 1)
        LastPacketIsGood = True
    End If
    
    'Check to see if we have multiple packets. If so, array them, then
    'call StringReceived or RemoveHeader for each one. If not, send the
    'whole buffer as one event.
    If InStr(1, strBuffer, vbNullChar, vbTextCompare) Then
        'Split up any packets
        tmpBufferArray = Split(strBuffer, vbNullChar, , vbTextCompare)
        
        'Loop through and Raise the events
        For iPackets = 0 To UBound(tmpBufferArray)
            
            'Check to see if last packet in string is complete. If so,
            'continue as normal. Otherwise, save for later processing.
            If iPackets = UBound(tmpBufferArray) And Not LastPacketIsGood Then
                strBuffer = tmpBufferArray(iPackets)
                Exit For
            End If
            
            'Re-Instate any NullChars, which have been removed before transmission
            tmpBufferArray(iPackets) = Replace$(tmpBufferArray(iPackets), _
                "<Null>", vbNullChar, , , vbTextCompare)
            
            If bRemoveHeader Then
                RemoveHeader tmpBufferArray(iPackets), True
            Else
                RaiseEvent StringReceived(tmpBufferArray(iPackets), True)
            End If
        Next iPackets
        
        'Flush the buffer, to be ready for next transmission,
        'if the last packet in string was complete.
        If LastPacketIsGood Then strBuffer = vbNullString
    ElseIf LastPacketIsGood Then
        'Only one packet, so send just the one string.
        'Replace Nulls.
        strBuffer = Replace$(strBuffer, "<Null>", vbNullChar, , , vbTextCompare)
        
        If bRemoveHeader Then
            RemoveHeader strBuffer, True
        Else
            RaiseEvent StringReceived(strBuffer, True)
        End If
        
        'Flush the buffer, to be ready for next transmission.
        strBuffer = vbNullString
    Else
        'Wait for more data.
    End If
End Sub

'Add length header to data, and append end-of-string delimiter
'to seperate buffered messages.
'Input: "Data"
'Output: "4 & vbTab & "Data" & vbNullChar
Public Function AddHeader(inMessage As String) As String
    Dim MsgLength As Integer 'Length of message after substitution.
    Dim Message As String
    
    'as Tab delimits between our length and actual data, remove it from data.
    Message = Replace$(inMessage, vbTab, "<Tab>", , , vbTextCompare)
    Message = Replace$(Message, vbNullChar, "<Null>", , , vbTextCompare)
    MsgLength = Len(Message)
    
    'Add the actual header info.
    Message = MsgLength & vbTab & Message & vbNullChar
    
    'Finally, push out the headed message.
    AddHeader = Message
End Function

'Remove length header, and if messagelength is equal to the header,
'return message, by event or by returnmethod.
'The vbNullChar has been removed already, due to buffer seperation.
'Input: "4 & vbTab & "Data"
'Output: "Data"
Public Function RemoveHeader(inMessage As String, Optional SendAsEvent As Boolean = False) As String
    Dim MsgLength As Integer 'Length of message before substitution.
    Dim MsgArray() As String
    Dim Message As String
    
    'Make sure our incoming message includes a vbTab.
    'If not, debug.print and return nothing.
    If InStr(1, inMessage, vbTab, vbTextCompare) Then
        MsgArray = Split(inMessage, vbTab) 'Create our array.
        
        'Important that our string contain the length header as an integer.
        'If it doesn't, we have garbage, and ignore this string.
        If Not IsNumeric(MsgArray(0)) Then Exit Function
        
        MsgLength = CInt(MsgArray(0)) 'Grab message length from header.
        
        'Compare our message length based on header.
        'If Message length is ok, return message. Otherwise,
        'Debug.Print error, and return nothing.
        If Len(MsgArray(1)) = MsgLength Then
            'Recover vbTab in the message.
            MsgArray(1) = Replace$(MsgArray(1), "<Tab>", vbTab, , , vbTextCompare)
            
            'Finally, return the message.
            If SendAsEvent Then
                RaiseEvent StringReceived(MsgArray(1), False)
            Else
                RemoveHeader = MsgArray(1)
            End If
        Else
            'Make the message readable for the error message.
            Message = Replace$(inMessage, vbTab, "<Tab>", , , vbTextCompare)
            Debug.Print "Bad message length: " & Message
            'Return nothing.
        End If
    Else
        Debug.Print "Badly formated message: " & Message
        'Return nothing.
    End If
End Function