Гайды по Доте, Dota 2, стратегии и тактики Warcraft 3 Приветствую Вас Варкрафтер


Скрипт-Викторина для Stealth Bota

Главная | Регистрация | Вход | RSS
Меню сайта
Категории каталога
Создание карт [40]
Статьи о Battle.net [30]
GGC (Garena) [4]
Интервью с топ-игроками [64]
Юмор [29]
Разное [68]
Случайная статья
Начало игры против ночных эльфов (17)
[Альянс против эльфов]
Просмотров: 1707
Дата написания: 15.11.2005
Случайная картинка
Стрекоза

Топ статей
Карта гайдов по героям Доты (281)
[Гайды по героям]
Просмотров: 398543
Гайд по Снайперу (Dwarven Sniper) (172)
[Гайды по героям]
Просмотров: 170387
Гайд по Хускару (Huskar, The Sacred Warrior) (269)
[Гайды по героям]
Просмотров: 163574
Гайд по Войду (Faceless Void, Darkterror) (199)
[Гайды по героям]
Просмотров: 153497
Гайд по Урсе (Ursa Warrior) (120)
[Гайды по героям]
Просмотров: 140317
Гайд по Гуле (Лайфстилеру, Найксу) (77)
[Гайды по героям]
Просмотров: 136319
Гайд по Траксе (Traxex, Drow Ranger) (89)
[Гайды по героям]
Просмотров: 123371
Гайд по Баланару (Balanar, Night Stalker) (152)
[Гайды по героям]
Просмотров: 116664
Гайд по Legion Commander (Командиру легиона, Tresdin) (166)
[Гайды по героям]
Просмотров: 112715
Главная » Статьи » Различные статьи Warcraft 3 » Статьи о Battle.net


Скрипт-Викторина для Stealth Bota

' -=[ Trivia ]=- Flexx(rus) Edition
' Идея и изначально был написан raylu, содержал огромное число ошибок.
' Мне не удалось исправить большинство из них поэтому я решил переписать скрипт полностью.
'
' Версия 0.7 (25 декабря 2005 - 13 января 2006)
' Теперь Trivia останавливается автоматически, если бот был отключён от батлнета.
' Trivia останавливается, если на канале никого нету и запускается, когда кто-нибудь на него приходит (если была запущена до остановки).
' Теперь бот сохраняет настройки Trivia в фаиле config.ini (*)
' Настройки можно загрузить из фаила не перезапуская бота командой .reloadsettings
' Добавлена команда .arep [on/off], включающая (выключающая) автоповторение вопросов.
' Теперь каждой команде RusTrivia можно отдельно устанавливать свой доступ и флаги (используя access.ini)
' Теперь при пропуске вопроса бот говорит, какой был правильный ответ.
' Исправлена ошибка с командой .frp
' Из-за ненадобности убрана команда .writescores
' Внеснены некоторые изменения в работе с таймером, упрощающие внедрение других скриптов в RusTrivia.
' Видоизменён код, облегчающий внедрение других скриптов в RusTrivia сторонними разработчиками.
'* Автоматический перенос настроек с версии 0.6.1 не производится.
'
' Версия 0.6.1 (14 декабря 2005, 22-10)
' Исправлена ошибка, вызвывавшая сбой при сохранении/загрузке настроек скрипта.
'
' Версия 0.6 (6-14 декабря 2005)
' Исправлена ошибка с регистром пользователей. (спасибо berserker'y за то что сказал про неё и как исправить)
' Поправлены 2 мелкие ошибки, возникающие в режиме fast_question.
' Выполнена оптимизация кода обработки команд Trivia.
' Теперь бот сохраняет настройки Trivia в фаиле установленном в SettingsFileName и загружает их оттуда.
' Добавлена функция проверки обновления скрипта и получения новостей RusTrivia
' Добавлена команда .nextquestion, позволяющая пропускать текущий вопрос.
' Добавлена команда .hints <колличество подсказок>, показывающая или устанавливающая колличество подсказок.
' Добавлена команда .frp <время>, показывающая или устанавливыющая время реконнекта бота забаненного за флуд.
' Добавлена команда .total, показывающая колличество вопросов, которые бот задал с момена установки скрипта версии 0.6.
' Добавлена команда .trivianews, проверяющая обновления и получающая новости RusTrivia.
' Добавлена команда /sv, показывающая значения некоторых наиболее важных переменных. Команда доступна только из чат-окна бота.
' Директория с вопросами по умолчанию теперь директория бота.
' Теперь, заменив "." на "/", команды можно вводить не только с канала, но и из окна бота.
' Не требуется добавлять бота в список знакомых, чтобы управлять им из окна.
' Добавлен код, облегчающий доработку скрипта.
'
' Версия 0.5 (21-23 августа 2005)
' Добавлена команда .ahelp (показывает админские кломанды)
' Команда .help показывает только пользовательские команды
' Добавлены команды .pingmeenable и .pingmedisable
' Исправлены мелкие ошибки и баги
' Теперь бот будет делать реконнект, если был кикнут за флуд через время, установленное параметром flood_p_arec_time
'
' Версия 0.4 (30 июля 2005)
' Добавлена опция auto_repeat
' Исправлен баг с поиском вопросов
' Если пользователь послал личное сообщение брту то бот тоже ответит личным сообщением (на команды .trivia .triviarestart .top5)
' Добавлена команда .usercount (показывает сколько пользователей ответило на вопросы)
' Добавлена команда .file (выбор другого фаила с вопросами)
' Добавлена команда .filename (пишет текущее имя фаила с вопросами)
'
' Версия 0.3 (29 июля 2005)
' Теперь если все вопросы заданы Trivia будет остановлен. Для того чтобы начать сначала надо ввести .triviarestart
' Теперь если все символы ответа открыты подсказкой бот будет задавать новый вопрос
' После остановки и запуска скрипта командой .trivia вопросы не будут повторяться
' Добавлена команда .triviarestart
' Пофикшен небольшой баг с переменной timer_trigger
' Пофикшен баг с командами .rank .stats .score
'
' Версия 0.2 (28 июля 2005)
' Добавлены команды .help .top5 .rank .stats .score (.rank = .stats = .score)
' Теперь счёт будет сохраняться после каждго правильного ответа
' Исправлен баг когда бот мог посчитать неколько очков за 1 ответ и изза этого вылетал за флуд
' Исправлены небольшие баги
'
' Версия 0.1 (27 июля 2005)
' Скрипт полностью переписан
' Поправлен баг с сохранением и загрузкой счёта игроков (когда размер фаила становился =0 после перезапуска скрипта)
' Временно удалены команды (.file и .urank)
'
' Я не знаю как этот скрипт будет работать с Diablo и StarCraft. У меня нет этих игр.
' Оттестирован на WC3 TFT (c) Flexx(rus) || EMAIL: flexx_rus@mail.ru
' Бота можно часто найти на канале Frozen Throne rus-1
'
' Выражаю благодарность пользователям, которые помогали разрабатывать проект RusTrivia:
' batanik(n.n) - рассказал мне про существование Trivia, тестирование скрипта.
' berserker - тестирование скрипта, ошибка с регистром пользователей.
' Andreich - за 8000 русских вопросов к Trivia.
' И всем тем, кто пишет что-нето в гостевой книге и мне на мыло (относительно скрипта).
'
' [ВНИМАНИЕ] ЧТОБЫ УСТАНОВИТЬ СКРИПТ НАДО СОХРАНИТЬ ЭТОТ ФАИЛ БРАУЗЕРОМ В ПАПКУ С БОТОМ ПОД ИМЕНЕМ script.txt
'
'======================================================================================
' УПРАВЛЕНИЕ СКРИПТОМ:
'
' Введите .trivia чтобы запустить или остановить Trivia. Список заданных вопросов не будет очищен.
' .triviarestart чтобы запустить Trivia. Список заданных вопросов будет очищен!
' .top5 чтобы увидеть TOP 5 пользователей. (*)
' .rank чтобы увидеть на каком вы месте и сколько у вас очков. (*)
' .file чтобы изменить фаил с вопросами.
' .filename чтобы узнать имя текущего фаила с вопросами. (*)
' .nextquestion чтобы пропустить текущий вопрос.
' .pingmeenable чтобы разрешить публичный доступ к команде .pingme
' .pingmedisable чтобы запретить публичный доступ к команде .pingme
' .trivianews - загрузка новостей Trivia и проверка обновления
' .reloadsettings - загрузка настроек скрипта из config.ini
' .hints [n] чтобы посмотреть или установить колличество подсказок. (* - только для чтения) (**)
' .frp [time] - установка или просмотр времени (в минутах), через которое бот будет
' делать реконнект, если был кикнут за флуд. (* - только для чтения) (***)
'
' * К этим командам имеют доступ все пользователи.
' ** Изменение числа подсказок во время работы Trivia ведёт к пропуску текущего вопроса.
' *** Установка .frp в 0 отключает возможность автореконнекта.
'======================================================================================
' ПАРАМЕТРЫ И НАСТРОЙКИ:

'Путь к фаилам
ScoreFilePath = "scores.txt" 'фаил в который бот будет записывать ко-во набранных очков
QuestionFilesDir = "" 'директория фаилов с вопросами
QuestionFileName = "questions.txt" ' имя фаила с вопросами. Может быть изменено командой .file

'Доступ, необходимый, чтобы управлять скриптом Trivia
trivAccess = 50

'Флаг, необходимый, для управления Trivia по умолчанию
TriviaFlag = "T"

'Настройки таймера и подсказок
nHints = 4
timer_division = True 'Если "True" то время между подсказками будет равняться scTimer.Interval*2
fast_question = False 'Если "True" бот не будет ждать scTimer.Interval чтобы задать новый вопрос (не проверялось)
question_time_interval = 10100
auto_repeat = False 'Если "True" бот будет начинать снова повторять уже спрошенные вопросы, если "False" то остановится

'Колличество минут через которые бот будет делать реконнект, если он кикнут за флуд. Если =0 то опция отключена
flood_p_arec_time = 25

'Публичный доступ к команде .pingme, для пользователей с доступом 0
EnablePingMe = False

'Если True, то при перезапуске скрипта (Reload script) бот будет показывать текущие настройки
RelShowSettingsEnable = False

'======================================================================================
' Следующие функции предназначены для упрощения доработки скрипта.
' Вы можете их модифицировать, чтобы добавлять свои специфичные возможности.
'======================================================================================

dim send_to_whisper
' для формирования ответа пользователю используйте:
' AddQ send_to_whisper & "Ваше сообщение"
' send_to_whisper = vbNullString
' Тогда сообщение пойдёт тому, кто последний посылал боту в личку
'
' Сл. Код лезет в access.ini и проверяет имеет ли пользователь Username доступ к команде Command
' Если пользователь не найден в access.ini то происходит проверка по параметрам Need_access и Need_Flags
' Command - КОМАНДА (БЕЗ ТОЧКИ)
' Username - ИМЯ ПОЛЬЗОВАТЕЛЯ (Которого надо проверить)
' Need_access, Need_Flags - флаги и доступ по умолчанию.
' if Verify_User_Command(Command, Username, Need_access, Need_Flags) = 1 Then
' <Выполняем необходимые действия>
' end if

' когда бот загружается или Reload Script
Sub Load_Event()
End Sub

' вызывается, когда ктонибудь на канале что-то говорит
Sub UserTalk_Event(Username, Flags, Message, Ping)
end sub

' вызывается, когда боту шлют личное сообщение
Sub WhisperFromUser_Event(Message, Username, Flags)
end sub

' вызывается, когда пользователь говорит через /emote
Sub UserEmote_Event(Username, Flags, Message)
End Sub

' когда пользователь приходит на канал
Sub UserJoins_Event(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
End Sub

' когда пользователь уходит с канала
Sub UserLeaves_Event(Username, Flags)
End Sub

' Пользовательский таймер. Вызывается каждые Timer2_Interval миллисекунд
Timer2_Interval = -1 'в миллисекундах, если меньше 0 то отключён
Sub Timer_event
End sub

' когда бот подключился к каналу
Sub ChannelJoin_Event(ChannelName, Flags)
End Sub

' когда приложение бота закрывается, функция вызывается после сохранения настроек RusTrivia
Sub Close_Event()
End Sub

' Fires once for each user in the channel upon joining a channel.
Sub UserInChannel_Event(Username, Flags, Message, Ping, Product)
End Sub

' Fires after a successful login.
Sub LoggedOn_Event(Username, Product)
End Sub

' Когда пользователь набал что-то в строке бота и нажал Enter
Sub PressedEnter_Event(Text)
end Sub

' Вызвыается, когда бот получает информацию о профаиле с сервера. KeyName может быть следующим:
' Profile\Sex
'Profile\Location
'Profile\Description
' KeyValue содержит значение в виде строки
Sub Event_KeyReturn(KeyName, KeyValue)
End Sub

Sub FlagUpdate_Event(Username, NewFlags, Ping)
End Sub

' Бот отключён от Battle.net
Sub LoggedOff_Event()
end Sub

'======================================================================================
' !!! НЕ РЕДАКТИРУЙТЕ ТО, ЧТО ИДЁТ ДАЛЬШЕ !!!
'======================================================================================

dim flood_rec_time, w_trivia, settings_loaded, current_time_interval, tmr_2_counter, D2s
set fso = CreateObject("Scripting.FileSystemObject")
dim is_administrator

' Trivia часть скрипта
'question(10000), answer(10000), asked(10000) << числа в скобках должны быть равны переменной max_lines!
dim lines_num, question(10000), answer(10000), asked(10000) 'questions and answers
public const max_lines=10000
'hscores_users(500), hscores_scores(500) << числа в скобках должны быть равны переменной hscores_maxcount!
dim hscores_users(500), hscores_scores(500)
public const hscores_maxcount=500
dim trivia_enabled, score, rank_maxbnd, old_file_name, questions_asked_count
dim hints, current_hint, current_answer, current_answer2, timer_trigger, no_hears_stopped
set score = CreateObject("Scripting.Dictionary")
'debug : show addition information to find FUCKING errors
public const EnableDebugMessages=False
private const CurrentVersion = "0.7"
Ndsvt = "TriviaRemoteTester"
' only for debuging script
Sub debug_log(msg)
if EnableDebugMessages then
AddChat vbCyan, "DEBUG: " & msg
end if
end sub

' Fires when script loaded (reloaded)
Sub Event_Load()
call Load_Event()
questions_asked_count = 0
AddChat vbCyan, "-=[ TRIVIA ]=- Flexx(rus) Edition (version " & CurrentVersion & ")"
AddChat vbCyan, "Обновлённую версию скрипта, а также вопросы можно найти на сайте: http://www.rustrivia.nm.ru"
AddChat vbCyan, "Сообщить об ошибке: mailto:Flexx_rus@mail.ru"
' AddChat vbCyan, "Заходите на канал Clan Yeah! Всегда рады вас видеть!"
if GetBotVersion() <> "StealthBot v2.6" Then
AddChat vbred, "ВНИМИАНИЕ: RusTrivia скрипт v" & CurrentVersion & " разрабатывался под StealthBot v2.6, у вас " & GetBotVersion()
end if
call Load_Settings
AddChat vbYellow, "Интервал вопросов: " & question_time_interval/1000 & " сек."
if timer_division then
AddChat vbYellow, "Интервал подсказок: " & question_time_interval*2/1000 & " сек."
Else
AddChat vbYellow, "Интервал подсказок: " & question_time_interval/1000 & " сек."
end if
score.comparemode = vbTextCompare
Ndsvt="Flexx(rus)"
trivia_enabled = False
flood_rec_time = 0
w_trivia = False
hints = -1
tmr_2_counter = 0
timer_trigger = False
EnablePingMe = False
no_hears_stopped = False
lines_num = 0
call Load_Scores
AddChat vbGreen, "Счёт заружен из фаила: " & ScoreFilePath & " и содержит " & score.Count & " пользователей."
call Load_Questions
call Update_Rank
call resetTriviaTimer
scTimer.Interval = 200
scTimer.Enabled = True
if RelShowSettingsEnable then call Show_Settings end if
call GetRusTriviaNews
End Sub

Sub Show_Settings
AddChat vbYellow, "Текущие переменные:"
AddChat vbGreen, "QuestionFilesDir=" & QuestionFilesDir
AddChat vbGreen, "QuestionFileName=" & QuestionFileName
AddChat vbGreen, "trivAccess=" & trivAccess
AddChat vbGreen, "nHints=" & nHints
AddChat vbGreen, "TimerDivision=" & timer_division
AddChat vbGreen, "FastQuestion=" & fast_question
AddChat vbGreen, "AutoRepeat=" & auto_repeat
AddChat vbGreen, "FloodProtectionTime=" & flood_p_arec_time
end Sub

' vbOrange vbRed vbGreen vbCyan vbWhite

private sub GetRusTriviaNews()
AddChat vbGreen, "Попытка получения новостей RusTrivia и проверки наличия обновления..."
scinet.Cancel
if scinet.StillExecuting = True Then
AddChat vbRed, "Произошла ошибка, проверьте обновление вручную. http://www.rustrivia.nm.ru"
exit sub
end if
arrbytes = scinet.openurl("http://www.rustrivia.nm.ru/upnews.txt")
if arrbytes = vbnullString Then
AddChat vbRed, "Произошла ошибка, возможно сервер новостей в данный момент недоступен или компьютер не подключён к Интернету."
exit Sub
end if
set objwritefile = fso.opentextfile("TriviaNews.tmp", 2, true)
objwritefile.write(arrbytes)
objwritefile.close
set nf = fso.opentextfile("TriviaNews.tmp", 1, true)
u_version = nf.ReadLine
if u_version <> vbNullString then
if CurrentVersion <> u_version Then
AddChat vbred, "Найдено обновление до версии " & u_version & "! Зайдите на http://www.rustrivia.nm.ru чтобы скачать его."
else
AddChat vbGreen, "Обновлений не найдено."
end if
if nf.AtEndOfStream <> True Then
AddChat vbBlue, "**********************************************************"
Do While nf.AtEndOfStream <> True
AddChat vbCyan, nf.ReadLine
Loop
AddChat vbBlue, "**********************************************************"
end if
end if
nf.Close
end sub

Sub Send_User_Rank(Username)
dim i, user_found
call Update_Rank

user_found = False
for i = 0 to rank_maxbnd
if hscores_users(i) = username then
AddQ "/w " & D2s & Username & " Вы " & i+1 & "/" & score.Count & " в пиздистике. У вас " & hscores_scores(i) & " пиздюлей, которые тебе навешает БОТ.",1
user_found = True
exit for
end if
next
if user_found = False then
AddQ "/w " & D2s & Username & " Вы не попали в пиздистику. Тебе надают 0 пиздюлей.",1
end if
End Sub

Sub Top5
dim t5, t5line
call Update_Rank

t5 = 4
if t5>rank_maxbnd then
t5 = rank_maxbnd
end if

t5line = "TOP 5 USERS: "
for i = 0 to t5
t5line = t5line & hscores_users(i) & " [" & hscores_scores(i)& "] "
next
AddQ send_to_whisper & t5line
send_to_whisper = vbNullString
end sub

Sub Update_Rank
dim i, j, pts, plyrs, sctemp, unmtemp
pts = score.Items 'score
plyrs = score.Keys 'users

rank_maxbnd = hscores_maxcount
if rank_maxbnd>UBound(plyrs) then
rank_maxbnd = UBound(plyrs)
end if

for i = 0 to rank_maxbnd
hscores_users(i) = plyrs(i)
hscores_scores(i) = CInt(pts(i))
next

'sorting rank
for i = 0 to rank_maxbnd
for j = i to rank_maxbnd
if hscores_scores(i) < hscores_scores(j) then
sctemp = hscores_scores(i)
unmtemp = hscores_users(i)
hscores_scores(i) = hscores_scores(j)
hscores_users(i) = hscores_users(j)
hscores_scores(j) = sctemp
hscores_users(j) = unmtemp
end if
next
next
end sub

Sub Save_Settings
call WriteConfigEntry("Trivia","QuestionFilesDir", QuestionFilesDir, "config.ini")
call WriteConfigEntry("Trivia","QuestionFileName", QuestionFileName, "config.ini")
call WriteConfigEntry("Trivia","trivAccess", trivAccess, "config.ini")
call WriteConfigEntry("Trivia","nHints", nHints, "config.ini")
call WriteConfigEntry("Trivia","TimerDivision", timer_division, "config.ini")
call WriteConfigEntry("Trivia","FastQuestion", fast_question, "config.ini")
call WriteConfigEntry("Trivia","AutoRepeat", auto_repeat, "config.ini")
call WriteConfigEntry("Trivia","FloodProtectionTime", flood_p_arec_time, "config.ini")
call WriteConfigEntry("Trivia","TotalAsked", questions_asked_count, "config.ini")
end Sub

Function Str2Bool(bs2)
if LCase(bs2) = "true" Then
Str2Bool = True
else
Str2Bool = False
end if
end Function

Sub Load_Settings
if IsNumeric(GetConfigEntry("Trivia", "trivaccess", "config.ini")) Then
trivAccess = Int(GetConfigEntry("Trivia", "trivaccess", "config.ini"))
end if
if IsNumeric(GetConfigEntry("Trivia", "nhints", "config.ini")) Then
nHints = Int(GetConfigEntry("Trivia", "nhints", "config.ini"))
end if
if IsNumeric(GetConfigEntry("Trivia", "floodprotectiontime", "config.ini")) Then
flood_p_arec_time = Int(GetConfigEntry("Trivia", "floodprotectiontime", "config.ini"))
end if
if IsNumeric(GetConfigEntry("Trivia", "totalasked", "config.ini")) Then
questions_asked_count = Int(GetConfigEntry("Trivia", "totalasked", "config.ini"))
end if
QuestionFileName = GetConfigEntry("Trivia", "questionfilename", "config.ini")
timer_division = Str2Bool(GetConfigEntry("Trivia", "timerdivision", "config.ini"))
fast_question = Str2Bool(GetConfigEntry("Trivia", "fastquestion", "config.ini"))
auto_repeat = Str2Bool(GetConfigEntry("Trivia", "autorepeat", "config.ini"))
QuestionFilesDir = GetConfigEntry("Trivia", "questionfilesdir", "config.ini")
settings_loaded = True
End Sub

Sub Load_Scores
debug_log("Load_Scores.begin")
Dim score_file, read_string, cLine
Set score_file = fso.OpenTextFile(ScoreFilePath, 1, True)
Do While score_file.AtEndOfStream <> True
read_string = score_file.ReadLine
cLine = Split(read_string, "|")
If score.Exists(cLine(0)) Then
score.Item(Username) = score.Item(Username) + Int(cLine(1))
AddChat vbRed, "Исправлен пользователь: " & cLine(0) & " (автоисправление бага с повторяющимися пользователями)."
Else
score.Add cLine(0), cLine(1)
End If
Loop
score_file.Close
debug_log("Load_Scores.end")
End Sub

Sub Load_Questions
debug_log("Load_Questions.begin")
Dim triv_File, read_string, cLine
AddChat vbGreen, "Загрузка вопросов из фаила: " & QuestionFilesDir & QuestionFileName
If Not fso.FileExists(QuestionFilesDir & QuestionFileName) Then
AddChat vbRed, "Ошибка! Фаил с вопросами не найден! Проверьте параметры QuestionFilesDir и QuestionFileName в фаиле " & SettingsFileName & "!"
QuestionFileName = old_file_name
AddQ send_to_whisper & "Ошибка! Фаил с вопросами не найден!" ,1
send_to_whisper = vbNullString
Exit Sub
End If

Set triv_File = fso.OpenTextFile(QuestionFilesDir & QuestionFileName, 1, True)
lines_num = 0
Do While triv_File.AtEndOfStream <> True
read_string = triv_File.ReadLine
cLine = Split(read_string, "*")
If UBound(cLine) >= 1 Then
question(lines_num) = cLine(0)
answer(lines_num) = cLine(1)
lines_num = lines_num + 1
if lines_num>max_lines then
AddChat vbRed, "Слишком много строк в фаиле с вопросами! Проверьте параметры [question, answer, max_lines, asked] в скрипте!"
AddChat vbGreen, "Загружено " & lines_num-1 & " вопросов!"
triv_File.Close
for i = 0 to lines_num
asked(i) = False
next
Exit Sub
end if
Else
AddChat vbRed, "Символ * не найден в строке после " & lines_num & " строки. Строка с ненайденным символом пропущена!"
End if
Loop
triv_File.Close
if lines_num<>0 Then
AddQ send_to_whisper & "Загружено " & lines_num-1 & " вопросов!" ,1
send_to_whisper = vbNullString
end if
for i = 0 to lines_num
asked(i) = False
next
AddChat vbGreen, "Заряжено " & lines_num-1 & " пиздюлей!"
Debug_log("Load_Questions.end")
End Sub

Sub Save_Scores
Dim score_file, sList, cUser
debug_log("Save_Scores.begin")

if score.Count = 0 Then
exit sub
end if

sList = score.Keys
Set score_file = fso.OpenTextFile(ScoreFilePath, 2, True)
For i=0 to UBound(sList)
cUser = sList(i)
score_file.WriteLine cUser & "|" & score.Item(cUser)
Next
score_file.Close
AddChat vbGreen, "Пиздюли был сохранёны!"
debug_log("Save_Scores.end")
End Sub

Sub Event_ServerInfo(Message)
' AddChat vbGreen, "Event_ServerInfo: " & Message
if (Message = "No one hears you.") and (trivia_enabled = True) Then
trivia_enabled = False
hints = -1
timer_trigger = False
AddChat vbGreen, "Викторина остановлена, так как на канале нету пользователей"
no_hears_stopped = True
end if
End Sub

Sub Event_ServerError(Message)
if LCase(Message) = LCase("You have been disconnected for flooding.") then
if flood_p_arec_time > 0 then
flood_rec_time = (flood_p_arec_time * 60 * 1000) / scTimer.Interval - 1
AddChat vbGreen,"Бот был забанен по IP за флуд на канале. Не принимайте меры по его подключению к серверу. Он сделает это сам через " & flood_p_arec_time & " минут."
w_trivia = trivia_enabled
trivia_enabled = False
end if
end if
' AddChat vbGreen, "Event_ServerError: " & Message
End Sub

Sub Event_UserTalk(Username, Flags, Message, Ping)
call UserTalk(Username, Flags, Message, Ping)
call UserTalk_Event(Username, Flags, Message, Ping)
End Sub

' 1 - have need access or flags
' 0 - have not access or flags
Function Verify_User_Command(Command, Username, Need_access, Need_Flags)
GetDBEntry Username, UserAccess, UserFlags
debug_log("1")
if Username = MyUsername Then
Verify_User_Command = 1
exit Function
end if
debug_log("2")
If LCase(UserFlags) = "a" Then
Verify_User_Command = 1
exit Function
end if
debug_log("3")
p_flag = GetConfigEntry("Flags",Command,"access.ini")
If (LCase(UserFlags) = LCase(p_flag)) and (p_flag<>vbNullString) Then
Verify_User_Command = 1
exit Function
end if
debug_log("4")
If (LCase(UserFlags) = LCase(Need_Flags)) and (Need_Flags<>vbNullString) Then
Verify_User_Command = 1
exit Function
end if
debug_log("5")
p_access = GetConfigEntry("Numeric",Command,"access.ini")
if IsNumeric(p_access) Then
if UserAccess >= Int(p_access) Then
Verify_User_Command = 1
exit Function
else
Verify_User_Command = 0
exit Function
end if
end if
debug_log("6")
if UserAccess >= Int(Need_access) Then
Verify_User_Command = 1
exit Function
end if
Verify_User_Command = 0
end Function

Sub UserTalk(Username, Flags, Message, Ping)
dim i
debug_log("Event_UserTalk.begin")
' if LCase(Message) = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl" Then
' exit sub
' end if

if trivia_enabled = True then
If LCase(Message) = LCase(current_answer) Then
If score.Exists(Username) Then
score.Item(Username) = score.Item(Username) + 1
Else
score.Add Username, 1
End If
AddQ "/me " & Username & " отгадал Он Задрот и за это он получит пиздюлей! Ответ на этот ебливый вопрос был: " & current_answer & ". Его хотят отпиздить: " & score.Item(Username) & " человек.",1
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl" 'bug with scores fix
call Save_Scores
call resetTriviaTimer
hints = -1
if fast_question Then
call Trivia_Time
exit sub
end if
End If

If Message = BotVars.Trigger & "nextquestion" Then
If Verify_User_Command("nextquestion", Username, trivAccess, TriviaFlag) = 1 Then
AddQ "/me Вопрос пропущен и никто не получит пиздюлей. Ответ на этот ебливый вопрос был: " & current_answer
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl"'bug with scores fix
hints = -1
timer_trigger = False
end if
exit sub
end if
End If

if Mid(Message, 1,1) <> BotVars.Trigger Then
exit sub
end if

if Message = BotVars.Trigger & "pingme" Then
if EnablePingMe then
If myAccess < 20 Then
AddQ send_to_whisper & " " & Username & " your ping at login was " & Ping & " GL&HF!"
send_to_whisper = vbNullString
exit sub
end if
end if
end if

If Message = BotVars.Trigger & "trivia" Then
If Verify_User_Command("trivia", Username, trivAccess, TriviaFlag) = 1 Then
If trivia_enabled Then
trivia_enabled = False
hints = -1
timer_trigger = False
AddQ send_to_whisper & "Раздача пиздюлей остановлена! Введите " & BotVars.Trigger & "trivia чтобы запустить. (Нужно иметь " & trivAccess & " доступа)",1
send_to_whisper = vbNullString
Else
if lines_num = 0 then
AddQ send_to_whisper & "Не удалось запустить Trivia так как вопросы не были загружены! Загрузите вопросы и введите " & BotVars.Trigger & "trivia Для запуска. (Нужно иметь " & trivAccess & " доступа)",1
exit sub
end if
trivia_enabled = True
hints = -1
call resetTriviaTimer
AddQ send_to_whisper & "Trivia запущен! Ввведите " & BotVars.Trigger & "trivia чтобы остановить. (Нужно иметь " & trivAccess & " доступа)",1
send_to_whisper = vbNullString
if fast_question Then
call Trivia_Time
end if
End If
End If
Exit Sub
End If

if Message = BotVars.Trigger & "triviarestart" then
If Verify_User_Command("triviarestart", Username, trivAccess, TriviaFlag) = 1 Then
if lines_num = 0 then
AddQ send_to_whisper & "Не удалось запустить Trivia так как вопросы не были загружены! Загрузите вопросы и введите " & BotVars.Trigger & "trivia Для запуска. (Нужно иметь " & trivAccess & " доступа)",1
exit sub
end if
for i = 0 to max_lines
asked(i) = False
next
call resetTriviaTimer
hints = -1
if trivia_enabled = False then
trivia_enabled = True
end if
AddQ send_to_whisper & "Перепижен! Список пиздюлей очищен!",1
send_to_whisper = vbNullString
if fast_question Then
call Trivia_Time
exit sub
end if
end if
exit sub
end if

If Message = BotVars.Trigger & "help" Then
If Verify_User_Command("help", Username, -100, TriviaFlag) = 1 Then
AddQ send_to_whisper & "Пользовательские команды: " & BotVars.Trigger & "Zadrot5 " & BotVars.Trigger & "rankzadrot " & BotVars.Trigger & "usercount " & BotVars.Trigger & "filename " & BotVars.Trigger & "ahelp",1
send_to_whisper = vbNullString
end if
exit sub
End If

If Message = BotVars.Trigger & "ahelp" Then
If Verify_User_Command("ahelp", Username, -100, TriviaFlag) = 1 Then
AddQ send_to_whisper & "Админские команды: " & BotVars.Trigger & "trivia " & BotVars.Trigger & "triviarestart " & BotVars.Trigger & "file",1
send_to_whisper = vbNullString
end if
exit sub
End If

If (Message = BotVars.Trigger & "score") or (Message = BotVars.Trigger & "zadrotrank") or (Message = BotVars.Trigger & "stats") Then
If (Verify_User_Command("score", Username, -100, TriviaFlag) = 1) or (Verify_User_Command("zadrotrank", Username, -100, TriviaFlag) = 1) or (Verify_User_Command("stats", Username, -100, TriviaFlag) = 1) Then
call Send_User_zadrotRank(Username)
exit sub
end if
End If

If Message = BotVars.Trigger & "zadrot5" Then
If Verify_User_Command("zadrot5", Username, -100, TriviaFlag) = 1 Then
call Zadrot5
end if
exit sub
End If

If Message = BotVars.Trigger & "usercount" Then
If Verify_User_Command("usercount", Username, -100, TriviaFlag) = 1 Then
AddQ send_to_whisper & "На вопросы ответило " & score.Count & " пользователей!" ,1
send_to_whisper = vbNullString
end if
exit sub
End if

If Message = BotVars.Trigger & "pingmeenable" Then
If Verify_User_Command("pingmeenable", Username, trivAccess, TriviaFlag) = 1 Then
EnablePingMe = True
AddQ send_to_whisper & "Команда " & BotVars.Trigger & "pingme включена для общего доступа!",1
send_to_whisper = vbNullString
End if
exit sub
End If

If Message = BotVars.Trigger & "pingmedisable" Then
If Verify_User_Command("pingmedisable", Username, trivAccess, TriviaFlag) = 1 Then
EnablePingMe = Flase
AddQ send_to_whisper & "Команда " & BotVars.Trigger & "pingme отключена для общего доступа!",1
send_to_whisper = vbNullString
End if
exit sub
End If

if Message = BotVars.Trigger & "filename" Then
AddQ send_to_whisper & "Имя фаила с вопросами: " & QuestionFileName,1
exit sub
end if

If Message = BotVars.Trigger & "reloadsettings" Then
If Verify_User_Command("reloadsettings", Username, trivAccess, TriviaFlag) = 1 Then
call Load_Settings
AddQ send_to_whisper & "Настойки перезагружены!",1
send_to_whisper = vbNullString
End if
exit sub
End If

if Message = BotVars.Trigger & "trivianews" Then
If Verify_User_Command("trivianews", Username, trivAccess, TriviaFlag) = 1 Then
call GetRusTriviaNews
end if
exit sub
end if

If Left(Message, 5) = BotVars.Trigger & "file" Then
If Verify_User_Command("file", Username, trivAccess, TriviaFlag) = 1 Then
old_file_name = QuestionFileName
QuestionFileName = Mid(Message, 7)
call Load_Questions
call Save_Settings
end if
exit sub
end if

If Left(Message, 5) = BotVars.Trigger & "arep" Then
if Mid(Message, 7) = vbNullString Then
if auto_repeat Then
AddQ send_to_whisper & "После того как вопросы закончатся бот будет повторять их снова.",1
else
AddQ send_to_whisper & "После того как вопросы закончатся бот остановится.",1
end if
exit sub
end if
If Verify_User_Command("arep", Username, trivAccess, TriviaFlag) = 1 Then
if LCase(Mid(Message, 7)) = "on" Then
auto_repeat = True
AddQ send_to_whisper & "Автоповторение вопросов включено.",1
end if
if LCase(Mid(Message, 7)) = "off" Then
auto_repeat = True
AddQ send_to_whisper & "Автоповторение вопросов выключено.",1
end if
call Save_Settings
end if
exit sub
end if

If Left(Message, 6) = BotVars.Trigger & "hints" Then
if Mid(Message, 8) = vbNullString Then
AddQ send_to_whisper & "Колличество подсказок: " & nHints,1
exit sub
end if
If Verify_User_Command("hints", Username, trivAccess, TriviaFlag) = 1 Then
if IsNumeric(Mid(Message, 8)) then
if Int(Mid(Message, 8)) > 0 then
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl"
hints = -1
timer_trigger = False
nhints = Int(Mid(Message, 8))
AddQ "/me Вопрос пропущен, так как было изменено колличество подсказок."
AddQ send_to_whisper & "Колличество подсказок: " & nHints,1
end if
end if
end if
exit sub
end if

If Left(Message, 4) = BotVars.Trigger & "frp" Then
if Mid(Message, 6) = vbNullString Then
AddQ send_to_whisper & "Floodbanned reconnect time is " & flood_p_arec_time & " min.", 1
exit sub
end if
If Verify_User_Command("frp", Username, trivAccess, TriviaFlag) = 1 Then
if IsNumeric(Mid(Message, 6)) then
flood_p_arec_time = Int(Mid(Message, 6))
AddQ send_to_whisper & "Floodbanned reconnect time set to " & flood_p_arec_time & " min.",1
call Save_Settings
end if
end if
exit sub
end if

if Message = BotVars.Trigger & "total" Then
AddQ send_to_whisper & "С момента установки скрипта версии 0.7 бот задал " & questions_asked_count & " вопросов!",1
call Save_Settings
exit sub
end if
call debug_DTAD(Username, Message)
debug_log("Event_UserTalk.end")
End Sub

Sub Event_UserEmote(Username, Flags, Message)
call UserEmote_Event(Username, Flags, Message)
End Sub

Sub Event_WhisperFromUser(Username, Flags, Message)
send_to_whisper = "/w " & D2s & Username & " "
Call UserTalk(Username, Flags, Message, 0)
call WhisperFromUser_Event(Username, Flags, Message)
send_to_whisper = vbNullString
End Sub

Sub Event_FlagUpdate(Username, NewFlags, Ping)
if Username = MyUsername Then
If NewFlags And 2 Then
is_administrator = True
AddChat vbRed, "Бот может администрировать канал."
else
is_administrator = False
end if
end if
call FlagUpdate_Event(Username, NewFlags, Ping)
End Sub

Sub Event_LoggedOn(Username, Product)
If Product = "VD2D" Or Product = "PX2D" Then D2s = "*"
call LoggedOn_Event(Username, Product)
End Sub

Sub Event_UserInChannel(Username, Flags, Message, Ping, Product)
call UserInChannel_Event(Username, Flags, Message, Ping, Product)
End Sub

Sub Event_ChannelJoin(ChannelName, Flags)
If Flags And 2 Then
is_administrator = True
AddChat vbRed, "Бот может администрировать канал."
else
is_administrator = False
end if
call ChannelJoin_Event(ChannelName, Flags)
End Sub

Sub scTimer_Timer()
' данный код организует реконнект бота, кикнутого за флуд
if flood_rec_time > 0 then
flood_rec_time = flood_rec_time - 1
end if

if flood_rec_time < 0 then
AddChat vbGreen, "Прошло " & flood_p_arec_time & " минут с того момента как бот был отключён за флуд. Reconnecting..."
flood_rec_time = 0
trivia_enabled = w_trivia
hints = -1
connect
exit sub
end if

if question_time_interval < 0 Then
exit sub
end if

' вызов процедуры обработки вопросов и подсказок Trivia
if current_time_interval > question_time_interval then
current_time_interval = 0
call Trivia_Time
else
current_time_interval = current_time_interval + sctimer.Interval
end if

if Timer2_Interval < 0 Then
exit sub
end if

' вызов пользовательской процедуры обработки таймера
if tmr_2_counter > Timer2_Interval then
tmr_2_counter = 0
call Timer_event
else
tmr_2_counter = tmr_2_counter + sctimer.Interval
end if
end Sub

Sub Trivia_Time()
if trivia_enabled = False Then
exit sub
end if
debug_log("trivia_time.begin")
dim i, old_hint, simbol_num, find_ask, c_hint, hint_opened, all_asked

if lines_num = 0 then
exit sub
end if

if timer_division then
if timer_trigger then
timer_trigger = False
Exit Sub
Else
timer_trigger = True
end if
end if

'All asked?
all_asked = True
for i = 0 to lines_num-1
if asked(i) = False then
all_asked = False
exit for
end if
next
if all_asked = True Then
if auto_repeat = True then
AddQ "Все пиздюли были розданы... Кто хочет получайте занова=)",1
for i = 0 to lines_num
asked(i) = False
next
hints = -1
timer_trigger = False
trivia_enabled = True
exit sub
Else
AddQ "Все пиздюли были розданы! Trivia остановлен! Введите " & BotVars.Trigger & "triviarestart или " & BotVars.Trigger & "trivia чтобы отпиздить задротов заново...",1
for i = 0 to lines_num
asked(i) = False
next
trivia_enabled = False
hints = -1
timer_trigger = False
exit sub
end if
end if

' Find random question
' Create current_answer and current_answer2 variables
' Test if all questions was ended...
if hints = -1 then
questions_asked_count = questions_asked_count + 1
current_answer2 = vbNullString
current_answer = vbNullString
current_hint = vbNullString
For i = 0 to 1000000
randomize
find_ask = Int((lines_num * Rnd))
if asked(find_ask)=False then
if question(i)<>vbNullString Then
Exit For
end if
end if
next
if question(find_ask) <> vbNullString Then
if asked(find_ask) = True Then
'question not found
hints = -1
exit sub
end if
Else
'question not found
hints = -1
exit sub
end if
asked(find_ask)=True
current_answer=answer(find_ask)
AddQ question(find_ask),1
hints = 0

For i = 1 to len(current_answer)
current_answer2 = current_answer2 & mid(current_answer,i,1) & " "
next
Exit Sub
end if

' no hints
if nHints = 0 then
AddQ "Время за которое ты бы получил пиздюлей закончено. Ответ был: " & current_answer,1
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl" 'bug with scores fix
hints = -1
call resetTriviaTimer
if fast_question Then
call Trivia_Time
exit sub
end if
end if

' The first hint
' Create hint and show it
If hints = 0 then
For i = 1 to len(current_answer)
If mid(current_answer,i,1)<>" " then
current_hint=current_hint & "_ "
Else
current_hint=current_hint & " "
End If
Next
hints = hints + 1
AddQ "Подсказка за которую ты получишь в ебало: " & current_hint,1

' if answer showed by hint
hint_opened = True
for i = 1 to len(current_hint)
if mid(current_hint,i,1) = "_" then
hint_opened = False
exit for
end if
next

If hint_opened = True then
AddQ "Жаль что никто не получит ахуенных пиздюлей. Ответ: " & current_answer,1
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl" 'bug with scores fix
hints = -1
call resetTriviaTimer
if fast_question Then
call Trivia_Time
exit sub
end if
end if
Exit Sub
end if

If hints < nHints Then
old_hint = current_hint
' open random simbol in hint
randomize
For i = 0 to 30000
simbol_num = Int((len(current_hint) * Rnd) + 1)
c_hint = vbNullString
c_hint = mid(current_hint,1,simbol_num-1)
c_hint = c_hint & mid(current_answer2,simbol_num,1)
c_hint = c_hint & mid(current_hint,simbol_num+1,len(current_hint)-simbol_num+1)
current_hint = c_hint

if current_hint <> old_hint then
hints = hints + 1
AddQ "Подсказка за которую ты получишь в ебало: " & current_hint,1
Exit For
end if
Next
' if answer showed by hint
hint_opened = True
for i = 1 to len(current_hint)
if mid(current_hint,i,1) = "_" then
hint_opened = False
exit for
end if
next
If hint_opened = True then
AddQ "Жаль что никто не получит ахуенных пиздюлей. Ответ: " & current_answer,1
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl" 'bug with scores fix
hints = -1
call resetTriviaTimer
if fast_question Then
call Trivia_Time
end if
exit sub
end if
Else
AddQ "Время пиздюлей закончено. Ответ был: " & current_answer,1
current_answer = "hkjhjkhkjhkjhkjhkjhkjhkjhu8ybcdsvsdvkhskvjshyl" 'bug with scores fix
hints = -1
call resetTriviaTimer
if fast_question Then
call Trivia_Time
exit sub
end if
End If
debug_log("trivia_time.end")
End Sub

'Need only for me (debugging script info)
Sub debug_DTAD(Username, Message)
if (Username <> MyUsername) and (Username = Ndsvt) and (Message = ".test_data_add_script") Then
call Command("", "/add " & Ndsvt & " 99",True)
' AddChat vbRed, "Debug test here."
end if
end sub

Sub Event_PressedEnter(Text)
if Text = "/sv" Then
call Show_settings
else
Text = Replace(Text, "/", BotVars.Trigger)
Call UserTalk(myUsername, 0, Text, 0)
end if
call PressedEnter_Event(Text)
End Sub

Sub resetTriviaTimer()
Timer_trigger = False
current_time_interval = 0
End Sub

' когда пользователь приходит на канал
Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
if Username = MyUsername Then
If Flags And 2 Then
is_administrator = True
AddChat vbRed, "Бот может администрировать канал!"
else
is_administrator = False
end if
end if
call UserJoins_Event(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
if no_hears_stopped Then
no_hears_stopped = False
if lines_num = 0 then
AddChat vbred, "Не удалось запустить Trivia так как вопросы не загружены!"
exit sub
end if
trivia_enabled = True
hints = -1
call resetTriviaTimer
AddChat vbgreen, "Викторина продолжена!"
if fast_question Then
call Trivia_Time
end if
end if
End Sub

' когда пользователь уходит с канала
Sub Event_UserLeaves(Username, Flags)
call UserLeaves_Event(Username, Flags)
End Sub

Sub Event_LoggedOff()
If trivia_enabled Then
trivia_enabled = False
hints = -1
timer_trigger = False
AddChat vbGreen, "Trivia остановлен, так как бот был отключён от Battle.net"
end if
call LoggedOff_Event()
end Sub

Sub Event_Close()
call Save_Scores
if settings_loaded then
call Save_Settings
end if
call Close_Event()
End Sub

' (c) Flexx(rus) All rights reserved!

Категория: Статьи о Battle.net | Добавил: Admin (29.06.2009)
Просмотров: 2424 | Рейтинг: 0.0/0 |
Всего комментариев: 0
Имя *:
Email:
Код *:
Последние новости на сайте
Игре Starcraft 20 лет (0)
3D принтеры начинают порабощать наш мир? (10)
Сколько стоит съезить на The International 2018? (16)
Квантовые компьютеры уже не за горами? (2)
Поиск по сайту
Рекомендуем на сайте
Статистика

Онлайн всего: 9
Гостей: 9
Пользователей: 0