[DataBuffer] Scripting can now use .SendData and .GetDataAndAppend

The bot has been refactored such that the interfaces for sending and
receiving packets through the DataBuffer can now be used through
scripting in the same way the bot does.

API:

Buffer.SendData(Socket, [PacketID], [ServerType], [HeaderType])

- By default, this sends the buffer over the socket unchanged.
- If the HeaderType supports it, PacketID will be used in a pre-pended header.
  HeaderType values:
  0 = phtNONE: no header
  3 = phtMCP: MCP/BNLS-like 3-byte header
  4 = phtBNCS: BNCS-like 4-byte header
- If ServerType is non-zero, the packet will be logged to your packet log and cache.

Buffer.GetDataAndAppend(Socket, Length)
- Reads up to Length bytes off the socket as a Byte(). This is locale-independent.
- Appends them to the end of Buffer.

Packet.GetPacketLength(HeaderLenStart)
- Returns an Integer (16-bit value) from position 0, 1, or 2 from the
  start of the packet. Returns 0 for any other HeaderLenStart.
  Does not change the value of the Buffer.Position property.
  For the use of several Battle.net-like binary protocols.

Buffer.IsFullPacket(HeaderLenStart)
- Returns True if this is a full packet,
  False if not, if invalid HeaderLenStart, or if empty buffer.
  Does not change the value of the Buffer.Position property.
  For the use of several Battle.net-like binary protocols.

Buffer.TakePacket(HeaderLenStart)
- Returns a new DataBuffer with a completed packet.
  The DataBuffer is empty if IsFullPacket() would have failed.
  For the use of several Battle.net-like binary protocols.

Suggested usage:

    ' Example: Data buffering in a script made to connect to vL's BotNet service
    ' Headers are of the form:
    ' (UINT8) Protocol version (0x01)
    ' (UINT8) Packet ID
    ' (UINT16) Packet length
    Sub BotNetSock_DataArrival(Length)
        Dim Packet
        RecvBuffer.GetDataAndAppend BotNetSock, Length
        Do While RecvBuffer.IsFullPacket(2)
            Set Packet = RecvBuffer.TakePacket(2)
            Call Recv_PacketSwitch(Packet)
            Set Packet = Nothing
        Loop
    End Sub

trunk/clsDataBuffer.cls

@@ -380,7 +380,7 @@ Public Function DebugOutput(Optional ByVal Start As Long = 0, Optional ByVal Len
     DebugOutput = modPacketBuffer.DebugOutput(Data, Start, Length)
 End Function
 
-Public Function SendData(ByRef Socket As Winsock, Optional ByVal PacketID As Byte, Optional ByVal ServerType As enuServerTypes = stBNCS, Optional ByVal HeaderType As enuPacketHeaderTypes = phtBNCS) As Boolean
+Public Function SendData(ByVal Socket As Winsock, Optional ByVal PacketID As Byte, Optional ByVal ServerType As enuServerTypes = stGEN, Optional ByVal HeaderType As enuPacketHeaderTypes = phtNONE) As Boolean
     If (Socket Is frmChat.sckBNet) Then
         ' catch packets being sent with their header
         If HeaderType = phtNONE And m_bufsize >= 4 Then PacketID = m_buf(1)
@@ -426,6 +426,14 @@ Public Function vLSendPacket(Optional ByVal PacketID As Byte) As Boolean
     vLSendPacket = Me.SendData(frmChat.sckBNLS, PacketID, stBNLS, phtMCP)
 End Function
 
+Public Sub GetDataAndAppend(ByVal Socket As Winsock, Optional ByVal Length As Long)
+    Dim buf() As Byte
+    ' read buffer as Byte()
+    Socket.GetData buf(), vbArray + vbByte, Length
+    ' add data to buffer
+    Me.InsertByteArr buf()
+End Sub
+
 Public Function HandleRecvData(Optional ByRef PacketID As Byte, Optional ByRef PacketLength As Long, Optional ByVal ServerType As enuServerTypes = stBNCS, Optional ByVal HeaderType As enuPacketHeaderTypes = phtBNCS, Optional ByVal ScriptSource As Boolean = False) As Boolean
     Dim HasPacketID As Boolean
 
@@ -459,76 +467,74 @@ Public Function FindByte(ByVal Value As Integer) As Long
     FindByte = 0
 End Function
 
-Public Function IsFullPacket(Optional ByVal st As enuServerTypes = stBNCS) As Boolean
+Public Function IsFullPacket(ByVal HeaderLenStart As Integer) As Boolean
     Dim lngPacketLen As Long, ByteIndex As Long
 
     IsFullPacket = False
 
     If m_bufsize > 0 Then
-        ByteIndex = FindByte(&HFF)
+        lngPacketLen = GetPacketLength(HeaderLenStart)
 
-        If st <> stBNCS Or ByteIndex = 1 Then
-            lngPacketLen = GetPacketLength(st)
-
-            If (lngPacketLen = 0) Then
-                Exit Function
-            End If
+        If (lngPacketLen = 0) Then
+            Exit Function
+        End If
 
-            If (m_bufsize >= lngPacketLen) Then
-                If lngPacketLen < 10000 Then
-                    IsFullPacket = True
-                Else
-                    frmChat.AddChat g_Color.ErrorMessageText, "Error: Packet Length of unusually high Length detected! Packet " & _
-                            "dropped. Buffer content at this time: " & vbCrLf & DebugOutput()
-
-                    Call Clear
-                End If
-            End If
-        Else
-            frmChat.AddChat g_Color.ErrorMessageText, "Error: The front of the buffer is not a valid packet!"
-
-            If MDebug("showdrops") Then
-                frmChat.AddChat g_Color.ErrorMessageText, "Error: The front of the buffer is not " & _
-                        "a valid packet!"
-                frmChat.AddChat g_Color.ErrorMessageText, "The following data is being purged:"
-
-                If ByteIndex > 0 Then
-                    frmChat.AddChat g_Color.ErrorMessageText, Space$(1) & DebugOutput()
-                Else
-                    frmChat.AddChat g_Color.ErrorMessageText, Space$(1) & DebugOutput()
-                End If
-            End If
-
-            If ByteIndex > 0 Then
-                m_bufpos = ByteIndex
-                Call Clear
+        If (m_bufsize >= lngPacketLen) Then
+            If lngPacketLen < 10000 Then
+                IsFullPacket = True
             Else
+                frmChat.AddChat g_Color.ErrorMessageText, "Error: Packet Length of unusually high Length detected! Packet " & _
+                        "dropped. Buffer content at this time: " & vbCrLf & DebugOutput()
+
                 Call Clear
             End If
         End If
+       'Else
+       '    frmChat.AddChat g_Color.ErrorMessageText, "Error: The front of the buffer is not a valid packet!"
+       '
+       '    If MDebug("showdrops") Then
+       '        frmChat.AddChat g_Color.ErrorMessageText, "Error: The front of the buffer is not " & _
+       '                "a valid packet!"
+       '        frmChat.AddChat g_Color.ErrorMessageText, "The following data is being purged:"
+       '
+       '        If ByteIndex > 0 Then
+       '            frmChat.AddChat g_Color.ErrorMessageText, Space$(1) & DebugOutput()
+       '        Else
+       '            frmChat.AddChat g_Color.ErrorMessageText, Space$(1) & DebugOutput()
+       '        End If
+       '    End If
+       '
+       '    If ByteIndex > 0 Then
+       '        m_bufpos = ByteIndex
+       '        Call Clear
+       '    Else
+       '        Call Clear
+       '    End If
+       'End If
     End If
 End Function
 
-Public Function GetPacketLength(Optional ByVal st As enuServerTypes = stBNCS) As Long
+Public Function GetPacketLength(ByVal HeaderLenStart As Integer) As Long
     Dim Value As Long
-
-    Select Case st
-        Case stBNCS
-            Value = GetDWord(True)
-            Value = CLng(Value \ 65536)
-        Case stBNLS, stMCP
-            Value = GetWord(True)
-    End Select
-
+    If HeaderLenStart = 0 Then
+        Value = GetWord(True)
+    ElseIf HeaderLenStart = 2 Then
+        Value = GetDWord(True)
+        Value = CLng(Value \ &H10000)
+    ElseIf HeaderLenStart = 1 Then
+        ' this one's unlikely but...
+        Value = GetDWord(True)
+        Value = CLng(Value \ &H100) And &HFFFF&
+    End If
     GetPacketLength = Value
 End Function
 
-Public Function TakePacket(Optional ByVal st As enuServerTypes = stBNCS) As clsDataBuffer
+Public Function TakePacket(ByVal HeaderLenStart As Integer) As clsDataBuffer
     Dim tmpbuf() As Byte
     Dim lngPacketLen As Long
     Dim pBuff As clsDataBuffer
 
-    lngPacketLen = GetPacketLength(st)
+    lngPacketLen = GetPacketLength(HeaderLenStart)
 
     ' returns new buffer
     Set TakePacket = New clsDataBuffer

trunk/frmChat.frm

@@ -5966,23 +5966,19 @@ End Sub
 
 Private Sub sckMCP_DataArrival(ByVal bytesTotal As Long)
     On Error GoTo ERROR_HANDLER
-
-    Dim buf() As Byte
+
     Dim pBuff As clsDataBuffer
-    
+
     If bytesTotal = 0 Then Exit Sub
-
-    ' read buffer as Byte()
-    sckMCP.GetData buf(), vbArray + vbByte, bytesTotal
-    ' add data to buffer
-    ReceiveBuffer(stMCP).InsertByteArr buf()
+
+    ReceiveBuffer(stMCP).GetDataAndAppend sckMCP, bytesTotal
 
     If ProxyConnInfo(stMCP).IsUsingProxy And ProxyConnInfo(stMCP).Status <> psOnline Then
         Call modProxySupport.ProxyRecvPacket(sckMCP, ProxyConnInfo(stMCP), ReceiveBuffer(stMCP))
     Else
-        Do While ReceiveBuffer(stMCP).IsFullPacket(stMCP)
+        Do While ReceiveBuffer(stMCP).IsFullPacket(0)
             ' retrieve MCP packet
-            Set pBuff = ReceiveBuffer(stMCP).TakePacket(stMCP)
+            Set pBuff = ReceiveBuffer(stMCP).TakePacket(0)
             ' if MCP handler exists, parse
             If Not ds.MCPHandler Is Nothing Then
                 Call ds.MCPHandler.MCPRecvPacket(pBuff)
@@ -5991,7 +5987,7 @@ Private Sub sckMCP_DataArrival(ByVal bytesTotal As Long)
             Set pBuff = Nothing
         Loop
     End If
-    
+
     Exit Sub
 
 ERROR_HANDLER:
@@ -6431,7 +6427,7 @@ Sub Connect()
             Exit Sub
         End If
 
-        For i = 0 To 2
+        For i = LBound(ProxyConnInfo) To UBound(ProxyConnInfo)
             ProxyConnInfo(i).IsUsingProxy = ProxyConnInfo(i).UseProxy
             If ProxyConnInfo(i).IsUsingProxy And (ProxyConnInfo(i).ProxyPort = 0 Or LenB(ProxyConnInfo(i).ProxyIP) = 0) Then
                 MsgBox "You have selected to use a proxy for one or more connections, but no proxy is configured. Please set one up in the Advanced " & _
@@ -7239,7 +7235,7 @@ Sub ReloadConfig(Optional Mode As Byte = 0)
         Call UpdateListviewTabs
     End If
 
-    For i = 0 To 2
+    For i = LBound(ProxyConnInfo) To UBound(ProxyConnInfo)
         With ProxyConnInfo(i)
             .ServerType = i
             Select Case i
@@ -7429,17 +7425,13 @@ Private Sub sckBNet_DataArrival(ByVal bytesTotal As Long)
     #If (COMPILE_DEBUG <> 1) Then
         On Error GoTo ERROR_HANDLER
     #End If
-
-    Dim buf() As Byte
+
     Dim pBuff As clsDataBuffer
-    
+
     If bytesTotal = 0 Then Exit Sub
 
-    ' read buffer as Byte()
-    sckBNet.GetData buf(), vbArray + vbByte, bytesTotal
-    ' add data to buffer
-    ReceiveBuffer(stBNCS).InsertByteArr buf()
-
+    ReceiveBuffer(stBNCS).GetDataAndAppend sckBNet, bytesTotal
+
     If ProxyConnInfo(stBNCS).IsUsingProxy And ProxyConnInfo(stBNCS).Status <> psOnline Then
         Call modProxySupport.ProxyRecvPacket(sckBNet, ProxyConnInfo(stBNCS), ReceiveBuffer(stBNCS))
     Else
@@ -7449,16 +7441,16 @@ Private Sub sckBNet_DataArrival(ByVal bytesTotal As Long)
             AutoReconnectTry = 0
         End If
 
-        Do While ReceiveBuffer(stBNCS).IsFullPacket(stBNCS)
+        Do While ReceiveBuffer(stBNCS).IsFullPacket(2)
             ' retrieve BNLS packet
-            Set pBuff = ReceiveBuffer(stBNCS).TakePacket(stBNCS)
+            Set pBuff = ReceiveBuffer(stBNCS).TakePacket(2)
             ' parse
             Call modBNCS.BNCSRecvPacket(pBuff)
             ' clean up
             Set pBuff = Nothing
         Loop
     End If
-    
+
     Exit Sub
 
 ERROR_HANDLER:
@@ -7573,30 +7565,26 @@ End Sub
 
 Private Sub sckBNLS_DataArrival(ByVal bytesTotal As Long)
     On Error GoTo ERROR_HANDLER
-
-    Dim buf() As Byte
+
     Dim pBuff As clsDataBuffer
 
     If bytesTotal = 0 Then Exit Sub
-
-    ' read buffer as Byte()
-    sckBNLS.GetData buf(), vbArray + vbByte, bytesTotal
-    ' add data to buffer
-    ReceiveBuffer(stBNLS).InsertByteArr buf()
+
+    ReceiveBuffer(stBNLS).GetDataAndAppend sckBNLS, bytesTotal
 
     If ProxyConnInfo(stBNLS).IsUsingProxy And ProxyConnInfo(stBNLS).Status <> psOnline Then
         Call modProxySupport.ProxyRecvPacket(sckBNLS, ProxyConnInfo(stBNLS), ReceiveBuffer(stBNLS))
     Else
-        Do While ReceiveBuffer(stBNLS).IsFullPacket(stBNLS)
+        Do While ReceiveBuffer(stBNLS).IsFullPacket(0)
             ' retrieve BNLS packet
-            Set pBuff = ReceiveBuffer(stBNLS).TakePacket(stBNLS)
+            Set pBuff = ReceiveBuffer(stBNLS).TakePacket(0)
             ' parse
             Call modBNLS.BNLSRecvPacket(pBuff)
             ' clean up
             Set pBuff = Nothing
         Loop
     End If
-    
+
     Exit Sub
 
 ERROR_HANDLER:

trunk/modGlobals.bas

@@ -21,8 +21,8 @@ Public ProductList(12) As udtProductInfo
 Public g_Queue As New clsQueue
 Public g_OSVersion As New clsOSVersion
 Public SharedScriptSupport As New clsScriptSupportClass
-Public ReceiveBuffer(0 To 2) As clsDataBuffer
-Public ProxyConnInfo(0 To 2) As udtProxyConnectionInfo
+Public ReceiveBuffer(1 To 3) As clsDataBuffer
+Public ProxyConnInfo(1 To 3) As udtProxyConnectionInfo
 
 Public ConfigOverride As String
 Public CommandLine As String

trunk/modPacketBuffer.bas

@@ -7,11 +7,12 @@ Option Explicit
 Private Const MAX_PACKET_CACHE_SIZE = 100
 
 Public Enum enuServerTypes
-    stBNCS = 0
-    stBNLS = 1
-    stMCP = 2
-    stBNFTP = 3
-    stPROXY = 4
+    stGEN = 0
+    stBNCS = 1
+    stBNLS = 2
+    stMCP = 3
+    stBNFTP = 4
+    stPROXY = 5
 End Enum
 
 Public Enum enuPacketHeaderTypes
@@ -63,6 +64,7 @@ End Function
 
 Public Function NamePacketType(ByVal PktType As enuServerTypes) As String
     Select Case PktType
+        Case stGEN:   NamePacketType = "SCRIPTING"
         Case stBNCS:  NamePacketType = "BNCS"
         Case stBNLS:  NamePacketType = "BNLS"
         Case stMCP:   NamePacketType = "MCP"
@@ -225,7 +227,7 @@ End Function
 ' PacketType: value sent to NamePacketType() shown in packet logs
 ' HeaderType: what kind of header to prepend
 Public Function SendData(ByRef Data() As Byte, ByVal DataLen As Long, _
-        ByVal HasPktID As Boolean, Optional ByVal PktID As Byte, Optional ByRef Socket As Winsock, _
+        ByVal HasPktID As Boolean, Optional ByVal PktID As Byte, Optional ByVal Socket As Winsock, _
         Optional ByVal PktType As enuServerTypes, Optional ByVal HeaderType As enuPacketHeaderTypes) As Boolean
     Dim buf()    As Byte
     Dim HLen     As Byte
@@ -285,9 +287,11 @@ Public Function SendData(ByRef Data() As Byte, ByVal DataLen As Long, _
         Socket.SendData buf
 
         ' only log if sent
-        Pkt = MakePacket(buf, PktLen, HasPktID, PktID, PktType, CtoS)
-        Call CachePacket(Pkt)
-        Call WritePacketData(Pkt)
+        If PktType <> stGEN Then
+            Pkt = MakePacket(buf, PktLen, HasPktID, PktID, PktType, CtoS)
+            Call CachePacket(Pkt)
+            Call WritePacketData(Pkt)
+        End If
     End If
 End Function
 

trunk/modParsing.bas

@@ -3,10 +3,6 @@ Option Explicit
 
 Public Const COLOR_BLUE2 = 12092001
 
-Public Sub SendHeader()
-    frmChat.sckBNet.SendData ChrW(1)
-End Sub
-
 Public Function StrToHex(ByVal String1 As String, Optional ByVal NoSpaces As Boolean = False) As String
     Dim strTemp As String, strReturn As String, i As Long