Advertisement
Guest User

WCKD Stealth Bot

a guest
Jul 3rd, 2018
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 80.20 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. GetDBEntry Username, a, f
  1380. If Left(Message, Len(b)) = b Then
  1381. cmd = Split(Mid(Message, Len(b)+1), " ")
  1382. Else
  1383. Exit Sub
  1384. End If
  1385.  
  1386. If bcp_Get("aliases", LCase(cmd(0))) <> "" Then
  1387. newcmd = bcp_Get("aliases", LCase(cmd(0)))
  1388. AddChat vbCyan, "[BCP] Command alias recognized: changes """ & cmd(0) & """ to """ & newcmd & """"
  1389. cmd(0) = newcmd
  1390. End If
  1391.  
  1392. If bcp_Get("commands", LCase(cmd(0))) <> "" Then
  1393. cmdA = Int(bcp_Get("commands", LCase(cmd(0))))
  1394. If (a < cmdA) and (Not cmdA = 0) Then
  1395. AddChat vbRed, "[BCP] Error: " & Username & " does not have enough bot access to do command """ & BotVars.Trigger & LCase(cmd(0)) & """; requires " & cmdA & " access"
  1396. bcp_DebugMsg "User " & Username & " log action: command result: failure: does not have required " & cmdA & " access to do '" & cmd(0) & "'; has " & a
  1397. Exit Sub
  1398. End If
  1399. Else
  1400. Exit Sub
  1401. End If
  1402.  
  1403. If Not bcpIC.Exists(Username) Then
  1404. AddChat vbRed, "[BCP] Error: The bot has not seen " & Username & " before in the channel... they should rejoin"
  1405. bcp_DebugMsg "User " & Username & " log action: precommand result: failure: user doesn't exist in internal channel database"
  1406. Exit Sub
  1407. End If
  1408.  
  1409. On Error Resume Next : Err.Clear
  1410.  
  1411. Select Case LCase(cmd(0))
  1412. Case "games"
  1413. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1414. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1415. End If
  1416.  
  1417. If Not LCase(bcp_Get("main", "MsgType")) = "ask" or (bcp_Get("main", "MsgType") = False) Then
  1418. AddChat vbRed, "[BCP] The bot refused to tell a user the games list; games are displayed periodically instead"
  1419. bcp_DebugMsg "User " & Username & " log action: command result: failure: cannot show games when host requests periodic display"
  1420. Exit Sub
  1421. Else
  1422. If Abs(DateDiff("s", bcpLastGameRequest, Now())) < bcp_Get("main", "MsgNoSpam") Then
  1423. AddChat vbRed, "[BCP] Waiting until cooldown expires to display games by command."
  1424. bcp_DebugMsg "User " & Username & " log action: command result: failure: command fizzled"
  1425. Exit Sub
  1426. End If
  1427. AddQ bcp_FmtGameList()
  1428. bcpLastGameRequest = Now()
  1429. End If
  1430. Case "login"
  1431. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1432. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1433. End If
  1434.  
  1435. If DateDiff("s", bcpIC.Item(Username).LastLog, Now()) < bcp_Get("main", "MsgNoSpam") Then
  1436. 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!"
  1437. 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"
  1438. Exit Sub
  1439. End If
  1440.  
  1441. bcpIC.Item(Username).LastLog = Now()
  1442. If (Ping > bcp_Get("main", "MinPing")) and (bcp_Get("main", "MinPing") <> -1) Then
  1443. AddQ "/w " & psD2 & Username & " You must have a ping lower than " & bcp_Get("main", "MinPing") & " to login."
  1444. bcp_DebugMsg "User " & Username & " log action: entry result: failure: user cannot be added if ping lower than " & bcp_Get("main", "MinPing") & "ms (MinPing)"
  1445. Exit Sub
  1446. End If
  1447.  
  1448. If (Not bcp_Get("main", "AllowHardcore")) and (bcpIC.Item(Username).IsHardcore) Then
  1449. AddQ "/w " & psD2 & Username & " Hardcore characters are not permitted to login."
  1450. bcp_DebugMsg "User " & Username & " log action: entry result: failure: hardcore characters are not allowed by host"
  1451. Exit Sub
  1452. End If
  1453.  
  1454. If (Not bcp_Get("main", "AllowNonLadder")) and (Not bcpIC.Item(Username).IsLadder) Then
  1455. AddQ "/w " & psD2 & Username & " Non-ladder characters are not permitted to login."
  1456. bcp_DebugMsg "User " & Username & " log action: entry result: failure: non-ladder characters are not allowed by host"
  1457. Exit Sub
  1458. End If
  1459.  
  1460. If (Not bcp_Get("main", "AllowLadder")) and (bcpIC.Item(Username).IsLadder) Then
  1461. AddQ "/w " & psD2 & Username & " Ladder characters are not permitted to login."
  1462. bcp_DebugMsg "User " & Username & " log action: entry result: failure: ladder characters are not allowed by host"
  1463. Exit Sub
  1464. End If
  1465.  
  1466. If bcpIC.Item(Username).Level < bcp_Get("main", "MinLvl") Then
  1467. AddQ "/w " & psD2 & Username & " Your character must be at least level " & bcp_Get("main", "MinLvl") & " to login."
  1468. bcp_DebugMsg "User " & Username & " log action: entry result: failure: character in IC is lower than required"
  1469. Exit Sub
  1470. End If
  1471. bcpIC.Item(Username).LastLog = Now()
  1472. bcpIC.Item(Username).HideLogMsg = False
  1473. AddQ "/f a " & Username
  1474. Case "logout"
  1475. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1476. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1477. End If
  1478.  
  1479. If DateDiff("s", bcpIC.Item(Username).LastLog, Now()) < bcp_Get("main", "MsgNoSpam") Then
  1480. 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!"
  1481. 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"
  1482. Exit Sub
  1483. End If
  1484.  
  1485. bcpIC.Item(Username).LastLog = DateAdd("n", 3, Now())
  1486. bcpIC.Item(Username).HideLogMsg = False
  1487. If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).GDB_Update("")
  1488. AddQ "/f r " & Username
  1489. Case "forcelogin"
  1490. If bcpIC.Exists(cmd(1)) Then
  1491. bcpIC.Item(cmd(1)).HideLogMsg = True
  1492. Else
  1493. AddQ "/w " & psD2 & Username & " You can only force a login for users the bot has seen."
  1494. AddChat vbYellow, "[BCP] This command only works when there is a channel object."
  1495. End If
  1496. AddQ "/f a " & cmd(1)
  1497. Case "forcelogout"
  1498. If bcpIC.Exists(cmd(1)) Then
  1499. bcpIC.Item(cmd(1)).HideLogMsg = True
  1500. Else
  1501. AddQ "/w " & psD2 & Username & " You can only force a login for users the bot has seen."
  1502. AddChat vbYellow, "[BCP] This command only works when there is a channel object."
  1503. End If
  1504. AddQ "/f r " & cmd(1)
  1505. Case "pref"
  1506. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1507. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1508. End If
  1509.  
  1510. If bcpUsers.Exists(Username) Then
  1511. If UBound(cmd) = 0 Then
  1512. AddQ "/w " & psD2 & Username & " " & _
  1513. "Preferences available to you: hidecharacter, hideduration"
  1514. Exit Sub
  1515. End If
  1516.  
  1517. With bcpUsers.Item(Username)
  1518. Select Case LCase(cmd(1))
  1519. Case "hcn", "hidecharacter", "showaccount", "showname"
  1520. If .NameOverCharacter Then
  1521. .NameOverCharacter = False
  1522. AddQ "/w " & psD2 & Username & " " & _
  1523. "Your character will now be shown instead of your account name."
  1524. bcp_DebugMsg "User " & Username & " log action: cfg result: success: character shown over account"
  1525. Else
  1526. .NameOverCharacter = True
  1527. AddQ "/w " & psD2 & Username & " " & _
  1528. "Your account name will now be shown instead of your character."
  1529. bcp_DebugMsg "User " & Username & " log action: cfg result: success: account shown over character"
  1530. End If
  1531. Case "hd", "hideduration", "hideinfo", "hidedata"
  1532. If .HideGameDuration Then
  1533. .HideGameDuration = False
  1534. AddQ "/w " & psD2 & Username & " " & _
  1535. "The bot will now whisper you your last game's duration and name."
  1536. bcp_DebugMsg "User " & Username & " log action: cfg result: success: game overview whispered upon return"
  1537. Else
  1538. .HideGameDuration = True
  1539. AddQ "/w " & psD2 & Username & " " & _
  1540. "The bot will now refrain from whispering you your game's data."
  1541. bcp_DebugMsg "User " & Username & " log action: cfg result: success: game overview muted"
  1542. End If
  1543. Case "hgdb", "hidegdb", "hidegame"
  1544. If .HideGDBStatus Then
  1545. .HideGDBStatus = False
  1546. AddQ "/w " & psD2 & Username & " " & _
  1547. "The bot will no longer disguise your game on the GDB."
  1548. bcp_DebugMsg "User " & Username & " log action: cfg result: success: gdb disguise disabled"
  1549. Else
  1550. .HideGDBStatus = True
  1551. AddQ "/w " & psD2 & Username & " " & _
  1552. "The bot will now disguise your game on the GDB."
  1553. bcp_DebugMsg "User " & Username & " log action: cfg result: success: gdb disguise enabled"
  1554. End If
  1555. End Select
  1556. End With
  1557. Else
  1558. AddQ "/w " & psD2 & Username & " " & _
  1559. "You do not have a career here, you cannot set preferences."
  1560. bcp_DebugMsg "User " & Username & " log action: command result: failure: user cannot manipulate the bot's internal commands without a career"
  1561. End If
  1562. Case "career", "my", "myinfo"
  1563. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1564. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1565. End If
  1566.  
  1567. If UBound(cmd) >= 1 Then
  1568. user = cmd(1)
  1569. Else
  1570. user = "info"
  1571. End If
  1572.  
  1573. If bcpUsers.Exists(Username) Then
  1574. With bcpUsers.Item(Username)
  1575. Select Case LCase(user)
  1576. Case "reset", "delete"
  1577. Randomize
  1578. .CareerResetCode = CStr(Int( Rnd * 100000 ) + 1000)
  1579. AddQ "/w " & psD2 & Username & " " & _
  1580. "Please type '" & BotVars.Trigger & "career confirmdelete " & .CareerResetCode & "' (no quotes) to confirm this."
  1581. bcp_DebugMsg "User " & Username & " log action: CAREER CODE REQUEST result: success: code = " & .CareerResetCode
  1582. Case "confirmdelete", "confirm", "deletecode", "resetcode"
  1583. If .CareerResetCode = cmd(2) Then
  1584. .Runs = 0
  1585. .Time = 0
  1586. .Fastest = 0
  1587. .Save
  1588. AddQ "/w " & psD2 & Username & " " & _
  1589. "Your career (runs, time, average, fastest game) has been reset."
  1590. bcp_DebugMsg "User " & Username & " log action: CAREER DELETION result: success"
  1591. Else
  1592. AddQ "/w " & psD2 & Username & " " & _
  1593. "Your code is " & .CareerResetCode & "."
  1594. End If
  1595. Case "rank"
  1596. AddQ "/w " & psD2 & Username & " " & _
  1597. "Your career ranks #" & .Rank() & " of " & bcpUsers.Count & " on this bot."
  1598. Case Else
  1599. AddQ "/w " & psD2 & Username & " " & _
  1600. "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) & "."
  1601. End Select
  1602. End With
  1603. Else
  1604. AddQ "/w " & psD2 & Username & " " & _
  1605. "You do not have a career here."
  1606. bcp_DebugMsg "User " & Username & " log action: command result: failure: user cannot manipulate the bot's internal commands without a career"
  1607. End If
  1608. Case "getcareer", "getinfo"
  1609. If (Not bcpIC.Item(Username).IsDiablo()) Then
  1610. AddChat vbRed, "[BCP] " & Username & " does not use Diablo II and cannot use this command."
  1611. End If
  1612.  
  1613. Select Case UBound(cmd)
  1614. Case 2
  1615. user = cmd(1)
  1616. op = cmd(2)
  1617. Case 1
  1618. user = cmd(1)
  1619. op = "info"
  1620. Case Else
  1621. Exit Sub
  1622. End Select
  1623.  
  1624. If bcpUsers.Exists(user) Then
  1625. With bcpUsers.Item(user)
  1626. Select Case LCase(op)
  1627. Case "rank"
  1628. AddQ "/w " & psD2 & Username & " " & _
  1629. "The career for " & .Username & " ranks #" & .Rank() & " of " & bcpUsers.Count & " on this bot."
  1630. Case Else
  1631. AddQ "/w " & psD2 & Username & " " & _
  1632. .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) & "."
  1633. End Select
  1634. End With
  1635. Else
  1636. AddQ "/w " & psD2 & Username & " " & _
  1637. "The user " & user & " could not be found. Please use their account name, or type " & BotVars.Trigger & "bcpfind " & user & " to find it."
  1638. bcp_DebugMsg "User " & Username & " log action: command result: failure: user not found"
  1639. End If
  1640. Case "bcpfind", "bcpwhois", "cf"
  1641. If UBound(cmd) = 0 Then
  1642. u = Username
  1643. Else
  1644. u = LCase(cmd(1))
  1645. For Each Key in bcpIC.Keys
  1646. ou = LCase(bcpIC.Item(Key).Username)
  1647. oc = LCase(bcpIC.Item(Key).Character)
  1648. If (ou = u) or (oc = u) Then
  1649. u = Key
  1650. Exit For
  1651. End If
  1652.  
  1653. If (InStr(ou, u) > 0) or (InStr(oc, u) > 0) Then
  1654. u = Key
  1655. End If
  1656. Next
  1657. End If
  1658.  
  1659. If Not bcpIC.Exists(u) Then
  1660. AddQ "/w " & psD2 & Username & " " & _
  1661. "Error: the bot has not seen that user since it was started"
  1662. Else
  1663. With bcpIC.Item(u)
  1664. m = "User " & .Username & " "
  1665. If .IsDiablo() Then
  1666. If .IsOpenCharacter() Then
  1667. m = m & "is an open character (last seen: " & bcp_FmtTime( DateDiff("s", .LastSeen, Now())) & ".)"
  1668. Else
  1669. m = m & "(aka " & .Character & ") is a level " & .Level & " " & .CClass & "."
  1670. End If
  1671. Else
  1672. m = m & "is not using Diablo II (last seen: " & bcp_FmtTime( DateDiff("s", .LastSeen, Now())) & ".)"
  1673. End If
  1674. End With
  1675.  
  1676. AddQ m
  1677. End If
  1678. Case "bcpeval"
  1679. tgames = 0
  1680. For Each Key in bcpUsers.Keys
  1681. tgames = tgames + bcpUsers.Item(Key).Runs
  1682. Next
  1683. AddQ "There are " & bcpUsers.Count & " unique profiles on this bot and " & tgames & " total games completed."
  1684. Case "bcpfastest", "fastest"
  1685. tname = ""
  1686. ttime = 9999
  1687. For Each Key in bcpUsers.Keys
  1688. If bcpUsers.Item(Key).Fastest < ttime Then
  1689. tname = Key
  1690. ttime = bcpUsers.Item(Key).Fastest
  1691. End If
  1692. Next
  1693.  
  1694. If tname = "" Then
  1695. AddQ "/w " & psD2 & Username & " " & _
  1696. "Error: the bot has no games to gather this information from"
  1697. Else
  1698. AddQ "The fastest game completed on this bot was completed in " & bcp_FmtTime(ttime) & " by " & tname & "."
  1699. End If
  1700. Case "bcptop", "top"
  1701. If UBound(cmd) = 0 Then
  1702. t = 5
  1703. Else
  1704. t = Int(cmd(1))
  1705. End If
  1706. AddQ "/w " & psD2 & Username & " " & _
  1707. "Top " & t & " users: " & bcp_TopX(5)
  1708. End Select
  1709.  
  1710. On Error GoTo 0
  1711. If (Err.Number <> 0) Then
  1712. AddChat vbRed, "[BCP] An error has occured processing remote commands: " & Err.Description
  1713. End If
  1714.  
  1715. End Sub
  1716.  
  1717. Sub Event_WhisperFromUser(Username, Flags, Message, Ping)
  1718.  
  1719. ProperMessageA = bcp_Translate(Message)
  1720. If (IsArray(ProperMessageA)) Then
  1721. If Not ProperMessageA(0) = "?" Then
  1722. If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).Language = ProperMessageA(0)
  1723. ProperMessage = ProperMessageA(1)
  1724. If (ProperMessageA(0) <> "English") Then
  1725. AddChat vbGreen, "[BCP] Translated " & ProperMessageA(0) & " message to English (" & ProperMessage & ")"
  1726. End If
  1727. Else
  1728. ProperMessage = Message
  1729. End If
  1730. Else
  1731. ProperMessage = Message
  1732. End If
  1733.  
  1734. '// BCP_ENABLED_CHECK (whisper)
  1735. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1736.  
  1737. If Match(ProperMessage, "Your friend * has exited Battle.net.", True) Then
  1738. If bcpUsers.Exists(Username) Then
  1739. With bcpUsers.Item(Username)
  1740. If bcp_Get("Behavior", "LogoutOnExit") = True Then
  1741. If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
  1742. AddQ "/f r " & Username
  1743. End If
  1744.  
  1745. If .InGame Then
  1746. AddChat vbRed, "[BCP] User logged off while in a game, run removed."
  1747. .InGame = False
  1748. Set .GameObject = Nothing
  1749. If .Runs > 10 Then .GDB_Update("")
  1750. Exit Sub
  1751. End If
  1752. End With
  1753. End If
  1754. End If
  1755.  
  1756. parts = Split(ProperMessage, " ")
  1757. If Match(ProperMessage, "Your friend * entered a * game called *.", True) Then
  1758. game = Split(ProperMessage, " game called ")(1)
  1759. game = Left(game, Len(game)-1)
  1760. If (InStr(game, " eingeklinkt") > 0) and bcp_Get("Translations", "GermanLanguageSupport") Then
  1761. game = Replace(game, " eingeklinkt", "")
  1762. AddChat vbYellow, "[BCP] German support is enabled, this game name was fixed automatically."
  1763. End If
  1764.  
  1765. If (Len(bcp_Get("main", "filter")) = 0) Then
  1766. ok = True
  1767. m = game
  1768. Else
  1769. gf = Split( CStr(bcp_Get("main", "filter")), "|" )
  1770. ok = False
  1771. For i = 0 to UBound(gf)
  1772. If InStr(LCase(game), LCase(gf(i))) > 0 Then
  1773. m = gf(i)
  1774. ok = True
  1775. End If
  1776. Next
  1777. End If
  1778.  
  1779. For Each Key in bcpUsers.Keys
  1780. With bcpUsers.Item(Key)
  1781. If .InGame Then
  1782. If LCase(game) = LCase(.GameObject.Name) Then
  1783. If bcp_Get("Behavior", "LogoutOnPiggy") Then
  1784. If bcpIC.Exists(Username) Then
  1785. bcpIC.Item(Username).HideLogMsg = True
  1786. bcpIC.Item(Username).LastLog = DateAdd("n", 30, Now())
  1787. End If
  1788. AddQ "/f r " & Username
  1789. AddChat vbRed, "[BCP] This game already exists, removing " & Username & " from friends and restricting login for 30 minutes."
  1790. bcp_DebugMsg "User " & Username & " log action: game result: error upon creation: piggy backing turned off by host; user removed; user barred for 30 minutes"
  1791. Else
  1792. AddChat vbRed, "[BCP] This game already exists, the bot will ignore it for this user."
  1793. End If
  1794. Exit Sub
  1795. End If
  1796. End If
  1797. End With
  1798. Next
  1799.  
  1800. If Not ok Then
  1801. If bcp_Get("Behavior", "LogoutInvalidFilter") Then
  1802. If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
  1803. AddQ "/f r " & Username
  1804. bcp_DebugMsg "User " & Username & " log action: removal result: automatic: user joined an untagged game"
  1805. Else
  1806. AddChat vbRed, "[BCP] Game name has no valid tag, it was ignored."
  1807. bcp_DebugMsg "User " & Username & " log action: game result: error upon creation: game has no tags"
  1808. End If
  1809. Exit Sub
  1810. Else
  1811. m = game
  1812. End If
  1813.  
  1814. If bcpUsers.Exists(Username) Then
  1815. With bcpUsers.Item(Username)
  1816. If .InGame Then
  1817. AddChat vbRed, "[BCP] User is already in a game. Resetting game."
  1818. bcp_DebugMsg "User " & Username & " log action: game result: automatic: user is doubling games, last game dropped"
  1819. .EmptyGame
  1820. Set .GameObject = New bcp_Game
  1821. .GameObject.Name = game
  1822. .GameObject.Host = Username
  1823. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1824. .InGame = True
  1825. If .Runs > 10 Then .GDB_Update(m)
  1826. Exit Sub
  1827. End If
  1828.  
  1829. .InGame = True
  1830. Set .GameObject = New bcp_Game
  1831. .GameObject.Name = game
  1832. .GameObject.Host = Username
  1833. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1834. If .Runs > 10 Then .GDB_Update(m)
  1835. End With
  1836. Else
  1837. AddChat vbYellow, "[BCP] User doesn't exist..."
  1838. If bcpIC.Exists(Username) Then
  1839. bcpUsers.Add Username, bcpIC.Item(Username)
  1840. With bcpUsers.Item(Username)
  1841. AddChat vbGreen, "[BCP] " & .Title & " " & .Character & " (level " & .Level & ", " & .CClass & ") added to database."
  1842. bcp_DebugMsg "User " & Username & " log action: added result: automatic: user created game"
  1843. End With
  1844.  
  1845. With bcpUsers.Item(Username)
  1846. .InGame = True
  1847. Set .GameObject = New bcp_Game
  1848. .GameObject.Name = game
  1849. .GameObject.Host = Username
  1850. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1851. End With
  1852. Else
  1853. AddChat vbRed, "[BCP] User was not in the database, and had no channel reference. The user couldn't be added properly."
  1854. bcp_DebugMsg "User " & Username & " log action: added result: failure: user not found in internal channel"
  1855. End If
  1856. End If
  1857. End If
  1858.  
  1859. End Sub
  1860.  
  1861. Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString, Banned)
  1862. '// BCP_ENABLED_CHECK (user joins)
  1863. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1864.  
  1865. If bcpUsers.Exists(Username) Then
  1866. With bcpUsers.Item(Username)
  1867. If .InGame Then
  1868. bcp_EagleMsg "User " & Username & " experiencing ephemeral transition, stats update soon"
  1869. d = .GameObject.Duration()
  1870. If Not .GameTimeOK() Then
  1871. AddQ "/w " & psD2 & Username & " Your game was too fast or too slow. (" & d & " seconds)"
  1872. .LastGameName = "Invalid"
  1873. Call .EmptyGame()
  1874. bcp_DebugMsg "User " & Username & " log action: game result: failure: game too fast or too slow"
  1875. Else
  1876. AddChat vbGreen, "[BCP] " & .Character & " finished " & .GameObject.Name & " in " & d & " seconds."
  1877. Call .EmptyGame()
  1878. .Runs = .Runs + 1
  1879. .Time = .Time + d
  1880. If d < .Fastest or .Fastest = 0 Then
  1881. If .Fastest > 0 Then m = " This is your fastest game so far."
  1882. .Fastest = d
  1883. End If
  1884.  
  1885. AddQ "/w " & psD2 & Username & " Game #" & .Runs & " (" & .GameObject.Name & ") lasted " & bcp_FmtTime(d) & " (" & d & " seconds)." & m
  1886. End If
  1887. Set .GameObject = Nothing
  1888. Call .GDB_UpdateComp("", d)
  1889. End If
  1890.  
  1891. .StatString = Message
  1892. .Product = Product
  1893. .Level = Level
  1894. .Parse
  1895. End With
  1896. End If
  1897.  
  1898. If Not bcpIC.Exists(Username) Then
  1899. bcpIC.Add Username, new bcp_User
  1900. End If
  1901.  
  1902. With bcpIC.Item(Username)
  1903. .Username = Username
  1904. .Product = Product
  1905. .Level = Level
  1906. .StatString = Message
  1907. .Parse
  1908. End With
  1909. End Sub
  1910.  
  1911. Sub Event_UserLeaves(Username, Flags)
  1912. '// BCP_ENABLED_CHECK (leave)
  1913. If Not bcp_Get("Main", "BCPEnabled") Then Exit Sub
  1914.  
  1915. 'If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1916. End Sub
  1917.  
  1918. Sub Event_UserInChannel(Username, Flags, Message, Ping, Product, StatUpdate)
  1919. If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1920. bcpIC.Add Username, new bcp_User
  1921. With bcpIC.Item(Username)
  1922. .Username = Username
  1923. .Product = Product
  1924. .Level = Level
  1925. '// Fuck 2.6
  1926. .StatString = Split(Message, ")")
  1927. If UBound(.StatString) > 0 Then
  1928. .StatString = .StatString(UBound(.StatString)-1) & ")"
  1929. Else
  1930. .StatString = Message
  1931. End If
  1932. .Parse
  1933. End With
  1934. Message = ""
  1935. End Sub
  1936.  
  1937. Sub Event_PressedEnter(Text)
  1938.  
  1939. On Error Resume Next : Err.Clear
  1940. If Left(Text, 5) = "/bcp " Then
  1941. VetoThisMessage
  1942. cmd = Split(Mid(Text, 6), " ")
  1943. Select Case LCase(cmd(0))
  1944. Case "gdbinfo"
  1945. bcp_Set "GDB", "username", cmd(1), True
  1946. bcp_Set "GDB", "password", cmd(2), True
  1947. AddChat vbGreen, "[BCP] Global database username set to " & cmd(1) & _
  1948. " and password set to """ & cmd(2) & """."
  1949. Case "gdbloc"
  1950. bcp_Set "GDB", "location", cmd(1), True
  1951. AddChat vbGreen, "[BCP] Global database location set to: " & cmd(1)
  1952. Case "cfg", "config"
  1953. If UBound(cmd) >= 1 Then
  1954. Select Case LCase(cmd(1))
  1955. Case "get"
  1956. AddChat vbGreen, bcp_Get(cmd(2), cmd(3))
  1957. Case "set"
  1958. Call bcp_Set(cmd(2), cmd(3), Replace(cmd(4), "_", " "))
  1959. AddChat vbGreen, bcp_Get(cmd(2), cmd(3))
  1960. Case "open"
  1961. AddChat vbYellow, "[BCP] Attempting to open default BCP config..."
  1962. Set objShell = CreateObject("WScript.Shell")
  1963. objShell.Run BotPath() & "bcp_settings.ini"
  1964. Set objShell = Nothing
  1965. End Select
  1966. End If
  1967. Case "reset"
  1968. u = LCase(cmd(1))
  1969. For Each Key in bcpUsers.Keys
  1970. With bcpUsers.Item(Key)
  1971. If LCase(.Username) = u Then
  1972. .Runs = 0
  1973. .Time = 0
  1974. .Fastest = 0
  1975. .Save
  1976. AddChat vbYellow, "[BCP] Purge/Reset: " & .Username
  1977. Exit Sub
  1978. End If
  1979. End With
  1980. Next
  1981. AddChat vbRed, "[BCP] That user was not found. Please make sure you typed their account name correctly."
  1982. Case "purge"
  1983. If (UBound(cmd) = 0) Then
  1984. l = 100000
  1985. Else
  1986. l = Int(cmd(1))
  1987. End If
  1988.  
  1989. If Msgbox("Do you really want to remove every user with less than " & l & " runs?", vbYesNo, "Purge") <> vbYes Then
  1990. Exit Sub
  1991. End If
  1992.  
  1993. AddChat vbYellow, "[BCP] Purging players with less than " & l & " runs."
  1994. bcp_PurgeList l
  1995. AddChat vbGreen, "[BCP] Purge complete."
  1996. Case "trans", "transtest"
  1997. text = ""
  1998. For i = 1 to UBound(cmd)
  1999. text = text & cmd(i) & " "
  2000. Next
  2001. text = Trim(text)
  2002. r = bcp_Translate(text)
  2003. AddChat vbCyan, "[BCP] From " & r(0) & " to English: " & r(1)
  2004. Case "version"
  2005. AddChat vbCyan, "[BCP] BCP Version " & Script("Major") & "." & Script("Revision") & "." & Script("Minor") & " version ID " & vID & " by vi[r]us -- http://toshley.net/bcp"
  2006. AddChat vbCyan, "[BCP] Translations markup last changed 2.0.2 (20210); file version " & bcp_Get("Translations", "Version") & ".0 last updated " & bcp_Get("Translations", "LastUpdate") & "."
  2007. Case "eagleeyes", "eagleyes", "eagleye", "eagleeye"
  2008. newsetting = False
  2009. If (cmd(1) = "disable") Then newsetting = False
  2010. If (cmd(1) = "enable") Then newsetting = True
  2011. bcp_Set "Debug", "EagleEyes", newsetting, True
  2012. AddChat vbGreen, "[BCP] Eagle Eye functionality turned on: " & newsetting
  2013. Case "disable", "enable", "toggle"
  2014. If LCase(cmd(0)) = "disable" Then
  2015. bcp_Set "Main", "BCPEnabled", "False", True
  2016. 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."
  2017. ElseIf LCase(cmd(0)) = "enable" Then
  2018. bcp_Set "Main", "BCPEnabled", "True", True
  2019. AddChat vbGreen, "[BCP] Script enabled."
  2020. ElseIf LCase(cmd(0)) = "toggle" Then
  2021. If (bcp_Get("Main", "BCPEnabled")) Then
  2022. bcp_Set "Main", "BCPEnabled", "False", True
  2023. AddChat vbRed, "[BCP] Script disabled (only muted). You can type /bcp enable to restart the script."
  2024. Else
  2025. bcp_Set "Main", "BCPEnabled", "True", True
  2026. AddChat vbGreen, "[BCP] Script enabled."
  2027. End If
  2028. End If
  2029. Case "update"
  2030. bcp_CheckScriptVersion
  2031. Case "transupdate"
  2032. bcp_CheckTranslations
  2033. Case "mutual"
  2034. If (bcp_Mutual(cmd(1))) Then
  2035. AddChat vbGreen, "[BCP] Mutual (" & cmd(1) & "): yes"
  2036. Else
  2037. AddChat vbGreen, "[BCP] Mutual (" & cmd(1) & "): no"
  2038. End If
  2039. Case "news", "checknews"
  2040. bcp_CheckNews
  2041. Case "setup"
  2042. bcp_RunSetup()
  2043. Case "find"
  2044. If UBound(cmd) = 0 Then
  2045. u = BotVars.Username
  2046. Else
  2047. u = LCase(cmd(1))
  2048. For Each Key in bcpIC.Keys
  2049. ou = LCase(bcpIC.Item(Key).Username)
  2050. oc = LCase(bcpIC.Item(Key).Character)
  2051. If (ou = u) or (oc = u) Then
  2052. u = Key
  2053. Exit For
  2054. End If
  2055.  
  2056. If (InStr(ou, u) > 0) or (InStr(oc, u) > 0) Then
  2057. u = Key
  2058. End If
  2059. Next
  2060. End If
  2061.  
  2062. If Not bcpIC.Exists(u) Then
  2063. AddChat vbRed, "[BCP] Error: the bot has not seen that user since it was started"
  2064. Else
  2065. With bcpIC.Item(u)
  2066. lastseen = "(last seen: " & bcp_FmtTime( DateDiff("s", .LastSeen, Now())) & ".)"
  2067. ladder = "non-Ladder"
  2068. If (.IsLadder) Then ladder = "Ladder"
  2069. If (.IsHardcore) Then ladder = "hardcore " & ladder
  2070. If (.Friend()) Then friend = " (mutual friend)"
  2071. d2game = "Diablo II Classic"
  2072. If (.IsExpansion) Then d2game = "Diablo II Expansion"
  2073. m = "User " & .Username & " "
  2074. If .IsDiablo() Then
  2075. If .IsOpenCharacter() Then
  2076. m = m & "is an open character " & lastseen
  2077. Else
  2078. m = m & "(aka " & .Title & " " & .Character & ") is a " & ladder & " level " & .Level & " " & .CClass & " using " & d2game & " " & lastseen
  2079. End If
  2080. Else
  2081. m = m & "is not using Diablo II " & lastseen
  2082. End If
  2083. End With
  2084.  
  2085. AddChat vbGreen, "[BCP] " & m
  2086. End If
  2087. End Select
  2088. End If
  2089.  
  2090. If (Err.Number <> 0) Then
  2091. AddChat vbRed, "[BCP] An error has occured processing commands: " & Err.Description
  2092. End If
  2093. End Sub
  2094.  
  2095. Sub Event_Close()
  2096. If bcp_Get("Behavior", "SaveOnExit") Then bcp_SaveAll
  2097. bcp_GDBStatus "Absent"
  2098. End Sub
  2099.  
  2100. Sub bcp_DebugMsg(Text)
  2101. If bcp_Get("Debug", "enable") Then AddChat vbRed, "[BCP] [DEBUG] " & Text
  2102. End Sub
  2103.  
  2104. Sub bcp_EagleMsg(Text)
  2105. If bcp_Get("Debug", "EagleEyes") Then AddChat vbWhite, "[BCP] [EAGLE] " & Text
  2106. End Sub
  2107.  
  2108. Sub bcp_RunSetup()
  2109.  
  2110. ' question - cat - item - checknum - forcelcase - isquestion
  2111.  
  2112. stufflist = Array(Array("How much access should the bot require people to have to login and do runs?", "Commands", "login", True, False, False), _
  2113. Array("How much time, in seconds, should be the minimum time for a run to take in your channel?", "Main", "MinGame", True, False, False), _
  2114. Array("What about the maximum time a game can take? (seconds)", "Main", "MaxGame", True, False, False), _
  2115. Array("What is the minimum level required on a character to login? (1-99)", "Main", "MinLvl", True, False, False), _
  2116. Array("Should we allow non-ladder players to run games?", "Main", "AllowNonLadder", False, False, True), _
  2117. Array("Should we allow ladder players to run games?", "Main", "AllowLadder", False, False, True), _
  2118. Array("Should we allow hardcore players to run games?", "Main", "AllowHardcore", False, False, True), _
  2119. Array("What should the bot say when no games are available?", "Messages", "NoGames", False, False, False), _
  2120. Array("What text precedes the game list when they are available? (%i is used as the number of games)", "Messages", "GamePretext", False, False, False), _
  2121. 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), _
  2122. 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: pindle|chant|rush|cow|wckd|baal|chaos" & vbCrLf & "for chant and rush and cow and wckd and chaos and baal games.", "Main", "Filter", False, True, False), _
  2123. Array("Should the games list repeat every 60 seconds, or should it be done by the .games command?", "Main", "MsgType", False, False, True))
  2124.  
  2125. AddChat vbYellow, "[BCP] Welcome to BCP setup. The bot will now ask you some questions to help you set up the configuration file."
  2126.  
  2127. 'InputBox(prompt[,title][,default][,xpos][,ypos][,helpfile,context])
  2128.  
  2129. 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.")
  2130.  
  2131. For a = 0 to UBound(stufflist)
  2132. stuff = stufflist(a)
  2133. AddChat vbYellow, "[BCP] [" & stuff(1) & "]: " & stuff(2)
  2134. data = InputBox(stuff(0), "BCP 2.0 Setup", bcp_Get(stuff(1), stuff(2)))
  2135. If (stuff(3)) Then
  2136. If Not IsNumeric(data) Then data = bcp_Get(stuff(1), stuff(2))
  2137. End If
  2138. If (stuff(4)) Then
  2139. data = LCase(data)
  2140. End If
  2141. If (stuff(5)) Then
  2142. Select Case LCase(data)
  2143. Case "yes", "y", "true"
  2144. data = True
  2145. Case "no", "n", "false"
  2146. data = False
  2147. Case Else
  2148. data = "RESET"
  2149. End Select
  2150. End If
  2151. If data <> "RESET" Then
  2152. AddChat vbGreen, "[BCP] " & stuff(2) & " set to: " & data
  2153. bcp_Set stuff(1), stuff(2), data,True
  2154. Else
  2155. AddChat vbRed, "[BCP] " & stuff(2) & " was invalid and not set."
  2156. End If
  2157. Next
  2158.  
  2159. data = InputBox("While we're here, do you have a GDB account to set up?", "BCP 2.0 Setup", "yes/no")
  2160. If (data = "yes") Then
  2161. name = InputBox("GDB Username", "BCP 2.0 GDB Setup", "")
  2162. pass = InputBox("GDB Password", "BCP 2.0 GDB Setup", "")
  2163. loc = "http://toshley.net/bcp/sys/commit.php"
  2164. If (name = "") or (pass = "") Then
  2165. AddChat vbRed, "[BCP] You must input data for this."
  2166. Else
  2167. bcp_Set "GDB", "username", name, True
  2168. bcp_Set "GDB", "password", pass, True
  2169. bcp_Set "GDB", "location", loc, True
  2170. AddChat vbGreen, "[BCP] Global database username set to " & name & _
  2171. " and password set to """ & pass & """."
  2172. End If
  2173. Else
  2174. 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."
  2175. AddChat vbRed, "[BCP] If you have any other questions, check out http://toshley.net/bcp for more information."
  2176. End If
  2177.  
  2178. AddChat vbGreen, "[BCP] Setup complete."
  2179. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement