Advertisement
Guest User

Untitled

a guest
Oct 5th, 2017
95
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 34.70 KB | None | 0 0
  1. 'bcp
  2. '2.0
  3. '&The Baal Channel Project:IAreConnection
  4. '&login:logout:forcelogin <name>:forcelogout <name>:games:pref [options]:career [options]: *** For more command information, please go to python.bot.nu/bcp/help.php?view=Commands and browse the page.
  5. '&31402
  6. '&Settings are stored in "bcp_settings.ini" in your bot folder. (no quotes):Check out help topics @ python.bot.nu/bcp/help.php:The translations file should be included, however you may get it at python.bot.nu/bcp/downloads/translations/
  7.  
  8. Const bcpVID = 20110
  9.  
  10. ' // SETTINGS ARE NOW STORED IN A CONFIG FILE IN THE BOT'S FOLDER CALLED bcp_settings.ini
  11.  
  12. '===============
  13. '= Parenthesis "(" and ")" denote the user who found the bug, if it is
  14. '= not specified, they were found by the community or a developer.
  15. '===============
  16. ' ChangeLog for 2.0.1 (3/1/09)
  17. '
  18. ' * Fixed forcelogin and forcelogout Object required errors
  19. ' * Fixed 'second timer' error
  20. ' * Improved fail messages for commands to be more descriptive
  21. ' * Fixed open characters being parsed
  22. ' * Fixed career misdeclaration (steve)
  23. ' * Fixed preferences mistype (steve)
  24. ' * Misc stuff
  25.  
  26. ' ________________
  27. '/ Foreward
  28. '
  29. ' This is BCP 2; BCP 2.0 is a remake of my previous release of 1.8. Using it
  30. ' as a model I made this one and improved almost everything. The community's
  31. ' favorite features such as auto-spam and fastest game recorded have been
  32. ' hard-coded into the script for you.
  33. '
  34. ' There are many new features, and many ways to freely change it, moreso than
  35. ' the previous version. You may find it hard to adapt to this version. I have made
  36. ' it extremely user friendly and it almost sets itself up. You can download a translation
  37. ' file or make them yourself. The forum (listed below) can be used to submit them.
  38. '
  39. ' You will notice a script function programatically named the GDB. You can research
  40. ' it more on the site, but I only plan on making it available to well-respected users of
  41. ' Battle.net.
  42. '
  43. ' as always, show some love to the StealthBot, PyBot and respective scripting communities
  44. '
  45. ' Have fun guys, good luck
  46. ' -iareconnection
  47. '
  48. '\_________________
  49. ' / %%%%
  50. ' _______________/ %%%%%
  51. '/ Quick Links
  52. '
  53. ' ==> Help Topics
  54. ' http://python.bot.nu/bcp/help.php
  55. '
  56. ' ==> GDB Explained
  57. ' http://python.bot.nu/bcp/help.php?view=GDB
  58. '
  59. ' ==> Forum
  60. ' http://python.bot.nu/forum/
  61. '
  62. '\________________
  63.  
  64.  
  65.  
  66. '%=================================%
  67. '% %
  68. '% do not edit below here %
  69. '% consult bcp_settings.ini %
  70. '% %
  71. '%=================================%
  72.  
  73.  
  74.  
  75. Public bcpFSO, bcpUsers
  76. Public bcpIC, bcpLastGameRequest
  77. Public bcpLastProfileUpdate
  78. Public bcpLastConnect
  79.  
  80. Public bcpTmrSec, bcpTmrHr
  81. '// The internal channel contains a bcp_User object without run data to easily swap it.
  82.  
  83. Class bcp_Banlist
  84. Private FSO
  85.  
  86. Sub Class_Initialize()
  87. Set FSO = CreateObject("Scripting.FileSystemObject")
  88. End Sub
  89.  
  90. Function IsBanned(Username)
  91. End Function
  92.  
  93. Sub Ban(Username, Duration)
  94. End Sub
  95. End Class
  96.  
  97. Class bcp_User
  98. Public Username
  99. Public StatString
  100. Public Product
  101. Public Character
  102. Public CClass
  103. Public Title 'Slayer, etc
  104. Public Level 'Int
  105. Public InGame 'Bool
  106. Public GameObject 'bcp_Game
  107. Public Language
  108.  
  109. Public IsExpansion 'Bool
  110. Public IsLadder 'Bool
  111. Public IsHardcore 'Bool
  112.  
  113. Public Runs 'Int
  114. Public Time 'Int
  115. Public Fastest 'Int
  116. Public LastTime 'Int
  117. Public LastGameName
  118.  
  119. '// Personal
  120. Public HideGameDuration
  121. Public NameOverCharacter
  122.  
  123. Public HideLogMsg
  124. Public LastLog
  125.  
  126. '// Temporary
  127. Public CareerResetCode
  128.  
  129. Sub EmptyGame()
  130. If Not InGame Then Exit Sub
  131. InGame = False
  132. LastTime = GameObject.Duration()
  133. LastGameName = GameObject.Name
  134. End Sub
  135.  
  136. Sub Parse()
  137. 'Bot name differences, we have to make a system that agrees with both
  138. 'because Eric does not love me.
  139. '...
  140. '2.6: (Matriarch Swampie, a ladder level 90 sorceress on realm USEast).
  141. '2.7: (Champion Swampie, a level 90 ladder Sorceress on USEast).
  142.  
  143. If StatString = "Open Character" Then
  144. Character = Username
  145. CClass = "unknown"
  146. Title = ""
  147. Level = 0
  148. Exit Sub
  149. End If
  150.  
  151. On Error Resume Next : Err.Clear
  152. If UBound(Split(StatString, " ")) < 4 Then Product = "INVALID" : Exit Sub
  153. StatString = Split(StatString, " (")(1)
  154. StatString = Left(StatString, Len(StatString)-1)
  155. partA = Split(Split(StatString, ", ")(0), " ")
  156. partS = Split(StatString, ", ")(1)
  157. partB = Split(Split(StatString, ", ")(1), " ")
  158.  
  159. If UBound(partA) = 1 Then
  160. Title = partA(0)
  161. Character = partA(1)
  162. Else
  163. Title = "Player"
  164. Character = partA(0)
  165. End If
  166.  
  167. p = Array("Paladin", "Barbarian", "Assassin", "Druid", "Amazon", "Necromancer", "Sorceress")
  168.  
  169. Level = Int(Split(Split(partS, " level ")(1), " ")(0))
  170. For i = 0 to UBound(p)
  171. If InStr(LCase(partS), LCase(" " & p(i) & " ")) > 0 Then
  172. CClass = p(i)
  173. Exit For
  174. End If
  175. Next
  176. CClass = LCase(CClass)
  177.  
  178. If InStr(StatString, " ladder ") Then IsLadder = True
  179. If InStr(StatString, " hardcore ") Then IsHardcore = True
  180. If Product = "D2XP" Then IsExpansion = True
  181. On Error GoTo 0
  182. If Err.Number <> 0 Then AddChat vbRed, "[BCP] StatString Parse error: " & StatString
  183. Err.Clear
  184. End Sub
  185.  
  186. Function IsDiablo()
  187. If Product = "D2DV" or Product = "D2XP" Then
  188. IsDiablo = True
  189. Else
  190. IsDiablo = False
  191. End If
  192. End Function
  193.  
  194. Function FormatString(Message)
  195. m = Message
  196.  
  197. On Error Resume Next : Err.Clear
  198. a = Array("%user", "%name", "%char", "%class", "%lvl", _
  199. "%runid", "%total", "%avg", "%fst", "%title", _
  200. "%runs", "%game", "%gametime")
  201. b = Array(PreferedName(), Username, Character, CClass, Level, _
  202. Runs+1, bcp_FmtTime(Time), bcp_FmtTime(Average()), bcp_FmtTime(Fastest), Title, _
  203. Runs, GameObject.Name, bcp_FmtTime(GameObject.Duration()))
  204. On Error GoTo 0
  205. If Err.Number <> 0 Then AddChat vbRed, "[BCP] Format error " & Err.Number & ": " & Err.Description
  206.  
  207. For i = 0 to UBound(a)
  208. m = Replace(m, a(i), b(i))
  209. Next
  210.  
  211. FormatString = m
  212. End Function
  213.  
  214. Function GameTimeOK()
  215. If GameObject.Duration() < bcp_Get("main", "MinGame") or GameObject.Duration() > bcp_Get("main", "MaxGame") Then
  216. GameTimeOK = False
  217. Else
  218. GameTimeOK = True
  219. End If
  220. End Function
  221.  
  222. Sub Save()
  223. path = "bcp_users/" & LCase(Username) & ".user"
  224. If Runs = 0 Then
  225. If bcpFSO.FileExists(path) Then bcpFSO.DeleteFile(path)
  226. Exit Sub
  227. End If
  228.  
  229. WriteConfigEntry "UData", "Username", CStr(Username), path
  230. WriteConfigEntry "UData", "StatString", CStr(StatString), path
  231. WriteConfigEntry "UData", "Product", CStr(Product), path
  232. WriteConfigEntry "UData", "Level", CStr(Level), path
  233. WriteConfigEntry "UData", "Character", CStr(Character), path
  234. WriteConfigEntry "UData", "CClass", CStr(CClass), path
  235. WriteConfigEntry "UData", "Title", CStr(Title), path
  236. WriteConfigEntry "UData", "Runs", CStr(Runs), path
  237. WriteConfigEntry "UData", "Time", CStr(Time), path
  238. WriteConfigEntry "UData", "Fastest", CStr(Fastest), path
  239. WriteConfigEntry "UData", "LastTime", CStr(LastTime), path
  240. WriteConfigEntry "UData", "LastGameName", CStr(LastGameName), path
  241. WriteConfigEntry "UData", "Language", CStr(Language), path
  242. WriteConfigEntry "Personal", "HideGameDuration", CStr(HideGameDuration), path
  243. WriteConfigEntry "Personal", "NameOverCharacter", CStr(NameOverCharacter), path
  244. End Sub
  245.  
  246. Sub GDB_Update(Status)
  247. If Runs = 0 Then Exit Sub
  248. Call Save()
  249. If bcp_Get("GDB", "username") = "" or bcp_Get("GDB", "disable") = True Then
  250. Exit Sub
  251. End If
  252. AddChat vbYellow, "[BCP:GDB] Updating " & Username & "..."
  253. WebString = Username & "|" & _
  254. Character & "|" & _
  255. Runs & "|" & _
  256. Average() & "|" & _
  257. "R|" & Status & "|" & _
  258. Level & "|" & _
  259. CClass & "|" & _
  260. Time & "|" & _
  261. Fastest
  262.  
  263. uName = bcp_Get("GDB", "username")
  264. uPassword = bcp_Get("GDB", "password")
  265.  
  266. webURL = bcp_Get("GDB", "location") & "?u=" & uName & "&p=" & uPassword & "&item1=" & WebString
  267. On Error Resume Next : Err.Clear
  268. SciNet.Cancel
  269. t = Timer
  270. result = SciNet.OpenURL(CStr(webURL))
  271. t = Round(Timer-t, 2)
  272. If Not Err.Number = 0 Then
  273. AddChat vbRed, "[BCP] Note: Failed to update " & Username & " on the GDB."
  274. AddChat vbRed, Space(8) & Err.Number & ": " & Err.Description
  275. Err.Clear
  276. Else
  277. m = Split(result, " ", 2)
  278. If Int(m(0)) = 1 Then
  279. AddChat vbGreen, "[BCP:GDB] Success: " & m(1) & " (" & t & "s)"
  280. Else
  281. AddChat vbRed, "[BCP:GDB] Failure (" & m(0) & "): " & m(1)
  282. End If
  283. End If
  284. On Error GoTo 0
  285. End Sub
  286.  
  287. Function Rank()
  288. Rank = 0
  289. bubble = bcp_RankBubble()
  290. For i = 1 to UBound(bubble)
  291. If LCase(bubble(i)) = LCase(Username) Then
  292. Rank = i
  293. Exit Function
  294. End If
  295. Next
  296. End Function
  297.  
  298. Function Average()
  299. If Runs = 0 or Time = 0 Then Average = 0 : Exit Function
  300. Average = Int(Time / Runs)
  301. End Function
  302.  
  303. Function PreferedName()
  304. If NameOverCharacter Then
  305. PreferedName = Username
  306. Else
  307. PreferedName = Character
  308. End If
  309. End Function
  310.  
  311. Sub Class_Initialize()
  312. InGame = False
  313. Set GameObject = Nothing
  314. HideGameDuration = False
  315. NameOverCharacter = False
  316. HideLogMsg = True
  317. Runs = 0
  318. Level = 0
  319. Time = 0
  320. Fastest = 0
  321. LastTime = 0
  322. LastGameName = "Incomplete"
  323. IsLadder = False : IsHardcore = False
  324. LastLog = DateAdd("s", -(bcp_Get("main", "MsgNoSpam")), Now())
  325. CareerResetCode = "~" & Chr(0) & Chr(2) '// Can't type those
  326. End Sub
  327. End Class
  328.  
  329. Sub bcp_PurgeList(LimitOf)
  330. For Each Key in bcpUsers.Keys
  331. With bcpUsers.Item(Key)
  332. If .Runs < LimitOf Then
  333. .Runs = 0
  334. .Time = 0
  335. .Fastest = 0
  336. .Save
  337. AddChat vbRed, "[BCP] Purge: " & .Username
  338. End If
  339. End With
  340. Next
  341. End Sub
  342.  
  343. Sub bcp_Folder()
  344. If Not bcpFSO.FolderExists(BotPath() & "bcp_users") Then
  345. bcpFSO.CreateFolder(BotPath() & "bcp_users")
  346. AddChat vbGreen, "[BCP] Users are stored in: {BOTPATH}/bcp_users as configuration files"
  347. End If
  348. End Sub
  349.  
  350. Class bcp_Game
  351. Public Name
  352. Public Host
  353. Public Started
  354.  
  355. Function Duration()
  356. Duration = Abs(DateDiff("s", Started, Now()))
  357. End Function
  358.  
  359. Sub Class_Initialize()
  360. Started = Now()
  361. End Sub
  362. End Class
  363.  
  364. Function bcp_Mutual(Username)
  365. For Each Friend in Friends
  366. addchat vbgreen, friend.name & ":" & friend.ismutual
  367. If LCase(Friend.Name) = LCase(Username) Then
  368. If Friend.IsMutual Then
  369. bcp_Mutual = True
  370. Else
  371. bcp_Mutual = False
  372. End If
  373. End If
  374. Next
  375. End Function
  376.  
  377. Function bcp_Translate(Text)
  378. On Error Resume Next : Err.Clear
  379. Set file = bcpFSO.OpenTextFile(BotPath() & "bcp_translations.txt", 1)
  380. Q = Split(file.ReadAll(), vbCrLf)
  381. lang = "?"
  382. phixd = Text
  383.  
  384. For i = 0 to UBound(Q)
  385. p = Split(Q(i), "|")
  386. Name = p(0)
  387. Game = p(1)
  388. OE = p(2)
  389. Padding = Int(p(3))
  390.  
  391. If Match(Text, Game, True) Then
  392. lang = Name
  393. D = Split(Game, "*")
  394.  
  395. p_user = Split(Split(Text, D(0))(1), D(1))(0)
  396. p_prod = Split(Split(Text, D(1))(1), D(2))(0)
  397. p_gamename = Split(Text, D(2))(1)
  398. p_gamename = Left(p_gamename, Len(p_gamename)-1)
  399. If Padding > 0 Then p_gamename = Right(p_gamename, Len(p_gamename)-Padding)
  400. phixd = "Your friend " & p_user & " entered a " & p_prod & " game called " & p_gamename & "."
  401. End If
  402.  
  403. If Match(Text, OE, True) Then
  404. lang = Name
  405. D = Split(OE, "*")
  406.  
  407. p_user = Split(Split(Text, D(0))(1), D(1))(0)
  408. phixd = "Your friend " & p_user & " has exited Battle.net."
  409. End If
  410. Next
  411. file.Close
  412. If Err.Number <> 0 Then
  413. AddChat vbRed, "[BCP] Translation error: " & Err.Description
  414. Err.Clear
  415. lang = "?"
  416. phixd = Text
  417. End If
  418. bcp_Translate = Array(lang, phixd)
  419. End Function
  420.  
  421. Function bcp_RankBubble()
  422. Dim b()
  423. Sandbox = Split(Join(bcpUsers.Keys, chr(0)), chr(0))
  424. For i = 0 to UBound(Sandbox)
  425. Sandbox(i) = Sandbox(i) & "|" & bcpUsers.Item(Sandbox(i)).Runs
  426. Next
  427. Total = bcpUsers.Count
  428. ReDim b(Total)
  429. g = 0
  430. k = "?"
  431. n = 0
  432.  
  433. For i = 1 to Total
  434. For x = 0 to UBound(Sandbox)
  435. If Sandbox(x) <> "" Then
  436. q = Split(Sandbox(x), "|")
  437. If Int(q(1)) > g Then
  438. k = q(0)
  439. g = Int(q(1))
  440. n = x
  441. End If
  442. End If
  443. Next
  444. Sandbox(n) = ""
  445.  
  446. b(i) = k
  447. g = 0
  448. Next
  449. bcp_RankBubble = b
  450. End Function
  451.  
  452. Function bcp_FmtTime(Seconds)
  453. If Int(Seconds) < 60 Then bcp_FmtTime = Seconds & "s" : Exit Function
  454. s = Int(Seconds) : m = 0 : h = 0
  455. While s > 60
  456. s = s - 60
  457. m = m + 1
  458. If m = 60 Then m = 0 : h = h + 1
  459. WEnd
  460. If h > 0 Then ret = ret & h & " hours, "
  461. If m > 0 Then ret = ret & m & " minutes, "
  462. If s > 0 Then ret = ret & s & " seconds, "
  463. bcp_FmtTime = Left(ret, Len(ret)-2)
  464. End Function
  465.  
  466. Function bcp_FmtGameList()
  467. fmtA = bcp_Get("Messages", "GameReturn") & " "
  468. fmtB = bcp_Get("Messages", "GameDelimeter") & " "
  469.  
  470. smt = bcp_Get("Messages", "GamePretext")
  471. games = 0
  472. For Each Key in bcpUsers.Keys
  473. With bcpUsers.Item(Key)
  474. If .InGame Then
  475. games = games + 1
  476. smt = smt & .FormatString(fmtA) & fmtB
  477. End If
  478. End With
  479. Next
  480. If games > 0 Then
  481. smt = Replace(Left(smt, Len(smt)-Len(fmtB)), "%i", games)
  482. Else
  483. smt = bcp_Get("Messages", "NoGames")
  484. End If
  485.  
  486. bcp_FmtGameList = smt
  487. End Function
  488.  
  489. Sub bcp_Set(Section, Key, Value, Overwrite)
  490. If bcp_Get(Section, Key) <> "" and Overwrite = False Then Exit Sub
  491. ssc.WriteConfigEntry Section, Key, CStr(Value), "bcp_settings.ini"
  492. End Sub
  493.  
  494. Function bcp_Get(Section, Key)
  495. bcp_Get = ssc.GetConfigEntry(Section, Key, "bcp_settings.ini")
  496. If bcp_Get = "True" or bcp_Get = "False" Then bcp_Get = CBool(bcp_Get)
  497. if IsNumeric(bcp_Get) Then bcp_Get = Int(bcp_Get)
  498. End Function
  499.  
  500. Sub bcp_ReadAll()
  501. On Error Resume Next
  502. Set contents = bcpFSO.GetFolder(BotPath & "bcp_users")
  503. For Each file In contents.Files
  504. nameArr = Split(file, "\")
  505. name = "bcp_users/" & nameArr(UBound(nameArr))
  506. Set nameArr = Nothing
  507. If Len(name) > 6 Then
  508. If Right(name, 5) = ".user" Then
  509. Username = GetConfigEntry("UData", "Username", name)
  510. If Not bcpUsers.Exists(Username) and Len(Username) > 3 and Len(Username) < 32 Then
  511. bcpUsers.Add Username, new bcp_User
  512. Err.Clear
  513. With bcpUsers.Item(Username)
  514. .Username = Username
  515. .StatString = GetConfigEntry("UData", "StatString", name)
  516. .Product = GetConfigEntry("UData", "Product", name)
  517. .Character = GetConfigEntry("UData", "Character", name)
  518. .CClass = GetConfigEntry("UData", "CClass", name)
  519. .Title = GetConfigEntry("UData", "Title", name)
  520. .Level = Int(GetConfigEntry("UData", "Level", name))
  521. .Runs = Int(GetConfigEntry("UData", "Runs", name))
  522. .Time = Int(GetConfigEntry("UData", "Time", name))
  523. .Fastest = Int(GetConfigEntry("UData", "Fastest", name))
  524. .LastTime = Int(GetConfigEntry("UData", "LastTime", name))
  525. .LastGameName = GetConfigEntry("UData", "LastGameName", name)
  526. .Language = GetConfigEntry("UData", "Language", name)
  527. .HideGameDuration = CBool(GetConfigEntry("Personal", "HideGameDuration", name))
  528. .NameOverCharacter = CBool(GetConfigEntry("Personal", "NameOverCharacter", name))
  529. If Err.Number = 0 Then
  530. Else
  531. If Err.Number = 5 or Err.Number = 13 Then
  532. AddChat vbRed, "[BCP] It is possible " & Username & "'s profile needs to be updated. It should function correctly, however."
  533. Else
  534. AddChat vbRed, "[BCP] Error: " & Err.Number & ": " & Err.Description
  535. End If
  536. Err.Clear
  537. End If
  538. End With
  539. End If
  540. End If
  541. End If
  542. Next
  543. On Error GoTo 0
  544. End Sub
  545.  
  546. Sub bcp_SaveAll()
  547. For Each Key in bcpUsers.Keys
  548. bcpUsers.Item(Key).Save()
  549. Next
  550. AddChat vbGreen, "[BCP] All users saved."
  551. End Sub
  552.  
  553. Sub bcp_Startup()
  554. AddChat vbCyan, "[BCP] Starting up... please wait"
  555. t = Timer
  556. Set bcpFSO = CreateObject("Scripting.FileSystemObject")
  557. Set bcpUsers = CreateObject("Scripting.Dictionary")
  558. Set bcpIC = CreateObject("Scripting.Dictionary")
  559.  
  560. bcpIC.CompareMode = 1
  561. bcpUsers.CompareMode = 1
  562.  
  563.  
  564. '// 2.0
  565.  
  566. bcp_Set "Main", "FirstRun", "True", False
  567. bcp_Set "Main", "Filter", "chant|cs", False
  568. bcp_Set "Main", "MinGame", "60", False
  569. bcp_Set "Main", "MaxGame", "250", False
  570. bcp_Set "Main", "MinLvl", "80", False
  571. bcp_Set "Main", "MinPing", "-1", False
  572. bcp_Set "Main", "MsgType", "Ask", False 'Ask,Repeat
  573. bcp_Set "Main", "MsgNoSpam", "10", False
  574. bcp_Set "Main", "MsgDelay", "60", False
  575. bcp_Set "Main", "AllowLadder", "True", False
  576. bcp_Set "Main", "AllowNonLadder", "True", False
  577. bcp_Set "Main", "AllowHardcore", "True", False
  578.  
  579. bcp_Set "Commands", "games", "0", False
  580. bcp_Set "Commands", "login", "20", False
  581. bcp_Set "Commands", "logout", "20", False
  582. bcp_Set "Commands", "forcelogout", "60", False
  583. bcp_Set "Commands", "forcelogin", "60", False
  584. bcp_Set "Commands", "pref", "0", False
  585. bcp_Set "Commands", "career", "0", False
  586.  
  587. bcp_Set "Aliases", "baal", "games", False
  588. bcp_Set "Aliases", "chaos", "games", False
  589.  
  590. bcp_set "GDB", "username", "", False
  591. bcp_set "GDB", "password", "", False
  592. bcp_set "GDB", "location", "", False
  593.  
  594. '// 2.0 (1)
  595.  
  596. bcp_Set "Main", "ProfileUpdate", "3", False
  597.  
  598. bcp_Set "Behavior", "LogoutInvalidFilter", "False", False
  599. bcp_Set "Behavior", "LogoutOnExit", "True", False
  600. bcp_Set "Behavior", "SaveOnExit", "True", False
  601.  
  602. bcp_Set "CRS", "Enable", "True", False
  603.  
  604. bcp_Set "Messages", "GameReturn", "[ %game by %user ]", False
  605. bcp_Set "Messages", "GameDelimeter", ",", False
  606. bcp_Set "Messages", "NoGames", "/me : No games available.", False
  607. bcp_Set "Messages", "GamePretext", "/me : %i Games:", False
  608. bcp_Set "Messages", "NewGame", "/me : New game %game started by %user (level %lvl %class (run #%runid.))", False
  609.  
  610.  
  611. bcp_Folder
  612. bcp_ReadAll
  613.  
  614. bcpTmrSec = 0 : bcpTmrHr = 0
  615.  
  616. TimerInterval "bcp", "second", 1
  617. 'TimerInterval "bcp", "hour", 3600
  618.  
  619. TimerEnabled "bcp", "second", True
  620. 'TimerEnabled "bcp", "hour", True
  621.  
  622. bcpLastProfileUpdate = Now()
  623. bcpLastGameRequest = Now()
  624. bcpLastConnect = Now()
  625.  
  626. If Not bcpFSO.FileExists(BotPath() & "bcp_translations.txt") Then
  627. AddChat vbRed, "[BCP] You do not have a translations file. The translations file allows your channel patrons to use other Diablo non-english clients. Place it in your bot folder."
  628. AddChat vbRed, "[BCP] You can consult /phelp bcp for more information."
  629. End If
  630.  
  631. If bcp_Get("main", "firstrun") = True Then
  632. AddChat vbGreen, "[BCP] Welcome to BCP " & psVersions.Item("bcp") & " by IAreConnection [" & bcpVID & "]."
  633. AddChat vbYellow, "[BCP] If you are running BCP for the first time, please take the time to edit bcp_settings.ini to your liking. It is located in the bot's main folder (Settings->Edit Files->Open Bot Folder.)"
  634. AddChat vbYellow, "[BCP] Note: You may want to get additional translations and check for updates at: http://python.bot.nu/bcp"
  635. AddChat vbYellow, "[BCP] Thank you for using BCP."
  636. AddChat vbCyan, "[BCP] Note: You will also need to reset any GDB usernames, locations and passwords."
  637. bcp_Set "main", "firstrun", False, True
  638. Else
  639. t = Round(Timer-t, 2)
  640. 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""."
  641. AddChat vbCyan, "[BCP] BCP " & psVersions.Item("bcp") & " by IAreConnection: Loaded " & bcpUsers.Count & " profiles. (" & t & "ms)"
  642. End If
  643. End Sub
  644.  
  645. Sub bcp_second_Timer()
  646. 'On Error Resume Next : Err.Clear
  647.  
  648. For Each Key in bcpUsers.Keys
  649. With bcpUsers.Item(Key)
  650. If CBool(.InGame) Then
  651. If .GameObject.Duration() > (bcp_Get("main", "MaxGame") * 1.5) Then
  652. .InGame = False
  653. AddChat vbRed, "[BCP] " & .Username & "'s game has taken too long. Removing."
  654. .GDB_Update("")
  655. End If
  656. End If
  657. End With
  658. Next
  659.  
  660. 'Err.Clear : On Error GoTo 0
  661.  
  662. If Not IsOnline or (Abs(DateDiff("s", bcpLastConnect, Now())) < 60) Then
  663. 'AddChat vbRed, "[BCP] The bot is not online or has just connected. Refraining from messages/profile."
  664. Exit Sub
  665. End If
  666.  
  667. If LCase(bcp_Get("main", "MsgType")) = "repeat" Then
  668. bcpTmrSec = bcpTmrSec + 1
  669. If bcpTmrSec >= bcp_Get("main", "msgdelay") Then
  670. bcpTmrSec = 0
  671. AddQ bcp_FmtGameList()
  672. End If
  673. End If
  674.  
  675. On Error Resume Next : Err.Clear
  676.  
  677. x = bcp_Get("Main", "ProfileUpdate")
  678. If x > 1 Then
  679. If Abs(DateDiff("s", bcpLastProfileUpdate, Now())) > (x * 60) Then
  680. bcpLastProfileUpdate = Now()
  681. bodyOf = MyChannel & " Top Runners: " & vbCrLf
  682. bubble = bcp_RankBubble()
  683. If UBound(bubble) < 5 Then
  684. Exit Sub
  685. Else
  686. t = 5
  687. End If
  688. For i = 1 to t
  689. If bcpUsers.Exists(bubble(i)) Then
  690. bodyOf = bodyOf & bubble(i) & " (" & bcpUsers.Item(bubble(i)).Runs & ")" & vbCrLf
  691. End If
  692. Next
  693.  
  694. SetBotProfile "", "[BCP " & psVersions.Item("bcp") & "] http://python.bot.nu/bcp [" & bcpVID & "]", bodyOf
  695. End If
  696. End If
  697.  
  698. Err.Clear : On Error GoTo 0
  699. End Sub
  700.  
  701. Sub bcp_Event_Load()
  702. bcp_Startup
  703. End Sub
  704.  
  705. Sub bcp_Event_LoggedOn(Username, Product)
  706. bcpLastConnect = Now()
  707. End Sub
  708.  
  709. Sub bcp_Event_ServerInfo(Message)
  710. parts = Split(Message, " ")
  711. If InStr(Message, " your friends list.") > 0 Then
  712. If bcpIC.Exists(parts(1)) Then
  713. If bcpIC.Item(parts(1)).HideLogMsg Then
  714. bcpIC.Item(parts(1)).HideLogMsg = False
  715. AddChat vbYellow, "[BCP] Action OK but hidden."
  716. Exit Sub
  717. End If
  718. Else
  719. AddChat vbRed, "[BCP] Ignoring message, assuming you want it hidden."
  720. Exit Sub
  721. End If
  722.  
  723. If parts(0) = "Added" Then
  724. 'If bcp_Mutual(parts(1)) Then
  725. AddQ "/w " & psD2 & parts(1) & " You have been logged IN."
  726. 'Else
  727. ' AddQ "/w " & psD2 & parts(1) & " You have been logged IN, however you have not added me to your friends list."
  728. 'End If
  729. ElseIf parts(0) = "Removed" Then
  730. msg = "You have been logged OUT."
  731. If bcpUsers.Exists(parts(1)) Then
  732. With bcpUsers.Item(parts(1))
  733. If .Runs > 1 Then msg = "You have been logged OUT. You have completed " & .Runs & " games at roughly " & bcp_FmtTime(.Average()) & " (" & .Average() & " seconds) per game."
  734. End With
  735. End If
  736.  
  737. AddQ "/w " & psD2 & parts(1) & " " & msg
  738. End If
  739. End If
  740. End Sub
  741.  
  742. Sub bcp_Event_ServerError(Message)
  743. parts = Split(Message, " ")
  744. If Message = "You already have the maximum number of friends in your list. You will need to remove some of your friends before adding more." Then AddQ "BCP Error: There is no more room on my friends list"
  745.  
  746. If InStr(Message, " is already in your friends list.") Then
  747. If bcpIC.Exists(parts(0)) Then
  748. If bcpIC.Item(parts(0)).HideLogMsg Then
  749. bcpIC.Item(parts(0)).HideLogMsg = False
  750. AddChat vbYellow, "[BCP] Action OK but hidden."
  751. Exit Sub
  752. End If
  753. Else
  754. AddChat vbRed, "[BCP] Ignoring message, assuming you want it hidden."
  755. Exit Sub
  756. End If
  757.  
  758. AddQ "/w " & psD2 & parts(0) & " You are already logged IN."
  759. End If
  760. End Sub
  761.  
  762. Sub bcp_Event_UserTalk(Username, Flags, Message, Ping)
  763.  
  764. b = BotVars.Trigger
  765. GetDBEntry Username, a, f
  766. If Left(Message, Len(b)) = b Then
  767. cmd = Split(Mid(Message, Len(b)+1), " ")
  768. Else
  769. Exit Sub
  770. End If
  771.  
  772. If bcp_Get("aliases", LCase(cmd(0))) <> "" Then
  773. newcmd = bcp_Get("aliases", LCase(cmd(0)))
  774. AddChat vbCyan, "[BCP] " & cmd(0) & " --> " & newcmd
  775. cmd(0) = newcmd
  776. End If
  777.  
  778. If bcp_Get("commands", LCase(cmd(0))) <> "" Then
  779. cmdA = Int(bcp_Get("commands", LCase(cmd(0))))
  780. If (a < cmdA) and (Not cmdA = 0) Then
  781. AddChat vbRed, "[BCP] Error: " & Username & " is not authorized to do this command"
  782. Exit Sub
  783. End If
  784. Else
  785. Exit Sub
  786. End If
  787.  
  788. If Not bcpIC.Exists(Username) Then
  789. AddChat vbRed, "[BCP] No channel object for " & Username & "... they may need to rejoin the channel"
  790. Exit Sub
  791. End If
  792.  
  793. Select Case LCase(cmd(0))
  794. Case "games"
  795. If Not LCase(bcp_Get("main", "MsgType")) = "ask" Then
  796. AddChat vbRed, "[BCP] Games are repeated."
  797. Exit Sub
  798. Else
  799. If Abs(DateDiff("s", bcpLastGameRequest, Now())) < bcp_Get("main", "MsgNoSpam") Then
  800. AddChat vbRed, "[BCP] Waiting until cooldown expires..."
  801. Exit Sub
  802. End If
  803. AddQ bcp_FmtGameList()
  804. bcpLastGameRequest = Now()
  805. End If
  806. Case "login"
  807. If Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now())) < bcp_Get("main", "MsgNoSpam") Then
  808. AddChat vbRed, "[BCP] Wait " & (bcp_Get("main", "MsgNoSpam") - Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now()))) & " seconds."
  809. Exit Sub
  810. End If
  811.  
  812. bcpIC.Item(Username).LastLog = Now()
  813. If (Ping > bcp_Get("main", "MinPing")) and (bcp_Get("main", "MinPing") <> -1) Then
  814. AddQ "/w " & psD2 & Username & " You must have a ping lower than " & bcp_Get("main", "MinPing") & " to login."
  815. Exit Sub
  816. End If
  817.  
  818. If (Not bcp_Get("main", "AllowHardcore")) and (bcpIC.Item(Username).IsHardcore) Then
  819. AddQ "/w " & psD2 & Username & " Hardcore characters are not permitted to login."
  820. Exit Sub
  821. End If
  822.  
  823. If (Not bcp_Get("main", "AllowNonLadder")) and (Not bcpIC.Item(Username).IsLadder) Then
  824. AddQ "/w " & psD2 & Username & " Non-ladder characters are not permitted to login."
  825. Exit Sub
  826. End If
  827.  
  828. If (Not bcp_Get("main", "AllowLadder")) and (bcpIC.Item(Username).IsLadder) Then
  829. AddQ "/w " & psD2 & Username & " Ladder characters are not permitted to login."
  830. Exit Sub
  831. End If
  832.  
  833. If bcpIC.Item(Username).Level < bcp_Get("main", "MinLvl") Then
  834. AddQ "/w " & psD2 & Username & " You must be at least level " & bcp_Get("main", "MinLvl") & " to login."
  835. Exit Sub
  836. End If
  837. bcpIC.Item(Username).HideLogMsg = False
  838. AddQ "/f a " & Username
  839. Case "logout"
  840. If Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now())) < bcp_Get("main", "MsgNoSpam") Then
  841. AddChat vbRed, "[BCP] Wait " & (bcp_Get("main", "MsgNoSpam") - Abs(DateDiff("s", bcpIC.Item(Username).LastLog, Now()))) & " seconds."
  842. Exit Sub
  843. End If
  844.  
  845. bcpIC.Item(Username).LastLog = Now()
  846. bcpIC.Item(Username).HideLogMsg = False
  847. If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).GDB_Update("")
  848. AddQ "/f r " & Username
  849. Case "forcelogin"
  850. If bcpIC.Exists(cmd(1)) Then
  851. bcpIC.Item(cmd(1)).HideLogMsg = True
  852. Else
  853. AddChat vbYellow, "[BCP] I cannot see " & cmd(1) & " in the channel."
  854. End If
  855. AddQ "/f a " & cmd(1)
  856. Case "forcelogout"
  857. If bcpIC.Exists(cmd(1)) Then
  858. bcpIC.Item(cmd(1)).HideLogMsg = True
  859. Else
  860. AddChat vbYellow, "[BCP] I cannot see " & cmd(1) & " in the channel."
  861. End If
  862. AddQ "/f r " & cmd(1)
  863. Case "pref"
  864. If bcpUsers.Exists(Username) Then
  865. If UBound(cmd) = 0 Then
  866. AddQ "/w " & psD2 & Username & " " & _
  867. "Preferences available to you: hidecharacter, hideduration"
  868. Exit Sub
  869. End If
  870.  
  871. With bcpUsers.Item(Username)
  872. Select Case LCase(cmd(1))
  873. Case "hcn", "hidecharacter", "showaccount", "showname"
  874. If .NameOverCharacter Then
  875. .NameOverCharacter = False
  876. AddQ "/w " & psD2 & Username & " " & _
  877. "Your character will now be shown instead of your account name."
  878. Else
  879. .NameOverCharacter = True
  880. AddQ "/w " & psD2 & Username & " " & _
  881. "Your account name will now be shown instead of your character."
  882. End If
  883. Case "hd", "hideduration", "hideinfo", "hidedata"
  884. If .HideGameDuration Then
  885. .HideGameDuration = False
  886. AddQ "/w " & psD2 & Username & " " & _
  887. "The bot will now whisper you your last game's duration and name."
  888. Else
  889. .HideGameDuration = True
  890. AddQ "/w " & psD2 & Username & " " & _
  891. "The bot will now refrain from whispering you your game's data."
  892. End If
  893. End Select
  894. End With
  895. Else
  896. AddQ "/w " & psD2 & Username & " " & _
  897. "You do not have a career here, you cannot set preferences."
  898. End If
  899. Case "career", "my"
  900. If bcpUsers.Exists(Username) Then
  901. With bcpUsers.Item(Username)
  902. Select Case LCase(cmd(1))
  903. Case "info", "data"
  904. AddQ "/w " & psD2 & Username & " " & _
  905. "You have completed " & .Runs & " runs at " & bcp_FmtTime(.Average()) & " (" & .Average() & "s) each (ranked #" & .Rank() & " of " & bcpUsers.Count & "). Your fastest was " & bcp_FmtTime(.Fastest) & ". Your last was " & bcp_FmtTime(.LastTime) & "."
  906. Case "reset", "delete"
  907. Randomize
  908. .CareerResetCode = CStr(Int( Rnd * 100000 ) + 1000)
  909. AddQ "/w " & psD2 & Username & " " & _
  910. "Please type '" & BotVars.Trigger & "career confirmdelete " & .CareerResetCode & "' (no quotes) to confirm this."
  911. Case "confirmdelete", "confirm", "deletecode", "resetcode"
  912. If .CareerResetCode = cmd(2) Then
  913. .Runs = 0
  914. .Time = 0
  915. .Fastest = 0
  916. .Save
  917. AddQ "/w " & psD2 & Username & " " & _
  918. "Your career (runs, time, average, fastest game) has been reset."
  919. Else
  920. AddQ "/w " & psD2 & Username & " " & _
  921. "Your code is " & .CareerResetCode & "."
  922. End If
  923. End Select
  924. End With
  925. Else
  926. AddQ "/w " & psD2 & Username & " " & _
  927. "You do not have a career here."
  928. End If
  929. End Select
  930.  
  931. End Sub
  932.  
  933. Sub bcp_Event_WhisperFromUser(Username, Flags, Message, Ping)
  934.  
  935. ProperMessageA = bcp_Translate(Message)
  936. If Not ProperMessageA(0) = "?" Then
  937. If bcpUsers.Exists(Username) Then bcpUsers.Item(Username).Language = ProperMessageA(0)
  938. ProperMessage = ProperMessageA(1)
  939. AddChat vbGreen, "[BCP] Language: " & ProperMessageA(0) & " message (" & ProperMessage & ")"
  940. Else
  941. ProperMessage = Message
  942. End If
  943.  
  944. If Match(ProperMessage, "Your friend * has exited Battle.net.", True) Then
  945. If bcpUsers.Exists(Username) Then
  946. With bcpUsers.Item(Username)
  947. If bcp_Get("Behavior", "LogoutOnExit") = True Then
  948. If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
  949. AddQ "/f r " & Username
  950. End If
  951.  
  952. If .InGame Then
  953. AddChat vbRed, "[BCP] User logged off while in a game, run removed."
  954. .InGame = False
  955. Set .GameObject = Nothing
  956. If .Runs > 10 Then .GDB_Update("")
  957. Exit Sub
  958. End If
  959. End With
  960. End If
  961. End If
  962.  
  963. parts = Split(ProperMessage, " ")
  964. If Match(ProperMessage, "Your friend * entered a * game called *.", True) Then
  965. game = Split(ProperMessage, " game called ")(1)
  966. game = Left(game, Len(game)-1)
  967. gf = Split( CStr(bcp_Get("main", "filter")), "|" )
  968. ok = False
  969. For i = 0 to UBound(gf)
  970. If InStr(LCase(game), LCase(gf(i))) > 0 Then
  971. m = gf(i)
  972. ok = True
  973. End If
  974. Next
  975.  
  976. If Not ok Then
  977. If bcp_Get("Behavior", "LogoutInvalidFilter") Then
  978. If bcpIC.Exists(Username) Then bcpIC.Item(Username).HideLogMsg = True
  979. AddQ "/f r " & Username
  980. Else
  981. AddChat vbRed, "[BCP] Game name has no valid tag, it was ignored."
  982. End If
  983. Exit Sub
  984. Else
  985. m = game
  986. End If
  987.  
  988. If bcpUsers.Exists(Username) Then
  989. With bcpUsers.Item(Username)
  990. If .InGame Then
  991. AddChat vbRed, "[BCP] User is already in a game. Resetting game."
  992. .EmptyGame
  993. Set .GameObject = New bcp_Game
  994. .GameObject.Name = game
  995. .GameObject.Host = Username
  996. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  997. .InGame = True
  998. If .Runs > 10 Then .GDB_Update(m)
  999. Exit Sub
  1000. End If
  1001.  
  1002. .InGame = True
  1003. Set .GameObject = New bcp_Game
  1004. .GameObject.Name = game
  1005. .GameObject.Host = Username
  1006. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1007. If .Runs > 10 Then .GDB_Update(m)
  1008. End With
  1009. Else
  1010. AddChat vbYellow, "[BCP] User doesn't exist..."
  1011. If bcpIC.Exists(Username) Then
  1012. bcpUsers.Add Username, bcpIC.Item(Username)
  1013. With bcpUsers.Item(Username)
  1014. AddChat vbGreen, "[BCP] " & .Title & " " & .Character & " (level " & .Level & ", " & .CClass & ") added to database."
  1015. End With
  1016.  
  1017. With bcpUsers.Item(Username)
  1018. .InGame = True
  1019. Set .GameObject = New bcp_Game
  1020. .GameObject.Name = game
  1021. .GameObject.Host = Username
  1022. AddQ .FormatString(bcp_Get("Messages", "NewGame"))
  1023. End With
  1024. Else
  1025. AddChat vbRed, "[BCP] User was not in the database, and had no channel reference. The user couldn't be added properly."
  1026. End If
  1027. End If
  1028. End If
  1029.  
  1030. End Sub
  1031.  
  1032. Sub bcp_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString, Banned)
  1033. If bcpUsers.Exists(Username) Then
  1034. With bcpUsers.Item(Username)
  1035. If .InGame Then
  1036. d = .GameObject.Duration()
  1037. If Not .GameTimeOK() Then
  1038. AddQ "/w " & psD2 & Username & " Your game was too fast or too slow. (" & d & " seconds)"
  1039. .LastGameName = "Invalid"
  1040. Call .EmptyGame()
  1041. Else
  1042. AddChat vbGreen, "[BCP] " & .Character & " finished " & .GameObject.Name & " in " & d & " seconds."
  1043. Call .EmptyGame()
  1044. .Runs = .Runs + 1
  1045. .Time = .Time + d
  1046. If d < .Fastest or .Fastest = 0 Then
  1047. If .Fastest > 0 Then m = " This is your fastest game so far."
  1048. .Fastest = d
  1049. End If
  1050.  
  1051. AddQ "/w " & psD2 & Username & " Game #" & .Runs & " (" & .GameObject.Name & ") lasted " & bcp_FmtTime(d) & " (" & d & " seconds)." & m
  1052. End If
  1053. Set .GameObject = Nothing
  1054. .GDB_Update("")
  1055. End If
  1056.  
  1057. .StatString = Message
  1058. .Product = Product
  1059. .Level = Level
  1060. .Parse
  1061. End With
  1062. End If
  1063.  
  1064. If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1065. bcpIC.Add Username, new bcp_User
  1066. With bcpIC.Item(Username)
  1067. .Username = Username
  1068. .Product = Product
  1069. .Level = Level
  1070. .StatString = Message
  1071. .Parse
  1072. End With
  1073. End Sub
  1074.  
  1075. Sub bcp_Event_UserLeaves(Username, Flags)
  1076. 'If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1077. End Sub
  1078.  
  1079. Sub bcp_Event_UserInChannel(Username, Flags, Message, Ping, Product, StatUpdate)
  1080. If bcpIC.Exists(Username) Then bcpIC.Remove Username
  1081. bcpIC.Add Username, new bcp_User
  1082. With bcpIC.Item(Username)
  1083. .Username = Username
  1084. .Product = Product
  1085. .Level = Level
  1086. '// Fuck 2.6
  1087. .StatString = Split(Message, ")")
  1088. If UBound(.StatString) > 0 Then
  1089. .StatString = .StatString(UBound(.StatString)-1) & ")"
  1090. Else
  1091. .StatString = Message
  1092. End If
  1093. .Parse
  1094. End With
  1095. Message = ""
  1096. End Sub
  1097.  
  1098. Sub bcp_Event_PressedEnter(Text)
  1099.  
  1100. If Left(Text, 5) = "/bcp " Then
  1101. VetoThisMessage
  1102. cmd = Split(Mid(Text, 6), " ")
  1103. Select Case LCase(cmd(0))
  1104. Case "gdbinfo"
  1105. bcp_Set "GDB", "username", cmd(1), True
  1106. bcp_Set "GDB", "password", cmd(2), True
  1107. AddChat vbGreen, "[BCP] Global database username set to " & cmd(1) & _
  1108. " and password set to """ & cmd(2) & """."
  1109. Case "gdbloc"
  1110. bcp_Set "GDB", "location", cmd(1), True
  1111. AddChat vbGreen, "[BCP] Global database location set to: " & cmd(1)
  1112. Case "cfg", "config"
  1113. Select Case LCase(cmd(1))
  1114. Case "get"
  1115. AddChat vbGreen, bcp_Get(cmd(2), cmd(3))
  1116. Case "set"
  1117. Call bcp_Set(cmd(2), cmd(3), Replace(cmd(4), "_", " "))
  1118. AddChat vbGreen, bcp_Get(cmd(2), cmd(3))
  1119. End Select
  1120. Case "purge"
  1121. l = Int(cmd(1))
  1122. AddChat vbYellow, "[BCP] Purging players with less than " & l & " runs."
  1123. bcp_PurgeList l
  1124. AddChat vbGreen, "[BCP] Purge complete."
  1125. End Select
  1126. End If
  1127.  
  1128. End Sub
  1129.  
  1130. Sub bcp_Event_Close()
  1131. If bcp_Get("Behavior", "SaveOnExit") Then bcp_SaveAll
  1132. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement