[div class='codetop']CODE[/div][div class='codemain' style='height:200px;white-space:pre;overflow:auto']'crs
'2.821
'&Clan Rank Script:Swent
'&crsgreet [m/nm] on/off:setcrsgreet <n/nm/#> <greet>:setrank <username> <#>:promote <username>
- [reason]:demote <username>
- [reason]:remove <username>:members:findrank <#>:findrank <rankname>:ranks:rankinfo [username]:rank [username]:meminfo [username]:mycmds
'&1294
'&Command arguements above inside "< >" are required, while those inside "[ ]" are optional:All of the above commands can be executed in-bot by replacing your trigger with "/":Adding the first member must be done from inside the bot:For answers to common CRS questions and issues, visit the following topic:www.stealthbot.net/board/index.php?showtopic=13965
'// Clan Rank Script v2.821
'// by Swent
'// Last Modified by Swent 5:31 PM 7/3/2007
'// ver 2.821
'// - Fixed a bug related to the old settings system that prevented all greets from displaying (Thanks ForEst-PlaGuE)
'// ver 2.82
'// - Added a new command: .setcrsgreet <m/nm/#> <greet>
'// ~ You may use the greet variables with this command
'// ~ Type /setcrsgreet inside your bot for help with this command
'// - Modified the .crsgreet command -- it's effect is now permanent, and you may now disable greets seperately
'// ~ Type .crsgreet <on/off> to enabled/disable both greets
'// ~ Type .crsgreet <n/nm> <on/off> to enable/disable the member or non-member greet only
'// - Fixed a minor error (most likely unnoticed) related to creation of the rank access settings
'// ver 2.81
'// - Added custom greet settings for each individual rank. Can be set inside pluginsettings.ini
'// ~ You do not need to surround settings with quotes ("setting") in pluginsettings.ini
'// ~ You may still use the greet variables (%0, %r, etc.) found below
'// ~ If no custom value is found for a certain rank, the global member greet will be used
'// - Added the crs_show_rank_value setting (see under Program Settings below)
'// ~ This allows you to choose if you want values displayed in rank names (ex: "Private (7)" or "Private")
'// - Moved the clan name setting to pluginsettings.ini. If no value is found, you will be prompted to enter a name on load.
'// ver 2.8
'// - Added automatic access settings for each individual rank. ** These settings can be found inside pluginsettings.ini **
'// - Added some helpful addchats that display the first time this plugin is loaded (when MemberData.mdb isn't found)
'// - The bot's profile will not be updated with the last action until StealthBot 2.7 due to battle.net profile changes
'// - Added support for double-slash in-bot commands. Use "//" as trigger for public display, "/" for in-bot display
'// - Replaced all usage of SplitQ and crsAddQ with calls to the dsp sub
Public crsConn '// holds database connection
Public crsLastAct '// holds data from bot's last action
Public crsRanks() '// holds rank names specified in program settings
Public crsDatabasePath '// holds database file path
Public crsCmdAccess(12, 2) '// holds command access requirements
Public crsDisplay '// holds command output display type
'//**************************//
'// PROGRAM SETTINGS //
'//**************************//
'// [ Clan Name ]
'// Your clan name can be set inside pluginsettings.ini
'// [ Display Value In Rank Name ]
'// If True each rank name will include a value in parenthesis
Const crs_show_rank_value = True '// True to enable / False to disable
'// [ Access Requirements ]
Const crsgreet_cmd_access = 90 '// Default: 90
Const setcrsgreet_cmd_access = 90 '// Default: 90
Const setrank_cmd_access = 90 '// Default: 90
Const promote_cmd_access = 20 '// Default: 90
Const demote_cmd_access = 20 '// Default: 90
Const remove_cmd_access = 90 '// Default: 90
Const members_cmd_access = 60 '// Default: 60
Const findrank_cmd_access = 60 '// Default: 60
Const ranks_cmd_access = 60 '// Default: 60
Const rankinfo_cmd_access = 20 '// Default: 20
Const rank_cmd_access = 20 '// Default: 20
Const meminfo_cmd_access = 20 '// Default: 20
Const mycmds_cmd_access = 20 '// Default: 20
'// [ Command Names ]
Const crsgreet_command = "crsgreet" '// Used to enable/disable greet by rank.
Const setcrsgreet_command = "setcrsgreet" '// Used to set the member/non-member greets
Const setrank_command = "setrank" '// Used to set the rank of new or existing members.
Const promote_command = "promote" '// Used to promote new or existing members.
Const demote_command = "demote" '// Used to demote existing members.
Const remove_command = "remove" '// Used to erase a member's rank, essentially removing them from the clan.
Const members_command = "members" '// Used to retrieve list of all member usernames.
Const findrank_command = "findrank" '// Used to retrieve a list of all members with the specified rank.
Const ranks_command = "ranks" '// Used to retrieve list of all ranks names.
Const rankinfo_command = "rankinfo" '// Used to retrieve detailed rank data.
Const rank_command = "rank" '// Used to retrieve a user's rank.
Const meminfo_command = "meminfo" '// Used to retrieve detailed member data.
Const mycmds_command = "mycmds" '// Used to retrieve a list of all useable commands.
'// [ Command Statuses ]
'// Commands can be disabled by setting their value to False
'// NOTE: disabled commands can still be executed in-bot
Const crsgreet_cmd_enabled = True
Const setcrsgreet_cmd_enabled = True
Const setrank_cmd_enabled = True
Const promote_cmd_enabled = True
Const demote_cmd_enabled = True
Const remove_cmd_enabled = True
Const members_cmd_enabled = True
Const findrank_cmd_enabled = True
Const ranks_cmd_enabled = True
Const rankinfo_cmd_enabled = True
Const rank_cmd_enabled = True
Const meminfo_cmd_enabled = True
Const mycmds_cmd_enabled = True
'// [ Profile Update ]
'// This feature has been removed until the release of StealthBot 2.7 due to Battle.net changes.
'// [ Automatic Access ]
'// Upon rank change, assigns bot access to users automatically.
'// ** The access level each rank recieves can be set inside pluginsettings.ini **
'// Until you set these levels, defaults of 110, 100, 50, 20, or 10 will be assigned (as in past versions)
Const auto_access_enabled = True '// True to enable, False to disable
'// [ Greet Settings ]
'// - Greet Variables:
'// %0 = joiner's Username | %r = joiner's rank name | %u = joiner's rank value
'// %m = Current member count | %n = clan name |
'// %c = Current channel | %1 = Current Bot Username | %t = Current time
'// %d = Current date | %v = Current bot version | %a = joiner's Db access
'// %f = joiner's Db flags | %p = joiner's ping
'// - Member and Non-member Greets:
'// ** Member and non-member can now be set using the .setcrsgreet command, or inside pluginsettings.ini **
'// ** Type "/setcrsgreet" inside your bot for the command syntax, greet variable list, and some example commands **
'// - Individual Rank Greets:
'// ** Custom greets for each rank can be set inside pluginsettings.ini **
'// ** Your rank greets may also use the greet variables listed above. **
'// - Greets Statuses:
'// ** Greets can now enabled/disabled using .crsgreet command (effect is now permanent), or in pluginsettings.ini **
'// To enable/disable both greets use /crsgreet <on/off>
'// To enable/disable the member greet type /crsgreet m <on/off>
'// To enable/disable the non-member greet type /crsgreet nm <on/off>
'// - Greet Display Type
'// 1 = public
'// 2 = emoted
'// 3 = whispered
Const m_greet_dsp = 1 '// Member greet display type
Const nm_greet_dsp = 3 '// Non-member greet display type
Sub crs_Event_Load()
'// [ Rank Settings ]
numRanks = 7 '// Number of ranks. Change this value after adding or removing ranks.
ReDim crsRanks(numRanks + 1): crsRanks(0) = "Unranked" '// Do not modify this line
'// ================================================================================
=============================
'// GUIDE TO CUSTOMIZING YOUR CRS RANKS - READ THIS BEFORE CHANGING ANYTHING!
'//
'// <<<<< ALL MODIFICATIONS TO THE NUMBER OF EXISTING RANKS SHOULD BE MADE *BEFORE* YOU START ADDING MEMBERS >>>>>
'// If ** you haven't added members yet **, FOLLOW THESE SIMPLE STEPS TO CUSTOMIZE YOUR RANKS:
'// 1) You may have as many ranks as you want. List them out in the RANK LIST section below in this format (WITHOUT the '//):
'// crsRanks(1) = "first rank"
'// crsRanks(2) = "second rank"
'// crsRanks(3) = "third rank"
'// 2) After you finish writing your ranks, ** you MUST change the numRanks variable above to the value of your GREATEST NUMBERED RANK **
'// Example: If my rank list was the three ranks above, I would change the value numRanks to 3
'// 3) Inside your bot hit Settings > Reload Script
'// If you HAVE already added members, and you need to change the number of ranks, follow these steps:
'// 1) Close your bot.
'// 2) Go to your StealthBot folder. Delete "MemberData.mdb"
'// 3) Make the desired rank modifications below.
'// 4) Open your bot back up.
'// 5) All of the your rank data will be gone, so you'll need to readd all of your members.
'// Note that after adding members, modifying the NAMES of existing ranks is fine, as long as you don't change the number that exist.
'// ================================================================================
=============================
'// <<<< RANK LIST -- YOUR RANKS SHOULD BE LISTED ** BELOW ** HERE >>>>
crsRanks(1) = "SAdmin"
crsRanks(2) = "Admin"
crsRanks(3) = "Smod"
crsRanks(4) = "Moderator"
crsRanks(5) = "Voucher"
crsRanks(6) = "Leader"
crsRanks(7) = "User"
'// <<<< YOUR RANKS SHOULD BE LISTED ** ABOVE ** HERE >>>>
'//****************************//
'// DO NOT EDIT BELOW HERE //
'// DO NOT EDIT BELOW HERE //
'// DO NOT EDIT BELOW HERE //
'// DO NOT EDIT BELOW HERE //
'//****************************//
'// Get clan name
If Len(GetSetting("crs", "clan_name")) = 0 Then
strClanName = InputBox("Please enter your clan's name." & String(2, vbCrLf) & "You can change this later inside pluginsettings.ini", "Clan Rank Script")
If Len(strClanName) = 0 Then strClanName = "Clan YourClanName"
SetSetting "crs", "clan_name", strClanName, "", False
End If
'// Create greet settings
SetSetting "crs", "m_greet_enabled", True, "Member greet status", False
SetSetting "crs", "nm_greet_enabled", True, "Non-member greet status", False
SetSetting "crs", "m_greet", "%r (%u) %0 has entered!", "Member greet", False
SetSetting "crs", "nm_greet", "Welcome %0 to %c, the home of %n!", "Non-member greet", False
'// Create an access level setting for each rank
For i = 1 to UBound(crsRanks) - 1
If i < UBound(crsRanks) / 3 Then
intAccess = 90
ElseIf i < UBound(crsRanks) / 1.5 Then
intAccess = 60
Else
intAccess = 20
End If
SetSetting "crs", "rank_" & i & "_access", intAccess, "", False
Next
'// Create a greet setting for each rank
For i = 1 to UBound(crsRanks) - 1
SetSetting "crs", "rank_" & i & "_greet", "", "", False
Next
'// Create array of command access requirements for use in mycmds command
cmdNames = Array(crsgreet_command, setrank_command, promote_command, demote_command, remove_command, rank_command, rankinfo_command, members_command, ranks_command, findrank_command, meminfo_command, mycmds_command)
accessReqs = Array(crsgreet_cmd_access, setrank_cmd_access, promote_cmd_access, demote_cmd_access, remove_cmd_access, rank_cmd_access, rankinfo_cmd_access, members_cmd_access, ranks_cmd_access, findrank_cmd_access, meminfo_cmd_access, mycmds_cmd_access)
For i = 0 to 11
crsCmdAccess(i, 0) = cmdNames(i)
crsCmdAccess(i, 1) = accessReqs(i)
Next
'// Database exists?
crsDatabasePath = BotPath() & "MemberData.mdb"
Set crsFSO = CreateObject("Scripting.FileSystemObject")
If Not crsFSO.FileExists(crsDatabasePath) Then
AddChat vbCyan, "Welcome to the Clan Rank Script! You can customize the number and names of existing ranks inside crsClanRankScript.plug"
AddChat vbCyan, "Please note that all changes to the NUMBER OF EXISTING RANKS should be made BEFORE you start adding members!"
AddChat vbCyan, "You may customize the access level each rank recieves inside your pluginsettings.ini file."
AddChat vbYellow, "For help using the Clan Rank Script, type ""/phelp crs"" inside your bot."
AddChat vbYellow, "For answers to common CRS questions and issues, PLEASE see the FAQ before posting a thread on the forum:"
AddChat vbCyan, "
http://www.stealthbot.net/board/index.php?showtopic=13965"
crs_create_database '// Create the database
Else
crs_connect '// Connect to database
End If
End Sub
Sub crs_Event_UserTalk(Username, Flags, Message, Ping)
GetDBEntry Username, myAccess, myFlags
'// User is executing a command?
If Username <> BotVars.Username Then
If Left(Message, 1) <> BotVars.Trigger Then Exit Sub
crsDisplay = 3
Else
If Left(Message, 2) = "//" Then
Message = Mid(Message, 2)
crsDisplay = 1
ElseIf Left(Message, 1) = "/" Then
crsDisplay = 4
Else
Exit Sub
End If
End If
'// Get the command and arguments
If Len(Message) < 2 Then Exit Sub
cmd = Split(Mid(Trim(Message), 2), " ")
'// Call the proper sub
Select Case LCase(cmd(0))
Case crsgreet_command: crsgreet_cmd cmd, Username, myAccess
Case setcrsgreet_command: setcrsgreet_cmd cmd, Username, myAccess, Message
Case setrank_command: setrank_cmd cmd, Username, myAccess
Case promote_command: promote_cmd cmd, Username, myAccess
Case demote_command: demote_cmd cmd, Username, myAccess
Case remove_command: remove_cmd cmd, Username, myAccess
Case allranks_command: allranks_cmd cmd, Username, myAccess
Case members_command: members_cmd Username, myAccess
Case findrank_command: findrank_cmd cmd, Username, myAccess
Case ranks_command: ranks_cmd Username, myAccess
Case rankinfo_command: rankinfo_cmd cmd, Username, myAccess
Case rank_command: rank_cmd cmd, Username, myAccess
Case meminfo_command: meminfo_cmd cmd, Username, myAccess
Case mycmds_command: mycmds_cmd cmd, Username, myAccess
End Select
End Sub
Sub crs_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString)
GetDBEntry Username, dbAccess, dbFlags
If dbFlags = "" Then dbFlags = "(none)"
'// Get user's rank data
set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & Username & "'")
If rs.Fields(0) <> 0 Then
set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & Username & "'")
rank = rs.Fields(2)
'// Update last active date/time
crsConn.Execute("UPDATE `members` SET `last_active` = '" & Now & "' WHERE `name`='" & LCase(Username) & "'")
End If
'// Replace greet variables
arrGreet = Array(GetSetting("crs", "m_greet"), GetSetting("crs", "nm_greet"))
If rank > 0 Then
If Not GetSetting("crs", "m_greet_enabled") Then Exit Sub
strRankGreet = GetSetting("crs", "rank_" & rank & "_greet")
If Len(strRankGreet) > 0 Then
ReDim Preserve arrGreet(1)
arrGreet(0) = strRankGreet
End If
Else
If Not GetSetting("crs", "nm_greet_enabled") Then Exit Sub
n = 1
End If
arrGreet(n) = Replace(arrGreet(n), "%0", Username)
arrGreet(n) = Replace(arrGreet(n), "%r", crsRanks(rank))
arrGreet(n) = Replace(arrGreet(n), "%u", CInt(rank))
arrGreet(n) = Replace(arrGreet(n), "%m", GetMemberCount())
arrGreet(n) = Replace(arrGreet(n), "%n", GetSetting("crs", "clan_name"))
arrGreet(n) = Replace(arrGreet(n), "%c", myChannel)
arrGreet(n) = Replace(arrGreet(n), "%1", BotVars.Username)
arrGreet(n) = Replace(arrGreet(n), "%t", Time)
arrGreet(n) = Replace(arrGreet(n), "%d", Date)
arrGreet(n) = Replace(arrGreet(n), "%v", ssc.GetBotVersion())
arrGreet(n) = Replace(arrGreet(n), "%a", dbAccess)
arrGreet(n) = Replace(arrGreet(n), "%f", dbFlags)
arrGreet(n) = Replace(arrGreet(n), "%p", Ping)
'// Display greeting
If rank > 0 Then
dsp m_greet_dsp, arrGreet(0), Username, 0
Else
dsp nm_greet_dsp, arrGreet(1), Username, 0
End If
End Sub
Sub crs_Event_WhisperFromUser(Username, Flags, Message)
crs_Event_UserTalk Username, Flags, Message, 0
End Sub
Sub crs_Event_PressedEnter(Text)
'// Avoid errors during command extraction
If Len(Text) < 2 Then Exit Sub
If Left(Text, 1) = "/" Then
'// Get the command
If Left(Text, 2) = "//" Then intStart = 3 Else intStart = 2 End If
commandName = Split(Mid(Trim(Text), intStart))(0)
'// If it's a CRS command, prevent bnet from recieving message (allows use of "/" as trigger)
Select Case commandName
Case crsgreet_command, setcrsgreet_command, setrank_command, promote_command, demote_command, remove_command, rank_command, rankinfo_command, members_command, ranks_command, findrank_command, meminfo_command, mycmds_command
VetoThisMessage
End Select
End If
crs_Event_UserTalk BotVars.Username, "", Text, 1
End Sub
'/// Command Subs ///
Sub crsgreet_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < crsgreet_cmd_access Or crsgreet_cmd_enabled = False Then Exit Sub
End If
If UBound(cmd) > 0 Then
Select Case cmd(1)
Case "on", "off"
If cmd(1) = "on" Then
SetSetting "crs", "m_greet_enabled", True, "", True
SetSetting "crs", "nm_greet_enabled", True, "", True
Else
SetSetting "crs", "m_greet_enabled", False, "", True
SetSetting "crs", "nm_greet_enabled", False, "", True
End If
dsp crsDisplay, "The member and non-member greets have been turned " & cmd(1) & ".", Username, vbCyan
Case "m", "nm"
If UBound(cmd) > 1 Then
If cmd(2) = "on" Or cmd(2) = "off" Then
If cmd(1) = "m" Then
If cmd(2) = "on" Then
SetSetting "crs", "m_greet_enabled", True, "", True
Else
SetSetting "crs", "m_greet_enabled", False, "", True
End If
dsp crsDisplay, "The member greet has been turned " & cmd(2) & ".", Username, vbCyan
Else
If cmd(2) = "on" Then
SetSetting "crs", "nm_greet_enabled", True, "", True
Else
SetSetting "crs", "nm_greet_enabled", True, "", True
End If
dsp crsDisplay, "The non-member greet has been turned " & cmd(2) & ".", Username, vbCyan
End If
End If
End If
End Select
End If
End Sub
Sub setcrsgreet_cmd(cmd, Username, Access, Message)
If Username <> BotVars.Username Then
If Access < setcrsgreet_cmd_access Or setcrsgreet_cmd_enabled = False Then Exit Sub
End If
If UBound(cmd) > 1 Then
If cmd(1) = "m" Then
SetSetting "crs", "m_greet", Mid(Message, Instr(Message, cmd(2))), "", True
dsp crsDisplay, "Member greet message set.", Username, vbCyan: Exit Sub
ElseIf cmd(1) = "nm" Then
SetSetting "crs", "nm_greet", Mid(Message, Instr(Message, cmd(2))), "", True
dsp crsDisplay, "Non-member greet message set.", Username, vbCyan: Exit Sub
ElseIf IsNumeric(cmd(1)) Then
If CInt(cmd(1)) > 0 And CInt(cmd(1)) < UBound(crsRanks) Then
SetSetting "crs", "rank_" & cmd(1) & "_greet", Mid(Message, Instr(Message, cmd(2))), "", True
dsp crsDisplay, "Rank " & cmd(1) & " (" & crsRanks(cmd(1)) & ") greet message set.", Username, vbCyan: Exit Sub
Else
crs_error 3, Username: Exit Sub
End If
End If
End If
dsp crsDisplay, "Command format: " & BotVars.Trigger & "setcrsgreet <m/nm/#> <greet>", Username, vbCyan
AddChat vbCyan, "Greet variables: %0 = joiner's Username, %r = joiner's rank name, %u = joiner's rank value, %m = member count, " & _
"%n = clan name, %c = channel name, %1=Current Bot Username, %t = Current time, %d = Current date, " & _
"%v = bot version, %a = joiner's Db access, %f = joiner's Db flags, %p = joiner's ping"
AddChat vbCyan, "Example 1: " & BotVars.Trigger & "setcrsgreet m Welcome clan member! Your rank is %r (%u)."
AddChat vbCyan, "Example 2: " & BotVars.Trigger & "setcrsgreet nm Welcome %0, our clan %n has %m members, your should join!"
AddChat vbCyan, "Example 3: " & BotVars.Trigger & "setcrsgreet 4 Hi %0, this is a special greet just for those with rank 4!"
End Sub
Sub setrank_cmd(cmd, Username, Access)
If Username <> BotVars.Username And cmd(0) = setrank_command Then
If Access < setrank_cmd_access Or setrank_cmd_enabled = False Then Exit Sub '// Valid command?
End If
If UBound(cmd) < 1 Then crs_error 8, Username: Exit Sub '// Username supplied?
'// Get user's current rank
Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & LCase(cmd(1)) & "'")
If rs.Fields(0) <> 0 Then
set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & LCase(cmd(1)) & "'")
curRank = rs.Fields(2)
Else
curRank = UBound(crsRanks)
End If
'// Get user's new rank
Select Case cmd(0)
Case promote_command, demote_command
If cmd(0) = promote_command Then pFlag = -1 Else pFlag = 1 End If
If UBound(cmd) < 2 Then
numRanks = 1
Else
If IsNumeric(cmd(2)) Then
numRanks = CInt(cmd(2))
Else
numRanks = 1
End If
End If
newRank = curRank + numRanks * pFlag
Case setrank_command
If UBound(cmd) < 2 Then crs_error 9, Username: Exit Sub '// Rank name/value supplied?
If Not IsNumeric(cmd(2)) Then
For i = 2 to UBound(cmd)
rankName = rankName & cmd(i) & " "
Next
newRank = getRankValue(rankName)
If newRank = 0 Then
crs_error 10, Username: Exit Sub
End If
Else
newRank = CInt(cmd(2))
End If
Case remove_command
newRank = UBound(crsRanks)
End Select
'// Get reason
If UBound(cmd) > 1 And cmd(0) <> setrank_command Then
If UBound(cmd) > 2 Or Not isNumeric(cmd(2)) Then '// Reason supplied?
If Not isNumeric(cmd(2)) Then rsn = cmd(2) & " "
For i = 3 to UBound(cmd)
rsn = rsn & cmd(i) & " "
Next
rsn = Left(rsn, Len(rsn) - 1) & ". "
rsn = Replace(rsn, "'", "`") '// replace single quotes to avoid errors
dispReason = "Reason: " & rsn
End If
End If
'// Get promoter's rank
If Username = BotVars.Username Then
promoterRank = 1
Else
Set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & Username & "'")
If rs.Fields(0) <> 0 Then
Set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & Username & "'")
promoterRank = rs.Fields(2)
End If
End If
'// Is promoter a member?
If promoterRank = 0 Then
crs_error 1, Username
If GetMemberCount() = 0 Then
dsp crsDisplay, "To make yourself a " & crsRanks(1) & ", inside your bot type /setrank <YourUsername> 1", Username, vbCyan
End If
Exit Sub
End If
'// If a demotion or a removal, does this member exist?
If (cmd(0) = demote_command Or cmd(0) = remove_command) And curRank = UBound(crsRanks) Then
crs_error 2, Username: Exit Sub
End If
'// Does this rank exist?
If newRank <= LBound(crsRanks) Or newRank > UBound(crsRanks) Then
crs_error 3, Username: Exit Sub
End If
'// Is promoter's rank higher than user's current rank?
If curRank <= promoterRank And Username <> BotVars.Username Then
crs_error 4, Username: Exit Sub
End If
'// If promoting to rank 1, is promoter in-bot?
If newRank = 1 and Username <> BotVars.Username Then
crs_error 5, Username: Exit Sub
End If
'// Is promoter's rank higher than user's new rank?
If newRank <= promoterRank And Username <> BotVars.Username Then
crs_error 6, Username: Exit Sub
End If
'// Is user's new rank equal to their current rank?
If newRank = curRank Then
crs_error 7, Username: Exit Sub
End If
'// Assign appropriate access to user
If auto_access_enabled Then
strAccess = GetSetting("crs", "rank_" & newRank & "_access")
If Len(strAccess) > 0 Then
If Instr(strAccess, " ") = 0 Then
GetDBEntry cmd(1), dbAccess, dbFlags
If Len(dbFlags) > 0 Then dbFlags = " " & dbFlags
End If
Command BotVars.Username, "/set " & LCase(cmd(1)) & " " & strAccess & dbFlags, True
End If
End If
If crs_show_rank_value Then
val1 = " (" & curRank & ")"
val2 = " (" & newRank & ")"
End If
'// Set user's new rank
If newRank >= UBound(crsRanks) Then
'// If user was demoted below lowest rank, remove from clan
crsConn.Execute("UPDATE `members` SET `name` = '<removed>', `rank`='0', `previous_rank`='" & curRank & "', `promoter_name`='" & _
Username & "', `promotion_date` = '" & Now & "', `reason` = '" & rsn & "' WHERE `name`='" & LCase(cmd(1)) & "'")
dsp crsDisplay, " Kicked " & cmd(1) & " out of " & GetSetting("crs", "clan_name") & ". " & dispReason, Username, vbCyan
kickedOut = True
Else
'// User is an existing member?
If curRank < UBound(crsRanks) Then
crsConn.Execute("UPDATE `members` SET `rank`='" & newRank & "', `previous_rank`='" & curRank & "', `promoter_name`='" & _
Username & "', `promotion_date` = '" & Now & "', `reason` = '" & rsn & "' WHERE `name`='" & LCase(cmd(1)) & "'")
If newRank < curRank Then pType = "Promoted" Else pType = "Demoted" End If
dsp crsDisplay, pType & " " & cmd(1) & " from " & crsRanks(curRank) & val1 & " to " & crsRanks(newRank) & val2 & ". " & dispReason, Username, vbCyan
'// Or user is a new member?
Else
crsConn.Execute("INSERT INTO `members` (`name`,`rank`,`previous_rank`, `promoter_name`, `promotion_date`, `join_date`, `reason`, `time_logged`) " & _
"VALUES ('" & LCase(cmd(1)) & "', '" & newRank & "', '0', '" & Username & "', '" & Now & "', '" & Now & "', '" & rsn & "', '0')")
dsp crsDisplay, "Added " & cmd(1) & " to " & GetSetting("crs", "clan_name") & " with rank " & crsRanks(newRank) & val2 & ". " & dispReason, Username, vbCyan
End If
End If
'// Update bot's profile
If profile_update_enabled Then
'// Get details from bot's last action
tmpUser = LCase(cmd(1))
Erase cmd: cmd = Split("rankinfo " & tmpUser, " ")
If Not kickedOut Then
rankinfo_cmd cmd, BotVars.Username, -2
Else
crsLastAct = cmd(1) & " was kicked out of " & GetSetting("crs", "clan_name") & " by " & Username & " on " & Replace(rs.Fields(5)," "," at ",1,1) & ". "
End If
'// Commented out until StealthBot 2.7 -- currently SetBotProfile causes a disconnect (has to do with changing the Sex in profile)
'SetBotProfile "", GetSetting("crs", "clan_name") & " " & chr(127) & " " & GetMemberCount() & " members " & str, "Last Action: " & Trim(capUsernames(crsLastAct))
End If
End Sub
Sub promote_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < promote_cmd_access or promote_cmd_enabled = False Then Exit Sub '// Valid command?
End If
setrank_cmd cmd, Username, Access
End Sub
Sub demote_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < demote_cmd_access or demote_cmd_enabled = False Then Exit Sub '// Valid command?
End If
setrank_cmd cmd, Username, Access
End Sub
Sub remove_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < remove_cmd_access or remove_cmd_enabled = False Then Exit Sub '// Valid command?
End If
setrank_cmd cmd, Username, Access
End Sub
Sub members_cmd(Username, Access)
If Username <> BotVars.Username Then
If Access < members_cmd_access Or members_cmd_enabled = False Then Exit Sub
End If
memberCount = GetMemberCount()
'// Are there any members yet?
If memberCount = 0 Then
dsp crsDisplay, "You have no members!", Username, vbCyan
dsp crsDisplay, "To get started, inside your bot type /setrank <YourUsername> 1", Username, vbCyan
Exit Sub
End If
dsp crsDisplay, memberCount & " members: " & GetAllMembers(), Username, vbCyan
End Sub
Sub findrank_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < findrank_cmd_access Or findrank_cmd_enabled = False Then Exit Sub '// Valid command?
End If
'// Rank value arguement exists?
If UBound(cmd) < 1 Then
crs_error 7, Username: Exit Sub
End If
'// Rank name supplied?
If Not IsNumeric(cmd(1)) Then
For i = 1 to UBound(cmd)
rankName = rankName & cmd(i) & " "
Next
rank = GetRankValue(rankName)
Else
rank = cmd(1)
End If
'// Does this rank exist?
If CInt(rank) < 1 Or CInt(rank) >= UBound(crsRanks) Then
If IsNumeric(cmd(1)) Then
crs_error 3, Username
Else
crs_error 10, Username
End If
Exit Sub
End If
'// Get all members with the specified rank
arrAllMembers = Split(GetAllMembers(), ", ") '// Get a list of all members
If crs_show_rank_value Then val = " (" & rank & ")"
rankString = crsRanks(rank) & val & " "
For i = 0 to UBound(arrAllMembers)
user = Replace(arrAllMembers(i), rankString, "")
If user <> arrAllMembers(i) Then
memCount = memCount + 1
memList = memList & user & ", "
End If
Next
If crs_show_rank_value Then val = " (" & rank & ")"
If Len(memCount) = 0 Then
dsp crsDisplay, " No members exist with rank " & crsRanks(rank) & val & ".", Username, vbCyan
Else
dsp crsDisplay, memCount & " members with rank " & crsRanks(rank) & val & ": " & Left(memList, Len(memList) - 2), Username, vbCyan
End If
End Sub
Sub ranks_cmd(Username, Access)
If Username <> BotVars.Username Then
If Access < findrank_cmd_access Or findrank_cmd_enabled = False Then Exit Sub '// Valid command?
End If
'// Get rank names
For i = 1 to UBound(crsRanks) - 1
If crs_show_rank_value Then val = " (" & i & ")"
ranks = ranks & crsRanks(i) & val & ", "
Next
dsp crsDisplay, "There are " & UBound(crsRanks) - 1 & " ranks: " & Left(ranks, Len(ranks) - 2), Username, vbCyan
End Sub
Sub rank_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < rank_cmd_access Or rank_cmd_enabled = False Then Exit Sub '// Valid command?
End If
If UBound(cmd) < 1 Then user = Username Else user = cmd(1) End If '// Username arguement exists?
'// Get user's rank data
set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & LCase(user) & "'")
If rs.Fields(0) <> 0 Then
set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & LCase(user) & "'")
Else
crs_error 2, Username: Exit Sub
End If
If crs_show_rank_value Then val = " (" & rs.Fields(2) & ")"
dsp crsDisplay, user & " is a " & crsRanks(rs.Fields(2)) & val & ".", Username, vbCyan
End Sub
Sub rankinfo_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < rankinfo_cmd_access Or rankinfo_cmd_enabled = False Then Exit Sub '// Valid command?
End If
If UBound(cmd) < 1 Then user = Username Else user = cmd(1) End If '// Username arguement exists?
'// Get user's rank data
set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & LCase(user) & "'")
If rs.Fields(0) <> 0 Then
set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & LCase(user) & "'")
Else
crs_error 2, Username: Exit Sub
End If
'// Get # ranks promoted, type of promotion
If rs.Fields(3) = 0 Then
numRanks = UBound(crsRanks) - rs.Fields(2): pRank = crsRanks(UBound(crsRanks))
Else
numRanks = rs.Fields(3) - rs.Fields(2): pRank = crsRanks(rs.Fields(3))
End If
If numRanks > 0 Then pType = "promoted" Else pType = "demoted" End If
If crs_show_rank_value Then
val1 = " (" & rs.Fields(3) & ")"
val2 = " (" & rs.Fields(2) & ")"
End If
If rs.Fields(7) <> vbNullString Then reason = "Reason: " & rs.Fields(7)
crsLastAct = user & " was " & pType & " " & Abs(numRanks) & " rank(s), from " & crsRanks(rs.Fields(3)) & val1 & " to " & _
crsRanks(rs.Fields(2)) & val2 & " by " & rs.Fields(4) & " " & "on " & Replace(rs.Fields(5)," "," at ",1,1) & ". " & reason
If Access <> -2 Then dsp crsDisplay, crsLastAct, Username, vbCyan
End Sub
Sub meminfo_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < meminfo_cmd_access Or meminfo_cmd_enabled = False Then Exit Sub '// Valid command?
End If
If UBound(cmd) < 1 Then user = Username Else user = cmd(1) End If '// Username arguement exists?
'// Get user's rank data
set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & LCase(user) & "'")
If rs.Fields(0) <> 0 Then
set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & LCase(user) & "'")
Else
crs_error 2, Username: Exit Sub
End If
'// Has user been active yet?
If rs.Fields(9) <> 0 Then
lastActive = " This user was last active on " & Replace(rs.Fields(9)," "," at ",1,1) & "."
End If
If crs_show_rank_value Then val = " (" & rs.Fields(2) & ")"
dsp crsDisplay, crsRanks(rs.Fields(2)) & val & " " & user & " joined " & GetSetting("crs", "clan_name") & " on " & _
Left(rs.Fields(6), Instr(rs.Fields(6), " ") - 1) & "." & lastActive, Username, vbCyan
End Sub
Sub mycmds_cmd(cmd, Username, Access)
If Username <> BotVars.Username Then
If Access < mycmds_cmd_access Or mycmds_cmd_enabled = False Then Exit Sub '// Valid command?
End If
'// Create list of all commands that user has enough access to use
For i = 0 to 11
If crsCmdAccess(i, 1) <= Access Then cmdList = cmdList & BotVars.Trigger & crsCmdAccess(i, 0) & ", "
Next
dsp crsDisplay, "You have enough access to use: " & Left(Trim(cmdList), Len(cmdList) - 2), Username, vbCyan
End Sub
'/// Functions ///
Function GetAllMembers()
set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
ubID = rs.Fields(0)
For i = 1 to ubID
set rs = crsConn.Execute("SELECT * FROM `members` WHERE `ID`="&i)
If Not (rs.BOF Or rs.EOF) Then
If rs.Fields(2) <> 0 Then
If crs_show_rank_value Then val = " (" & rs.Fields(2) & ")"
memList = memList & crsRanks(rs.Fields(2)) & val & " " & rs.Fields(1) & ", "
End If
End If
Next
If memList <> vbNullString Then
GetAllMembers = Left(memList, Len(memList) - 2)
Else
GetAllMembers = memList
End If
End Function
Function GetMemberCount()
memList = GetAllMembers
If memList = vbNullString Then
GetMemberCount = 0
Else
GetMemberCount = UBound(Split(memList, ", ")) + 1
End If
End Function
Function capUsernames(Message) '// make sure capitalizaton of usernames in message matches usernames in channel list
For i = 1 to GetInternalUserCount()
nameInChan = GetNameByPosition(i)
If Instr(LCase(Message), LCase(nameInChan)) Then
Message = Replace(Message, LCase(nameInChan), nameInChan, 1, 1)
End If
Next
capUsernames = Message
End Function
Function getRankValue(RankName)
For i = 1 to UBound(crsRanks)
If LCase(crsRanks(i)) = LCase(Trim(RankName)) Then
getRankValue = i
Exit Function
End If
Next
End Function
'/// Custom Subs ///
Sub crs_create_database()
'// Create the database
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & crsDatabasePath
'// Connect to database
crs_connect()
'// Create members Table
crsConn.Execute("CREATE TABLE `members` (`ID` COUNTER, `name` varchar(30) NOT NULL, `rank` int NULL, " & _
"`previous_rank` int NULL, `promoter_name` varchar(30) NOT NULL, `promotion_date` date NULL, " & _
"`join_date` date NULL, `reason` varchar(50) NULL, `time_logged` double NULL, `last_active` date NULL)")
End Sub
Sub crs_connect()
'// Create database connection
Set crsConn = CreateObject ("ADODB.connection")
dsn = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & crsDatabasePath
crsConn.ConnectionString = dsn
crsConn.Open
End Sub
Sub crs_error(errNum, Username)
Select Case errNum
Case 1: errString = "You must be a member to promote/demote other members."
Case 2: errString = "/meThat user does not exist."
Case 3: errString = "A rank of that value does not exist."
Case 4: errString = "You cannot promote/demote members of an equal or higher rank."
Case 5: errString = "You can only promote members to " & crsRanks(1) & " from inside the bot."
Case 6: errString = "You cannot promote a member to a rank equal to or higher than your own."
Case 7: errString = "You cannot set a user's rank to their current rank."
Case 8: errString = "You must supply a username."
Case 9: errString = "You must supply a rank value or rank name."
Case 10: errString = "A rank of that name does not exist."
End Select
If crsDisplay = 1 Then crsDisplay = 4
dsp crsDisplay, "Clan Rank Script: " & errString, Username, vbRed
End Sub
[/div]
