[VB]STAR ~ Recieving Unrecognized Game Ver (101)

[John420]

PBuffer Class:

[Hdx]

Code Select Expand

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Enum DataTypes
    DWORD
    WORD
    void
    NTString
    NBYTE
    NLONG
End Enum
Public Enum PacketTypes
    BNCS
    BNLS
    RAW
End Enum
Private buffer As String
Private position As Integer


Private Function CreateWORD(ByVal Value As Integer) As String
    Dim Result As String * 2
    CopyMemory ByVal Result, Value, 2
    CreateWORD = Result
End Function
Private Function CreateDWORD(ByVal Value As Long) As String
    Dim Result As String * 4
    CopyMemory ByVal Result, Value, 4
    CreateDWORD = Result
End Function
Private Function CreateLONG(ByVal Value As Double) As String
    Dim Result As String * 8
    CopyMemory ByVal Result, Value, 8
    CreateLONG = Result
End Function
Private Function GetWORD(ByVal Value As String) As Integer
    Dim Result As Integer
    CopyMemory Result, ByVal Value, 2
    GetWORD = Result
End Function
Private Function GetDWORD(ByVal Value As String) As Long
    Dim Result As Long
    CopyMemory Result, ByVal Value, 4
    GetDWORD = Result
End Function
Private Function GetLONG(ByVal Value As String) As Double
    Dim Result As Double
    CopyMemory Result, ByVal Value, 8
    GetLONG = Result
End Function
Private Function HasData(ByVal length As Long) As Boolean
    HasData = True
    If (Len(buffer) < position + length - 1) Then HasData = False
End Function

Public Function Push(ByVal DataType As DataTypes, ByVal Data As Variant, Optional Increment As Boolean = True)
    Dim Append As String
    Select Case DataType
        Case DWORD:    Append = CreateDWORD(Data)
        Case WORD:     Append = CreateWORD(Data)
        Case void:     Append = Data
        Case NBYTE:    Append = Chr(Data)
        Case NLONG:    Append = CreateLONG(Data)
        Case NTString: Append = Data & Chr$(0)
    End Select
    If (Increment) Then position = position + Len(Append)
    buffer = buffer & Append
End Function

Public Function Pop(ByVal DataType As DataTypes, Optional length As Long = 0, Optional Peek As Boolean = False) As Variant
    Dim Result As Variant
    Select Case DataType
        Case DWORD:
            If (HasData(4)) Then
                Result = GetDWORD(Mid(buffer, position, 4))
                If (!Peek) Then position = position + 4
            End If
        Case WORD:
            If (HasData(2)) Then
                Result = GetDWORD(Mid(buffer, position, 2))
                If (!Peek) Then position = position + 2
            End If
        Case void:
            If (HasData(length)) Then
                Result = Mid(buffer, position, length)
                If (!Peek) Then position = position + length
            End If
        Case NBYTE:
            If (HasData(1)) Then
                Result = Asc(Mid(buffer, position, 1))
                If (!Peek) Then position = position + 1
            End If
        Case NLONG:
            If (HasData(8)) Then
                Result = GetLONG(Mid(buffer, position, 8))
                If (!Peek) Then position = position + 8
            End If
        Case NTString:
            Dim ntpos As Integer
            ntpos = InStr(position, buffer, Chr$(0))
            If (ntpos > 0) Then
                Result = Mid(buffer, position, ntpos - position)
                If (!Peek) Then position = ntpos + 1
            End If
    End Select
    Pop = Result
End Function

Public Function Peek(ByVal DataType As DataTypes, Optional length As Long = 0) As Variant
    Peek = Pop(DataType, length, True)
End Function

Public Function Clear()
    buffer = vbNullString
    position = 1
End Function

Public Function GetPacket(ByVal PacketType As PacketTypes, Optional ID As Byte = 0) As String
    Dim Header As String
    Select Case PacketType
        Case BNCS: Header = Chr$(&HFF) & Chr$(ID) & CreateWORD(Len(buffer) + 4)
        Case BNLS: Header = CreateWORD(Len(buffer) + 3) & Chr$(ID)
    End Select
    GetPacket = Header & buffer
    Clear
End Function

Private Sub Class_Initialize()
    buffer = vbNullString
    position = 1
End Sub
Heres something I wipped up special for you.
Pretty self exploratory how to use.

Code Select Expand

Public Sub Main()
  Dim test As New clsBuffer
  With test
    .Push DWORD, 1, False
    .Push WORD, 2, False
    .Push NBYTE, 3, False
    .Push NLONG, 4, False
    .Push NTString, "5", False
    .Push void, "6", False
    Debug.Print .Pop(DWORD)
    Debug.Print .Pop(WORD)
    Debug.Print .Pop(NBYTE)
    Debug.Print .Pop(NLONG)
    Debug.Print .Pop(NTString)
    Debug.Print .Pop(void, 1)
  End With
End Sub
Note the 'False' on the .Push's
This will make it not increment its position. Which is good for the whole 'debuffer' aspect
exa for SID_PING:

Code Select Expand

Dim inBuf as new clsBuffer
With inBuf
  .Push void, PacketData, False
  Debug.print "Header Byte: " & .Pop(NBYTE)
  Debug.print "Packet ID: 0x" & Right("00" & Hex(.Pop(NBYTE)), 2)
  Debug.print "Length: " & .Pop(WORD)
  Debug.print "Ping Value: 0x" & Right("00000000" & Hex(.Pop(DWORD)), 8)
End With

[Spht]

We have such a community...  there's not many programming forums where you can paste a bunch of code and say "fix"

[MyndFyre]

We have such a community...  there's not many programming forums where you can paste a bunch of code and say "fix"

Nope.  Good thing, too....  People might get critical if you refused to just "fix."

[Hdx]

He was bitching about me.
I don't consider giving him a buffer class is 'fixing' 'his' code, for 1) He didn't make the code hes using now 2) hes a dumb fuck who prolly doesn't even understand what a buffer is 3) Its vb 4) For the love of god I am so bored i'd do anything.

[John420]

5) You're assumptions are wrong. 6) You're nothing but a stupid egomaniac who thinks he's better than everyone else and spends hours upon hours on these forums. 7) You're not as cool as you think you are, nor as smart.

[MysT_DooM]

hey private, lock it up...get in the front leaning rest...hdx assumptions are based upon the aura of the questions you have asked the replies you have given....