A minor problem with a script I found

Which hub software is the best? Where can I find script XXX? Discuss it here...(no, this is not for advertising your hub...)

Moderator: Moderators

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

A minor problem with a script I found

Post by Animated 0wner » 2003-04-11 20:17

I came across a script on a website for hub/slot ratio. The script works great, but it doesn't pm the user, telling them what they were kicked for. Could one of you please take a look at this portion of the script, where I believe the problem lies. If the whole script is needed, please say so.

Code: Select all

If cInt(slot) < (slotsPerHub * cInt(hub)) then
     index.SendChatMessage cStr(sBotName), cStr("Unfortunately, you have not got enough slots to connect here." & vbCrLf & "You must have at least " & slotsPerHub & " open slot(s) per hub you are connected." & vbCrLf & "Open more slots or disconnect from some hubs before coming back.")
     index.disconnect

Marvin
Posts: 147
Joined: 2003-03-06 11:56
Location: France

Post by Marvin » 2003-04-11 20:27

if index is holding the "bad" user, index.SendChatMessage should send him a message in the main chat (for his eyes only). Writing frmHub.DoEventsForMe before the index.disconnect line should solve your problem.

Use PrivateMessage instead of SenChatMessage if you want an PM instead of the main chat warning.

Marvin
Posts: 147
Joined: 2003-03-06 11:56
Location: France

Post by Marvin » 2003-04-11 20:29

PS : if this didn't work, there might be a problem with the line setting the index object, so we would need the code that handles it.

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

Post by Animated 0wner » 2003-04-11 20:53

That did it. Thank You. :D

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

Post by Animated 0wner » 2003-04-11 22:16

I had to take the script down. It has major flaws in it. It was kicking people for having too many slots open. For instance, it kicked a user for being in 3 hubs and having 10 slots open. It seems that hub/slot ratio has to match to be allowed in. It also had a max hubs portion in the script. Which I set higher than my other max hub script, so it wouldn't be used. But it was still kicking people, users well within my limit were being kicked and told that they were in too many hubs. I guess I'll have to leave the hub/slot ratio to the ops. If any of you get bored and are interested in taking a look at the script, here it is.


Code: Select all

Dim sBotName
Dim maxHubs
Dim slotsPerHub
Dim minSpeed

Sub Main()
'--------------------------------------------
 sBotName = "Slot Bot"
 maxHubs = 20
 slotsPerHub = 1
 minSpeed = 5
'--------------------------------------------
 
End sub

Sub DataArival(index, sCurData)
 on Error resume Next

'adds a description and connection to the bot
'--------------------------------------------
 If len(sCurData) > 0 then
  If left(sCurData, 8) = "$GetINFO" then
   Dim sReqdUserName
   sReqdUserName = split(sCurData, " ", 3)(1)
   If sReqdUserName = sBotName then index.SendData "$MyINFO $ALL " & sReqdUserName & " DC++ Script$ $Warp 10" & chr(8) & "$ $0$|"
   Exit sub
  End if
'--------------------------------------------

  If left(sCurData, 7) = "$MyINFO" And Not index.bOperator then
   Dim sDescrAndMore
   sDescrAndMore = left(sCurData, inStr(sCurData, "$ $") - 1)
   If right(sDescrAndMore, 1) = ">" then
    Dim tag
    Dim hub, slot, speed
    tag = right(sDescrAndMore, len(sDescrAndMore) - inStr(sDescrAndMore, " V:") - 3)
    hub = BeforeFirst(AfterFirst(tag, ",H:"), ",S:")
    speed = ""
    If inStr(tag, ",O:") > 0 then
     slot = BeforeFirst(AfterFirst(tag, ",S:"), ",O:")
    Elseif inStr(tag, ",B:") > 0 then
     slot = BeforeFirst(AfterFirst(tag, ",S:"), ",B:")
     speed = BeforeFirst(AfterFirst(tag, ",B:"), ">")
    Elseif inStr(tag, ",L:") > 0 then
     slot = BeforeFirst(AfterFirst(tag, ",S:"), ",L:")
     speed = BeforeFirst(AfterFirst(tag, ",L:"), ">")
    Else
     slot = BeforeFirst(AfterFirst(tag, ",S:"), ">")
    End if
    If speed <> "" then
     If cInt(speed) < minSpeed then
      index.PrivateMessage sBotName, cStr("Unfortunately, you are using a bandwith-limiter version of DC++ and have not met the minimum upload speed of " & minSpeed & "kb/s. You may return when you meet this requirement.")
      frmHub.DoEventsForMe
      index.disconnect
     End if
    End if
    If cInt(hub) > maxHubs then
     index.PrivateMessage cStr(sBotName), cStr("Unfortunately, you are exceeding this hub's simultaneous hub connections limit of " & maxHubs & "." & vbCrLf & "You are welcome to come back after disconnecting from some of the other hubs. Try again in 15min.")
     frmHub.DoEventsForMe
     index.kick
    End If
    If cInt(slot) < (slotsPerHub * cInt(hub)) then
     index.PrivateMessage cStr(sBotName), cStr("Unfortunately, you do not have enough slots open to connect to this hub." & vbCrLf & "You must have at least " & slotsPerHub & " open slot per hub you are connected." & vbCrLf & "Open more slots or disconnect from some hubs before coming back.")
     frmHub.DoEventsForMe
     index.disconnect
    End if
   End if
  End if
 End if
End sub

Function BeforeFirst(sIn, sFirst)
 BeforeFirst = left(sIn, inStr(1, sIn, sFirst) - 1)
End Function

Function AfterFirst(sIn, sFirst)
 AfterFirst = right(sIn, len(sIn) - inStr(1, sIn, sFirst) - (len(sFirst) - 1))
End Function

TasMan
Posts: 196
Joined: 2003-01-03 13:31
Location: Canada

Post by TasMan » 2003-04-11 22:44

Yuck :)

Hmmm....well if you'd like me to write one up, give a shout! Course, I DO have a nice one built-into Cerberus (my multi-function script), so it basically would be "ripped" from it.

I'm too lazy to write one if you don't care....
Shadows Direct Connect Hub - Taking away the light from NMDCH, leaving only shadows.....

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

Post by Animated 0wner » 2003-04-11 23:03

I'd love for you to write me one! I didn't want to ask in my previous post because I didn't want to seem like the noob that came in and started demanding stuff. Figured that one script you wrote for me was all I could get away with asking for without seeming pushy. But if you don't mind, I'd be very much grateful!

Marvin
Posts: 147
Joined: 2003-03-06 11:56
Location: France

Post by Marvin » 2003-04-11 23:05

Animated 0wner wrote:I had to take the script down. It has major flaws in it.

Code: Select all

    hub = BeforeFirst(AfterFirst(tag, ",H:"), ",S:")

This script doesn't know about the new hub tag (H:x/y/z), that might explain why it doesn't work.

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

Sorry for the extra post, I don't see an edit option.

Post by Animated 0wner » 2003-04-11 23:08

Mis-read, sorry. If you don't mind giving me the hub/slot portion of your script, I would be very grateful. :oops:

TasMan
Posts: 196
Joined: 2003-01-03 13:31
Location: Canada

Post by TasMan » 2003-04-11 23:23

I'll leave you to test it....I did a quick test that was all.

Don't worry about over stepping yourself. I like to make scripts (I have no life)

Code: Select all

Const RATIO = 25                      'How many slots per hub
Const MAXHUBS = 25               'Max number of hubs a user can be connected to
Const MINBANDWIDTH = 2      'Minimum amount of bandwidth (in kb/s) if using limiter
Const BOTNAME = "DCpp"       'Name of the bot used in PMs

Sub DataArival(curUser, sCurData)
  If LeftB(sCurData, 14) = "$MyINFO" Then
    Dim iPos
 
    sCurData = MidB(sCurData, InStrB(1, sCurData, " ") + 2)
    sCurData = MidB(sCurData, InStrB(1, sCurData, " ") + 2)
    iPos = InStrB(1, sCurData, " ")
    sCurData = MidB(sCurData, iPos + 2, InStrB(iPos, sCurData, "$") - iPos - 2)

    iPos = InStrRev(sCurData, "<++")

    If iPos Then
      '<++ V:*,M:*,H:*,S:*>

      sCurData = Mid(sCurData, iPos + 4, Len(sCurData) - iPos - 4)

      Dim aTag, iHubs, iSlots

      aTag = Split(sCurData, ",")
      iHubs = MidB(aTag(2), 5)
      iSlots = MidB(aTag(3), 5)

      If InStrB(1, iHubs, "/") Then
        Dim aTmp

        aTmp = Split(iHubs, "/")
        iHubs = CInt(aTmp(0)) + CInt(aTmp(1))
      End If

      If CInt(iHubs) > CInt(MAXHUBS) Then
        curUser.PrivateMessage CStr(BOTNAME), "You are connected to too many hubs. Good bye!"
        frmHub.DoEventsForMe
        curUser.Disconnect
       
        Exit Sub
      End If
     
      If (CInt(iSlots) / CInt(iHubs)) < CInt(RATIO) Then
        curUser.PrivateMessage CStr(BOTNAME), "You do not have enough slots open for the number of hubs you are connected to. Good bye!"
        frmHub.DoEventsForMe
        curUser.Disconnect
       
        Exit Sub
      End If

      Dim ub

      ub = UBound(aTag)

      If ub > 3 Then
        Dim i
 
        For i = 4 To ub
          Select Case AscW(aTag(i))
            Case 76, 66 'L, B
              If CInt(MidB(aTag(i), 5)) < CInt(MINBANDWIDTH) Then
                curUser.PrivateMessage CStr(BOTNAME), "You do not have enough bandwidth alloted for DC++. Good bye!"
                frmHub.DoEventsForMe
                curUser.Disconnect
               
                Exit Sub
              End If
          End Select
        Next
      End If
    End If
  End If
End Sub
Shadows Direct Connect Hub - Taking away the light from NMDCH, leaving only shadows.....

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

Thx!

Post by Animated 0wner » 2003-04-12 00:15

If you don't mind, would you see if you could modify this script. It's the watchbot script, a pretty common script that watches for users and files. I was wondering if it could possibly be edited so that ops can watch for ips.

Code: Select all

im sBotName
Dim lInterval, lCountDown
Dim oFW, oUW
Dim sConfirmMsg
Dim sFileMsg, sUserMsg, sAddUserMsg, sAddFileMsg
Dim sResetMsg, sUserOnline, sWelcomeMsg

Sub Main()
  Set oFW = CreateObject("Scripting.Dictionary")
  Set oUW = CreateObject("Scripting.Dictionary")

'Set these basic parameters.
  sBotName = "WatchBot"  ' <- name of the bot
  lInterval = 6          ' <- how often to search for files (* 10 seconds)

'The messages sent at different actions.
  sFileMsg = "$usr has files matching '$file'."
  sUserMsg = "$name logged on."
  sAddUserMsg = "Waiting for $name to log on..."
  sAddFileMsg = "Started searching for '$file'..."
  sResetMsg = "Your watch list was cleared."
  sUserOnline = "That user is already online!"
  sWelcomeMsg = "Hi there!  I will watch for users or files which are " & _
   "not here, and then tell you when they come online. Please type the " & _
   "commands in mainchat:" & vcBRLF & vbCRLF & _
   "  watchuser <user_name>" & vbTab & "- adds a user to my list" & vbCRLF & _
   "  watchfile <file_name>" & vbTab & "- adds a file to my list" & vbCRLF & _
   "  watchreset" & vbTab & vbTab & "- clears the list" & vbCRLF
 
  lCountDown = lInterval
  tmrScriptTimer.Interval = 10000
  tmrScriptTimer.Enabled = True
End Sub

Sub TimerMethod()
  Dim sFind

  For Each sFind In oFW.Keys
    colUsers.SendToAll "$Search Hub:" & CStr(sBotName) & " F?F?0?0?" & sFind
    frmHub.DoEventsForMe
  Next
End Sub

Sub DataArival(curUser, sCurData)
  Dim sTheText, lPos
  Dim sUsrName
  Dim sFind, sTmpMsg

  If Left(sCurdata, 1) = "<" Or _
     Left(sCurData, 5 + Len(sBotName)) = "$To: " & sBotName Then

    lPos = InStr(1, sCurData, ">")
    sTheText = Mid(sCurData, lPos + 2)

    sUsrName = CStr(curUser.sName)

    If Left(sTheText, 9) = "watchuser" Then
      sFind = Mid(sTheText, 11)
      If Not colUsers.Online(CStr(sFind)) Then
        If oUW.Exists(sFind) Then
          oUW(sFind) = oUW(sFind) & ":" & sUsrName
        Else
          oUW(sFind) = sUsrName
        End If
        curUser.PrivateMessage CStr(sBotName), _
          Replace(sAddUserMsg, "$name", sFind)
      Else
        curUser.PrivateMessage CStr(sBotName), CStr(sUserOnline)
      End If

    ElseIf Left(sTheText, 9) = "watchfile" Then
      sFind = Mid(sTheText, 11)
      If oFW.Exists(sFind) Then
        oFW(sFind) = oFW(sFind) & ":" & sUsrName
      Else
        oFW(sFind) = sUsrName
      End If
      curUser.PrivateMessage CStr(sBotName), _
        Replace(sAddFileMsg, "$file", sFind)
      frmHub.DoEventsForMe
      Call TimerMethod

    ElseIf sTheText = "watchreset" Then
      For Each sFind In oUW.Keys
        oUW(sFind) = Replace(oUW(sFind), ":" & sUsrName, "")
        If oUW(sFind) = sUsrName Then oUW.Remove(sFind)
      Next
      For Each sFind In oFW.Keys
        oFW(sFind) = Replace(oFW(sFind), ":" & sUsrName, "")
        If oFW(sFind) = sUsrName Then oFW.Remove(sFind)
      Next
      curUser.PrivateMessage CStr(sBotName), CStr(sResetMsg)

    ElseIf sTheText = "watchdump" Then
      For Each sFind In oUW.Keys
        curUser.PrivateMessage CStr(sBotName), _
          sFind & " (" & oUW(sFind) & ")"
        frmHub.DoEventsForMe
      Next
      For Each sFind In oFW.Keys
        curUser.PrivateMessage CStr(sBotName), _
          sFind & " (" & oFW(sFind) & ")"
        frmHub.DoEventsForMe
      Next

    End If

  ElseIf Left(sCurData, 3) = "$SR" Then  'incoming search result
    If Right(sCurData, Len(sBotName)) = CStr(sBotName) Then
      lPos = InStr(5, sCurData, " ")
      sWhatUser = Mid(sCurData, 5, lPos - 5)
      For Each sFind In oFW.Keys
        If InStr(1, LCase(sCurData), LCase(sFind)) > 0 Then
          sTmpMsg = Replace(sFileMsg, "$file", sFind)
          sTmpMsg = Replace(sTmpMsg, "$usr", sWhatUser)
          Call NotifyUsers(oFW(sFind), sTmpMsg)
          Call oFW.Remove(sFind)
        End If
      Next
    End If

  End If

End Sub

Sub NewUserConnected(curUser)
  Dim sUsrName

  sUsrName = CStr(curUser.sName)
  If oUW.Exists(sUsrName) Then
    Call NotifyUsers(oUW(sUsrName), Replace(sUserMsg, "$name", sUsrName))
    Call oUW.Remove(sUsrName)
  End If
  curUser.PrivateMessage CStr(sBotName), CStr(sWelcomeMsg)
End Sub

Sub OpConnected(curUser)
  Call NewUserConnected(curUser)
End Sub

Sub NotifyUsers(sUserList, sMsg)
  Dim aNicks, sNick
  Dim tmpUser

  aNicks = Split(sUserList, ":")
  For Each sNick In aNicks
    If colUsers.Online(CStr(sNick)) Then
      Set tmpUser = colUsers.ItemByName(CStr(sNick))
      tmpUser.PrivateMessage CStr(sBotName), CStr(sMsg)
      frmHub.DoEventsForMe
    End If
  Next
End Sub

Sub tmrScriptTimer_Timer()
  lCountDown = lCountDown - 1
  If lCountDown = 0 Then
    Call TimerMethod
    lCountDown = lInterval
  End If
End Sub

TasMan
Posts: 196
Joined: 2003-01-03 13:31
Location: Canada

Post by TasMan » 2003-04-12 00:53

Once again....completely untested! :)

It should though have the "watchip" command for ops...(note I did none of the optimizations that I could have done - just added watchip)

Code: Select all

Dim sBotName 
Dim lInterval, lCountDown
Dim oFW, oUW, oIW
Dim sConfirmMsg
Dim sFileMsg, sUserMsg, sAddUserMsg, sAddFileMsg
Dim sResetMsg, sUserOnline, sWelcomeMsg

Sub Main()
  Set oFW = CreateObject("Scripting.Dictionary")
  Set oUW = CreateObject("Scripting.Dictionary")
  Set oIW = CreateObject("Scripting.Dictionary")

'Set these basic parameters.
  sBotName = "WatchBot"  ' <- name of the bot
  lInterval = 6          ' <- how often to search for files (* 10 seconds)

'The messages sent at different actions.
  sFileMsg = "$usr has files matching '$file'."
  sUserMsg = "$name logged on."
  sAddUserMsg = "Waiting for $name to log on..."
  sAddFileMsg = "Started searching for '$file'..."
  sResetMsg = "Your watch list was cleared."
  sUserOnline = "That user is already online!"
  sWelcomeMsg = "Hi there!  I will watch for users or files which are " & _
   "not here, and then tell you when they come online. Please type the " & _
   "commands in mainchat:" & vcBRLF & vbCRLF & _
   "  watchuser <user_name>" & vbTab & "- adds a user to my list" & vbCRLF & _
   "  watchfile <file_name>" & vbTab & "- adds a file to my list" & vbCRLF & _
   "  watchreset" & vbTab & vbTab & "- clears the list" & vbCRLF
 
  lCountDown = lInterval
  tmrScriptTimer.Interval = 10000
  tmrScriptTimer.Enabled = True
End Sub

Sub TimerMethod()
  Dim sFind

  For Each sFind In oFW.Keys
    colUsers.SendToAll "$Search Hub:" & CStr(sBotName) & " F?F?0?0?" & sFind
    frmHub.DoEventsForMe
  Next
End Sub

Sub DataArival(curUser, sCurData)
  Dim sTheText, lPos
  Dim sUsrName
  Dim sFind, sTmpMsg

  If Left(sCurdata, 1) = "<" Or _
     Left(sCurData, 5 + Len(sBotName)) = "$To: " & sBotName Then

    lPos = InStr(1, sCurData, ">")
    sTheText = Mid(sCurData, lPos + 2)

    sUsrName = CStr(curUser.sName)

    If Left(sTheText, 9) = "watchuser" Then
      sFind = Mid(sTheText, 11)
      If Not colUsers.Online(CStr(sFind)) Then
        If oUW.Exists(sFind) Then
          oUW(sFind) = oUW(sFind) & ":" & sUsrName
        Else
          oUW(sFind) = sUsrName
        End If
        curUser.PrivateMessage CStr(sBotName), _
          Replace(sAddUserMsg, "$name", sFind)
      Else
        curUser.PrivateMessage CStr(sBotName), CStr(sUserOnline)
      End If

    ElseIf Left(sTheText, 9) = "watchfile" Then
      sFind = Mid(sTheText, 11)
      If oFW.Exists(sFind) Then
        oFW(sFind) = oFW(sFind) & ":" & sUsrName
      Else
        oFW(sFind) = sUsrName
      End If
      curUser.PrivateMessage CStr(sBotName), _
        Replace(sAddFileMsg, "$file", sFind)
      frmHub.DoEventsForMe
      Call TimerMethod

    ElseIf sTheText = "watchreset" Then
      For Each sFind In oUW.Keys
        oUW(sFind) = Replace(oUW(sFind), ":" & sUsrName, "")
        If oUW(sFind) = sUsrName Then oUW.Remove(sFind)
      Next
      For Each sFind In oFW.Keys
        oFW(sFind) = Replace(oFW(sFind), ":" & sUsrName, "")
        If oFW(sFind) = sUsrName Then oFW.Remove(sFind)
      Next
      curUser.PrivateMessage CStr(sBotName), CStr(sResetMsg)

    ElseIf sTheText = "watchdump" Then
      For Each sFind In oUW.Keys
        curUser.PrivateMessage CStr(sBotName), _
          sFind & " (" & oUW(sFind) & ")"
        frmHub.DoEventsForMe
      Next
      For Each sFind In oFW.Keys
        curUser.PrivateMessage CStr(sBotName), _
          sFind & " (" & oFW(sFind) & ")"
        frmHub.DoEventsForMe
      Next

    ElseIf Left(sTheText, 7) = "watchip" Then
      If curUser.bOperator Then
        Dim oUser

        sTheText = Mid(sTheText, InStr(1, sTheText, " ") + 1)

        For Each oUser In colUsers
          If oUser.IP = CStr(sTheText) Then
            curUser.PrivateMessage CStr(sBotName), CStr(sTheText) & " is already connected as " & curUser.sName
            Exit Sub
          End If
        Next

        If oIW.Exists(sTheText) Then oIW(sTheText) = oIW(sTheText) & ":" & CStr(sTheText)  Else oIW.Add CStr(sTheText), curUser.sName

        curUser.PrivateMessage CStr(sBotName), "Watching for the ip : " & CStr(sTheText)
      End If
    End If

  ElseIf Left(sCurData, 3) = "$SR" Then  'incoming search result
    If Right(sCurData, Len(sBotName)) = CStr(sBotName) Then
      lPos = InStr(5, sCurData, " ")
      sWhatUser = Mid(sCurData, 5, lPos - 5)
      For Each sFind In oFW.Keys
        If InStr(1, LCase(sCurData), LCase(sFind)) > 0 Then
          sTmpMsg = Replace(sFileMsg, "$file", sFind)
          sTmpMsg = Replace(sTmpMsg, "$usr", sWhatUser)
          Call NotifyUsers(oFW(sFind), sTmpMsg)
          Call oFW.Remove(sFind)
        End If
      Next
    End If

  End If

End Sub

Sub NewUserConnected(curUser)
  Dim sUsrName

  sUsrName = CStr(curUser.sName)
  If oUW.Exists(sUsrName) Then
    Call NotifyUsers(oUW(sUsrName), Replace(sUserMsg, "$name", sUsrName))
    Call oUW.Remove(sUsrName)
  End If

  sUsrName = curUser.IP

  If oIW.Exists(sUsrName) Then
    Call NotifyUsers(oUW(sUsrName), "IP : " & CStr(sUsrName) & " has connected as " & curUser.sName)
    Call oIW.Remove(sUsrName)
  End If

  If curUser.bOperator Then curUser.PrivateMessage CStr(sBotName), CStr(sWelcomeMessage) & vbCrLf & "  watchip <ip>" & vbTab & vbTab & " - watches for an ip to connect" & vbCrLf _
  Else curUser.PrivateMessage CStr(sBotName), CStr(sWelcomeMsg)
End Sub

Sub OpConnected(curUser)
  Call NewUserConnected(curUser)
End Sub

Sub NotifyUsers(sUserList, sMsg)
  Dim aNicks, sNick
  Dim tmpUser

  aNicks = Split(sUserList, ":")
  For Each sNick In aNicks
    If colUsers.Online(CStr(sNick)) Then
      Set tmpUser = colUsers.ItemByName(CStr(sNick))
      tmpUser.PrivateMessage CStr(sBotName), CStr(sMsg)
      frmHub.DoEventsForMe
    End If
  Next
End Sub

Sub tmrScriptTimer_Timer()
  lCountDown = lCountDown - 1
  If lCountDown = 0 Then
    Call TimerMethod
    lCountDown = lInterval
  End If
End Sub
Shadows Direct Connect Hub - Taking away the light from NMDCH, leaving only shadows.....

Animated 0wner
Posts: 36
Joined: 2003-04-09 09:04

Post by Animated 0wner » 2003-04-12 06:41

Thank You! I appreciate all the script work you've done for me. :D

Who is online

Users browsing this forum: Google [Bot] and 0 guests