Valhalla Legends Archive


0000:  FF 0F 3A 00 02 00 00 00 00 00 00 00 10 00 00 00   ÿ:...........
0010:  00 00 00 00 0D F0 AD BA 0D F0 AD BA 49 2E 72 75   .....ð­º.ð­ºI.ru
0020:  6E 2E 6E 61 6B 65 64 5F 00 50 58 33 57 20 47 50   n.naked_.PX3W GP
0030:  43 57 20 30 20 47 4E 69 4B 00                     CW 0 GNiK.......


i haven't seen the GPCW, and it isnt the clan as someone told me before... does anyone know which icon this represents?

okay here's something i just noticed...


0000:  FF 0F 2C 00 01 00 00 00 00 00 00 00 4E 00 00 00   ÿ,.
.......N...
0010:  00 00 00 00 0D F0 AD BA 0D F0 AD BA 47 65 4B 00   .....ð­º.ð­ºGeK.
0020:  50 58 33 57 20 47 50 43 57 20 30 00               PX3W GPCW 0.....

0000:  FF 0F 2F 00 01 00 00 00 00 00 00 00 0F 00 00 00   ÿ/.
..........
0010:  00 00 00 00 0D F0 AD BA 0D F0 AD BA 62 4C 69 6E   .....ð­º.ð­ºbLin
0020:  6B 7A 00 50 58 33 57 20 47 50 43 57 20 30 00      kz.PX3W GPCW 0..


These people both had an amlost completely different statstring. Is this more of the tournament stuff? I didn't see anything like this in your w3 parsing

My Statstring was..

0000:  FF 0F 31 00 01 00 00 00 00 00 00 00 00 00 00 00   ÿ1.
...........
0010:  00 00 00 00 0D F0 AD BA 0D F0 AD BA 4F 78 69 4B   .....ð­º.ð­ºOxiK
0020:  6C 65 61 6E 00 33 52 41 57 20 31 4F 33 57 20 32   lean.3RAW 1O3W 2
0030:  00                                                ................


That's exactly what i wanted; W3XP and WAR3 do differ, noticed it in your code. I guess i didn't check the difference between xp and non-xp on the website, just found all of it.
Thanks Ripple

Look i really don't care to argue over this kinda of crap. I wrote the code from line 1, no copy, no pasting. Only reference i could find was this post http://forum.valhallalegends.com/index.php?topic=2984.0 and this on battle.net for the icons of each tier http://www.battle.net/war3/ladder/war3-ladder-info-laddericons.aspx?Gateway=Azeroth My Biggest question was i couldnt find anything saying there was a difference in W3XP.

If i post code that is not mine, i will say so; I don't have any issues with that.

Okay just wrote this up with some help from some other post's. If noone has it, feel free. My intention is to see if anyone sees any problem with the code. Please let me know. As for some of the values; I have the game, but i don't know each detail so im going off of what i have read.



..The parsing sub

Public Sub ParseStatString(ByVal Statstring As String, ByRef outBuf As String)
Dim Values() As String
Dim cType As String
    Select Case Left$(Statstring, 4)
   
        Case "PX3W"
            If Len(Statstring) = 4 Then
                Call strcpy(outBuf, "Warcraft III Expansion: Frozen Throne.")
                Exit Sub
            Else
                Call strcpy(outBuf, "Warcraft III Expansion: Frozen Throne, ")
                Call strcpy(outBuf, ParseW3String(Statstring, outBuf))
            End If
        Case "3RAW"
            If Len(Statstring) = 4 Then
                Call strcpy(outBuf, "Warcraft III: Reign of Chaos.")
                Exit Sub
            Else
                Call strcpy(outBuf, "Warcraft III: Reign of Chaos, ")
                Call strcpy(outBuf, ParseW3String(Statstring, outBuf))
            End If


And the Function...

Public Function ParseW3String(ByVal Stats As String, ByRef outBuf As String)
Dim BestRace As String, Tier As String, Level As String
Dim Icon As String, Values() As String, Clan As String

    Values() = Split(Mid$(Stats, 6), " ")
   
    Tier = Mid(Values(0), 1, 1)
   
    Select Case UCase(Mid$(Values(0), 2, 1))
        Case "R"
            BestRace = "Random"
           
            Select Case Tier
                Case 1: Icon = "Peon"
                Case 2: Icon = "Green Dragon Whelp"
                Case 3: Icon = "Blue Drake"
                Case 4: Icon = "Red Dragon"
                Case 5: Icon = "Deathwing"
            End Select
        Case "N"
            BestRace = "Night Elf"
           
            Select Case Tier
                Case 1: Icon = "Peon"
                Case 2: Icon = "Archer"
                Case 3: Icon = "Druid of the Claw"
                Case 4: Icon = "Priestess of the Moon"
                Case 5: Icon = "Furion Stormrage"
            End Select
        Case "O"
            BestRace = "Orc"
           
            Select Case Tier
                Case 1: Icon = "Peon"
                Case 2: Icon = "Grunt"
                Case 3: Icon = "Tauren"
                Case 4: Icon = "Farseer"
                Case 5: Icon = "Thrall"
            End Select
        Case "U"
            BestRace = "Undead"
           
            Select Case Tier
                Case 1: Icon = "Peon"
                Case 2: Icon = "Ghoul"
                Case 3: Icon = "Abomination"
                Case 4: Icon = "Lich"
                Case 5: Icon = "Tichondrius"
            End Select
        Case "H"
            BestRace = "Human"
           
            Select Case Tier
                Case 1: Icon = "Peon"
                Case 2: Icon = "Footmen"
                Case 3: Icon = "Knight"
                Case 4: Icon = "Archmage"
                Case 5: Icon = "Medivh"
            End Select
    End Select
   
    Level = Values(1)
   
    If UBound(Values) = 2 Then
        Clan = StrReverse(Values(2))
        Call sprintf(outBuf, "Tier-%s(%s), %s Icon, is level %s and with Clan %s", Tier, Icon, BestRace, Level, Clan)
    Else
        Call sprintf(outBuf, "Tier-%s(%s), %s Icon, and is level %s", Tier, Icon, BestRace, Level)
    End If
   
End Function


Thanks..

-Edit, made code perdier

Okay, at first i didn't really care to do it that way. When i was redoing my 0x3E (SID_LOGONREALMEX) I decided that it was less of a headache if i did use a position instead of just removing the bytes as needed.

Thanks Shadow, heres the new Class, any other suggestions?


***ClsPktDebuf

Private Buffer As String
Private Position As Integer

Public Sub InitPacket(Data As String)
    Position = 1
    Buffer = Data
End Sub

Public Sub SetPosition(NewPos As Integer)
    Position = NewPos
End Sub

Public Sub SkipBytes(lSkip As Integer)
    Position = Position + lSkip
End Sub

Public Sub ClearBuf()
    Buffer = ""
    Position = 1
End Sub

Public Function GetData(DType As DataType, Optional DataLen As Integer) As Variant
Dim NTPos As Long
On Error Resume Next

    Select Case DType
        Case xDword
            GetData = CVL(Mid$(Buffer, Position, 4))
            Position = Position + 4
        Case xWord
            GetData = CVI(Mid$(Buffer, Position, 2))
            Position = Position + 2
        Case xByte
            GetData = Chr(CVB(Mid$(Buffer, Position, 1)))
            Position = Position + 1
        Case xNonNTString
            GetData = Mid$(Buffer, Position, DataLen)
            Position = Position + Len(GetData)
        Case xNTString
            NTPos = InStr(Position, Buffer, Chr(0))
            GetData = Mid$(Buffer, Position, NTPos - Position)
            Position = NTPos + 1
    End Select
End Function



heres my attempt at a packet debuffer class. my only question is this the most efficient usage?

any suggestions or criticism are graciously accepted.


From clsPktDebuf
Private Buffer As String

Public Sub InitPacket(Data As String)
    Buffer = Data
End Sub

Public Function GetData(DType As DataType, Optional DataEnd As Integer) As Variant
    Select Case DType
        Case xDword
            GetData = CVL(Mid$(Buffer, 1, 4))
            Call RemBytes(4)
        Case xWord
            GetData = CVI(Mid$(Buffer, 1, 2))
            Call RemBytes(2)
        Case xbyte
            GetData = Chr(CVB(Mid$(Buffer, 1, 1)))
            Call RemBytes(1)
        Case xNonNtstring
            GetData = Mid$(Buffer, 1, DataEnd)
            Call RemBytes(Len(GetData))
        Case xNTString
            GetData = Mid$(Buffer, 1, InStr(1, Buffer, Chr(0)) - 1)
            Call RemBytes(Len(GetData) + 1)
    End Select
End Function

Public Sub RemBytes(remLength As Integer)
    Buffer = Mid(Buffer, remLength + 1)
End Sub

Public Sub ClearBuf()
    Buffer = ""
End Sub


the CVI(), CVB(), and CVL() are just RtlMoveMemory functions

ask for help and ya get critics? america...

actually most of the code is my own, like i said i wanted to throw it together quickly so learning how it works was from a little reading and a little copy and pasting. as for the other code, Botmains() etc... Botmains() is actually a class that i used a few years ago so i could do muliple logons with only one bot screen but use multiple chat buffers. i actually made this thing back when spawns could actually load in channels. i wanted it to be much like s0ul's Damnbot but i never have the time to tinker. so for the critics, thanks

here we go...

http://www.battle.net/forums/thread.aspx?fn=opensupport&t=431351&p=1&#post431351

like i said, i verified that the proxy and packets being sent looked correct, but here you go.


1  Hide  Hide  18  Send 
0000  04 01 17 E0 D3 E9 00 31 61 6E 6F 6E 79 6D 6F 75    .......1anonymou
0010  73 00                                              s.

2  Hide  Hide  8  Recv 
0000  00 5A 17 E0 D3 E9 00 31                            .Z.....1

3  Hide  Hide  67  Send 
0000  01 FF 50 3A 00 00 00 00 00 36 38 58 49 56 44 32    ..P:.....68XIVD2
0010  44 0B 00 00 00 00 00 00 00 00 00 00 00 80 04 00    D...............
0020  00 33 10 00 00 33 10 00 00 55 53 41 00 55 6E 69    .3...3...USA.Uni
0030  74 65 64 20 53 74 61 74 65 73 00 FF 25 08 00 69    ted States..%..i
0040  1D 18 34                                           ..4



alright, like i said in my previous post. i threw together proxy support pretty quickly after reading up on it. This is so far what i have. also like i said before, this will work with pvpgn servers but not bnet, after sending 0x50 i get disc'd. as of right now i am stumped. i've packetlogged and everything looks perfectly fine, but obviously isnt. any help with this would be greatly appreciated.



Private Sub bnSockets_Connect(Index As Integer)



    If BotMains(Index).IsProxy = 1 Then
        BotMains(Index).InProxy = True
        Dim Splt() As String, str As String, i As Integer
        BotMains(Index).ServerVar = LCase$(BotMains(Index).ServerVar)
        Splt = Split(BotMains(Index).ServerVar, ".")
        If IsNumeric(Splt(0)) = False Then
            ' If server is not an ip.
            Dim a
            a = GetIPFromHostName(BotMains(Index).ServerVar)
            Splt = Split(a, ".")
        End If
        For i = 0 To UBound(Splt)
            str = str & Chr(CStr(Splt(i)))
        Next i
        rtbAdd "Connected to ", vbGreen, BotMains(Index).Proxy & vbNewLine, vbWhite
        Socks.SendSocks Chr(&H4) & Chr(&H1) & Chr(&H17) & Chr(&HE0) & str & "anonymous" & Chr(&H0), bnsockets(Index)
        rtbAdd "Sending Socks Header packet." & vbNewLine, vbGreen
    Else
        rtbAdd "Connected to ", vbGreen, bnsockets(Index).RemoteHost & vbNewLine, vbWhite
        bnsockets(Index).SendData Chr(1)
        Call BotMains(Index).SendProductPacket(BotMains(Index).ProductVar)
        BotMains(Index).ConnUptime = GetTickCount()
    End If




   ' If BotMains(Index).SelectedVar = True Then
        'rtbAdd "Connected!" & vbNewLine, RGB(25, 87, 5)
    'End If

End Sub

Private Sub bnSockets_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strBuffer As String, strTemp As String, lngLen As Long
Dim Data As String

If BotMains(Index).InProxy = True Then
    bnsockets(Index).GetData Data, vbString
    Call consAdd(DebugOutput(Data) & vbNewLine & vbNewLine, vbYellow)
End If

    If BotMains(Index).InProxy = True Then
       
        Select Case Mid(Data, 2, 1)
            Case Chr(&H5A)
                rtbAdd "SOCKS -> ", vbWhite, "Request granted." & vbNewLine, vbGreen
                rtbAdd "Connecting to Battle.net" & vbNewLine, vbGreen
                bnsockets(Index).SendData Chr(1)
                Call BotMains(Index).SendProductPacket(BotMains(Index).ProductVar)
                BotMains(Index).ConnUptime = GetTickCount()
                BotMains(Index).InProxy = False
                Exit Sub
            Case Chr(&H5B)
                rtbAdd "SOCKS -> ", vbWhite, "Request Rejected or Failed." & vbNewLine, vbRed
                bnsockets(Index).Close
                Exit Sub
            Case Chr(&H5C)
                rtbAdd "SOCKS -> ", vbWhite, "Request Rejected because SOCKS server cannot IDENT on the client." & vbNewLine, vbRed
                bnsockets(Index).Close
                Exit Sub
            Case Chr(&H5D)
                rtbAdd "SOCKS -> ", vbWhite, "Request Rejected because the Client Program and the ID Report Different User-IDs." & vbNewLine, vbRed
                bnsockets(Index).Close
                Exit Sub
        End Select
    Else
        Call BotMains(Index).PrepareParse(strTemp, Index)
    End If
   
   
   
End Sub


i guess i'll wait out the ban then.

everything checks out, to what i can see. i know that pvpgn arent credible sources to test on but lik i said everything gets sent correctly to those servers through a proxy. was just curious if bnet blocks ip's with open 1080 ports..

Haven't done bnet for a long while so i'm not sure if things have changed. The other day i was messing around with 0x51 and kept getting an invalid cdkey. after a few trys i was ip banned and figured it would lift after a short period of time. well that short period of time is 2 days and counting. has bnet changed its ipbanning? if so does anyone know the lengths?
also... after not being able to logon, i decided to throw together socks4 real quick into the bot and proxy my way to bnet. but no such luck... all of the pvpgn servers worked fine with proxies but not bnet, aftering sending the initial packets, nothing is returned. I even tried using sockscap but produced the same result.

any info would be great.

thanks..