[VB.net]packetbuffer

[mentalCo.]

Code Select Expand



Imports System
Imports System.Net.Sockets
Imports System.Text

Namespace UGPB
    Friend Class PacketBuffer
        Protected intPSize As Integer
        Public alBuffer As New ArrayList
        Public stream As NetworkStream
        Public tcpBNET As New System.Net.Sockets.TcpClient
        Public tcpBNLS As New System.Net.Sockets.TcpClient

        Public Function connect(ByVal strServ As String, ByVal port As Integer)
            Try
                tcpBNET.Connect(strServ, port)
            Catch
                Return -1
            End Try
            stream = tcpBNET.GetStream
            Return 1
        End Function

        Public Sub addBYTE(ByVal byt As Byte)
            Me.alBuffer.Add(byt)
        End Sub

        Protected Sub clear()
            Me.alBuffer.Clear()
        End Sub

        Public Sub addBYTES(ByVal byts() As Byte)
            For i As Integer = 0 To UBound(byts)
                alBuffer.Add(byts.GetValue(i))
            Next i
        End Sub

        Public Sub addSTRING(ByVal str As String)
            Me.addBYTES(Encoding.UTF8.GetBytes(str))
        End Sub

        Public Sub addNTSTRING(ByVal str As String)
            alBuffer.Insert(alBuffer.Count, str)
            alBuffer.Add(0)
        End Sub

        Public Sub addDWORD(ByVal dword As Integer)
            addBYTES(BitConverter.GetBytes(dword))
        End Sub

        Public Sub addWORD(ByVal word As Short)
            addBYTES(BitConverter.GetBytes(word))
        End Sub

        Public Sub send(ByVal intServer As Integer, ByVal bytPacketID As Byte)
            Dim bytPacket(1024) As Byte
            Select Case intServer
                Case 1 ' BNET
                    stream = tcpBNET.GetStream
                    Dim outArray(alBuffer.Count + 4) As Byte
                    outArray(0) = &HFF
                    outArray(1) = bytPacketID
                    Array.Copy(BitConverter.GetBytes(CType(alBuffer.Count + 4, Short)), 0, outArray, 2, 2)
                    alBuffer.CopyTo(0, outArray, 4, alBuffer.Count)
                    stream.Write(outArray, 0, UBound(outArray))
                    Me.clear()
                Case 2 ' BNLS
                    stream = tcpBNLS.GetStream
                    Dim outArray(alBuffer.Count + 3) As Byte
                    outArray(0) = bytPacketID
                    Array.Copy(BitConverter.GetBytes(CType(alBuffer.Count + 3, Short)), 0, outArray, 1, 2)
                    alBuffer.CopyTo(outArray, 3)
                    stream.Write(outArray, 0, UBound(outArray))
                    Me.clear()
            End Select
            Me.clear()
        End Sub

    End Class
End Namespace


this works when i do this:

Code Select Expand


dim packetbuff as new UGPB.PacketBuffer

packetbuff.connect(MyIp, MyPort) ' my server displays packets recieved
packetbuff.addSTRING("testing")
packetbuff.send(1, &HE) ' doesnt matter  what the ID is


but, when i try to make 0x50 i run into a problem:

Code Select Expand


PacketBuff.addDWORD(0)
        PacketBuff.addSTRING("IX86")
        PacketBuff.addSTRING(strProduct)
        Select Case strProduct
            Case "STAR"
                PacketBuff.addDWORD(&HC9)
            Case "SEXP"
                PacketBuff.addDWORD(&HC7)
            Case "D2DV"
                PacketBuff.addDWORD(&HA)
            Case "D2XP"
                PacketBuff.addDWORD(&HA)
            Case "W2BN"
                PacketBuff.addDWORD(&H4F)
            Case "WAR3"
                PacketBuff.addDWORD(&H11)
            Case "W3XP"
                PacketBuff.addDWORD(&H11)
        End Select
        PacketBuff.addDWORD(0)
        PacketBuff.addDWORD(0)
        PacketBuff.addDWORD(480)
        PacketBuff.addDWORD(1033)
        PacketBuff.addDWORD(1033)
        PacketBuff.addNTSTRING("USA")
        PacketBuff.addNTSTRING("United States")
        PacketBuff.send(1, &H50)


the problem is in:

Code Select Expand


                    alBuffer.CopyTo(0, outArray, 4, alBuffer.Count)



I get an exception saying:

"An unhandled exception of type 'System.InvalidCastException' occurred in mscorlib.dll

Additional information: At least one element in the source array could not be cast down to the destination array type."

[mentalCo.]

I fixed it.  it was a problem in the addNTSTRING.

[Grok]

I fixed it.  it was a problem in the addNTSTRING.

Should post the corrected addNTSTRING for anyone who didn't see the problem.

[mentalCo.]

There was quite a few things wrong with it but i managed to fix a lot.

Code Select Expand


Imports System
Imports System.Net.Sockets
Imports System.Text

Namespace UGPB
    Friend Class PacketBuffer
        Protected intPSize As Integer
        Public alBuffer As New ArrayList
        Public bnetstream As NetworkStream
        Public bnlsstream As NetworkStream
        Public tcpBNET As New System.Net.Sockets.TcpClient
        Public tcpBNLS As New System.Net.Sockets.TcpClient

        Public Function connect(ByVal strServ As String, ByVal port As Integer)
            Try
                tcpBNET.Connect(strServ, port)
                tcpBNLS.Connect("bnls.valhallalegends.com", 9367)
            Catch
                Return -1
            End Try
            bnetstream = tcpBNET.GetStream
            bnlsstream = tcpBNLS.GetStream
            Return 1
        End Function

        Public Sub addBYTE(ByVal byt As Byte)
            Me.alBuffer.Add(byt)
        End Sub

        Protected Sub clear()
            Me.alBuffer.Clear()
        End Sub

        Public Sub addBYTES(ByVal byts() As Byte)
            Dim byt As Byte = &H1
            For Each byt In byts
                alBuffer.Add(byt)
            Next
        End Sub

        Public Sub addSTRING(ByVal str As String)
            Me.addBYTES(Encoding.UTF8.GetBytes(str))
        End Sub

        Public Sub addNTSTRING(ByVal str As String)
            Me.addBYTES(Encoding.UTF8.GetBytes(str))
            Me.addBYTE(&H0)
        End Sub

        Public Sub addDWORD(ByVal dword As Integer)
            addBYTES(BitConverter.GetBytes(dword))
        End Sub

        Public Sub addWORD(ByVal word As Short)
            addBYTES(BitConverter.GetBytes(word))
        End Sub

        Public Sub send(ByVal intServer As Integer, ByVal bytPacketID As Byte)
            Dim bytPacket(1024) As Byte
            Select Case intServer
                Case 1 ' BNET
                    Dim outArray(alBuffer.Count + 4) As Byte
                    outArray(0) = &HFF
                    outArray(1) = bytPacketID
                    Array.Copy(BitConverter.GetBytes(CType(alBuffer.Count + 4, Short)), 0, outArray, 2, 2)
                    alBuffer.CopyTo(0, outArray, 4, alBuffer.Count)
                    bnetstream.Write(outArray, 0, UBound(outArray))
                    Me.clear()
                Case 2 ' BNLS
                    Dim outArray(alBuffer.Count + 3) As Byte
                    outArray(2) = bytPacketID
                    Array.Copy(BitConverter.GetBytes(CType(alBuffer.Count + 3, Short)), 0, outArray, 0, 2)
                    alBuffer.CopyTo(outArray, 3)
                    bnlsstream.Write(outArray, 0, UBound(outArray))
                    Me.clear()
            End Select
            Me.clear()
        End Sub

    End Class
End Namespace


heres an example of sending the 0x50 packet

Code Select Expand


Public Sub send0x50()
        PacketBuff.addDWORD(&H0)
        PacketBuff.addSTRING("68XI")
        PacketBuff.addSTRING(strProduct)
        Select Case strProduct
            Case "RATS"
                PacketBuff.addDWORD(&HC9)
            Case "PXES"
                PacketBuff.addDWORD(&HC7)
            Case "D2DV"
                PacketBuff.addDWORD(&HA)
            Case "D2XP"
                PacketBuff.addDWORD(&HA)
            Case "W2BN"
                PacketBuff.addDWORD(&H4F)
            Case "WAR3"
                PacketBuff.addDWORD(&H11)
            Case "W3XP"
                PacketBuff.addDWORD(&H11)
            Case Else
                'Product not supported
        End Select
        PacketBuff.addDWORD(&H0)
        PacketBuff.addDWORD(&H0)
        PacketBuff.addDWORD(480)
        PacketBuff.addDWORD(1033)
        PacketBuff.addDWORD(1033)
        PacketBuff.addNTSTRING("USA")
        PacketBuff.addNTSTRING("United States")
        PacketBuff.send(1, &H50) '  1 being the BNET stream, 2 being BNLS
    End Sub


edit:
removed my debugging crap

[Minux]

Aren't you that guy who was making the C++ bot called "The Slammer" ?
What ever happened to that?

[mentalCo.]

I don't know i got distracted from it.  It works tho but very buggy.  I was up to adding proxy support.  Also the script language I wrote for it was sort of slow I guess so I'm making a vb.net bot that supports vb script.  It will have local hashing of all the games or bnls.  and uhhh I duno should be done in like a week or two.

[MyndFyre]

I don't know i got distracted from it.  It works tho but very buggy.  I was up to adding proxy support.  Also the script language I wrote for it was sort of slow I guess so I'm making a vb.net bot that supports vb script.  It will have local hashing of all the games or bnls.  and uhhh I duno should be done in like a week or two.

You know, VB .NET doesn't inherently support VBScript, and the "script engine" for .NET (VSA) never happened.

[mentalCo.]

You know, VB .NET doesn't inherently support VBScript, and the "script engine" for .NET (VSA) never happened.

I'm using vb script just fine:

this is an example program

Code Select Expand


    Dim scriptobject As New MSScriptControl.ScriptControlClass

    Public Sub AddTextToATextBox(ByVal text As String)
        TextBox1.Text = text
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim filereader As New StreamReader("script.txt")
        Dim buffer As String
        buffer = filereader.ReadToEnd()
        scriptobject.Language = "VBScript"
        scriptobject.AddObject("Form1", Me)
        scriptobject.AddCode(buffer)
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        scriptobject.Run("Test", "some text")
    End Sub
End Class


and this is an example script file ("Script.txt"):

Code Select Expand


Sub Test(crap)
Form1.AddTextToATextBox(crap)
End Sub