Вернуться   D3Scene.Ru Софт портал игр | Хаки | Проги | Статьи > Основные игры > WarCraft 3 > WarCraft 3 Боты
Присоединяйся к нам

WarCraft 3 Боты Вопросы и обсуждения ботов.



Закрытая тема
 
Опции темы Опции просмотра
Старый 12.05.2008, 19:38   #1
Гость_за_инактив
 
Аватар для Inferno
 
Регистрация: 24.09.2008
Сообщений: 46
Репутация: 11
Отправить сообщение для Inferno с помощью MSN
Автор По умолчанию

Как впихнуть скрипт в бота.


У мну есть скрипт, Clan Rank Script v2.76. Но я неипу как его вбота впихнуть, мб кто подскажет?*sos* буду оч благодарен. Ах да, забыл сказать у мну в боте уже дофига кулл скриптов, и замещать те скрипты на этот я не хочу, поэтому хочу узнать как бы их совместить а?(
  Наверх
Старый 12.05.2008, 19:49   #2
Кодер-Дизайнер

 
Аватар для AlfaDogg
 
Регистрация: 24.02.2008
Сообщений: 208
Репутация: 164
По умолчанию

скрипт сюды
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 12.05.2008, 20:19   #3
Гость_за_инактив
 
Аватар для Inferno
 
Регистрация: 24.09.2008
Сообщений: 46
Репутация: 11
Отправить сообщение для Inferno с помощью MSN
Автор По умолчанию

[Ссылки скрыты от гостей.]

ссыль все скрипты на том сайте кроме этого у меня в боте есть и даже ещё парчока а вот этого нету=( Clan Rank Script v2.76
  Наверх
Старый 12.05.2008, 20:25   #4
Кодер-Дизайнер

 
Аватар для AlfaDogg
 
Регистрация: 24.02.2008
Сообщений: 208
Репутация: 164
По умолчанию

в самый конец script.txt пихнуть не пробовал?
Код:
'// Clan Rank Script v2.76
'// Â  by Swent
'// Â  Â  Last Modified by Swent 10:32 PM 12/23/2005

Public crsConn         '// hold database connection
Public crsLastAct      '// hold data from bot's last action
Public crsRanks() Â  Â  Â '// hold rank names specified in program settings
Public crsQueue() Â  Â  Â '// hold multi-message data until its sent to bot's queue
Public crsGreetEnabled '// hold bool containing greet status
Public crsDatabasePath '// hold database file path

'//**************************//
'// Â  PROGRAM SETTINGS Â  Â  Â  // Â  
'//**************************//

'// [ Clan Name ]
Const crs_clan_name = "Clan YourClanName" '// Clan Name

'// [ Access Requirements ]
Const crsgreet_cmd_access = 100 '// Default: 100
Const setrank_cmd_access  = 100 '// Default: 100
Const promote_cmd_access  = 100 '// Default: 100
Const demote_cmd_access   = 100 '// Default: 100
Const remove_cmd_access   = 100 '// Default: 100
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

'// [ Command Names ]
Const crsgreet_command = "crsgreet" '// Used to enable/disable greet by rank.
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 retieve 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 cmdlist_command  = "cmdlist"  '// Used to retrieve a list of all commands useable by user.
Const meminfo_command  = "meminfo"  '// Used to retrieve detailed member data.

'// [ 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 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 cmdlist_cmd_enabled    = True
Const meminfo_cmd_enabled    = True

'// [ Profile Update ]
Const profile_update_enabled = True '// Updates bot's profile after each promotion/demotion.

'// [ Automatic Access ]
'// Assigns access to users automatically based on their rank after promotions/demotions.
'// Â  Higher ranks (top third) recieve 100 acesss
'// Â  Middle ranks (middle third) recieve 60 access
'// Â  Lower ranks (bottom third) receive 20 access
Const auto_access_enabled = True '// True to enable, False to disable

'// [ Rank Greets ]
'// <<< RANK GREET MESSAGES CAN BE ENABLED OR DISABLED HERE!!! >>>
'// Â  NOTE: Rank greets can also be enabled/disabled *temporarily* by using the .crsgreet on/off command.
crsGreetEnabled = True '// Greets users by their rank

'// [ Anti-Flood Delay ]
Const crs_anti_flood = 8 '// For multi-message command responses, delay each message by x seconds to prevent flooding.

Sub Event_Load()

'// [ Rank Settings ]
numRanks = 16 '// Number of ranks <- CHANGE THIS AFTER ADDING OR REMOVING RANKS!
ReDim crsRanks(numRanks + 1): crsRanks(0) = "Unranked" '// Do not modify this line
crsRanks(1) = "Leader"
crsRanks(2) = "Commander"
crsRanks(3) = "Lieutenant General"
crsRanks(4) = "Major General"
crsRanks(5) = "Brigadier General"
crsRanks(6) = "Colonel"
crsRanks(7) = "Major"
crsRanks(8) = "Captain"
crsRanks(9) = "Lieutenant"
crsRanks(10) = "Sergeant Major"
crsRanks(11) = "First Sergeant"
crsRanks(12) = "Staff Sergeant"
crsRanks(13) = "Sergeant"
crsRanks(14) = "Corporal"
crsRanks(15) = "Private First Class"
crsRanks(16) = "Private"
'// Feel free to modify/remove some of the ranks above, or add additional ranks below.
'// Example: crsRanks(17) = "Newbie"
'// ** IMPORTANT: All modifications to number of ranks or rank names should be made BEFORE you start using the script!
'// ** IMPORTANT: Don't forget to change the numRanks variable above after you add or remove ranks!

'//****************************//
'// Â  DO NOT EDIT BELOW HERE Â  //
'// Â  DO NOT EDIT BELOW HERE Â  //
'// Â  DO NOT EDIT BELOW HERE Â  //
'// Â  DO NOT EDIT BELOW HERE Â  //
'//****************************//

'// Start timer (timer is used to log members' online time and to record last active time)
scTimer.Interval = 60000
scTimer.Enabled = True

'// Database exists?
crsDatabasePath = BotPath() & "MemberData.mdb"
Set crsFSO = CreateObject("Scripting.FileSystemObject")
If Not crsFSO.FileExists(crsDatabasePath) Then
 crs_create_database '// Create the database
Else
 crs_connect '// Connect to database
End If
End Sub


Sub Event_UserTalk(Username, Flags, Message, Ping)

GetDBEntry Username, myAccess, myFlags

'// User is executing a command?
If Len(Message) < 2 Then Exit Sub
If Username <> BotVars.Username Then
 If Left(Message, 1) <> BotVars.Trigger Then Exit Sub
Else
 If Left(Message, 1) <> "/" Then Exit Sub
End If

'// Get the command and arguments
If Instr(Trim(Message), " ") = 0 Then Message = Message & " "
cmd = Split(Mid(Trim(Message), 2), " ")

'// Call the proper sub
Select Case LCase(cmd(0))
 Case crsgreet_command: crsgreet_cmd cmd, Username, myAccess
 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
End Select
End Sub


Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)

'// Greets enabled?
If crsGreetEnabled = False Then Exit Sub

'// Get user's current rank
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)
Else
 rank = 0
End If

'// If user is a member, announce user's name and rank to channel.
PadQueue() '// delay greet display
If rank > 0 Then
 AddQ crsRanks(rank) & " (" & rank & ") " & Username & " has entered."
Else
 'AddQ "Hello, you're not a member!" '// remove the ' before this line to greet non-members
End If
End Sub


Sub Event_WhisperFromUser(Username, Flags, Message)

Event_UserTalk Username, Flags, Message, 0
End Sub


Sub Event_PressedEnter(Text)

If Len(Text) < 2 Then Exit Sub
If Instr(Text, " ") = 0 Then Text = Text & " "
cmd = Split(Mid(Trim(Text), 2), " ")
Select Case LCase(cmd(0))
 Case crsgreet_command, setrank_command, promote_command, demote_command, remove_command, rank_command, rankinfo_command, members_command, ranks_command, findrank_command, cmdlist_command, meminfo_command
   If Left(Text, 1) = "/" Then VetoThisMessage
End Select
Event_UserTalk BotVars.Username, "", Text, 1
End Sub


Sub scTimer_Timer()

arrMembers = Split(GetAllMembers(), ", ")
For i = 0 to UBound(arrMembers)
 memberName = Replace(Mid(arrMembers(i), Instr(arrMembers(i), ") ") + 2), " (online)", "")

 If MonitoredUserIsOnline(LCase(memberName)) = 1 Then

   '// Make sure user isn't idle
   If GetInternalDataByUsername(memberName, 7) < 600 Then

     '// Get user's current time logged
     set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & LCase(memberName) & "'")
     If rs.Fields(0) <> 0 Then
       set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & LCase(memberName) & "'")
       curLogged = CDbl(rs.Fields(8))
     Else
       curLogged = 0
     End If

     '// Update user's time log
     newLogged = FormatNumber((curLogged * 60 + 1) / 60, 3)
     crsConn.Execute("UPDATE `members` SET `time_logged` = '" & newLogged & "' WHERE `name`='" & LCase(memberName) & "'")

     '// Update last active date/time
     crsConn.Execute("UPDATE `members` SET `last_active` = '" & Now & "' WHERE `name`='" & LCase(memberName) & "'")
   End If
 End If
Next
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 '// Has enough access?
End If

If LCase(cmd(1)) = "on" Then
 crsGreetEnabled = True
 crsAddQ "Clan Rank Script: Rank Greets have been enabled.", Username, True
ElseIf LCase(cmd(1)) = "off" Then
 crsGreetEnabled = False
 crsAddQ "Clan Rank Script: Rank Greets have been disabled.", Username, True
End If
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 7, Username: Exit Sub '// Username arguement exists?

'// 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
   newRank = CInt(cmd(2))
 Case remove_command
   newRank = UBound(crsRanks)
End Select

'// Get reason
If UBound(cmd) > 1 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 = "Reason: " & Left(rsn, Len(rsn) - 1) & ". "
   rsn = Replace(rsn, "'", "`") '// replace single quotes to avoid errors
 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
   crsAddQ "To make yourself a " & crsRanks(1) & ", inside your bot type /promote <YourUsername> " & UBound(crsRanks) - 1, Username, True
 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 9, Username: Exit Sub
End If

'// Assign appropriate access to user
'// Â  Highest ranks (top third) get 100 access
'// Â  Â  Middle ranks (middle third) get 60 access
'// Â  Â  Â  Lowest ranks (bottom third) get access 20 access
If auto_access_enabled Then
 third = Int(UBound(crsRanks) / 3)
 If newRank > 0 And newRank < (third + 1) Then
   newAccess = 100
 ElseIf newRank < (third * 2) Then
   newAccess = 60
 ElseIf newRank < UBound(crsRanks) Then
   newAccess = 20
 ElseIf newRank = UBound(crsRanks) Then
   newAccess = 0
 End If
 Command BotVars.Username, "/set " & LCase(cmd(1)) & " " & newAccess, True
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)) & "'")
 crsAddQ "Kicked " & cmd(1) & " out of " & crs_clan_name & ".", Username, False
 Command BotVars.Username, "/unmonitor " & cmd(1), True
 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
 crsAddQ pType & " " & cmd(1) & " from " & crsRanks(curRank) & " (" & curRank & ") to " & crsRanks(newRank) & " (" & newRank & ").", Username, False

'// 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')")
 crsAddQ "Added " & cmd(1) & " to " & crs_clan_name & " with rank " & crsRanks(newRank) & " (" & newRank & ").", Username, False
 Command BotVars.Username, "/monitor " & cmd(1), True
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 " & crs_clan_name & " by " & Username & " on " & Replace(rs.Fields(5)," "," at ",1,1) & ". "
 End If

 crsLastAct = Trim(capUsernames(crsLastAct))
 SetBotProfile "RankB0t", 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()
If memberCount = 0 Then
 crsAddQ "You have no members!", Username, True
 crsAddQ "To get started, inside your bot type /promote <YourUsername> " & UBound(crsRanks) - 1, Username, True
 Exit Sub
End If
SplitQ memberCount & " members: ", GetAllMembers(), ", ", Username
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 8, Username: Exit Sub
Else
 If Not IsNumeric(cmd(1)) Then crs_error 8, Username: Exit Sub 
End If

'// Does this rank exist?
If CInt(cmd(1)) < 1 Or CInt(cmd(1)) >= UBound(crsRanks) Then
 crs_error 3, Username: Exit Sub
End If

'// Get all members with the specified rank
arrAllMembers = Split(GetAllMembers(), ", ") '// Get a list of all members
rankString = crsRanks(cmd(1)) & " (" & cmd(1) & ") "
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 memCount = vbNullString Then memCount = 0
listStart = memCount & " members with rank " & crsRanks(cmd(1)) & " (" & cmd(1) & ")"
If memCount = 0 Then crsAddQ listStart, Username, True: Exit Sub
SplitQ listStart & ": ", memList, ", ", Username
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 ranks from crsRanks array
For i = 1 to UBound(crsRanks) - 1: ranks = ranks & crsRanks(i) & " (" & i & "), ": Next
listStart = "There are " & UBound(crsRanks) - 1 & " ranks: "
SplitQ listStart, ranks, ", ", Username
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

crsAddQ user & " is a " & crsRanks(rs.Fields(2)) & " (" & rs.Fields(2) & ").", Username, True
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

crsLastAct = user & " was " & pType & " " & Abs(numRanks) & " rank(s), from " & crsRanks(rs.Fields(3)) & _
            " (" & rs.Fields(3) & ")" & " to " & crsRanks(rs.Fields(2)) & " (" & rs.Fields(2) & ")" & _
            " by " & rs.Fields(4) & " on " & Replace(rs.Fields(5)," "," at ",1,1) & ". " & rs.Fields(7)
If Access <> -2 Then crsAddQ crsLastAct, Username, True
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

If rs.Fields(9) <> 0 Then lastActive = " This user was last active on " & Replace(rs.Fields(9)," "," at ",1,1) & "."

crsAddQ user & " joined " & crs_clan_name & " on " & Left(rs.Fields(6), Instr(rs.Fields(6), " ") - 1) & ", " & _
       "and has logged " & Int(rs.Fields(8) * 100)/100 & " Clan Hours." & lastActive, Username, True
End Sub


'/// Functions ///

Function GetAllMembers()

set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
ubID = rs.Fields(0)
For i = 0 to ubID
 set rs = crsConn.Execute("SELECT * FROM `members` WHERE `ID`="&i)
 If Not(rs.EOF And rs.BOF) Then
   If rs.Fields(2) <> 0 Then
     If MonitoredUserIsOnline(LCase(rs.Fields(1))) = 1 Then strOnline = " (online)" Else strOnline = "" End If     
     memList = memList & crsRanks(rs.Fields(2)) & " (" & rs.Fields(2) & ") " & rs.Fields(1) & strOnline & ", "
   End If
 End If
Next
GetAllMembers = memList
End Function


Function GetMemberCount()

memList = GetAllMembers
If memList = vbNullString Then
 GetMemberCount = 0 
Else
 GetMemberCount = UBound(Split(memList, ", "))
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


'/// 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 connection to database catalog
Set crsConn = CreateObject ("ADODB.connection")
dsn = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & crsDatabasePath
crsConn.ConnectionString = dsn
crsConn.Open
End Sub


Sub SplitQ(Title, String, Delimiter, Username) '// Seperates large strings and AddQ's

If Username = BotVars.Username Then '// User is in bot -- seperation not necessary
 crsAddQ Title & Left(String, Len(String) - 2), Username, True: Exit Sub
End If

arrString = Split(String, Delimiter)
ReDim crsQueue(0)

'// Create list
For i = 1 to UBound(arrString)
 If i = UBound(arrString) Then
   curString = Mid(String, Instr(String, arrString(i)))
   curString = Left(curString, Len(curString) - Len(Delimiter))
 Else
   curString = Left(String, Instr(String, arrString(i)) - (Len(Delimiter)))
 End If
 If i < UBound(arrString) - 1 Then
   nextString = Left(String, Instr(String, arrString(i + 1)) - (Len(Delimiter)))
 End If
 If Len(nextString) >= 180 Then '// String exceeds Battle.net character limit?
   qCount = qCount + 1
   ReDim Preserve crsQueue(qCount)
   crsQueue(qCount) = curString
   nextString = ""
   String = Mid(String, Instr(String, arrString(i)))
 End If
Next

'// If string can be sent through a single AddQ, display list and exit sub
If qCount = 0 Then
 crsAddQ Title & curString, Username, True: Exit Sub
Else
 AddQ "/w " & Username & " This data is " & UBound(crsQueue) + 1 & " messages long. There will be a " & _
      "delay of appx. " & crs_anti_flood  & " seconds between each message."
End If

'// Display list via multiple AddQs
Do
 For i = 1 to Int(crs_anti_flood / 4) '// Increase queue time to prevent flooding
   ssc.PadQueue()
 Next
 crsIndex = crsIndex + 1
 If UBound(crsQueue) = 0 Then
   crsAddQ Title & curString, Username, True: Exit Sub
 End If
 If crsIndex <= UBound(crsQueue) Then
   msg = crsQueue(crsIndex)
   If crsIndex = 1 Then
     crsAddQ Title & msg & " [more]", Username, True
   ElseIf crsIndex = UBound(crsQueue) and curString = "" Then
     crsAddQ msg, Username, True: Exit Do '// No data remains
   Else
     crsAddQ msg & " [more]", Username, True '// There's more data to display
   End If
 End If
 If crsIndex = UBound(crsQueue) + 1 Then
   If Len(curString) > 0 and UBound(crsQueue) > 0 Then 
     crsAddQ curString, Username, True: Exit Do '// End of list
   End If
 End If
Loop
End Sub


Sub crsAddQ(Message, Username, Whisper)

'// Bot is on Diablo 2 / Diablo 2 LOD?
botProduct = GetInternalDataByUsername(BotVars.Username, 3)
If botProduct = "D2DV" Or botProduct = "D2XP" Then
 Username = "*" & Username
End If

Message = Trim(capUsernames(Message))
If Username = BotVars.Username Then '// In-bot command?
 AddChat vbCyan, Message
Else
 If Whisper Then AddQ "/w " & Username & " " & Message Else AddQ Message End If
End If
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 = "That 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 must supply a username."
 Case 8: errString = "You must supply a rank value. (ex: " & BotVars.Trigger & findrank_command & " 7)"
 Case 9: errString = "You cannot set a user's rank to their current rank."
End Select
crsAddQ "Clan Rank Script: " & errString, Username, True
End Sub
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 12.05.2008, 21:15   #5
Гость_за_инактив
 
Аватар для Inferno
 
Регистрация: 24.09.2008
Сообщений: 46
Репутация: 11
Отправить сообщение для Inferno с помощью MSN
Автор По умолчанию

пробовал. но он его не видит тоесть он там есть но команды не пашут.
  Наверх
Старый 12.05.2008, 21:17   #6
Кодер-Дизайнер

 
Аватар для AlfaDogg
 
Регистрация: 24.02.2008
Сообщений: 208
Репутация: 164
По умолчанию

аццес отредактил? команды впиши и доступ к ним...
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 12.05.2008, 21:27   #7
Гость_за_инактив
 
Аватар для Inferno
 
Регистрация: 24.09.2008
Сообщений: 46
Репутация: 11
Отправить сообщение для Inferno с помощью MSN
Автор По умолчанию

аксес подходит, он во время загрузки скрипта там переодически ошибки выдаёт типо такая строка не пральная, и прочий бред аксес у мну 777 а, так что ту сотню которую он требует полюбак перекрывает, и все стандартные команды с аксесом 100 пашут.

ещё када скрипт вставляю, там типо юникод в скрипте хз мб из за него... в другом формате засейвить или убрать ваще юникод
  Наверх
Старый 12.05.2008, 21:30   #8
Кодер-Дизайнер

 
Аватар для AlfaDogg
 
Регистрация: 24.02.2008
Сообщений: 208
Репутация: 164
По умолчанию

Да походу сам скрипт не рабочий у них на форуме кодировка лагнула... и символ какойто не првельно засейвился
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 12.05.2008, 21:33   #9
Гость_за_инактив
 
Аватар для Inferno
 
Регистрация: 24.09.2008
Сообщений: 46
Репутация: 11
Отправить сообщение для Inferno с помощью MSN
Автор По умолчанию

Код:
'// Clan Rank Script v2.77
'//   by Swent
'//     Last Modified by Swent 10:28 PM 3/6/2006
'//       plugin version

Public crsConn          '// hold database connection
Public crsLastAct       '// hold data from bot's last action
Public crsRanks()       '// hold rank names specified in program settings
Public crsQueue()       '// hold multi-message data until its sent to bot's queue
Public crsGreetsEnabled '// hold bool containing greet status
Public crsDatabasePath  '// hold database file path

'//**************************//
'//   PROGRAM SETTINGS       //   
'//**************************//

'// [ Clan Name ]
Const crs_clan_name = "Clan YourClanName" '// Clan Name

'// [ Access Requirements ]
Const crsgreet_cmd_access = 100 '// Default: 100
Const setrank_cmd_access  = 100 '// Default: 100
Const promote_cmd_access  = 100 '// Default: 100
Const demote_cmd_access   = 100 '// Default: 100
Const remove_cmd_access   = 100 '// Default: 100
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

'// [ Command Names ]
Const crsgreet_command = "crsgreet" '// Used to enable/disable greet by rank.
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 retieve 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.

'// [ 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 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

'// [ Profile Update ]
Const profile_update_enabled = True '// Updates bot's profile after each promotion/demotion.

'// [ Automatic Access ]
'// Assigns access to users automatically based on their rank after promotions/demotions.
'//   Higher ranks (top third) recieve 100 acesss
'//   Middle ranks (middle third) recieve 60 access
'//   Lower ranks (bottom third) receive 20 access
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            | %h = joiner's time logged (in hours)   
'//   %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
'//   Feel free to edit the greets below using any of the variables listed above!

'//   - Greets:
'//     **IMPORTANT: Don't forget that quotations (" ") must surround the greets below, or else there'll be errors!
Const member_greet     = "%r (%u) %0 has entered!"
Const nonmember_greet  = "Welcome %0 to %c, the home of %n!"

'//   - Greets Statuses:
'//  <<< GREETS CAN BE ENABLED OR DISABLED HERE!!! >>>
'//  NOTE: Greets can also be enabled/disabled *temporarily* using the .crsgreet on/off command
crsGreetsEnabled              = True '// True to enable all greets, False to disable
Const member_greet_enabled    = True '// True to enable member greets, False to disable
Const nonmember_greet_enabled = True '// True to enable non-member greets, False to disable

'//   - Greet Display Type (whisper 
Const whisper_member_greet    = False '// True: member greets whispered, False: displayed publicly
Const whisper_nonmember_greet = True  '// True: non-member greets whipsered, False: displayed publicly

'// [ Anti-Flood Delay ]
Const crs_anti_flood = 8 '// For multi-message command responses, delay each message by x seconds to prevent flooding.

Sub crs_Event_Load()

'// [ Rank Settings ]
numRanks = 16 '// Number of ranks <- CHANGE THIS AFTER ADDING OR REMOVING RANKS!
ReDim crsRanks(numRanks + 1): crsRanks(0) = "Unranked" '// Do not modify this line
crsRanks(1) = "Leader"
crsRanks(2) = "Commander"
crsRanks(3) = "Lieutenant General"
crsRanks(4) = "Major General"
crsRanks(5) = "Brigadier General"
crsRanks(6) = "Colonel"
crsRanks(7) = "Major"
crsRanks(8) = "Captain"
crsRanks(9) = "Lieutenant"
crsRanks(10) = "Sergeant Major"
crsRanks(11) = "First Sergeant"
crsRanks(12) = "Staff Sergeant"
crsRanks(13) = "Sergeant"
crsRanks(14) = "Corporal"
crsRanks(15) = "Private First Class"
crsRanks(16) = "Private"
'// Feel free to modify/remove some of the ranks above, or add additional ranks below.
'// Example: crsRanks(17) = "Newbie"
'// ** IMPORTANT: All modifications to number of ranks or rank names should be made BEFORE you start using the script!
'// ** IMPORTANT: Don't forget to change the numRanks variable above after you add or remove ranks!

'//****************************//
'//   DO NOT EDIT BELOW HERE   //
'//   DO NOT EDIT BELOW HERE   //
'//   DO NOT EDIT BELOW HERE   //
'//   DO NOT EDIT BELOW HERE   //
'//****************************//

'// Start timer (timer is used to log members' online time and to record last active time)
CreateTimer "crs", "crsTimer"
TimerInterval "crs", "crsTimer", 60
TimerEnabled "crs", "crsTimer", True

'// Database exists?
crsDatabasePath = BotPath() & "MemberData.mdb"
Set crsFSO = CreateObject("Scripting.FileSystemObject")
If Not crsFSO.FileExists(crsDatabasePath) Then
  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 Len(Message) < 2 Then Exit Sub
If Username <> BotVars.Username Then
  If Left(Message, 1) <> BotVars.Trigger Then Exit Sub
Else
  If Left(Message, 1) <> "/" Then Exit Sub
End If

'// Get the command and arguments
If Instr(Trim(Message), " ") = 0 Then Message = Message & " "
cmd = Split(Mid(Trim(Message), 2), " ")

'// Call the proper sub
Select Case LCase(cmd(0))
  Case crsgreet_command: crsgreet_cmd cmd, Username, myAccess
  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
End Select
End Sub


Sub crs_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)

GetDBEntry Username, dbAccess, dbFlags
If dbFlags = "" Then dbFlags = "(none)"

'// Greets enabled?
If crsGreetsEnabled = False Then Exit Sub

'// 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)
  timeLogged = Int(rs.Fields(8) * 100)/100
Else
  rank = 0
  timeLogged = 0
End If

'// Replace custom greet variables
arrGreet = Array(member_greet, nonmember_greet)
If rank > 0 Then n = 0 Else 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", rank)
arrGreet(n) = Replace(arrGreet(n), "%m", GetMemberCount())
arrGreet(n) = Replace(arrGreet(n), "%h", timeLogged)
arrGreet(n) = Replace(arrGreet(n), "%n", 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/whisper the appropriate greet
If rank > 0 Then
  
  '// member greets enabled?
  If Not member_greet_enabled Then Exit Sub

  If whisper_member_greet Then
    AddQ "/w " & Username & " " & arrGreet(0)
  Else
    AddQ arrGreet(0)
  End If
Else

  '// non-member greets enabled?
  If Not nonmember_greet_enabled Then Exit Sub

  If whisper_nonmember_greet Then
    AddQ "/w " & Username & " " & arrGreet(1)
  Else
    AddQ arrGreet(1)
  End If
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)

If Len(Text) < 2 Then Exit Sub
If Instr(Text, " ") = 0 Then Text = Text & " "
cmd = Split(Mid(Trim(Text), 2), " ")
Select Case LCase(cmd(0))
  Case crsgreet_command, setrank_command, promote_command, demote_command, remove_command, rank_command, rankinfo_command, members_command, ranks_command, findrank_command, cmdlist_command, meminfo_command
    If Left(Text, 1) = "/" Then VetoThisMessage
End Select
crs_Event_UserTalk BotVars.Username, "", Text, 1
End Sub


Sub crs_crsTimer_Timer()

arrMembers = Split(GetAllMembers(), ", ")
For i = 0 to UBound(arrMembers)
  memberName = Replace(Mid(arrMembers(i), Instr(arrMembers(i), ") ") + 2), " (online)", "")

  If MonitoredUserIsOnline(LCase(memberName)) = 1 Then

    '// Make sure user isn't idle
    If GetInternalDataByUsername(memberName, 7) < 600 Then

      '// Get user's current time logged
      set rs = crsConn.Execute("SELECT COUNT(*) FROM `members` WHERE `name`='" & LCase(memberName) & "'")
      If rs.Fields(0) <> 0 Then
        set rs = crsConn.Execute("SELECT * FROM `members` WHERE `name`='" & LCase(memberName) & "'")
        curLogged = CDbl(rs.Fields(8))
      Else
        curLogged = 0
      End If
 
      '// Update user's time log
      newLogged = FormatNumber((curLogged * 60 + 1) / 60, 3)
      crsConn.Execute("UPDATE `members` SET `time_logged` = '" & newLogged & "' WHERE `name`='" & LCase(memberName) & "'")

      '// Update last active date/time
      crsConn.Execute("UPDATE `members` SET `last_active` = '" & Now & "' WHERE `name`='" & LCase(memberName) & "'")
    End If
  End If
Next
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 '// Has enough access?
End If

Select Case LCase(cmd(1))
  Case "on"
    crsGreetsEnabled = True
    crsAddQ "Clan Rank Script: The Member and the Non-Member greets have been enabled", Username, True
  Case "off"
    crsGreetsEnabled = False
    crsAddQ "Clan Rank Script: The Member and the Non-Member greets have been disabled.", Username, True
  Case Else
    crsAddQ "Correct format: " & BotVars.Trigger & crsgreet_command & " on/off"
End Select
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 7, Username: Exit Sub '// Username arguement exists?

'// 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 user supplied a rank name, get rank value
    If Not IsNumeric(cmd(2)) Then
      For i = 2 to UBound(cmd)
        rankName = rankName & cmd(i) & " "
      Next
      For i = 1 to UBound(crsRanks)
        If LCase(crsRanks(i)) = LCase(Trim(rankName)) Then
          newRank = i
          Exit For
        End If
      Next
      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 = "Reason: " & Left(rsn, Len(rsn) - 1) & ". "
    rsn = Replace(rsn, "'", "`") '// replace single quotes to avoid errors
  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
    crsAddQ "To make yourself a " & crsRanks(1) & ", inside your bot type /promote <YourUsername> " & UBound(crsRanks) - 1, Username, True
  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 9, Username: Exit Sub
End If

'// Assign appropriate access to user
'//   Highest ranks (top third) get 100 access
'//     Middle ranks (middle third) get 60 access
'//       Lowest ranks (bottom third) get access 20 access
If auto_access_enabled Then
  third = Int(UBound(crsRanks) / 3)
  If newRank > 0 And newRank < (third + 1) Then
    newAccess = 100
  ElseIf newRank < (third * 2) Then
    newAccess = 60
  ElseIf newRank < UBound(crsRanks) Then
    newAccess = 20
  ElseIf newRank = UBound(crsRanks) Then
    newAccess = 0
  End If
  GetDBEntry cmd(1), curAccess, curFlags
  Command BotVars.Username, "/set " & LCase(cmd(1)) & " " & newAccess, True
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)) & "'")
  crsAddQ "Kicked " & cmd(1) & " out of " & crs_clan_name & ".", Username, False
  Command BotVars.Username, "/unmonitor " & cmd(1), True
  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
  crsAddQ pType & " " & cmd(1) & " from " & crsRanks(curRank) & " (" & curRank & ") to " & crsRanks(newRank) & " (" & newRank & ").", Username, False

'// 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')")
  crsAddQ "Added " & cmd(1) & " to " & crs_clan_name & " with rank " & crsRanks(newRank) & " (" & newRank & ").", Username, False
  Command BotVars.Username, "/monitor " & cmd(1), True
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 " & crs_clan_name & " by " & Username & " on " & Replace(rs.Fields(5)," "," at ",1,1) & ". "
  End If

  crsLastAct = Trim(capUsernames(crsLastAct))
  SetBotProfile "RankB0t", 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()
If memberCount = 0 Then
  crsAddQ "You have no members!", Username, True
  crsAddQ "To get started, inside your bot type /promote <YourUsername> " & UBound(crsRanks) - 1, Username, True
  Exit Sub
End If
SplitQ memberCount & " members: ", GetAllMembers(), ", ", Username
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 8, Username: Exit Sub
Else
  If Not IsNumeric(cmd(1)) Then crs_error 8, Username: Exit Sub 
End If

'// Does this rank exist?
If CInt(cmd(1)) < 1 Or CInt(cmd(1)) >= UBound(crsRanks) Then
  crs_error 3, Username: Exit Sub
End If

'// Get all members with the specified rank
arrAllMembers = Split(GetAllMembers(), ", ") '// Get a list of all members
rankString = crsRanks(cmd(1)) & " (" & cmd(1) & ") "
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 memCount = vbNullString Then memCount = 0
listStart = memCount & " members with rank " & crsRanks(cmd(1)) & " (" & cmd(1) & ")"
If memCount = 0 Then crsAddQ listStart, Username, True: Exit Sub
SplitQ listStart & ": ", memList, ", ", Username
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 ranks from crsRanks array
For i = 1 to UBound(crsRanks) - 1: ranks = ranks & crsRanks(i) & " (" & i & "), ": Next
listStart = "There are " & UBound(crsRanks) - 1 & " ranks: "
SplitQ listStart, ranks, ", ", Username
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

crsAddQ user & " is a " & crsRanks(rs.Fields(2)) & " (" & rs.Fields(2) & ").", Username, True
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

crsLastAct = user & " was " & pType & " " & Abs(numRanks) & " rank(s), from " & crsRanks(rs.Fields(3)) & _
             " (" & rs.Fields(3) & ")" & " to " & crsRanks(rs.Fields(2)) & " (" & rs.Fields(2) & ")" & _
             " by " & rs.Fields(4) & " on " & Replace(rs.Fields(5)," "," at ",1,1) & ". " & rs.Fields(7)
If Access <> -2 Then crsAddQ crsLastAct, Username, True
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

If rs.Fields(9) <> 0 Then lastActive = " This user was last active on " & Replace(rs.Fields(9)," "," at ",1,1) & "."

crsAddQ user & " joined " & crs_clan_name & " on " & Left(rs.Fields(6), Instr(rs.Fields(6), " ") - 1) & ", " & _
        "and has logged " & Int(rs.Fields(8) * 100)/100 & " Clan Hours." & lastActive, Username, True
End Sub


'/// Functions ///

Function GetAllMembers()

set rs = crsConn.Execute("SELECT COUNT(*) FROM `members`")
ubID = rs.Fields(0)
For i = 0 to ubID
  set rs = crsConn.Execute("SELECT * FROM `members` WHERE `ID`="&i)
  If Not(rs.EOF And rs.BOF) Then
    If rs.Fields(2) <> 0 Then
      If MonitoredUserIsOnline(LCase(rs.Fields(1))) = 1 Then strOnline = " (online)" Else strOnline = "" End If     
      memList = memList & crsRanks(rs.Fields(2)) & " (" & rs.Fields(2) & ") " & rs.Fields(1) & strOnline & ", "
    End If
  End If
Next
GetAllMembers = memList
End Function


Function GetMemberCount()

memList = GetAllMembers
If memList = vbNullString Then
  GetMemberCount = 0 
Else
  GetMemberCount = UBound(Split(memList, ", "))
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


'/// 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 connection to database catalog
Set crsConn = CreateObject ("ADODB.connection")
dsn = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & crsDatabasePath
crsConn.ConnectionString = dsn
crsConn.Open
End Sub


Sub SplitQ(Title, String, Delimiter, Username) '// Seperates large strings and AddQ's

If Username = BotVars.Username Then '// User is in bot -- seperation not necessary
  crsAddQ Title & Left(String, Len(String) - 2), Username, True: Exit Sub
End If

arrString = Split(String, Delimiter)
ReDim crsQueue(0)

'// Create list
For i = 1 to UBound(arrString)
  If i = UBound(arrString) Then
    curString = Mid(String, Instr(String, arrString(i)))
    curString = Left(curString, Len(curString) - Len(Delimiter))
  Else
    curString = Left(String, Instr(String, arrString(i)) - (Len(Delimiter)))
  End If
  If i < UBound(arrString) - 1 Then
    nextString = Left(String, Instr(String, arrString(i + 1)) - (Len(Delimiter)))
  End If
  If Len(nextString) >= 180 Then '// String exceeds Battle.net character limit?
    qCount = qCount + 1
    ReDim Preserve crsQueue(qCount)
    crsQueue(qCount) = curString
    nextString = ""
    String = Mid(String, Instr(String, arrString(i)))
  End If
Next

'// If string can be sent through a single AddQ, display list and exit sub
If qCount = 0 Then
  crsAddQ Title & curString, Username, True: Exit Sub
Else
  AddQ "/w " & Username & " This data is " & UBound(crsQueue) + 1 & " messages long. There will be a " & _
       "delay of appx. " & crs_anti_flood  & " seconds between each message."
End If

'// Display list via multiple AddQs
Do
  For i = 1 to Int(crs_anti_flood / 4) '// Increase queue time to prevent flooding
    ssc.PadQueue()
  Next
  crsIndex = crsIndex + 1
  If UBound(crsQueue) = 0 Then
    crsAddQ Title & curString, Username, True: Exit Sub
  End If
  If crsIndex <= UBound(crsQueue) Then
    msg = crsQueue(crsIndex)
    If crsIndex = 1 Then
      crsAddQ Title & msg & " [more]", Username, True
    ElseIf crsIndex = UBound(crsQueue) and curString = "" Then
      crsAddQ msg, Username, True: Exit Do '// No data remains
    Else
      crsAddQ msg & " [more]", Username, True '// There's more data to display
    End If
  End If
  If crsIndex = UBound(crsQueue) + 1 Then
    If Len(curString) > 0 and UBound(crsQueue) > 0 Then 
      crsAddQ curString, Username, True: Exit Do '// End of list
    End If
  End If
Loop
End Sub


Sub crsAddQ(Message, Username, Whisper)

'// Bot is on Diablo 2 / Diablo 2 LOD?
botProduct = GetInternalDataByUsername(BotVars.Username, 3)
If botProduct = "D2DV" Or botProduct = "D2XP" Then
  Username = "*" & Username
End If

Message = Trim(capUsernames(Message))
If Username = BotVars.Username Then '// In-bot command?
  AddChat vbCyan, Message
Else
  If Whisper Then AddQ "/w " & Username & " " & Message Else AddQ Message End If
End If
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 = "That 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 must supply a username."
  Case 8:  errString = "You must supply a rank value. (ex: " & BotVars.Trigger & findrank_command & " 7)"
  Case 9:  errString = "You cannot set a user's rank to their current rank."
  Case 10: errString = "A rank of that name does not exist."
End Select
crsAddQ "Clan Rank Script: " & errString, Username, True
End Sub
тут есть ещё и другая версия скрипта но токо с plugin системой
  Наверх
Старый 12.05.2008, 21:41   #10
Кодер-Дизайнер

 
Аватар для AlfaDogg
 
Регистрация: 24.02.2008
Сообщений: 208
Репутация: 164
По умолчанию

хз но должно пахать если в самый конец скрипта пихнуть... но могут случаться как сбои, так и конфликты с другими скриптами...
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 12.05.2008, 21:53   #11
Гость_за_инактив
 
Аватар для Inferno
 
Регистрация: 24.09.2008
Сообщений: 46
Репутация: 11
Отправить сообщение для Inferno с помощью MSN
Автор По умолчанию

кста как ты код делаешь не втыкну?
  Наверх
Старый 12.05.2008, 22:06   #12
Кодер-Дизайнер

 
Аватар для AlfaDogg
 
Регистрация: 24.02.2008
Сообщений: 208
Репутация: 164
По умолчанию

[code]57575[/code]
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 13.12.2008, 23:18   #13
Гость_за_инактив
 
Аватар для WARCRAFT
 
Регистрация: 08.12.2008
Сообщений: 2
Репутация: 0
По умолчанию

Слушайте народ как сделать чтоб писала много сообщений через некотрое время а то в боте настройках токо одно можно, а как больше сделать?
  Наверх
Старый 13.12.2008, 23:28   #14
Освоившийся
 
Аватар для Ilya89
 
Регистрация: 09.03.2008
Адрес: Москва, Россия
Сообщений: 703
Репутация: 470
Отправить сообщение для Ilya89 с помощью ICQ
Смущение

Цитата:
Сообщение от WARCRAFT Посмотреть сообщение
Слушайте народ как сделать чтоб писала много сообщений через некотрое время а то в боте настройках токо одно можно, а как больше сделать?
Актуальный вопрос... Но теперь уже никак, к сожалению. Надо к скрипту одно небольшое дополнение писать, но как я без понятия. *shahta*
__________________
[Ссылки скрыты от гостей.]
[Ссылки скрыты от гостей.]
  Наверх
Закрытая тема

Метки
Bot, script, scripting, stealthbot, Бот, добавить скрипт, скрипт, стилсбот


Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 
Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход


Powered by vBulletin
Copyright © 2017 vBulletin Solutions, Inc.
Перевод: zCarot | Дизайн: G-A | Верстка: OldEr
Текущее время: 00:09. Часовой пояс GMT +4.