Advertisement
Guest User

bcp_2_0_6

a guest
Jul 6th, 2018
236
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 80.11 KB | None | 0 0
  1. Script("Name") = "BCP"
  2. Script("Author") = "vi[r]us (IAreConnection @ StealthBot.net)"
  3. Script("Major") = 2
  4. Script("Minor") = 6
  5. Script("Revision") = 0
  6.  
  7. '// This is a unique code given to each public release. The version name (BCP x.x.x) is always the first 3 numbers.
  8. '// Major_Minor_Revision_BetaCode_ScriptType (ScriptType is always 0 for public releases)
  9. Const bcpVID = 20600
  10. Const bcpVD = "9/28/2010"
  11.  
  12. '// The bot maintains the following files and folders (in the StealthBot directory):
  13. '// bcp_settings.ini -- Used to keep settings for the script.
  14. '// bot folder/bcp_users -- The folder where user profiles are stored.
  15. '// bcp_translations.txt -- A text file containing instructions used to "translate" friend messages.
  16. '// bot folder/bcp_translations -- Formerly used to hold old translations. Defunct in this version.
  17. '// bot folder/bcp_versions -- Will be used to hold outdated scripts in upcoming versions. Defunct in this version.
  18.  
  19. '// The bot will by default access the following websites on the internet:
  20. '// http://toshley.net/bcp/downloads/getcurrentversion.php -- Used to find the current script version.
  21. '// http://toshley.net/bcp/downloads/translations/getcurrentversion.php -- Used to find the current translations version.
  22. '// http://toshley.net/bcp/.../commit.php -- Used to report information to the GDB if turned on.
  23. '// http://toshley.net/bcp/news/[vID].txt -- Used to get the news for your version.
  24.  
  25. '// This file belongs in the /scripts/ folder of your StealthBot directory. It is no longer a plugin as of 2.0.4.
  26.  
  27. '// I have been getting a lot of comments lately about the BCP code itself. It is not commented on except in areas where there are
  28. '// special notes required for myself. If you don't know how to use Visual Basic, please don't edit the script yourself.
  29.  
  30. ' // SETTINGS ARE NOW STORED IN A CONFIG FILE IN THE BOT'S FOLDER CALLED bcp_settings.ini
  31.  
  32. '============================================================================================================================
  33. '= Parenthesis "(" and ")" denote the user who found the bug, if it is
  34. '= not specified, they were found by the community or a developer.
  35. '=
  36. '= Everything in the changelog is only there to show users what has changed. This
  37. '= includes displayed messages and minor code changes, as well as large changes.
  38. '============================================================================================================================
  39. ' ChangeLog for 2.0.6 (id 20600, 20601)
  40. ' * Added a quick disable/enable for the script's internal functions (the new scripting system isn't forgiving at all)
  41. ' --the bot will still do some things (such as reset the GDB on/off toggle)
  42. ' * Fixed a bug where the bot raises an error over a blank command
  43. ' * The script now checks for updates since 2.0.6, but does not download them for you
  44. ' * Added /bcp update command which checks for script updates
  45. ' * Added /bcp transupdate command which checks for translations file updates
  46. ' * Added /bcp mutual command which allows you to check if a friend is logged in and mutual (deprecated, for testing)
  47. ' * Added /bcp news command which gets the news for your version
  48. ' * Added LogoutOnNoMutual=int config entry, which is the time in minutes after a user has logged in that
  49. ' the bot will check their friend mutuality. If they aren't mutual or have gone offline, they will be removed
  50. ' --this only works if the bot has not been restarted: in testing
  51. ' * Added LogoutOnOffline config entry, which removes people if they are offline on your friends list periodically
  52. ' --this only happens if they are a runner
  53. ' --this follows the same time constraint as the game message display
  54. ' * Added /bcp config open command to open the settings file in the default editor (changes are automatic)
  55. ' * Added IsLadder profile setting to user profiles to fix temporary unknowns until someone rejoins the channel
  56. ' * Added IsHardcore profile setting ^
  57. ' * Added IsExpansion profile setting ^
  58. ' * The bot will now mark ladder, nonladder and hardcore on the GDB
  59. ' * The bot will not use the GDB for the duration of the session if it becomes unavailable for any reason
  60. ' --this resets when the bot logs on *meaning you can reconnect to reset it
  61. ' * Replaced the FOREWARD in the script file with a nonedit warning
  62. ' * Added /bcp setup command which runs an interface to help you set up the bot
  63. ' --this includes GDB setup
  64. ' * The firstrun message now tells you such a command exists IN BIG LETTERS.
  65. ' * The bots will now ignore Diablo-only commands from users that aren't using Diablo
  66. ' --effected commands: getinfo, myinfo, login, logout, games
  67. ' * When reporting command invalidity, the bot will now say the command and the required access
  68. ' * Reworded some responses that only make sense to people who know more than a "normal" person does (they were
  69. ' created when the script was in beta, and only developers needed to read it)
  70. ' * Added /bcp find command that works in the same fashion as the in-game one, it is however more descriptive
  71. ' * Fixed a bug where hardcore flags stick to users even after rejoining the channel (ChX-Dragon)
  72. ' * Fixed a bug where ladder flags stick to users even after rejoining the channel (ChX-Dragon)
  73. ' * Changed a potential type mismatch from product comparisons (ChX-Dragon)
  74. ' * Fixed the error occuring because %game is replaced before %gametime, thereby making the latter give the wrong value or never appear (ChX-Dragon)
  75. ' * Added information for files and locations at the top of the script. In case this is ever necessary, it is now in the script itself.
  76. ' * Added the option to show MessageBox notifications for things the bot has done or needs your help with to assist users who like to minimize at startup (Main:ShowDialogs = boolean)
  77. ' --effected events: translation updates, script updates, gdb turning off
  78. ' * Changed the way news is read so that it can see links
  79. ' * Added UseNewestProfile entry, which can be used to completely turn off GDB downloads for newer profiles by setting it to False (Behavior:UseNewestProfile = boolean)
  80. ' * Fixed an index error that occured when a translation mismatch occurs
  81. ' * The translation warning message no longer shows English to English
  82. ' * Removed unused functions and classes (code only)
  83. ' * Added a simple error escape for commands (you will no longer see the obnoxious StealthBot warning when mistyping a command)
  84. ' * Added /bcp reset command; this command allows you to reset a single person's game count and information (same clear method as purge)
  85. ' * The .myinfo command now includes the player's rank
  86. ' * Added Translations:GermanLanguageSupport=Boolean under translations, which simply hard removes " eingeklinkt" from game names (the space is included). Enabled by default.
  87. ' * Setting filters to nothing turns them off, and will no longer raise an error
  88. ' * Added Behavior:AutoLock=Boolean to automatically lock the bot's window when BCP loads
  89. '
  90. ' Developer's Notes
  91. ' ### YNI (but still in code)
  92. ' * The bot will now check to see if the user logging in is a mutual friend (experimental, the bot takes a moment to update)
  93. ' * Added MsgMutualError config entry which is copied to the user when they are not a mutual friend (requires the above)
  94. '
  95. ' * This release was coupled with a GDB reset and Blizzard also reset their ladder. If you experience any problem just turn GDB off temporarily.
  96. '
  97. '============================================================================================================================
  98. ' ChangeLog for 2.0.5 (id 20500)
  99. ' * Added dozens of debug messages
  100. ' * Added EagleEyes, a method to see what the bot sees that most users
  101. ' ignore in chat (works similar to .NET IDE's intellisense)
  102. ' * Added /bcp version command to check bot version and translations
  103. ' * Added /bcp eagleeyes [status] where [status] is "enable" or "disable"
  104. ' (no quotes): see above
  105. ' * Fixed the problem with users not being found (StealthBot scripts ignore
  106. ' scripting events with insufficient arguments, didn't realize that)
  107. ' * Open Characters (not ephemeral characters) are now treated as non-diablo players.
  108. '
  109. '============================================================================================================================
  110. ' ChangeLog for 2.0.4 (id 20400)
  111. ' * The plugin is now a StealthBot 2.7 script.
  112. ' * Added news module
  113. ' * Replaced the old BCP domain I used with the new .net domain
  114. '
  115. '============================================================================================================================
  116. ' ChangeLog for 2.0.3 (id 20300)
  117. ' * Added .top command
  118. ' * Added .career rank command (sub of career: .career rank)
  119. ' * Fixed profile updating
  120. ' * Added .getcareer <username> <command> command for getinfo compatability
  121. ' * Added a system of/for debug messages to help users diagnose problems
  122. ' * Minor typo fixes
  123. ' * This release includes a new translation system, old files will be outdated
  124. ' but fix themselves by auto-updating
  125. ' * Translations are now updated every 2 hours instead of 12.
  126. ' * MsgType config entry now accepts "True" and "False" and is reflective
  127. ' of True = "Repeat" and False = "Ask"; the old system is still in place
  128. ' $ The script still defaults MsgType to "Ask"
  129. ' * Properly adjusted the command system to use an "Else" operator on switch
  130. ' so that .career and .getcareer are the same as .myinfo and .getinfo
  131. ' * The mirror commands .myinfo and .getinfo are now defaulted in config
  132. ' * Added ProfileHead config entry; it's the Location section of the bot's
  133. ' profile when it updates it. It still includes the VID, however.
  134.  
  135. ' ________________
  136. '/
  137. ' HEY THERE
  138. '
  139. ' YEAH, YOU
  140. '
  141. ' THE ONE READING THE SCRIPT FILE
  142. '
  143. ' YOU'RE IN THE WRONG SPOT, BRO
  144. '
  145. ' CHECK OUT BCP_SETTINGS.INI TO CHANGE STUFF, NOT HERE
  146. '
  147. '\_________________
  148. '
  149. ' _______________
  150. '/ Quick Links
  151. '
  152. ' ==> Help Topics
  153. ' http://toshley.net/bcp/help.php
  154. '
  155. ' ==> GDB Explained
  156. ' http://toshley.net/bcp/help.php?view=GDB
  157. '
  158. ' ==> Forum
  159. ' http://toshley.net/forum/
  160. '
  161. '\________________
  162.  
  163.  
  164.  
  165. '%=================================%
  166. '% %
  167. '% do not edit below here %
  168. '% consult bcp_settings.ini %
  169. '% %
  170. '%=================================%
  171.  
  172. Public bcpFSO, bcpUsers
  173. Public bcpIC, bcpLastGameRequest
  174. Public bcpLastProfileUpdate
  175. Public bcpLastConnect, bcpMarkOffline
  176. Public bcpGDBTemp_Disable
  177.  
  178. Public bcpTmrSec, bcpTmrHr
  179. '// The internal channel contains a bcp_User object without run data to easily swap it.
  180.  
  181. '// Helpful constants
  182. Const bcp_game_DiabloII = "D2DV"
  183. Const bcp_game_DiabloIIExp = "D2XP"
  184.  
  185. Class bcp_User
  186. Public Username
  187. Public StatString
  188. Public Product
  189. Public Character
  190. Public CClass
  191. Public Title 'Slayer, etc
  192. Public Level 'Int
  193. Public InGame 'Bool
  194. Public GameObject 'bcp_Game
  195. Public Language
  196.  
  197. Public IsExpansion 'Bool
  198. Public IsLadder 'Bool
  199. Public IsHardcore 'Bool
  200.  
  201. Public Runs 'Int
  202. Public Time 'Int
  203. Public Fastest 'Int
  204. Public LastTime 'Int
  205. Public LastGameName
  206.  
  207. '// Personal
  208. Public HideGameDuration
  209. Public NameOverCharacter
  210. Public HideGDBGame
  211.  
  212. Public HideLogMsg
  213. Public LastLog
  214.  
  215. Public LastSeen
  216.  
  217. '// Temporary
  218. Public CareerResetCode
  219.  
  220. Sub EmptyGame()
  221. If Not InGame Then Exit Sub
  222. InGame = False
  223. LastTime = GameObject.Duration()
  224. LastGameName = GameObject.Name
  225. End Sub
  226.  
  227. Sub Parse()
  228. LastSeen = Now()
  229. 'Bot name differences, we have to make a system that agrees with both
  230. 'because Eric does not love me.
  231. '...
  232. '2.6: (Matriarch Swampie, a ladder level 90 sorceress on realm USEast).
  233. '2.7: (Champion Swampie, a level 90 ladder Sorceress on USEast).
  234.  
  235. If (Not Product = bcp_game_DiabloII) and (Not Product = bcp_game_DiabloIIExp) Then
  236. Character = Username
  237. CClass = "nonchar"
  238. Title = ""
  239. bcp_EagleMsg Username & " is not using Diablo II or Lord of Destruction (Product: " & Product & ")."
  240. Exit Sub
  241. End If
  242.  
  243. If InStr(LCase(StatString), "open character") > 0 Then
  244. If Len(Character) = 0 Then
  245. Character = Username
  246. CClass = "nonchar"
  247. Title = ""
  248. Level = 0
  249. bcp_EagleMsg Username & " is an open character, but no record of character found. (Product: " & Product & ")."
  250. Else
  251. bcp_EagleMsg Username & " is an open character, keeping user as """ & Character & """."
  252. End If
  253. Exit Sub
  254. End If
  255.  
  256. On Error Resume Next : Err.Clear
  257. If UBound(Split(StatString, " ")) < 4 Then Product = "INVALID" : Exit Sub
  258. StatString = Split(StatString, " (")(1)
  259. StatString = Left(StatString, Len(StatString)-1)
  260. partA = Split(Split(StatString, ", ")(0), " ")
  261. partS = Split(StatString, ", ")(1)
  262. partB = Split(Split(StatString, ", ")(1), " ")
  263.  
  264. If UBound(partA) = 1 Then
  265. Title = partA(0)
  266. Character = partA(1)
  267. Else
  268. Title = "Player"
  269. Character = partA(0)
  270. End If
  271.  
  272. p = Array("Paladin", "Barbarian", "Assassin", "Druid", "Amazon", "Necromancer", "Sorceress")
  273.  
  274. Level = Int(Split(Split(partS, " level ")(1), " ")(0))
  275. For i = 0 to UBound(p)
  276. If InStr(LCase(partS), LCase(" " & p(i) & " ")) > 0 Then
  277. CClass = p(i)
  278. Exit For
  279. End If
  280. Next
  281. CClass = LCase(CClass)
  282.  
  283. If InStr(StatString, " ladder ") Then
  284. IsLadder = True
  285. Else
  286. IsLadder = False
  287. End If
  288.  
  289. If InStr(StatString, " hardcore ") Then
  290. IsHardcore = True
  291. Else
  292. IsHardcore = False
  293. End If
  294.  
  295. If Product = "D2XP" Then
  296. IsExpansion = True
  297. Else
  298. IsExpansion = False
  299. End If
  300.  
  301. On Error GoTo 0
  302. If Err.Number <> 0 Then AddChat vbRed, "[BCP] StatString Parse error: " & StatString
  303. Err.Clear
  304. '// not the statstring, its what the bot "thinks" the statstring is (so it can be manipulated)
  305. '// this was the problem with the 2.0.4 conversion; some users use different versions with diff
  306. '// statstring values
  307. bcp_EagleMsg "User " & Username & " stats: " & Product & " # [H|" & IsHardcore & "][L|" & IsLadder & "] [" & Title & "] " & Character & ", a level " & Level & " " & CClass & "."
  308. End Sub
  309.  
  310. Function IsDiablo()
  311. If Product = bcp_game_DiabloII or Product = bcp_game_DiabloIIExp Then
  312. IsDiablo = True
  313. Else
  314. IsDiablo = False
  315. End If
  316. End Function
  317.  
  318. Function IsOpenCharacter()
  319. If Not IsDiablo() or Int(Level) = 0 Then
  320. IsOpenCharacter = True
  321. Else
  322. IsOpenCharacter = False
  323. End If
  324. End Function
  325.  
  326. Function FormatString(Message)
  327. m = Message
  328.  
  329. On Error Resume Next : Err.Clear
  330. a = Array("%user", "%name", "%char", "%class", "%lvl", _
  331. "%runid", "%total", "%avg", "%fst", "%title", _
  332. "%runs", "%gametime", "%game")
  333. b = Array(PreferedName(), Username, Character, CClass, Level, _
  334. Runs+1, bcp_FmtTime(Time), bcp_FmtTime(Average()), bcp_FmtTime(Fastest), Title, _
  335. Runs, bcp_FmtTime(GameObject.Duration()), GameObject.Name)
  336. On Error GoTo 0
  337. If Err.Number <> 0 Then AddChat vbRed, "[BCP] Format error " & Err.Number & ": " & Err.Description
  338.  
  339. For i = 0 to UBound(a)
  340. m = Replace(m, a(i), b(i))
  341. Next
  342.  
  343. FormatString = m
  344. End Function
  345.  
  346. Function GameTimeOK()
  347. If GameObject.Duration() < bcp_Get("main", "MinGame") or GameObject.Duration() > bcp_Get("main", "MaxGame") Then
  348. GameTimeOK = False
  349. Else
  350. GameTimeOK = True
  351. End If
  352. End Function
  353.  
  354. Sub Save()
  355. path = "bcp_users/" & LCase(Username) & ".user"
  356. If Runs = 0 Then
  357. If bcpFSO.FileExists(path) Then bcpFSO.DeleteFile(path)
  358. Exit Sub
  359. End If
  360.  
  361. WriteConfigEntry "UData", "Username", CStr(Username), path
  362. WriteConfigEntry "UData", "StatString", CStr(StatString), path
  363. WriteConfigEntry "UData", "Product", CStr(Product), path
  364. WriteConfigEntry "UData", "Level", CStr(Level), path
  365. WriteConfigEntry "UData", "Character", CStr(Character), path
  366. WriteConfigEntry "UData", "CClass", CStr(CClass), path
  367. WriteConfigEntry "UData", "Title", CStr(Title), path
  368. WriteConfigEntry "UData", "Runs", CStr(Runs), path
  369. WriteConfigEntry "UData", "Time", CStr(Time), path
  370. WriteConfigEntry "UData", "Fastest", CStr(Fastest), path
  371. WriteConfigEntry "UData", "LastTime", CStr(LastTime), path
  372. WriteConfigEntry "UData", "LastGameName", CStr(LastGameName), path
  373. WriteConfigEntry "UData", "Language", CStr(Language), path
  374. WriteConfigEntry "Personal", "HideGameDuration", CStr(HideGameDuration), path
  375. WriteConfigEntry "Personal", "NameOverCharacter", CStr(NameOverCharacter), path
  376. WriteConfigEntry "Personal", "HideGDBGame", CStr(HideGDBGame), path
  377. WriteConfigEntry "UType", "IsLadder", CStr(IsLadder), path
  378. WriteConfigEntry "UType", "IsHardcore", CStr(IsHardcore), path
  379. WriteConfigEntry "UType", "IsExpansion", CStr(IsExpansion), path
  380. End Sub
  381.  
  382. Sub GDB_Update(Status)
  383. DoGDB_Update Status, 0
  384. End Sub
  385.  
  386. Sub GDB_UpdateComp(Status, C)
  387. DoGDB_Update Status, C
  388. End Sub
  389.  
  390. Sub DoGDB_Update(Status, CompensateGame)
  391. If Runs = 0 Then Exit Sub
  392. Call Save()
  393. If bcp_Get("GDB", "username") = "" or bcp_Get("GDB", "disable") = True Then
  394. Exit Sub
  395. End If
  396.  
  397. If bcpGDBTemp_Disable Then
  398. AddChat vbYellow, "[BCP:GDB] The bot is temporarily not committing to the GDB. Update failed."
  399. Exit Sub
  400. End If
  401.  
  402. AddChat vbYellow, "[BCP:GDB] Updating " & Username & "..."
  403. i_Status = Status
  404. If HideGDBGame Then
  405. i_Status = ""
  406. AddChat vbYellow, "[BCP:GDB] Hiding " & Username & "'s game on the GDB."
  407. End If
  408.  
  409. islString = "0"
  410. If IsLadder Then islString = "1"
  411. ishString = "0"
  412. If IsHardcore Then ishString = "1"
  413.  
  414. WebString = Username & "|" & _
  415. Character & "|" & _
  416. Runs & "|" & _
  417. Average() & "|" & _
  418. "Realm|" & i_Status & "|" & _
  419. Level & "|" & _
  420. CClass & "|" & _
  421. Time & "|" & _
  422. Fastest & "|" & _
  423. islString & "|" & _
  424. ishString
  425.  
  426. uName = bcp_Get("GDB", "username")
  427. uPassword = bcp_Get("GDB", "password")
  428.  
  429. webURL = bcp_Get("GDB", "location") & "?u=" & uName & "&p=" & uPassword & "&item1=" & WebString
  430. On Error Resume Next : Err.Clear
  431. SciNet.Cancel
  432. t = Timer
  433. result = SciNet.OpenURL(CStr(webURL))
  434. t = Round(Timer-t, 2)
  435. If Not Err.Number = 0 Then
  436. AddChat vbRed, "[BCP] Note: Failed to update " & Username & " on the GDB."
  437. AddChat vbRed, Space(8) & Err.Number & ": " & Err.Description
  438.  
  439. If (Err.Number = 35761) and (Err.Description = "Request timed out") Then
  440. AddChat vbRed, "**************************************"
  441. AddChat vbRed, "[BCP] The GDB database is not responding, the bot will temporarily stop committing data to the GDB until it is reloaded."
  442. AddChat vbRed, "[BCP] It is possible the website is temporarily offline or updating, please try again in a few minutes."
  443. AddChat vbRed, "**************************************"
  444. If (bcp_Get("Main", "ShowDialogs")) Then Call MsgBox("The bot has temporarily turned off the GDB because it is unavailable.", 0, "BCP Warning")
  445. bcpGDBTemp_Disable = True
  446. End If
  447. Err.Clear
  448. Else
  449. m = Split(result, " ", 2)
  450. If Int(m(0)) = 1 Then
  451. AddChat vbGreen, "[BCP:GDB] Success: " & m(1) & " (" & t & "s)"
  452. ElseIf Int(m(0)) = 2 Then
  453. AddChat vbCyan, "[BCP:GDB] Update: There is an updated profile for " & Username & "."
  454. If (bcp_Get("Behavior", "UseNewestProfile")) Then
  455. newData = Split(m(1), "|")
  456. before = Runs
  457. Username = newData(0)
  458. Character = newData(1)
  459. Runs = Int(newData(2))
  460. 'Average
  461. 'Realm
  462. Status = newData(5)
  463. Level = Int(newData(6))
  464. CClass = newData(7)
  465. Time = Int(newData(8))
  466. Fastest = Int(newData(9))
  467. If CompensateGame > 0 Then
  468. timeBonus = CompensateGame
  469. Runs = Runs + 1
  470. Time = Time + timeBonus
  471. End If
  472. Call Save()
  473. AddChat vbCyan, "[BCP:GDB] " & Username & " (" & Character & ") now has " & Runs & " games (had " & before & "), with an average time of " & bcp_FmtTime(Int(Time / Runs)) & "."
  474. Else
  475. AddChat vbRed, "[BCP] Note: There is a new profile for " & Username & " but you have turned profile downloading off."
  476. End If
  477. Else
  478. AddChat vbRed, "[BCP:GDB] Failure (" & m(0) & "): " & m(1)
  479. End If
  480. End If
  481. On Error GoTo 0
  482. End Sub
  483.  
  484. Function Rank()
  485. Rank = 0
  486. bubble = bcp_RankBubble()
  487. For i = 1 to UBound(bubble)
  488. If LCase(bubble(i)) = LCase(Username) Then
  489. Rank = i
  490. Exit Function
  491. End If
  492. Next
  493. End Function
  494.  
  495. Function MutualFriend()
  496. MutualFriend = bcp_Mutual(Username)
  497. End Function
  498.  
  499. Function Friend()
  500. Friend = bcp_Friend(Username)
  501. End Function
  502.  
  503. Function Average()
  504. If Runs = 0 or Time = 0 Then Average = 0 : Exit Function
  505. Average = Int(Time / Runs)
  506. End Function
  507.  
  508. Function PreferedName()
  509. If NameOverCharacter Then
  510. PreferedName = Username
  511. Else
  512. PreferedName = Character
  513. End If
  514. End Function
  515.  
  516. Sub Class_Initialize()
  517. InGame = False
  518. Set GameObject = Nothing
  519. HideGameDuration = False
  520. NameOverCharacter = False
  521. HideGDBGame = False
  522. HideLogMsg = True
  523. Runs = 0
  524. Level = 0
  525. Time = 0
  526. Fastest = 0
  527. LastTime = 0
  528. LastGameName = "Incomplete"
  529. IsLadder = False : IsHardcore = False
  530. LastLog = DateAdd("s", -(bcp_Get("main", "MsgNoSpam")), Now())
  531. CareerResetCode = "~" & Chr(0) & Chr(2) '// Can't type those
  532. End Sub
  533. End Class
  534.  
  535. Sub bcp_PurgeList(LimitOf)
  536. For Each Key in bcpUsers.Keys
  537. With bcpUsers.Item(Key)
  538. If .Runs < LimitOf Then
  539. .Runs = 0
  540. .Time = 0
  541. .Fastest = 0
  542. .Save
  543. AddChat vbRed, "[BCP] Purge: " & .Username
  544. End If
  545. End With
  546. Next
  547. End Sub
  548.  
  549. Sub bcp_Folder()
  550. If Not bcpFSO.FolderExists(BotPath() & "bcp_users") Then
  551. bcpFSO.CreateFolder(BotPath() & "bcp_users")
  552. AddChat vbGreen, "[BCP] Users are stored in: {BOTPATH}/bcp_users as configuration files"
  553. End If
  554. End Sub
  555.  
  556. Class bcp_Game
  557. Public Name
  558. Public Host
  559. Public Started
  560.  
  561. Function Duration()
  562. Duration = Abs(DateDiff("s", Started, Now()))
  563. End Function
  564.  
  565. Sub Class_Initialize()
  566. Started = Now()
  567. End Sub
  568. End Class
  569.  
  570. Function bcp_Mutual(Username)
  571. bcp_Mutual = False
  572. For Each Friend in Friends
  573. If LCase(Friend.Name) = LCase(Username) Then
  574. If CBool(Friend.IsMutual) Then
  575. bcp_Mutual = True
  576. Exit For
  577. End If
  578. End If
  579. Next
  580. End Function
  581.  
  582. Function bcp_Friend(Username)
  583. bcp_Friend = False
  584. For Each Friend in Friends
  585. If LCase(Friend.Name) = LCase(Username) Then
  586. bcp_Friend = True
  587. End If
  588. Next
  589. End Function
  590.  
  591. Function bcp_FriendOnline(Username)
  592. bcp_FriendOnline = False
  593. For Each Friend in Friends
  594. If LCase(Friend.Name) = LCase(Username) Then
  595. If Friend.Status = 1 Then
  596. bcp_FriendOnline = True
  597. End If
  598. End If
  599. Next
  600. End Function
  601.  
  602. Function bcp_FixTranslation(Line)
  603.  
  604. bcp_FixTranslation = Line
  605. For i = 0 to 255
  606. bcp_FixTranslation = Replace(bcp_FixTranslation, "[" & i & "]", Chr(i))
  607. Next
  608. End Function
  609.  
  610. Function bcp_Translate(Text)
  611. If Not bcpFSO.FileExists(BotPath() & "bcp_translations.txt") Then Exit Function
  612. On Error Resume Next : Err.Clear
  613. Set file = bcpFSO.OpenTextFile(BotPath() & "bcp_translations.txt", 1)
  614. Q = Split(file.ReadAll(), vbCrLf)
  615. lang = "?"
  616. tVer = bcp_Get("Translations", "Version")
  617. phixd = Text
  618. bcp_DebugMsg "Translate: " & phixd
  619.  
  620. If tVer = 3 Then bcp_DebugMsg "Version 3 check..."
  621.  
  622. For i = 0 to UBound(Q)
  623. p = Split(Q(i), "|")
  624. If UBound(p) >= 2 Then
  625. Name = p(0)
  626. Game = p(1)
  627. OE = p(2)
  628. bcp_DebugMsg "Checking " & Name & "..."
  629. Else
  630. bcp_DebugMsg "Invalid translation: " & Join(p)
  631. End If
  632.  
  633. If tVer = 3 Then
  634. '// 3 and lower use padding
  635. Padding = Int(p(3))
  636.  
  637. If Match(Text, Game, True) Then
  638. lang = Name
  639. D = Split(Game, "*")
  640.  
  641. p_user = Split(Split(Text, D(0))(1), D(1))(0)
  642. p_prod = Split(Split(Text, D(1))(1), D(2))(0)
  643. p_gamename = Split(Text, D(2))(1)
  644. p_gamename = Left(p_gamename, Len(p_gamename)-1)
  645. If Padding > 0 Then p_gamename = Right(p_gamename, Len(p_gamename)-Padding)
  646. phixd = "Your friend " & p_user & " entered a " & p_prod & " game called " & p_gamename & "."
  647. End If
  648.  
  649. If Match(Text, OE, True) Then
  650. lang = Name
  651. D = Split(OE, "*")
  652.  
  653. p_user = Split(Split(Text, D(0))(1), D(1))(0)
  654. phixd = "Your friend " & p_user & " has exited Battle.net."
  655. End If
  656. ElseIf tVer > 3 Then
  657. '// >3 doesn't use padding, it uses char replace
  658. Game = bcp_FixTranslation(Game)
  659. OE = bcp_FixTranslation(OE)
  660. bcp_DebugMsg "Adjusted: " & Game
  661. bcp_DebugMsg "Adjusted: " & OE
  662. If Match(Text, Game, True) Then
  663. lang = Name
  664. D = Split(Game, "*")
  665.  
  666. p_user = Split(Split(Text, D(0))(1), D(1))(0)
  667. p_prod = Split(Split(Text, D(1))(1), D(2))(0)
  668. p_gamename = Split(Text, D(2))(1)
  669. p_gamename = Left(p_gamename, Len(p_gamename)-1)
  670.  
  671. phixd = "Your friend " & p_user & " entered a " & p_prod & " game called " & p_gamename & "."
  672. End If
  673.  
  674. If Match(Text, OE, True) Then
  675. lang = Name
  676. D = Split(OE, "*")
  677.  
  678. p_user = Split(Split(Text, D(0))(1), D(1))(0)
  679. phixd = "Your friend " & p_user & " has exited Battle.net."
  680. End If
  681. End If
  682. Next
  683. file.Close
  684. bcp_DebugMsg "Fixed from " & lang & " to English: " & phixd
  685. If Err.Number <> 0 Then
  686. AddChat vbRed, "[BCP] Translation error: " & Err.Description
  687. Err.Clear
  688. lang = "?"
  689. phixd = Text
  690. End If
  691.  
  692. bcp_Translate = Array(lang, phixd)
  693. On Error GoTo 0
  694. End Function
  695.  
  696. Sub bcp_CheckTranslationsCond()
  697. If DateDiff("s", CDate(bcp_Get("Translations", "LastUpdate")), Now()) > (60 * 60 * 2) or bcp_Get("Translations", "Version") = 0 Then
  698. bcp_CheckTranslations
  699. Else
  700. bcp_DebugMsg "Translations file #" & bcp_Get("Translations", "Version") & ", last updated " & bcp_Get("Translations", "LastUpdate") & "."
  701. End If
  702. End Sub
  703.  
  704. Sub bcp_CheckNews()
  705. AddChat vbYellow, "[BCP] Checking for recent BCP news..."
  706.  
  707. Call bcp_Set("News", "Location", CStr("http://toshley.net/bcp/news/"), False)
  708. newsUpdateLoc = bcp_Get("News", "Location")
  709. newsFile = newsUpdateLoc & "news_" & bcpVID & ".txt"
  710.  
  711. SciNet.Cancel
  712. On Error Resume Next : Err.Clear
  713. data = SciNet.OpenURL(CStr(newsfile))
  714. If Err.Number <> 0 or data = "" Then
  715. AddChat vbRed, "[BCP] An error occured checking for news."
  716. bcp_DebugMsg Err.Description
  717. Err.Clear
  718. Exit Sub
  719. End If
  720. On Error GoTo 0 : Err.Clear
  721.  
  722. If (InStr(data, "404 Not Found") > 0) Then
  723. AddChat vbRed, "[BCP] An error occured checking for news: item not found"
  724. bcp_DebugMsg "News download got 404ed"
  725. Err.Clear
  726. Exit Sub
  727. End If
  728.  
  729. part = Split(data, "||")
  730.  
  731. title = part(0)
  732. lines = Split(part(1), "\n")
  733.  
  734. AddChat vbWhite, " "
  735. AddChat vbWhite, " http://toshley.net/bcp/"
  736. AddChat vbGreen, " --- BCP News ---"
  737. AddChat vbCyan, " " & title
  738. For i = 0 to UBound(lines)
  739. AddChat vbWhite, " " & lines(i)
  740. Next
  741. AddChat vbWhite, " "
  742. End Sub
  743.  
  744. Sub bcp_CheckScriptVersion()
  745. scriptVer = bcpVID
  746. scriptLU = bcp_Get("Main", "ScriptLastUpdate")
  747. scriptUpdateLoc = bcp_Get("Main", "ScriptUpdateLoc")
  748.  
  749. Call bcp_Set("Main", "ScriptLastUpdate", CStr(Now()), True)
  750.  
  751. AddChat vbYellow, "[BCP] Checking for script updates..."
  752.  
  753. SciNet.Cancel
  754. On Error Resume Next : Err.Clear
  755. data = SciNet.OpenURL(CStr(scriptUpdateLoc & "?id=" & bcpVID))
  756. If Err.Number <> 0 or data = "" or InStr(data, "404 Not Found") > 0 Then
  757. AddChat vbRed, "[BCP] An error occured checking for script updates."
  758. bcp_DebugMsg Err.Description
  759. Err.Clear
  760. Exit Sub
  761. End If
  762.  
  763. On Error GoTo 0 : Err.Clear
  764.  
  765. serverVer = Int(Split(data, "#")(0))
  766. serverLoc = Split(data, "#")(1)
  767. serverMsg = Split(data, "#")(2)
  768. lines = Split(serverMsg, "//")
  769.  
  770. If serverVer = "ERROR" Then
  771. AddChat vbRed, "[BCP] An error occured getting the most recent version: " & serverMsg
  772. bcp_DebugMsg Err.Description
  773. Err.Clear
  774. Exit Sub
  775. End If
  776.  
  777. If Int(serverVer) > Int(bcpVID) Then
  778. AddChat vbRed, "[BCP] This current version of BCP is out of date. The server has BCP " & serverVer & " but you have BCP " & bcpVID & "."
  779. AddChat vbRed, "[BCP] It is recommended that you update at " & serverLoc & " ."
  780. If (serverMsg <> "") Then
  781. AddChat vbWhite, "[BCP] The updater has supplied the following information about the update:"
  782. For i = 0 to UBound(lines)
  783. AddChat vbWhite, " " & lines(i)
  784. Next
  785. End If
  786. If (bcp_Get("Main", "ShowDialogs")) Then Call MsgBox("There is a new version of the script available. Your bot window has more information for you.", 0, "BCP Warning")
  787. ElseIf Int(serverVer) < Int(bcpVID) Then
  788. AddChat vbRed, "[BCP] This current version of BCP is newer than the one on record. The server has BCP " & serverVer & " but you have BCP " & bcpVID & "."
  789. AddChat vbRed, "[BCP] You do not need to get the older version, however you may want to consider reading the changelog at " & serverLoc & " ."
  790. Else
  791. AddChat vbGreen, "[BCP] This version of up to date (vID " & bcpVID & ")."
  792. End If
  793. End Sub
  794.  
  795. Sub bcp_CheckTranslations()
  796. transVer = bcp_Get("Translations", "Version")
  797. transLU = bcp_Get("Translations", "LastUpdate")
  798. transUpdateLoc = bcp_Get("Translations", "GetVersion")
  799.  
  800. Call bcp_Set("Translations", "LastUpdate", CStr(Now()), True)
  801.  
  802. AddChat vbYellow, "[BCP] Checking for translation updates..."
  803.  
  804. SciNet.Cancel
  805. On Error Resume Next : Err.Clear
  806. data = SciNet.OpenURL(CStr(transUpdateLoc))
  807. If Err.Number <> 0 or data = "" Then
  808. AddChat vbRed, "[BCP] An error occured checking for translation updates."
  809. bcp_DebugMsg Err.Description
  810. Err.Clear
  811. Exit Sub
  812. End If
  813. On Error GoTo 0 : Err.Clear
  814.  
  815. serverVer = Int(Split(data, "#")(0))
  816. serverLoc = Split(data, "#")(1)
  817.  
  818. If serverVer <> transVer Then
  819. AddChat vbYellow, "[BCP] Your translations file is out of date. The script will download it now. Please allow any script control dialogs."
  820. AddChat vbYellow, "[BCP] Source of document (you have " & transVer & ") (server has " & serverVer & "): " & serverLoc
  821.  
  822. If bcpFSO.FileExists(BotPath() & "bcp_translations.txt") Then
  823. bcpFSO.DeleteFile(BotPath() & "bcp_translations.txt")
  824. End If
  825.  
  826. t = Timer
  827. SSC.PrintURLToFile "bcp_translations.txt", CStr(serverLoc)
  828. t = Round( Timer-t, 2)
  829. Call bcp_Set("Translations", "Version", CStr(serverVer), True)
  830. AddChat vbGreen, "[BCP] Download complete. Your translations are now up-to-date (" & t & "s.)"
  831. If (bcp_Get("Main", "ShowDialogs")) Then Call MsgBox("Your bot has downloaded a new translations file.", 0, "BCP Warning")
  832. Else
  833. AddChat vbGreen, "[BCP] Your translations file is up to date (" & transVer & ")."
  834. End If
  835. End Sub
  836.  
  837. Sub bcp_GDBStatus(Status)
  838. If bcp_Get("GDB", "username") = "" or bcp_Get("GDB", "disable") = True Then
  839. Exit Sub
  840. End If
  841.  
  842. If bcpGDBTemp_Disable Then
  843. AddChat vbYellow, "[BCP:GDB] The bot is temporarily not committing to the GDB. Update failed."
  844. Exit Sub
  845. End If
  846.  
  847. AddChat vbYellow, "[BCP:GDB] Updating bot status..."
  848.  
  849. uName = bcp_Get("GDB", "username")
  850. uPassword = bcp_Get("GDB", "password")
  851.  
  852. webURL = bcp_Get("GDB", "location") & "?u=" & uName & "&p=" & uPassword & "&setstatus=" & Replace(Status, " ", "+")
  853. On Error Resume Next : Err.Clear
  854. SciNet.Cancel
  855. t = Timer
  856. result = SciNet.OpenURL(CStr(webURL))
  857. t = Round(Timer-t, 2)
  858. If Not Err.Number = 0 Then
  859. AddChat vbRed, "[BCP] Note: Failed to update " & Username & " on the GDB."
  860. AddChat vbRed, Space(8) & Err.Number & ": " & Err.Description
  861.  
  862. If (Err.Number = 35761) and (Err.Description = "Request timed out") Then
  863. AddChat vbRed, "**************************************"
  864. AddChat vbRed, "[BCP] The GDB database is not responding, the bot will temporarily stop committing data to the GDB until it is reloaded."
  865. AddChat vbRed, "[BCP] It is possible the website is temporarily offline or updating, please try again in a few minutes."
  866. AddChat vbRed, "**************************************"
  867. bcpGDBTemp_Disable = True
  868. End If
  869.  
  870. Err.Clear
  871. Else
  872. m = Split(result, " ", 2)
  873. If Int(m(0)) = 1 Then
  874. AddChat vbGreen, "[BCP:GDB] Success: " & m(1) & " (" & t & "s)"
  875. Else
  876. AddChat vbRed, "[BCP:GDB] Failure (" & m(0) & "): " & m(1) & " (Username: " & uName & ")"
  877. End If
  878. End If
  879. On Error GoTo 0
  880. End Sub
  881.  
  882. Function bcp_TopX(n)
  883. bcp_TopX = ""
  884. bubble = bcp_RankBubble()
  885. If (UBound(bubble) = 0) Then Exit Function
  886. If UBound(bubble) < n Then
  887. t = UBound(bubble)
  888. Else
  889. t = n
  890. End If
  891.  
  892. For i = 1 to t
  893. If bcpUsers.Exists(bubble(i)) Then
  894. bcp_TopX = bcp_TopX & bubble(i) & " (" & bcpUsers.Item(bubble(i)).Runs & "), "
  895. End If
  896. Next
  897.  
  898. If bcp_TopX <> "" Then
  899. bcp_TopX = Left(bcp_TopX, Len(bcp_TopX) - 2)
  900. End If
  901. End Function
  902.  
  903. Function bcp_RankBubble()
  904. Dim b()
  905. Sandbox = Split(Join(bcpUsers.Keys, chr(0)), chr(0))
  906. For i = 0 to UBound(Sandbox)
  907. Sandbox(i) = Sandbox(i) & "|" & bcpUsers.Item(Sandbox(i)).Runs
  908. Next
  909. Total = bcpUsers.Count
  910. ReDim b(Total)
  911. g = 0
  912. k = "?"
  913. n = 0
  914.  
  915. For i = 1 to Total
  916. For x = 0 to UBound(Sandbox)
  917. If Sandbox(x) <> "" Then
  918. q = Split(Sandbox(x), "|")
  919. If Int(q(1)) > g Then
  920. k = q(0)
  921. g = Int(q(1))
  922. n = x
  923. End If
  924. End If
  925. Next
  926. Sandbox(n) = ""
  927.  
  928. b(i) = k
  929. g = 0
  930. Next
  931. bcp_RankBubble = b
  932. End Function
  933.  
  934. Function bcp_FmtTime(Seconds)
  935. If Int(Seconds) < 60 Then bcp_FmtTime = Seconds & "s" : Exit Function
  936. s = Int(Seconds) : m = 0 : h = 0
  937. While s >= 60
  938. s = s - 60
  939. m = m + 1
  940. If m = 60 Then m = 0 : h = h + 1
  941. WEnd
  942. If h > 0 Then ret = ret & h & " hours, "
  943. If m > 0 Then ret = ret & m & " minutes, "
  944. If s > 0 Then ret = ret & s & " seconds, "
  945. bcp_FmtTime = Left(ret, Len(ret)-2)
  946. End Function
  947.  
  948. Function bcp_FmtGameList()
  949. fmtA = bcp_Get("Messages", "GameReturn") & " "
  950. fmtB = bcp_Get("Messages", "GameDelimeter") & " "
  951.  
  952. smt = bcp_Get("Messages", "GamePretext") & " "
  953. games = 0
  954. For Each Key in bcpUsers.Keys
  955. With bcpUsers.Item(Key)
  956. If .InGame Then
  957. games = games + 1
  958. smt = smt & .FormatString(fmtA) & fmtB
  959. End If
  960. End With
  961. Next
  962. If games > 0 Then
  963. smt = Replace(Left(smt, Len(smt)-Len(fmtB)), "%i", games)
  964. Else
  965. smt = bcp_Get("Messages", "NoGames")
  966. End If
  967.  
  968. bcp_FmtGameList = smt
  969. End Function
  970.  
  971. Sub bcp_Set(Section, Key, Value, Overwrite)
  972. If bcp_Get(Section, Key) <> "" and Overwrite = False Then
  973. Exit Sub
  974. Else
  975. ssc.WriteConfigEntry Section, Key, CStr(Value), "bcp_settings.ini"
  976. bcp_DebugMsg "[BCP] Created config entry for " & Key & "."
  977. Exit Sub
  978. End If
  979. ssc.WriteConfigEntry Section, Key, CStr(Value), "bcp_settings.ini"
  980. End Sub
  981.  
  982. Function bcp_Get(Section, Key)
  983. bcp_Get = ssc.GetConfigEntry(Section, Key, "bcp_settings.ini")
  984. If bcp_Get = "True" or bcp_Get = "False" Then bcp_Get = CBool(bcp_Get)
  985. if IsNumeric(bcp_Get) Then bcp_Get = Int(bcp_Get)
  986. End Function
  987.  
  988. Sub bcp_ReadAll()
  989. On Error Resume Next
  990. Set contents = bcpFSO.GetFolder(BotPath & "bcp_users")
  991. For Each file In contents.Files
  992. nameArr = Split(file, "\")
  993. name = "bcp_users/" & nameArr(UBound(nameArr))
  994. Set nameArr = Nothing
  995. If Len(name) > 6 Then
  996. If Right(name, 5) = ".user" Then
  997. Username = GetConfigEntry("UData", "Username", name)
  998. If Not bcpUsers.Exists(Username) and Len(Username) > 3 and Len(Username) < 32 Then
  999. bcpUsers.Add Username, new bcp_User
  1000. Err.Clear
  1001. With bcpUsers.Item(Username)
  1002. '...
  1003. .Username = Username
  1004. .StatString = GetConfigEntry("UData", "StatString", name)
  1005. .Product = GetConfigEntry("UData", "Product", name)
  1006. .Character = GetConfigEntry("UData", "Character", name)
  1007. .CClass = GetConfigEntry("UData", "CClass", name)
  1008. .Title = GetConfigEntry("UData", "Title", name)
  1009. .Level = Int(GetConfigEntry("UData", "Level", name))
  1010. .Runs = Int(GetConfigEntry("UData", "Runs", name))
  1011. .Time = Int(GetConfigEntry("UData", "Time", name))
  1012. .Fastest = Int(GetConfigEntry("UData", "Fastest", name))
  1013. .LastTime = Int(GetConfigEntry("UData", "LastTime", name))
  1014. .LastGameName = GetConfigEntry("UData", "LastGameName", name)
  1015. .Language = GetConfigEntry("UData", "Language", name)
  1016. .HideGameDuration = CBool(GetConfigEntry("Personal", "HideGameDuration", name))
  1017. .NameOverCharacter = CBool(GetConfigEntry("Personal", "NameOverCharacter", name))
  1018. .HideGDBGame = CBool(GetConfigEntry("Personal", "HideGDBGame", name))
  1019. .IsLadder = CBool(GetConfigEntry("UType", "IsLadder", name))
  1020. .IsExpansion = CBool(GetConfigEntry("UType", "IsExpansion", name))
  1021. .IsHardcore = CBool(GetConfigEntry("UType", "IsHardcore", name))
  1022. '...
  1023.  
  1024.  
  1025.  
  1026. If Err.Number = 0 Then
  1027. Else
  1028. If Err.Number = 5 or Err.Number = 13 Then
  1029. AddChat vbRed, "[BCP] It is possible " & Username & "'s profile needs to be updated. It should function correctly, however."
  1030. Else
  1031. AddChat vbRed, "[BCP] Error: " & Err.Number & ": " & Err.Description
  1032. End If
  1033. Err.Clear
  1034. End If
  1035. End With
  1036. End If
  1037. End If
  1038. End If
  1039. Next
  1040. On Error GoTo 0
  1041. End Sub
  1042.  
  1043. Sub bcp_SaveAll()
  1044. For Each Key in bcpUsers.Keys
  1045. bcpUsers.Item(Key).Save()
  1046. Next
  1047. AddChat vbGreen, "[BCP] All users saved."
  1048. End Sub
  1049.  
  1050. Function bcp_ConcVersion()
  1051. bcp_ConcVersion = Script("Major") & "." & Script("Revision") & "." & Script("Minor")
  1052. End Function
  1053.  
  1054. Sub bcp_Startup()
  1055. AddChat vbCyan, "[BCP] Starting up... please wait"
  1056. t = Timer
  1057. Set bcpFSO = CreateObject("Scripting.FileSystemObject")
  1058. Set bcpUsers = CreateObject("Scripting.Dictionary")
  1059. Set bcpIC = CreateObject("Scripting.Dictionary")
  1060.  
  1061. bcpIC.CompareMode = 1
  1062. bcpUsers.CompareMode = 1
  1063. bcpMarkOffline = False
  1064. bcpGDBTemp_Disable = False
  1065.  
  1066. '// 2.0
  1067.  
  1068. bcp_Set "Debug", "enable", "False", False
  1069.  
  1070. bcp_DebugMsg "Dictionaries loaded, creating configuration..."
  1071.  
  1072. bcp_Set "Main", "FirstRun", "True", False
  1073. bcp_Set "Main", "Filter", "baal|chaos", False
  1074. bcp_Set "Main", "MinGame", "60", False
  1075. bcp_Set "Main", "MaxGame", "250", False
  1076. bcp_Set "Main", "MinLvl", "80", False
  1077. bcp_Set "Main", "MinPing", "-1", False
  1078. bcp_Set "Main", "MsgType", "Ask", False 'Ask,Repeat
  1079. bcp_Set "Main", "MsgNoSpam", "10", False
  1080. bcp_Set "Main", "MsgDelay", "60", False
  1081. bcp_Set "Main", "AllowLadder", "True", False
  1082. bcp_Set "Main", "AllowNonLadder", "True", False
  1083. bcp_Set "Main", "AllowHardcore", "True", False
  1084.  
  1085. bcp_Set "Commands", "games", "0", False
  1086. bcp_Set "Commands", "login", "20", False
  1087. bcp_Set "Commands", "logout", "20", False
  1088. bcp_Set "Commands", "forcelogout", "60", False
  1089. bcp_Set "Commands", "forcelogin", "60", False
  1090. bcp_Set "Commands", "pref", "0", False
  1091. bcp_Set "Commands", "career", "0", False
  1092.  
  1093. bcp_Set "Aliases", "baal", "games", False
  1094. bcp_Set "Aliases", "chaos", "games", False
  1095.  
  1096. bcp_set "GDB", "username", "", False
  1097. bcp_set "GDB", "password", "", False
  1098. bcp_set "GDB", "location", "", False
  1099.  
  1100. '// 2.0 (1)
  1101.  
  1102. bcp_Set "Main", "ProfileUpdate", "3", False
  1103.  
  1104. bcp_Set "Behavior", "LogoutInvalidFilter", "False", False
  1105. bcp_Set "Behavior", "LogoutOnExit", "True", False
  1106. bcp_Set "Behavior", "SaveOnExit", "True", False
  1107.  
  1108. bcp_Set "CRS", "Enable", "True", False
  1109.  
  1110. bcp_Set "Messages", "GameReturn", "[ %game by %user ]", False
  1111. bcp_Set "Messages", "GameDelimeter", ",", False
  1112. bcp_Set "Messages", "NoGames", "/me : No games available.", False
  1113. bcp_Set "Messages", "GamePretext", "/me : %i Games:", False
  1114. bcp_Set "Messages", "NewGame", "/me : New game %game started by %user (level %lvl %class (run #%runid.))", False
  1115.  
  1116. '// 2.0 (2)
  1117.  
  1118. bcp_Set "Behavior", "LogoutOnPiggy", "True", False
  1119. bcp_Set "Commands", "bcpfind", "20", False
  1120. bcp_Set "Commands", "bcpeval", "20", False
  1121. bcp_Set "Commands", "bcpfastest", "20", False
  1122. bcp_Set "Translations", "Version", "0.0", False
  1123. bcp_Set "Translations", "LastUpdate", CStr( DateAdd("s", -(60 * 60 * 24), Now()) ), False
  1124. bcp_Set "Translations", "GetVersion", "http://toshley.net/bcp/downloads/translations/getcurrentversion.php", False
  1125.  
  1126. '// 2.0 (3)
  1127. bcp_Set "Commands", "top", "0", False
  1128. bcp_Set "Commands", "getcareer", "0", False
  1129. bcp_Set "Aliases", "myinfo", "career", False
  1130. bcp_Set "Aliases", "getinfo", "getcareer", False
  1131. bcp_Set "Main", "ProfileHead", "http://toshley.net/bcp", False
  1132.  
  1133. '// 2.0 (4)
  1134. '// nothing added in 2.0.4
  1135.  
  1136. '// 2.0 (5)
  1137. bcp_Set "Debug", "EagleEyes", "False", False
  1138.  
  1139. '// 2.0 (6)
  1140. bcp_Set "Main", "BCPEnabled", "True", False
  1141. bcp_Set "Main", "ScriptLastUpdate", CStr( DateAdd("s", -(60 * 60 * 24), Now()) ), False
  1142. bcp_Set "Main", "ScriptUpdateLoc", "http://toshley.net/bcp/downloads/getcurrentversion.php", False
  1143. 'bcp_Set "Main", "MsgMutualError", "Note: You are not on the bot's friends list, please add " & BotVars.Username & " to friends before running or you will be logged out.", False
  1144. bcp_Set "Behavior", "LogoutOnNoMutual", "10", False
  1145. bcp_Set "Behavior", "LogoutOnOffline", "True", False
  1146. bcp_Set "Main", "ShowDialogs", "False", False
  1147. bcp_Set "Behavior", "UseNewestProfile", "True", False
  1148. bcp_Set "Translations", "GermanLanguageSupport", "True", False
  1149. bcp_Set "Behavior", "AutoLock", "False", False
  1150.  
  1151. bcp_DebugMsg "Configuration loaded, loading profiles..."
  1152.  
  1153. bcp_Folder
  1154. bcp_ReadAll
  1155.  
  1156. bcpTmrSec = 0 : bcpTmrHr = 0
  1157.  
  1158. bcp_DebugMsg "Profiles loaded, creating timers and setting dates..."
  1159.  
  1160. '// Old timer creation scheme
  1161. 'TimerInterval "bcp", "second", 1
  1162. 'TimerInterval "bcp", "hour", 3600
  1163.  
  1164. 'TimerEnabled "bcp", "second", True
  1165. 'TimerEnabled "bcp", "hour", True
  1166.  
  1167. '// The new stuff (2.0.4)
  1168. CreateObj "LongTimer", "LTsecond"
  1169. CreateObj "LongTimer", "LThour"
  1170.  
  1171. With LTsecond
  1172. .Interval = 1
  1173. .Enabled = True
  1174. End With
  1175.  
  1176. With LThour
  1177. .Interval = 3600
  1178. .Enabled = True
  1179. End With
  1180. '// ...
  1181.  
  1182. bcpLastProfileUpdate = Now()
  1183. bcpLastGameRequest = Now()
  1184. bcpLastConnect = Now()
  1185.  
  1186. bcp_DebugMsg "Loading completed, finalizing and checking translations..."
  1187.  
  1188. If bcp_Get("main", "firstrun") = True Then
  1189. AddChat vbGreen, "[BCP] Welcome to BCP " & bcp_ConcVersion() & " by vi[r]us (IAreConnection) [" & bcpVID & "]."
  1190. AddChat vbOrange, "[BCP] If you are running BCP for the first time, please take the time to run the setup help -- type ""/bcp setup"" (no quotes) in your bot to begin."
  1191. AddChat vbYellow, "[BCP] For more advanced users reinstalling, don't forget to edit bcp_settings.ini to your liking. It is located in the bot's main folder (Settings->Edit Files->Open Bot Folder.)"
  1192. AddChat vbYellow, "[BCP] Note: You may want check for updates over time at: http://toshley.net/bcp"
  1193. AddChat vbYellow, "[BCP] Thank you for using BCP. As of 2.0.6 most of this jazz is automated, so just hang in there!"
  1194. AddChat vbCyan, "[BCP] Note: You will also need to reset any GDB usernames, locations and passwords."
  1195. bcp_Set "main", "firstrun", False, True
  1196. Else
  1197. t = Round(Timer-t, 2)
  1198. 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"" (no quotes) to disable mass-save on exit. The command is case sensative."
  1199. AddChat vbCyan, "[BCP] BCP " & bcp_ConcVersion() & " by vi[r]us (on StealthBot: IAreConnection): Loaded " & bcpUsers.Count & " profiles. (" & t & "ms) visit http://toshley.net/bcp for frequent questions or support"
  1200. End If
  1201.  
  1202. '// updates
  1203. bcp_CheckTranslationsCond
  1204. bcp_CheckNews
  1205. bcp_CheckScriptVersion
  1206.  
  1207. If bcp_Get("Behavior", "AutoLock") = True Then
  1208. AddChat vbRed, "[BCP] You have chosen to have BCP lock your bot window. To turn this off go into BCP's config and set AutoLock to ""False"" under Behavior."
  1209. Command BotVars.Username, "/locktext", True
  1210. End If
  1211.  
  1212. End Sub
  1213.  
  1214. Sub LThour_Timer()
  1215. bcp_CheckTranslationsCond
  1216. End Sub
  1217.  
  1218. Sub LTsecond_Timer()
  1219. 'On Error Resume Next : Err.Clear
  1220.  
  1221. If Not IsOnline and bcpMarkOffline Then
  1222. bcpMarkOffline = False
  1223. bcp_GDBStatus "Offline"
  1224. End If
  1225.  
  1226. logoutNMdelay = bcp_Get("Behavior", "LogoutOnNoMutual")
  1227. For Each Key in bcpUsers.Keys
  1228. With bcpUsers.Item(Key)
  1229. If CBool(.InGame) Then
  1230. If .GameObject.Duration() > (bcp_Get("main", "MaxGame") * 1.5) Then
  1231. .InGame = False
  1232. AddChat vbRed, "[BCP] " & .Username & "'s game has taken too long. Removing."
  1233. .GDB_Update("")
  1234. End If
  1235. End If
  1236.  
  1237. If logoutNMdelay > 1 Then
  1238. If (Abs(DateDiff("s", .LastLog, Now())) > logoutNMdelay) AND .MutualFriend() AND .Friend() Then
  1239. 'AddChat vbRed, "[BCP] " & .Username & " has been logged in for more than " & logoutNMdelay & " minutes but has not added this bot. Removing."
  1240. 'AddQ "/f r " & psD2 & .Username
  1241. End If
  1242. End If
  1243.  
  1244. If Not IsOnline or (Abs(DateDiff("s", bcpLastConnect, Now())) < 60) Then
  1245. '// don't check
  1246. Else
  1247. If bcp_Get("Behavior", "LogoutOnOffline") Then
  1248. If Not bcp_FriendOnline(.Username) and .Friend() Then
  1249. AddChat vbRed, "[BCP] " & .Username & " is offline. Removing."
  1250. AddQ "/f r " & psD2 & .Username
  1251. End If
  1252. End If
  1253. End If
  1254. End With
  1255. Next
  1256.  
  1257. 'Err.Clear : On Error GoTo 0
  1258.  
  1259. '// BCP_ENABLED_CHECK
  1260. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1261.  
  1262. If Not IsOnline or (Abs(DateDiff("s", bcpLastConnect, Now())) < 60) Then
  1263. 'AddChat vbRed, "[BCP] The bot is not online or has just connected. Refraining from messages/profile."
  1264. Exit Sub
  1265. End If
  1266.  
  1267. If LCase(bcp_Get("main", "MsgType")) = "repeat" or (bcp_Get("main", "MsgType") = True) Then
  1268. bcpTmrSec = bcpTmrSec + 1
  1269. If bcpTmrSec >= bcp_Get("main", "msgdelay") Then
  1270. bcpTmrSec = 0
  1271. AddQ bcp_FmtGameList()
  1272. End If
  1273. End If
  1274.  
  1275. On Error Resume Next : Err.Clear
  1276.  
  1277. x = Int(bcp_Get("Main", "ProfileUpdate"))
  1278. If x >= 1 Then
  1279. If Int(DateDiff("s", bcpLastProfileUpdate, Now())) > (x * 60) Then
  1280. bcpLastProfileUpdate = Now()
  1281. bodyOf = MyChannel & " Top Runners: " & vbCrLf
  1282. data = Join(Split(bcp_TopX(5), ", "), vbCrLf)
  1283. bodyOf = bodyOf & data
  1284. SetBotProfile "", "[BCP " & bcp_ConcVersion() & "." & bcpVID & "] " & bcp_Get("Main", "ProfileHead"), bodyOf
  1285. bcp_DebugMsg "Profile updated."
  1286. End If
  1287. End If
  1288.  
  1289. Err.Clear : On Error GoTo 0
  1290. End Sub
  1291.  
  1292. Sub Event_Load()
  1293. bcp_Startup
  1294. End Sub
  1295.  
  1296. Sub Event_LoggedOn(Username, Product)
  1297. bcpLastConnect = Now()
  1298. bcpMarkOffline = True
  1299. bcpGDBTemp_Disable = False
  1300. bcp_GDBStatus "Online as " & Username
  1301. bcp_DebugMsg "Set online status: " & Username
  1302. End Sub
  1303.  
  1304. Sub Event_ServerInfo(Message)
  1305. '// BCP_ENABLED_CHECK (blue messages)
  1306. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1307.  
  1308. parts = Split(Message, " ")
  1309. If InStr(Message, " your friends list.") > 0 Then
  1310. If bcpIC.Exists(parts(1)) Then
  1311. If bcpIC.Item(parts(1)).HideLogMsg Then
  1312. bcpIC.Item(parts(1)).HideLogMsg = False
  1313. AddChat vbYellow, "[BCP] Friends list action recognized; bot requested script to ignore it"
  1314. Exit Sub
  1315. End If
  1316. Else
  1317. AddChat vbRed, "[BCP] Friends list action recognized; this message is not used by the script right now"
  1318. Exit Sub
  1319. End If
  1320.  
  1321. If parts(0) = "Added" Then
  1322. If (bcp_Get("Main", "MsgMutualError") <> "") Then
  1323. MutualError = bcp_Get("Main", "MsgMutualError")
  1324. End If
  1325. completeMsg = "You have been logged IN."
  1326. 'If Not bcp_Mutual(parts(1)) Then completeMsg = completeMsg & " " & MutualError
  1327. AddQ "/w " & psD2 & parts(1) & " " & completeMsg
  1328. bcp_DebugMsg "User " & parts(1) & " log action: entry result: success"
  1329. ElseIf parts(0) = "Removed" Then
  1330. msg = "You have been logged OUT."
  1331. If bcpUsers.Exists(parts(1)) Then
  1332. With bcpUsers.Item(parts(1))
  1333. If .Runs > 1 Then msg = "You have been logged OUT. You have completed " & .Runs & " games at roughly " & bcp_FmtTime(.Average()) & " (" & .Average() & " seconds) per game."
  1334. End With
  1335. End If
  1336.  
  1337. AddQ "/w " & psD2 & parts(1) & " " & msg
  1338. bcp_DebugMsg "User " & parts(1) & " log action: removal result: success"
  1339. End If
  1340. End If
  1341. End Sub
  1342.  
  1343. Sub Event_ServerError(Message)
  1344. '// BCP_ENABLED_CHECK (red messages)
  1345. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1346.  
  1347. parts = Split(Message, " ")
  1348. 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
  1349. AddQ "BCP Error: There is no more room on my friends list"
  1350. bcp_DebugMsg "User " & parts(1) & " log action: entry result: error: friends list is full"
  1351. End If
  1352.  
  1353. If InStr(Message, " is already in your friends list.") Then
  1354. If bcpIC.Exists(parts(0)) Then
  1355. If bcpIC.Item(parts(0)).HideLogMsg Then
  1356. bcpIC.Item(parts(0)).HideLogMsg = False
  1357. AddChat vbYellow, "[BCP] Friends list action recognized; bot requested script to ignore it"
  1358. Exit Sub
  1359. End If
  1360. Else
  1361. AddChat vbRed, "[BCP] Friends list action recognized; this message is not used by the script right now"
  1362. Exit Sub
  1363. End If
  1364.  
  1365. AddQ "/w " & psD2 & parts(0) & " You are already logged IN."
  1366. bcp_DebugMsg "User " & parts(1) & " log action: entry result: error: user is already logged in"
  1367. End If
  1368. End Sub
  1369.  
  1370. Sub Event_UserTalk(Username, Flags, Message, Ping)
  1371.  
  1372. '// BCP_ENABLED_CHECK (talk)
  1373. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1374.  
  1375. '// Blank command w/ just trigger
  1376. If LCase(Message) = LCase(BotVars.Trigger) Then Exit Sub
  1377.  
  1378. b = BotVars.Trigger
  1379. If Left(Message, Len(b)) = b Then
  1380. cmd = Split(Mid(Message, Len(b)+1), " ")
  1381. Else
  1382. Exit Sub
  1383. End If
  1384.  
  1385. If bcp_Get("aliases", LCase(cmd(0))) <> "" Then
  1386. newcmd = bcp_Get("aliases", LCase(cmd(0)))
  1387. AddChat vbCyan, "[BCP] Command alias recognized: changes """ & cmd(0) & """ to """ & newcmd & """"
  1388. cmd(0) = newcmd
  1389. End If
  1390.  
  1391. If bcp_Get("commands", LCase(cmd(0))) <> "" Then
  1392. cmdA = Int(bcp_Get("commands", LCase(cmd(0))))
  1393. If (a < cmdA) and (Not cmdA = 0) Then
  1394. AddChat vbRed, "[BCP] Error: " & Username & " does not have enough bot access to do command """ & BotVars.Trigger & LCase(cmd(0)) & """; requires " & cmdA & " access"
  1395. bcp_DebugMsg "User " & Username & " log action: command result: failure: does not have required " & cmdA & " access to do '" & cmd(0) & "'; has " & a
  1396. Exit Sub
  1397. End If
  1398. Else
  1399. Exit Sub
  1400. End If
  1401.  
  1402. If Not bcpIC.Exists(Username) Then
  1403. AddChat vbRed, "[BCP] Error: The bot has not seen " & Username & " before in the channel... they should rejoin"
  1404. bcp_DebugMsg "User " & Username & " log action: precommand result: failure: user doesn't exist in internal channel database"
  1405. Exit Sub
  1406. End If
  1407.  
  1408. On Error Resume Next : Err.Clear
  1409.  
  1410. Select Case LCase(cmd(0))
  1411. Case "games"
  1412. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1413. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1414. End If
  1415.  
  1416. If Not LCase(bcp_Get("main", "MsgType")) = "ask" or (bcp_Get("main", "MsgType") = False) Then
  1417. AddChat vbRed, "[BCP] The bot refused to tell a user the games list; games are displayed periodically instead"
  1418. bcp_DebugMsg "User " & Username & " log action: command result: failure: cannot show games when host requests periodic display"
  1419. Exit Sub
  1420. Else
  1421. If Abs(DateDiff("s", bcpLastGameRequest, Now())) < bcp_Get("main", "MsgNoSpam") Then
  1422. AddChat vbRed, "[BCP] Waiting until cooldown expires to display games by command."
  1423. bcp_DebugMsg "User " & Username & " log action: command result: failure: command fizzled"
  1424. Exit Sub
  1425. End If
  1426. AddQ bcp_FmtGameList()
  1427. bcpLastGameRequest = Now()
  1428. End If
  1429. Case "login"
  1430. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1431. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1432. End If
  1433.  
  1434. If DateDiff("s", bcpIC.Item(Username).LastLog, Now()) < bcp_Get("main", "MsgNoSpam") Then
  1435. AddChat vbRed, "[BCP] The command user cannot login now, they need to wait " & (bcp_Get("main", "MsgNoSpam") - Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now()))) & " seconds!"
  1436. bcp_DebugMsg "User " & Username & " log action: entry result: failure: user cannot be added if they have logged out less than " & bcp_Get("main", "MsgNoSpam") & "s (MsgNoSpam) ago"
  1437. Exit Sub
  1438. End If
  1439.  
  1440. bcpIC.Item(Username).LastLog = Now()
  1441. If (Ping > bcp_Get("main", "MinPing")) and (bcp_Get("main", "MinPing") <> -1) Then
  1442. AddQ "/w " & psD2 & Username & " You must have a ping lower than " & bcp_Get("main", "MinPing") & " to login."
  1443. bcp_DebugMsg "User " & Username & " log action: entry result: failure: user cannot be added if ping lower than " & bcp_Get("main", "MinPing") & "ms (MinPing)"
  1444. Exit Sub
  1445. End If
  1446.  
  1447. If (Not bcp_Get("main", "AllowHardcore")) and (bcpIC.Item(Username).IsHardcore) Then
  1448. AddQ "/w " & psD2 & Username & " Hardcore characters are not permitted to login."
  1449. bcp_DebugMsg "User " & Username & " log action: entry result: failure: hardcore characters are not allowed by host"
  1450. Exit Sub
  1451. End If
  1452.  
  1453. If (Not bcp_Get("main", "AllowNonLadder")) and (Not bcpIC.Item(Username).IsLadder) Then
  1454. AddQ "/w " & psD2 & Username & " Non-ladder characters are not permitted to login."
  1455. bcp_DebugMsg "User " & Username & " log action: entry result: failure: non-ladder characters are not allowed by host"
  1456. Exit Sub
  1457. End If
  1458.  
  1459. If (Not bcp_Get("main", "AllowLadder")) and (bcpIC.Item(Username).IsLadder) Then
  1460. AddQ "/w " & psD2 & Username & " Ladder characters are not permitted to login."
  1461. bcp_DebugMsg "User " & Username & " log action: entry result: failure: ladder characters are not allowed by host"
  1462. Exit Sub
  1463. End If
  1464.  
  1465. If bcpIC.Item(Username).Level < bcp_Get("main", "MinLvl") Then
  1466. AddQ "/w " & psD2 & Username & " Your character must be at least level " & bcp_Get("main", "MinLvl") & " to login."
  1467. bcp_DebugMsg "User " & Username & " log action: entry result: failure: character in IC is lower than required"
  1468. Exit Sub
  1469. End If
  1470. bcpIC.Item(Username).LastLog = Now()
  1471. bcpIC.Item(Username).HideLogMsg = False
  1472. AddQ "/f a " & Username
  1473. Case "logout"
  1474. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1475. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1476. End If
  1477.  
  1478. If DateDiff("s", bcpIC.Item(Username).LastLog, Now()) < bcp_Get("main", "MsgNoSpam") Then
  1479. AddChat vbRed, "[BCP] The command user cannot logout now, they need to wait " & (bcp_Get("main", "MsgNoSpam") - Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now()))) & " seconds!"
  1480. bcp_DebugMsg "User " & Username & " log action: removal result: failure: user cannot be added if they have logged out less than " & bcp_Get("main", "MsgNoSpam") & "s (MsgNoSpam) ago"
  1481. Exit Sub
  1482. End If
  1483.  
  1484. bcpIC.Item(Username).LastLog = DateAdd("n", 3, Now())
  1485. bcpIC.Item(Username).HideLogMsg = False
  1486. If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).GDB_Update("")
  1487. AddQ "/f r " & Username
  1488. Case "forcelogin"
  1489. If bcpIC.Exists(cmd(1)) Then
  1490. bcpIC.Item(cmd(1)).HideLogMsg = True
  1491. Else
  1492. AddQ "/w " & psD2 & Username & " You can only force a login for users the bot has seen."
  1493. AddChat vbYellow, "[BCP] This command only works when there is a channel object."
  1494. End If
  1495. AddQ "/f a " & cmd(1)
  1496. Case "forcelogout"
  1497. If bcpIC.Exists(cmd(1)) Then
  1498. bcpIC.Item(cmd(1)).HideLogMsg = True
  1499. Else
  1500. AddQ "/w " & psD2 & Username & " You can only force a login for users the bot has seen."
  1501. AddChat vbYellow, "[BCP] This command only works when there is a channel object."
  1502. End If
  1503. AddQ "/f r " & cmd(1)
  1504. Case "pref"
  1505. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1506. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1507. End If
  1508.  
  1509. If bcpUsers.Exists(Username) Then
  1510. If UBound(cmd) = 0 Then
  1511. AddQ "/w " & psD2 & Username & " " & _
  1512. "Preferences available to you: hidecharacter, hideduration"
  1513. Exit Sub
  1514. End If
  1515.  
  1516. With bcpUsers.Item(Username)
  1517. Select Case LCase(cmd(1))
  1518. Case "hcn", "hidecharacter", "showaccount", "showname"
  1519. If .NameOverCharacter Then
  1520. .NameOverCharacter = False
  1521. AddQ "/w " & psD2 & Username & " " & _
  1522. "Your character will now be shown instead of your account name."
  1523. bcp_DebugMsg "User " & Username & " log action: cfg result: success: character shown over account"
  1524. Else
  1525. .NameOverCharacter = True
  1526. AddQ "/w " & psD2 & Username & " " & _
  1527. "Your account name will now be shown instead of your character."
  1528. bcp_DebugMsg "User " & Username & " log action: cfg result: success: account shown over character"
  1529. End If
  1530. Case "hd", "hideduration", "hideinfo", "hidedata"
  1531. If .HideGameDuration Then
  1532. .HideGameDuration = False
  1533. AddQ "/w " & psD2 & Username & " " & _
  1534. "The bot will now whisper you your last game's duration and name."
  1535. bcp_DebugMsg "User " & Username & " log action: cfg result: success: game overview whispered upon return"
  1536. Else
  1537. .HideGameDuration = True
  1538. AddQ "/w " & psD2 & Username & " " & _
  1539. "The bot will now refrain from whispering you your game's data."
  1540. bcp_DebugMsg "User " & Username & " log action: cfg result: success: game overview muted"
  1541. End If
  1542. Case "hgdb", "hidegdb", "hidegame"
  1543. If .HideGDBStatus Then
  1544. .HideGDBStatus = False
  1545. AddQ "/w " & psD2 & Username & " " & _
  1546. "The bot will no longer disguise your game on the GDB."
  1547. bcp_DebugMsg "User " & Username & " log action: cfg result: success: gdb disguise disabled"
  1548. Else
  1549. .HideGDBStatus = True
  1550. AddQ "/w " & psD2 & Username & " " & _
  1551. "The bot will now disguise your game on the GDB."
  1552. bcp_DebugMsg "User " & Username & " log action: cfg result: success: gdb disguise enabled"
  1553. End If
  1554. End Select
  1555. End With
  1556. Else
  1557. AddQ "/w " & psD2 & Username & " " & _
  1558. "You do not have a career here, you cannot set preferences."
  1559. bcp_DebugMsg "User " & Username & " log action: command result: failure: user cannot manipulate the bot's internal commands without a career"
  1560. End If
  1561. Case "career", "my", "myinfo"
  1562. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1563. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1564. End If
  1565.  
  1566. If UBound(cmd) >= 1 Then
  1567. user = cmd(1)
  1568. Else
  1569. user = "info"
  1570. End If
  1571.  
  1572. If bcpUsers.Exists(Username) Then
  1573. With bcpUsers.Item(Username)
  1574. Select Case LCase(user)
  1575. Case "reset", "delete"
  1576. Randomize
  1577. .CareerResetCode = CStr(Int( Rnd * 100000 ) + 1000)
  1578. AddQ "/w " & psD2 & Username & " " & _
  1579. "Please type '" & BotVars.Trigger & "career confirmdelete " & .CareerResetCode & "' (no quotes) to confirm this."
  1580. bcp_DebugMsg "User " & Username & " log action: CAREER CODE REQUEST result: success: code = " & .CareerResetCode
  1581. Case "confirmdelete", "confirm", "deletecode", "resetcode"
  1582. If .CareerResetCode = cmd(2) Then
  1583. .Runs = 0
  1584. .Time = 0
  1585. .Fastest = 0
  1586. .Save
  1587. AddQ "/w " & psD2 & Username & " " & _
  1588. "Your career (runs, time, average, fastest game) has been reset."
  1589. bcp_DebugMsg "User " & Username & " log action: CAREER DELETION result: success"
  1590. Else
  1591. AddQ "/w " & psD2 & Username & " " & _
  1592. "Your code is " & .CareerResetCode & "."
  1593. End If
  1594. Case "rank"
  1595. AddQ "/w " & psD2 & Username & " " & _
  1596. "Your career ranks #" & .Rank() & " of " & bcpUsers.Count & " on this bot."
  1597. Case Else
  1598. AddQ "/w " & psD2 & Username & " " & _
  1599. "You have completed " & .Runs & " runs at roughly " & bcp_FmtTime(.Average()) & " (" & .Average() & "s) each (ranked #" & .Rank() & "). Your fastest run was " & bcp_FmtTime(.Fastest) & ". Your last was " & bcp_FmtTime(.LastTime) & "."
  1600. End Select
  1601. End With
  1602. Else
  1603. AddQ "/w " & psD2 & Username & " " & _
  1604. "You do not have a career here."
  1605. bcp_DebugMsg "User " & Username & " log action: command result: failure: user cannot manipulate the bot's internal commands without a career"
  1606. End If
  1607. Case "getcareer", "getinfo"
  1608. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1609. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1610. End If
  1611.  
  1612. Select Case UBound(cmd)
  1613. Case 2
  1614. user = cmd(1)
  1615. op = cmd(2)
  1616. Case 1
  1617. user = cmd(1)
  1618. op = "info"
  1619. Case Else
  1620. Exit Sub
  1621. End Select
  1622.  
  1623. If bcpUsers.Exists(user) Then
  1624. With bcpUsers.Item(user)
  1625. Select Case LCase(op)
  1626. Case "rank"
  1627. AddQ "/w " & psD2 & Username & " " & _
  1628. "The career for " & .Username & " ranks #" & .Rank() & " of " & bcpUsers.Count & " on this bot."
  1629. Case Else
  1630. AddQ "/w " & psD2 & Username & " " & _
  1631. .Username & " has completed " & .Runs & " runs at roughly " & bcp_FmtTime(.Average()) & " (" & .Average() & "s) each. Their fastest run was " & bcp_FmtTime(.Fastest) & ". The last run was " & bcp_FmtTime(.LastTime) & "."
  1632. End Select
  1633. End With
  1634. Else
  1635. AddQ "/w " & psD2 & Username & " " & _
  1636. "The user " & user & " could not be found. Please use their account name, or type " & BotVars.Trigger & "bcpfind " & user & " to find it."
  1637. bcp_DebugMsg "User " & Username & " log action: command result: failure: user not found"
  1638. End If
  1639. Case "bcpfind", "bcpwhois", "cf"
  1640. If UBound(cmd) = 0 Then
  1641. u = Username
  1642. Else
  1643. u = LCase(cmd(1))
  1644. For Each Key in bcpIC.Keys
  1645. ou = LCase(bcpIC.Item(Key).Username)
  1646. oc = LCase(bcpIC.Item(Key).Character)
  1647. If (ou = u) or (oc = u) Then
  1648. u = Key
  1649. Exit For
  1650. End If
  1651.  
  1652. If (InStr(ou, u) > 0) or (InStr(oc, u) > 0) Then
  1653. u = Key
  1654. End If
  1655. Next
  1656. End If
  1657.  
  1658. If Not bcpIC.Exists(u) Then
  1659. AddQ "/w " & psD2 & Username & " " & _
  1660. "Error: the bot has not seen that user since it was started"
  1661. Else
  1662. With bcpIC.Item(u)
  1663. m = "User " & .Username & " "
  1664. If .IsDiablo() Then
  1665. If .IsOpenCharacter() Then
  1666. m = m & "is an open character (last seen: " & bcp_FmtTime( DateDiff("s", .LastSeen, Now())) & ".)"
  1667. Else
  1668. m = m & "(aka " & .Character & ") is a level " & .Level & " " & .CClass & "."
  1669. End If
  1670. Else
  1671. m = m & "is not using Diablo II (last seen: " & bcp_FmtTime( DateDiff("s", .LastSeen, Now())) & ".)"
  1672. End If
  1673. End With
  1674.  
  1675. AddQ m
  1676. End If
  1677. Case "bcpeval"
  1678. tgames = 0
  1679. For Each Key in bcpUsers.Keys
  1680. tgames = tgames + bcpUsers.Item(Key).Runs
  1681. Next
  1682. AddQ "There are " & bcpUsers.Count & " unique profiles on this bot and " & tgames & " total games completed."
  1683. Case "bcpfastest", "fastest"
  1684. tname = ""
  1685. ttime = 9999
  1686. For Each Key in bcpUsers.Keys
  1687. If bcpUsers.Item(Key).Fastest < ttime Then
  1688. tname = Key
  1689. ttime = bcpUsers.Item(Key).Fastest
  1690. End If
  1691. Next
  1692.  
  1693. If tname = "" Then
  1694. AddQ "/w " & psD2 & Username & " " & _
  1695. "Error: the bot has no games to gather this information from"
  1696. Else
  1697. AddQ "The fastest game completed on this bot was completed in " & bcp_FmtTime(ttime) & " by " & tname & "."
  1698. End If
  1699. Case "bcptop", "top"
  1700. If UBound(cmd) = 0 Then
  1701. t = 5
  1702. Else
  1703. t = Int(cmd(1))
  1704. End If
  1705. AddQ "/w " & psD2 & Username & " " & _
  1706. "Top " & t & " users: " & bcp_TopX(5)
  1707. End Select
  1708.  
  1709. On Error GoTo 0
  1710. If (Err.Number <> 0) Then
  1711. AddChat vbRed, "[BCP] An error has occured processing remote commands: " & Err.Description
  1712. End If
  1713.  
  1714. End Sub
  1715.  
  1716. Sub Event_WhisperFromUser(Username, Flags, Message, Ping)
  1717.  
  1718. ProperMessageA = bcp_Translate(Message)
  1719. If (IsArray(ProperMessageA)) Then
  1720. If Not ProperMessageA(0) = "?" Then
  1721. If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).Language = ProperMessageA(0)
  1722. ProperMessage = ProperMessageA(1)
  1723. If (ProperMessageA(0) <> "English") Then
  1724. AddChat vbGreen, "[BCP] Translated " & ProperMessageA(0) & " message to English (" & ProperMessage & ")"
  1725. End If
  1726. Else
  1727. ProperMessage = Message
  1728. End If
  1729. Else
  1730. ProperMessage = Message
  1731. End If
  1732.  
  1733. '// BCP_ENABLED_CHECK (whisper)
  1734. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1735.  
  1736. If Match(ProperMessage, "Your friend * has exited Battle.net.", True) Then
  1737. If bcpUsers.Exists(Username) Then
  1738. With bcpUsers.Item(Username)
  1739. If bcp_Get("Behavior", "LogoutOnExit") = True Then
  1740. If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
  1741. AddQ "/f r " & Username
  1742. End If
  1743.  
  1744. If .InGame Then
  1745. AddChat vbRed, "[BCP] User logged off while in a game, run removed."
  1746. .InGame = False
  1747. Set .GameObject = Nothing
  1748. If .Runs > 10 Then .GDB_Update("")
  1749. Exit Sub
  1750. End If
  1751. End With
  1752. End If
  1753. End If
  1754.  
  1755. parts = Split(ProperMessage, " ")
  1756. If Match(ProperMessage, "Your friend * entered a * game called *.", True) Then
  1757. game = Split(ProperMessage, " game called ")(1)
  1758. game = Left(game, Len(game)-1)
  1759. If (InStr(game, " eingeklinkt") > 0) and bcp_Get("Translations", "GermanLanguageSupport") Then
  1760. game = Replace(game, " eingeklinkt", "")
  1761. AddChat vbYellow, "[BCP] German support is enabled, this game name was fixed automatically."
  1762. End If
  1763.  
  1764. If (Len(bcp_Get("main", "filter")) = 0) Then
  1765. ok = True
  1766. m = game
  1767. Else
  1768. gf = Split( CStr(bcp_Get("main", "filter")), "|" )
  1769. ok = False
  1770. For i = 0 to UBound(gf)
  1771. If InStr(LCase(game), LCase(gf(i))) > 0 Then
  1772. m = gf(i)
  1773. ok = True
  1774. End If
  1775. Next
  1776. End If
  1777.  
  1778. For Each Key in bcpUsers.Keys
  1779. With bcpUsers.Item(Key)
  1780. If .InGame Then
  1781. If LCase(game) = LCase(.GameObject.Name) Then
  1782. If bcp_Get("Behavior", "LogoutOnPiggy") Then
  1783. If bcpIC.Exists(Username) Then
  1784. bcpIC.Item(Username).HideLogMsg = True
  1785. bcpIC.Item(Username).LastLog = DateAdd("n", 30, Now())
  1786. End If
  1787. AddQ "/f r " & Username
  1788. AddChat vbRed, "[BCP] This game already exists, removing " & Username & " from friends and restricting login for 30 minutes."
  1789. bcp_DebugMsg "User " & Username & " log action: game result: error upon creation: piggy backing turned off by host; user removed; user barred for 30 minutes"
  1790. Else
  1791. AddChat vbRed, "[BCP] This game already exists, the bot will ignore it for this user."
  1792. End If
  1793. Exit Sub
  1794. End If
  1795. End If
  1796. End With
  1797. Next
  1798.  
  1799. If Not ok Then
  1800. If bcp_Get("Behavior", "LogoutInvalidFilter") Then
  1801. If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
  1802. AddQ "/f r " & Username
  1803. bcp_DebugMsg "User " & Username & " log action: removal result: automatic: user joined an untagged game"
  1804. Else
  1805. AddChat vbRed, "[BCP] Game name has no valid tag, it was ignored."
  1806. bcp_DebugMsg "User " & Username & " log action: game result: error upon creation: game has no tags"
  1807. End If
  1808. Exit Sub
  1809. Else
  1810. m = game
  1811. End If
  1812.  
  1813. If bcpUsers.Exists(Username) Then
  1814. With bcpUsers.Item(Username)
  1815. If .InGame Then
  1816. AddChat vbRed, "[BCP] User is already in a game. Resetting game."
  1817. bcp_DebugMsg "User " & Username & " log action: game result: automatic: user is doubling games, last game dropped"
  1818. .EmptyGame
  1819. Set .GameObject = New bcp_Game
  1820. .GameObject.Name = game
  1821. .GameObject.Host = Username
  1822. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1823. .InGame = True
  1824. If .Runs > 10 Then .GDB_Update(m)
  1825. Exit Sub
  1826. End If
  1827.  
  1828. .InGame = True
  1829. Set .GameObject = New bcp_Game
  1830. .GameObject.Name = game
  1831. .GameObject.Host = Username
  1832. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1833. If .Runs > 10 Then .GDB_Update(m)
  1834. End With
  1835. Else
  1836. AddChat vbYellow, "[BCP] User doesn't exist..."
  1837. If bcpIC.Exists(Username) Then
  1838. bcpUsers.Add Username, bcpIC.Item(Username)
  1839. With bcpUsers.Item(Username)
  1840. AddChat vbGreen, "[BCP] " & .Title & " " & .Character & " (level " & .Level & ", " & .CClass & ") added to database."
  1841. bcp_DebugMsg "User " & Username & " log action: added result: automatic: user created game"
  1842. End With
  1843.  
  1844. With bcpUsers.Item(Username)
  1845. .InGame = True
  1846. Set .GameObject = New bcp_Game
  1847. .GameObject.Name = game
  1848. .GameObject.Host = Username
  1849. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1850. End With
  1851. Else
  1852. AddChat vbRed, "[BCP] User was not in the database, and had no channel reference. The user couldn't be added properly."
  1853. bcp_DebugMsg "User " & Username & " log action: added result: failure: user not found in internal channel"
  1854. End If
  1855. End If
  1856. End If
  1857.  
  1858. End Sub
  1859.  
  1860. Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString, Banned)
  1861. '// BCP_ENABLED_CHECK (user joins)
  1862. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1863.  
  1864. If bcpUsers.Exists(Username) Then
  1865. With bcpUsers.Item(Username)
  1866. If .InGame Then
  1867. bcp_EagleMsg "User " & Username & " experiencing ephemeral transition, stats update soon"
  1868. d = .GameObject.Duration()
  1869. If Not .GameTimeOK() Then
  1870. AddQ "/w " & psD2 & Username & " Your game was too fast or too slow. (" & d & " seconds)"
  1871. .LastGameName = "Invalid"
  1872. Call .EmptyGame()
  1873. bcp_DebugMsg "User " & Username & " log action: game result: failure: game too fast or too slow"
  1874. Else
  1875. AddChat vbGreen, "[BCP] " & .Character & " finished " & .GameObject.Name & " in " & d & " seconds."
  1876. Call .EmptyGame()
  1877. .Runs = .Runs + 1
  1878. .Time = .Time + d
  1879. If d < .Fastest or .Fastest = 0 Then
  1880. If .Fastest > 0 Then m = " This is your fastest game so far."
  1881. .Fastest = d
  1882. End If
  1883.  
  1884. AddQ "/w " & psD2 & Username & " Game #" & .Runs & " (" & .GameObject.Name & ") lasted " & bcp_FmtTime(d) & " (" & d & " seconds)." & m
  1885. End If
  1886. Set .GameObject = Nothing
  1887. Call .GDB_UpdateComp("", d)
  1888. End If
  1889.  
  1890. .StatString = Message
  1891. .Product = Product
  1892. .Level = Level
  1893. .Parse
  1894. End With
  1895. End If
  1896.  
  1897. If Not bcpIC.Exists(Username) Then
  1898. bcpIC.Add Username, new bcp_User
  1899. End If
  1900.  
  1901. With bcpIC.Item(Username)
  1902. .Username = Username
  1903. .Product = Product
  1904. .Level = Level
  1905. .StatString = Message
  1906. .Parse
  1907. End With
  1908. End Sub
  1909.  
  1910. Sub Event_UserLeaves(Username, Flags)
  1911. '// BCP_ENABLED_CHECK (leave)
  1912. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1913.  
  1914. 'If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1915. End Sub
  1916.  
  1917. Sub Event_UserInChannel(Username, Flags, Message, Ping, Product, StatUpdate)
  1918. If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1919. bcpIC.Add Username, new bcp_User
  1920. With bcpIC.Item(Username)
  1921. .Username = Username
  1922. .Product = Product
  1923. .Level = Level
  1924. '// Fuck 2.6
  1925. .StatString = Split(Message, ")")
  1926. If UBound(.StatString) > 0 Then
  1927. .StatString = .StatString(UBound(.StatString)-1) & ")"
  1928. Else
  1929. .StatString = Message
  1930. End If
  1931. .Parse
  1932. End With
  1933. Message = ""
  1934. End Sub
  1935.  
  1936. Sub Event_PressedEnter(Text)
  1937.  
  1938. On Error Resume Next : Err.Clear
  1939. If Left(Text, 5) = "/bcp " Then
  1940. VetoThisMessage
  1941. cmd = Split(Mid(Text, 6), " ")
  1942. Select Case LCase(cmd(0))
  1943. Case "gdbinfo"
  1944. bcp_Set "GDB", "username", cmd(1), True
  1945. bcp_Set "GDB", "password", cmd(2), True
  1946. AddChat vbGreen, "[BCP] Global database username set to " & cmd(1) & _
  1947. " and password set to """ & cmd(2) & """."
  1948. Case "gdbloc"
  1949. bcp_Set "GDB", "location", cmd(1), True
  1950. AddChat vbGreen, "[BCP] Global database location set to: " & cmd(1)
  1951. Case "cfg", "config"
  1952. If UBound(cmd) >= 1 Then
  1953. Select Case LCase(cmd(1))
  1954. Case "get"
  1955. AddChat vbGreen, bcp_Get(cmd(2), cmd(3))
  1956. Case "set"
  1957. Call bcp_Set(cmd(2), cmd(3), Replace(cmd(4), "_", " "))
  1958. AddChat vbGreen, bcp_Get(cmd(2), cmd(3))
  1959. Case "open"
  1960. AddChat vbYellow, "[BCP] Attempting to open default BCP config..."
  1961. Set objShell = CreateObject("WScript.Shell")
  1962. objShell.Run BotPath() & "bcp_settings.ini"
  1963. Set objShell = Nothing
  1964. End Select
  1965. End If
  1966. Case "reset"
  1967. u = LCase(cmd(1))
  1968. For Each Key in bcpUsers.Keys
  1969. With bcpUsers.Item(Key)
  1970. If LCase(.Username) = u Then
  1971. .Runs = 0
  1972. .Time = 0
  1973. .Fastest = 0
  1974. .Save
  1975. AddChat vbYellow, "[BCP] Purge/Reset: " & .Username
  1976. Exit Sub
  1977. End If
  1978. End With
  1979. Next
  1980. AddChat vbRed, "[BCP] That user was not found. Please make sure you typed their account name correctly."
  1981. Case "purge"
  1982. If (UBound(cmd) = 0) Then
  1983. l = 100000
  1984. Else
  1985. l = Int(cmd(1))
  1986. End If
  1987.  
  1988. If Msgbox("Do you really want to remove every user with less than " & l & " runs?", vbYesNo, "Purge") <> vbYes Then
  1989. Exit Sub
  1990. End If
  1991.  
  1992. AddChat vbYellow, "[BCP] Purging players with less than " & l & " runs."
  1993. bcp_PurgeList l
  1994. AddChat vbGreen, "[BCP] Purge complete."
  1995. Case "trans", "transtest"
  1996. text = ""
  1997. For i = 1 to UBound(cmd)
  1998. text = text & cmd(i) & " "
  1999. Next
  2000. text = Trim(text)
  2001. r = bcp_Translate(text)
  2002. AddChat vbCyan, "[BCP] From " & r(0) & " to English: " & r(1)
  2003. Case "version"
  2004. AddChat vbCyan, "[BCP] BCP Version " & Script("Major") & "." & Script("Revision") & "." & Script("Minor") & " version ID " & vID & " by vi[r]us -- http://toshley.net/bcp"
  2005. AddChat vbCyan, "[BCP] Translations markup last changed 2.0.2 (20210); file version " & bcp_Get("Translations", "Version") & ".0 last updated " & bcp_Get("Translations", "LastUpdate") & "."
  2006. Case "eagleeyes", "eagleyes", "eagleye", "eagleeye"
  2007. newsetting = False
  2008. If (cmd(1) = "disable") Then newsetting = False
  2009. If (cmd(1) = "enable") Then newsetting = True
  2010. bcp_Set "Debug", "EagleEyes", newsetting, True
  2011. AddChat vbGreen, "[BCP] Eagle Eye functionality turned on: " & newsetting
  2012. Case "disable", "enable", "toggle"
  2013. If LCase(cmd(0)) = "disable" Then
  2014. bcp_Set "Main", "BCPEnabled", "False", True
  2015. AddChat vbRed, "[BCP] Script disabled (only muted). You can type /bcp enable to restart the script. The bot will continue to run minor BCP functions in the background."
  2016. ElseIf LCase(cmd(0)) = "enable" Then
  2017. bcp_Set "Main", "BCPEnabled", "True", True
  2018. AddChat vbGreen, "[BCP] Script enabled."
  2019. ElseIf LCase(cmd(0)) = "toggle" Then
  2020. If (bcp_Get("Main", "BCPEnabled")) Then
  2021. bcp_Set "Main", "BCPEnabled", "False", True
  2022. AddChat vbRed, "[BCP] Script disabled (only muted). You can type /bcp enable to restart the script."
  2023. Else
  2024. bcp_Set "Main", "BCPEnabled", "True", True
  2025. AddChat vbGreen, "[BCP] Script enabled."
  2026. End If
  2027. End If
  2028. Case "update"
  2029. bcp_CheckScriptVersion
  2030. Case "transupdate"
  2031. bcp_CheckTranslations
  2032. Case "mutual"
  2033. If (bcp_Mutual(cmd(1))) Then
  2034. AddChat vbGreen, "[BCP] Mutual (" & cmd(1) & "): yes"
  2035. Else
  2036. AddChat vbGreen, "[BCP] Mutual (" & cmd(1) & "): no"
  2037. End If
  2038. Case "news", "checknews"
  2039. bcp_CheckNews
  2040. Case "setup"
  2041. bcp_RunSetup()
  2042. Case "find"
  2043. If UBound(cmd) = 0 Then
  2044. u = BotVars.Username
  2045. Else
  2046. u = LCase(cmd(1))
  2047. For Each Key in bcpIC.Keys
  2048. ou = LCase(bcpIC.Item(Key).Username)
  2049. oc = LCase(bcpIC.Item(Key).Character)
  2050. If (ou = u) or (oc = u) Then
  2051. u = Key
  2052. Exit For
  2053. End If
  2054.  
  2055. If (InStr(ou, u) > 0) or (InStr(oc, u) > 0) Then
  2056. u = Key
  2057. End If
  2058. Next
  2059. End If
  2060.  
  2061. If Not bcpIC.Exists(u) Then
  2062. AddChat vbRed, "[BCP] Error: the bot has not seen that user since it was started"
  2063. Else
  2064. With bcpIC.Item(u)
  2065. lastseen = "(last seen: " & bcp_FmtTime( DateDiff("s", .LastSeen, Now())) & ".)"
  2066. ladder = "non-Ladder"
  2067. If (.IsLadder) Then ladder = "Ladder"
  2068. If (.IsHardcore) Then ladder = "hardcore " & ladder
  2069. If (.Friend()) Then friend = " (mutual friend)"
  2070. d2game = "Diablo II Classic"
  2071. If (.IsExpansion) Then d2game = "Diablo II Expansion"
  2072. m = "User " & .Username & " "
  2073. If .IsDiablo() Then
  2074. If .IsOpenCharacter() Then
  2075. m = m & "is an open character " & lastseen
  2076. Else
  2077. m = m & "(aka " & .Title & " " & .Character & ") is a " & ladder & " level " & .Level & " " & .CClass & " using " & d2game & " " & lastseen
  2078. End If
  2079. Else
  2080. m = m & "is not using Diablo II " & lastseen
  2081. End If
  2082. End With
  2083.  
  2084. AddChat vbGreen, "[BCP] " & m
  2085. End If
  2086. End Select
  2087. End If
  2088.  
  2089. If (Err.Number <> 0) Then
  2090. AddChat vbRed, "[BCP] An error has occured processing commands: " & Err.Description
  2091. End If
  2092. End Sub
  2093.  
  2094. Sub Event_Close()
  2095. If bcp_Get("Behavior", "SaveOnExit") Then bcp_SaveAll
  2096. bcp_GDBStatus "Absent"
  2097. End Sub
  2098.  
  2099. Sub bcp_DebugMsg(Text)
  2100. If bcp_Get("Debug", "enable") Then AddChat vbRed, "[BCP] [DEBUG] " & Text
  2101. End Sub
  2102.  
  2103. Sub bcp_EagleMsg(Text)
  2104. If bcp_Get("Debug", "EagleEyes") Then AddChat vbWhite, "[BCP] [EAGLE] " & Text
  2105. End Sub
  2106.  
  2107. Sub bcp_RunSetup()
  2108.  
  2109. ' question - cat - item - checknum - forcelcase - isquestion
  2110.  
  2111. stufflist = Array(Array("How much access should the bot require people to have to login and do runs?", "Commands", "login", True, False, False), _
  2112. Array("How much time, in seconds, should be the minimum time for a run to take in your channel?", "Main", "MinGame", True, False, False), _
  2113. Array("What about the maximum time a game can take? (seconds)", "Main", "MaxGame", True, False, False), _
  2114. Array("What is the minimum level required on a character to login? (1-99)", "Main", "MinLvl", True, False, False), _
  2115. Array("Should we allow non-ladder players to run games?", "Main", "AllowNonLadder", False, False, True), _
  2116. Array("Should we allow ladder players to run games?", "Main", "AllowLadder", False, False, True), _
  2117. Array("Should we allow hardcore players to run games?", "Main", "AllowHardcore", False, False, True), _
  2118. Array("What should the bot say when no games are available?", "Messages", "NoGames", False, False, False), _
  2119. Array("What text precedes the game list when they are available? (%i is used as the number of games)", "Messages", "GamePretext", False, False, False), _
  2120. Array("What should the bot say when a new game is created? (for a full list of variables, check out http://toshley.net/bcp/help.php and click Variables)", "Messages", "NewGame", False, False, False), _
  2121. Array("What kind of games do you run in your channel? These phrases will be used to determine such games. Use a line (|) to separate them." & vbCrLf & vbCrLf & "Example: baal|chaos" & vbCrLf & "for chaos and baal games.", "Main", "Filter", False, True, False), _
  2122. Array("Should the games list repeat every 60 seconds, or should it be done by the .games command?", "Main", "MsgType", False, False, True))
  2123.  
  2124. AddChat vbYellow, "[BCP] Welcome to BCP setup. The bot will now ask you some questions to help you set up the configuration file."
  2125.  
  2126. 'InputBox(prompt[,title][,default][,xpos][,ypos][,helpfile,context])
  2127.  
  2128. f = InputBox("Dialogs like this will follow asking you simple questions. You can answer with text, a number or with ""yes"" and ""no"".", "BCP 2.0 Setup", "Your answers will go here, when you're ready click OK.")
  2129.  
  2130. For a = 0 to UBound(stufflist)
  2131. stuff = stufflist(a)
  2132. AddChat vbYellow, "[BCP] [" & stuff(1) & "]: " & stuff(2)
  2133. data = InputBox(stuff(0), "BCP 2.0 Setup", bcp_Get(stuff(1), stuff(2)))
  2134. If (stuff(3)) Then
  2135. If Not IsNumeric(data) Then data = bcp_Get(stuff(1), stuff(2))
  2136. End If
  2137. If (stuff(4)) Then
  2138. data = LCase(data)
  2139. End If
  2140. If (stuff(5)) Then
  2141. Select Case LCase(data)
  2142. Case "yes", "y", "true"
  2143. data = True
  2144. Case "no", "n", "false"
  2145. data = False
  2146. Case Else
  2147. data = "RESET"
  2148. End Select
  2149. End If
  2150. If data <> "RESET" Then
  2151. AddChat vbGreen, "[BCP] " & stuff(2) & " set to: " & data
  2152. bcp_Set stuff(1), stuff(2), data,True
  2153. Else
  2154. AddChat vbRed, "[BCP] " & stuff(2) & " was invalid and not set."
  2155. End If
  2156. Next
  2157.  
  2158. data = InputBox("While we're here, do you have a GDB account to set up?", "BCP 2.0 Setup", "yes/no")
  2159. If (data = "yes") Then
  2160. name = InputBox("GDB Username", "BCP 2.0 GDB Setup", "")
  2161. pass = InputBox("GDB Password", "BCP 2.0 GDB Setup", "")
  2162. loc = "http://toshley.net/bcp/sys/commit.php"
  2163. If (name = "") or (pass = "") Then
  2164. AddChat vbRed, "[BCP] You must input data for this."
  2165. Else
  2166. bcp_Set "GDB", "username", name, True
  2167. bcp_Set "GDB", "password", pass, True
  2168. bcp_Set "GDB", "location", loc, True
  2169. AddChat vbGreen, "[BCP] Global database username set to " & name & _
  2170. " and password set to """ & pass & """."
  2171. End If
  2172. Else
  2173. AddChat vbRed, "[BCP] We're done here if you have no further information. Thanks for using BCP. If you change your mind about the GDB run this setup again."
  2174. AddChat vbRed, "[BCP] If you have any other questions, check out http://toshley.net/bcp for more information."
  2175. End If
  2176.  
  2177. AddChat vbGreen, "[BCP] Setup complete."
  2178. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement