Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 'bcp
- '2.0
- '&The Baal Channel Project:IAreConnection
- '&login:logout:forcelogin <name>:forcelogout <name>:games:pref [options]:career [options]: *** For more command information, please go to python.bot.nu/bcp/help.php?view=Commands and browse the page.
- '&31402
- '&Settings are stored in "bcp_settings.ini" in your bot folder. (no quotes):Check out help topics @ python.bot.nu/bcp/help.php:The translations file should be included, however you may get it at python.bot.nu/bcp/downloads/translations/
- Const bcpVID = 20110
- ' // SETTINGS ARE NOW STORED IN A CONFIG FILE IN THE BOT'S FOLDER CALLED bcp_settings.ini
- '===============
- '= Parenthesis "(" and ")" denote the user who found the bug, if it is
- '= not specified, they were found by the community or a developer.
- '===============
- ' ChangeLog for 2.0.1 (3/1/09)
- '
- ' * Fixed forcelogin and forcelogout Object required errors
- ' * Fixed 'second timer' error
- ' * Improved fail messages for commands to be more descriptive
- ' * Fixed open characters being parsed
- ' * Fixed career misdeclaration (steve)
- ' * Fixed preferences mistype (steve)
- ' * Misc stuff
- ' ________________
- '/ Foreward
- '
- ' This is BCP 2; BCP 2.0 is a remake of my previous release of 1.8. Using it
- ' as a model I made this one and improved almost everything. The community's
- ' favorite features such as auto-spam and fastest game recorded have been
- ' hard-coded into the script for you.
- '
- ' There are many new features, and many ways to freely change it, moreso than
- ' the previous version. You may find it hard to adapt to this version. I have made
- ' it extremely user friendly and it almost sets itself up. You can download a translation
- ' file or make them yourself. The forum (listed below) can be used to submit them.
- '
- ' You will notice a script function programatically named the GDB. You can research
- ' it more on the site, but I only plan on making it available to well-respected users of
- ' Battle.net.
- '
- ' as always, show some love to the StealthBot, PyBot and respective scripting communities
- '
- ' Have fun guys, good luck
- ' -iareconnection
- '
- '\_________________
- ' / %%%%
- ' _______________/ %%%%%
- '/ Quick Links
- '
- ' ==> Help Topics
- ' http://python.bot.nu/bcp/help.php
- '
- ' ==> GDB Explained
- ' http://python.bot.nu/bcp/help.php?view=GDB
- '
- ' ==> Forum
- ' http://python.bot.nu/forum/
- '
- '\________________
- '%=================================%
- '% %
- '% do not edit below here %
- '% consult bcp_settings.ini %
- '% %
- '%=================================%
- Public bcpFSO, bcpUsers
- Public bcpIC, bcpLastGameRequest
- Public bcpLastProfileUpdate
- Public bcpLastConnect
- 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).
- If StatString = "Open Character" Then
- Character = Username
- CClass = "unknown"
- Title = ""
- Level = 0
- Exit Sub
- End If
- 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
- On Error Resume Next : Err.Clear
- 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()))
- On Error GoTo 0
- If Err.Number <> 0 Then AddChat vbRed, "[BCP] Format error " & Err.Number & ": " & Err.Description
- 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)
- If Runs = 0 Then Exit Sub
- 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 Rank()
- Rank = 0
- bubble = bcp_RankBubble()
- For i = 1 to UBound(bubble)
- If LCase(bubble(i)) = LCase(Username) Then
- Rank = i
- Exit Function
- End If
- Next
- End Function
- Function Average()
- If Runs = 0 or Time = 0 Then Average = 0 : Exit Function
- 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 = "~" & Chr(0) & Chr(2) '// Can't type those
- End Sub
- End Class
- Sub bcp_PurgeList(LimitOf)
- For Each Key in bcpUsers.Keys
- With bcpUsers.Item(Key)
- If .Runs < LimitOf Then
- .Runs = 0
- .Time = 0
- .Fastest = 0
- .Save
- AddChat vbRed, "[BCP] Purge: " & .Username
- End If
- End With
- Next
- End Sub
- 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)
- On Error Resume Next : Err.Clear
- Set file = bcpFSO.OpenTextFile(BotPath() & "bcp_translations.txt", 1)
- Q = Split(file.ReadAll(), vbCrLf)
- lang = "?"
- phixd = Text
- For i = 0 to UBound(Q)
- p = Split(Q(i), "|")
- Name = p(0)
- Game = p(1)
- OE = p(2)
- Padding = Int(p(3))
- 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)
- If Padding > 0 Then p_gamename = Right(p_gamename, Len(p_gamename)-Padding)
- 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
- If Err.Number <> 0 Then
- AddChat vbRed, "[BCP] Translation error: " & Err.Description
- Err.Clear
- lang = "?"
- phixd = Text
- End If
- bcp_Translate = Array(lang, phixd)
- End Function
- Function bcp_RankBubble()
- Dim b()
- Sandbox = Split(Join(bcpUsers.Keys, chr(0)), chr(0))
- For i = 0 to UBound(Sandbox)
- Sandbox(i) = Sandbox(i) & "|" & bcpUsers.Item(Sandbox(i)).Runs
- Next
- Total = bcpUsers.Count
- ReDim b(Total)
- g = 0
- k = "?"
- n = 0
- For i = 1 to Total
- For x = 0 to UBound(Sandbox)
- If Sandbox(x) <> "" Then
- q = Split(Sandbox(x), "|")
- If Int(q(1)) > g Then
- k = q(0)
- g = Int(q(1))
- n = x
- End If
- End If
- Next
- Sandbox(n) = ""
- b(i) = k
- g = 0
- Next
- bcp_RankBubble = b
- 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", "chant|cs", 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 "Commands", "career", "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 "Behavior", "SaveOnExit", "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()
- bcpLastConnect = Now()
- If Not bcpFSO.FileExists(BotPath() & "bcp_translations.txt") Then
- AddChat vbRed, "[BCP] You do not have a translations file. The translations file allows your channel patrons to use other Diablo non-english clients. Place it in your bot folder."
- AddChat vbRed, "[BCP] You can consult /phelp bcp for more information."
- End If
- If bcp_Get("main", "firstrun") = True Then
- AddChat vbGreen, "[BCP] Welcome to BCP " & psVersions.Item("bcp") & " by IAreConnection [" & bcpVID & "]."
- 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
- Else
- t = Round(Timer-t, 2)
- If bcpUsers.Count > 100 Then AddChat vbYellow, "[BCP] Note: you have a lot of channel patrons, if you experience intense lag when the bot closes, type ""/bcp cfg set behavior saveonexit False""."
- AddChat vbCyan, "[BCP] BCP " & psVersions.Item("bcp") & " by IAreConnection: Loaded " & bcpUsers.Count & " profiles. (" & t & "ms)"
- End If
- End Sub
- Sub bcp_second_Timer()
- 'On Error Resume Next : Err.Clear
- For Each Key in bcpUsers.Keys
- With bcpUsers.Item(Key)
- If CBool(.InGame) Then
- If .GameObject.Duration() > (bcp_Get("main", "MaxGame") * 1.5) Then
- .InGame = False
- AddChat vbRed, "[BCP] " & .Username & "'s game has taken too long. Removing."
- .GDB_Update("")
- End If
- End If
- End With
- Next
- 'Err.Clear : On Error GoTo 0
- If Not IsOnline or (Abs(DateDiff("s", bcpLastConnect, Now())) < 60) Then
- 'AddChat vbRed, "[BCP] The bot is not online or has just connected. Refraining from messages/profile."
- Exit Sub
- End If
- If LCase(bcp_Get("main", "MsgType")) = "repeat" Then
- bcpTmrSec = bcpTmrSec + 1
- If bcpTmrSec >= bcp_Get("main", "msgdelay") Then
- bcpTmrSec = 0
- AddQ bcp_FmtGameList()
- End If
- End If
- On Error Resume Next : Err.Clear
- x = bcp_Get("Main", "ProfileUpdate")
- If x > 1 Then
- If Abs(DateDiff("s", bcpLastProfileUpdate, Now())) > (x * 60) Then
- bcpLastProfileUpdate = Now()
- bodyOf = MyChannel & " Top Runners: " & vbCrLf
- bubble = bcp_RankBubble()
- If UBound(bubble) < 5 Then
- Exit Sub
- Else
- t = 5
- End If
- For i = 1 to t
- If bcpUsers.Exists(bubble(i)) Then
- bodyOf = bodyOf & bubble(i) & " (" & bcpUsers.Item(bubble(i)).Runs & ")" & vbCrLf
- End If
- Next
- SetBotProfile "", "[BCP " & psVersions.Item("bcp") & "] http://python.bot.nu/bcp [" & bcpVID & "]", bodyOf
- End If
- End If
- Err.Clear : On Error GoTo 0
- End Sub
- Sub bcp_Event_Load()
- bcp_Startup
- End Sub
- Sub bcp_Event_LoggedOn(Username, Product)
- bcpLastConnect = Now()
- 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
- newcmd = bcp_Get("aliases", LCase(cmd(0)))
- AddChat vbCyan, "[BCP] " & cmd(0) & " --> " & newcmd
- cmd(0) = newcmd
- 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
- If Not bcpIC.Exists(Username) Then
- AddChat vbRed, "[BCP] No channel object for " & Username & "... they may need to rejoin the channel"
- 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
- AddChat vbRed, "[BCP] Waiting until cooldown expires..."
- Exit Sub
- End If
- AddQ 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
- If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).GDB_Update("")
- AddQ "/f r " & Username
- Case "forcelogin"
- If bcpIC.Exists(cmd(1)) Then
- bcpIC.Item(cmd(1)).HideLogMsg = True
- Else
- AddChat vbYellow, "[BCP] I cannot see " & cmd(1) & " in the channel."
- End If
- AddQ "/f a " & cmd(1)
- Case "forcelogout"
- If bcpIC.Exists(cmd(1)) Then
- bcpIC.Item(cmd(1)).HideLogMsg = True
- Else
- AddChat vbYellow, "[BCP] I cannot see " & cmd(1) & " in the channel."
- End If
- AddQ "/f r " & cmd(1)
- Case "pref"
- If bcpUsers.Exists(Username) Then
- If UBound(cmd) = 0 Then
- AddQ "/w " & psD2 & Username & " " & _
- "Preferences available to you: hidecharacter, hideduration"
- Exit Sub
- End If
- 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
- Else
- AddQ "/w " & psD2 & Username & " " & _
- "You do not have a career here, you cannot set preferences."
- End If
- Case "career", "my"
- 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 & " runs at " & bcp_FmtTime(.Average()) & " (" & .Average() & "s) each (ranked #" & .Rank() & " of " & bcpUsers.Count & "). 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", "deletecode", "resetcode"
- 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
- Else
- AddQ "/w " & psD2 & Username & " " & _
- "You do not have a career here."
- End If
- End Select
- End Sub
- Sub bcp_Event_WhisperFromUser(Username, Flags, Message, Ping)
- ProperMessageA = bcp_Translate(Message)
- If Not ProperMessageA(0) = "?" Then
- If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).Language = ProperMessageA(0)
- ProperMessage = ProperMessageA(1)
- AddChat vbGreen, "[BCP] Language: " & ProperMessageA(0) & " message (" & ProperMessage & ")"
- 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 bcp_Get("Behavior", "LogoutOnExit") = True Then
- If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
- AddQ "/f r " & Username
- End If
- 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("")
- 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
- If bcpIC.Exists(Username) 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, Banned)
- If bcpUsers.Exists(Username) Then
- With bcpUsers.Item(Username)
- If .InGame Then
- d = .GameObject.Duration()
- If Not .GameTimeOK() Then
- AddQ "/w " & psD2 & Username & " Your game was too fast or too slow. (" & d & " seconds)"
- .LastGameName = "Invalid"
- Call .EmptyGame()
- Else
- AddChat vbGreen, "[BCP] " & .Character & " finished " & .GameObject.Name & " in " & d & " seconds."
- Call .EmptyGame()
- .Runs = .Runs + 1
- .Time = .Time + d
- If d < .Fastest or .Fastest = 0 Then
- If .Fastest > 0 Then m = " This is your fastest game so far."
- .Fastest = d
- End If
- AddQ "/w " & psD2 & Username & " Game #" & .Runs & " (" & .GameObject.Name & ") lasted " & bcp_FmtTime(d) & " (" & d & " 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, StatUpdate)
- 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
- Case "purge"
- l = Int(cmd(1))
- AddChat vbYellow, "[BCP] Purging players with less than " & l & " runs."
- bcp_PurgeList l
- AddChat vbGreen, "[BCP] Purge complete."
- End Select
- End If
- End Sub
- Sub bcp_Event_Close()
- If bcp_Get("Behavior", "SaveOnExit") Then bcp_SaveAll
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement