I really had to dig around to find this Vector...
Prefix: OnlineRanks
Name: Online Ranks
Bot(s) Supported: Stealthbot
Author: RiffRuff
Use: Managing ranks on IPB and the bot.
Changelog:Online Ranks Beta v0.51New Additions- Prompt for user input of database information if the information doesn't exist - Thanks Fusic
- phelp options written (inbot "/phelp onlineranks")
Online Ranks Beta v0.41 Bug Fixes - Promote command access requirement.
- Demote Sub Error - Thanks Fusic
- Demote DSP Error
New Additions General Coding - Indention Problems.
- Moved access check to a function - AllowedToUseCommand(myAccess, Command, CommandName)
Commands- promote - Promotes a user.
- demote - Demotes a user.
- rank - returns rank
Code:'OnlineRanks
'0.51
'&Online Ranks:RiffRuff
'&promote:demote:rank
'&
'&Requires use of a MySQL Database:Requires Invision Power Board v2.3.4:Requires the Plugin System.
'//MySQL Public Variables
Public OnlineRanks_tbl_prefix
Public OnlineRanks_db_host
Public OnlineRanks_db_user
Public OnlineRanks_db_pass
Public OnlineRanks_db_dbname
Public OnlineRanks_Conn
'//Command Names
Public Const Rank_cmd = "rank"
Public Const Promote_cmd = "promote"
Public Const Demote_cmd = "demote"
'//Command Access Requirements
Public Const Rank_cmd_access = -1
Public Const Promote_cmd_access = 20
Public Const Demote_cmd_access = 20
'//Debugging Options Enabled?
Public Const DebugPlugin = False
'// Form Objects
Public Const objCommandButton = 0
Public Const objLabel = 1
Public Const objTextBox = 2
Public Const objTimer = 3 'A Timer
Public Const objPictureBox = 4
Public Const objCheckBox = 5
Public Const objOptionBox = 6
Public Const objComboBox = 7
Public Const objListBox = 8
Public Const objShape = 9
Public Const objLine = 10
Public Const objListView = 11
Public Const objImageList = 12
Public Const objInet = 13
Public Const objRichTextBox = 13
'//Rank form object
Private frmRanks, objRankNames, objRankUp, objRankDown, objRankDelete, objRankSave, objRankCancel
Sub OnlineRanks_Event_Load()
If Len(GetSetting("OnlineRanks", "tbl_prefix")) = 0 Then
SetSetting "OnlineRanks", "tbl_prefix", InputBox("Please enter your database table prefix."), False
end if
If Len(GetSetting("OnlineRanks", "db_host")) = 0 Then
SetSetting "OnlineRanks", "db_host", InputBox("Please enter your database host."), False
end if
If Len(GetSetting("OnlineRanks", "db_user")) = 0 Then
SetSetting "OnlineRanks", "db_user", InputBox("Please enter your database username."), False
end if
If Len(GetSetting("OnlineRanks", "db_pass")) = 0 Then
SetSetting "OnlineRanks", "db_pass", InputBox("Please enter your database password."), False
end if
If Len(GetSetting("OnlineRanks", "db_dbname")) = 0 Then
SetSetting "OnlineRanks", "db_dbname", InputBox("Please enter your database name."), False
end if
OnlineRanks_tbl_prefix = GetSetting("OnlineRanks", "tbl_prefix")
OnlineRanks_db_host = GetSetting("OnlineRanks", "db_host")
OnlineRanks_db_user = GetSetting("OnlineRanks", "db_user")
OnlineRanks_db_pass = GetSetting("OnlineRanks", "db_pass")
OnlineRanks_db_dbname = GetSetting("OnlineRanks", "db_dbname")
If Not connect Then
AddChat vbGreen, InBot(4) & "?c1Connection to online database failed."
Else
AddChat vbGreen, InBot(4) & "Connection to online database sucessful."
End If
If Len(GetSetting("OnlineRanks", "rank1")) = 0 Then
OnlineRanks_frmRanks_Opening
End If
OnlineRanks_MenuItems
End Sub
Sub OnlineRanks_MenuItems()
AddMenuItem "OnlineRanks", "Ranks", False, False, False
End Sub
Sub OnlineRanks_Menu_Callback(ItemName)
Select Case ItemName
Case "Ranks"
OnlineRanks_frmRanks_Opening
End Select
End Sub
Sub OnlineRanks_frmRanks_Resize()
With frmRanks
.Width = 5500
.Height = 6000
End With
End Sub
Sub OnlineRanks_frmRanks_Opening()
Dim rs
DestroyForm "OnlineRanks", "frmRanks"
'//Create Forms
CreateForm "OnlineRanks", "frmRanks"
'//Add Objects to Forms
AddFormObject "OnlineRanks", "frmRanks", "objRankNames", objListBox
AddFormObject "OnlineRanks", "frmRanks", "objRankUp", objCommandButton
AddFormObject "OnlineRanks", "frmRanks", "objRankDown", objCommandButton
AddFormObject "OnlineRanks", "frmRanks", "objRankDelete", objCommandButton
AddFormObject "OnlineRanks", "frmRanks", "objRankSave", objCommandButton
AddFormObject "OnlineRanks", "frmRanks", "objRankCancel", objCommandButton
'//Create shortcuts
Set frmRanks = GetUIObject("OnlineRanks", "frmRanks")
Set objRankNames = GetUIObject("OnlineRanks", "frmRanks", "objRankNames")
Set objRankUp = GetUIObject("OnlineRanks", "frmRanks", "objRankUp")
Set objRankDown = GetUIObject("OnlineRanks", "frmRanks", "objRankDown")
Set objRankDelete = GetUIObject("OnlineRanks", "frmRanks", "objRankDelete")
Set objRankSave = GetUIObject("OnlineRanks", "frmRanks", "objRankSave")
Set objRankCancel = GetUIObject("OnlineRanks", "frmRanks", "objRankCancel")
'//Create captions
frmRanks.Caption = "Online Ranks Plugin - Ranks Management"
objRankUp.Caption = "Move Up"
objRankDown.Caption = "Move Down"
objRankDelete.Caption = "Delete"
objRankSave.Caption = "Save + Close"
objRankCancel.Caption = "Cancel + Close"
'//Set sizes
With objRankNames
.Top = 250
.Left = 200
.Width = 1500
.Height = 5000
End With
With objRankCancel
.Top = 5000
.Left = 3500
.Width = 1250
.Height = 250
End With
With objRankSave
.Top = 4500
.Left = 3500
.Width = 1250
.Height = 250
End With
With objRankUp
.Top = 250
.Left = 2000
.Width = 1000
.Height = 250
End With
With objRankDown
.Top = 4900
.Left = 2000
.Width = 1000
.Height = 250
End With
With objRankDelete
.Top = 2450
.Left = 2000
.Width = 1000
.Height = 250
End With
Set rs = OnlineRanks_Conn.Execute("SELECT COUNT(*) FROM `" & OnlineRanks_tbl_prefix & "groups`")
TotalRanks = CInt(rs.fields(0))
Set rs = OnlineRanks_Conn.Execute("SELECT `g_title` FROM `" & OnlineRanks_tbl_prefix & "groups`")
For i = 1 to TotalRanks
objRankNames.AddItem rs(0)
rs.MoveNext
Next
frmRanks.Show()
End Sub
Sub OnlineRanks_frmRanks_objRankSave_Click()
With objRankNames
If .ListCount > 0 Then
SetSetting "OnlineRanks", "totalranks", .ListCount, "", False
For i = 1 to .ListCount
SetSetting "OnlineRanks", "rank" & i, .List(i - 1), "", False
Next
End If
End With
frmRanks.Hide()
End Sub
Sub OnlineRanks_frmRanks_objRankCancel_Click()
frmRanks.Hide()
End Sub
Sub OnlineRanks_frmRanks_objRankUp_Click()
Dim intCurrentIndex
Dim strCurrentText
With objRankNames
If .ListIndex > 0 Then
intCurrentIndex = .ListIndex
strCurrentText = .List(.ListIndex)
.RemoveItem .ListIndex
.AddItem strCurrentText, intCurrentIndex - 1
.ListIndex = intCurrentIndex - 1
End If
End With
End Sub
Sub OnlineRanks_frmRanks_objRankDown_Click()
Dim intCurrentIndex
Dim strCurrentText
With objRankNames
If .ListIndex < (.ListCount - 1) And Not .ListIndex = -1 Then
intCurrentIndex = .ListIndex
strCurrentText = .List(.ListIndex)
.RemoveItem .ListIndex
.AddItem strCurrentText, intCurrentIndex + 1
.ListIndex = intCurrentIndex + 1
End If
End With
End Sub
Sub OnlineRanks_frmRanks_objRankDelete_Click()
objRankNames.RemoveItem objRankNames.ListIndex
End Sub
Sub OnlineRanks_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatString, Banned)
If Instr(Username, "@") > 0 Then
Username = Split(Username, "@", 2)(0)
End If
If Not UserExists(Username) Then
Exit Sub
End If
AddQ RankName(Username) & " " & Username & " has joined the channel."
End Sub
Sub OnlineRanks_Event_UserTalk(Username, Flags, Message, Ping)
OnlineRanks_ProcessInput Username, Message, 1
End Sub
Sub OnlineRanks_Event_UserEmote(Username, Flags, Message)
OnlineRanks_ProcessInput Username, Message, 2
End Sub
Sub OnlineRanks_Event_WhisperFromUser(Username, Flags, Message)
OnlineRanks_ProcessInput Username, Message, 3
End Sub
Sub OnlineRanks_Event_PressedEnter(Text)
OnlineRanks_ProcessInput BotVars.Username, Text, 4
End Sub
Sub OnlineRanks_ProcessInput(Username, Message, From)
'//Make sure they are using the bots trigger if command is outside of bot
If Left(Message, Len(BotVars.Trigger)) <> BotVars.Trigger And From <> 4 Then
Exit Sub
End If
'//Make sure they are using / if command is inside bot
If (Left(Message, 1) <> "/") And (From = 4) Then
Exit Sub
End If
'//Get user access
GetDBEntry Username, myAccess, myFlags
'//Setup message for command processing
Message = Right(Message, Len(Message) - Len(BotVars.Trigger))
If InStr(Message, " ") > 0 Then
TmpMsg = Split(Message, " ", 2)
Select Case LCase(TmpMsg(0))
Case Rank_cmd: OnlineRanks_Rank_Cmd Username, TmpMsg(1), From, myAccess, myFlags
Case Promote_cmd: OnlineRanks_Promote_Cmd Username, TmpMsg(1), From, myAccess, myFlags
Case Demote_cmd: OnlineRanks_Demote_Cmd Username, TmpMsg(1), From, myAccess, myFlags
Case Else: Exit Sub
End Select
Else
Select Case LCase(Message)
Case Rank_cmd: OnlineRanks_Rank_Cmd Username, Username, From, myAccess, myFlags
Case Else: Exit Sub
End Select
End If
End Sub
Sub OnlineRanks_Rank_Cmd(Username, Message, From, myAccess, myFlags)
VetoThisMessage
DebugOutput("OnlineRanks_Rank_Cmd sub called.")
If Not AllowedToUseCommand(myAccess, Rank_cmd_access, Rank_cmd) Then Exit Sub
'//Check to make sure user exists in the database
If Not UserExists(Message) Then
DebugOutput("User does not exist.")
Exit Sub
Else
DebugOutput("User exists.")
End If
DSP From, InBot(From) & Message & " currently has a rank of " & RankName(Message) & ".", Username, vbGreen
End Sub
Sub OnlineRanks_Promote_Cmd(Username, Message, From, myAccess, myFlags)
VetoThisMessage
DebugOutput("OnlineRanks_Promote_Cmd sub called.")
If Not AllowedToUseCommand(myAccess, Promote_cmd_access, Promote_cmd) Then Exit Sub
'//Check to make sure user recieving a promotion exists in the database
If Not UserExists(Message) Then
DebugOutput("User recieving promotion does not exist.")
Exit Sub
Else
DebugOutput("User recieving promotion exists.")
End If
If From <> 4 Then
'//Check to make sure user exists in the database
If Not UserExists(Username) Then
DebugOutput("User does not exist.")
Exit Sub
Else
DebugOutput("User exists.")
End If
'//Check to make sure the promoter is still a higher rank than the promotee
If Not RankHigher(Username, Message) Then
DebugOutput("User is not a high enough rank.")
Exit Sub
End If
End If
DebugOutput("User is a high enough rank.")
OldRank = RankName(Message)
OldRankNumber = RankNumberSettings(Message)
OnlineRanks_Conn.Execute("UPDATE `" & OnlineRanks_tbl_prefix & "members` SET `mgroup` = '" & RankNumberConverter(GetSetting("OnlineRanks", "rank" & OldRankNumber - 1)) & "' WHERE `members_display_name` = '" & Message & "'")
DSP From, InBot(From) & Message & " was sucessfully promoted from " & OldRank & " to " & RankName(Message) & ".", Username, vbGreen
End Sub
Sub OnlineRanks_Demote_Cmd(Username, Message, From, myAccess, myFlags)
VetoThisMessage
DebugOutput("OnlineRanks_Demote_Cmd sub called.")
If Not AllowedToUseCommand(myAccess, Demote_cmd_access, Demote_cmd) Then Exit Sub
'//Check to make sure user recieving a demotion exists in the database
If Not UserExists(Message) Then
DebugOutput("User recieving demotion does not exist.")
Exit Sub
End If
DebugOutput("User recieving demotion exists.")
If From <> 4 Then
'//Check to make sure user exists in the database
If Not UserExists(Username) Then
DebugOutput("User does not exist.")
Exit Sub
Else
DebugOutput("User Exists.")
End If
'//Check to make sure the demoter is a higher rank than the demotee
If Not RankHigher(Username, Message) Then
DebugOutput("User is not a high enough rank.")
Exit Sub
End If
DebugOutput("User is a high enough rank.")
End If
'//Check to make sure the user recieving a demotion is not going to be removed!
If RankNumberSettings(Message) + 1 > GetSetting("OnlineRanks", "totalranks") Then
DebugOutput("User being demoted can not be removed from the bot.")
Exit Sub
End If
DebugOutput("User being demoted is not being removed from the bot.")
OldRank = RankName(Message)
OldRankNumber = RankNumberSettings(Message)
OnlineRanks_Conn.Execute("UPDATE `" & OnlineRanks_tbl_prefix & "members` SET `mgroup` = '" & RankNumberConverter(GetSetting("OnlineRanks", "rank" & OldRankNumber + 1)) & "' WHERE `members_display_name` = '" & Message & "'")
DSP From, InBot(From) & Message & " was sucessfully demoted from " & OldRank & " to " & RankName(Message) & ".", Username, vbGreen
End Sub
Function IsConnected()
DebugOutput("IsConnected function alled.")
On Error Resume Next
Dim rs
Set rs = OnlineRanks_Conn.Execute("SELECT `mgroup` FROM `" & OnlineRanks_tbl_prefix & "members`")
rs.MoveFirst
If Err.Number = -2147467259 Then
DebugOutput("The bot is not connected, attempting to connect")
connect
End If
DebugOutput("The bot is connected")
End Function
Function AllowedToUseCommand(myAccess, Command, CommandName)
DebugOutput("AllowedToUseCommand function called.")
'//Check if access is correct
If myAccess < Command Then
DebugOutput("User does not meet access requirements for the " & Command & " command.")
AllowedToUseCommand = False
End If
DebugOutput("User meets access requirements for the " & Command & " command.")
AllowedToUseCommand = True
End Function
Function RankNumberSettings(Username)
DebugOutput("RankNumberSettings function called.")
Rank = RankName(Username)
For i = 1 to GetSetting("OnlineRanks", "totalranks")
If LCase(Rank) = LCase(GetSetting("OnlineRanks", "rank" & i)) Then
RankNumberSettings = i
End If
Next
End Function
Function RankHigher(User1, User2)
DebugOutput("RankHigher function called.")
'//Retrieve both users ranks
UserRankName1 = RankName(User1)
UserRankName2 = RankName(User2)
For i = 1 to GetSetting("OnlineRanks", "totalranks")
If LCase(GetSetting("OnlineRanks", "rank" & i)) = LCase(UserRankName1) Then
UserRankNumber1 = i
End If
Next
For i = 1 to GetSetting("OnlineRanks", "totalranks")
If LCase(GetSetting("OnlineRanks", "rank" & i)) = LCase(UserRankName2) Then
UserRankNumber2 = i
End If
Next
If UserRankNumber1 < UserRankNumber2 Then
RankHigher = True
Else
RankHigher = False
End If
End Function
Function RankNumberConverter(Rank)
DebugOutput("RankNumberConverter function called.")
Dim rs
Set rs = OnlineRanks_Conn.Execute("SELECT `g_id` FROM `" & OnlineRanks_tbl_prefix & "groups` WHERE `g_title` = '" & Rank & "'")
RankNumberConverter = rs(0)
End Function
Function RankNumber(Username)
DebugOutput("RankNumber function called.")
Dim rs
Set rs = OnlineRanks_Conn.Execute("SELECT `mgroup` FROM `" & OnlineRanks_tbl_prefix & "members` WHERE `members_display_name` = '" & Username & "'")
rs.MoveFirst
RankNumber = rs(0)
End Function
Function RankName(Username)
DebugOutput("RankName function called.")
Dim rs
Set rs = OnlineRanks_Conn.Execute("SELECT `g_title` FROM `" & OnlineRanks_tbl_prefix & "groups` WHERE `g_id` = '" & RankNumber(Username) & "'")
RankName = rs(0)
End Function
Function InBot(From)
DebugOutput("InBot function called.")
If From = 4 Then
InBot = "?cu?cbOnline Ranks:?cu?cb?c8 "
Else
InBot = ""
End If
End Function
Function UserExists(Username)
DebugOutput("UserExists function called.")
Dim rs
Set rs = OnlineRanks_Conn.Execute("SELECT COUNT(*) FROM `" & OnlineRanks_tbl_prefix & "members` WHERE `members_display_name` = '" & Username & "'")
If CInt(rs.fields(0)) = 0 Then
UserExists = False
Else
UserExists = True
End If
End Function
Function connect()
DebugOutput("Connect function called.")
'// Connect to Database
Set OnlineRanks_Conn = CreateObject("ADODB.Connection")
OnlineRanks_Conn.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & OnlineRanks_db_host & ";DATABASE=" & OnlineRanks_db_dbname & ";USER=" & OnlineRanks_db_user & ";PASSWORD=" & OnlineRanks_db_pass & ";OPTION=3;"
OnlineRanks_Conn.Open
connect = true
End Function
Function DebugOutput(Message)
If DebugPlugin Then
DSP 4, "?cu?cbOnline Ranks:?cu?cb?c1 " & Message, Username, vbGreen
End If
End Function
