Attribute VB_Name = "modStatstring"
Option Explicit

Public Type UserInfo
    Username As String
    Icon As Integer
    IconSt As Integer
    IconEx As Integer
    PingColor As Long
    Color As Long
    Clan As String
    Index As Integer
    Ping As Long
    Flags As Long
    Statstring As String
    Account As String
End Type

Public Function DecodeMapData(ByVal Encoded As String, ByRef Decoded As String) As Long
' Ported to VB by l2k-Shadow
    Dim enc() As Byte, Dec() As Byte
    Dim I As Long, J As Long, D As Byte, lngLen As Long
    enc = StrConv(Encoded, vbFromUnicode)
    For I = 0 To UBound(enc)
        If (I Mod 8) Then
            ReDim Preserve Dec(lngLen)
            Dec(lngLen) = (enc(I) And ((RShift(D, 1 + J) Or Not 1)))
            J = J + 1
            lngLen = lngLen + 1
        Else
            J = 0
            D = enc(I)
        End If
    Next I
    Decoded = StrConv(Dec, vbUnicode)
    DecodeMapData = lngLen
End Function

Public Function RShift(ByVal pnValue As Long, ByVal pnShift As Long) As Long
    RShift = CLng(pnValue \ (2 ^ pnShift))
End Function

Public Function GetUserInfo(Index As Integer, ByVal Username As String, ByVal Statstring As String, ByVal Flags As Long, ByVal Ping As Long) As UserInfo
On Error Resume Next
    Dim U As UserInfo, r As Integer, M As objMember
    Set M = frmBot.Bot(Index).Clan.GetByName(Username)
    If M Is Nothing Then
        r = -1
    Else
        r = M.Rank
    End If
    U.Account = Suffix(Username)
    U.Flags = Flags
    U.Ping = Ping
    If Len(Statstring) Then
        U.Statstring = Statstring
        U.Clan = ExtractClanName(Statstring)
    End If
    U.Username = Abbr(U.Account)
    U.Index = frmBot.Bot(Index).Users.Find(U.Account)
    U.Color = GetUserColor(Index, U.Account, Flags, False)
    U.PingColor = GetPingColor(Ping)
    U.Icon = GetClientIcon(Index, Statstring, Flags, r, True, frmBot.Bot(Index).Config.ProductID)
    If LenB(U.Clan) = 0 Then U.Clan = " "
    If U.Color = -1 Then U.Color = vbWhite
    GetUserInfo = U
End Function

Public Function ProductToStr(ByRef ProductID$) As String
On Error GoTo hErr
    Select Case UCase$(ProductID)
        Case "CHAT", "TAHC": ProductToStr = "Telnet Client"
        Case "STAR", "RATS": ProductToStr = "StarCraft"
        Case "JSTR", "RTSJ": ProductToStr = "StarCraft Japanese"
        Case "SSHR", "RHSS": ProductToStr = "StarCraft Shareware"
        Case "SEXP", "PXES": ProductToStr = "StarCraft BroodWar"
        Case "W2BN", "NB2W": ProductToStr = "WarCraft II"
        Case "WAR3", "3RAW": ProductToStr = "WarCraft III Reign of Chaos"
        Case "W3XP", "PX3W": ProductToStr = "WarCraft III Frozen Throne"
        Case "D2DV", "VD2D": ProductToStr = "Diablo II"
        Case "D2XP", "PX2D": ProductToStr = "Diablo II Lord of Destruction"
        Case "DRTL", "LTRD": ProductToStr = "Diablo"
        Case "DSHR", "RHSD": ProductToStr = "Diablo Shareware"
        Case Else:           ProductToStr = "Unknown (" & ProductID & ")"
    End Select
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "ProductToStr"
End Function

Public Function ExtractClanName(ByVal Statstring$) As String
On Error GoTo hErr
1   If LenB(Statstring) = 0 Then Exit Function
2   If Left$(Statstring, 4) = "3RAW" Or Left$(Statstring, 4) = "PX3W" Then
3       If InStrB(Statstring, " ") <> 0 Then
4           Dim Splt() As String
5           Splt() = Split(Statstring, Space$(1))
6           If UBound(Splt) >= 3 Then ExtractClanName = Replace$(StrReverse$(Splt(3)), vbNullChar, vbNS)
7       End If
8   End If
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "ExtractClanName"
End Function

Private Function StrToNumeric(ByVal S As String, Optional ByVal Min As Long = -1, Optional ByVal Max As Long = -1) As Long
    S = Trim$(S)
    If (Len(S) > 9) Then S = Left$(S, 9)
    If IsNumeric(S) = False Then Exit Function
    StrToNumeric = CLng(S)
    If (Min > -1) And (Max > -1) And (Max >= Min) Then
        If (StrToNumeric < Min) Then StrToNumeric = Min
        If (StrToNumeric > Max) Then StrToNumeric = Max
    End If
End Function

Public Function DisplayStatInfo(ByVal S As String) As String
    Dim U As New objUser
    U.Statstring = S
    DisplayStatInfo = DisplayStatInfoByUser(U)
End Function

Public Function DisplayStatInfoByUser(ByVal U As objUser) As String
On Error GoTo hErr:
1   Dim Out As String, Buf As String
2   If Not U.StatInfo Is Nothing Then
        Select Case U.Client
        Case "STAR", "RATS", "JSTR", "RTSJ", "SEXP", "PXES", "SSHR", "RHSS", "W2BN", "NB2W"
5           Dim objSC As objStats_SC
6           Set objSC = U.StatInfo
7           If objSC.StatWins > 0 Then Buf = Buf & objSC.StatWins & " wins, "
8           If objSC.StatRank > 0 Then Buf = Buf & "#" & objSC.StatRank & ", "
9           If objSC.StatRating > 0 Then Buf = Buf & objSC.StatRating & " rating, "
10          If objSC.StatIronRank > 0 Then Buf = Buf & "#" & objSC.StatIronRank & ", "
11          If objSC.StatIronRating > 0 Then Buf = Buf & objSC.StatIronRating & " rating, "
12          If objSC.StatWCGBool <> 0 Then Buf = Buf & objSC.StatWCGIcon & " icon, "
13          Set objSC = Nothing
14          If Len(Buf) Then Buf = Left$(Buf, Len(Buf) - 2): Out = Buf
        Case "DRTL", "LTRD", "DSHR", "RHSD"
16          Dim objD1 As objStats_D1
17          Set objD1 = U.StatInfo
18          If Len(objD1.CharClassName) And objD1.CharLevel > 0 Then Out = "a level " & objD1.CharLevel & " " & objD1.CharClassName
19          Set objD1 = Nothing
        Case "D2DV", "VD2D", "D2XP", "PX2D"
21          Dim objD2 As objStats_D2
22          Set objD2 = U.StatInfo
23          Out = IIf(Len(objD2.CharTitle), objD2.CharTitle & " ", vbNS) & objD2.CharName & ", a level " & objD2.CharLevel & " " & objD2.CharClassName
24          Set objD2 = Nothing
        Case "WAR3", "3RAW", "W3XP", "PX3W"
26          Dim objW3 As objStats_W3
27          Set objW3 = U.StatInfo
28          If (objW3.StatIconTier > 1) Then Out = objW3.StatIconRace & " " & objW3.StatIconName
29          Set objW3 = Nothing
        End Select
31  End If
32  DisplayStatInfoByUser = Out
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "DisplayStatInfoByUser"
End Function

Public Function DecodeStatstring(ByVal Statstring As String) As Object
On Error GoTo hErr:
    Select Case UCase$(Left(Statstring, 4))
    Case "STAR", "RATS", "JSTR", "RTSJ", "SEXP", "PXES", "SSHR", "RHSS", "W2BN", "NB2W"
3       Set DecodeStatstring = DecodeSC(Statstring)
    Case "DRTL", "LTRD", "DSHR", "RHSD"
5       Set DecodeStatstring = DecodeD1(Statstring)
    Case "D2DV", "VD2D", "D2XP", "PX2D"
7       Set DecodeStatstring = DecodeD2(Statstring)
    Case "WAR3", "3RAW", "W3XP", "PX3W"
9       Set DecodeStatstring = DecodeW3(Statstring)
    End Select
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "DecodeStatstring"
End Function

Private Function DecodeSC(ByVal Statstring As String) As Object
On Error GoTo hErr:
1   Dim strSP() As String, intCount As Long, objStats As New objStats_SC
2   strSP = Split(Statstring, " ", -1, vbBinaryCompare)
3   intCount = UBound(strSP)
4   With objStats
5       If intCount > 0 Then .StatRating = StrToNumeric(strSP(1), 0, 999999)
6       If intCount > 1 Then .StatRank = StrToNumeric(strSP(2), 0, 999999)
7       If intCount > 2 Then .StatWins = StrToNumeric(strSP(3))
8       If intCount > 3 Then .StatSpawn = StrToNumeric(strSP(4), 0, 1)
9       If intCount > 4 Then .StatWCGBool = StrToNumeric(strSP(5), 0, 1)
10      If intCount > 5 Then .StatHighRating = StrToNumeric(strSP(6), 0, 999999)
11      If intCount > 6 Then .StatIronRating = StrToNumeric(strSP(7), 0, 999999)
12      If intCount > 7 Then .StatIronRank = StrToNumeric(strSP(8), 0, 999999)
13      If intCount > 8 Then
14          If (Len(strSP(9)) > 3) Then
15              .StatWCGIcon = Replace$(StrReverse$(strSP(9)), vbNullChar, vbNS)
16          End If
17      Else
18          If (Len(strSP(0)) > 3) Then
19              .StatWCGIcon = Replace$(StrReverse$(strSP(0)), vbNullChar, vbNS)
20          End If
21      End If
22  End With
23  Erase strSP()
24  Set DecodeSC = objStats
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "DecodeSC"
End Function

Private Function DecodeD1(ByVal Statstring As String) As Object
On Error GoTo hErr:
1   Dim strSP() As String, intCount As Long, objStats As New objStats_D1
2   strSP = Split(Statstring, " ", -1, vbBinaryCompare)
3   intCount = UBound(strSP)
4   With objStats
5       If intCount > 0 Then .CharLevel = StrToNumeric(strSP(1), 0, 999999)
6       If intCount > 1 Then .CharClass = StrToNumeric(strSP(2), 0, 2)
7       If intCount > 2 Then .CharDots = StrToNumeric(strSP(3), 0, 3)
8       If intCount > 3 Then .CharStrength = StrToNumeric(strSP(4))
9       If intCount > 4 Then .CharMagic = StrToNumeric(strSP(5))
10      If intCount > 5 Then .CharDexterity = StrToNumeric(strSP(6))
11      If intCount > 6 Then .CharVitality = StrToNumeric(strSP(7))
12      If intCount > 7 Then .CharGold = StrToNumeric(strSP(8))
13      If intCount > 8 Then .CharSpawn = StrToNumeric(strSP(9), 0, 1)
        Select Case .CharClass
        Case 0: .CharClassName = "Warrior"
        Case 1: .CharClassName = "Rogue"
        Case 2: .CharClassName = "Sorceror"
        End Select
19  End With
20  Erase strSP()
21  Set DecodeD1 = objStats
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "DecodeD1"
End Function

Private Function DecodeD2(ByVal Statstring As String) As Object
On Error GoTo hErr:
1   If (Len(Statstring) < 6) Or (InStr(1, Statstring, ",", vbBinaryCompare) < 1) Then Exit Function 'Open Character
2   Dim objStats As New objStats_D2, objRead As New clsPDebuffer
4   Dim strRealmName As String, strCharName As String, intType As Integer, intAct As Integer, arrClasses(), p() As Byte
10  objRead.SetDebuffer Mid(Statstring, 5)
11  'Get Realm Name
12  strRealmName = objRead.ReadTSTRING(",")
13  If Len(strRealmName) = 0 Then Exit Function 'Open Character
14  If Len(strRealmName) > 16 Then strRealmName = Left$(strRealmName, 16)
15  'Get Character
16  strCharName = objRead.ReadTSTRING(",")
17  If Len(strCharName) = 0 Then Exit Function 'Open Character
18  If Len(strCharName) > 16 Then strCharName = Left$(strCharName, 16)
19  'Move to Stats
20  objRead.Skip 2
21  objRead.SetDebuffer objRead.ReadAll
22  p = objRead.ReadBytes()
23  If UBound(p) < 30 Then Exit Function 'Not Enough Bytes
24  'Character Type
25  intType = p(11)
26  If intType > 7 Or intType < 1 Then intType = 0
27  arrClasses = Array("Unknown", "Amazon", "Sorceress", "Necromancer", "Paladin", "Barbarian", "Druid", "Assassin")
29  With objStats
30      .CharName = strCharName
31      .RealmName = strRealmName
32      .LadderSeason = CLng(IIf(p(28) = &HFF, 0, p(28)))
        .CharClass = CLng(intType)
33      .CharClassName = CStr(arrClasses(intType)): Erase arrClasses
34      .CharIsFemale = intType = 1 Or intType = 2 Or intType = 7
35      .CharIsLadder = Not p(28) = &HFF
36      .CharIsHardcore = (p(24) And &H4)
37      .CharIsExpansion = (p(24) And &H20)
38      If .CharIsHardcore Then .CharIsDead = (p(24) And &H8)
39      .CharLevel = StrToNumeric(p(23), 0, 9999)
40      .CharArmor = DecodeD2Armor(p(1) & " " & p(2) & " " & p(3) & " " & p(4) & " " & p(8) & " " & p(9))
41      .CharHelmet = DecodeD2Helmet(p(0))
42      .CharLeftWeapon = DecodeD2Weapon(p(6))
43      .CharRightWeapon = DecodeD2Weapon(p(5))
44      .CharShield = DecodeD2Weapon(p(7))
45      .CharItem = DecodeD2Weapon(p(10))
46      .Color_CharArmor = DecodeD2ItemColor(p(13))
47      .Color_CharHelmet = DecodeD2ItemColor(p(12))
48      .Color_CharLeftWeapon = DecodeD2ItemColor(p(18))
49      .Color_CharRightWeapon = DecodeD2ItemColor(p(17))
50      .Color_CharShield = DecodeD2ItemColor(p(19))
51      If .CharIsExpansion Then
            Select Case p(25)
                Case &H80: .CharAct = "Normal Act I": intAct = 0
                Case &H82: .CharAct = "Normal Act II": intAct = 0
                Case &H84: .CharAct = "Normal Act III": intAct = 0
                Case &H86: .CharAct = "Normal Act IV/V": intAct = 0
                Case &H8A: .CharAct = "Nightmare Act I": intAct = 1
                Case &H8C: .CharAct = "Nightmare Act II": intAct = 1
                Case &H8E: .CharAct = "Nightmare Act III": intAct = 1
                Case &H90: .CharAct = "Nightmare Act IV/V": intAct = 1
                Case &H94: .CharAct = "Hell Act I": intAct = 2
                Case &H96: .CharAct = "Hell Act II": intAct = 2
                Case &H98: .CharAct = "Hell Act III": intAct = 2
                Case &H9A: .CharAct = "Hell Act IV/V": intAct = 2
                Case &H9E: .CharAct = "All Acts Complete": intAct = 3
                Case Else: .CharAct = "No Acts Complete": intAct = 0
            End Select
            Select Case intAct
                Case 1: .CharTitle = IIf(.CharIsHardcore, "Destroyer", "Slayer ")
                Case 2: .CharTitle = IIf(.CharIsHardcore, "Conqueror", "Champion ")
                Case 3: .CharTitle = IIf(.CharIsHardcore, "Guardian ", IIf(.CharIsFemale, "M", "P") & "atriarch ")
            End Select
            .CharActInt = intAct
73      Else
            Select Case p(25)
                Case &H80: .CharAct = "Normal Act I": intAct = 0
                Case &H82: .CharAct = "Normal Act II": intAct = 0
                Case &H84: .CharAct = "Normal Act III": intAct = 0
                Case &H86: .CharAct = "Normal Act IV/V": intAct = 0
                Case &H88: .CharAct = "Nightmare Act I": intAct = 1
                Case &H8A: .CharAct = "Nightmare Act II": intAct = 1
                Case &H8C: .CharAct = "Nightmare Act III": intAct = 1
                Case &H8E: .CharAct = "Nightmare Act IV/V": intAct = 1
                Case &H90: .CharAct = "Hell Act I": intAct = 2
                Case &H92: .CharAct = "Hell Act II": intAct = 2
                Case &H94: .CharAct = "Hell Act III": intAct = 2
                Case &H96: .CharAct = "Hell Act IV/V": intAct = 2
                Case &H98: .CharAct = "All Acts Complete": intAct = 3
                Case Else: .CharAct = "No Acts Complete": intAct = 0
            End Select
            Select Case intAct
                Case 1: .CharTitle = IIf(.CharIsHardcore, IIf(.CharIsFemale, "Dame ", "Sir "), IIf(.CharIsFemale, "Countess ", "Count "))
                Case 2: .CharTitle = IIf(.CharIsHardcore, IIf(.CharIsFemale, "Lady ", "Lord "), IIf(.CharIsFemale, "Duchess ", "Duke "))
                Case 3: .CharTitle = IIf(.CharIsHardcore, IIf(.CharIsFemale, "Baroness ", "Baron "), IIf(.CharIsFemale, "Queen ", "King "))
            End Select
            .CharActInt = intAct
95      End If
96  End With
97  Set DecodeD2 = objStats
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "DecodeD2"
End Function

Private Function DecodeD2Helmet(ByVal Helmet As Byte) As String
    Select Case Helmet
    Case &H0, 255: DecodeD2Helmet = "None"
    Case &H1: DecodeD2Helmet = "Leather"
    Case &H2: DecodeD2Helmet = "Chain"
    Case &H3: DecodeD2Helmet = "Plate"
    Case &H4, &H39: DecodeD2Helmet = "Cap"
    Case &H5, &H3A: DecodeD2Helmet = "Skullcap"
    Case &H6, &H3B: DecodeD2Helmet = "Helmet"
    Case &H7, &H3C: DecodeD2Helmet = "Full Helmet"
    Case &H8, &H3D: DecodeD2Helmet = "Great Helmet"
    Case &H9, &H3E: DecodeD2Helmet = "Crown"
    Case &HA, &H3F: DecodeD2Helmet = "Mask"
    Case &H40, &H53: DecodeD2Helmet = "Bone Helmet"
    Case &H56: DecodeD2Helmet = "Wolf Head"
    Case &H57: DecodeD2Helmet = "Hawk Helmet"
    Case &H58: DecodeD2Helmet = "Antlers"
    Case &H59: DecodeD2Helmet = "Fanged Helmet"
    Case &H5A: DecodeD2Helmet = "Horned Helmet"
    Case &H5B: DecodeD2Helmet = "Avenger Guard"
    Case Else: DecodeD2Helmet = "Unknown"
    End Select
End Function

Private Function DecodeD2Armor(ByVal Armor As String) As String
    Select Case Armor 'Torso, Legs, Right Arm, Left Arm, Right Shoulder, Left Shoulder
    Case "1 1 1 1 1 1": DecodeD2Armor = "None"
    Case "1 1 1 1 2 2": DecodeD2Armor = "Quilted"
    Case "2 1 1 1 2 2": DecodeD2Armor = "Leather"
    Case "2 1 2 2 2 2": DecodeD2Armor = "Hard Leather"
    Case "1 2 2 1 2 2": DecodeD2Armor = "Studded Leather"
    Case "2 2 1 1 2 2": DecodeD2Armor = "Ring Mail"
    Case "2 2 2 2 2 2": DecodeD2Armor = "Scale Mail"
    Case "3 1 1 1 3 3": DecodeD2Armor = "Breast Plate"
    Case "2 2 2 2 3 3": DecodeD2Armor = "Chain Mail"
    Case "3 2 2 2 2 2": DecodeD2Armor = "Splint Mail"
    Case "2 2 3 1 3 3": DecodeD2Armor = "Light Plate"
    Case "3 3 2 2 3 3": DecodeD2Armor = "Field Plate"
    Case "3 3 3 3 2 2": DecodeD2Armor = "Plate Mail"
    Case "2 3 3 3 3 3": DecodeD2Armor = "Gothic Plate"
    Case "3 3 3 3 3 3": DecodeD2Armor = "Full Plate Mail"
    Case "3 3 2 3 3 1": DecodeD2Armor = "Ancient Armor"
    Case "255 255 255 255 255 255": DecodeD2Armor = "None"
    Case Else: DecodeD2Armor = "Unknown"
    End Select
End Function

Private Function DecodeD2ItemColor(ByVal Color As Byte) As Long
    Dim Tint As Integer
    Tint = 0
    If Color > &H40 Then Color = Color - &H40: Tint = 2
    If Color > &H20 Then Color = Color - &H20: Tint = 1
    Select Case Color
    Case &H1: DecodeD2ItemColor = &HC0C0C0        ' Gray
    Case &H2: DecodeD2ItemColor = &H505050          ' Light Black
    Case &H3: DecodeD2ItemColor = &H404040          ' Dark Black
    Case &H4: DecodeD2ItemColor = &H303030       ' Black
    Case &H5, &H6, &H7: DecodeD2ItemColor = D2Blue    ' Blue
    Case &H8, &H9, &HA: DecodeD2ItemColor = D2Red    ' Red
    Case &HB, &HC, &HD: DecodeD2ItemColor = D2Green    ' Green
    Case &HE, &HF, &H10, &H11: DecodeD2ItemColor = D2Beige    ' Yellow
    Case &H12, &H13: DecodeD2ItemColor = D2Purple    ' Purple
    Case &H14: DecodeD2ItemColor = D2Orange    ' Gold
    Case &H15: DecodeD2ItemColor = D2White    ' White
    End Select
End Function

Private Function DecodeD2Weapon(ByVal Weapon As Byte) As String
    Select Case Weapon
    Case &H4: DecodeD2Weapon = "Hand Axe"
    Case &H5: DecodeD2Weapon = "Axe"
    Case &H6: DecodeD2Weapon = "Double Axe"
    Case &H7: DecodeD2Weapon = "War Axe"
    Case &H8: DecodeD2Weapon = "Giant Axe"
    Case &H9: DecodeD2Weapon = "Wand"
    Case &HA: DecodeD2Weapon = "Yew Wand"
    Case &HB: DecodeD2Weapon = "Grim Wand"
    Case &HC: DecodeD2Weapon = "Club"
    Case &HD: DecodeD2Weapon = "Mace"
    Case &HE: DecodeD2Weapon = "Warhammer"
    Case &HF: DecodeD2Weapon = "Flail"
    Case &H10: DecodeD2Weapon = "Maul"
    Case &H11: DecodeD2Weapon = "Short Sword"
    Case &H12: DecodeD2Weapon = "Scimitar"
    Case &H13: DecodeD2Weapon = "Falchion"
    Case &H14: DecodeD2Weapon = "Crystal Sword"
    Case &H15: DecodeD2Weapon = "Broadsword"
    Case &H16: DecodeD2Weapon = "Longsword"
    Case &H17: DecodeD2Weapon = "Claymore"
    Case &H18: DecodeD2Weapon = "Bastard Sword"
    Case &H19: DecodeD2Weapon = "Dagger"
    Case &H1A: DecodeD2Weapon = "Blade"
    Case &H1B: DecodeD2Weapon = "Short Spear"
    Case &H1C: DecodeD2Weapon = "Glaive"
    Case &H1D: DecodeD2Weapon = "Pilum"
    Case &H1E: DecodeD2Weapon = "Spear"
    Case &H1F: DecodeD2Weapon = "Trident"
    Case &H20: DecodeD2Weapon = "Spetum"
    Case &H21: DecodeD2Weapon = "Pike"
    Case &H22: DecodeD2Weapon = "Bardiche"
    Case &H23: DecodeD2Weapon = "Scythe"
    Case &H24: DecodeD2Weapon = "Halberd"
    Case &H25: DecodeD2Weapon = "Short Staff"
    Case &H26: DecodeD2Weapon = "Long Staff"
    Case &H27: DecodeD2Weapon = "Battle Staff"
    Case &H28: DecodeD2Weapon = "War Staff"
    Case &H29: DecodeD2Weapon = "Short Bow"
    Case &H2A: DecodeD2Weapon = "Long Bow"
    Case &H2B, &HF3, &HF4, &HFB: DecodeD2Weapon = "Claws"
    Case &H2C, &HF5, &HF6, &HFC: DecodeD2Weapon = "Scissorskatar"
    Case &H2D, &HF7, &HF8, &HFD: DecodeD2Weapon = "Katar"
    Case &H2E, &HF9, &HFA, &HFE: DecodeD2Weapon = "Hatchet Hands"
    Case &H2F: DecodeD2Weapon = "Hunter's Bow"
    Case &H30: DecodeD2Weapon = "Composite Bow"
    Case &H31, &H7A, &HF0: DecodeD2Weapon = "Crossbow"
    Case &H32, &H7C, &HF2: DecodeD2Weapon = "Heavy Crossbow"
    Case &H33: DecodeD2Weapon = "Eagleorb"
    Case &H34: DecodeD2Weapon = "Sacredglobe"
    Case &H35: DecodeD2Weapon = "Claspedorb"
    Case &H36: DecodeD2Weapon = "Stag Bow"
    Case &H37: DecodeD2Weapon = "Reflex Bow"
    Case &H4F: DecodeD2Weapon = "Small Shield"
    Case &H50: DecodeD2Weapon = "Large Shield"
    Case &H51: DecodeD2Weapon = "Kite Shield"
    Case &H52: DecodeD2Weapon = "Tower Shield"
    Case &H54: DecodeD2Weapon = "Bone Shield"
    Case &H55: DecodeD2Weapon = "Spiked Shield"
    Case &H5C: DecodeD2Weapon = "Targe"
    Case &H5D: DecodeD2Weapon = "Heraldic Shield"
    Case &H5E: DecodeD2Weapon = "Crown Shield"
    Case &H5F: DecodeD2Weapon = "Demon Head"
    Case &H60: DecodeD2Weapon = "Gargoyle Head"
    Case &H61: DecodeD2Weapon = "Zombie Head"
    Case &H75, &HEB: DecodeD2Weapon = "Short Battle Bow"
    Case &H76, &HEC: DecodeD2Weapon = "Long Battle Bow"
    Case &H77, &HED: DecodeD2Weapon = "Short War Bow"
    Case &H78, &HEE: DecodeD2Weapon = "Long War Bow"
    Case &H79, &HEF: DecodeD2Weapon = "Light Crossbow"
    Case &H7B, &HF1: DecodeD2Weapon = "Heavy Crossbow"
    Case &H7D, &H7F, &H81: DecodeD2Weapon = "Green Potion"
    Case &H7E, &H80: DecodeD2Weapon = "Red Potion"
    Case &H86: DecodeD2Weapon = "Unknown"
    Case &HEF: DecodeD2Weapon = "Light Crossbow"
    Case &HF1: DecodeD2Weapon = "Repeating Crossbow"
    Case 255: DecodeD2Weapon = "None"
    Case Else: DecodeD2Weapon = "Unknown"
        Output frmBot.rtbChat(SelBot), &HB3, , "Diablo II Statstring Parsing - Unknown Weapon: " & Weapon
    End Select
End Function

Private Function DecodeW3(ByVal Statstring As String) As Object
On Error GoTo hErr:
1   Dim strSP() As String, intCount As Long, objStats As New objStats_W3
2   strSP = Split(Statstring, " ", -1, vbBinaryCompare)
3   intCount = UBound(strSP)
4   With objStats
5       If Len(strSP(0)) Then
6           Dim bExp As Boolean
7           bExp = (strSP(0)) = "PX3W"
8           If intCount > 0 Then
9               If Len(strSP(1)) > 3 Then
10                  .StatIcon = Replace$(StrReverse$(strSP(1)), vbNullChar, vbNS)
11                  .StatIconTier = StrToNumeric(Right$(.StatIcon, 1), 1, CLng(IIf(bExp, 6, 5)))
12                  If .StatIconTier = 1 Then
13                      .StatIconRace = "Orc"
14                      .StatIconName = "Peon"
15                      .StatIconWinsReq = "0"
16                  Else
17                      Dim H(), N(), O(), U(), r(), t(), W()
18                      If Not bExp Then
                            W() = Array("25", "250", "500", "1500")
19                          H() = Array("Footman", "Knight", "Archmage", "Medivh")
20                          N() = Array("Archer", "Druid of the Claw", "Priestess of the Moon", "Furion Stormrage")
21                          O() = Array("Grunt", "Tauren", "Far Seer", "Thrall")
22                          U() = Array("Ghoul", "Abomination", "Lich", "Tichondrius")
23                          r() = Array("Green Dragon Whelp", "Blue Dragon", "Red Dragon", "Deathwing")
24                      Else
                            W() = Array("25", "150", "350", "750", "1500")
25                          H() = Array("Rifleman", "Sorceress", "Spellbreaker", "Blood Mage", "Jaina")
26                          O() = Array("Troll Headhunter", "Shaman", "Spirit Walker", "Shadow Hunter", "Rexxar")
27                          N() = Array("Huntress", "Druid of the Talon", "Dryad", "Keeper of the Grove", "Maiev")
28                          U() = Array("Crypt Fiend", "Banshee", "Destroyer", "Crypt Lord", "Sylvanas")
29                          r() = Array("Myrmidon", "Siren", "Dragon Turtle", "Sea Witch", "Illidan")
30                          t() = Array("Felguard", "Infernal", "Doomguard", "Pit Lord", "Archimonde")
31                      End If
34                      If (.StatIconTier - 2) > -1 And (.StatIconTier - 2 < 5) Then
                            Select Case Mid$(.StatIcon, 3, 1)
                            Case "H": .StatIconRace = "Human": .StatIconName = CStr(H(.StatIconTier - 2))
                            Case "N": .StatIconRace = "Night Elf": .StatIconName = CStr(N(.StatIconTier - 2))
                            Case "O": .StatIconRace = "Orc": .StatIconName = CStr(O(.StatIconTier - 2))
                            Case "U": .StatIconRace = "Undead": .StatIconName = CStr(U(.StatIconTier - 2))
                            Case "R": .StatIconRace = "Random": .StatIconName = CStr(r(.StatIconTier - 2))
                            Case "T": .StatIconRace = "Tournament": .StatIconName = CStr(t(.StatIconTier - 2))
                            End Select
42                          .StatIconWinsReq = CStr(W(.StatIconTier - 2))
43                      End If
44                      Erase H, O, N, U, r, t, W
45                  End If
46              End If
47          End If
48          If intCount > 1 Then .StatLevel = StrToNumeric(strSP(2), 1, 9999)
49          If intCount > 2 Then
50              .StatClanTag = Replace$(StrReverse$(strSP(3)), vbNullChar, vbNS)
51          End If
52      End If
53  End With
54  Erase strSP
55  Set DecodeW3 = objStats
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Statstring", "DecodeW3"
End Function

Public Function GetClientIcon(Index As Integer, ByVal Statstring As String, ByVal Flags As Long, Optional ByVal Rank As Integer = -1, Optional UserList As Boolean = True, Optional MyProductID As String) As Integer
    On Error GoTo hErr
1   Dim dIcon As Integer
2   If Not UserList Then dIcon = 0 Else dIcon = options.Icons
    Select Case dIcon
    Case 0, 1, 4, 5, 6
5       If Len(Statstring) > 0 Then
6           If Len(Statstring) < 4 Then GetClientIcon = 17: Exit Function
7           Dim IconIndex As Integer
            Select Case StrReverse$(Left$(Statstring, 4))
                Case "WAR3": IconIndex = 6
                Case "W3XP": IconIndex = 7
                Case "DSHR": IconIndex = 8
                Case "DRTL": IconIndex = 9
                Case "D2DV": IconIndex = 10
                Case "D2XP": IconIndex = 11
                Case "SSHR": IconIndex = 12
                Case "JSTR": IconIndex = 13
                Case "STAR": IconIndex = 14
                Case "SEXP": IconIndex = 15
                Case "W2BN": IconIndex = 16
                Case "CHAT": IconIndex = 18
                Case Else:   IconIndex = 17
            End Select
23      End If
24      If (Flags And &H2) Then IconIndex = 5
25      If options.DisableClanIcons = False Then
            Select Case Rank
                Case 0, 1: IconIndex = 19
                Case 2: IconIndex = 20
                Case 3: IconIndex = 21
                Case 4: IconIndex = 22
            End Select
32      End If
33      If (Flags And &H1) Then IconIndex = 1
34      If (Flags And &H8) Then IconIndex = 2
35      If (Flags And &H4) Then IconIndex = 3
36      If (Flags And &H20) Then IconIndex = 4
        If IconIndex = 0 Then IconIndex = 17
    Case 2, 3
38      If Len(Statstring) > 0 Then
            Dim FullParse As Boolean
            If dIcon = 2 Then
                If MyProductID = StrReverse$(Left$(Statstring, 4)) Then
                    FullParse = True
                Else
                    FullParse = False
                End If
            Else
                FullParse = True
            End If
            If Len(Statstring) = 4 Then FullParse = False
39          Dim U As New objUser, objW3 As objStats_W3, objSC As objStats_SC, objD1 As objStats_D1, objD2 As objStats_D2
40          U.Statstring = Statstring
            Select Case StrReverse$(Left$(Statstring, 4))
                Case "CHAT"
43                  IconIndex = 6
                Case "WAR3"
                    If FullParse Then
45                      Set objW3 = U.StatInfo
                        Select Case Left$(objW3.StatIconRace, 1)
                            Case "H": IconIndex = 70 + objW3.StatIconTier
                            Case "N": IconIndex = 75 + objW3.StatIconTier
                            Case "O": IconIndex = 80 + objW3.StatIconTier
                            Case "R": IconIndex = 85 + objW3.StatIconTier
                            Case "U": IconIndex = 90 + objW3.StatIconTier
                        End Select
                    Else
                        IconIndex = 16
                    End If
53
                Case "W3XP"
                    If FullParse Then
55                      Set objW3 = U.StatInfo
                        Select Case Left$(objW3.StatIconRace, 1)
                            Case "T": IconIndex = 95 + objW3.StatIconTier
                            Case "H": IconIndex = 101 + objW3.StatIconTier
                            Case "N": IconIndex = 107 + objW3.StatIconTier
                            Case "O": IconIndex = 113 + objW3.StatIconTier
                            Case "R": IconIndex = 119 + objW3.StatIconTier
                            Case "U": IconIndex = 125 + objW3.StatIconTier
                        End Select
                    Else
                        IconIndex = 17
                    End If
                Case "SSHR"
65                  IconIndex = 12
                Case "JSTR"
                    Set objSC = U.StatInfo
                    If objSC.StatSpawn And FullParse Then
                        IconIndex = 53
                    Else
                        IconIndex = 14
                    End If
                Case "DRTL"
69                  'IconIndex = 7
                    If FullParse Then
70                      Set objD1 = U.StatInfo
71                      Dim Base As Integer
72                      IconIndex = objD1.CharClass + 18
73                      If objD1.CharDots > 0 Then IconIndex = IconIndex + (objD1.CharDots * 4)
                    Else
                        IconIndex = 7
                    End If
                Case "DSHR"
75                  IconIndex = 8
                Case "D2DV"
                    If U.StatInfo Is Nothing Or Not FullParse Then
                        IconIndex = 9
                    Else
78                      Set objD2 = U.StatInfo
                        Select Case objD2.CharClass
                            Case 1, 2, 3, 4, 5, 6, 7
82                              IconIndex = 30 + objD2.CharClass
                            Case Else
84                              IconIndex = 9
                        End Select
                    End If
                Case "D2XP"
95                  'IconIndex = 10
                    If U.StatInfo Is Nothing Or Not FullParse Then
                        IconIndex = 10
                    Else
96                      Set objD2 = U.StatInfo
                        Select Case objD2.CharClass
                            Case 1, 2, 3, 4, 5, 6, 7
                                IconIndex = 30 + objD2.CharClass
                            Case Else
                                IconIndex = 10
                        End Select
                    End If
                Case "W2BN"
                    If FullParse Then
113                 Set objSC = U.StatInfo
114                 If objSC.StatRank = 1 Then
115                     IconIndex = 68
116                 ElseIf objSC.StatIronRank = 1 Then
117                     IconIndex = 69
118                 ElseIf objSC.StatIronRating > 0 Then
119                     IconIndex = 67
120                 ElseIf objSC.StatRating > 0 Then
121                     If objSC.StatRating < 1000 Then
122                         IconIndex = 65  'Low
123                     Else
124                         IconIndex = 66  'High
125                     End If
126                 ElseIf objSC.StatSpawn = 1 Then
127                     IconIndex = 70  'Spawn
128                 Else
129                     If objSC.StatWins > 9 Then
130                         IconIndex = 64
131                     Else
132                         IconIndex = 54 + objSC.StatWins
133                     End If
134                 End If
                    Else
                        IconIndex = 15
                    End If
                Case "STAR", "SEXP"
                    If FullParse Then
136                 Set objSC = U.StatInfo
137                 If objSC.StatRank = 1 Then
138                     IconIndex = 51
139                 ElseIf objSC.StatRating > 0 Then
140                     If objSC.StatRating < 1000 Then
141                         IconIndex = 49
142                     Else
143                         IconIndex = 50
144                     End If
145                 ElseIf objSC.StatSpawn = 1 Then
146                     IconIndex = 52
147                 Else
148                     If objSC.StatWins > 9 Then
149                         IconIndex = 48
150                     Else
151                         IconIndex = 38 + objSC.StatWins
152                     End If
153                 End If
                    Else
                        If StrReverse$(Left$(Statstring, 4)) = "STAR" Then
                            IconIndex = 11
                        Else
                            IconIndex = 13
                        End If
                    End If
                Case Else
155                 IconIndex = 132
            End Select
157     End If
158     If (Flags And &H2) Then IconIndex = 3
159     If options.DisableClanIcons = False Then
            Select Case Rank
                Case 0, 1: IconIndex = 133
                Case 2: IconIndex = 134
                Case 3: IconIndex = 135
                Case 4: IconIndex = 136
            End Select
166     End If
167     If (Flags And &H1) Then IconIndex = 1
168     If (Flags And &H8) Then IconIndex = 2
169     If (Flags And &H4) Then IconIndex = 4
170     If (Flags And &H20) Then IconIndex = 5
        If IconIndex = 0 Then IconIndex = 132
    End Select
172
173 GetClientIcon = IconIndex

    Exit Function
hErr:
    Select Case dIcon
    Case 0, 1, 4
        GetClientIcon = 17
    Case Else
        GetClientIcon = 132
    End Select
    ErrorHandler Err.Number, Err.Description, Erl, "IconParse", "GetClientIcon"
End Function

