Hi. in my hub is a rule.. min 2 slots... but there are some ass*****s who open just 1 slot...
i need a script wich i can use in the main chat (as an OP) wich shows me who has 1 slot open...
For example : +show min slots (and then the users with only 1 slot appear to me)
i thought that generalbot would do the trick...
Or the user enters with 2 slots and then change it back to 1 i don't know, but i can't keep checking my users settings if they live by the rules....
hope someone understands what i'm trying to say....
tnx, René
Slots
Moderator: Moderators
-
ButterflySoul
- Posts: 210
- Joined: 2003-01-23 22:24
- Location: Nevada
Code: Select all
Option Explicit
' ---------------------------
Sub DataArrival(curUser, sData)
' ---------------------------
If AscW(sData)=36 Then
If LeftB(sData, 8) = "$SR " Then InfoAnalysis curUser, MidB(sData, LenB(curUser.sName)+10)
End If
End Sub
' ---------------------------
Sub SRAnalysis(objUser, sRawData)
' ---------------------------
Dim aTmp
aTmp=Split(sRawData, Chr(5))
If Mid(aTmp(1), InStrRev(aTmp(1), "/")+1) < 2 Then objUser.SendChatMessage "Hub-Security", "You need at least 2 slots opened. Thx": frmHub.DoEventsForMe: objUser.Kick()
End SubShould do the trick if you want them automatically kicked. If you really want a list to be displayed, you'll have to use something a bit longer, but still rather simple :
Code: Select all
Option Explicit
Dim dSlots, iGlobCount
' ---------------------------
Sub Main
' ---------------------------
Set dSlots = CreateObject("Scripting.Dictionary")
tmrScriptTimer.Interval = 64000
tmrScriptTimer = True
End Sub
' ---------------------------
Sub DataArrival(curUser, sData)
' ---------------------------
Select Case AscW(sData)
Case 36: If LeftB(sData, 8) = "$SR " Then SRAnalysis curUser, MidB(sData, LenB(curUser.sName)+10)
Case 60: If curUser.bOperator Then Call ChatArrival(curUser, sData)
End Select
End Sub
' ---------------------------
Sub ChatArrival(objUser, sRawChat)
' ---------------------------
Dim aTemp
aTemp=Split(sRawChat, "> ")
If LCase(LeftB(aTemp(1),12))="+slots" Then ChatAnalysis objUser, LCase(aTemp(1))
End Sub
' ---------------------------
Sub ChatAnalysis(objUser, sRawParam)
' ---------------------------
Dim aParam, aTmp, x, sMsg
aParam=Split(sRawParam)," ")
If UBound(aParam)<1 Then HelpUser(objUser): Exit Sub
Select Case aParam(1)
Case "list"
If dSlots.Count>0 Then DClean
If dSlots.Count=0 Then objUser.SendChatMessage "Hub-Security", "There are currently no users with less than 2 slots opened": Exit Sub
aTmp = dSlots.Key
For x = 0 to dSlots.Count-1
sMsg=sMsg &aTmp(x) &vbCrLf
If x Mod 75 = 0 Then frmHub.DoEventsForMe
Next
objUser.SendChatMessage "Hub-Security", "Users currently having less than 2 slots opened: " &vbCrLf &sMsg
Case "clean"
If UBound(aParam)<2 Then HelpUser(objUser): Exit Sub
If dSlots.Count>0 Then DClean
If dSlots.Count=0 Then objUser.SendChatMessage "Hub-Security", "There are currently no users with less than 2 slots opened": Exit Sub
aTmp = dSlots.Key
Select Case AscW(aParam(2))
Case 100
sMsg="disconnected:" &vbCrLf
For x = 0 to dSlots.Count-1
If colUsers.Online(cstr(aTmp(x))) Then
With colUsers.ItemByName(cstr(aTmp(x))
.PrivateMessage "Hub-Security", "You are being disconnected because you need at least 2 slots opened"
frmHub.DoEventsForMe
.Disconnect()
End With
sMsg=sMsg &aTmp(x) &vbCrLf
End If
dSlots.Remove(aTmp(x))
Next
Case 107
sMsg="kicked:" &vbCrLf
For x = 0 to dSlots.Count-1
If colUsers.Online(cstr(aTmp(x))) Then
With colUsers.ItemByName(cstr(aTmp(x))
.PrivateMessage "Hub-Security", "You are being kicked because you need at least 2 slots opened"
frmHub.DoEventsForMe
.Kick()
End With
sMsg=sMsg &aTmp(x) &vbCrLf
End If
dSlots.Remove(aTmp(x))
Next
Case Else: HelpUser(objUser): Exit Sub
End Select
objUser.SendChatMessage "Hub-Security", "The following users have been " &sMsg
Case Else: HelpUser(objUser): Exit Sub
End Select
End Sub
' ---------------------------
Sub SRAnalysis(objUser, sRawData)
' ---------------------------
Dim aTmp
aTmp=Split(sRawData, Chr(5))
If Mid(aTmp(1), InStrRev(aTmp(1), "/")+1) < 2 Then dSlots.Item(objUser.sName) = 1
End Sub
' --------------------------------------------------
Sub tmrScriptTimer_Timer()
' --------------------------------------------------
iGlobCount=iGlobCount+1
If iGlobCount=5 Then
If dSlots.Count>0 Then DClean
iGlobCount=0
End If
' ---------------------------
'Helpers
' ---------------------------
Sub DClean
Dim x, aClean
aClean = dSlots.Keys
For x = 0 to dSlots.Count-1
If Not colUsers.Online(cstr(aClean(x))) Then dSlots.Remove(aClean(x))
If x Mod 75 = 0 Then frmHub.DoEventsForMe
Next
End Sub
Sub HelpUser(objUser)
objUser.SendChatMessage "Hub-Security", "Valid +slots commands :" &vbCrLf_
&"+slots list : Lists all users with less than 2 slots opened" &vbCrLf_
&"+slots clean k : Kick all users with less than 2 slots opened and display their name when finished" &vbCrLf_
&"+slots clean d : Disconnect all users with less than 2 slots opened and display their name when finished"
End SubI don't have a NeoModus hub anymore, so they're completely untested, but they should work nonetheless. Typing +slots by itself in the main chat (or any wrong command starting with +slots) will trigger a short help message.
-
ButterflySoul
- Posts: 210
- Joined: 2003-01-23 22:24
- Location: Nevada
By the way, those 2 scripts don't detect people with less than 1 slot before they send results to regular passive searches from other users.
If you want to force each client to always send you a few search results each time they connect or change their slot settings, just let me know and I can add a few extra lines to whichever of those 2 scripts you picked. The versions above don't do it because it's a very bandwidth-hungry feature, but it's real easy to add it.
If you want to force each client to always send you a few search results each time they connect or change their slot settings, just let me know and I can add a few extra lines to whichever of those 2 scripts you picked. The versions above don't do it because it's a very bandwidth-hungry feature, but it's real easy to add it.
-
Cureboy
- Posts: 7
- Joined: 2003-06-15 11:44
- Location: Netherlands
thanks for the help
thank you all..
i go study this messages....and pm's
René
i go study this messages....and pm's
René
Up to the sky
down to earth
Somewhere in the middle
that is me
down to earth
Somewhere in the middle
that is me
Who is online
Users browsing this forum: Google [Bot] and 0 guests