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


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

Главная | Регистрация | Вход | RSS
Меню сайта
Категории каталога
Создание карт [46]
Статьи о Battle.net [30]
GGC (Garena) [4]
Интервью с топ-игроками [64]
Юмор [29]
Разное [81]
История Варкрафта [63]
Персонажи Варкрафта [115]
Случайная статья
Нежить против ночных эльфов: Криптлорд рулит (0)
[Нежить против эльфов]
Просмотров: 4771
Дата написания: 17.08.03
Старая, но достаточно грамотная и подробная статья.
В статье имеются скриншоты из игры
Случайная картинка
Орк, арчер, паладин

Топ статей
Карта гайдов по героям Доты 1 (281)
[Гайды по героям]
Просмотров: 662441
Гайд по Снайперу (Dwarven Sniper) (176)
[Гайды по героям]
Просмотров: 229483
Гайд по Хускару (Huskar, The Sacred Warrior) (269)
[Гайды по героям]
Просмотров: 228077
Гайд по Войду (Faceless Void, Darkterror) (199)
[Гайды по героям]
Просмотров: 211112
Гайд по Траксе (Traxex, Drow Ranger) (89)
[Гайды по героям]
Просмотров: 191573
Гайд по Урсе (Ursa Warrior) (125)
[Гайды по героям]
Просмотров: 191464
Гайд по Гуле (Лайфстилеру, Найксу) (78)
[Гайды по героям]
Просмотров: 186733
Гайд по Баланару (Balanar, Night Stalker) (152)
[Гайды по героям]
Просмотров: 158331
Гайд по Legion Commander (Командиру легиона, Tresdin) (166)
[Гайды по героям]
Просмотров: 153002
Главная » Статьи » Различные статьи 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)
Просмотров: 4773 | Рейтинг: 0.0/0 |
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Последние новости на сайте
Люк Валонфорт перед встречей с Артесом - обновление 2024 (0)
Обновление Melee Campaign Heroes 0.9.1 High Elves - пак из 150+ карт-сражений с героями и расами из кампании (7)
Помните ли вы день когда Артас перешел на темную сторону (21)
У кого дома еще хранятся эти диски? (16)
Поиск по сайту
Реклама (Р)
Статистика

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