**FIXED A BUG USE THIS ONE NOT ONE ABOVE**
Script("Name") = "Clan Members"
Script("Abbreviation") = "clan members"
Script("Author") = "Fpa-rF-"
Script("Category") = "Utility"
Script("Major") = 1
Script("Minor") = 0
Script("Revision") = 1
Script("Description") = "Clan Member Management"
' https://pastebin.com/ztK9sq4s
' SCRIPT COMMANDS
' ===============
' rhelp - LISTS CLAN MEMBER COMMANDS (THIS SCRIPT) !rhelp
' members - LISTS MEMBERS BY RANK (scripts\..\members.txt) (SEE ABOVE) !members
' rnum - LISTS NUMBER OF MEMBERS AND OPEN POSITIONS -> (OPEN) !rnum
' rfind - LISTS A MEMBER AND RANK !rfind Username
' rlist - LISTS NUMBER OF RANKS (SEE ABOVE) !rlist
' radd - ADDS MEMBER TO CLAN LIST !radd Username clanrank OR !radd (OPEN) clanrank
' rdel - DELS MEMBER FROM CLAN LIST !rdel Username
' redit - EDITS A MEMBER RANK IN CLAN LIST !redit Username clanrank
' rpromote - PROMOTE A MEMBER 1 RANK !rpromote Username
' rdemote - DEMOTE A MEMBER 1 RANK !rdemote Username
' ropen - ADDS A RANK POSITION (OPEN) !ropen clanrank
' rclose - DELS A RANK POSITION (OPEN) !rclose clanrank
' SCRIPT SETTINGS
' ===============
'ENTER YOUR REQUIRED ACCESS LEVEL FOR COMMANDS
Public reqaccess : reqaccess = 1
'RANKS/ROSTER FILE (KEEP OUT OF SCRIPTS FOLDER)
Public members_list : members_list = BotPath() & "scripts\..\members.txt"
'ENTER YOUR CLAN TAG BELOW (ONE WILDCARD * ALLOWED, * IS MEMBER NAME)
'EXAMPLE RIGHT SIDED: clantag = "*-TaG-"
'EXAMPLE LEFT SIDED: clantag = "~TaG~*"
'EXAMPLE DUAL SIDED: clantag = "]*["
Public clantag : clantag = "*[EUD]"
'ENTER YOUR RANKS BELOW - ADD AS MANY AS YOU NEED
Public clanranks : clanranks = Array( _
"Leader", _
"General", _
"Moderator", _
"Recruit")
Public intOpen : intOpen = 0
Public strOpen : strOpen = ""
Public Sub Event_Load()
Dim objWriteFile
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(members_list) Then
Else
Set objWriteFile= objFSO.OpenTextFile(members_list, 8, True, 0)
objWriteFile.Close
End If
If OpenCommand("members") Is Nothing Then
With CreateCommand("members")
.Description = "List Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rhelp") Is Nothing Then
With CreateCommand("rhelp")
.Description = "List Clan Member Commands"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rnum") Is Nothing Then
With CreateCommand("rnum")
.Description = "List Number Of Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rfind") Is Nothing Then
With CreateCommand("rfind")
.Description = "Find Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rlist") Is Nothing Then
With CreateCommand("rlist")
.Description = "List Clan Ranks"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("radd") Is Nothing Then
With CreateCommand("radd")
.Description = "Add Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rdel") Is Nothing Then
With CreateCommand("rdel")
.Description = "Delete Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("redit") Is Nothing Then
With CreateCommand("redit")
.Description = "Edit Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rpromote") Is Nothing Then
With CreateCommand("rpromote")
.Description = "Promote Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rdemote") Is Nothing Then
With CreateCommand("rdemote")
.Description = "Demote Clan Members"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("ropen") Is Nothing Then
With CreateCommand("ropen")
.Description = "Add Clan Rank Recruting Position"
.RequiredRank = reqaccess
.Save
End With
End If
If OpenCommand("rclose") Is Nothing Then
With CreateCommand("rclose")
.Description = "Remove Clan Rank Recruting Position"
.RequiredRank = reqaccess
.Save
End With
End If
End Sub
Public Sub Event_Command(Command)
FormatTag()
Dim objWriteFile
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(members_list) Then
Else
Set objWriteFile= objFSO.OpenTextFile(members_list, 8, True, 0)
objWriteFile.Close
End If
If LCase(Command.Name) = "rhelp" Then
AddQ "Clan Member Management Commands: members, rnum, rfind, rlist, radd, rdel, redit, rpromote, rdemote, ropen, rclose, rhelp."
End If
If LCase(Command.Name) = "members" Then
intNumMembers = NumLines()
strMembers = Split(ListMembers(), vbcrlf)
For x = 0 To intNumMembers - 1
AddQ strMembers(x)
Next
End If
If LCase(Command.Name) = "rnum" Then
intNumMembers = NumMembers()
If intOpen > 0 Then
strOpen = Left(strOpen,Len(strOpen)-2) & "."
AddQ "Clan " & clantag & " currently has " & intNumMembers & " members, and " & intOpen & " recruiting positions: " & strOpen
Else
AddQ "Clan " & clantag & " currently has " & intNumMembers & " members. Recruting currently closed."
End If
End If
If LCase(Command.Name) = "rfind" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
strUser = Command.Args
strRank = GetRank(strUser)
If strRank <> "" And LCase(strUser) <> LCase("(OPEN)") Then
AddQ strRank & ": " & strUser
ElseIf strRank = "" And strUser <> "" Then
AddQ strUser & " not found in Clan " & clantag & " members list."
Else
AddQ "You must specify a username."
End If
Else
strSplit = Split(Command.Args, " ") '2 or more args
strUser = strSplit(0)
strRank = GetRank(strUser)
If strRank <> "" And LCase(strUser) <> LCase("(OPEN)") Then
AddQ strRank & ": " & strUser
End If
End If
End If
If LCase(Command.Name) = "rlist" Then
For x = LBound(clanranks) To UBound(clanranks)
strMessage = strMessage & clanranks(x) & ", "
Next
strMessage = Left(strMessage,Len(strMessage)-2) & "."
AddQ "[" & UBound(clanranks) + 1 &"] " & strMessage
End If
If LCase(Command.Name) = "radd" Then
If NumLines() = 0 Then
strUser = Command.Username
Call AddCMember(strUser, clanranks(0))
AddQ "[NEW] " & members_list & " is empty, adding " & strUser & " as highest rank " & clanranks(0) & "."
End If
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
AddQ "You must specify a username and clanrank."
Else
strSplit = Split(Command.Args, " ") '2 or more args
strUser = strSplit(0)
strSetRank = strSplit(1)
strRank = GetRank(strUser)
If strRank <> "" And LCase(strUser) <> LCase("(OPEN)") Then
AddQ strUser & " is already a ranked member."
ElseIf strUser <> "" And strSetRank <> "" Then
If CheckTag(strUser) = 1 Then
If FindRank(strSetRank) <> "" Then
For x = LBound(clanranks) To UBound(clanranks)
If LCase(strSetRank) = LCase(clanranks(x)) Then
strRankIndex = x + 1
Exit For
End If
Next
strSupRank = GetRankIndex(Command.Username)
If strRankIndex <> "" And strSupRank <> "" And strSupRank < strRankIndex Or LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
If DelCMember(strUser) = True Then
Call AddCMember(strUser, strSetRank)
AddQ "[ADDED] " & strUser & " as rank " & strSetRank & " to Clan " & clantag & " members list."
Call AddRMember(strUser)
AddChat &H99CC00, strUser & " has been given rank " & reqaccess & "."
AddChat vbYellow, "Added " & strUser & " to " & BotVars.Username & " User Datatbase with access: " & reqaccess
ReloadSettings 1
End If
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Then
AddQ "You cannot add a member to the same rank or higher."
End If
Else
AddQ "The clanrank you specified is not valid."
End If
ElseIf CheckTag(strUser) = 2 Then
AddQ "Cannot add member to Clan " & clantag & " members list. The username " & strUser & " is restricted."
Else
AddQ "Cannot add member to Clan " & clantag & " members list. " & strUser & " is not wearing clan tag."
End If
End If
End If
End If
If LCase(Command.Name) = "rdel" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
strUser = Command.Args
strRank = GetRank(strUser)
If strRank <> "" And LCase(strUser) <> LCase("(OPEN)") Then
strRankIndex = GetRankIndex(strUser)
strSupRank = GetRankIndex(Command.Username)
If strRankIndex <> "" And strSupRank <> "" And strSupRank < strRankIndex Or LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
If DelCMember(strUser) = True Then
AddQ "[REMOVED] " & strRank & ": " & strUser & " from Clan " & clantag & " members list."
Call DelRMember(strUser)
AddChat &H99CC00, """" & strUser & """ has been removed from the database."
AddChat vbYellow, "Removed " & strUser & " from " & BotVars.Username & " User Datatbase."
ReloadSettings 1
End If
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Then
AddQ "You cannot delete a member of same rank or higher."
End If
ElseIf strRank = "" Then
AddQ "The member you are trying to delete is not in Clan " & clantag & " members list."
Else
AddQ "You must specify a username."
End If
Else
strSplit = Split(Command.Args, " ") '2 or more args
strUser = strSplit(0)
strRank = GetRank(strUser)
If strRank <> "" And LCase(strUser) <> LCase("(OPEN)") Then
strRankIndex = GetRankIndex(strUser)
strSupRank = GetRankIndex(Command.Username)
If strRankIndex <> "" And strSupRank <> "" And strSupRank < strRankIndex Or LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
If DelCMember(strUser) = True Then
AddQ "[REMOVED] " & strUser & " from Clan " & clantag & " members list."
Call DelRMember(strUser)
AddChat &H99CC00, """" & strUser & """ has been removed from the database."
AddChat vbYellow, "Removed " & strUser & " from " & BotVars.Username & " User Datatbase."
ReloadSettings 1
End If
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Then
AddQ "You cannot delete a member of same rank or higher."
End If
End If
End If
End If
If LCase(Command.Name) = "redit" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
AddQ "You must specify a username and a clanrank."
Else
strSplit = Split(Command.Args, " ") '2 or more args
strUser = strSplit(0)
strSetRank = strSplit(1)
If FindRank(strSetRank) <> "" Then
strRank = GetRank(strUser)
If strRank <> "" And strSetRank <> "" Then
strSupRank = GetRankIndex(Command.Username) '4
strRankIndex = GetRankIndex(strUser) '5
For x = LBound(clanranks) To UBound(clanranks)
If LCase(strSetRank) = Lcase(clanranks(x)) Then
strChangeRank = x + 1
Exit For
End If
Next
If strRankIndex <> "" And LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
If DelCMember(strUser) = True Then
Call AddCMember(strUser, strSetRank)
AddQ "[EDITED] " & strUser & " as rank " & strSetRank & " to Clan " & clantag & " members list."
End If
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank < strRankIndex And strChangeRank > strSupRank Then
If DelCMember(strUser) = True Then
Call AddCMember(strUser, strSetRank)
AddQ "[EDITED] " & strUser & " as rank " & strSetRank & " to Clan " & clantag & " members list."
End If
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Then
AddQ "You cannot edit a member of same rank or higher."
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank = strChangeRank Then
AddQ "You cannot edit a member to the same rank or higher."
Else
AddQ "The member you are trying to edit is not in Clan " & clantag & " members list."
End If
Else
AddQ "The member you are trying to edit is not in Clan " & clantag & " members list."
End If
Else
AddQ "You specified an invalid clanrank."
End If
End If
End If
If LCase(Command.Name) = "rpromote" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
strUser = Command.Args
strRankIndex = GetRankIndex(strUser)
strSupRank = GetRankIndex(Command.Username)
If strRankIndex <> "" And LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
PromoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been promoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank < (strRankIndex - 1) Then
PromoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been promoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Then
AddQ "You cannot promote a member of same rank or higher."
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= (strRankIndex - 1) Then
AddQ "You cannot promote a member to the same rank or higher."
ElseIf Command.Args = "" Then
AddQ "You must specify a member to promote."
Else
AddQ "The member you are trying to promote is not in Clan " & clantag & " members list."
End If
Else
strSplit = Split(Command.Args, " ") '2 or more args
strUser = strSplit(0)
strRankIndex = GetRankIndex(strUser)
strSupRank = GetRankIndex(Command.Username)
If strRankIndex <> "" And LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
PromoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been promoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank < (strRankIndex - 1) Then
PromoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been promoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Then
AddQ "You cannot promote a member of same rank or higher."
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= (strRankIndex - 1) Then
AddQ "You cannot promote a member to the same rank or higher."
ElseIf Command.Args = "" Then
AddQ "You must specify a member to promote."
Else
AddQ "The member you are trying to promote is not in Clan " & clantag & " members list."
End If
End If
End If
If LCase(Command.Name) = "rdemote" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
strUser = Command.Args
strRankIndex = GetRankIndex(strUser)
strSupRank = GetRankIndex(Command.Username)
If strRankIndex <> "" And LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
DemoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been demoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank < strRankIndex Then
DemoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been demoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Or LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
AddQ "You cannot demote a member of same rank or higher."
ElseIf Command.Args = "" Then
AddQ "You must specify a member to demote."
Else
AddQ "The member you are trying to demote is not in Clan " & clantag & " members list."
End If
Else
strSplit = Split(strArgs, " ") '2 or more args
strUser = strSplit(0)
strRankIndex = GetRankIndex(strUser)
strSupRank = GetRankIndex(Username)
If strRankIndex <> "" And LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
DemoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been demoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank < strRankIndex Then
DemoteCMember(strUser)
strRank = GetRank(strUser)
AddQ strUser & " has been demoted to rank " & strRank
ElseIf strRankIndex <> "" And strSupRank <> "" And strSupRank >= strRankIndex Or LCase(GetRank(Command.Username)) = LCase(clanranks(0)) Then
AddQ "You cannot demote a member of same rank or higher."
ElseIf Command.Args = "" Then
AddQ "You must specify a member to demote."
Else
AddQ "The member you are trying to demote is not in Clan " & clantag & " members list."
End If
End If
End If
If LCase(Command.Name) = "ropen" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
strRank = Command.Args
If LCase(strRank) = LCase(FindRank(strRank)) And strRank <> "" Then
Call AddCMember("(OPEN)", strRank)
AddQ "[ADDED] " & strRank & " open-position to Clan " & clantag & " members list."
Else
AddQ "You must specify a clanrank to open a position. Try " & BotVars.Trigger & "ropen clanrank"
End If
Else
strSplit = Split(Command.Args, " ") '2 or more args
strRank = strSplit(0)
If LCase(strRank) = LCase(FindRank(strRank)) And strRank <> "" Then
Call AddCMember("(OPEN)", strRank)
AddQ "[ADDED] " & strRank & " open-position to Clan " & clantag & " members list."
Else
AddQ "You must specify a clanrank to open a position. Try " & BotVars.Trigger & "ropen clanrank"
End If
End If
End If
If LCase(Command.Name) = "rclose" Then
If InStr(1, Command.Args, " ", vbTextCompare) = 0 Then '0 or 1 arg
strRank = Command.Args
If LCase(strRank) = LCase(FindRank(strRank)) And strRank <> "" Then
If RemRankPos(strRank) = True Then
AddQ "[REMOVED] " & strRank & " open-position removed from Clan " & clantag & " members list."
End If
Else
AddQ "You must specify a clanrank to remove an open position. Try " & BotVars.Trigger & "rclose clanrank"
End If
Else
strSplit = Split(Command.Args, " ") '2 or more args
strRank = strSplit(0)
If LCase(strRank) = LCase(FindRank(strRank)) And strRank <> "" Then
If RemRankPos(strRank) = True Then
AddQ "[REMOVED] " & strRank & " open-position removed from Clan " & clantag & " members list."
End If
Else
AddQ "You must specify a clanrank to remove an open position. Try " & BotVars.Trigger & "rclose clanrank"
End If
End If
End If
End Sub
Function PromoteCMember(strMember)
strRankIndex = GetRankIndex(strMember)
For x = LBound(clanranks) To UBound(clanranks)
If x = strRankIndex - 1 Then
If x <> LBound(clanranks) Then
DelCMember(strMember)
Call AddCMember(strMember, clanranks(x-1))
Exit For
End If
End If
Next
End Function
Function DemoteCMember(strMember)
strRankIndex = GetRankIndex(strMember)
For x = LBound(clanranks) To UBound(clanranks)
If x = strRankIndex - 1 Then
If x <> UBound(clanranks) Then
DelCMember(strMember)
Call AddCMember(strMember, clanranks(x+1))
Exit For
End If
End If
Next
End Function
Function AddCMember(strMember, strSetRank)
Dim objReadFile, objWriteFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile= objFSO.OpenTextFile(members_list, 1)
For x = LBound(clanranks) To UBound(clanranks)
If LCase(strSetRank) = LCase(clanranks(x)) Then
intPrevRankPos = x + 1
blnRankExists = True
strSetRank = clanranks(x)
Exit For
End If
blnRankExists = False
Next
If blnRankExists = True Then
intFilePos = 0
blnNextRank = False
Do While Not objReadFile.AtEndOfStream
intFilePos = intFilePos + 1
intNumLines = NumLines
strLine = objReadFile.readline 'Read line
If strLine <> "" Then
strFile = strFile & strLine
If intNumLines <> intFilePos Then strFile = strFile & vbcrlf
End If
If InStr(1, strLine, " ", vbTextCompare) > 0 Then '1 or more arg
strSplit = Split(strLine, " ")
strRank = Left(strSplit(0),Len(strSplit(0))-1)
If strRank = strSetRank Then
blnNextRank = True
ElseIf strRank <> strSetRank And blnNextRank = True Then
intSetFilePos = intFilePos - 1
blnNextRank = False
End If
End If
Loop
If intSetFilePos = "" Then
intSetFilePos = NumLines()
End If
objReadFile.Close 'Close file
Set objWriteFile= objFSO.OpenTextFile(members_list, 2)
strSplit = Split(strFile, vbcrlf)
For x = LBound(strSplit) To UBound(strSplit)
intCount = x + 1
If intCount = intSetFilePos Then
objWriteFile.WriteLine(strSplit(x))
objWriteFile.WriteLine(strSetRank & ": " & strMember)
Else
objWriteFile.WriteLine(strSplit(x))
End If
Next
objWriteFile.Close 'Close file
End If
End Function
Function DelCMember(strMember)
Dim objReadFile, objWriteFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile= objFSO.OpenTextFile(members_list, 1)
blnWriteFile = False
Do While Not objReadFile.AtEndOfStream
strLine = objReadFile.readline 'Read line
If InStr(1, strLine, " ", vbTextCompare) > 0 Then '1 or more arg
strSplit = Split(strLine, " ")
If LCase(strSplit(1)) <> LCase(strMember) Then
strFile = strFile & strLine & vbcrlf
End If
blnWriteFile = True
End If
Loop
If blnWriteFile = True Then
objReadFile.Close 'Close file
Set objWriteFile= objFSO.OpenTextFile(members_list, 2)
strSplit = Split(strFile, vbcrlf)
For x = LBound(strSplit) To UBound(strSplit)
If strSplit(x) <> "" Then
objWriteFile.WriteLine(strSplit(x))
End If
Next
DelCMember = True
End If
End Function
Function AddRMember(strMember)
Dim objReadFile, objWriteFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile= objFSO.OpenTextFile(BotPath & "Users.txt", 1)
Do While Not objReadFile.AtEndOfStream
intFilePos = intFilePos + 1
intNumLines = RNumLines
strLine = objReadFile.readline 'Read line
If strLine <> "" Then
strFile = strFile & strLine
If intNumLines <> intFilePos Then strFile = strFile & vbcrlf
End If
Loop
If intSetFilePos = "" Then
intSetFilePos = RNumLines()
End If
objReadFile.Close 'Close file
Set objWriteFile= objFSO.OpenTextFile(BotPath & "Users.txt", 2)
strSplit = Split(strFile, vbcrlf)
For x = LBound(strSplit) To UBound(strSplit)
intCount = x + 1
If intCount = intSetFilePos Then
objWriteFile.WriteLine(strSplit(x))
strDate = Now
strDay = Day(strDate) : If Len(strDay) = 1 Then strDay = "0" & strDay : End If
strMonth = Month(strDate) : If Len(strMonth) = 1 Then strMonth = "0" & strMonth : End If
strYear = Year(strDate)
strHour = Hour(strDate) : If Len(strHour) = 1 Then strHour = "0" & strHour : End If
strMinute = Minute(strDate) : If Len(strMinute) = 1 Then strMinute = "0" & strMinute : End If
strSecond = Second(strDate) : If Len(strSecond) = 1 Then strSecond = "0" & strSecond : End If
strDateStamp = strDay & "-" & strMonth & "-" & strYear & "_" & strHour & ":" & strMinute & ":" & strSecond
strLineInfo = strMember & " " & reqaccess & " % <console> " & strDateStamp & " <console> " & strDateStamp & " USER % %"
objWriteFile.WriteLine(strLineInfo)
Else
objWriteFile.WriteLine(strSplit(x))
End If
Next
objWriteFile.Close 'Close file
End Function
Function DelRMember(strMember)
Dim objReadFile, objWriteFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile= objFSO.OpenTextFile(BotPath & "Users.txt", 1)
blnWriteFile = False
Do While Not objReadFile.AtEndOfStream
strLine = objReadFile.readline 'Read line
If InStr(1, strLine, " ", vbTextCompare) > 0 Then '1 or more arg
strSplit = Split(strLine, " ")
If LCase(strSplit(0)) <> LCase(strMember) Then
strFile = strFile & strLine & vbcrlf
End If
blnWriteFile = True
End If
Loop
If blnWriteFile = True Then
objReadFile.Close 'Close file
Set objWriteFile= objFSO.OpenTextFile(BotPath & "Users.txt", 2)
strSplit = Split(strFile, vbcrlf)
For x = LBound(strSplit) To UBound(strSplit)
If strSplit(x) <> "" Then
objWriteFile.WriteLine(strSplit(x))
End If
Next
DelRMember = True
End If
End Function
Function RemRankPos(strRank)
Dim objReadFile, objWriteFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile= objFSO.OpenTextFile(members_list, 1)
blnWriteFile = False
Do While Not objReadFile.AtEndOfStream
strLine = objReadFile.readline 'Read line
If InStr(1, strLine, " ", vbTextCompare) > 0 Then '1 or more arg
strSplit = Split(strLine, " ")
strRankFind = Left(strSplit(0),Len(strSplit(0))-1)
strUser = strSplit(1)
If LCase(strRankFind) = LCase(strRank) And LCase(strUser) = LCase("(OPEN)") And blnWriteFile = False Then
'Do Nothing
blnWriteFile = True
Else
strFile = strFile & strLine & vbcrlf
End If
End If
Loop
If blnWriteFile = True Then
objReadFile.Close 'Close file
Set objWriteFile= objFSO.OpenTextFile(members_list, 2)
strSplit = Split(strFile, vbcrlf)
For x = LBound(strSplit) To UBound(strSplit)
If strSplit(x) <> "" Then
objWriteFile.WriteLine(strSplit(x))
End If
Next
RemRankPos = True
End If
End Function
Function FindRank(strRank)
For x = LBound(clanranks) To UBound(clanranks)
If LCase(strRank) = LCase(clanranks(x)) Then
FindRank = clanranks(x)
Exit For
End If
Next
End Function
Function GetRankIndex(strMember)
Dim objFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile= objFSO.OpenTextFile(members_list, 1)
Do While Not objFile.AtEndOfStream
strLine = objFile.readline 'Read line
If InStr(1, strLine, " ", vbTextCompare) > 0 Then '1 or more arg
strSplit = Split(strLine," ")
If Lcase(strSplit(1)) = Lcase(strMember) Then
strRankName = Left(strSplit(0),Len(strSplit(0))-1)
Exit Do
End If
End If
Loop
objFile.Close 'Close file
For x = LBound(clanranks) To UBound(clanranks)
If LCase(strRankName) = LCase(clanranks(x)) Then
If strRankName = clanranks(x) Then
GetRankIndex = x + 1
Exit For
End If
End If
Next
End Function
Function GetRank(strMember)
Dim objFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile= objFSO.OpenTextFile(members_list, 1)
Do While Not objFile.AtEndOfStream
strLine = objFile.readline 'Read line
If InStr(1, strLine, " ", vbTextCompare) > 0 Then '1 or more arg
strSplit = Split(strLine," ")
If Lcase(strSplit(1)) = Lcase(strMember) Then
GetRank = Left(strSplit(0),Len(strSplit(0))-1)
Exit Do
End If
End If
Loop
objFile.Close 'Close file
End Function
Function GetRankNum()
For x = LBound(clanranks) To UBound(clanranks)
strMessage = strMessage & clanranks(x) & ", "
Next
End Function
Function NumMembers() 'Count words in a specific dictionary
Dim objFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile= objFSO.OpenTextFile(members_list, 1)
strOpen = ""
intOpen = 0
intNumLines = 0
Do While Not objFile.AtEndOfStream
strLine = objFile.readline 'Read line
If strLine <> "" Then
If LCase(Right(strLine, 6)) <> LCase("(OPEN)") Then
intNumLines = intNumLines + 1 'Count lines
Else
intOpen = intOpen + 1
strSplit = Split(strLine," ")
strOpen = strOpen & Left(strSplit(0),Len(strSplit(0))-1) & ", "
End If
End If
Loop
objFile.Close 'Close file
NumMembers = intNumLines 'Exit function with number of lines in file
End Function
Function RNumLines() 'Count words in a specific dictionary
Dim objFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile= objFSO.OpenTextFile(BotPath & "Users.txt", 1)
Do While Not objFile.AtEndOfStream
strLine = objFile.readline 'Read line
If strLine <> "" Then
intNumLines = intNumLines + 1 'Count lines
End If
Loop
objFile.Close 'Close file
RNumLines = intNumLines 'Exit function with number of lines in file
End Function
Function NumLines() 'Count words in a specific dictionary
Dim objFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile= objFSO.OpenTextFile(members_list, 1)
Do While Not objFile.AtEndOfStream
strLine = objFile.readline 'Read line
If strLine <> "" Then
intNumLines = intNumLines + 1 'Count lines
End If
Loop
objFile.Close 'Close file
NumLines = intNumLines 'Exit function with number of lines in file
End Function
Function ListMembers() 'Fetch a word from a specific dictionary
Dim objFile, strLine
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile= objFSO.OpenTextFile(members_list, 1)
intNumLines = 0
Do While Not objFile.AtEndOfStream
strLine = objFile.readline 'Read line
If strLine <> "" Then
intNumLines = intNumLines + 1
strMembers = strMembers & "[" & intNumLines & "] " & strLine & vbcrlf
End If
Loop
objFile.Close 'Close file
ListMembers = strMembers 'Exit function with Members
End Function
Function FormatTag()
intWilds = 0
For x = 1 To Len(clantag)
If Mid(clantag,x,1) = "*" Then
intWilds = intWilds + 1
If intWilds > 1 Then
Else
strTag = strTag & Mid(clantag,x,1)
End If
Else
strTag = strTag & Mid(clantag,x,1)
End If
Next
clantag = strTag
End Function
Function CheckTag(strUser)
CheckTag = 0
If InStr(1, clantag, "*") > 0 Then
strSplitTag = Split(clantag,"*")
intLeft = Len(strSplitTag(0))
intRight = Len(strSplitTag(1))
blnLeft = False : blnRight = False
For x = 1 To Len(strUser)
strFind = Mid(strUser,x,intLeft)
If LCase(strFind) = LCase(strSplitTag(0)) Then blnLeft = True
strFind = Mid(strUser,x,intRight)
If LCase(strFind) = LCase(strSplitTag(1)) Then blnRight = True
Next
strLeftTag = Left(strUser,Len(strSplitTag(0)))
lenLeftTag = Len(strLeftTag)
strRightTag = Right(strUser,Len(strSplitTag(1)))
lenRightTag = Len(strRightTag)
strMember = Right(strUser, Len(strUser) - lenLeftTag)
strMember = Left(strMember, Len(strMember) - lenRightTag)
If Left(clantag,1) = "*" Then
strRestricted = Mid(clantag,2,1)
If Right(strMember,1) = strRestricted Then CheckTag = 2 : Exit Function
ElseIf Right(clantag,1) = "*" Then
strRestricted = Mid(clantag,Len(clantag)-1,1)
If Left(strMember,1) = strRestricted Then CheckTag = 2 : Exit Function
Else
strRestricted1 = Right(strLeftTag,1)
strRestricted2 = Left(strRightTag,1)
If Left(strMember,1) = strRestricted1 Then CheckTag = 2 : Exit Function
If Right(strMember,1) = strRestricted2 Then CheckTag = 2 : Exit Function
End If
If strMember <> Replace(clantag, "*", "") Then
strMember = strSplitTag(0) & strMember & strSplitTag(1)
Else
CheckTag = 2 : Exit Function
End If
If LCase(strUser) = LCase(strMember) And blnLeft = True And blnRight = True Then CheckTag = 1
End If
End Function
This post has been edited by Fpa: December 10, 2020 - 09:52 PM
Sign In
Register
Help
MultiQuote