'bcp '2.0 '&The Baal Channel Project:IAreConnection '& '& '&Revamped to 2.0.:This version is a closed beta. Do NOT post it anywhere, DO NOT report any bugs publicly or anything such as that. Please come to me directly. ' ___________________ '/ InScript ChangeLog ' ->> 2.0 (2) ' * Fixed characters for the LAST TIME. ' * Added translation system. ' * Fixed a few minor typos and errors. ' * Preliminary profile stuff. ' * Save after game completion to avoid data loss. ' * .Language added to bcp_User ' * Games display as the actual name on the GDB, not the interpreted one. ' * [and others] ' ->> 2.0 (1) ' * Fixed overflow error that occured when you logout with no games. ' * Fixed character parsing. Public bcpFSO, bcpUsers Public bcpIC, bcpLastGameRequest Public bcpLastProfileUpdate Public bcpTmrSec, bcpTmrHr '// The internal channel contains a bcp_User object without run data to easily swap it. Class bcp_Banlist Private FSO Sub Class_Initialize() Set FSO = CreateObject("Scripting.FileSystemObject") End Sub Function IsBanned(Username) End Function Sub Ban(Username, Duration) End Sub End Class Class bcp_User Public Username Public StatString Public Product Public Character Public CClass Public Title 'Slayer, etc Public Level 'Int Public InGame 'Bool Public GameObject 'bcp_Game Public Language Public IsExpansion 'Bool Public IsLadder 'Bool Public IsHardcore 'Bool Public Runs 'Int Public Time 'Int Public Fastest 'Int Public LastTime 'Int Public LastGameName '// Personal Public HideGameDuration Public NameOverCharacter Public HideLogMsg Public LastLog '// Temporary Public CareerResetCode Sub EmptyGame() If Not InGame Then Exit Sub InGame = False LastTime = GameObject.Duration() LastGameName = GameObject.Name End Sub Sub Parse() 'Bot name differences, we have to make a system that agrees with both 'because Eric does not love me. '... '2.6: (Matriarch Swampie, a ladder level 90 sorceress on realm USEast). '2.7: (Champion Swampie, a level 90 ladder Sorceress on USEast). On Error Resume Next : Err.Clear If UBound(Split(StatString, " ")) < 4 Then Product = "INVALID" : Exit Sub StatString = Split(StatString, " (")(1) StatString = Left(StatString, Len(StatString)-1) partA = Split(Split(StatString, ", ")(0), " ") partS = Split(StatString, ", ")(1) partB = Split(Split(StatString, ", ")(1), " ") If UBound(partA) = 1 Then Title = partA(0) Character = partA(1) Else Title = "Player" Character = partA(0) End If p = Array("Paladin", "Barbarian", "Assassin", "Druid", "Amazon", "Necromancer", "Sorceress") Level = Int(Split(Split(partS, " level ")(1), " ")(0)) For i = 0 to UBound(p) If InStr(LCase(partS), LCase(" " & p(i) & " ")) > 0 Then CClass = p(i) Exit For End If Next CClass = LCase(CClass) If InStr(StatString, " ladder ") Then IsLadder = True If InStr(StatString, " hardcore ") Then IsHardcore = True If Product = "D2XP" Then IsExpansion = True On Error GoTo 0 If Err.Number <> 0 Then AddChat vbRed, "[BCP] StatString Parse error: " & StatString Err.Clear End Sub Function IsDiablo() If Product = "D2DV" or Product = "D2XP" Then IsDiablo = True Else IsDiablo = False End If End Function Function FormatString(Message) m = Message a = Array("%user", "%name", "%char", "%class", "%lvl", _ "%runid", "%total", "%avg", "%fst", "%title", _ "%runs", "%game", "%gametime") b = Array(PreferedName(), Username, Character, CClass, Level, _ Runs+1, bcp_FmtTime(Time), bcp_FmtTime(Average()), bcp_FmtTime(Fastest), Title, _ Runs, GameObject.Name, bcp_FmtTime(GameObject.Duration())) For i = 0 to UBound(a) m = Replace(m, a(i), b(i)) Next FormatString = m End Function Function GameTimeOK() If GameObject.Duration() < bcp_Get("main", "MinGame") or GameObject.Duration() > bcp_Get("main", "MaxGame") Then GameTimeOK = False Else GameTimeOK = True End If End Function Sub Save() path = "bcp_users/" & LCase(Username) & ".user" If Runs = 0 Then If bcpFSO.FileExists(path) Then bcpFSO.DeleteFile(path) Exit Sub End If WriteConfigEntry "UData", "Username", CStr(Username), path WriteConfigEntry "UData", "StatString", CStr(StatString), path WriteConfigEntry "UData", "Product", CStr(Product), path WriteConfigEntry "UData", "Level", CStr(Level), path WriteConfigEntry "UData", "Character", CStr(Character), path WriteConfigEntry "UData", "CClass", CStr(CClass), path WriteConfigEntry "UData", "Title", CStr(Title), path WriteConfigEntry "UData", "Runs", CStr(Runs), path WriteConfigEntry "UData", "Time", CStr(Time), path WriteConfigEntry "UData", "Fastest", CStr(Fastest), path WriteConfigEntry "UData", "LastTime", CStr(LastTime), path WriteConfigEntry "UData", "LastGameName", CStr(LastGameName), path WriteConfigEntry "UData", "Language", CStr(Language), path WriteConfigEntry "Personal", "HideGameDuration", CStr(HideGameDuration), path WriteConfigEntry "Personal", "NameOverCharacter", CStr(NameOverCharacter), path End Sub Sub GDB_Update(Status) Call Save() If bcp_Get("GDB", "username") = "" or bcp_Get("GDB", "disable") = True Then Exit Sub End If AddChat vbYellow, "[BCP:GDB] Updating " & Username & "..." WebString = Username & "|" & _ Character & "|" & _ Runs & "|" & _ Average() & "|" & _ "R|" & Status & "|" & _ Level & "|" & _ CClass & "|" & _ Time & "|" & _ Fastest uName = bcp_Get("GDB", "username") uPassword = bcp_Get("GDB", "password") webURL = bcp_Get("GDB", "location") & "?u=" & uName & "&p=" & uPassword & "&item1=" & WebString On Error Resume Next : Err.Clear SciNet.Cancel t = Timer result = SciNet.OpenURL(CStr(webURL)) t = Round(Timer-t, 2) If Not Err.Number = 0 Then AddChat vbRed, "[BCP] Note: Failed to update " & Username & " on the GDB." AddChat vbRed, Space(8) & Err.Number & ": " & Err.Description Err.Clear Else m = Split(result, " ", 2) If Int(m(0)) = 1 Then AddChat vbGreen, "[BCP:GDB] Success: " & m(1) & " (" & t & "s)" Else AddChat vbRed, "[BCP:GDB] Failure (" & m(0) & "): " & m(1) End If End If On Error GoTo 0 End Sub Function Average() Average = Int(Time / Runs) End Function Function PreferedName() If NameOverCharacter Then PreferedName = Username Else PreferedName = Character End If End Function Sub Class_Initialize() InGame = False Set GameObject = Nothing HideGameDuration = False NameOverCharacter = False HideLogMsg = True Runs = 0 Level = 0 Time = 0 Fastest = 0 LastTime = 0 LastGameName = "Incomplete" IsLadder = False : IsHardcore = False LastLog = DateAdd("s", -(bcp_Get("main", "MsgNoSpam")), Now()) CareerResetCode = "LOLWTFOMG~~~" & Chr(0) & Chr(2) '// Can't type those!!! keke End Sub End Class Sub bcp_Folder() If Not bcpFSO.FolderExists(BotPath() & "bcp_users") Then bcpFSO.CreateFolder(BotPath() & "bcp_users") AddChat vbGreen, "[BCP] Users are stored in: {BOTPATH}/bcp_users as configuration files" End If End Sub Class bcp_Game Public Name Public Host Public Started Function Duration() Duration = Abs(DateDiff("s", Started, Now())) End Function Sub Class_Initialize() Started = Now() End Sub End Class Function bcp_Mutual(Username) For Each Friend in Friends addchat vbgreen, friend.name & ":" & friend.ismutual If LCase(Friend.Name) = LCase(Username) Then If Friend.IsMutual Then bcp_Mutual = True Else bcp_Mutual = False End If End If Next End Function Function bcp_Translate(Text) Set file = bcpFSO.OpenTextFile(BotPath() & "bcp_translations.txt", 1) Q = Split(file.ReadAll(), vbCrLf) lang = "?" phixd = "" For i = 0 to UBound(Q) p = Split(Q(i), "|") Name = p(0) Game = p(1) OE = p(2) If Match(Text, Game, True) Then lang = Name D = Split(Game, "*") p_user = Split(Split(Text, D(0))(1), D(1))(0) p_prod = Split(Split(Text, D(1))(1), D(2))(0) p_gamename = Split(Text, D(2))(1) p_gamename = Left(p_gamename, Len(p_gamename)-1) phixd = "Your friend " & p_user & " entered a " & p_prod & " game called " & p_gamename & "." End If If Match(Text, OE, True) Then lang = Name D = Split(OE, "*") p_user = Split(Split(Text, D(0))(1), D(1))(0) phixd = "Your friend " & p_user & " has exited Battle.net." End If Next file.Close bcp_Translate = Array(lang, phixd) End Function Function bcp_FmtTime(Seconds) If Int(Seconds) < 60 Then bcp_FmtTime = Seconds & "s" : Exit Function s = Int(Seconds) : m = 0 : h = 0 While s > 60 s = s - 60 m = m + 1 If m = 60 Then m = 0 : h = h + 1 WEnd If h > 0 Then ret = ret & h & " hours, " If m > 0 Then ret = ret & m & " minutes, " If s > 0 Then ret = ret & s & " seconds, " bcp_FmtTime = Left(ret, Len(ret)-2) End Function Function bcp_FmtGameList() fmtA = bcp_Get("Messages", "GameReturn") fmtB = bcp_Get("Messages", "GameDelimeter") smt = bcp_Get("Messages", "GamePretext") games = 0 For Each Key in bcpUsers.Keys With bcpUsers.Item(Key) If .InGame Then games = games + 1 smt = smt & .FormatString(fmtA) & fmtB End If End With Next If games > 0 Then smt = Replace(Left(smt, Len(smt)-Len(fmtB)), "%i", games) Else smt = bcp_Get("Messages", "NoGames") End If bcp_FmtGameList = smt End Function Sub bcp_Set(Section, Key, Value, Overwrite) If bcp_Get(Section, Key) <> "" and Overwrite = False Then Exit Sub ssc.WriteConfigEntry Section, Key, CStr(Value), "bcp_settings.ini" End Sub Function bcp_Get(Section, Key) bcp_Get = ssc.GetConfigEntry(Section, Key, "bcp_settings.ini") If bcp_Get = "True" or bcp_Get = "False" Then bcp_Get = CBool(bcp_Get) if IsNumeric(bcp_Get) Then bcp_Get = Int(bcp_Get) End Function Sub bcp_ReadAll() On Error Resume Next Set contents = bcpFSO.GetFolder(BotPath & "bcp_users") For Each file In contents.Files nameArr = Split(file, "\") name = "bcp_users/" & nameArr(UBound(nameArr)) Set nameArr = Nothing If Len(name) > 6 Then If Right(name, 5) = ".user" Then Username = GetConfigEntry("UData", "Username", name) If Not bcpUsers.Exists(Username) and Len(Username) > 3 and Len(Username) < 32 Then bcpUsers.Add Username, new bcp_User Err.Clear With bcpUsers.Item(Username) .Username = Username .StatString = GetConfigEntry("UData", "StatString", name) .Product = GetConfigEntry("UData", "Product", name) .Character = GetConfigEntry("UData", "Character", name) .CClass = GetConfigEntry("UData", "CClass", name) .Title = GetConfigEntry("UData", "Title", name) .Level = Int(GetConfigEntry("UData", "Level", name)) .Runs = Int(GetConfigEntry("UData", "Runs", name)) .Time = Int(GetConfigEntry("UData", "Time", name)) .Fastest = Int(GetConfigEntry("UData", "Fastest", name)) .LastTime = Int(GetConfigEntry("UData", "LastTime", name)) .LastGameName = GetConfigEntry("UData", "LastGameName", name) .Language = GetConfigEntry("UData", "Language", name) .HideGameDuration = CBool(GetConfigEntry("Personal", "HideGameDuration", name)) .NameOverCharacter = CBool(GetConfigEntry("Personal", "NameOverCharacter", name)) If Err.Number = 0 Then Else If Err.Number = 5 or Err.Number = 13 Then AddChat vbRed, "[BCP] It is possible " & Username & "'s profile needs to be updated. It should function correctly, however." Else AddChat vbRed, "[BCP] Error: " & Err.Number & ": " & Err.Description End If Err.Clear End If End With End If End If End If Next On Error GoTo 0 End Sub Sub bcp_SaveAll() For Each Key in bcpUsers.Keys bcpUsers.Item(Key).Save() Next AddChat vbGreen, "[BCP] All users saved." End Sub Sub bcp_Startup() AddChat vbCyan, "[BCP] Starting up... please wait" t = Timer Set bcpFSO = CreateObject("Scripting.FileSystemObject") Set bcpUsers = CreateObject("Scripting.Dictionary") Set bcpIC = CreateObject("Scripting.Dictionary") bcpIC.CompareMode = 1 bcpUsers.CompareMode = 1 '// 2.0 bcp_Set "Main", "FirstRun", "True", False bcp_Set "Main", "Filter", "baal|chaos", False bcp_Set "Main", "MinGame", "60", False bcp_Set "Main", "MaxGame", "250", False bcp_Set "Main", "MinLvl", "80", False bcp_Set "Main", "MinPing", "-1", False bcp_Set "Main", "MsgType", "Ask", False 'Ask,Repeat bcp_Set "Main", "MsgNoSpam", "10", False bcp_Set "Main", "MsgDelay", "60", False bcp_Set "Main", "AllowLadder", "True", False bcp_Set "Main", "AllowNonLadder", "True", False bcp_Set "Main", "AllowHardcore", "True", False bcp_Set "Commands", "games", "0", False bcp_Set "Commands", "login", "20", False bcp_Set "Commands", "logout", "20", False bcp_Set "Commands", "forcelogout", "60", False bcp_Set "Commands", "forcelogin", "60", False bcp_Set "Commands", "pref", "0", False bcp_Set "Aliases", "baal", "games", False bcp_Set "Aliases", "chaos", "games", False bcp_set "GDB", "username", "", False bcp_set "GDB", "password", "", False bcp_set "GDB", "location", "", False '// 2.0 (1) bcp_Set "Main", "ProfileUpdate", "3", False bcp_Set "Behavior", "LogoutInvalidFilter", "False", False bcp_Set "Behavior", "LogoutOnExit", "True", False bcp_Set "CRS", "Enable", "True", False bcp_Set "Messages", "GameReturn", "[ %game by %user ]", False bcp_Set "Messages", "GameDelimeter", ", ", False bcp_Set "Messages", "NoGames", "/me : No games available.", False bcp_Set "Messages", "GamePretext", "/me : %i Games: ", False bcp_Set "Messages", "NewGame", "/me : New game %game started by %user (level %lvl %class (run #%runid.))", False bcp_Folder bcp_ReadAll bcpTmrSec = 0 : bcpTmrHr = 0 TimerInterval "bcp", "second", 1 'TimerInterval "bcp", "hour", 3600 TimerEnabled "bcp", "second", True 'TimerEnabled "bcp", "hour", True bcpLastProfileUpdate = Now() bcpLastGameRequest = Now() If Not bcpFSO.FileExists(BotPath() & "bcp_translations.txt") Then AddChat vbRed, "[BCP] You do not have a translations file. It is suggested that you download it at:" AddChat vbYellow, Space(10) & "http://python.bot.nu/bcp/downloads/" AddChat vbRed, "[BCP] The translations file allows your channel patrons to use other Diablo non-english clients." End If If bcp_Get("main", "firstrun") = True Then AddChat vbGreen, "[BCP] Welcome to BCP " & psVersions.Item("bcp") & " by IAreConnection." AddChat vbYellow, "[BCP] If you are running BCP for the first time, please take the time to edit bcp_settings.ini to your liking. It is located in the bot's main folder (Settings->Edit Files->Open Bot Folder.)" AddChat vbYellow, "[BCP] Note: You may want to get additional translations and check for updates at: http://python.bot.nu/bcp" AddChat vbYellow, "[BCP] Thank you for using BCP." AddChat vbCyan, "[BCP] Note: You will also need to reset any GDB usernames, locations and passwords." bcp_Set "main", "firstrun", False, True AddChat vbGreen, "[BCP] Note: Wes can't finess anybody." AddChat vbRed, "[BCP] This is a closed beta. You are expected to keep it closed until it is released. Do not report any bugs publicly. Come to me directly." Else t = Round(Timer-t, 2) AddChat vbCyan, "[BCP] BCP " & psVersions.Item("bcp") & " by IAreConnection: Loaded " & bcpUsers.Count & " profiles. (" & t & "ms)" End If End Sub Sub bcp_second_Timer() If LCase(bcp_Get("main", "MsgType")) = "repeat" Then bcpTmrSec = bcpTmrSec + 1 If bcpTmrSec >= bcp_Get("main", "msgdelay") Then bcpTmrSec = 0 AddQ "/me : " & bcp_FmtGameList() End If End If x = bcp_Get("Main", "ProfileUpdate") If x > 1 Then If Abs(DateDiff("s", bcpLastProfileUpdate, Now())) > (x * 60) Then bcpLastProfileUpdate = Now() SetBotProfile "", "[BCP " & psVersions.Item("bcp") & "] http://python.bot.nu/bcp", "..." End If End If End Sub Sub bcp_Event_Load() bcp_Startup End Sub Sub bcp_Event_ServerInfo(Message) parts = Split(Message, " ") If InStr(Message, " your friends list.") > 0 Then If bcpIC.Exists(parts(1)) Then If bcpIC.Item(parts(1)).HideLogMsg Then bcpIC.Item(parts(1)).HideLogMsg = False AddChat vbYellow, "[BCP] Action OK but hidden." Exit Sub End If Else AddChat vbRed, "[BCP] Ignoring message, assuming you want it hidden." Exit Sub End If If parts(0) = "Added" Then 'If bcp_Mutual(parts(1)) Then AddQ "/w " & psD2 & parts(1) & " You have been logged IN." 'Else ' AddQ "/w " & psD2 & parts(1) & " You have been logged IN, however you have not added me to your friends list." 'End If ElseIf parts(0) = "Removed" Then msg = "You have been logged OUT." If bcpUsers.Exists(parts(1)) Then With bcpUsers.Item(parts(1)) If .Runs > 1 Then msg = "You have been logged OUT. You have completed " & .Runs & " games at roughly " & bcp_FmtTime(.Average()) & " (" & .Average() & " seconds) per game." End With End If AddQ "/w " & psD2 & parts(1) & " " & msg End If End If End Sub Sub bcp_Event_ServerError(Message) parts = Split(Message, " ") If Message = "You already have the maximum number of friends in your list. You will need to remove some of your friends before adding more." Then AddQ "BCP Error: There is no more room on my friends list" If InStr(Message, " is already in your friends list.") Then If bcpIC.Exists(parts(0)) Then If bcpIC.Item(parts(0)).HideLogMsg Then bcpIC.Item(parts(0)).HideLogMsg = False AddChat vbYellow, "[BCP] Action OK but hidden." Exit Sub End If Else AddChat vbRed, "[BCP] Ignoring message, assuming you want it hidden." Exit Sub End If AddQ "/w " & psD2 & parts(0) & " You are already logged IN." End If End Sub Sub bcp_Event_UserTalk(Username, Flags, Message, Ping) b = BotVars.Trigger GetDBEntry Username, a, f If Left(Message, Len(b)) = b Then cmd = Split(Mid(Message, Len(b)+1), " ") Else Exit Sub End If If bcp_Get("aliases", LCase(cmd(0))) <> "" Then cmd(0) = bcp_Get("aliases", LCase(cmd(0))) End If If bcp_Get("commands", LCase(cmd(0))) <> "" Then cmdA = Int(bcp_Get("commands", LCase(cmd(0)))) If (a < cmdA) and (Not cmdA = 0) Then AddChat vbRed, "[BCP] Error: " & Username & " is not authorized to do this command" Exit Sub End If Else Exit Sub End If Select Case LCase(cmd(0)) Case "games" If Not LCase(bcp_Get("main", "MsgType")) = "ask" Then AddChat vbRed, "[BCP] Games are repeated." Exit Sub Else If Abs(DateDiff("s", bcpLastGameRequest, Now())) < bcp_Get("main", "MsgNoSpam") Then Exit Sub AddQ "/me : " & bcp_FmtGameList() bcpLastGameRequest = Now() End If Case "login" If Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now())) < bcp_Get("main", "MsgNoSpam") Then AddChat vbRed, "[BCP] Wait " & (bcp_Get("main", "MsgNoSpam") - Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now()))) & " seconds." Exit Sub End If bcpIC.Item(Username).LastLog = Now() If (Ping > bcp_Get("main", "MinPing")) and (bcp_Get("main", "MinPing") <> -1) Then AddQ "/w " & psD2 & Username & " You must have a ping lower than " & bcp_Get("main", "MinPing") & " to login." Exit Sub End If If (Not bcp_Get("main", "AllowHardcore")) and (bcpIC.Item(Username).IsHardcore) Then AddQ "/w " & psD2 & Username & " Hardcore characters are not permitted to login." Exit Sub End If If (Not bcp_Get("main", "AllowNonLadder")) and (Not bcpIC.Item(Username).IsLadder) Then AddQ "/w " & psD2 & Username & " Non-ladder characters are not permitted to login." Exit Sub End If If (Not bcp_Get("main", "AllowLadder")) and (bcpIC.Item(Username).IsLadder) Then AddQ "/w " & psD2 & Username & " Ladder characters are not permitted to login." Exit Sub End If If bcpIC.Item(Username).Level < bcp_Get("main", "MinLvl") Then AddQ "/w " & psD2 & Username & " You must be at least level " & bcp_Get("main", "MinLvl") & " to login." Exit Sub End If bcpIC.Item(Username).HideLogMsg = False AddQ "/f a " & Username Case "logout" If Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now())) < bcp_Get("main", "MsgNoSpam") Then AddChat vbRed, "[BCP] Wait " & (bcp_Get("main", "MsgNoSpam") - Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now()))) & " seconds." Exit Sub End If bcpIC.Item(Username).LastLog = Now() bcpIC.Item(Username).HideLogMsg = False AddQ "/f r " & Username Case "forcelogin" bcpIC.Item(cmd(1)).HideLogMsg = True AddQ "/f a " & cmd(1) Case "forcelogout" bcpIC.Item(cmd(1)).HideLogMsg = True AddQ "/f r " & cmd(1) Case "pref" If bcpUsers.Exists(Username) Then With bcpUsers.Item(Username) Select Case LCase(cmd(1)) Case "hcn", "hidecharacter", "showaccount", "showname" If .NameOverCharacter Then .NameOverCharacter = False AddQ "/w " & psD2 & Username & " " & _ "Your character will now be shown instead of your account name." Else .NameOverCharacter = True AddQ "/w " & psD2 & Username & " " & _ "Your account name will now be shown instead of your character." End If Case "hd", "hideduration", "hideinfo", "hidedata" If .HideGameDuration Then .HideGameDuration = False AddQ "/w " & psD2 & Username & " " & _ "The bot will now whisper you your last game's duration and name." Else .HideGameDuration = True AddQ "/w " & psD2 & Username & " " & _ "The bot will now refrain from whispering you your game's data." End If End Select End With End If Case "career" If bcpUsers.Exists(Username) Then With bcpUsers.Item(Username) Select Case LCase(cmd(1)) Case "info", "data" AddQ "/w " & psD2 & Username & " " & _ "You have completed " & .Runs & " at roughly " & bcp_FmtTime(.Average()) & " (" & .Average() & "s) each. Your fastest was " & bcp_FmtTime(.Fastest) & ". Your last was " & bcp_FmtTime(.LastTime) & "." Case "reset", "delete" Randomize .CareerResetCode = CStr(Int( Rnd * 100000 ) + 1000) AddQ "/w " & psD2 & Username & " " & _ "Please type '" & BotVars.Trigger & "career confirmdelete " & .CareerResetCode & "' (no quotes) to confirm this." Case "confirmdelete", "confirm" If .CareerResetCode = cmd(2) Then .Runs = 0 .Time = 0 .Fastest = 0 .Save AddQ "/w " & psD2 & Username & " " & _ "Your career (runs, time, average, fastest game) has been reset." Else AddQ "/w " & psD2 & Username & " " & _ "Your code is " & .CareerResetCode & "." End If End Select End With End If End Select End Sub Sub bcp_Event_WhisperFromUser(Username, Flags, Message) ProperMessageA = bcp_Translate(Message) If Not ProperMessageA(0) = "?" Then If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).Language = ProperMessageA(0) AddChat vbGreen, "[BCP] Dialect: " & ProperMessageA(0) & " message." ProperMessage = ProperMessageA(1) Else ProperMessage = Message End If If Match(ProperMessage, "Your friend * has exited Battle.net.", True) Then If bcpUsers.Exists(Username) Then With bcpUsers.Item(Username) If .InGame Then AddChat vbRed, "[BCP] User logged off while in a game, run removed." .InGame = False Set .GameObject = Nothing If .Runs > 10 Then .GDB_Update("") If bcp_Get("Behavior", "LogoutOnExit") = True Then bcpIC.Item(Username).HideLogMsg = True AddQ "/f r " & Username End If Exit Sub End If End With End If End If parts = Split(ProperMessage, " ") If Match(ProperMessage, "Your friend * entered a * game called *.", True) Then game = Split(ProperMessage, " game called ")(1) game = Left(game, Len(game)-1) gf = Split( CStr(bcp_Get("main", "filter")), "|" ) ok = False For i = 0 to UBound(gf) If InStr(LCase(game), LCase(gf(i))) > 0 Then m = gf(i) ok = True End If Next If Not ok Then If bcp_Get("Behavior", "LogoutInvalidFilter") Then bcpIC.Item(Username).HideLogMsg = True AddQ "/f r " & Username Else AddChat vbRed, "[BCP] Game name has no valid tag, it was ignored." End If Exit Sub Else m = game End If If bcpUsers.Exists(Username) Then With bcpUsers.Item(Username) If .InGame Then AddChat vbRed, "[BCP] User is already in a game. Resetting game." .EmptyGame Set .GameObject = New bcp_Game .GameObject.Name = game .GameObject.Host = Username AddQ .FormatString(bcp_Get("Messages", "NewGame")) .InGame = True If .Runs > 10 Then .GDB_Update(m) Exit Sub End If .InGame = True Set .GameObject = New bcp_Game .GameObject.Name = game .GameObject.Host = Username AddQ .FormatString(bcp_Get("Messages", "NewGame")) If .Runs > 10 Then .GDB_Update(m) End With Else AddChat vbYellow, "[BCP] User doesn't exist..." If bcpIC.Exists(Username) Then bcpUsers.Add Username, bcpIC.Item(Username) With bcpUsers.Item(Username) AddChat vbGreen, "[BCP] " & .Title & " " & .Character & " (level " & .Level & ", " & .CClass & ") added to database." End With With bcpUsers.Item(Username) .InGame = True Set .GameObject = New bcp_Game .GameObject.Name = game .GameObject.Host = Username AddQ .FormatString(bcp_Get("Messages", "NewGame")) End With Else AddChat vbRed, "[BCP] User was not in the database, and had no channel reference. The user couldn't be added properly." End If End If End If End Sub Sub bcp_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString) If bcpUsers.Exists(Username) Then With bcpUsers.Item(Username) If .InGame Then If Not .GameTimeOK() Then AddQ "/w " & psD2 & Username & " Your game was too fast or too slow. (" & .GameObject.Duration() & " seconds)" .LastGameName = "Invalid" Call .EmptyGame() Else AddChat vbGreen, "[BCP] " & .Character & " finished " & .GameObject.Name & " in " & .GameObject.Duration() & " seconds." Call .EmptyGame() .Runs = .Runs + 1 .Time = .Time + .GameObject.Duration() If .GameObject.Duration() < .Fastest or .Fastest = 0 Then If .Fastest > 0 Then m = " This is your fastest game so far." .Fastest = .GameObject.Duration() End If AddQ "/w " & psD2 & Username & " Game #" & .Runs & " (" & .GameObject.Name & ") lasted " & bcp_FmtTime(.GameObject.Duration()) & " (" & .Average() & " seconds)." & m End If Set .GameObject = Nothing .GDB_Update("") End If .StatString = Message .Product = Product .Level = Level .Parse End With End If If bcpIC.Exists(Username) Then bcpIC.Remove Username bcpIC.Add Username, new bcp_User With bcpIC.Item(Username) .Username = Username .Product = Product .Level = Level .StatString = Message .Parse End With End Sub Sub bcp_Event_UserLeaves(Username, Flags) 'If bcpIC.Exists(Username) Then bcpIC.Remove Username End Sub Sub bcp_Event_UserInChannel(Username, Flags, Message, Ping, Product) If bcpIC.Exists(Username) Then bcpIC.Remove Username bcpIC.Add Username, new bcp_User With bcpIC.Item(Username) .Username = Username .Product = Product .Level = Level '// Fuck 2.6 .StatString = Split(Message, ")") If UBound(.StatString) > 0 Then .StatString = .StatString(UBound(.StatString)-1) & ")" Else .StatString = Message End If .Parse End With Message = "" End Sub Sub bcp_Event_PressedEnter(Text) If Left(Text, 5) = "/bcp " Then VetoThisMessage cmd = Split(Mid(Text, 6), " ") Select Case LCase(cmd(0)) Case "gdbinfo" bcp_Set "GDB", "username", cmd(1), True bcp_Set "GDB", "password", cmd(2), True AddChat vbGreen, "[BCP] Global database username set to " & cmd(1) & _ " and password set to """ & cmd(2) & """." Case "gdbloc" bcp_Set "GDB", "location", cmd(1), True AddChat vbGreen, "[BCP] Global database location set to: " & cmd(1) Case "cfg", "config" Select Case LCase(cmd(1)) Case "get" AddChat vbGreen, bcp_Get(cmd(2), cmd(3)) Case "set" Call bcp_Set(cmd(2), cmd(3), Replace(cmd(4), "_", " ")) AddChat vbGreen, bcp_Get(cmd(2), cmd(3)) End Select End Select End If End Sub Sub bcp_Event_Close() bcp_SaveAll End Sub