Attribute VB_Name = "modDataFormatting"
Option Explicit 'Binary

Const MOD1 As String = "%n is now: %s"
Const MOD2 As String = "%n is currently: %s"
Const MOD3 As String = "Unknown %n setting, try on/off/?"
Public Function ModString(i As Integer, N As String, Optional O As Boolean) As String
    Select Case i
    Case 1: ModString = Replace$(Replace$(MOD1, "%n", N), "%s", OnOff(O))
    Case 2: ModString = Replace$(Replace$(MOD2, "%n", N), "%s", OnOff(O))
    Case Else: ModString = Replace$(MOD3, "%n", N)
    End Select
End Function

Public Function StrToByteArray(S As String) As Byte()
    Dim B() As Byte, i As Integer
    ReDim B(Len(S) - 1)
    For i = 1 To Len(S)
        B(i - 1) = Asc(Mid$(S, i, 1))
    Next i
    StrToByteArray = B
End Function

Public Function Suffix(str As String, Optional Char As String = "*")
    If InStrB(str, Char) <> 0 Then Suffix = Mid$(str, InStrRev(str, Char) + 1) Else Suffix = str
End Function
Public Function Prefix(str As String, Optional Char As String = "*")
    If InStrB(str, Char) <> 0 Then Prefix = Left$(str, InStr(str, Char) - 1) Else Prefix = str
End Function

Public Function RestrictCharacters(S As String, Optional Alpha As Boolean = True, Optional Number As Boolean = True, _
    Optional Symbol As Boolean = False, Optional Spaces As Boolean = False, Optional NewLine As Boolean = False) As String
    Dim i As Integer, Out As String
    For i = 1 To Len(S)
        Dim A As Integer
        A = Asc(Mid$(S, i, 1))
        If A > 96 And A < 123 Then
            If Alpha Then Out = Out & Chr$(A) 'Lowercase
        ElseIf A > 64 And A < 91 Then
            If Alpha Then Out = Out & Chr$(A) 'Uppercase
        ElseIf A > 47 And A < 58 Then
            If Number Then Out = Out & Chr$(A) 'Number
        ElseIf A = 32 Then
            If Spaces Then Out = Out & Chr$(A) 'Spaces
        ElseIf A = 10 Or A = 13 Then
            If NewLine Then Out = Out & Chr$(A) 'New Line
        Else
            If Symbol Then  'Symbols
                Select Case Mid$(S, i, 1)
                Case "!", "@", "$", "#", "^", "&", "(", ")", "_", "-", ".", ":", ";", "[", "]", "{", "}", "+", "=", "|", "~", "`"
                    Out = Out & Mid$(S, i, 1)
                End Select
            End If
        End If
    Next i
    RestrictCharacters = Out
End Function

Public Function TruncNumber(sUsertrunc As String) As String
    Dim sRealm As String
    If InStrB(sUsertrunc, "#") Then
        sRealm = Mid$(sUsertrunc, InStr(sUsertrunc, "#") + 1)
        Do Until Not IsNumeric(Left$(sRealm, 1))
            sRealm = Mid$(sRealm, 2)
        Loop
        sUsertrunc = Left$(sUsertrunc, InStr(sUsertrunc, "#") - 1) & sRealm
    End If
    TruncNumber = sUsertrunc
End Function

Public Function FixFilename(ByVal str As String) As String
    str = Replace$(str, ":", vbNS)
    str = Replace$(str, "<", vbNS)
    str = Replace$(str, ">", vbNS)
    str = Replace$(str, "?", vbNS)
    str = Replace$(str, "/", vbNS)
    str = Replace$(str, "\", vbNS)
    str = Replace$(str, "*", vbNS)
    str = Replace$(str, ChrW$(34), vbNS)
    str = Replace$(str, "|", vbNS)
    FixFilename = Trim$(str)
End Function






'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' CHANNEL RELATED
'///////////////////////////////////////////////////////////////////////////////
Public Function FlagsToStr(Flags As Long) As String
    Dim Buf As String
    If (Flags And &H1) Then Buf = Buf & "Representative, "
    If (Flags And &H2) Then Buf = Buf & "Operator, "
    If (Flags And &H4) Then Buf = Buf & "Speaker, "
    If (Flags And &H8) Then Buf = Buf & "Administrator, "
    If (Flags And &H10) Then Buf = Buf & "Plugged, "
    If (Flags And &H20) Then Buf = Buf & "Squelched, "
    If (Flags And &H40) Then Buf = Buf & "Guest, "
    If (Flags And &H100) Then Buf = Buf & "Beep, "
    If (Flags And &H100000) Then Buf = Buf & "Jailed, "
    If Len(Buf) = 0 Then Buf = "Normal"
    If Right$(Buf, 2) = ", " Then Buf = Left$(Buf, Len(Buf) - 2)
    FlagsToStr = Buf
End Function
Public Function ChanFlagsToStr(ChannelFlags As Long) As String
    Dim Buf As String
    If (ChannelFlags And CHANNEL_PUBLIC) Then Buf = Buf & "Public, "
    If (ChannelFlags And CHANNEL_MODERATED) Then Buf = Buf & "Moderated, "
    If (ChannelFlags And CHANNEL_RESTRICTED) Then Buf = Buf & "Restricted, "
    If (ChannelFlags And CHANNEL_SILENT) Then Buf = Buf & "Silent, "
    If (ChannelFlags And CHANNEL_SYSTEM) Then Buf = Buf & "System, "
    If (ChannelFlags And CHANNEL_PRODUCTSPECIFIC) Then Buf = Buf & "Product Specific, "
    If (ChannelFlags And CHANNEL_GLOBAL) Then Buf = Buf & "Global, "
    If Len(Buf) = 0 Then Buf = "Private"
    If Right$(Buf, 2) = ", " Then Buf = Left$(Buf, Len(Buf) - 2)
    ChanFlagsToStr = Buf
End Function
Public Function PingBars(ByVal Ping As Long) As String
    If Ping = -1 Then PingBars = "6 red": Exit Function
    If Ping > 600 Then PingBars = "6 red": Exit Function
    If Ping > 500 Then PingBars = "5 red": Exit Function
    If Ping > 400 Then PingBars = "4 yellow": Exit Function
    If Ping > 300 Then PingBars = "3 yellow": Exit Function
    If Ping > 200 Then PingBars = "2 green": Exit Function
    If Ping > 9 Then PingBars = "1 green": Exit Function
    PingBars = "No bars"
End Function





'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' FRIEND RELATED
'///////////////////////////////////////////////////////////////////////////////
Public Function FriendStatus(Status As Byte, Optional Online As Boolean = True) As String
    Dim Buf As String
    If (Status And &H1) Then Buf = "Mutual Friend, "
    If (Status And &H2) Then Buf = Buf & "DND, "
    If (Status And &H4) Then Buf = Buf & "Away"
    If Right$(Buf, 2) = ", " Then Buf = Left$(Buf, Len(Buf) - 2)
    If LenB(Buf) = 0 Then If Online Then Buf = "Online" Else Buf = "Offline"
    FriendStatus = Buf
End Function
Public Function FriendStatus2(Status As Byte) As String
    Dim Buf As String
    If (Status And &H1) Then Buf = "mutual, "
    If (Status And &H2) Then Buf = Buf & "dnd, "
    If (Status And &H4) Then Buf = Buf & "away"
    If Right$(Buf, 2) = ", " Then Buf = Left$(Buf, Len(Buf) - 2)
    FriendStatus2 = Buf
End Function
Public Function FriendLocation(Location As Byte) As String
    Select Case Location
    Case &H0: FriendLocation = "Offline"
    Case &H1: FriendLocation = "Not in chat"
    Case &H2: FriendLocation = "In chat"
    Case &H3: FriendLocation = "In a public game"
    Case &H4: FriendLocation = "In a private game"
    Case &H5: FriendLocation = "In a password protected game"
    Case Else: FriendLocation = "Unknown"
    End Select
End Function






'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' CLAN RELATED
'///////////////////////////////////////////////////////////////////////////////
Public Function ClanRankEnumToString(Rank As CLANRANKENUM) As String
    Select Case Rank
        Case crInitiate: ClanRankEnumToString = "Initiate"
        Case crPeon: ClanRankEnumToString = "Peon"
        Case crGrunt: ClanRankEnumToString = "Grunt"
        Case crShaman: ClanRankEnumToString = "Shaman"
        Case crChieftain: ClanRankEnumToString = "Chieftain"
    End Select
End Function
Public Function ClanRankToString(Rank As Byte) As String
    Select Case Rank
        Case &H0: ClanRankToString = "Initiate"
        Case &H1: ClanRankToString = "Peon"
        Case &H2: ClanRankToString = "Grunt"
        Case &H3: ClanRankToString = "Shaman"
        Case &H4: ClanRankToString = "Chieftain"
    End Select
End Function
Public Function ClanStatusToString(Status As Byte) As String
    Select Case Status
    Case &H0: ClanStatusToString = "Offline"
    Case &H1: ClanStatusToString = "Online"
    Case &H2: ClanStatusToString = "In a channel"
    Case &H3: ClanStatusToString = "In a public game"
    Case &H5: ClanStatusToString = "In a private game"
    Case Else: ClanStatusToString = "Unknown"
    End Select
End Function






'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' SERVER RELATED
'///////////////////////////////////////////////////////////////////////////////
Public Function GetServerName(Server As String, Optional IsWarCraft As Boolean = False) As String
    If InStrB(Server, ".") <> 0 Then
        Dim range As String
        range = Left$(Server, InStrRev(Server, ".") - 1)
        If range = "63.241.83" Then
            GetServerName = "USWest"
        ElseIf range = "63.240.202" Then
            GetServerName = "USEast"
        ElseIf range = "211.233.0" Then
            GetServerName = "Asia"
        ElseIf range = "213.248.106" Then
            GetServerName = "Europe"
        Else
            Select Case LCase$(Server)
            Case "uswest.battle.net"
                GetServerName = "USWest"
            Case "useast.battle.net"
                GetServerName = "USEast"
            Case "asia.battle.net"
                GetServerName = "Asia"
            Case "europe.battle.net"
                GetServerName = "Europe"
            Case Else
                GetServerName = "PvPGN (" & Server & ")"
            End Select
        End If
        
        If IsWarCraft Then
            If GetServerName = "USWest" Then GetServerName = "Lordaeron"
            If GetServerName = "USEast" Then GetServerName = "Azeroth"
            If GetServerName = "Europe" Then GetServerName = "Northrend"
            If GetServerName = "Asia" Then GetServerName = "Kalimdor"
        End If
    Else
        GetServerName = "PvPGN (" & Server & ")"
    End If
End Function
Public Function ServerMatch(server1 As String, server2 As String) As Boolean
    ServerMatch = GetServerName(server1) = GetServerName(server2)
End Function
Public Function GatewayExists(Gate As String) As Boolean
    Dim U As String
    U = LCase$(Gate)
    If (U = "uswest") Or (U = "useast") Or (U = "asia") Or (U = "europe") Or (U = "lordaeron") Or (U = "azeroth") Or (U = "kalimdor") Or (U = "northrend") Then
        GatewayExists = True
    Else
        GatewayExists = False
    End If
End Function







'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' USER RELATED
'///////////////////////////////////////////////////////////////////////////////
Public Function Abbr(ByVal S As String) As String
    If Not options.DisableRealmName Then Abbr = S: Exit Function
    Abbr = StripGateway(S)
End Function
Public Function FixUserExploits(ByVal Username As String) As String
    Username = Replace$(Username, ChrW$(32), vbNS)
    Username = Replace$(Username, ChrW$(34), vbNS)
    Username = Replace$(Username, ",", vbNS)
    FixUserExploits = Username
End Function
Public Function IsRandomNum(ByVal S As String) As Boolean
    If Len(S) < 7 Then Exit Function
    Dim Count As Integer, i As Integer
    S = Prefix(S, "#")
    For i = 1 To Len(S)
        If IsNumeric(Mid$(S, i, 1)) Then Count = Count + 1
    Next i
    IsRandomNum = (Count >= CInt(Len(S) / 3))
End Function
Public Function IsRandom(Text As String) As Boolean
    On Error GoTo Err
    If Len(Text) < 1 Then Exit Function
    Dim Pattern() As String
    Dim vPattern As String
    ReDim Preserve Pattern(0 To 0)
    'Add space between each character
    Dim i As Integer
    For i = 1 To Len(Text)
        ReDim Preserve Pattern(UBound(Pattern) + 1)
        If IsSymbol(Mid(Text, i, 1)) = True Then
            Pattern(UBound(Pattern)) = "S"
            IsRandom = False
            Exit Function
        End If
        If IsNumeric(Mid(Text, i, 1)) = True Then
            Pattern(UBound(Pattern)) = "N"
        End If
        If IsAlphaLower(Mid(Text, i, 1)) = True Then
            Pattern(UBound(Pattern)) = "L"
        End If
        If IsAlphaUpper(Mid(Text, i, 1)) = True Then
            Pattern(UBound(Pattern)) = "U"
        End If
        If Mid(Text, i, 1) = "@" Then
            Pattern(UBound(Pattern)) = "S"
        End If
    Next
    vPattern = Join(Pattern, vbNS)
    
    'Need to find how many groups numbers and alpha characters are in
    Dim vNumberGroups As Integer, vLastNumber As Integer
    Dim vAlphaLowerGroups As Integer, vLastAlphaLower As Integer
    Dim vAlphaUpperGroups As Integer, vLastAlphaUpper As Integer
    For i = 1 To Len(vPattern)
        If Mid(vPattern, i, 1) = "N" Then
            If vLastNumber = 0 Then
                'Set the position to i
                vLastNumber = i
                vNumberGroups = vNumberGroups + 1
                Else
                If vLastNumber = i - 1 Then
                    'Same group
                    vLastNumber = i
                    Else
                    'New group
                    vLastNumber = i
                    vNumberGroups = vNumberGroups + 1
                End If
            End If
        End If
        If Mid(vPattern, i, 1) = "L" Then
            If vLastAlphaLower = 0 Then
                'Set the position to i
                vLastAlphaLower = i
                vAlphaLowerGroups = vAlphaLowerGroups + 1
                Else
                If vLastAlphaLower = i - 1 Then
                    'Same group
                    vLastAlphaLower = i
                    Else
                    'New group
                    vLastAlphaLower = i
                    vAlphaLowerGroups = vAlphaLowerGroups + 1
                End If
            End If
        End If
        If Mid(vPattern, i, 1) = "U" Then
            If vLastAlphaUpper = 0 Then
                'Set the position to i
                vLastAlphaUpper = i
                vAlphaUpperGroups = vAlphaUpperGroups + 1
                Else
                If vLastAlphaUpper = i - 1 Then
                    'Same group
                    vLastAlphaUpper = i
                    Else
                    'New group
                    vLastAlphaUpper = i
                    vAlphaUpperGroups = vAlphaUpperGroups + 1
                End If
            End If
        End If
    Next
    
    Dim Patterns() As String
    Patterns = Split("143,242,232,352,333,323,324,332,342,343,424,442,422,432,433,413,532,542,533,430,441,541,421,343,123,132,133,134,142,144,213,223,224,231,233,234,235,241,243,244,252,254,255,311,334,344,345,351,353,362,373,412,415,423,434,443,444,451,452,453,462,513,522,523,531,551,561,642,651,652,320,560,540,450,550,340,330,440", ",")
    For i = LBound(Patterns) To UBound(Patterns)
        If (vAlphaLowerGroups & vAlphaUpperGroups & vNumberGroups) = Patterns(i) Then
            IsRandom = True
            Exit Function
        End If
    Next
Err:
    IsRandom = False
End Function
Private Function IsSymbol(Text As String) As Boolean
    On Error Resume Next
    Select Case Text
        Case "!": IsSymbol = True
        Case "$": IsSymbol = True
        Case "%": IsSymbol = True
        Case "^": IsSymbol = True
        Case "&": IsSymbol = True
        Case "*": IsSymbol = True
        Case "(": IsSymbol = True
        Case ")": IsSymbol = True
        Case "[": IsSymbol = True
        Case "]": IsSymbol = True
        Case "{": IsSymbol = True
        Case "}": IsSymbol = True
        Case ";": IsSymbol = True
        Case ":": IsSymbol = True
        Case "'": IsSymbol = True
        Case vbQuote: IsSymbol = True
        Case ",": IsSymbol = True
        Case "<": IsSymbol = True
        Case ".": IsSymbol = True
        Case ">": IsSymbol = True
        Case "?": IsSymbol = True
        Case "`": IsSymbol = True
        Case "~": IsSymbol = True
        Case "-": IsSymbol = True
        Case "_": IsSymbol = True
        Case "+": IsSymbol = True
        Case "=": IsSymbol = True
        Case Else: IsSymbol = False
    End Select
End Function
Private Function IsAlphaLower(Text As String) As Boolean
    On Error Resume Next
    IsAlphaLower = False
    If Asc(Text) >= 97 And Asc(Text) <= 122 Then IsAlphaLower = True
End Function
Private Function IsAlphaUpper(Text As String) As Boolean
    On Error Resume Next
    IsAlphaUpper = False
    If Asc(Text) >= 65 And Asc(Text) <= 90 Then IsAlphaUpper = True
End Function
Public Function WhoUser(Username As String) As String
    If UCase$(Username) = Username Then
        If Left$(Username, 1) = "[" And Right$(Username, 1) = "]" Then
            WhoUser = Mid$(Username, 2, Len(Username) - 2)
        Else
            WhoUser = Username
        End If
    Else
        WhoUser = Username
    End If
    If InStr(WhoUser, " (*") > 0 Then
        WhoUser = Suffix(WhoUser, " (")
        If Right(WhoUser, 1) = ")" Then WhoUser = Left$(WhoUser, Len(WhoUser) - 1)
    End If
End Function
Public Function ExtractNum(Username As String) As String
    If InStrB(Username, "#") = 0 Then ExtractNum = 0: Exit Function
    Dim Num As String
    Num = Split(Username, "#")(1)
    If InStrB(Num, "@") <> 0 Then Num = Split(Num, "@")(0)
    ExtractNum = Num
End Function
Public Function IsOnGateway(Username As String) As Boolean
    Dim U As String
    U = LCase$(Username)
    If (InStr(U, "@uswest") > 0) Or (InStr(U, "@useast") > 0) Or (InStr(U, "@asia") > 0) Or (InStr(U, "@europe") > 0) Or _
       (InStr(U, "@lordaeron") > 0) Or (InStr(U, "@azeroth") > 0) Or (InStr(U, "@kalimdor") > 0) Or (InStr(U, "@northrend") > 0) Then
        IsOnGateway = True
    Else
        IsOnGateway = False
    End If
End Function
Public Function GatewayMatch(sName As String, sServer As String) As Boolean
    If InStrB(sName, "@") Then
        Dim Server As String
        Server = LCase$(Mid$(sName, InStrRev(sName, "@") + 1))
        Select Case Server
        Case "uswest", "useast", "asia", "europe", "azeroth", "lordaeron", "kalimdor", "northrend"
             GatewayMatch = (Server = LCase$(sServer))
        End Select
    End If
End Function
Public Function StripGateway(ByVal sName As String) As String
    StripGateway = sName
    If InStrB(sName, "@") Then
        Dim Server As String
        Server = LCase$(Mid$(sName, InStrRev(sName, "@") + 1))
        Select Case Server
        Case "uswest", "useast", "asia", "europe", "azeroth", "lordaeron", "kalimdor", "northrend"
             StripGateway = Left$(sName, Len(sName) - Len(Server) - 1)
        End Select
    End If
End Function

'Rotate 13 Encoding
Public Function Rot13(Text As String) As String
    Dim codec_text As String, i As Integer
    codec_text = vbNS
    For i = 1 To Len(Text)
        Dim K As Integer
        K = Asc(Mid$(Text, i, 1))
        If ((K >= 65 And K <= 77) Or (K >= 97 And K <= 109)) Then
            codec_text = codec_text & Chr$(K + 13)
        ElseIf ((K >= 78 And K <= 90) Or (K >= 110 And K <= 122)) Then
            codec_text = codec_text & Chr$(K - 13)
        Else
            codec_text = codec_text & Chr$(K)
        End If
    Next
    Rot13 = codec_text
End Function
'Xor Encryption
Public Function XORDecryption(CodeKey As String, DataIn As String) As String
    Dim lonDataPtr As Long
    Dim strDataOut As String
    Dim intXOrValue1 As Integer
    Dim intXOrValue2 As Integer
    
    For lonDataPtr = 1 To (Len(DataIn) / 2)
        'The first value to be XOr-ed comes from the data to be encrypted
        intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
        'The second value comes from the code key
        intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
        
        strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
    Next lonDataPtr
   XORDecryption = strDataOut
End Function
Public Function XOREncryption(CodeKey As String, DataIn As String) As String
    Dim lonDataPtr As Long
    Dim strDataOut As String
    Dim Temp As Integer
    Dim tempstring As String
    Dim intXOrValue1 As Integer
    Dim intXOrValue2 As Integer
    
    For lonDataPtr = 1 To Len(DataIn)
        'The first value to be XOr-ed comes from the data to be encrypted
        intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
        'The second value comes from the code key
        intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
        
        Temp = (intXOrValue1 Xor intXOrValue2)
        tempstring = Hex(Temp)
        If Len(tempstring) = 1 Then tempstring = "0" & tempstring
        
        strDataOut = strDataOut + tempstring
    Next lonDataPtr
   XOREncryption = strDataOut
End Function
'Decryption of Hex
Public Function HexToString(ByVal Hex As String) As String
    On Error GoTo Ending
    Dim strReturn As String, i As Long
    If Len(Hex) Mod 2 <> 0 Then Exit Function
    For i = 1 To Len(Hex) Step 2
        strReturn = strReturn & Chr(Val("&H" & Mid(Hex, i, 2)))
    Next
    HexToString = strReturn
Ending:
End Function
'Encryption of Hex
Public Function StringToHex(ByVal strData As String) As String
    Dim strReturn As String, i As Integer
    For i = 1 To Len(strData)
        strReturn = strReturn & Right("00" & Hex(Asc(Mid(strData, i, 1))), 2)
    Next i
    StringToHex = strReturn
End Function
'Decryption of Ascii
Public Function AscToString(ByVal Text As String) As String
    Dim Char As String * 1, NewText As String, i As Integer
    For i = 1 To Len(Text)
        Char = Mid$(Text, i, 1)
        Select Case Asc(Char)
            Case 190 To 215: Char = Chr$(Asc(Char) - 125)
            Case 216 To 241: Char = Chr$(Asc(Char) - 119)
            Case 242 To 251: Char = Chr$(Asc(Char) - 194)
        End Select
        NewText = NewText & Char
    Next i
    AscToString = NewText
End Function
'Encryption of Ascii
Public Function StringToAsc(ByVal Text As String) As String
    Dim Char As String * 1, NewText As String, i As Integer
    For i = 1 To Len(Text)
        Char = Mid$(Text, i, 1)
        Select Case Asc(Char)
            Case 65 To 90: Char = Chr$(Asc(Char) + 125)
            Case 97 To 122: Char = Chr$(Asc(Char) + 119)
            Case 48 To 57: Char = Chr$(Asc(Char) + 194)
        End Select
        NewText = NewText & Char
    Next i
    StringToAsc = NewText
End Function
