Новичок
Профиль
Группа: Участник
Сообщений: 3
Регистрация: 17.3.2006
Репутация: нет
Всего: нет
|
Здраствуйте. Помогите пожалуста со следующим скриптом, я правда не в курсе - написан он на ВБ или на чем-то еще, но синтаксис вроде ВБшный -.- Назначение скрипта следующее: Он подключается как плагин для бота StealthBot, основное его назначение - брать из файла questions.txt вопросы, по типу ... Вопрос*Ответ Вопрос 2*Ответ 2 ... и задавать их на канале, вообщем это - тривиа бот как в ирке, только используется в чат-канал в игре. Т.к. я не нашел не одной внятной документации по ВБ, чтобы разобратся в скрипте, то ПРОШУ, если здесь есть мастаки кому это НЕСЛОЖНО, и скрипт вообще пренадлежит "теме форума", сделать в нем некоторые изменения: -.- 1. Увеличить задержку между вопросами на несколько секунд(желательно через константу) 2. Основная проблема скрипта в том, что для него ответ считается только стоящим после "*", поэтому, можно ли сделать так - "Вопрос *Ответ|Ответ2|Ответ3" ?, по типу if (a == "1" || "2" || "3")  3. Иногда, хочется чтобы с ответом, выводились какие-то комментарии ;) поэтому, можно ли сделать так: "Вопрос *Ответ|Ответ2//Гыы, угадали" ?, при этом чтобы выводилось это, типа "Ответ. Гыы, угадали" ;)) Заранее благодарю. P.S. Воизбежание БЕССМЫСЛЕННЫХ возгласов, прошу обратить внимание на "то ПРОШУ" и "кому это НЕСЛОЖНО". | Код |
'question(1000), answer(1000), asked(1000) << числа в скобках должны быть равны переменной 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
'Информация о версии
public const BotVersion = "v1.0"
'Путь к фаилам
public const ScoreFilePath = "C:\Program Files\StealthBot\scores.txt" 'фаил в который бот будет записывать ко-во набранных очков
public const QuestionFilesDir = "C:\Program Files\StealthBot\" 'директория фаилов с вопросами
QuestionFileName = "questions.txt" ' имя фаила с вопросами
'Доступ, необходимый чтобы управлять скриптом Trivia
public const trivAccess = 60
'Настройки таймера и подсказок
public const nHints = 5
public const timer_division = True 'Если "True" то время между подсказками будет равняться scTimer.Interval*2
public const fast_question = False 'Если "True" бот не будет ждать scTimer.Interval чтобы задать новый вопрос (не проверялось)
scTimer.Interval = 6500 ' Это секунды по истечению которых будет задан новый вопрос, 6500 = 6.5сек
public const auto_repeat = True 'Если "True" бот будет начинать снова повторять уже спрошенные вопросы, если "False" то остановится
'======================================================================================
' !!! DO NOT EDIT BELOW HERE !!!
'======================================================================================
dim trivia_enabled, D2s, score, rank_maxbnd, send_to_whisper, old_file_name
dim hints, current_hint, current_answer, current_answer2, timer_trigger
'debug : отображает отладочные сообщения
public const EnableDebugMessages = False
set score = CreateObject("Scripting.Dictionary")
' Только для отладки
Sub debug_log(msg)
if EnableDebugMessages then
AddChat vbCyan, "DEBUG: " & msg
end if
end sub
' Отображем загруженный скрипт
Sub Event_Load()
AddChat vbCyan, "-=[ TRIVIA ]=- v1.0 by Gg-ItachiSt0ry., based on Trivia v0.4 by Flexx(rus)"
AddChat vbYellow, "Интервал вопросов: " & scTimer.Interval/1000 & " сек."
if timer_division then
AddChat vbYellow, "Интервал подсказок: " & scTimer.Interval*2/1000 & " сек."
Else
AddChat vbYellow, "Интервал подсказок: " & scTimer.Interval/1000 & " сек."
end if
trivia_enabled = False
hints = -1
timer_trigger = False
scTimer.Enabled = True
lines_num = 0
call Load_Scores
AddChat vbGreen, "Счёт заружен из фаила: " & ScoreFilePath & " и содержит " & score.Count & " пользователей."
call Load_Questions
call Update_Rank
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 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 Load_Scores
debug_log("Load_Scores.begin")
Dim fso, score_file, read_string, cLine
Set fso = CreateObject("Scripting.FileSystemObject")
Set score_file = fso.OpenTextFile(ScoreFilePath, 1, True)
Do While score_file.AtEndOfStream <> True
read_string = score_file.ReadLine
cLine = Split(read_string, "|")
score.Add cLine(0), cLine(1)
Loop
score_file.Close
debug_log("Load_Scores.end")
End Sub
Sub Load_Questions
debug_log("Load_Questions.begin")
Dim fso, triv_File, read_string, cLine
AddChat vbGreen, "Загрузка вопросов из фаила: " & QuestionFilesDir & QuestionFileName
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(QuestionFilesDir & QuestionFileName) Then
AddChat vbRed, "Ошибка! Фаил с вопросами не найден! Проверьте параметры QuestionFilesDir и QuestionFileName в скрипте!"
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
AddQ send_to_whisper & "Trivia Bot " & BotVersion & " by Gg-ItachiSt0ry., based on Trivia Bot 0.4 by Flexx(rus)" ,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 fso, score_file, sList, cUser
debug_log("Save_Scores.begin")
if score.Count = 0 Then
exit sub
end if
Set fso = CreateObject("Scripting.FileSystemObject")
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
End Sub
Sub Event_ServerError(Message)
AddChat vbGreen, "Event_ServerError: " & Message
End Sub
Sub Event_UserTalk(Username, Flags, Message, Ping)
call UserTalk(Username, Flags, Message, Ping)
End Sub
Sub UserTalk(Username, Flags, Message, Ping)
dim i
debug_log("Event_UserTalk.begin")
If Message = BotVars.Trigger & "trivia" Then
GetDBEntry Username, myAccess, myFlags
If myAccess >= trivAccess Then
If trivia_enabled Then
trivia_enabled = False
hints = -1
timer_trigger = False
AddQ send_to_whisper & "Trivia остановлен!",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 resetTimer
AddQ send_to_whisper & "Trivia запущен!",1
send_to_whisper = vbNullString
if fast_question Then
call scTimer_Timer
end if
End If
End If
Exit Sub
End If
if Message = BotVars.Trigger & "triviarestart" then
GetDBEntry Username, myAccess, myFlags
If myAccess >= trivAccess 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 resetTimer
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 scTimer_Timer
exit sub
end if
end if
exit sub
end if
'// КОМНАДЫ !!!
If Message = BotVars.Trigger & "top5" Then
call Top5
exit sub
End If
If Left(Message, 5) = BotVars.Trigger & "file" Then
GetDBEntry Username, myAccess, myFlags
If myAccess >= trivAccess Then
old_file_name = QuestionFileName
QuestionFileName = Mid(Message, 7)
call Load_Questions
end if
exit sub
end if
if trivia_enabled = False then
debug_log("Event_UserTalk.end")
Exit Sub
End if
debug_log(LCase(current_answer))
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 = "_ОШИБКА_ОТВЕТА_" 'bug with scores fix
call Save_Scores
call resetTimer
hints = -1
if fast_question Then
call scTimer_Timer
exit sub
end if
End If
debug_log("Event_UserTalk.end")
End Sub
Sub Event_UserEmote(Username, Flags, Message)
End Sub
Sub Event_WhisperFromUser(Username, Flags, Message)
send_to_whisper = "/w " & D2s & Username & " "
Call UserTalk(Username, Flags, Message, 0)
send_to_whisper = vbNullString
End Sub
Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
End Sub
Sub Event_UserLeaves(Username, Flags)
End Sub
Sub Event_FlagUpdate(Username, NewFlags, Ping)
End Sub
Sub Event_LoggedOn(Username, Product)
If Product = "VD2D" Or Product = "PX2D" Then D2s = "r"
End Sub
Sub Event_UserInChannel(Username, Flags, Message, Ping, Product)
End Sub
Sub Event_ChannelJoin(ChannelName, Flags)
End Sub
Sub scTimer_Timer()
debug_log("scTimer_Timer.begin")
dim i, old_hint, simbol_num, find_ask, c_hint, hint_opened, all_asked
if trivia_enabled = False Then
exit sub
end if
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 остановлен! Введите .triviarestart или .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
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 "/me Время истекло. Ответ был: " & current_answer,1
current_answer = "_ОШИБКА_ОТВЕТА_" 'bug with scores fix
hints = -1
call resetTimer
if fast_question Then
call scTimer_Timer
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 "/me --> Подсказка: " & current_hint,2 '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 "/me Ответ был полностью раскрыт подсказками. Ответ: " & current_answer,1
current_answer = "_ОШИБКА_ОТВЕТА_" 'bug with scores fix
hints = -1
call resetTimer
if fast_question Then
call scTimer_Timer
exit sub
end if
end if
Exit Sub
end if
If hints < nHints Then
old_hint = current_hint
' open random simbol in hint
For i = 0 to 50000
randomize
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 "/me Ответ был полностью раскрыт подсказками. Ответ: " & current_answer,1
current_answer = "_ОШИБКА_ОТВЕТА_" 'bug with scores fix
hints = -1
call resetTimer
if fast_question Then
call scTimer_Timer
end if
exit sub
end if
Else
AddQ "/me Время истекло. Ответ был: " & current_answer,1
current_answer = "_ОШИБКА_ОТВЕТА_" 'bug with scores fix
hints = -1
call resetTimer
if fast_question Then
call scTimer_Timer
exit sub
end if
End If
debug_log("scTimer_Timer.end")
End Sub
Sub Event_PressedEnter(Text)
' if connected = False then
' Addchat vbGreen, Text
' end if
Call UserTalk(myUsername, 0, Text, 0)
End Sub
Sub resetTimer()
Timer_trigger = False
scTimer.Enabled = False
scTimer.Enabled = True
End Sub
Sub Event_KeyReturn(KeyName, KeyValue)
End Sub
Sub Event_Close()
Save_Scores
End Sub
|
|
Помогите поправить скрипт, язык - вероятно VBS 
Загрузка ...
