API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jan 23rd, 2018
66
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 85.34 KB | None | 0 0
raw download clone embed print report
  1. Script("Name") = "crs"
  2. Script("Author") = "The-Black-Ninja, original author: Swent"
  3. Script("Major") = 1
  4. Script("Minor") = 19
  5. Script("Revision") = 0
  6. Script("Description") = "Extends Battle.Net's clan management capabilities."
  7.  
  8.  
  9. '// Change Log
  10. '//
  11. '// :: v1.18 - v1.19 ::
  12. '// -> Added a filter by rank option for the crsAdmin members command - Thanks Red
  13. '// :: v1.17 - v1.18 ::
  14. '// -> Fixed adding unique greets for a username - Thanks DaveTheBat
  15. '// :: v1.16 - v1.17 ::
  16. '// -> Added settings option to auto-remove user from bot database when removed from CRS database - Thanks DaveTheBat
  17. '// :: v1.9 - v1.16 ::
  18. '// -> Various fixes
  19. '// -> Fixed issue with auto-promote
  20. '// :: v1.9 - v1.10 ::
  21. '// -> Fixed issue with setting members to a rank by specifying a name instead of a number - Thanks Spiritless
  22. '// -> Fixed issue with adding reasons that contain apostrophe's
  23. '// :: v1.8 - v1.9 ::
  24. '// -> Corrected some spelling mistakes
  25. '// -> Fixed issue for the auto-promote
  26. '// -> Fixed issue with an infinite loop happening when you have 0 files in the backup folder and the backup_num value is set to 1 or more
  27. '// -> Altered how commands were created to allow for a better command description
  28. '// :: v1.7 - v1.8 ::
  29. '// -> Added anti-spam settings for greetings.
  30. '// :: v1.6 - v1.7 ::
  31. '// -> Added command to mass set users from the bot's clan to a certain crs rank depending on their clan rank (peon, grunt, shaman) - Thanks 008
  32. '// -> Fixed issue with using commands offline - Thanks Tower
  33. '// -> Fixed error when removing a non-existant user from the database - Thanks Tower
  34. '// -> Fixed error when setting a user to a specific rank - Thanks Tower
  35. '// -> Minor fix with the ini about greeting users when they enter.
  36. '// :: v1.5 - v1.6 ::
  37. '// -> Fixed issue with IsAlterValid - Thanks Tower
  38.  
  39.  
  40.  
  41. Public crsConn '// Holds database connection
  42. Public crsRanks() '// Holds rank names specified in program settings
  43. Public crsRankAccess() '// Holds access for the ranks
  44. Public crsDatabasePath '// Holds database file path
  45. Private crsFSO '// FileSystemObject
  46. Private crsUsers '// Holds their time spent in channel, in seconds
  47. Private crsGreetUsers '// Holds their time since last greet
  48. Private crsLastGreet '// Holds the time of last greet
  49.  
  50.  
  51. '// Notes
  52. '// --> Any columns having a date and time is formatted in mm/dd/YYY and the time. This allows for using DateDiff with the row value and the Now function without giving a crazy number.
  53.  
  54.  
  55. Sub Event_Load()
  56.  
  57. '// [ Rank Settings ]
  58. '// =============================================================================================================
  59. '// GUIDE TO CUSTOMIZING YOUR CRS RANKS - READ THIS BEFORE CHANGING ANYTHING!
  60. '//
  61. '// <<<<< ALL MODIFICATIONS TO THE NUMBER OF EXISTING RANKS SHOULD BE MADE *BEFORE* YOU START ADDING MEMBERS >>>>>
  62.  
  63. '// If ** you haven't added members yet **, FOLLOW THESE SIMPLE STEPS TO CUSTOMIZE YOUR RANKS:
  64. '// 1) You may have as many ranks as you want. List them out in the RANK LIST section below in this format (WITHOUT the '//):
  65. '// crsRanks(1) = "first rank name" : crsRankAccess(1) = 90
  66. '// crsRanks(2) = "second rank name" : crsRankAccess(2) = 60
  67. '// crsRanks(3) = "third rank name" : crsRankAccess(3) = 30
  68. '// Don't forget to set each rank's access on the same line like the example provides!!!
  69. '// 2) After you finish writing your ranks, ** you MUST change the numRanks variable, above our ranks, to the value of your GREATEST NUMBERED RANK
  70. '// Example: If my rank list was the three ranks above, I would change the value numRanks to 3
  71. '// 3) Inside your bot hit Settings > Reload Script
  72.  
  73. '// If you HAVE already added members, and you need to change the number of ranks, follow these steps:
  74. '// 1) Close your bot.
  75. '// 2) Go to your StealthBot folder. Delete "MemberData.mdb"
  76. '// 3) Make the desired rank modifications below.
  77. '// 4) Open your bot back up.
  78. '// 5) All of the your rank data will be gone, so you'll need to read all of your members.
  79. '// Note that after adding members, modifying the NAMES of existing ranks is fine, as long as you don't change the number that exist.
  80.  
  81. '// ========= This line needs to be changed after you've altered the amount of ranks you have ============
  82.  
  83. numRanks = 14 '// Highest number of ranks. Change this value after adding or removing ranks.
  84.  
  85. '// =========================================================================================================
  86.  
  87. ReDim crsRanks(numRanks + 1): crsRanks(0) = "Unranked" '// Do not modify this line
  88. ReDim crsRankAccess(numRanks + 1): crsRankAccess(0) = "Unranked" '// Do not modify this line
  89.  
  90. '// <<<< RANK LIST -- YOUR RANKS SHOULD BE LISTED ** BELOW ** HERE >>>>
  91.  
  92. crsRanks(1) = "Night Angel" : crsRankAccess(1) = 10
  93. crsRanks(2) = "Speaker" : crsRankAccess(2) = 10
  94. crsRanks(3) = "Silencer" : crsRankAccess(3) = 10
  95. crsRanks(4) = "Assassin" : crsRankAccess(4) = 10
  96. crsRanks(5) = "Eliminator" : crsRankAccess(5) = 10
  97. crsRanks(6) = "Slayer" : crsRankAccess(6) = 10
  98. crsRanks(7) = "Murderer" : crsRankAccess(7) = 10
  99. crsRanks(8) = "Creed Probation Lvl 5" : crsRankAccess(8) = 10
  100. crsRanks(9) = "Creed Probation Lvl 4" : crsRankAccess(9) = 10
  101. crsRanks(10) = "Creed Probation Lvl 3" : crsRankAccess(10) = 10
  102. crsRanks(11) = "Creed Probation Lvl 2" : crsRankAccess(11) = 10
  103. crsRanks(12) = "Creed Probation Lvl 1" : crsRankAccess(12) = 10
  104. crsRanks(13) = "Thug" : crsRankAccess(13) = 10
  105. crsRanks(14) = "Banned" : crsRankAccess(14) = 0
  106. '// <<<< YOUR RANKS SHOULD BE LISTED ** ABOVE ** HERE >>>>
  107.  
  108. If crsRanks(UBound(crsRanks)-1) = vbNullString OR crsRankAccess(UBound(crsRankAccess)-1) = vbNullString Then
  109. AddChat 16759296, "CRS Script:. ", 5731327, "ERROR: Your "" numRanks "" does not match up with your maximum crsRank value or your maximum crsRankAccess value. Consult this post for information on this error: "
  110. AddChat vbGreen, "http://www.stealthbot.net/forum/index.php?showtopic=368&st=0#FAQ_ErrNum"
  111. End If
  112.  
  113. If GetSettingsEntry("dsllLimit") = vbNullString Then
  114. WriteSettingsEntry "'// For all settings that have a True or False, True enables the setting, False disables the setting. Do not remove the True/False, simply put one or the other.", vbNullString
  115. WriteSettingsEntry "'// This setting will determine how many backups of the CRS database you want to keep; -1 = unlimited, 0 = disable this feature", vbNullString
  116. WriteSettingsEntry "'// Any other number will reflect how many backups will be in the folder. Once that limit is reached, the script will start deleting the oldest backup to make room.", vbNullString
  117. WriteSettingsEntry "'// When the bot closes or you reload the script, the CRS script will make a backup into a directory called CRS DB Backups.", vbNullString
  118. WriteSettingsEntry "backupNum", -1
  119. WriteSettingsEntry "'// Clan Name.", vbNullString
  120. WriteSettingsEntry "clan_name", "Black Hand Assassins"
  121. WriteSettingsEntry "'// Enable CRS auto-access so when users are promoted to different ranks, their access will be automatically adjusted according to each rank's access setting.", vbNullString
  122. WriteSettingsEntry "aa_on", False
  123. WriteSettingsEntry "'// Enable CRS auto-access removal so when users are removed from the CRS database, their entry in the bot's Database Manager will also be removed.", vbNullString
  124. WriteSettingsEntry "aa_rem_on", False
  125. WriteSettingsEntry "'// Set autoadd_tag_on to True to automatically add members to the database with a certain tag in their name (autoadd_tag).", vbNullString
  126. WriteSettingsEntry "autoadd_tag_on", False
  127. WriteSettingsEntry "autoadd_tag", "(BHA)"
  128. WriteSettingsEntry "'// Demotes users with X days of last logging into the channel.", vbNullString
  129. WriteSettingsEntry "dsllLimit", 10
  130. WriteSettingsEntry "'// Enable auto-demote based on days of last channel log in.", vbNullString
  131. WriteSettingsEntry "dsll_on", True
  132. WriteSettingsEntry "'// Every X days (dayIncrement) in the clan, users will be promoted starting from the numerical rank of dayLowRank, stopping at dayHighRank", vbNullString
  133. WriteSettingsEntry "'// Disable this system by setting dayPromote_on to False", vbNullString
  134. WriteSettingsEntry "dayPromote_on", True
  135. WriteSettingsEntry "dayHighRank", 7
  136. WriteSettingsEntry "dayLowRank", 12
  137. WriteSettingsEntry "dayIncrement", 5
  138. WriteSettingsEntry "'// For every X recruits recruited (recruitIncrement), users will be promoted starting from the numerical rank of recruitLowRank, stopping at recruitHighRank", vbNullString
  139. WriteSettingsEntry "'// Disable this system by setting recruitPromote_on to False", vbNullString
  140. WriteSettingsEntry "recruitPromote_on", True
  141. WriteSettingsEntry "recruitHighRank", 6
  142. WriteSettingsEntry "recruitLowRank", 4
  143. WriteSettingsEntry "recruitIncrement", 5
  144. WriteSettingsEntry "'// Member greet display type; 1 - all chat, 2 - emote, 3 - whisper", vbNullString
  145. WriteSettingsEntry "m_greet_dsp", 3
  146. WriteSettingsEntry "'// Non-member greet display type; 1 - all chat, 2 - emote, 3 - whisper", vbNullString
  147. WriteSettingsEntry "nm_greet_dsp", 3
  148. WriteSettingsEntry "'// Member greet enabled?", vbNullString
  149. WriteSettingsEntry "m_greet_on", True
  150. WriteSettingsEntry "'// Non-member greet enabled?", vbNullString
  151. WriteSettingsEntry "nm_greet_on", True
  152. WriteSettingsEntry "'// Member greet message.", vbNullString
  153. WriteSettingsEntry "m_greet", "Welcome back, %0. You are ranked %u - %r. You have %a Access."
  154. WriteSettingsEntry "'// Non-member greet message.", vbNullString
  155. WriteSettingsEntry "nm_greet", "Welcome %0 to %c. Your ping is %pms."
  156. WriteSettingsEntry "'// Anti-flood settings for the greet message.", vbNullString
  157. WriteSettingsEntry "'// greet_bufferTime - If users join within these seconds, they will not be greeted.", vbNullString
  158. WriteSettingsEntry "'// greet_coolDown - Users will need to wait these amount of seconds before they will be greeted again. 1800 sec = 30 mins", vbNullString
  159. WriteSettingsEntry "'// greet_queueExit - If the queue load gets to this number, the bot will not greet until the queue decreases.", vbNullString
  160. WriteSettingsEntry "greet_bufferTime", 7
  161. WriteSettingsEntry "greet_coolDown", 1800
  162. WriteSettingsEntry "greet_queueExit", 4
  163. WriteSettingsEntry "'// Rank specific greet messages.", vbNullString
  164. WriteSettingsEntry "***", "***"
  165.  
  166. Call CleanINI()
  167. End If
  168.  
  169. AddChat 16759296, "CRS Script:. ", 10682112, "Checking commands and creating if neccesary ... This may take a few minutes; ignore the Script-Control pop-up."
  170. Call CreateCmds()
  171.  
  172. '// Database exists?
  173. crsDatabasePath = BotPath() & "MemberData.mdb"
  174. Set crsFSO = CreateObject("Scripting.FileSystemObject")
  175. If Not crsFSO.FileExists(crsDatabasePath) Then
  176. AddChat 16759296, "Welcome to the Clan Rank Script! You can customize the number and names of existing ranks inside crsClanRankScript.txt"
  177. AddChat 16759296, "Please note that all changes to the ", vbRed, "NUMBER OF EXISTING RANKS", vbCyan, " should be made ", vbRed, "BEFORE", vbCyan, " you start adding members!"
  178. AddChat 16759296, "You may customize the access level for each rank inside crsClanRankScript.txt"
  179. AddChat 10682112, "For help on common CRS questions and issues, visit:"
  180. AddChat 10682112, "http://www.stealthbot.net/forum/index.php?/topic/368-clan-rank-script-faqs-crs/"
  181. crs_create_database '// Create the database
  182. Else
  183. crs_connect '// Connect to database
  184. End If
  185.  
  186. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  187. If rs.Fields(0) = 0 Then
  188. '// No one is in the Database, so add the bot's username as the first user
  189. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  190. "Values ('" & BotVars.Username & "', " & 1 & ", " & 1 & ", '" & BotVars.Username & "', '" & Now & "', '" & Now & "', 'Bot Console', " & 0 & ", '0', '" & BotVars.Username & "')")
  191.  
  192. AddChat 16759296, "CRS Script:. ", 10682112, "Bot console has been added as the first member in your CRS database. Console is now able to add other users and perform CRS commands."
  193. End If
  194.  
  195. Call CreateObj("LongTimer", "Check_dsll")
  196. Check_dsll.Enabled = True
  197. Check_dsll.Interval = 720
  198.  
  199. Set crsUsers = CreateObject("Scripting.Dictionary")
  200. crsUsers.CompareMode = 1
  201.  
  202. Set crsGreetUsers = CreateObject("Scripting.Dictionary")
  203. crsGreetUsers.CompareMode = 1
  204.  
  205. crsLastGreet = Now -1
  206. End Sub
  207.  
  208.  
  209. Sub Event_Userjoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString, Banned)
  210.  
  211. '// Get user's rank data
  212. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & Username & "'")
  213. If rs.Fields(0) <> 0 Then
  214. Set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & Username & "'")
  215. rank = rs.Fields(1)
  216. reason = rs.Fields(6)
  217.  
  218. '// Update last active date/time
  219. crsConn.Execute("UPDATE `members` SET `last_active` = '" & Now() & "' WHERE `name`='" & Username & "'")
  220. AutoPromote(Username)
  221.  
  222. crsUsers.Item(Username) = Now
  223. Else
  224. If GetSettingsEntry("autoadd_tag_on") Then
  225. If InStr(Username, GetSettingsEntry("autoadd_tag")) > 0 Then
  226. If LCase(crsRanks(UBound(crsRanks)-1)) = "banned" Then
  227. nRank = UBound(crsRanks)-2
  228. Else
  229. nRank = UBound(crsRanks)-1
  230. End If
  231. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  232. "Values ('" & Username & "', " & nRank & ", " & nRank & ", '" & BotVars.Username & "', '" & Now & "', '" & Now & "', 'Automatically added due to tag in name.', " & 0 & ", '0', '" & BotVars.Username & "')")
  233. AddChat 16759296, "CRS Script:. ", 10682112, Username & " was added to the database for having "" " & GetSettingsEntry("autoadd_tag") & " "" within their name."
  234. Else
  235. rank = 0
  236. End If
  237. Else
  238. rank = 0
  239. End If
  240. End If
  241.  
  242. '// Replace greet variables
  243. If rank > 0 Then
  244. If LCase(crsRanks(rank)) = "banned" Then
  245. Command BotVars.Username, "/ipban " & Username & " " & reason, True
  246. Exit Sub
  247. End If
  248.  
  249. If NOT GetSettingsEntry("m_greet_on") Then Exit Sub
  250. If GetSettingsEntry(rank) = vbNullString Then
  251. strRankGreet = GetSettingsEntry("m_greet")
  252. Else
  253. strRankGreet = GetSettingsEntry(rank)
  254. End If
  255. Else
  256. If NOT GetSettingsEntry("nm_greet_on") Then Exit Sub
  257. If Len(GetSettingsEntry(Username)) > 0 Then
  258. strRankGreet = GetSettingsEntry(Username)
  259. Else
  260. strRankGreet = GetSettingsEntry("nm_greet")
  261. End If
  262. End If
  263.  
  264. strRankGreet = Replace(strRankGreet, "%0", Username)
  265. strRankGreet = Replace(strRankGreet, "%r", crsRanks(rank))
  266. strRankGreet = Replace(strRankGreet, "%u", CInt(rank))
  267. strRankGreet = Replace(strRankGreet, "%m", GetDBMembers(0, vbNullString))
  268. strRankGreet = Replace(strRankGreet, "%n", GetSettingsEntry("clan_name"))
  269. strRankGreet = Replace(strRankGreet, "%c", myChannel)
  270. strRankGreet = Replace(strRankGreet, "%1", BotVars.Username)
  271. strRankGreet = Replace(strRankGreet, "%t", Time)
  272. strRankGreet = Replace(strRankGreet, "%d", Date)
  273. strRankGreet = Replace(strRankGreet, "%v", ssc.GetBotVersion())
  274. strRankGreet = Replace(strRankGreet, "%a", GetDBEntry(Username).Rank)
  275. strRankGreet = Replace(strRankGreet, "%f", GetDBEntry(Username).Flags)
  276. strRankGreet = Replace(strRankGreet, "%p", Ping)
  277.  
  278. '// Display greeting
  279.  
  280. If GetQueueSize => CInt(GetSettingsEntry("greet_queueExit")) Then Exit Sub
  281. If DateDiff("s", crsLastGreet, Now) < CInt(GetSettingsEntry("greet_bufferTime")) Then Exit Sub
  282.  
  283. If crsGreetUsers.Exists(Username) Then
  284. If DateDiff("s", crsGreetUsers.Item(Username), Now) < CInt(GetSettingsEntry("greet_coolDown")) Then Exit Sub
  285. If rank > 0 Then
  286. dspId = GetSettingsEntry("m_greet_dsp")
  287. Select Case dspId
  288. Case 1: AddQ strRankGreet
  289. Case 2: AddQ "/me " & strRankGreet
  290. Case 3: AddQ "/w " & Username & " " & strRankGreet
  291. End Select
  292. Else
  293. dspId = GetSettingsEntry("nm_greet_dsp")
  294. Select Case dspId
  295. Case 1: AddQ strRankGreet
  296. Case 2: AddQ "/me " & strRankGreet
  297. Case 3: AddQ "/w " & Username & " " & strRankGreet
  298. End Select
  299. End If
  300. crsGreetUsers.Item(Username) = Now
  301. Else
  302. If rank > 0 Then
  303. dspId = GetSettingsEntry("m_greet_dsp")
  304. Select Case dspId
  305. Case 1: AddQ strRankGreet
  306. Case 2: AddQ "/me " & strRankGreet
  307. Case 3: AddQ "/w " & Username & " " & strRankGreet
  308. End Select
  309. Else
  310. dspId = GetSettingsEntry("nm_greet_dsp")
  311. Select Case dspId
  312. Case 1: AddQ strRankGreet
  313. Case 2: AddQ "/me " & strRankGreet
  314. Case 3: AddQ "/w " & Username & " " & strRankGreet
  315. End Select
  316. End If
  317. crsGreetUsers.Item(Username) = Now
  318. End If
  319.  
  320. crsLastGreet = Now
  321. End Sub
  322.  
  323. Sub Event_UserLeaves(Username, Flags)
  324.  
  325. If crsUsers.Exists(Username) Then
  326. crsConn.Execute("UPDATE `members` SET `time_logged` = `time_logged` +" & DateDiff("s", crsUsers.Item(Username), Now) & " WHERE `name` = '" & Username & "'")
  327. crsUsers.Remove Username
  328. End If
  329. End Sub
  330.  
  331. Sub Event_Close()
  332.  
  333. '// Close DB Connection
  334. AddChat 16759296, "CRS Script:. ", 10682112, "Closing Database connection."
  335. crsConn.Close
  336.  
  337. '// Create a backup of the database
  338. temp = Int(GetSettingsEntry("backupNum"))
  339. If temp <> 0 Then
  340. AddChat 16759296, "CRS Script:. ", 10682112, "Creating backup of current database."
  341.  
  342. '// Make our backup folder
  343. backFolder = BotPath & "CRS Database Backups\"
  344. If NOT crsFSO.FolderExists(backFolder) Then crsFSO.CreateFolder(backFolder)
  345.  
  346. '// Unlimited backups allowed
  347. If temp = -1 Then
  348. Set Folder = crsFSO.GetFolder(backFolder)
  349. '// If there are no files in the folder, create the first one
  350. If Folder.Files.Count = 0 Then
  351. tFile = backFolder & "MemberData (1).mdb"
  352.  
  353. Set File = crsFSO.GetFile(crsDatabasePath)
  354. File.Copy(tFile)
  355. Else
  356. '// Find the highest appeneded number and set the new file to +1
  357. highestAppend = 0
  358.  
  359. For Each f In Folder.Files
  360. appendNum = Int(Split(Split(f.Name, "(")(1), ")")(0))
  361. If appendNum > highestAppend Then highestAppend = appendNum
  362. Next
  363.  
  364. Set File = crsFSO.GetFile(crsDatabasePath)
  365. File.Copy(backFolder & "MemberData (" & highestAppend+1 & ").mdb")
  366. End If
  367. Else
  368. Set Folder = crsFSO.GetFolder(backFolder)
  369. If Folder.Files.Count >= temp Then
  370. oldFile = 0
  371. fName = vbNullString
  372. highestAppend = 0
  373.  
  374. For Each f In Folder.Files
  375. dDiff = DateDiff("s", f.DateCreated, Now)
  376. appendNum = Int(Split(Split(f.Name, "(")(1), ")")(0))
  377. If appendNum > highestAppend Then highestAppend = appendNum
  378. If dDiff > oldFile Then
  379. oldFile = dDiff
  380. fName = f.Name
  381. End If
  382. Next
  383.  
  384. tFile = backFolder & "MemberData (" & highestAppend+1 & ").mdb"
  385. crsFSO.DeleteFile(backFolder & fName)
  386. Set File = crsFSO.GetFile(crsDatabasePath)
  387. File.Copy(tFile)
  388. Else
  389. Set File = crsFSO.GetFile(crsDatabasePath)
  390. tFile = backFolder & "MemberData (1).mdb"
  391. Set Folder = crsFSO.GetFolder(backFolder)
  392.  
  393. If Folder.Files.Count = 0 Then
  394. tFile = backFolder & "MemberData (" & Folder.Files.Count+1 & ").mdb"
  395. File.Copy(tFile)
  396. Exit Sub
  397. End If
  398.  
  399. '// If a backup already exists, append a #
  400. i = Folder.Files.Count
  401. Do
  402. If crsFSO.FileExists(tFile) Then
  403. i=i+1
  404. tFile = backFolder & "MemberData (" & i & ").mdb"
  405. Else
  406. nFound = True
  407. End If
  408. Loop While nFound
  409.  
  410. File.Copy(tFile)
  411. End If
  412. End If
  413. End If
  414. End Sub
  415.  
  416.  
  417. Public Sub Event_Command(Command)
  418.  
  419. '// This makes it so you can use the commands while offline
  420. If Command.IsLocal Then Command.Username = BotVars.Username
  421.  
  422. Select Case LCase(Command.Name)
  423. Case "crsadmin": Call crsadminCmd(Command, Command.Username)
  424. Case "addqueue": Call addQueue(Command, Command.Username)
  425. Case "showqueue": Call showQueue(Command, Command.Username)
  426. Case "clearqueue": Call clearQueue(Command, Command.Username)
  427. Case "crscmds": Call crsCmdsCmd(Command, Command.Username)
  428. Case "crsdemote": Call crsdemoteCmd(Command, Command.Username)
  429. Case "crsdisable": Call crsdisableCmd(Command, Command.Username)
  430. Case "crsgreet": Call crsgreetCmd(Command, Command.Username)
  431. Case "crsmeminfo": Call crsmeminfoCmd(Command, Command.Username)
  432. Case "crspromote": Call crspromoteCmd(Command, Command.Username)
  433. Case "crsqranks": Call crsqranksCmd(Command, Command.Username)
  434. Case "crsrank": Call crsrankCmd(Command, Command.Username)
  435. Case "crsrankinfo": Call crsrankinfoCmd(Command, Command.Username)
  436. Case "crsrankstats": Call crsrankstatsCmd(Command, Command.Username)
  437. Case "crsremove": Call crsremoveCmd(Command, Command.Username)
  438. Case "crsrestore": Call crsrestoreCmd(Command, Command.Username)
  439. Case "crsset": Call crssetCmd(Command, Command.Username)
  440. End Select
  441. End Sub
  442.  
  443.  
  444. Sub Check_dsll_Timer()
  445.  
  446. If NOT GetSettingsEntry("dsll_on") Then Exit Sub
  447.  
  448. Set rs = crsConn.Execute("SELECT `name`, `promotion_date`, `reason` FROM `members`")
  449. If NOT (rs.BOF OR rs.EOF) Then
  450. Do Until rs.EOF
  451. iniLimit = Int(GetSettingsEntry("dsllLimit"))
  452. dsll = GetDaysLastLogged(rs.Fields(0))
  453. If dsll >= iniLimit AND rs.Fields(0) <> BotVars.Username Then
  454. If DateDiff("d", rs.Fields(1), Now) >= iniLimit Then
  455. Command BotVars.Username, "/crsdemote " & rs.Fields(0) & " Days inactive: " & dsll, True
  456. End If
  457. End If
  458. rs.MoveNext
  459. Loop
  460. End If
  461. End Sub
  462.  
  463.  
  464.  
  465. Sub crs_create_database()
  466.  
  467. '// Create the database
  468. Set Catalog = CreateObject("ADOX.Catalog")
  469. Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & crsDatabasePath
  470.  
  471. '// Connect to database
  472. crs_connect()
  473.  
  474. '// Create members Table
  475. crsConn.Execute("CREATE TABLE `members` (`name` varchar(30) NOT NULL, `rank` int NULL, `previous_rank` int NULL, " & _
  476. "`promoter_name` varchar(30) NOT NULL, `promotion_date` varchar(32), " & _
  477. "`join_date` varchar(32), `reason` Text, `time_logged` Int, `last_active` varchar(32), `recruiter` varchar(15))")
  478. End Sub
  479.  
  480. Sub crs_connect()
  481.  
  482. '// Create database connection
  483. Set crsConn = CreateObject("ADODB.connection")
  484. dsn = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & crsDatabasePath
  485. crsConn.ConnectionString = dsn
  486.  
  487. crsConn.Open
  488. End Sub
  489.  
  490.  
  491. Private Sub addQueue(Command, user)
  492. '// If proper syntax
  493. If Command.IsValid Then
  494. '// Has enough access
  495.  
  496. name = Split(Command.Args)(0)
  497. Call AddToQueue(name,0)
  498. Command.Respond name & " has been added to the queue"
  499.  
  500. End If
  501. End Sub
  502.  
  503.  
  504. Private Sub showQueue(Command, user)
  505. '// If proper syntax
  506.  
  507. '// Has enough access
  508. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  509. If rs.Fields(0) = 0 Then
  510. Command.Respond "Nobody currenty in queue"
  511. End If
  512. Set ss = crsConn.Execute("SELECT `name`, `rank` FROM `members` ORDER BY rank ASC")
  513. Do Until ss.EOF
  514. text=text& ss.Fields(1) & ") " & ss.Fields(0) & " "
  515. ss.MoveNext
  516. Loop
  517. Command.Respond text
  518.  
  519. End Sub
  520.  
  521.  
  522. Private Sub clearQueue(Command, user)
  523. '// If proper syntax
  524. If Command.IsValid Then
  525. '// Has enough access
  526. '// If Command.HasAccess Then
  527. Set ss = crsConn.Execute("DELETE FROM `members`")
  528. Command.Respond "Queue has been cleared"
  529. '// End If
  530. End If
  531. End Sub
  532.  
  533. Private Sub crsCmdsCmd(Command, user)
  534.  
  535. '// If proper syntax
  536. If Command.IsValid Then
  537. '// Has enough access
  538. If Command.HasAccess Then
  539. If NOT IsCRSMember(user) Then Exit Sub
  540. '// Get command requirements. Use official names as they appear in the Command Manager; these names will not change unless users edit the XML, which is idiotic when they can just create an alias.
  541. cmdNames = Array("crsAdmin", "crsCmds", "crsDemote", "crsDisable", "crsGreet", "crsMemInfo", "crsPromote", "crsQRanks", "crsRank", "crsRankInfo", "crsRankStats", "crsRemove", "crsRestore", "crsSet")
  542. For i = 0 To UBound(cmdNames)
  543. Set cmd = OpenCommand(cmdNames(i))
  544. If cmd.RequiredRank <= GetDBEntry(user).Rank OR user = BotVars.Username Then text = text & cmdNames(i) & ", "
  545. Next
  546.  
  547. If text <> vbNullString Then
  548. Command.Respond "You are able to use the following CRS commands: " & Left(text, Len(text) -2)
  549. Else
  550. Command.Respond "You are not able to use any CRS commands."
  551. End If
  552. End If
  553. End If
  554. End Sub
  555.  
  556. Private Sub crsadminCmd(Command, user)
  557.  
  558. If Command.IsValid Then
  559. If user = BotVars.Username Then
  560. If NOT IsCRSMember(user) Then Exit Sub
  561. Select Case LCase(Split(Command.Args)(0))
  562. Case "override"
  563. cmdArr = Split(Command.Args)
  564. If Ubound(cmdArr) < 3 Then Exit Sub
  565.  
  566. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` = '" & cmdArr(2) & "'")
  567. If rs.Fields(0) <> 0 Then
  568. On Error Resume Next
  569. If IsNumeric(cmdArr(3)) Then
  570. crsConn.Execute("UPDATE `members` SET `" & cmdArr(1) & "` = " & cmdArr(3) & " WHERE `name` ='" & cmdArr(2) & "'")
  571. On Error Resume Next
  572. Select Case Err.Number
  573. Case -2147217904
  574. Command.Respond "CRS Database error: That field does not exist. Please do not use this command if you don't know what you are doing. Misuse of this command WILL cause this script to error."
  575. Exit Sub
  576. Case -2147217913
  577. Command.Respond "CRS Database error: Field is not formatted for the specified entry. Please do not use this command if you don't know what you are doing. Misuse of this command WILL cause this script to error."
  578. Exit Sub
  579. End Select
  580. Command.Respond "Field was changed to the specified entry for user "" " & cmdArr(2) & """ ."
  581. Else
  582. If UBound(cmdArr) > 3 Then
  583. sValue = Split(Command.Args, " ", 4)(3)
  584. Else
  585. sValue = cmdArr(3)
  586. End If
  587. crsConn.Execute("UPDATE `members` SET `" & cmdArr(1) & "` = '" & sValue & "' WHERE `name` ='" & cmdArr(2) & "'")
  588. Select Case Err.Number
  589. Case -2147217904
  590. Command.Respond "CRS Database error: That field does not exist. Please do not use this command if you don't know what you are doing. Misuse of this command WILL cause this script to error."
  591. Exit Sub
  592. Case -2147217913
  593. Command.Respond "CRS Database error: Field is not formatted for the specified entry. Please do not use this command if you don't know what you are doing. Misuse of this command WILL cause this script to error."
  594. Exit Sub
  595. End Select
  596. Command.Respond "Field was changed to the specified entry for user "" " & cmdArr(2) & """ ."
  597. End If
  598. End If
  599.  
  600. Case "members"
  601. cmdArr = Split(Command.Args)
  602. If UBound(cmdArr) > 0 Then
  603. If IsNumeric(cmdArr(1)) Then
  604. Command.Respond "Members in the CRS database " & GetDBMembers(3, cmdArr(1))
  605. Else
  606. Command.Respond "Invalid rank. Ranks must be numeric."
  607. End If
  608. Else
  609. Command.Respond "Members in the CRS database (" & GetDBMembers(0, vbNullString) & "): " & GetDBMembers(1, vbNullString)
  610. End If
  611.  
  612. Case "massrank"
  613. cmdArr = Split(LCase(Command.Args))
  614. If IsNumeric(cmdArr(2)) AND (cmdArr(1) = "probation" OR cmdArr(1) = "peon" OR cmdArr(1) = "grunt" OR cmdArr(1) = "shaman") Then
  615. If Int(cmdArr(2)) > UBound(crsRanks)-1 OR Int(cmdArr(2)) < LBound(crsRanks)+1 Then
  616. Command.Respond "Invalid rank. Ranks must be between " & LBound(crsRanks)+1 & " and " & UBound(crsRanks)-1 &"."
  617. Exit Sub
  618. End If
  619.  
  620. addchat vbGreen, cmdArr(1)
  621.  
  622. Select Case cmdArr(1)
  623. Case "probation":sRank = 0
  624. Case "peon":sRank = 1
  625. Case "grunt":sRank = 2
  626. Case "shaman":sRank = 3
  627. End Select
  628.  
  629. For Each mem In Clan.Members
  630. If mem.Rank = sRank Then
  631. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` = '" & mem.Name & "'")
  632. If rs.Fields(0) <> 0 Then
  633. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` =" & cmdArr(2) & ", `promoter_name`='" & BotVars.Username & "', `reason` = 'Mass Set' WHERE `name` ='" & mem.Name & "'")
  634.  
  635. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & mem.Name & "'")
  636. Command.Respond """ " & mem.Name & " "" has had their rank changed to rank " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  637. If GetSettingsEntry("aa_on") Then Call GiveAccess(Mem.name, rs.Fields(0))
  638. Else '// Brand new member
  639. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  640. "Values ('" & mem.Name & "', " & cmdArr(2) & ", " & cmdArr(2) & ", '" & BotVars.Username & "', '" & Now & "', '" & Now & "', 'Mass Set', " & 0 & ", '0', '" & BotVars.Username & "')")
  641.  
  642. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & mem.Name & "'")
  643. Command.Respond """ " & mem.Name & " "" has been added as a new member with the rank of " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  644. If GetSettingsEntry("aa_on") Then Call GiveAccess(mem.Name, rs.Fields(0))
  645. End If
  646. End If
  647. Next
  648. End If
  649.  
  650. Case "resetdb"
  651. AddChat 16759296, "CRS Script:. ", 10682112, "Resetting database..."
  652. crsConn.Close
  653. crsFSO.DeleteFile(crsDatabasePath)
  654. Call crs_create_database()
  655.  
  656. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  657. If rs.Fields(0) = 0 Then
  658. '// No one is in the Database, so add the bot's username as the first user
  659. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  660. "Values ('" & BotVars.Username & "', " & 1 & ", " & 1 & ", '" & BotVars.Username & "', '" & Now & "', '" & Now & "', 'Bot Console', " & 0 & ", '0', '" & BotVars.Username & "')")
  661.  
  662. AddChat 16759296, "CRS Script:. ", 10682112, "Bot console has been added as the first member in your CRS database. Console is now able to add other users and perform CRS commands."
  663. End If
  664. End Select
  665. End If
  666. End If
  667. End Sub
  668.  
  669. Private Sub crsgreetCmd(Command, user)
  670.  
  671. If Command.IsValid Then
  672. If Command.HasAccess Then
  673. If NOT IsCRSMember(user) Then Exit Sub
  674. '// Get command agruments
  675. cmdArr = Split(Command.Args)
  676. Select Case LCase(cmdArr(0))
  677. Case "on"
  678. WriteSettingsEntry "nm_greet_on", True
  679. WriteSettingsEntry "m_greet_on", True
  680. Command.Respond "Member and non-member CRS greets have been turned on."
  681. Case "off"
  682. WriteSettingsEntry "nm_greet_on", False
  683. WriteSettingsEntry "m_greet_on", False
  684. Command.Respond "Member and non-member CRS greets have been turned off."
  685. Case "mem"
  686. If UBound(cmdArr) < 1 Then Exit Sub
  687. Select Case cmdArr(1)
  688. Case "on"
  689. WriteSettingsEntry "m_greet_on", True
  690. Command.Respond "Member CRS greets have been turned on."
  691. Case "off"
  692. WriteSettingsEntry "m_greet_on", False
  693. Command.Respond "Member CRS greets have been turned off."
  694. Case Else
  695. WriteSettingsEntry "m_greet", Split(Command.Args, " ", 2)(1)
  696. Command.Respond "Greet saved for CRS members."
  697. End Select
  698. Case "nmem"
  699. If UBound(cmdArr) < 1 Then Exit Sub
  700. Select Case cmdArr(1)
  701. Case "on"
  702. WriteSettingsEntry "nm_greet_on", True
  703. Command.Respond "Non member CRS greets have been turned on."
  704. Case "off"
  705. WriteSettingsEntry "nm_greet_on", False
  706. Command.Respond "Non member CRS greets have been turned off."
  707. Case Else
  708. WriteSettingsEntry "nm_greet", Split(Command.Args, " ", 2)(1)
  709. Command.Respond "Greet saved for non CRS members."
  710. End Select
  711. Case Else
  712. '// Rank Specific greets
  713. If UBound(cmdArr) < 1 Then Exit Sub
  714. If IsNumeric(cmdArr(0)) Then
  715. WriteSettingsEntry cmdArr(0), Split(Command.Args, " ", 2)(1)
  716. Command.Respond "Greet saved for rank " & cmdArr(0) & "."
  717. End If
  718. End Select
  719. End If
  720. End If
  721. End Sub
  722.  
  723. Private Sub crsremoveCmd(Command, user)
  724.  
  725. If Command.IsValid Then
  726. If Command.HasAccess Then
  727. If NOT IsCRSMember(user) Then Exit Sub
  728. name = Command.Args
  729.  
  730. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & name & "'")
  731. If rs.Fields(0) <> 0 Then
  732. If NOT IsAlterValid("remove", name, user, vbNullString) Then
  733. Command.Respond "You cannot remove someone equal to or higher than your current CRS rank."
  734. Exit Sub
  735. End If
  736.  
  737. crsConn.Execute("DELETE FROM `members` WHERE `name`='" & name & "'")
  738. Command.Respond """ " & name & " "" has been removed from the CRS database."
  739. If GetSettingsEntry("aa_rem_on") Then Command BotVars.Username, "/rem " & name, True
  740. Else
  741. Command.Respond """ " & name & " "" does not have a record on the CRS database."
  742. End If
  743. End If
  744. End If
  745. End Sub
  746.  
  747. Private Sub crsdemoteCmd(Command, user)
  748.  
  749. If Command.IsValid Then
  750. If Command.HasAccess Then
  751. If NOT IsCRSMember(user) Then Exit Sub
  752. If Len(Command.Args) < 1 Then Exit Sub
  753.  
  754. cmdArr = Split(Command.Args)
  755.  
  756. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & cmdArr(0) & "'")
  757. If rs.Fields(0) <> 0 Then
  758. Select Case UBound(cmdArr)
  759. Case 0 '// No number, no reason = demoting down by 1
  760. '// Check if rank is a valid rank
  761. If NOT IsAlterValid("demote", cmdArr(0), user, 1) Then
  762. Command.Respond "You cannot demote someone that is an equal or higher rank than yourself, or below the lowest rank."
  763. Exit Sub
  764. End If
  765.  
  766. Call GivePromotion(Command, cmdArr(0), user, 1, vbNullString)
  767.  
  768. Case Else '// Number and/or reason
  769. If IsNumeric(cmdArr(1)) Then
  770. If NOT IsAlterValid("demote", cmdArr(0), user, cmdArr(1)) Then
  771. Command.Respond "You cannot demote someone that is an equal or higher rank than yourself, or below the lowest rank."
  772. Exit Sub
  773. End If
  774.  
  775. If Int(cmdArr(1)) > UBound(crsRanks)-1 OR Int(cmdArr(1)) < LBound(crsRanks)+1 Then
  776. Command.Respond "Invalid rank. Ranks must be between " & LBound(crsRanks)+1 & " and " & UBound(crsRanks)-1 &"."
  777. Exit Sub
  778. End If
  779.  
  780. '// Check for a reason
  781. If UBound(cmdArr) > 1 Then
  782. reason = Split(Command.Args, " ", 3)(2)
  783. Else
  784. reason = vbNullString
  785. End If
  786.  
  787. Call GivePromotion(Command, cmdArr(0), user, cmdArr(1), reason)
  788. Else
  789. If NOT IsAlterValid("demote", cmdArr(0), user, 1) Then
  790. Command.Respond "You cannot demote someone that is an equal or higher rank than yourself, or below the lowest rank."
  791. Exit Sub
  792. End If
  793.  
  794. If UBound(cmdArr) => 0 Then
  795. reason = Split(Command.Args, " ", 2)(1)
  796. Else
  797. reason = vbNullString
  798. End If
  799.  
  800. Call GivePromotion(Command, cmdArr(0), user, 1, reason)
  801. End If
  802. End Select
  803. Else
  804. Command.Respond """ " & cmdArr(0) & " "" does not have a record on the CRS database."
  805. End If
  806. End If
  807. End If
  808. End Sub
  809.  
  810. Private Sub crsdisableCmd(Command, user)
  811.  
  812. If Command.IsValid Then
  813. If Command.HasAccess Then
  814. If NOT IsCRSMember(user) Then Exit Sub
  815. If Len(Command.Args) < 1 Then Exit Sub
  816.  
  817. cmdArr = Split(Command.Args)
  818.  
  819. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & cmdArr(0) & "'")
  820. If rs.Fields(0) <> 0 Then
  821. If NOT IsAlterValid("demote", cmdArr(0), user, 0) Then
  822. Command.Respond "You cannot disable someone that is of equal or higher rank than yourself."
  823. Exit Sub
  824. End If
  825.  
  826. If UBound(cmdArr) > 0 Then
  827. reason = Split(Command.Args, " ", 2)(1)
  828. Else
  829. reason = vbNullString
  830. End If
  831.  
  832. Call GivePromotion(Command, cmdArr(0), user, vbNullString, reason)
  833. Else
  834. Command.Respond """ " & cmdArr(0) & " "" does not have a record on the CRS database."
  835. End If
  836. End If
  837. End If
  838. End Sub
  839.  
  840. Private Sub crspromoteCmd(Command, user)
  841.  
  842. If Command.IsValid Then
  843. If Command.HasAccess Then
  844. If NOT IsCRSMember(user) Then Exit Sub
  845. If Len(Command.Args) < 1 Then Exit Sub
  846.  
  847. cmdArr = Split(Command.Args)
  848.  
  849. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & cmdArr(0) & "'")
  850. If rs.Fields(0) <> 0 Then
  851. Select Case UBound(cmdArr)
  852. Case 0 '// No number, no reason = promoting up by 1
  853. '// Check if rank is a valid rank
  854. If NOT IsAlterValid("promote", cmdArr(0), user, 1) Then
  855. Command.Respond "You cannot promote someone to an equal or higher rank than yourself."
  856. Exit Sub
  857. End If
  858.  
  859. Call GivePromotion(Command, cmdArr(0), user, 1, vbNullString)
  860.  
  861. Case Else '// Number and/or reason
  862. If IsNumeric(cmdArr(1)) Then
  863. If NOT IsAlterValid("promote", cmdArr(0), user, cmdArr(1)) Then
  864. Command.Respond "You cannot promote someone to an equal or higher rank than yourself."
  865. Exit Sub
  866. End If
  867.  
  868. If Int(cmdArr(1)) > UBound(crsRanks)-1 OR Int(cmdArr(1)) < LBound(crsRanks)+1 Then
  869. Command.Respond "Invalid rank. Ranks must be between " & LBound(crsRanks)+1 & " and " & UBound(crsRanks)-1 &"."
  870. Exit Sub
  871. End If
  872.  
  873. '// Check for a reason
  874. If UBound(cmdArr) > 1 Then
  875. reason = Split(Command.Args, " ", 3)(2)
  876. Else
  877. reason = vbNullString
  878. End If
  879.  
  880. Call GivePromotion(Command, cmdArr(0), user, cmdArr(1), reason)
  881. Else
  882. If NOT IsAlterValid("promote", cmdArr(0), user, 1) Then
  883. Command.Respond "You cannot promote someone to an equal or higher rank than yourself."
  884. Exit Sub
  885. End If
  886.  
  887. If UBound(cmdArr) => 1 Then
  888. reason = Split(Command.Args, " ", 2)(1)
  889. Else
  890. reason = vbNullString
  891. End If
  892.  
  893. Call GivePromotion(Command, cmdArr(0), user, 1, reason)
  894. End If
  895. End Select
  896. Else
  897. Command.Respond """ " & cmdArr(0) & " "" does not have a record on the CRS database."
  898. End If
  899. End If
  900. End If
  901. End Sub
  902.  
  903. Private Sub crsrestoreCmd(Command, user)
  904.  
  905. If Command.IsValid Then
  906. If Command.HasAccess Then
  907. If NOT IsCRSMember(user) Then Exit Sub
  908. If Len(Command.Args) < 1 Then Exit Sub
  909.  
  910. cmdArr = Split(Command.Args)
  911.  
  912. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & cmdArr(0) & "'")
  913. If rs.Fields(0) <> 0 Then
  914. If NOT IsAlterValid("restore", cmdArr(0), user, vbNullString) Then
  915. Command.Respond "You cannot restore someone that is or will be of equal or higher rank than yourself."
  916. Exit Sub
  917. End If
  918.  
  919. If UBound(cmdArr) > 0 Then
  920. reason = Split(Command.Args, " ", 2)(1)
  921. Else
  922. reason = vbNullString
  923. End If
  924.  
  925. Call GivePromotion(Command, cmdArr(0), user, vbNullString, reason)
  926. Else
  927. Command.Respond """ " & cmdArr(0) & " "" does not have a record on the CRS database."
  928. End If
  929. End If
  930. End If
  931. End Sub
  932.  
  933. Private Sub crssetCmd(Command, user)
  934.  
  935. If Command.IsValid Then
  936. If Command.HasAccess Then
  937. If NOT IsCRSMember(user) Then Exit Sub
  938. If Len(Command.Args) < 0 Then Exit Sub
  939.  
  940. cmdArr = Split(Command.Args)
  941.  
  942. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & cmdArr(0) & "'")
  943.  
  944. Select Case UBound(cmdArr)
  945. Case 0
  946. Call GivePromotion(Command, cmdArr(0), user, UBound(crsRanks)-1, vbNullString)
  947. Case Else
  948. If IsNumeric(cmdArr(1)) Then
  949. If NOT IsAlterValid("set", cmdArr(0), user, cmdArr(1)) Then
  950. Command.Respond "You cannot set someone equal to or higher than your current CRS rank."
  951. Exit Sub
  952. End If
  953.  
  954. If Int(cmdArr(1)) > UBound(crsRanks)-1 OR Int(cmdArr(1)) < LBound(crsRanks)+1 Then
  955. Command.Respond "Invalid rank. Ranks must be between " & LBound(crsRanks)+1 & " and " & UBound(crsRanks)-1 &"."
  956. Exit Sub
  957. End If
  958.  
  959. If UBound(cmdArr) > 1 Then
  960. reason = Split(Command.Args, " ", 3)(2)
  961. Else
  962. reason = vbNullString
  963. End If
  964.  
  965. Call GivePromotion(Command, cmdArr(0), user, cmdArr(1), reason)
  966. Else
  967. '// Check if the rank name is valid
  968. rankName = Split(Command.Args, " ", 2)(1)
  969. For i = 0 To UBound(crsRanks)-1
  970. If Match(LCase(rankName), LCase(crsRanks(i)) & "*", True) Then
  971. rank = i
  972. If Len(rankName) = Len(crsRanks(rank)) Then
  973. reason = vbNullString
  974. Else
  975. reason = Right(rankName, Len(rankName) - (Len(crsRanks(rank))+1))
  976. End If
  977. Exit For
  978. End If
  979. Next
  980.  
  981. Call GivePromotion(Command, cmdArr(0), user, rank, reason)
  982. End If
  983. End Select
  984. End If
  985. End If
  986. End Sub
  987.  
  988. Private Sub crsmeminfoCmd(Command, user)
  989.  
  990. If Command.IsValid Then
  991. If Command.HasAccess Then
  992. If NOT IsCRSMember(user) Then Exit Sub
  993. name = Split(Command.Args)(0)
  994.  
  995. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & name & "'")
  996. If rs.Fields(0) <> 0 Then
  997. Set rs = crsConn.Execute("SELECT `join_date`, `last_active`, `time_logged` FROM `members` WHERE `name` ='" & name & "'")
  998. Command.Respond """ " & name & " "" joined on " & rs.Fields(0) & ", has spent " & GetTimeSpent(rs.Fields(2), False) & " in the clan, and was last active on " & rs.Fields(1) & "."
  999. Else
  1000. Command.Respond """ " & name & " "" does not have a record on the CRS database."
  1001. End If
  1002. End If
  1003. End If
  1004. End Sub
  1005.  
  1006. Private Sub crsrankCmd(Command, user)
  1007.  
  1008. If Command.IsValid Then
  1009. If Command.HasAccess Then
  1010. If NOT IsCRSMember(user) Then Exit Sub
  1011. name = Split(Command.Args)(0)
  1012.  
  1013. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & name & "'")
  1014. If rs.Fields(0) <> 0 Then
  1015. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1016. Command.Respond """ " & name & " "" is ranked #" & rs.Fields(0) & " - " & crsRanks(rs.Fields(0)) & "."
  1017. Else
  1018. Command.Respond """ " & name & " "" does not have a record on the CRS database."
  1019. End If
  1020. End If
  1021. End If
  1022. End Sub
  1023.  
  1024. Private Sub crsrankstatsCmd(Command, user)
  1025.  
  1026. If Command.IsValid Then
  1027. If Command.HasAccess Then
  1028. If NOT IsCRSMember(user) Then Exit Sub
  1029. name = Split(Command.Args)(0)
  1030.  
  1031. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & name & "'")
  1032. If rs.Fields(0) <> 0 Then
  1033. Command.Respond """ " & name & " "" has spent " & GetDaysInClan(name) & " days in the clan, recruited " & GetNumOfRecruits(name) & " members, and last logged into the channel " & GetDaysLastLogged(name) & " days ago."
  1034. Else
  1035. Command.Respond """ " & name & " "" does not have a record on the CRS database."
  1036. End If
  1037. End If
  1038. End If
  1039. End Sub
  1040.  
  1041. Private Sub crsrankinfoCmd(Command, user)
  1042.  
  1043. If Command.IsValid Then
  1044. If Command.HasAccess Then
  1045. If NOT IsCRSMember(user) Then Exit Sub
  1046. name = Split(Command.Args)(0)
  1047.  
  1048. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & name & "'")
  1049. If rs.Fields(0) <> 0 Then
  1050. Set rs = crsConn.Execute("SELECT `previous_rank`, `rank`, `promotion_date`, `promoter_name` FROM `members` WHERE `name` ='" & name & "'")
  1051. Command.Respond """ " & name & " "" is ranked #" & rs.Fields(1) & " (previously #" & rs.Fields(0) & "), last promoted on " & Split(rs.Fields(2), "/")(1) & "/" & Split(rs.Fields(2), "/")(0) & "/" & Split(rs.Fields(2), "/", 3)(2) & " by " & rs.Fields(3) & "."
  1052. Else
  1053. Command.Respond """ " & name & " "" does not have a record on the CRS database."
  1054. End If
  1055. End If
  1056. End If
  1057. End Sub
  1058.  
  1059. Private Sub crsqranksCmd(Command, user)
  1060.  
  1061. If Command.IsValid Then
  1062. If Command.HasAccess Then
  1063. If NOT IsCRSMember(user) Then Exit Sub
  1064. If Len(Command.Args) < 1 Then Exit Sub
  1065.  
  1066. cmdArr = Split(Command.Args)
  1067.  
  1068. Select Case LCase(cmdArr(0))
  1069. Case "find"
  1070. If UBound(cmdArr) <> 1 Then Exit Sub
  1071.  
  1072. If IsNumeric(cmdArr(1)) Then
  1073. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `rank` =" & cmdArr(1))
  1074. If NOT rs.EOF Then
  1075. Set ss = crsConn.Execute("SELECT `name` FROM `members` WHERE `rank` =" & cmdArr(1))
  1076. Do Until ss.EOF
  1077. text = text & ss.Fields(0) & ", "
  1078. ss.MoveNext
  1079. Loop
  1080. Command.Respond "Users with rank " & cmdArr(1) & " (" & crsRanks(cmdArr(1)) & "): " & Left(text, Len(text)-2)
  1081. Else
  1082. Command.Respond "There are no members with a rank of "" " & cmdArr(1) & " ""."
  1083. End If
  1084. Else
  1085. For i = 0 To Ubound(crsRanks)
  1086. If LCase(cmdArr(1)) = LCase(crsRanks(i)) Then
  1087. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `rank` =" & i)
  1088. If NOT rs.EOF Then
  1089. Set ss = crsConn.Execute("SELECT `name` FROM `members` WHERE `rank` =" & i)
  1090. Do Until ss.EOF
  1091. text = text & ss.Fields(0) & ", "
  1092. ss.MoveNext
  1093. Loop
  1094. Command.Respond "Users with rank " & cmdArr(1) & " (" & i & "): " & Left(text, Len(text)-2)
  1095. Exit Sub
  1096. Else
  1097. Command.Respond "There are no members with a rank of "" " & cmdArr(1) & " ""."
  1098. Exit Sub
  1099. End If
  1100. End If
  1101. Next
  1102. Command.Respond "There are no members with a rank of "" " & cmdArr(1) & " ""."
  1103. End If
  1104. Case "list"
  1105. For i = 1 To UBound(crsRanks)-1
  1106. text = text & i & " (" & crsRanks(i) & "), "
  1107. Next
  1108.  
  1109. Command.Respond "Ranks are the following: " & Left(text, Len(text)-2)
  1110. Case "info"
  1111. If Ubound(cmdArr) < 1 Then Exit Sub
  1112. If IsNumeric(cmdArr(1)) Then
  1113. If Int(cmdArr(1)) > UBound(crsRanks)-1 OR Int(cmdArr(1)) < LBound(crsRanks)+1 Then
  1114. Command.Respond "Invalid rank. Ranks must be between " & LBound(crsRanks)+1 & " and " & UBound(crsRanks)-1 &"."
  1115. Exit Sub
  1116. End If
  1117.  
  1118. Command.Respond "Information for rank #" & cmdArr(1) & ": Name [" & crsRanks(cmdArr(1)) & "], Access level [" & crsRankAccess(cmdArr(1)) & "], Position [" & cmdArr(1) & " out of " & UBound(crsRanks)-1 & "]"
  1119. Else
  1120. For i = 0 To Ubound(crsRanks)
  1121. If Lcase(cmdArr(1)) = LCase(crsRanks(i)) Then
  1122. Command.Respond "Information for rank " & cmdArr(1) & ": Number [" & i & "], Access level [" & crsRankAccess(i) & "], Position [" & i & " out of " & UBound(crsRanks)-1 & "]"
  1123. Exit Sub
  1124. End If
  1125. Next
  1126.  
  1127. Command.Response "No information available for rank name: " & cmdArr(1)
  1128. End If
  1129. End Select
  1130. End If
  1131. End If
  1132. End Sub
  1133.  
  1134.  
  1135.  
  1136. Private Sub CreateCmds '// Creates CRS commands
  1137.  
  1138. '// crsMembers = lists all members, will be left out due to the possibility of severely causing lag issues - bot console only
  1139. '// Users wanting to find out about ranks will need to know what rank/member they want information for, or they will need to use a combination of listing all ranks and finding info about the specific rank/member
  1140.  
  1141. Set cmd = OpenCommand("crsGreet")
  1142. If cmd Is Nothing Then
  1143. Set cmd = CreateCommand("crsGreet")
  1144. With cmd
  1145. .Description = "Manages the CRS greet settings."
  1146. .RequiredRank = 200
  1147.  
  1148. Set Parameter = .NewParameter("on/off/mem/nmem/#", False, "Word")
  1149. With Parameter
  1150. .Description = "crsGreet on = Enables the greeting of clan and non clan members." & vbNewLine & vbNewLine & _
  1151. "crsGreet off = Disables the greeting of clan and non clan members." & vbNewLine & vbNewLine & _
  1152. "crsGreet mem on = Enables the greeting of clan members." & vbNewLine & vbNewLine & _
  1153. "crsGreet mem off = Disables the greeting of clan members." & vbNewLine & vbNewLine & _
  1154. "crsGreet mem (greet) = Sets the greet message of clan members. Do not include the brackets." & vbNewLine & vbNewLine & _
  1155. "crsGreet # (greet) = Sets the greet message for a specified numerical CRS rank. Do not include the brackets." & vbNewLine & vbNewLine & _
  1156. "crsGreet nmem on = Enables the greeting of non clan members." & vbNewLine & vbNewLine & _
  1157. "crsGreet nmem off = Disables the greeting of non clan members." & vbNewLine & vbNewLine & _
  1158. "crsGreet nmem (greet) = Sets the greet message of non clan members."
  1159. End With
  1160. .Parameters.Add Parameter
  1161. .Save
  1162. End With
  1163. End If
  1164.  
  1165. Set cmd = OpenCommand("showQueue")
  1166. If cmd Is Nothing Then
  1167. Set cmd = CreateCommand("showQueue")
  1168. With cmd
  1169. .Description = "shows Queue"
  1170. .RequiredRank = -1
  1171. .Save
  1172. End With
  1173. End If
  1174.  
  1175. Set cmd = OpenCommand("clearQueue")
  1176. If cmd Is Nothing Then
  1177. Set cmd = CreateCommand("clearQueue")
  1178. With cmd
  1179. .Description = "clearsQueue"
  1180. .RequiredRank = 200
  1181. .Save
  1182. End With
  1183. End If
  1184.  
  1185. Set cmd = OpenCommand("addQueue")
  1186. If cmd Is Nothing Then
  1187. Set cmd = CreateCommand("addQueue")
  1188. With cmd
  1189. .Description = "adds user to queue"
  1190. .RequiredRank = 200
  1191. Set Parameter = .NewParameter("Username", False, "Word")
  1192. With Parameter
  1193. .Description = "Username of the user to add."
  1194. End With
  1195. .Parameters.Add Parameter
  1196. .SpecialNotes = "Users cannot demote someone equal to or higher than their own rank." & vbNewLine & vbNewLine & _
  1197. "Bot console is an exception."
  1198. .Save
  1199. End With
  1200. End If
  1201.  
  1202. Set cmd = OpenCommand("crsRemove")
  1203. If cmd Is Nothing Then
  1204. Set cmd = CreateCommand("crsRemove")
  1205. With cmd
  1206. .Description = "Removes a specified CRS member."
  1207. .RequiredRank = 200
  1208. Set Parameter = .NewParameter("Username", False, "Word")
  1209. With Parameter
  1210. .Description = "Username of the user to be removed."
  1211. End With
  1212. .Parameters.Add Parameter
  1213. .SpecialNotes = "Users cannot remove someone equal to or higher than their own rank." & vbNewLine & vbNewLine & _
  1214. "Bot console is an exception."
  1215. .Save
  1216. End With
  1217. End If
  1218.  
  1219. Set cmd = OpenCommand("crsDemote")
  1220. If cmd Is Nothing Then
  1221. Set cmd = CreateCommand("crsDemote")
  1222. With cmd
  1223. .Description = "Demotes the specified CRS member." & vbNewLine & vbNewLine & _
  1224. "crsDemote <username> (#) (reason is optional) = Demotes user down # rank(s). If # is omitted, user is demoted by 1 rank."
  1225. .RequiredRank = 200
  1226. Set Parameter = .NewParameter("Username", False, "Word")
  1227. With Parameter
  1228. .Description = "Username of the user recieving the demotion."
  1229. End With
  1230. .Parameters.Add Parameter
  1231. .SpecialNotes = "Users cannot demote someone equal to or higher than their own rank." & vbNewLine & vbNewLine & _
  1232. "Bot console is an exception."
  1233. .Save
  1234. End With
  1235. End If
  1236.  
  1237. Set cmd = OpenCommand("crsPromote")
  1238. If cmd Is Nothing Then
  1239. Set cmd = CreateCommand("crsPromote")
  1240. With cmd
  1241. .Description = "Promotes the specified CRS member." & vbNewLine & vbNewLine & _
  1242. "crsPromote <username> (#) (reason is optional) = Promotes user down # rank(s). If # is omitted, user is promoted by 1 rank."
  1243. Set Parameter = .NewParameter("Username", False, "Word")
  1244. With Parameter
  1245. .Description = "Username of the user recieving the promotion."
  1246. End With
  1247. .Parameters.Add Parameter
  1248. .RequiredRank = 200
  1249. .SpecialNotes = "Users cannot promote someone; equal to or higher than their own rank, to a rank higher than their own." & vbNewLine & vbNewLine & _
  1250. "Bot console is an exception."
  1251. .Save
  1252. End With
  1253. End If
  1254.  
  1255. Set cmd = OpenCommand("crsSet")
  1256. If cmd Is Nothing Then
  1257. Set cmd = CreateCommand("crsSet")
  1258. With cmd
  1259. .Description = "Sets the specified CRS member to a rank. If the user does not exist, they will be added to the database automatically." & vbNewLine & vbNewLine & _
  1260. "crsSet <username> (#) (reason is optional) = Sets user to the specified # rank. If # is omitted, user is set to the lowest rank."
  1261. .RequiredRank = 200
  1262. Set Parameter = .NewParameter("Username", False, "Word")
  1263. With Parameter
  1264. .Description = "Username of the user recieving the rank change."
  1265. End With
  1266. .Parameters.Add Parameter
  1267. .SpecialNotes = "Users cannot set someone equal to or higher than their own rank." & vbNewLine & vbNewLine & _
  1268. "Bot console is an exception."
  1269. .Save
  1270. End With
  1271. End If
  1272.  
  1273. Set cmd = OpenCommand("crsRestore")
  1274. If cmd Is Nothing Then
  1275. Set cmd = CreateCommand("crsRestore")
  1276. With cmd
  1277. .Description = "Restores the specified CRS member to the last rank they held." & vbNewLine & vbNewLine & _
  1278. "crsRestore <username> (reason is optional) = Restores username to their previous rank."
  1279. .RequiredRank = 200
  1280. Set Parameter = .NewParameter("Username", False, "Word")
  1281. With Parameter
  1282. .Description = "Username of the user to be restored."
  1283. End With
  1284. .Parameters.Add Parameter
  1285. .SpecialNotes = "Users cannot restore someone that will be equal to or higher than their own rank." & vbNewLine & vbNewLine & _
  1286. "Bot console is an exception."
  1287. .Save
  1288. End With
  1289. End If
  1290.  
  1291. Set cmd = OpenCommand("crsDisable")
  1292. If cmd Is Nothing Then
  1293. Set cmd = CreateCommand("crsDisable")
  1294. With cmd
  1295. .Description = "Immediately sets the specified CRS member to the lowest rank." & vbNewLine & vbNewLine & _
  1296. "crsDisable <username> (reason is optional) = Sets user to the lowest rank."
  1297. .RequiredRank = 200
  1298. Set Parameter = .NewParameter("Username", False, "Word")
  1299. With Parameter
  1300. .Description = "Username of the user to be disabled."
  1301. End With
  1302. .Parameters.Add Parameter
  1303. .SpecialNotes = "Users cannot disable someone that is equal to or higher than their own rank." & vbNewLine & vbNewLine & _
  1304. "Bot console is an exception."
  1305. .Save
  1306. End With
  1307. End If
  1308.  
  1309. Set cmd = OpenCommand("crsMemInfo")
  1310. If cmd Is Nothing Then
  1311. Set cmd = CreateCommand("crsMemInfo")
  1312. With cmd
  1313. .Description = "crsMemInfo <username> = Displays a specified CRS user's join date and date/time last active."
  1314. .RequiredRank = 200
  1315. Set Parameter = .NewParameter("Username", False, "Word")
  1316. With Parameter
  1317. .Description = "Username of the user to be profiled."
  1318. End With
  1319. .Parameters.Add Parameter
  1320. .Save
  1321. End With
  1322. End If
  1323.  
  1324. Set cmd = OpenCommand("crsRankStats")
  1325. If cmd Is Nothing Then
  1326. Set cmd = CreateCommand("crsRankStats")
  1327. With cmd
  1328. .Description = "crsRankStats <username> = Displays a days in clan, number of recruits, and days since last logged into channel for a spefified CRS user."
  1329. .RequiredRank = 200
  1330. Set Parameter = .NewParameter("Username", False, "Word")
  1331. With Parameter
  1332. .Description = "Username of the user to be profiled."
  1333. End With
  1334. .Parameters.Add Parameter
  1335. .Save
  1336. End With
  1337. End If
  1338.  
  1339. Set cmd = OpenCommand("crsRank")
  1340. If cmd Is Nothing Then
  1341. Set cmd = CreateCommand("crsRank")
  1342. With cmd
  1343. .Description = "crsRank <username> = Displays a specified CRS user's rank."
  1344. .RequiredRank = 200
  1345. Set Parameter = .NewParameter("Username", False, "Word")
  1346. With Parameter
  1347. .Description = "Username of the user to be profiled."
  1348. End With
  1349. .Parameters.Add Parameter
  1350. .Save
  1351. End With
  1352. End If
  1353.  
  1354. Set cmd = OpenCommand("crsRankInfo")
  1355. If cmd Is Nothing Then
  1356. Set cmd = CreateCommand("crsRankInfo")
  1357. With cmd
  1358. .Description = "crsRankInfo <username> = Displays previous & current ranks, date/time of last promotion, and name of last promoter for a specificied CRS user."
  1359. .RequiredRank = 200
  1360. Set Parameter = .NewParameter("Username", False, "Word")
  1361. With Parameter
  1362. .Description = "Username of the user to be profiled."
  1363. End With
  1364. .Parameters.Add Parameter
  1365. .Save
  1366. End With
  1367. End If
  1368.  
  1369. Set cmd = OpenCommand("crsQRanks")
  1370. If cmd Is Nothing Then
  1371. Set cmd = CreateCommand("crsQRanks")
  1372. With cmd
  1373. .Description = "Displays information regarding various ranks."
  1374. .RequiredRank = 200
  1375.  
  1376. Set Parameter = .NewParameter("find/list/info", False, "Word")
  1377. With Parameter
  1378. .Description = "crsQRanks find (rank) = Lists the members with the the specified rank name or a rank number." & vbNewLine & vbNewLine & _
  1379. "crsQRanks list = Lists all rank names." & vbNewLine & vbNewLine & _
  1380. "crsQRanks info (rank) = Displays detailed information about the specified rank name or a rank number."
  1381. End With
  1382. .Parameters.Add Parameter
  1383.  
  1384. .Save
  1385. End With
  1386. End If
  1387.  
  1388. Set cmd = OpenCommand("crsCmds")
  1389. If cmd Is Nothing Then
  1390. Set cmd = CreateCommand("crsCmds")
  1391. With cmd
  1392. .Description = "Displays a list of commands for the user's rank that uses the command."
  1393. .RequiredRank = 200
  1394. .Save
  1395. End With
  1396. End If
  1397.  
  1398. Set cmd = OpenCommand("crsAdmin")
  1399. If cmd Is Nothing Then
  1400. Set cmd = CreateCommand("crsAdmin")
  1401. With cmd
  1402. .Description = "CRS commands that are available to the bot console only."
  1403. .RequiredRank = 200
  1404.  
  1405. Set Parameter = .NewParameter("override/members/massrank/closedb/opendb", False, "Word")
  1406. With Parameter
  1407. .Description = "crsAdmin override (field) (username) entry = Sets the user's database field to the specified entry text." & vbNewLine & vbNewLine & _
  1408. "crsAdmin members (rank #) = Lists all members and their ranks. If a rank number is supplied, the list will be filtered for that criteria." & vbNewLine & vbNewLine & _
  1409. "crsAdmin massrank <probation/peon/grunt/shaman> <rank #> = Sets all peons or grunts or shamans (whatever you choose) in the bot's clan to a specified CRS rank." & vbNewLine & vbNewLine & _
  1410. "crsAdmin resetdb = Clears the database of all data and sets your bot as the first member, effectively resetting your database."
  1411. End With
  1412. .Parameters.Add Parameter
  1413. .SpecialNotes = "These commands are limited to the bot console only for security reasons and for flood control issues."
  1414. .Save
  1415. End With
  1416. End If
  1417.  
  1418. AddChat 16759296, "CRS Script:. Script is ready to use. ", 5731327, "Please view the commands in the Command Manager for descriptions, syntax, and command aliases."
  1419. End Sub
  1420.  
  1421. Private Sub CleanINI '// Removes the " = " after the commented out lines that this script makes
  1422.  
  1423. Set fso = CreateObject("Scripting.FileSystemObject")
  1424. Set File = fso.OpenTextFile(BotPath & "scripts\scripts.ini", 1, True)
  1425. data = Split(File.ReadAll, vbNewLine)
  1426. File.Close
  1427.  
  1428.  
  1429. tMatch = False
  1430. For i = 0 To UBound(data) -1
  1431. If tMatch Then
  1432. If Left(data(i), 3) = "'//" Then
  1433. line = line & Split(data(i), "=")(0) & vbNewLine
  1434. ElseIf InStr(data(i), "[") > 0 AND InStr(data(i), "]") > 0 Then
  1435. tMatch = False
  1436. line = line & data(i) & vbNewLine
  1437. Else
  1438. line = line & data(i) & vbNewLine
  1439. End If
  1440. Else
  1441. If data(i) = "[crs]" Then
  1442. tMatch = True
  1443. line = line & data(i) & vbNewLine
  1444. Else
  1445. line = line & data(i) & vbNewLine
  1446. End If
  1447. End If
  1448. Next
  1449.  
  1450. fso.DeleteFile(BotPath & "scripts\scripts.ini")
  1451. temp = Split(line, vbNewLine)
  1452. For i = 0 To Ubound(temp) -1
  1453. Set File = fso.OpenTextFile(BotPath & "scripts\scripts.ini", 8, True)
  1454. File.WriteLine temp(i)
  1455. File.Close
  1456. Next
  1457. End Sub
  1458.  
  1459. Private Sub AutoPromote(Username) '// Auto-promots users based on Days in Clan or Number of Recruits
  1460.  
  1461. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & Username & "'")
  1462.  
  1463. If rs.Fields(0) <> 0 Then
  1464. If GetSettingsEntry("dayPromote_on") Then
  1465. dic = GetDaysInClan(Username)
  1466. Set rs = crsConn.Execute("SELECT `rank`, `promotion_date` FROM `members` WHERE `name` = '" & Username & "'")
  1467. cRank = rs.Fields(0)
  1468. pDate = rs.Fields(1)
  1469.  
  1470. dLower = Int(GetSettingsEntry("dayLowRank"))
  1471. dUpper = Int(GetSettingsEntry("dayHighRank"))
  1472. dIncrement = Int(GetSettingsEntry("dayIncrement"))
  1473.  
  1474. dLimit = dLower - dUpper
  1475.  
  1476. If cRank > dUpper AND (cRank => dLower OR (cRank < dLower AND cRank =< dLower-1)) Then
  1477. DaysSinceLastPromote = DateDiff("d", pDate, Now)
  1478. '// Check if the days since their last promotion is a multiple of dIncrement
  1479. If DaysSinceLastPromote MOD dIncrement = 0 AND DaysSinceLastPromote > 0 Then
  1480. '// Find out how many ranks they will need to be promoted
  1481. promoteNum = DaysSinceLastPromote/dIncrement
  1482. '// Check if the amount of ranks they need to be promoted will not let them go above dUpper. If it does, promote them up to dUpper
  1483. If (cRank - promoteNum) < dUpper Then
  1484. AddChat 16759296, "CRS Script:. ", 10682112, Username & " was last promoted " & DaysSinceLastPromote & " days ago and was ranked " & crsRanks(cRank) & "(" & cRank & "); needs +" & promoteNum & " promotions. Auto promoting to " & crsRanks(dUpper) & "(" & dUpper & ") (dayHighRank)."
  1485. Command BotVars.Username, "/crsPromote " & Username & " " & cRank - dUpper & " Was last promoted " & pDiff & " days ago.", True
  1486. Else
  1487. AddChat 16759296, "CRS Script:. ", 10682112, Username & " was last promoted " & DaysSinceLastPromote & " days ago and was ranked " & crsRanks(cRank) & "(" & cRank & "); needs +" & promoteNum & " promotions. Auto promoting to " & crsRanks(cRank-promoteNum) & "(" & cRank-promoteNum & ")."
  1488. Command BotVars.Username, "/crsPromote " & Username & " " & promoteNum & " Was last promoted " & pDiff & " days ago.", True
  1489. End If
  1490. End If
  1491. End If
  1492. End If
  1493.  
  1494. If GetSettingsEntry("recruitPromote_on") Then
  1495. numRec = GetNumOfRecruits(Username)
  1496. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` = '" & Username & "'")
  1497. cRank = rs.Fields(0)
  1498.  
  1499. recLower = Int(GetSettingsEntry("recruitLowRank"))
  1500. recUpper = Int(GetSettingsEntry("recruitHighRank"))
  1501. recIncrement = Int(GetSettingsEntry("recruitIncrement"))
  1502.  
  1503. dLimit = recLower - recUpper
  1504.  
  1505. '// If they're joining the channel that's a multiple of the dIncrement and they've recruited more than 0 users
  1506. If numRec MOD recIncrement = 0 AND numRec > 0 Then
  1507. '// If their rank is less than the max and equal to or greater than the lowest
  1508. If cRank > recUpper AND (cRank => recLower OR (cRank < recLower AND cRank => recLower-1)) Then
  1509. '// If the number of possible promotions is less than or equal to that which is allowed
  1510. If (numRec/recIncrement) <= dLimit Then
  1511. '// If their rank-to-be is less than the max
  1512. If cRank-(numRec/recIncrement) < recUpper Then
  1513. AddChat 16759296, "CRS Script:. ", 10682112, Username & " has recruited " & numRec & " users and was ranked " & crsRanks(cRank) & ". Auto promoting to " & crsRanks(recUpper) & " (maximum)."
  1514. Command BotVars.Username, "/crsPromote " & Username & " " & cRank-recUpper & " Has recruited " & numRec & " users.", True
  1515. Else
  1516. AddChat 16759296, "CRS Script:. ", 10682112, Username & " has recruited " & numRec & " users and was ranked " & crsRanks(cRank) & ". Auto promoting to " & crsRanks(cRank-(numRec/recIncrement)) & "."
  1517. Command BotVars.Username, "/crsPromote " & Username & " " & numRec/recIncrement & " Has recruited " & numRec & " users.", True
  1518. End If
  1519. Else
  1520. AddChat 16759296, "CRS Script:. ", 10682112, Username & " has recruited " & numRec & " users and was ranked " & crsRanks(cRank) & ". Auto promoting to " & crsRanks(recUpper) & " (maximum)."
  1521. Command BotVars.Username, "/crsPromote " & Username & " " & cRank-recUpper & " Has recruited " & numRec & " users.", True
  1522. End If
  1523. End If
  1524. End If
  1525. End If
  1526. End If
  1527.  
  1528. Set rs = Nothing
  1529. End Sub
  1530.  
  1531. Private Sub AddToQueue(name, rank) '// Promotes/Demotes/Disables/Restores/Adds members
  1532.  
  1533. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` = '" & name & "'")
  1534. If rs.Fields(0) <> 0 Then
  1535. Exit Sub
  1536. crsConn.Execute("UPDATE `members` SET `rank` = '" & rank & "' WHERE `name` ='" & name & "'")
  1537. Else '// Brand new member
  1538. If rank = 0 Then
  1539. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  1540. rank = rs.Fields(0) + 1
  1541. End If
  1542. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  1543. "Values ('" & name & "', " & rank & ", " & rank & ", 'Bob', '" & Now & "', '" & Now & "', 'N/A', " & 0 & ", '0', 'Bob')")
  1544.  
  1545. End If
  1546.  
  1547. End Sub
  1548.  
  1549.  
  1550.  
  1551. Private Sub GivePromotion(Command, name, promoter, rank, reason) '// Promotes/Demotes/Disables/Restores/Adds members
  1552.  
  1553. reason = Replace(reason, "'", CHR(156))
  1554. Select Case LCase(Command.Name)
  1555. Case "crsdemote"
  1556. If reason <> vbNullString Then
  1557. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = `rank`+" & rank & ", `promoter_name`='" & promoter & "', `reason` = '" & reason & "' WHERE `name` ='" & name & "'")
  1558. Else
  1559. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = `rank` +" & rank & ", `promoter_name`='" & promoter & "', `reason` = 'N/A' WHERE `name` ='" & name & "'")
  1560. End If
  1561.  
  1562. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1563. Command.Respond """ " & name & " "" has been demoted to rank " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  1564. If GetSettingsEntry("aa_on") Then Call GiveAccess(name, rs.Fields(0))
  1565.  
  1566. Case "crspromote"
  1567. If reason <> vbNullString Then
  1568. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = `rank`-" & rank & ", `promoter_name`='" & promoter & "', `reason` = '" & reason & "' WHERE `name` ='" & name & "'")
  1569. Else
  1570. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = `rank` -" & rank & ", `promoter_name`='" & promoter & "', `reason` = 'N/A' WHERE `name` ='" & name & "'")
  1571. End If
  1572.  
  1573. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1574. Command.Respond """ " & name & " "" has been promoted to rank " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  1575. If GetSettingsEntry("aa_on") Then Call GiveAccess(name, rs.Fields(0))
  1576.  
  1577. Case "crsdisable"
  1578. If reason <> vbNullString Then
  1579. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = " & UBound(crsRanks)-1 & ", `promoter_name`='" & promoter & "', `reason` = '" & reason & "' WHERE `name` ='" & name & "'")
  1580. Else
  1581. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = " & UBound(crsRanks)-1 & ", `promoter_name`='" & promoter & "', `reason` = 'N/A' WHERE `name` ='" & name & "'")
  1582. End If
  1583.  
  1584. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1585. Command.Respond """ " & name & " "" has been disabled to rank " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  1586. If GetSettingsEntry("aa_on") Then Call GiveAccess(name, rs.Fields(0))
  1587.  
  1588. Case "crsrestore"
  1589. If reason <> vbNullString Then
  1590. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = `previous_rank`, `promoter_name`='" & promoter & "', `reason` = '" & reason & "' WHERE `name` ='" & name & "'")
  1591. Else
  1592. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` = previous_rank, `promoter_name`='" & promoter & "', `reason` = 'N/A' WHERE `name` ='" & name & "'")
  1593. End If
  1594.  
  1595. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1596. Command.Respond """ " & name & " "" has been restored to rank " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  1597. If GetSettingsEntry("aa_on") Then Call GiveAccess(name, rs.Fields(0))
  1598.  
  1599. Case "crsset"
  1600. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` = '" & name & "'")
  1601. If rs.Fields(0) <> 0 Then
  1602. If reason <> vbNullString Then
  1603. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` =" & rank & ", `promoter_name`='" & promoter & "', `reason` = '" & reason & "' WHERE `name` ='" & name & "'")
  1604. Else
  1605. crsConn.Execute("UPDATE `members` SET `promotion_date` ='" & Now & "', `previous_rank` = `rank`, `rank` =" & rank & ", `promoter_name`='" & promoter & "', `reason` = 'N/A' WHERE `name` ='" & name & "'")
  1606. End If
  1607.  
  1608. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1609. Command.Respond """ " & name & " "" has had their rank changed to rank " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  1610. If GetSettingsEntry("aa_on") Then Call GiveAccess(name, rs.Fields(0))
  1611.  
  1612. Else '// Brand new member
  1613. If reason <> vbNullString Then
  1614. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  1615. "Values ('" & name & "', " & rank & ", " & rank & ", '" & promoter & "', '" & Now & "', '" & Now & "', '" & reason & "', " & 0 & ", '0', '" & promoter & "')")
  1616. Else
  1617. crsConn.Execute("INSERT INTO `members` (`name`, `rank`, `previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`, `last_active`, `recruiter`) " & _
  1618. "Values ('" & name & "', " & rank & ", " & rank & ", '" & promoter & "', '" & Now & "', '" & Now & "', 'New Member', " & 0 & ", '0', '" & promoter & "')")
  1619. End If
  1620.  
  1621. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1622. Command.Respond """ " & name & " "" has been added as a new member with the rank of " & rs.Fields(0) & " - " & crsRanks(rs.Fields(0))
  1623. If GetSettingsEntry("aa_on") Then Call GiveAccess(name, rs.Fields(0))
  1624. End If
  1625. End Select
  1626. End Sub
  1627.  
  1628. Private Sub GiveAccess(user, rank) '// If CRS auto-access is enabled, give them access.
  1629.  
  1630. '// This is in its own sub incase I add flags to be associated with ranks, as well as access, AND if users want to be able to have their members retain their existing flags and only update the access, and vice versa.
  1631. GetDBEntry user, A, F
  1632.  
  1633. If Lcase(user) <> Lcase(BotVars.Username) Then
  1634. Command BotVars.Username, "/set " & user & " " & crsRankAccess(rank), True
  1635. End If
  1636. End Sub
  1637.  
  1638.  
  1639.  
  1640. Private Function IsCRSMember(name) '// Returns True if they're a CRS member, False if not
  1641.  
  1642. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name` ='" & name & "'")
  1643. If rs.Fields(0) <> 0 Then
  1644. IsCRSMember = True
  1645. Else
  1646. If name <> BotVars.Username Then
  1647. IsCRSMember = False
  1648. Else
  1649. IsCRSMember = True
  1650. End If
  1651. End If
  1652. End Function
  1653.  
  1654. Private Function IsAlterValid(alterType, name, user, num) '// Returns True if they're trying to promote equal to or greater than their own rank, False if not
  1655.  
  1656. Select Case alterType
  1657. Case "promote"
  1658. If user <> BotVars.Username Then
  1659. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & user & "'")
  1660. uRank = CInt(rs.Fields(0))
  1661. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1662. nRank = CInt(rs.Fields(0))
  1663.  
  1664. If nRank > uRank Then
  1665. If nRank-CInt(num) > uRank Then
  1666. IsAlterValid = True
  1667. Else
  1668. IsAlterValid = False
  1669. End If
  1670. End If
  1671. Else
  1672. IsAlterValid = True
  1673. End If
  1674. Case "set"
  1675. If user <> BotVars.Username Then
  1676. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1677. If rs.EOF OR rs.BOF Then
  1678. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & user & "'")
  1679. If CInt(rs.Fields(0)) < CInt(num) Then
  1680. IsAlterValid = True
  1681. Else
  1682. IsAlterValid = False
  1683. End If
  1684. Else
  1685. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1686. uRank = CInt(rs.Fields(0))
  1687. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & user & "'")
  1688. nRank = CInt(rs.Fields(0))
  1689.  
  1690. If nRank < uRank Then
  1691. If nRank < CInt(num) Then
  1692. IsAlterValid = True
  1693. Else
  1694. IsAlterValid = False
  1695. End If
  1696. End If
  1697. End If
  1698. Else
  1699. IsAlterValid = True
  1700. End If
  1701. Case "demote"
  1702. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1703. uRank = CInt(rs.Fields(0))
  1704.  
  1705. If user <> BotVars.Username Then
  1706. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & user & "'")
  1707. nRank = rs.Fields(0)
  1708. If nRank < uRank Then
  1709. If uRank+num > UBound(crsRanks)-1 Then
  1710. IsAlterValid = False
  1711. Else
  1712. IsAlterValid = True
  1713. End If
  1714. End If
  1715. Else
  1716. If uRank+num > UBound(crsRanks)-1 Then
  1717. IsAlterValid = False
  1718. Else
  1719. IsAlterValid = True
  1720. End If
  1721. End If
  1722. Case "restore"
  1723. Set rs = crsConn.Execute("SELECT `rank`, `previous_rank` FROM `members` WHERE `name` ='" & name & "'")
  1724. uRank = CInt(rs.Fields(0)):pRank = CInt(rs.Fields(1))
  1725.  
  1726. If user <> BotVars.Username Then
  1727. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & user & "'")
  1728. If CInt(rs.Fields(0)) < uRank Then
  1729. If pRank > CInt(rs.Fields(0)) Then
  1730. IsAlterValid = True
  1731. Else
  1732. IsAlterValid = False
  1733. End If
  1734. End If
  1735. Else
  1736. IsAlterValid = True
  1737. End If
  1738. Case "remove"
  1739. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & name & "'")
  1740. nRank = rs.Fields(0)
  1741.  
  1742. If user <> BotVars.Username Then
  1743. Set rs = crsConn.Execute("SELECT `rank` FROM `members` WHERE `name` ='" & user & "'")
  1744.  
  1745. If rs.Fields(0) < nRank Then
  1746. IsAlterValid = True
  1747. Else
  1748. IsAlterValid = False
  1749. End If
  1750. Else
  1751. IsAlterValid = True
  1752. End If
  1753. End Select
  1754. End Function
  1755.  
  1756. Private Function GetNumOfRecruits(name) '// Returns number of recruits a user has recruited
  1757.  
  1758. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `recruiter` ='" & name & "'")
  1759. GetNumOfRecruits = rs.Fields(0)
  1760. End Function
  1761.  
  1762. Private Function GetDaysInClan(name) '// Returns the days spent in clan for a username
  1763.  
  1764. Set rs = crsConn.Execute("SELECT `join_date` FROM `members` WHERE `name` ='" & name & "'")
  1765. GetDaysInClan = ABS(INT(DateDiff("d", rs.Fields(0), Now)))
  1766. End Function
  1767.  
  1768. Private Function GetDaysLastLogged(name) '// Returns the days since user last logged into the channel
  1769.  
  1770. Set rs = crsConn.Execute("SELECT `last_active` FROM `members` WHERE `name` ='" & name & "'")
  1771. If NOT IsDate(rs.Fields(0)) Then
  1772. GetDaysLastLogged = "unknown"
  1773. Else
  1774. GetDaysLastLogged = DateDiff("d", rs.Fields(0), Now)
  1775. End If
  1776. End Function
  1777.  
  1778. Private Function GetDBMembers(sType, num) '// Returns either a number of members in the db or a list of names
  1779.  
  1780. Select Case sType
  1781. Case 0 '// Integers only
  1782. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  1783. GetDBMembers = rs.Fields(0)
  1784. Case 1 '// Member names
  1785. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  1786. If NOT (rs.EOF OR rs.BOF) Then
  1787. Set rs = crsConn.Execute("SELECT `name` FROM `members`")
  1788. Do Until rs.EOF
  1789. text = text & rs.Fields(0) & ", "
  1790. rs.MoveNext
  1791. Loop
  1792. GetDBMembers = Left(text, Len(text) -2)
  1793. Else
  1794. GetDBMembers = "Database is empty."
  1795. End If
  1796. Case 3 '// Filtered results
  1797. Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
  1798. If NOT (rs.EOF OR rs.BOF) Then
  1799. Set rs = crsConn.Execute("SELECT `name`, `rank` FROM `members`")
  1800. x = 0
  1801. Do Until rs.EOF
  1802. If rs.Fields(1) = Int(num) Then
  1803. text = text & rs.Fields(0) & ", "
  1804. x = x+1
  1805. End If
  1806. rs.MoveNext
  1807. Loop
  1808. If x=0 Then
  1809. GetDBMembers = "(0): None"
  1810. Else
  1811. GetDBMembers = "(" & x & "): " & Left(text, Len(text) -2)
  1812. End If
  1813. Else
  1814. GetDBMembers = "Database is empty."
  1815. End If
  1816. End Select
  1817. End Function
  1818.  
  1819. Private Function GetTimeSpent(sTime, isShortForm) '// Returns the time spent in the channel in Years/Days/Hours/Minutes/Seconds
  1820.  
  1821. If sTime = 0 Then
  1822. GetTimeSpent = "0 secs"
  1823. Exit Function
  1824. End If
  1825.  
  1826. years = Split(FormatNumber(sTime/60/60/24/365, 9), ".")(0)
  1827. 'AddChat vbGreen, "Years: " & years
  1828.  
  1829. dayDeci = FormatNumber(sTime/60/60/24/365, 9) - Split(FormatNumber(sTime/60/60/24/365, 9), ".")(0)
  1830. 'AddChat vbGreen, "Day Decimal: " & dayDeci
  1831.  
  1832. days = Int(dayDeci*365)
  1833. 'AddChat vbGreen, "Days: " & days
  1834.  
  1835. hourDeci = FormatNumber(sTime/60/60/24, 9) - Split(FormatNumber(sTime/60/60/24, 9), ".")(0)
  1836. 'AddChat vbGreen, "hour Decimal: " & hourDeci
  1837.  
  1838. hours = Int(hourDeci*24)
  1839. 'AddChat vbGreen, "Hours: " & hours
  1840.  
  1841. minDeci = FormatNumber(sTime/60/60, 9) - Split(FormatNumber(sTime/60/60, 9), ".")(0)
  1842. 'AddChat vbGreen, "Minute Decimal: " & minDeci
  1843.  
  1844. minutes = Int(minDeci*60)
  1845. 'AddChat vbGreen, "Minutes: " & minutes
  1846.  
  1847. secDeci = FormatNumber(sTime/60, 9) - Split(FormatNumber(sTime/60, 9), ".")(0)
  1848. 'AddChat vbGreen, "Seconds Deicmal: " & secDeci
  1849.  
  1850.  
  1851. seconds = Int(secDeci*60)
  1852. 'AddChat vbGreen, "Seconds: " & seconds
  1853.  
  1854. If NOT isShortForm Then
  1855. GetTimeSpent = years & " Years, " & days & " Days, " & hours & " Hours, " & minutes & " Minutes, " & seconds & " Seconds"
  1856. Else
  1857. If years <> 0 Then text = text & years & " yrs/"
  1858. If days <> 0 Then text = text & days & " days/"
  1859. If hours <> 0 Then text = text & hours & " hrs/"
  1860. If minutes <> 0 Then text = text & minutes & " mins/"
  1861. If seconds <> 0 Then text = text & seconds & " secs/"
  1862.  
  1863. GetTimeSpent = Left(text, Len(text) - 1)
  1864. End If
  1865. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!