also, bin ein ziemlicher script noob, aber das sollte es sein
'bcp
'1.78
'&Acc Baal Script:ConnectioN_Lost
'&This section is old, please refer to the script's command list.
'&19132
'&Last updated 8/2/07
'Credits
'║ vi[r]us >>> Thats me, I hope you enjoyed the time I put into this. ║
'║ Alls I ask is for you to not spam me for help. ║
'║ heavenly_love >>> Helped me a lot in fixing and testing the Overflow error. ║
'║ s.t.a.s.h >>> Suggested I remove xfire messages.
║
'║ fagju >>> Reworked the top players function, works better and faster! ║
'║ UnitedSouls >>> Helped me test the "multi-sensative-game" word checking system. ║
'║ Steve & his buds @ Clan Chx >>> Helped test multi-language support! ║
'// Supported Languages (active as of v1.78):
' English
' French
' Spanish - Thanks xHerr_Totenx for translating
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
' // ChangeLog
' // Key:
' // * = new commands
' // # = bug fixes
' // ^ = new features/bot stuff
' // @ = other
' // () = may not be in this version
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
'// 1.78
' ^ 1. Added multi-language support.
'// .One
' ^ 1. Added spanish support.
' @ 2. Cleaned up phelp, added post number and last update time.
' @ 3. Fixed a typo by the translation area, also added a "don't leech" note to it.
' // 1.77
' ^ 1. You can have more than one detection word in your gamechecking list. Seperate with |
' ^ 2. Fixed 2 typos.
' ^ 3. (b)List saves and opens again when the profile does.
' // 1.76 (Bug Fixes)
' # 1. Fixed the "you went over time" spam.
' @ 2. Changes the "xfire me" messages.
' # 3. Fixed the absUpdate Error Message
' # 4. Fixed the dreaded OVERFLOW message. -- Thanks heavenly!
' ^ 5. Added and changed the bot to work with fagju's rework of my gettopusers function. That helps a lot. Thanks
' // 1.75B
' ^ 1. Gave commands access.
' // 1.75 (Next)
' // You can no longer blacklist players with more access then your own.
' ^ 2. The bot tells you when your game goes over-time.
' ^ 3. The bot can /f m login/logout messages now.
' ^ 4. You now have to give a reason when blacklisting a player.
' ^ 5. You can now get information on a rune.
' # 6. Lessened an overflow bug when too many users joined a game. (may still happen when 5+ users join the same game)
' // 1.74 (Latest Official Release) (3/28/07)
' ^ 1. The bot has top runners now.
' @ 3. x
' @ -3. x
' @ 4. x
' ^ 5. You can rename files now.
' * 6. Added :top command
' * 7. Added :resetmystats command
' * 8. Bot keeps tabs on who gets logged out and has a delay before they can log in again.
' # 9. The bot now says exactly how long they have left before they can do :baal again.
' @ 10. You no longer have to worry about the thing that has a * for d2. The bot figures it out himself.
' ^ 11. Stopwatch message now shown even when a player is over time.
' * 12. Added /restartlist command
' ^ 13. ()Bot checks for corruption within the list
' ^ 14. Fixed a bug with message display that made your chat lag.
' // 1.73 (3/25/07)
' ^ 1. The bot now runs my runeword script integrated inside.
' ^ 2. The bot has functionality for a blacklist, a list of players who cannot use the bot.
' # 3. Commands adjusted to get names more accurately.
' ^ 4. Bot sends a friends message when restarting.
' ^ 5. Added option to ignore games that took less then 60 seconds.
' ^ 6. You can include a player's baal statstring when making a new game. Use %ss
' # 7. Fixed a bug with :baal that would say games twice and games that were older.
' * 8. You can get your game's duration by typing :mytime, :runtime or time.
' ^ 9. Gives you the option to log a player out if they do not have a certain word in the game-name. (allowing baal only!)
' ^ 10. Colorized messages that appear in bot.
' @ 11. Sorted the declarations list (doesnt effect you)
' * 12. Added :globalmessage (:gm) command.
' ^ 13. You can put a games runtime in the game return. Use %t.
' ^ 14. Will not show games on the return list if they are over the max time a game can go for.
' # 15. Fixed a bug that whispered the wrong player their logout message when someone else exited battle.net.
' @ 16. Forcelogging no longer has confirmations.
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
' // List of commands //
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
' /// Format:
' // MODES CALLABLE | MODE RETURNED | COMMAND | DESCRIPTION
' /// Example:
' // Whisper | Whisper | :time | gets your run's time
' /// Styles
' // Public - Returns to the channel
' // Whisper - Returns to the caller
' // Both - Returns whisper or public depending on how it was called
' // Friends - Returns as a friends message
' // ' = ' means whatever you call it with is how it responds
' /// Public Commands (anyone can use unless blacklisted)
' Public | Whisper | :login | logs you in allowing you to join games
' Public | Whisper | :logout | logs you out so the bot won't follow you
' Public | Public | :myinfo | gets your run record
' Public | Public | :getinfo <username> | gets a player's run record
' Public | Public | :top | gets top runners
' Public | Whisper | :resetmystats | resets your record
' Public | Public | :allinfo | gets info bot-wide
' Public | Whisper | :loginreqs | gets login requirements
' Public | Public | :baal | gets the list of *current* games
' Whisper | Whisper | :time **or** :mytime **or** time | gets your game's runtime
' /// Admin (def: 60 access)
' Public | Nothing | :forcelogin <username> | logs someone in without checking requirements
' Public | Nothing | :forcemylogin | logs the caller in without checking requirements
' Public | Nothing | :forcelogout <username> | logs someone out without their permission
' Public | Public | :toggleactive | turns the script on and off
' Public | Friends | :globalmessage <message> | sends a message to everyone logged in
' Public | Friends | :gm <message> | see above
' Both | Public | :updateprofile | updates the bot's profile as if it were on the timer
' /// Runewords
' Both | = | :runeword <rune word name> | gets a runeword by it's name
' Both | = | :wordrune <rune or rune combo> | gets a runeword by it's rune combination (Jah + Ith + Ber returns Enigma)
' /// Blacklist (Admin)
' Public | Whisper | :blacklist <username> <reason> | blacklists a player, they cant join games/use commands
' Public | Whisper | :blackdelete <username> <reason> | removes a player from the blacklist
' /// in-Bot Only
' /blacklist <username> | blacklists a player, they cant join games
' /blackdelete <username> | removes a player from the blacklist
' /showdata | shows data as a forum-code format so you can post it on your forums
' /restartlist | clears all user info and empties the datafile
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
' // Settings
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
'// Script Settings (S)
Const sTimeZone = " EST" '// Your timezone. This is so people know what time to use when getting last run.
Const sShowMessages = True '// Shows messages (in your bot) about what the bot does.
Const sForceNL = True '// Only non-ladder players can login.
Const sNoQuickies = True '// Will not record a game that took less then 60 seconds.
' ----- ----- ----- ----- -----
'// Public Commands (C)
Const cpAccess = -1 '// Access required to use public commands.
Const cLogin = "login"
Const cLogout = "logout"
Const cList = "baal"
Const cMyInfo = "myinfo"
Const cRequire = "loginreqs"
Const cGetTop = "top"
Const cResetData = "resetmystats"
Const cdGetTime = 8 '// Time beetween the command :mytime can be executed to stop spam.
' ----- ----- ----- ----- -----
'// Runeword Commands
Const rcGetWord = "runeword"
Const rcGetRune = "wordrune"
Const rcGetRuneInfo = "rune"
Const rcAccess = -1 '// Access to get runewords/runes.
' ----- ----- ----- ----- -----
'// Admin Commands (AC)
Const acAdminAccess = 60 '// The access level the bot considers 'admin-leveled'.
Const acGetInfo = "getinfo"
Const acGetOver = "allinfo"
Const acToggle = "bcptoggle"
Const acForceLog = "forcelogout"
Const acForceLogin = "forcemylogin"
Const acForceUserLogin = "forcelogin"
'// Blacklist Commands
Const acBlacklist = "blacklist"
Const acBlacklistRemove = "blackdelete"
' ----- ----- ----- ----- -----
'// Message (MS)
'// %n - Name of the user
'// %g - Game they joined
'//// Logging/Listing
Const msLogin = "You have been logged in, make sure you add me to your friends."
Const msDoubleLog = "You are already logged in."
Const msLogout = "You have logged out."
Const msLogoutFail = "You are not logged in."
Const msLogFail = "I could not log you in; you may not reach the level requirements, try rejoining the channel."
Const msListFail = "There are no games available."
Const msUserInad = "You do not meet the requirements to login."
Const msBusy = "The bot is busy, please wait a moment."
Const msNotFound = "No information was found on that person."
Const msHighPing = "Your ping is too high to host games with."
Const msSGError = "You are not joining a baal game. You have been logged out."
Const msBNetAway = "You are marked as unavailable, I couldn't add you to my friends list or log you in."
'//// Messages with Variables (MS) // Remember, gamereturn needs to be short, keep it less then 12 characters.
Const msGameReturn = "%n -- %t -- %g"
Const msNewRun = "New game: [ %n ] - [ Record: %ss ] - [ %g ]"
'//// Bot logging off message -- Blank disables
Const bloMessage = "The bot is logging off or reloading, your current games will not be recorded."
'//// Misc
Const mDontKnow = "?"
' ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'// Stopwatch (SW)
Const swStopwatch = True '// Whispers players their time when returning from runs in seconds or minutes.
Const swTimeout = 9 '// If a player's game takes longer then this, the bot ignores their game. (def: 8 min)
Const swMsgs = True '// If a players game goes over-time, it tells them.
' ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'// Profile Updating (PU)
Const puActive = True '// Whether he updates his profile or not.
Const puDelay = 120 '// Time beetween updates.
'//// Prefetch - THIS GOES DIRECTLY BEFORE THE ENTIRE PROFILE. Set to blank to disable.
Const puPrefetch = "ÿc0-ÿc5Clan xNLGÿc0-"
'//// Colors
'//// Use "rnd" on pcData to make it a random color.
Const pcTitle = "ÿc5" '// The color of a title, like "Total users:"
Const pcData = "rnd" '// The color of a data, like "14 minutes"
'// Bracket
' ÿ
'// List of colors (in diablo)
' c0 White
' c1 Red
' c2 Green
' c3 Blue
' c4 Gold
' c5 Gray
' c8 Orange
' c6 Black
' c9 Yellow
' c; Violet
' c+ Cyan/Teal/Bright White
'// List of stuff (in diablo)
' cb Boldface
' ci Italice
' cu Underline
' ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'// List Cleaning (LC)
Const lcActive = True '// Logs out users who exit battle.net.
Const lcAvoid = 90 '// Will not remove if access is more then this.
' ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'// List Returns (LR) // Compressed is suggested, but hey, whatever floats your boat.
Const lrIsWhispered = False '// Game list returns whispered to whoever called the command.
Const lrDelay = 12 '// Time in seconds before the getlist command can be executed again, per bot.
Const lrCompress = True '// The list returns 1 line instead of seperately. May split into other lines depending on size.
Const lrSplitter = ", " '// Devides games if compressed.
' ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'// File System (FS)
Const fsName = "playerinfo.dat"
Const fsBlack = "blacklist.txt"
Const fsRunes = "runewords.txt"
Const fsRuneInfos = "runeinfo.txt"
' ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'// User Requirements (UR)
Const urLevel = 1 '// The level required to login.
Const urType = "all" '// The character type required to login. Seperate with ' | '.
Const urPing = 500 '// The maximum ping a user can have. // Set to -1 to disable.
' ----- ----- ----- ----- -----
'// Sensative Games (SG)
Const sgActive = True '// Looks for a certain word in the name of the game.
Const sgString = "baal" '// This is the word it looks for. To have more than one, seperate with ' | '.
Const sgAvoid = 999 '// Access required to avoid the game filter.
Const sgMsg = True '// Sends the player a message telling them they were logged out.
' ----- ----- ----- ----- -----
'// Login Delay (LD)
Const ldDelay = 15 '// Time in minutes before a player can log in again when forced to log out. (flood control)
Const ldAccess = 10 '// Access to avoid the timer.
' ----- ----- ----- ----- -----
'// Friend Messages (FM)
Const fmMsgs = False '// Bot does a global message when a player logs in/out.
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
' // Declarations //
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
'// Arrays / Array Counters
Public ul(3,1500), s(2,50), cl(2,25), ctotal, allq(500), blu(1,1500), xTotalBUsers, ld(1,500), ri(3,34), xTotalRuneData
'// Variables
Public xChecking, xActive, xTotalRuns, xSuccess, xLSuccess, xrSuccess, xrLSuccess, xGettingList, xAllowList, xExecutee
Public xTotalUsers, rwl(2,80), xTotalRunes, xAllowGetTime
'// Objects
Public xFSO
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
' // Code //
' // ----- ----- ----- ----- ----- //
' // ----- ----- ----- ----- ----- //
Sub bcp_Event_Load()
Set xFSO = CreateObject("Scripting.FileSystemObject")
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: Loading files..."
LoadPlayerInfo
LoadRuneList
LoadBannedPlayers
LoadRuneInfoList
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: File loading complete."
xActive = True
xAllowGetTime = True
xAllowList = True
xSuccess = True
xrSuccess = True
For x = 0 to 50
s(0,x) = ""
s(1,x) = 0
s(2,x) = False
Next
TimerInterval "bcp","absUpdate", Int(puDelay)
TimerInterval "bcp","absStopwatch", 1
TimerInterval "bcp","absCompression", 2
TimerInterval "bcp","absGetTimeCmdDelay", cdGetTime
TimerEnabled "bcp","absStopwatch", True
TimerInterval "bcp","absUDelay", 60
TimerEnabled "bcp","absUDelay", True
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: " & GetTopRunnersF(10)
End Sub
Sub bcp_Event_ServerInfo(Message)
If xActive = False Then Exit Sub
If InStr(Message, "to your friends list.") > 0 and xSuccess = False Then
If fmMsgs = True Then AddQ "/f m " & xLSuccess & " logged in."
AddQ "/w " & psD2 & xLSuccess & " " & msLogin
xSuccess = True
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: ÿc5" & xLSuccess & "ÿc0 has been logged in."
End If
If InStr(Message, "from your friends list") > 0 and xrSuccess = False and InStr(LCase(Message), LCase(xrLSuccess)) > 0 Then
If fmMsgs = True Then AddQ "/f m " & xrLSuccess & " logged out."
AddQ "/w " & psD2 & xrLSuccess & " " & msLogout
xrSuccess = True
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: ÿc5" & xrLSuccess & "ÿc0 has been logged out."
End If
If InStr(Message, "unavailable") > 0 and xrSuccess = False Then
If fmMsgs = True Then AddQ "/f m " & xLSuccess & " logged out."
AddQ "/w " & psD2 & xrLSuccess & " " & msLogout
xrSuccess = True
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: ÿc5" & xLSuccess & "ÿc0 has been logged out."
End If
If InStr(Message, "unavailable") > 0 and xSuccess = False Then
AddQ "/w " & psD2 & xLSuccess & " " & msBNetAway
xSuccess = True
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: ÿc5" & xLSuccess & "ÿc0 was unable to be added!"
End If
If InStr(Message, "in the game") > 0 and InStr(Message, ":") > 0 and xGettingList = True Then
CurrentArguement = Split(Message, ": ")(1)
Name = Split(CurrentArguement, ",")(0)
Game = Split(CurrentArguement, "in the game ")(1)
Game = Left(Game, Len(Game) - 1)
Game = Replace(Game, " (private)", vbNullString)
For i = 0 to 25
If LCase(Game) = LCase(cl(1,i)) Then
Exit Sub
End If
Next
'// Get time
onstopwatch = False
For x = 0 to 50
If LCase(Name) = LCase(s(0,x)) Then
onstopwatch = True
placement = x
Exit For
End If
Next
If onstopwatch = True Then
If s(2,placement) = True Then
sect = s(1,placement)
If sect >= 60 Then
runt = sect \ 60
If runt > swTimeout Then
Exit Sub
End If
btime = runt & "m"
Else
btime = sect & "s"
End If
Else
btime = mDontKnow
End If
Else
btime = mDontKnow
End If
cl(0,ctotal) = Name
cl(1,ctotal) = Game
cl(2,ctotal) = btime
ctotal = ctotal + 1
If lrCompress = False Then
If lrIsWhispered = True Then
msg = msGameReturn
msg = Replace(msg, "%n", Name)
msg = Replace(msg, "%g", Game)
AddQ "/w " & psD2 & xrLSuccess & " " & msg
Else
msg = msGameReturn
msg = Replace(msg, "%n", Name)
msg = Replace(msg, "%g", Game)
AddQ msg
End If
End If
End If
End Sub
Sub bcp_Event_ServerError(Message)
If xActive = False Then Exit Sub
If InStr(Message, "have any friends in your list") > 0 and xGettingList = True Then
xGettingList = False
If sShowMessages = True Then AddChat vbRed, " -- ÿc5Baal Scriptÿc0: Could not get the list, no one present."
End If
If InStr(Message, "not logged on") < 0 and xSuccess = False Then
xSuccess = True
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: User was not connected to Battle.net."
End If
If InStr(Message, "is already in your friends list") > 0 and xSuccess = False Then
AddQ "/w " & psD2 & xLSuccess & " " & msDoubleLog
xSuccess = True
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: ÿc5" & xLSuccess & "ÿc0 was already logged in."
End If
If InStr(Message, "supply the account name") > 0 and xSuccess = False Then
AddQ "/w " & psD2 & xLSuccess & " You need to give me a name to add."
xSuccess = True
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: Invalid user."
End If
If InStr(Message, "You already have the maximum") > 0 and xSuccess = False Then
If fmMsgs = True Then AddQ "/f m The bot list is full. " & Username & " could not be logged on!"
AddQ "/w " & psD2 & xLSuccess & " " & msLogFail
xSuccess = True
If sShowMessages = True Then AddChat vbRed, " -- ÿc5Baal Scriptÿc0: The friends list is full."
End If
If InStr(Message, "was not in your friends list") > 0 and xrSuccess = False Then
AddQ "/w " & psD2 & xrLSuccess & " " & msLogoutFail
xrSuccess = True
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: ÿc5" & xLSuccess & "ÿc0 was not logged in."
End If
If InStr(Message, "not logged on") < 0 and xrSuccess = False Then
xrSuccess = True
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: User was not connected to Battle.net."
End If
End Sub
Sub bcp_Event_UserTalk(Username, Flags, Message, Ping)
If Left(Message, 2 + Len(rcGetRuneInfo)) = BotVars.Trigger & rcGetRuneInfo & " " Then
GetDBEntry Username, Access, myAccess
If Access >= rcAccess Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
Exit Sub
End If
Next
If xTotalRuneData = 0 Then
AddQ "There are no runes loaded to reference."
Exit Sub
End If
rwr = Split(Message, BotVars.Trigger & rcGetRuneInfo & " ")(1)
For q = 0 to xTotalRuneData
If LCase(ri(0,q)) = LCase(rwr) Then
AddQ ri(0,q) & " [:] Weapon Effect: " & ri(1,q) & " [:] Armor (all) Effect: " & ri(2,q) & " [:] Level: " & ri(3,q)
Exit Sub
End If
Next
AddQ "Rune not found on the list."
End If
End If
If Left(Message, 2 + Len(rcGetRune)) = BotVars.Trigger & rcGetRune & " " Then
GetDBEntry Username, Access, myAccess
If Access >= rcAccess Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
If xTotalRunes = 0 Then
AddQ "There are no runewords loaded to reference."
Exit Sub
End If
rwr = Split(Message, BotVars.Trigger & rcGetRune & " ")(1)
For q = 0 to xTotalRunes
If InStr(LCase(rwl(2,q)), LCase(rwr)) > 0 Then
AddQ rwl(0,q) & " [:] " & rwl(1,q) & " [:] " & rwl(2,q)
Exit Sub
End If
Next
AddQ "Rune not found in a runeword."
End If
End If
If Left(Message, 2 + Len(rcGetWord)) = BotVars.Trigger & rcGetWord & " " Then
GetDBEntry Username, Access, myAccess
If Access >= rcAccess Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
If xTotalRunes = 0 Then
AddQ "There are no runewords loaded to reference."
Exit Sub
End If
rwr = Split(Message, BotVars.Trigger & rcGetWord & " ")(1)
For q = 0 to xTotalRunes
If InStr(LCase(rwl(0,q)), LCase(rwr)) > 0 Then
AddQ rwl(0,q) & " [:] " & rwl(1,q) & " [:] " & rwl(2,q)
Exit Sub
End If
Next
AddQ "Runeword not found."
End If
End If
If xActive = False Then Exit Sub
'// 0 = Name
'// 1 = Runs completed
'// 2 = Total seconds taken in games.
'// 3 = Last run completed date/time
If Message = BotVars.Trigger & cMyInfo Then
GetDBEntry Username, Access, MyAccess
If Access < cpAccess Then Exit Sub
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
For i = 0 to xTotalUsers + 1
If LCase(ul(0,i)) = LCase(Username) Then
exists = true
index = i
Exit For
End If
Next
If exists = True Then
ctime = ul(2,index) \ ul(1,index)
ctime = Int(ctime)
If ctime >= 60 Then
ctime = Int(ctime \ 60)
ctime = ctime & " minutes"
Else
ctime = ctime & " seconds"
End If
AddQ "You have done " & ul(1,index) & " runs, overall you average " & ctime & " per run. Last run: " & ul(3,index)
Else
AddQ "I couldn't find any information about you, " & Username & "."
End If
End If
If Left(Message, 1 + Len(acForceUserLogin)) = BotVars.Trigger & acForceUserLogin Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
targetuser = Split(Message, BotVars.Trigger & acForceUserLogin)(1)
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Attempting to force login ÿc5" & Username & "ÿc0..."
If fmMsgs = True Then AddQ "/f m " & targetuser & " logged in."
AddQ "/f a " & targetuser
End If
End If
If Message = BotVars.Trigger & cGetTop Then
AddQ "Top 5 runners: " & GetTopRunnersF(5)
End If
If Left(Message, 15) = BotVars.Trigger & "globalmessage " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
gmsg = Split(Message, BotVars.Trigger & "globalmessage ")(1)
AddQ "/f m Global Message (" & Username & "): " & gmsg
End If
End If
If Left(Message, 4) = BotVars.Trigger & "gm " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
gmsg = Split(Message, BotVars.Trigger & "gm ")(1)
AddQ "/f m Global Message (" & Username & "): " & gmsg
End If
End If
If Message = BotVars.Trigger & cLogin Then
GetDBEntry Username, Access, MyAccess
If Access < cpAccess Then Exit Sub
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
'// Check if they are flooding.
ldFound = False
For i = 0 to 500
If LCase(ld(0,i)) = LCase(Username) Then
ldFound = True
ldPos = i
Exit For
End If
Next
If ldFound = True Then
If Int(ld(1,ldPos)) < ldDelay Then
AddQ "/w " & psD2 & Username & " You must wait " & ldDelay - ld(1,ldPos) & " more minutes before logging in."
Exit Sub
End If
End If
If xSuccess = False Then
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: The bot is busy. Canceling request..."
xSuccess = True
AddQ "/w " & psD2 & Username & " " & msBusy
Exit Sub
End If
If Ping > urPing and urPing <> - 1 Then
AddQ "/w " & psD2 & Username & " " & msHighPing
Exit Sub
End If
allowed = false
For y = 0 to 500
If LCase(allq
) = LCase(Username) Then
allowed = true
Exit For
End If
Next
If allowed = false Then
AddQ "/w " & psD2 & Username & " " & msLogFail
Exit Sub
End If
xSuccess = False
xLSuccess = Username
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Attempting to login ÿc5" & Username & "ÿc0..."
AddQ "/f a " & Username
ResetUDelay Username
End If
If Message = BotVars.Trigger & cLogout Then
GetDBEntry Username, Access, MyAccess
If Access < cpAccess Then Exit Sub
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
If xrSuccess = False Then
xrSuccess = True
AddQ "/w " & psD2 & Username & " " & msBusy
Exit Sub
End If
xrSuccess = False
xrLSuccess = Username
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Attempting to logout ÿc5" & Username & "ÿc0..."
AddQ "/f r " & Username
End If
If Message = BotVars.Trigger & cRequire Then
GetDBEntry Username, Access, MyAccess
If Access < cpAccess Then Exit Sub
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
AddQ "/w " & psD2 & Username & " Login Requirements // Level: " & urLevel & " // Ping: " & urPing & " or less // Classes: " & urType
End If
If Message = BotVars.Trigger & acForceLogin Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Force logging ÿc5" & Username & "ÿc0..."
AddQ "/f a " & Username
If fmMsgs = True Then AddQ "/f m " & Username & " logged in."
End If
End If
If Message = BotVars.Trigger & cList Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
AddQ "/w " & psD2 & Username & " You are blacklisted. ( " & blu(1,y) & " )."
Exit Sub
End If
Next
If xAllowList = False Then
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: The bot is busy. Canceling request..."
AddQ "/w " & psD2 & Username & " Please wait " & GetTimeLeft("bcp", "absListTO") & " seconds before executing a command again. Flooding will result in a ban."
Exit Sub
End If
For h = 0 to 25
cl(0,h) = ""
cl(1,h) = ""
Next
ctotal = 0
xExecutee = Username
xGettingList = True
xAllowList = False
TimerInterval "bcp","absListTO", Int(lrDelay)
TimerEnabled "bcp","absListTO", True
AddQ "/f l"
If lrCompress = True Then
TimerEnabled "bcp","absCompression", True
End If
End If
If Message = BotVars.Trigger & cResetData Then
targetuser = Username
For q = 0 to xTotalUsers + 1
If LCase(ul(0,q)) = LCase(targetuser) Then
founduser = true
index = q
Exit For
End If
Next
If founduser = true Then
ul(1,index) = 0
ul(2,index) = 0
ul(3,index) = "*Never"
AddQ "/w " & psD2 & Username & " Your stats has been reset. Your runs record and time were erased."
Else
AddQ "/w " & psD2 & Username & " You aren't on the list to be deleted from."
End If
End If
If Left(Message, 1 + Len(acGetInfo)) = BotVars.Trigger & acGetInfo Then
GetDBEntry Username, Access, MyAccess
If Access < cpAccess Then Exit Sub
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
targetuser = Split(Message, BotVars.Trigger & acGetInfo & " ")(1)
For i = 0 to xTotalUsers + 1
If LCase(ul(0,i)) = LCase(targetuser) Then
founduser = true
index = i
Exit For
End If
Next
If founduser = true Then
ctime = ul(2,index) \ ul(1,index)
ctime = Int(ctime)
If ctime >= 60 Then
ctime = Int(ctime \ 60)
ctime = ctime & " minutes"
Else
ctime = ctime & " seconds"
End If
AddQ ul(0,index) & " has done " & ul(1,index) & " runs, overall averages " & ctime & " per run. Last run: " & ul(3,index)
Else
AddQ msNotFound
End If
End If
End If
If Message = BotVars.Trigger & acGetOver Then
GetDBEntry Username, Access, MyAccess
If Access < cpAccess Then Exit Sub
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
toprunnernum = 0
toprunner = "List not available."
totalusers = 0
totaltime = 0
totalruns = 0
For i = 0 to xTotalUsers + 1
If ul(0,i) <> "" Then
tvar = Int(ul(2,i))
rvar = Int(ul(1,i))
totaltime = totaltime + tvar
totalruns = totalruns + rvar
totalusers = totalusers + 1
If ul(1,i) > toprunnernum Then
toprunnernum = rvar
toprunner = ul(0,i)
End If
End If
Next
If totaltime >= 60 Then
totaltime = totaltime \ 60
totaltime = totaltime & " minutes"
Else
totaltime = totaltime & " seconds"
End If
AddQ "Total users: " & totalusers & " Total runs: " & totalruns & " Total time: " & totaltime
End If
End If
If Message = BotVars.Trigger & acToggle Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
If xActive = True Then
xActive = False
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: No longer active."
AddQ "ACC Baal Script by ConnectioN_LosT turned off."
Else
xActive = True
AddQ "ACC Baal Script by ConnectioN_LosT turned on."
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Now active."
End If
End If
End If
If Message = BotVars.Trigger & "updateprofile" Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
Call bcp_absUpdate_Timer
AddQ "Profile updated."
End If
End If
If Left(Message, 2 + Len(acForceLog)) = BotVars.Trigger & acForceLog & " " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
targetuser = Split(Message, BotVars.Trigger & acForceLog & " ")(1)
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Forcing the logout of " & targetuser & "."
AddQ "/f r " & targetuser
If fmMsgs = True Then AddQ "/f m " & xLSuccess & " logged out."
End If
End If
If Left(Message, 2 + Len(acBlacklist)) = BotVars.Trigger & acBlacklist & " " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
'// Get the variables we need from their command.
targetuser = Split(Message, BotVars.Trigger & acBlacklist & " ")(1)
targetuser = Split(targetuser, " ")(0)
targetreason = Split(Message, BotVars.Trigger & acBlacklist & " " & targetuser & " ")(1)
'// Make sure they aren't blacklisting themself.
If LCase(targetuser) = LCase(Username) Then
AddQ "/w " & psD2 & Username & " Why would you blacklist yourself?"
Exit Sub
End If
'// Make sure they arent blacklisting someone with more power then them.
GetDBEntry Username, Access, MyAccess
UA = Access
GetDBEntry targetuser, Access, MyAccess
TA = Access
If TA > UA Then
AddQ "/w " & psD2 & Username & " You can't blacklist a player with more bot-access then you."
Exit Sub
End If
'// Make sure they are not already blacklisted.
blacked = false
For r = 0 to xTotalBUsers
If LCase(targetuser) = LCase(blu(0,r)) Then
blacked = true
posi = r
Exit For
End If
Next
'// Using the info we gathered, do something.
If blacked = true Then
AddQ "/w " & psD2 & Username & " " & targetuser & " is already blacklisted."
Else
xTotalBUsers = xTotalBUsers + 1
blu(0,xTotalBUsers) = targetuser
blu(1,xTotalBUsers) = targetreason
AddQ "/w " & psD2 & Username & " " & blu(0,xTotalBUsers) & " is now blacklisted and cannot login or execute commands."
AddQ "/f r " & targetuser
End If
End If
End If
If Left(Message, 2 + Len(acBlacklistRemove)) = BotVars.Trigger & acBlacklistRemove & " " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
targetuser = Split(Message, BotVars.Trigger & acBlacklistRemove & " ")(1)
If LCase(targetuser) = LCase(Username) Then
AddQ "/w " & psD2 & Username & " You cannot remove yourself from the blacklist, nice try."
Exit Sub
End If
blacked = false
For r = 0 to xTotalBUsers
If LCase(targetuser) = LCase(blu(0,r)) Then
blacked = true
posi = r
Exit For
End If
Next
If blacked = true Then
blu(0,posi) = ""
AddQ "/w " & psD2 & Username & " " & targetuser & " was removed from the blacklist."
Else
AddQ "/w " & psD2 & Username & " " & targetuser & " is not blacklisted."
End If
End If
End If
End Sub
Sub bcp_Event_UserEmote(Username, Flags, Message)
End Sub
Sub bcp_Event_WhisperFromUser(Username, Flags, Message)
If Left(Message, 2 + Len(rcGetWord)) = BotVars.Trigger & rcGetWord & " " Then
GetDBEntry Username, Access, myAccess
If Access >= rcAccess Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
Exit Sub
End If
Next
If xTotalRunes = 0 Then
AddQ "/w " & psD2 & Username & " There are no runewords loaded to reference."
Exit Sub
End If
rwr = Split(Message, BotVars.Trigger & rcGetWord & " ")(1)
For q = 0 to xTotalRunes
If InStr(LCase(rwl(0,q)), LCase(rwr)) > 0 Then
AddQ "/w " & psD2 & Username & " [--] " & rwl(0,q) & " [--] Items: " & rwl(1,q) & " [--] Rune Order: " & rwl(2,q)
Exit Sub
End If
Next
AddQ "/w " & psD2 & Username & " Runeword not found on the list."
End If
End If
If Left(Message, 2 + Len(rcGetRune)) = BotVars.Trigger & rcGetRune & " " Then
GetDBEntry Username, Access, myAccess
If Access >= rcAccess Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
Exit Sub
End If
Next
If xTotalRunes = 0 Then
AddQ "/w " & psD2 & Username & " There are no runewords loaded to reference."
Exit Sub
End If
rwr = Split(Message, BotVars.Trigger & rcGetRune & " ")(1)
For q = 0 to xTotalRunes
If InStr(LCase(rwl(2,q)), LCase(rwr)) > 0 Then
AddQ "/w " & psD2 & Username & " [--] " & rwl(0,q) & " [--] Items: " & rwl(1,q) & " [--] Rune Order: " & rwl(2,q)
Exit Sub
End If
Next
AddQ "/w " & psD2 & Username & " Rune not found in a runeword on the list."
End If
End If
If Left(Message, 2 + Len(rcGetRuneInfo)) = BotVars.Trigger & rcGetRuneInfo & " " Then
GetDBEntry Username, Access, myAccess
If Access >= rcAccess Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
Exit Sub
End If
Next
If xTotalRuneData = 0 Then
AddQ "/w " & psD2 & Username & " There are no runes loaded to reference."
Exit Sub
End If
rwr = Split(Message, BotVars.Trigger & rcGetRuneInfo & " ")(1)
For q = 0 to xTotalRuneData
If LCase(ri(0,q)) = LCase(rwr) Then
AddQ "/w " & psD2 & Username & " [--] " & ri(0,q) & " [--] Weapon Effect: " & ri(1,q) & " [--] Armor (all) Effect: " & ri(2,q) & " [--] Level: " & ri(3,q)
Exit Sub
End If
Next
AddQ "/w " & psD2 & Username & " Rune not found on the list."
End If
End If
If xActive = False Then Exit Sub
If Message = BotVars.Trigger & "mytime" or Message = BotVars.Trigger & "runtime" or Message = "time" and xAllowGetTime = True Then
For y = 0 to xTotalBUsers
If LCase(Username) = LCase(blu(0,y)) Then
Exit Sub
End If
Next
TimerEnabled "bcp","absGetTimeCmdDelay", True
xAllowGetTime = False
Name = Username
onstopwatch = False
For x = 0 to 50
If LCase(Name) = LCase(s(0,x)) Then
onstopwatch = True
placement = x
Exit For
End If
Next
If onstopwatch = True Then
If s(2,placement) = True Then
sect = s(1,placement)
If sect >= 60 Then
runt = sect \ 60
If runt > swTimeout Then
AddQ "/w " & psD2 & Username & " Your game has taken " & runt & " minutes [" & sect & "s]. (you are overtime)"
Exit Sub
End If
AddQ "/w " & psD2 & Username & " Your game has taken " & runt & " minutes [" & sect & "s]. (you are not over or under time)"
Else
runt = sect & " seconds"
If sNoQuickies = True Then
AddQ "/w " & psD2 & Username & " Your game has taken " & runt & ". (you are undertime)"
Exit Sub
End If
End If
Else
AddQ "/w " & psD2 & Username & " You don't have any record on my stopwatch."
End If
End If
End If
'//===== ===== ===== =====
'//LANGUAGE SUPPORT
'//1.0
temp_holdforreplace = Message
If InStr(Message, "Diablo II Lord of Destruction") > 0 Then
'//Diablo II Lord of Destruction Only
'//I used Split instead of Mid in case the message varies.
'//If you've custom-made translations, post them for everyone else!
'//===== ===== ===== =====
'//FRENCH TRANSLATION>>>
If InStr(Message, " dans une partie ") > 0 and InStr(Message, "Votre ami ") > 0 Then
'//Votre ami [username] est entré dans une partie [product] nommée [game name].
temp_uname = Split(Message, " ami ")(1)
temp_uname = Split(temp_uname, " est ")(0)
temp_gn = Split(Message, "nommée ")(1)
Message = "Your friend " & temp_uname & " entered a Diablo II Lord of Destruction game called " & temp_gn
End If
'//SPANISH TRANSLATION>>>
If InStr(Message, " en una partida ") > 0 and InStr(Message, "Tu amigo ") > 0 Then
'//Tu amigo [username] ha entrado en una partida [product] llamada [game name].
temp_uname = Split(Message, " amigo ")(1)
temp_uname = Split(temp_uname, " ha")(0)
temp_gn = Split(Message, "llamada ")(1)
Message = "Your friend " & temp_uname & " entered a Diablo II Lord of Destruction game called " & temp_gn
End If
'//DEUTSCH TRANSLATION>>>
If InStr(Message, "-Spiel ") > 0 and InStr(Message, "Ihr Freund ") > 0 Then
'//Ihr Freund [username] hat sich in ein [product] -Spiel mit dem Namen [game name].
temp_uname = Split(Message, " Freund ")(1)
temp_uname = Split(temp_uname, " hat sich")(0)
temp_gn = Split(Message, "-Spiel mit dem Namen ")(1)
Message = "Your friend " & temp_uname & " entered a Diablo II Lord of Destruction game called " & temp_gn
End If
End If
'//===== ===== ===== =====
If InStr(Message, "Your friend ") > 0 and InStr(Message, "game called") > 0 Then
Name = Split(Message, "Your friend ")(1)
Name = Split(Name, " entered a")(0)
Game = Split(Message, "game called ")(1)
Game = Left(Game, Len(Game) - 1)
If sgActive = True Then
GameNameOk = False
gNames = Split(sgString, "|")
For Each gName in gNames
If InStr(LCase(Game), LCase(gName)) > 0 Then '// game contains proper word
GameNameOk = True
End If
Next
If GameNameOk = False Then
If Access < sgAvoid Then
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: ÿc5" & Username & "ÿc0 is not running a normal game... logging out."
AddQ "/f r " & Username
ResetUDelay Username
Exit Sub
End If
End If
End If
'// Stats
If LCase(xLastGame) <> LCase(Game) Then
For x = 0 to xTotalUsers + 1
If LCase(ul(0,x)) = LCase(Username) Then
exists = true
index = x
Exit For
End If
Next
If exists = True Then
ctime = ul(2,index)
ctime = Int(ctime)
If ctime >= 60 Then
ctime = Int(ctime \ 60)
ctime = ctime & "m"
Else
ctime = ctime & "s"
End If
ssString = ul(1,index) & " runs, " & ctime & " time"
Else
ssString = "No Data"
End If
Else
ssString = "OFlow"
End If
msg = msNewRun
msg = Replace(msg, "%n", Username)
msg = Replace(msg, "%g", Game)
msg = Replace(msg, "%ss", ssString)
If LCase(xLastGame) <> LCase(Game) Then AddQ msg
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: ÿc5" & Username & "ÿc0 has started a new run."
If swStopwatch = True Then
onstopwatch = False
For i = 0 to 50
If LCase(Name) = LCase(s(0,i)) Then
onstopwatch = True
placement = i
Exit For
End If
Next
If onstopwatch = False Then
For x = 0 to 50
If s(0,x) = "" Then
s(0,x) = Name
s(1,x) = 0
s(2,x) = True
Exit For
End If
Next
Else
s(1,placement) = 0
s(2,placement) = True
End If
xLastGame = Game
End If
End If
If InStr(Message, "Your friend ") > 0 and InStr(Message, "has exited") > 0 Then
GetDBEntry Username, Access, myAccess
If Access < lcAvoid and lcActive = True Then
If sShowMessages = True Then AddChat vbYellow, " -- ÿc5Baal Scriptÿc0: Forcing the logout of ÿc5" & Username & "ÿc0."
AddQ "/f r " & Username
ResetUDelay Username
End If
End If
If Left(Message, 15) = BotVars.Trigger & "globalmessage " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
gmsg = Split(Message, BotVars.Trigger & "globalmessage ")(1)
AddQ "/f m Global Message (" & Username & "): " & gmsg
End If
End If
If Left(Message, 4) = BotVars.Trigger & "gm " Then
GetDBEntry Username, Access, myAccess
If Access >= acAdminAccess Then
gmsg = Split(Message, BotVars.Trigger & "gm ")(1)
AddQ "/f m Global Message (" & Username & "): " & gmsg
End If
End If
End Sub
Sub bcp_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
Name = Username
onstopwatch = False
For i = 0 to 50
If LCase(Name) = LCase(s(0,i)) Then
onstopwatch = True
placement = i
Exit For
End If
Next
If onstopwatch = True Then
If s(2,placement) = True Then
s(2,placement) = False
sect = CStr(s(1,placement))
If sect >= 60 Then
runt = sect \ 60
If runt > swTimeout Then
AddQ "/w " & psD2 & Username & " Your last game took " & runt & " minutes. (overtime, unrecorded)"
Exit Sub
End If
runt = CStr(runt) & " minutes"
Else
runt = sect & " seconds"
If sNoQuickies = True Then
AddQ "/w " & psD2 & Username & " Your last game took " & runt & ". (undertime, unrecorded)"
Exit Sub
End If
End If
AddQ "/w " & psD2 & Username & " Your last game took " & runt & "."
inuserlist = false
For e = 0 to xTotalUsers + 1
If LCase(ul(0,e)) = LCase(Username) Then
inuserlist = true
userplace = e
Exit For
End If
Next
If inuserlist = true Then
ul(1,userplace) = ul(1,userplace) + 1
ul(2,userplace) = Int(ul(2,userplace)) + Int(sect)
ul(3,userplace) = Date & " - " & Time & sTimeZone
Else
xTotalUsers = xTotalUsers + 1
ul(0,xTotalUsers) = Username
ul(1,xTotalUsers) = 1
ul(2,xTotalUsers) = sect
ul(3,xTotalUsers) = Date & " - " & Time & " " & sTimeZone
End If
End If
End If
If xActive = False Then Exit Sub
If Product = "D2XP" or Product = "D2DV" Then
For z = 0 to 500
If LCase(allq(z)) = LCase(Username) Then
Exit Sub
End If
Next
If Level <> 0 Then
lev = Level
cha = Split(Message, CStr(lev) & " ")(1)
cha = Split(cha, " ")(0)
If sNLOnly = True Then
If InStr(Message, "a ladder") > 0 Then Exit Sub
If InStr(Message, "a hardcore") > 0 Then Exit Sub
End If
If Level < urLevel Then
Exit Sub
End If
Chars = Split(urType, "|")
TChars = 0
charexists = false
For Each Char in Chars
If LCase(cha) = LCase(Char) Then
charexists = true
End If
Next
If charexists = false Then
Exit Sub
End If
For w = 0 to 500
If LCase(allq(w)) = LCase(Username) Then
allq(w) = ""
End If
Next
For z = 0 to 500
If allq(z) = "" or LCase(allq(z)) = LCase(Username) Then
allq(z) = Username
Exit For
End If
Next
End If
End If
End Sub
Sub bcp_Event_UserLeaves(Username, Flags)
End Sub
Sub bcp_Event_FlagUpdate(Username, NewFlags, Ping)
End Sub
Sub bcp_Event_LoggedOn(Username, Product)
TimerEnabled "bcp","absUpdate", True
End Sub
Sub bcp_Event_UserInChannel(Username, Flags, Message, Ping, Product)
End Sub
Sub bcp_Event_ChannelJoin(ChannelName, Flags)
End Sub
Sub bcp_absUpdate_Timer()
If xTotalUsers = 0 Then Exit Sub
If xActive = False Then Exit Sub
If puActive = False Then Exit Sub
totalusers = 0
totaltime = 0
totalruns = 0
For i = 0 to xTotalUsers + 1
If ul(0,i) <> "" Then
tvar = Int(ul(2,i))
rvar = Int(ul(1,i))
totaltime = totaltime + tvar
totalruns = totalruns + rvar
totalusers = totalusers + 1
End If
Next
totalaveragetime = Int(totaltime \ totalruns)
If totaltime >= 3600 Then
totaltime = Int(totaltime \ 3600)
totaltime = totaltime & " hours"
End If
If Not InStr(totaltime, " hours") > 0 Then
If totaltime >= 60 Then
totaltime = Int(totaltime \ 60)
totaltime = totaltime & " minutes"
Else
totaltime = totaltime & " seconds"
End If
End If
If totalaveragetime >= 60 Then
totalaveragetime = Int(totalaveragetime \ 60)
totalaveragetime = totalaveragetime & " minutes"
Else
totalaveragetime = totalaveragetime & " seconds"
End If
pmsg = puPrefetch
pmsg = Replace(pmsg, "%newline", vbCrlLf)
pmsg = Replace(pmsg, "%0", BotVars.Username)
If pcData = "rnd" Then
Randomize
rndnum = Int(Rnd * 11)
Select Case rndnum
Case 1: pcd = "ÿc1"
Case 2: pcd = "ÿc2"
Case 3: pcd = "ÿc3"
Case 4: pcd = "ÿc4"
Case 5: pcd = "ÿc5"
Case 6: pcd = "ÿc8"
Case 7: pcd = "ÿc5"
Case 8: pcd = "ÿc9"
Case 9: pcd = "ÿc;"
Case 10: pcd = "ÿc+"
Case 11: pcd = "ÿc0"
Case Else: pcd = "ÿc0"
End Select
Else
pcd = pcData
End If
If puPrefetch <> "" Then
SetBotProfile "M", "Clan xNLG", puPrefetch & vbCrLf & pcTitle & "Total users: " & pcd & totalusers & vbCrLf & pcTitle & "Total runs: " & pcd & totalruns & vbCrLf & pcTitle & "Total time: " & pcd & totaltime & vbCrLf & pcTitle & "Top 3 runners: " & pcd & GetTopRunnersF(3)
Else
SetBotProfile "M", "Clan xNLG", pcTitle & "Total users: " & pcd & totalusers & vbCrLf & pcTitle & "Total runs: " & pcd & totalruns & vbCrLf & pcTitle & "Total time: " & pcd & totaltime & vbCrLf & pcTitle & "Top 3 runners: " & pcd & GetTopRunnersF(3)
End If
If sShowMessages = True Then AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Profile updated."
SavePlayerInfo
LoadPlayerInfo
End Sub
Sub bcp_absGetTimeCmdDelay_Timer()
TimerEnabled "bcp","GetTimeCmdDelay", False
xAllowGetTime = True
End Sub
Sub bcp_absCompression_Timer()
TimerEnabled "bcp","absCompression", False
If ctotal = 0 Then
AddQ msListFail
Exit Sub
End If
msgcircle = "Games: "
For i = 0 to ctotal
If cl(0,i) <> "" Then
msg = msGameReturn
vgame = cl(1,i)
vgame = Split(vgame, "(private)")(0)
msg = Replace(msg, "%n", cl(0,i))
msg = Replace(msg, "%g", vgame)
msg = Replace(msg, "%t", cl(2,i))
msgcircle = msgcircle & msg & lrSplitter
End If
Next
msgcircle = Left(msgcircle, Len(msgcircle) - Len(lrSplitter))
If lrIsWhispered = True Then
dsp 2, msgcircle, psD2 & xrLSuccess, ""
Else
dsp 1, msgcircle, "", ""
End If
End Sub
Sub bcp_absListTO_Timer()
xAllowList = True
TimerEnabled "bcp","absListTO", True
End Sub
Sub bcp_absUDelay_Timer()
For i = 0 to 500
ld(1,i) = ld(1,i) + 1
Next
End Sub
Sub bcp_absStopwatch_Timer()
If xActive = False Then Exit Sub
For i = 0 to 50
s(1,i) = s(1,i) + 1
If swMsgs = True Then
If s(1,i) = Int(swTimeout * 60) Then
If s(2,i) = True Then
AddQ "/w " & psD2 & s(0,i) & " Your game has taken more then " & swTimeout & " minutes, it won't be recorded."
End If
End If
End If
Next
End Sub
Sub bcp_Event_PressedEnter(Text)
If Left(Text, 2 + Len(acBlacklist)) = "/" & acBlacklist & " " Then
VetoThisMessage
targetuser = Split(Text, "/" & acBlacklist & " ")(1)
targetuser = Split(targetuser, " ")(0)
targetreason = Split(Text, "/" & acBlacklist & " " & targetuser & " ")(1)
blacked = false
For r = 0 to xTotalBUsers
If LCase(targetuser) = LCase(blu(0,r)) Then
blacked = true
posi = r
Exit For
End If
Next
If blacked = true Then
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: " & targetuser & " is already blacklisted."
Else
xTotalBUsers = xTotalBUsers + 1
blu(0,xTotalBUsers) = targetuser
blu(1,xTotalBUsers) = targetreason
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: " & blu(0,xTotalBUsers) & " is now blacklisted and cannot login or execute commands."
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Reason: " & targetreason
AddQ "/f r " & targetuser
End If
End If
If Left(Text, 2 + Len(acBlacklistRemove)) = "/" & acBlacklistRemove & " " Then
VetoThisMessage
targetuser = Split(Text, "/" & acBlacklistRemove & " ")(1)
blacked = false
For r = 0 to xTotalBUsers
If LCase(targetuser) = LCase(blu(0,r)) Then
blacked = true
posi = r
Exit For
End If
Next
If blacked = true Then
blu(0,posi) = ""
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: " & targetuser & " was removed from the blacklist."
Else
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: " & targetuser & " is not blacklisted."
End If
End If
If Text = "/showdata" Then
VetoThisMessage
ShowDataAsBox
End If
If Text = "/restartlist" Then
For u = 0 to xTotalUsers
ul(0,u) = ""
Next
SavePlayerInfo
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: All player info was erased."
End If
If Text = "/bcptoggle" Then
VetoThisMessage
If xActive = True Then
xActive = False
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: Off"
Else
xActive = True
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: On"
End If
End If
End Sub
Sub bcp_Event_KeyReturn(KeyName, KeyValue)
End Sub
Sub bcp_Event_Close()
If bloMessage <> "" Then
AddQ "/f m " & bloMessage
End If
SavePlayerInfo
SaveBannedPlayers
End Sub
Sub LoadPlayerInfo()
xTotalUsers = 0
xPath = BotPath() & fsName
If Not xFSO.FileExists(xPath) Then
Set xFile = xFSO.CreateTextFile(xPath)
AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Players info file created. Data will be written when you close your bot."
Exit Sub
End If
Set xFile = xFSO.OpenTextFile(xPath, 1)
If xFile.AtEndofStream = False Then
Lines = Split(xFile.ReadAll, vbCrLf)
xTotalUsers = 0
For Each Line in Lines
If Line <> "" and Left(Line, 1) <> ";" Then
If Not InStr(Line, "ô") > 0 Then
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: Corruption detected in the players file! Type /restartlist to make a new file."
xTotalUsers = 0
Exit Sub
End If
ul(0,xTotalUsers) = Split(Line, "ô")(0)
ul(1,xTotalUsers) = Split(Line, "ô")(1)
ul(2,xTotalUsers) = Split(Line, "ô")(2)
ul(3,xTotalUsers) = Split(Line, "ô")(3)
For r = 0 to 3
If ul(r,xTotalUsers) = "" Then
AddChat vbRed, " -- ÿc5Baal Scriptÿc0: Corruption detected in the players file! Type /restartlist to make a new file."
AddChat vbRed, " --ÿc5Corruption Noteÿc0: Column " & r & ", Row " & xTotalUsers & " (" & ul(0,xTotalUsers) & ")"
xTotalUsers = 0
Exit Sub
End If
Next
xTotalUsers = xTotalUsers + 1
End If
Next
End If
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Players info data file loaded, there are [ ÿc5" & xTotalUsers & "ÿc0 ] players present."
AddChat vbWhite, " -- ÿc5BCP Baal Script by ConnectioN_LosT (vi[r]us) --
OnxThexFly@Yahoo.com"
xFile.Close
End Sub
Sub SavePlayerInfo()
xPath = BotPath() & fsName
If xFSO.FileExists(xPath) Then xFSO.DeleteFile(xPath)
ConstructedString = "; This file holds player information." & vbCrLf & "; Reset it by typing /restartlist in your bot." & vbCrLf & vbCrLf
Set xFile = xFSO.OpenTextFile(xPath, 2, True)
For i = 0 to xTotalUsers
If ul(0,i) <> "" Then
ConstructedString = ConstructedString & ul(0,i) & "ô" & ul(1,i) & "ô" & ul(2,i) & "ô" & ul(3,i) & vbCrLf
End If
Next
xFile.WriteLine ConstructedString
xFile.Close
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Players data saved to disc."
End Sub
Sub LoadRuneList()
xTotalRunes = 0
xPath = BotPath() & fsRunes
If Not xFSO.FileExists(xPath) Then
AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Runeword list not found."
Exit Sub
End If
Set xFile = xFSO.OpenTextFile(xPath, 1)
If xFile.AtEndofStream = False Then
Lines = Split(xFile.ReadAll, vbCrLf)
xTotalRunes = 0
For Each Line in Lines
If Line <> "" and Left(Line, 1) <> ";" Then
rwl(0,xTotalRunes) = Split(Line, "^")(0)
rwl(1,xTotalRunes) = Split(Line, "^")(1)
rwl(2,xTotalRunes) = Split(Line, "^")(2)
xTotalRunes = xTotalRunes + 1
End If
Next
End If
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Runeword file loaded, there are [ ÿc5" & xTotalRunes & "ÿc0 ] runewords present."
xFile.Close
End Sub
Sub LoadBannedPlayers()
xTotalBUsers = 0
xPath = BotPath() & fsBlack
If Not xFSO.FileExists(xPath) Then
Set xFile = xFSO.CreateTextFile(xPath)
AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Players blacklist file created."
Exit Sub
End If
Set xFile = xFSO.OpenTextFile(xPath, 1)
If xFile.AtEndofStream = False Then
Lines = Split(xFile.ReadAll, vbCrLf)
xTotalBUsers = 0
For Each Line in Lines
If Line <> "" and Left(Line, 1) <> ";" Then
blu(0,xTotalBUsers) = Split(Line, "^")(0)
blu(1,xTotalBUsers) = Split(Line, "^")(1)
xTotalBUsers = xTotalBUsers + 1
End If
Next
End If
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Players blacklist file loaded, there are [ ÿc5" & xTotalBUsers & "ÿc0 ] players not allowed to login."
xFile.Close
End Sub
Sub SaveBannedPlayers()
xPath = BotPath() & fsBlack
If xFSO.FileExists(xPath) Then xFSO.DeleteFile(xPath)
Set xFile = xFSO.OpenTextFile(xPath, 2, True)
xFile.WriteLine "; This file holds all of the blacklisted players and the reason they are blacklisted." & vbCrLf
For i = 0 to xTotalBUsers
If blu(0,i) <> "" Then
xFile.WriteLine blu(0,i) & "^" & blu(1,i)
End If
Next
xFile.Close
If sShowMessages = True Then AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Blacklist saved to disc."
End Sub
Sub ResetUDelay(Username)
GetDBEntry Username, Access, MyAccess
If Access >= ldAccess Then Exit Sub
ldFound = False
For i = 0 to 500
If LCase(ld(0,i)) = LCase(Username) Then
ldFound = True
ldPos = i
Exit For
End If
Next
If ldFound = False Then
For x = 0 to 500
If ld(0,x) = "" Then
ld(0,x) = Username
ld(1,x) = 0
Exit For
End If
Next
Else
ld(1,ldPos) = 0
End If
End Sub
Sub ShowDataAsBox()
toprunnernum = 0
toprunner = "List not available."
totalusers = 0
totaltime = 0
totalruns = 0
For i = 0 to xTotalUsers + 1
If ul(0,i) <> "" Then
tvar = Int(ul(2,i))
rvar = Int(ul(1,i))
totaltime = totaltime + tvar
totalruns = totalruns + rvar
totalusers = totalusers + 1
If ul(1,i) > toprunnernum Then
toprunnernum = rvar
toprunner = ul(0,i)
End If
End If
Next
If totaltime >= 60 Then
totaltime = totaltime \ 60
totaltime = totaltime & " minutes"
Else
totaltime = totaltime & " seconds"
End If
begi = vbCrLf & "--Overall--" & vbCrLf & vbCrLf & "Total Users: " & totalusers & vbCrLf & "Total Time: " & totaltime & vbCrLf & "Total Runs: " & totalruns & vbCrLf & vbCrLf & "--Users--" & vbCrLf
For i = 0 to xTotalUsers
If ul(0,i) <> "" and ul(2,i) <> 0 Then
avgt = ul(2,i) \ ul(1,i)
avgt = Int(avgt)
If avgt >= 60 Then
avgt = Int(avgt \ 60)
avgt = avgt & " minutes"
Else
avgt = avgt & " seconds."
End If
If ul(2,i) >= 60 Then
totaltime = Int(ul(2,i) \ 60)
totaltime = totaltime & " minutes"
Else
totaltime = totaltime & " seconds"
End If
ulines = ulines & vbCrLf & "
Name: " & ul(0,i) & vbCrLf & "
Runs: " & ul(1,i) & vbCrLf & "
Total Time: " & totaltime & vbCrLf & "
Average Time: " & avgt & vbCrLf
End If
Next
AddChat vbGreen, begi & ulines
End Sub
Sub LoadRuneInfoList()
xTotalRuneData = 0
xPath = BotPath() & fsRuneInfos
If Not xFSO.FileExists(xPath) Then
AddChat vbCyan, " -- ÿc5Baal Scriptÿc0: Rune info list not found."
Exit Sub
End If
Set xFile = xFSO.OpenTextFile(xPath, 1)
If xFile.AtEndofStream = False Then
Lines = Split(xFile.ReadAll, vbCrLf)
xTotalRuneData = 0
For Each Line in Lines
If Line <> "" and Left(Line, 1) <> ";" Then
ri(0,xTotalRuneData) = Split(Line, "^")(0)
ri(1,xTotalRuneData) = Split(Line, "^")(1)
ri(2,xTotalRuneData) = Split(Line, "^")(2)
ri(3,xTotalRuneData) = Split(Line, "^")(3)
xTotalRuneData = xTotalRuneData + 1
End If
Next
End If
AddChat vbGreen, " -- ÿc5Baal Scriptÿc0: Rune info file loaded, there are [ ÿc5" & xTotalRuneData & "ÿc0 ] runes present."
xFile.Close
End Sub
Function GetTopRunnersF(TopPlayersCount)
Dim topNums, topNames, arrSave
ReDim topNums(TopPlayersCount)
ReDim topNames(TopPlayersCount)
ReDim arrSave(TopPlayersCount)
ReDim arrUL(3,1500)
'// Create a temp array we can mess up
For a = 0 to 1500
arrUL(0,a) = ul(0,a)
arrUL(1,a) = ul(1,a)
arrUL(2,a) = ul(2,a)
arrUL(3,a) = ul(3,a)
Next
'// Get top runners.
For j = 0 To TopPlayersCount - 1
tmp = 0
For x = 0 To xTotalUsers
If arrUL(0, x) <> "" Then
If Int(arrUL(1, x)) > Int(arrUL(1, tmp)) Then
tmp = x
End If
End If
Next
topnums(j) = Int(arrUL(1, tmp))
topnames(j) = arrUL(0, tmp)
arrSave(j) = tmp
arrUL(1, tmp) = -1
If topnums(j) <> -1 and topnames(j) <> "" Then
GetTopRunnersF = GetTopRunnersF & topnames(j) & "(" & topnums(j) & "), "
End If
Next
GetTopRunnersF = Left(GetTopRunnersF, Len(GetTopRunnersF) - 2)
End Function
also, dort ist auch baal qounter drinne
MfG
)