· 8 years ago · Jan 24, 2018, 01:56 AM
1Script("Name") = "crs"
2Script("Author") = "The-Black-Ninja, original author: Swent"
3Script("Major") = 1
4Script("Minor") = 19
5Script("Revision") = 0
6Script("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
41Public crsConn '// Holds database connection
42Public crsRanks() '// Holds rank names specified in program settings
43Public crsRankAccess() '// Holds access for the ranks
44Public crsDatabasePath '// Holds database file path
45Private crsFSO '// FileSystemObject
46Private crsUsers '// Holds their time spent in channel, in seconds
47Private crsGreetUsers '// Holds their time since last greet
48Private 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
55Sub 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
206End Sub
207
208
209Sub 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
321End Sub
322
323Sub 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
329End Sub
330
331Sub 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
414End Sub
415
416
417Public 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
441End Sub
442
443
444Sub 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
461End Sub
462
463
464
465Sub 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))")
478End Sub
479
480Sub 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
488End Sub
489
490
491Private 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
501End Sub
502
503
504Private 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
519End Sub
520
521
522Private 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
531End Sub
532
533Private 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
554End Sub
555
556Private 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
667End Sub
668
669Private 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
721End Sub
722
723Private 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
745End Sub
746
747Private 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
808End Sub
809
810Private 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
838End Sub
839
840Private 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
901End Sub
902
903Private 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
931End Sub
932
933Private 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
986End Sub
987
988Private 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
1004End Sub
1005
1006Private 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
1022End Sub
1023
1024Private 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
1039End Sub
1040
1041Private 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
1057End Sub
1058
1059Private 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
1132End Sub
1133
1134
1135
1136Private 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."
1419End Sub
1420
1421Private 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
1457End Sub
1458
1459Private 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
1529End Sub
1530
1531Private 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
1547End Sub
1548
1549
1550
1551Private 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
1626End Sub
1627
1628Private 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
1636End Sub
1637
1638
1639
1640Private 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
1652End Function
1653
1654Private 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
1754End Function
1755
1756Private 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)
1760End Function
1761
1762Private 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)))
1766End Function
1767
1768Private 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
1776End Function
1777
1778Private 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
1817End Function
1818
1819Private 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
1865End Function