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

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



Закрытая тема
 
Опции темы Опции просмотра
Старый 16.04.2008, 19:06   #46
Кодер-Дизайнер

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

Цитата:
Сообщение от eHoT Посмотреть сообщение
[17:18:00] <Clan-eFe> Ошибка! Фаил с вопросами не найден!
хм... ну лан кинь сюда свой script.txt
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 17.04.2008, 00:30   #47
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

Код:
'
' [ВНИМАНИЕ] ЧТОБЫ УСТАНОВИТЬ СКРИПТ НАДО СОХРАНИТЬ ЭТОТ ФАИЛ В ПАПКУ С БОТОМ ПОД ИМЕНЕМ 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] - установка или просмотр времени (в минутах), через которое бот будет 
' делать реконнект, если был кикнут за флуд. (* - только для чтения) (***)
'         .timeban <username> <time> - забанить username на time минут.
'
' *   К этим командам имеют доступ все пользователи.
' **  Изменение числа подсказок во время работы Trivia ведёт к пропуску текущего вопроса.
' *** Установка .frp в 0 отключает возможность автореконнекта.
'======================================================================================
' ПАРАМЕТРЫ И НАСТРОЙКИ:

'Путь к фаилам
ScoreFilePath = "scores.txt"  'фаил в который бот будет записывать ко-во набранных очков 
QuestionFilesDir = ""  'директория фаилов с вопросами
QuestionFileName = "voprosi.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 = 15100
auto_repeat = True 'Если "True" бот будет начинать снова повторять уже спрошенные вопросы, если "False" то остановится

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

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

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

'Время, между воспринимаемыми командами. Не влияет на восприятие ответов Trivia
anti_flood_time = 3200

'Переименовывать пользователей в старкрафт
starcraft_rename = True

' Выполнять команды с переименованными пользователями
renamed_shell = True

' Не даёт зайти на канал пользователю, но и не банит его (timeidlekick)
timeban_kick_enabled = False
'======================================================================================
' Antimat Script v.1.2 by berserker
'======================================================================================

Public const AntiMatFilePath = "antimat.txt" 'фаил с антиматом
Public const ClanName1 = "RUS"
Public const ClanBan = false       ' если ClanBan = false то если поставить ClanName  = имяклана то игроков с этого клана не будет банить за мат
Public antimat(10000)
Public nn
Public arr_w1
Public mk, mb

Sub Load_antimat
  Dim fso, antimat_file, read_string
  nn = 0
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set antimat_file = fso.OpenTextFile(AntiMatFilePath, 1, True)
   Do While antimat_file.AtEndOfStream <> True
      antimat(nn)=antimat_file.ReadLine
      nn = nn+1
   Loop
  antimat_file.Close
  nn=nn-1
End Sub

Sub antimat_Event_UserTalk(Username, Flags, Message, Ping)
 bNet_ClanName = GetInternalDataByUsername(UserName, 0)
  If (bNet_ClanName = "") Then bNet_ClanName = "N/A"

 if Message = BotVars.Trigger & "matkick" Then
   GetDBEntry Username, myAccess, myFlags
   If myAccess >= 60 Then                                      'ставьте тут аксесс такой, какой надо
    mk= true
    mb= false
    AddQ send_to_whisper & "Включен режим \маткик\"
   end if
  end if

  if Message = BotVars.Trigger & "matban" Then
   GetDBEntry Username, myAccess, myFlags
   If myAccess >= 60 Then                                     'ставьте тут аксесс такой, какой надо
    mk= false
    mb= true
    AddQ send_to_whisper & "Включен режим \матбан\"
   end if
  end if

  if Message = BotVars.Trigger & "cancelmatkick" Then
   GetDBEntry Username, myAccess, myFlags
   If myAccess >= 60 Then                                     'ставьте тут аксесс такой, какой надо
    mk= false
    mb= false
    AddQ send_to_whisper & "Выключены режимы \маткик\ и \матбан\"
   end if
  end if

  if Message = BotVars.Trigger & "matkickinfo" Then
   if mk then
    AddQ send_to_whisper & "Включен режим \маткик\"
   end if
   if mb then
    AddQ send_to_whisper & "Включен режим \матбан\"
   end if
   if not mk and not mb then
    AddQ send_to_whisper & "Выключены режимы \маткик\ и \матбан\"
   end if
  end if

  if mk or mb then

   arr_w1 = split(message, " ")

   for i = 0 to ubound(arr_w1)
    for j = 0 to nn
     if (LCase(arr_w1(i)) = LCase(antimat(j))) and (arr_w1(i)<>" ") and (arr_w1(i)<>"") then

      if mk and not ((ClanName = ClanName1) and not ClanBan) then
       AddQ "/kick " & username & " Не матерись !"
      end if

      if mb and not ((ClanName = ClanName1) and not ClanBan) then
      AddQ "/ban " & username & " Не матерись !"
      end if

      exit sub
     end if
    next
   next
  end if

 if left(Message, 8) = BotVars.Trigger & "matadd " Then
  GetDBEntry Username, myAccess, myFlags
  If myAccess >= 60 Then                                      'ставьте тут аксесс такой, какой надо
'  Dim fso, mat_file, mat1

   mat1= mid(Message, 9, len(Message)-8)

   Set fso = CreateObject("Scripting.FileSystemObject")
   Set mat_file = fso.OpenTextFile(AntiMatFilePath, 8, True)
   mat_file.WriteLine mat1
   mat_file.Close

   antimat(nn+1)=mat1
   nn=nn+1

   AddQ send_to_whisper & "Мат \" & mat1 & "\ добавлен"
  end if
 end if

 if Message = BotVars.Trigger & "matsay" Then

  j = 0
  str = "Список запрещенных слов - "
  for i = 0 to nn
   if i<>nn then
    str = str & antimat(i) & ", "
   else
    str = str & antimat(i) & "."
   end if
   j=j+1

   if (j = 10) or (i = nn) then
    AddQ send_to_whisper & str
'    padqueue
    j = 0
    str = ""
   end if
  next

  AddQ send_to_whisper & "Всё."
 end if

 if left(Message, 8) = BotVars.Trigger & "matdel " Then
  GetDBEntry Username, myAccess, myFlags
  If myAccess >= 60 Then                                      'ставьте тут аксесс такой, какой надо
'  Dim fso, mat_file, mat1

   mat1= mid(Message, 9, len(Message)-8)

   found = false
   for i = 0 to nn
    if antimat(i) = mat1 then
     for j = i to nn-1
      antimat(j) = antimat(j+1)
     next
     nn = nn-1
     found = true
     exit for
    end if
   next
   if found = false then
    AddQ send_to_whisper & "Запрещенное слово не найдено."
   end if


   Set fso = CreateObject("Scripting.FileSystemObject")
   Set mat_file = fso.OpenTextFile(AntiMatFilePath, 2, True)
   for i = 0 to nn
    mat_file.WriteLine antimat(i)
   next
   mat_file.Close

   if found = true then
    AddQ send_to_whisper & "Мат \" & mat1 & "\ удален"
   end if
  end if
 end if
End Sub

'======================================================================================
' Clan invite script.
'======================================================================================
'// Powered by xKLONx =)
'// Variables
Option Explicit
Public Usrname                  '// Имя пользователя, для которого была использована команда /stats
Public InfoMessage              '// Последнее информационное сообщение с battle.net(синее)
Public ErrorMessage             '// Последнее сообщение об ошибке с battle.net(красное)
Public TalkMessage              '// Последнее сообщение пользователя
Public TalkUsername

'// Тут можно и самим подобрать значания...
Public Const r_solo_lvl = 60
Public Const r_team_lvl = 60
Public Const r_ffa_lvl = 60
Public Const r_solo_stats = 100
Public Const r_team_stats = 100
Public Const r_ffa_stats = 100

Public solopr, solowins, sololosses, soloprocent, ffawins, ffalosses, ffaprocent, teamwins, _
    teamlosses, teamprocent, teamlevel, sololevel, ffalevel

Public f_check_stats, counter1

Sub civ_Event_Load()
    Timer2_Interval = 1000
    addchat vbYellow, "Канальный.Автоприглашалка"
End Sub

Sub civ_Event_ServerInfo(Message)
    Dim ladder, ldrlen, lvllen, winlen, lsslen, Level
    If f_check_stats Then
        If InStr(Message, "- Ladder ") > 0 Then
            UserStatArray = Split(Message, " ")
            Laddername = UserStatArray(2)
            ldrlen = Len(UserStatArray(2))
            Select Case Mid(UserStatArray(2), 1, ldrlen)
                Case "SOLO,"
                    ladder = "SOLO"
                    If InStr(Message, ", Level ") > 0 Then
                        lvllen = Len(UserStatArray(4))
                        Level = Left(UserStatArray(4), lvllen - 1)
                    End If
                    If InStr(Message, ", Wins ") > 0 Then
                        winlen = Len(UserStatArray(6))
                        wins = Left(UserStatArray(6), winlen - 1)
                    End If
                    If InStr(Message, ", Losses ") > 0 Then
                        lsslen = Len(UserStatArray(8))
                        losses = Left(UserStatArray(8), lsslen)
                    End If
                Case "TEAM,"
                    ladder = "TEAM"
                    If InStr(Message, ", Level ") > 0 Then
                        lvllen = Len(UserStatArray(4))
                        Level = Left(UserStatArray(4), lvllen - 1)
                    End If
                    If InStr(Message, ", Wins ") > 0 Then
                        winlen = Len(UserStatArray(6))
                        wins = Left(UserStatArray(6), winlen - 1)
                    End If
                    If InStr(Message, ", Losses ") > 0 Then
                        lsslen = Len(UserStatArray(8))
                        losses = Left(UserStatArray(8), lsslen)
                    End If
                Case "FFA"
                    ladder = "FFA"
                    If InStr(Message, ", Level ") > 0 Then
                        lvllen = Len(UserStatArray(5))
                        Level = Left(UserStatArray(5), lvllen - 1)
                    End If
                    If InStr(Message, ", Wins ") > 0 Then
                        winlen = Len(UserStatArray(7))
                        wins = Left(UserStatArray(7), winlen - 1)
                    End If
                    If InStr(Message, ", Losses ") > 0 Then
                        lsslen = Len(UserStatArray(9))
                        losses = Left(UserStatArray(9), lsslen)
                    End If
                Case Else
                    ladder = "Unknown": Level = "Unknown": wins = "Unknown": losses = "Unknown"
            End Select
        End If
        wins = Int(wins): losses = Int(losses)
        If losses <> 0 And wins <> 0 Then
            procent = Int(wins / (wins + losses) * 1000)
            procent = procent / 10
        End If
        Level = Int(Level)
        If ladder = "SOLO" Then
            sololevel = Level
            solowins = wins: sololosses = losses
            soloprocent = procent
        End If
        If ladder = "FFA" Then
            ffalevel = Level
            ffawins = wins: ffalosses = losses
            ffaprocent = procent
        End If
        If ladder = "TEAM" Then
            teamlevel = Level
            teamwins = wins: teamlosses = losses
            teamprocent = procent
        End If
    End If
End Sub

Sub civ_Event_ServerError(Message)
    ErrorMessage = Message
    If InStr(Message, "The invitation failed.") > 0 Then
        AddQ "Opps.. the invitation failed. Try again!"
        f_check_stats = False
    End If
    If InStr(Message, "Too many server requests") > 0 Then
        AddQ "Sry батла глючит напиши ещё :("
        f_check_stats = False
    End If
    If InStr(Message, "No stats on record") > 0 Then
        AddQ Usrname & "  ты не подходиш..."
        f_check_stats = False
    End If
End Sub

Sub Inviter()
    f_check_stats = False
    If sololevel >= r_solo_lvl And soloprocent >= r_solo_stats Then
        ssc.addchat vbYellow, Usrname & " подходит по соло"
        Command BotVars.Username, ".invite " & Usrname, 0
    Else
        If teamlevel >= r_team_lvl And teamprocent >= r_team_stats Then
            ssc.addchat vbYellow, Usrname & " подходит по тим"
            Command BotVars.Username, ".invite " & Usrname, 0
        Else
            If ffalevel > r_ffa_lvl And ffaprocent >= r_ffa_stats Then ':)
                ssc.addchat vbYellow, Usrname & " подходит по ффа"
                Command BotVars.Username, ".invite " & Usrname, 0
            Else
                ssc.addchat vbRed, Usrname & " не подходит"
                ssc.addchat vbRed, "Solo: " & sololevel & " & " & soloprocent & "%. " & "Требования: " & r_solo_lvl & "lvl & " & r_solo_stats & "%"
                ssc.addchat vbRed, "Team: " & teamlevel & " & " & teamprocent & "%. " & "Требования: " & r_team_lvl & "lvl & " & r_team_stats & "%"
                ssc.addchat vbRed, "FFA: " & ffalevel & " & " & ffaprocent & "%. " & "Требования: " & r_ffa_lvl & "lvl & " & r_ffa_stats & "%"
                AddQ Usrname & "  ты не подходиш..."
            End If
        End If
    End If
End Sub

Sub civ_Event_UserTalk(Username, Flags, Message, Ping)
    Dim myAccess, myFlags, clan
    If LCase(Message) = ".join" Then
        GetDBentry Username, myAccess, myFlags
        clan = GetInternalDataByUsername(Username, 0)
        If clan = "" Then
            sololevel = 0: teamlevel = 0: ffalevel = 0
            solowins = 0: teamwins = 0: ffawins = 0
            sololosses = 0: teamlosses = 0: ffalosses = 0
            soloprocent = 0: teamprocent = 0: ffaprocent = 0
            AddQ "Check stats..."
            'ssc.addchat vbRed, "Check stats..."
            f_check_stats = True
            Usrname = Username
            'Usrname = "тестюзверь"
            AddQ "/stats " & Usrname & " w3xp"
        Else
            AddQ Username & " ты должен сначала выйти из " & clan
        End If
    End If
End Sub

Sub civ_Event_WhisperFromUser(Username, Flags, Message)
    If LCase(Message) = "join" Then Event_UserTalk Username, 0, Message, 0
End Sub

Sub civ_Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
    Dim clan
    clan = GetInternalDataByUsername(Username, 0)
    If clan = "" And Level > 25 Then AddQ "Хочеш войти в клан просто напиши .join"
End Sub

Sub civ_Timer()
    If f_check_stats Then
        counter1 = counter1 + 1 ': ssc.addchat vbGreen, counter1
        If counter1 = 3 Then Inviter: counter1 = 0: f_check_stats = False
    End If
End Sub


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

dim send_to_whisper
' для формирования ответа пользователю используйте:
' 	AddQ send_to_whisper & "Ваше сообщение"
' Тогда сообщение пойдёт тому, кто последний посылал боту в личку
'
' Сл. Код лезет в 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 
'
' Чтобы забанить пользователя на определённое время используйте
'   call TimeBan_ban_user(Username, time_min)

' когда бот загружается или Reload Script
Sub Load_Event()
 call civ_Event_Load
 call Load_antimat
 AddChat vbGreen, "Антимат заружен из фаила: " & AntimatFilePath & " и содержит " & nn & " слов."
End Sub

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

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

' когда пользователь приходит на канал
Sub UserJoins_Event(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
 call civ_Event_UserJoins(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
 call civ_Timer()
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 ' показывает сколько времени прошло, когда бот был отключён от Battle.net за флуд
dim w_trivia ' Trivia остановлена так как на канале небыло народу
dim settings_loaded ' Настройки загружены (нужно для предотвращения стирания настроек)

dim current_time_interval ' счётчик времени для Trivia
dim tmr_2_counter ' счётчик времени для пользовательского таймера
dim ftime ' время для защиты от флуда
dim D2s, StarCraftPrefix ' Diablo и StarCraft символы (поддержка Diablo не проверялась)
dim current_product ' Текущая игра под которой залогинился.

dim is_istrator ' True, если бот адимн на канале                         
dim starcraft_rename_users_actived ' True, если производится переименование пользователей в StarCraft

set fso = CreateObject("Scripting.FileSystemObject")

' текущая версия скрипта
private const CurrentVersion = "0.8"

'================================================================================
'======================== MatKick/MatBan/MatTimeBan =============================

Sub MatKick_init()
End sub

Sub MatKick_UserTalk(Username, Flags, Message, Ping)
end sub

Sub MatKick_Free()
end sub

'================================================================================
'========================== Timeban part of script ==============================

dim timebanned_users(10000), timebanned_times(10000), timebanned_count

Sub TimeBan_init()
 timebanned_count = 0
 call Load_TimeBans
End sub

Sub Load_TimeBans
  timebanned_count = 0
  Dim tb_file, read_string, cLine
  Set tb_file = fso.OpenTextFile("timebans.txt", 1, True)
   Do While tb_file.AtEndOfStream <> True
      read_string = tb_file.ReadLine
      cLine = Split(read_string, "|")
      if UBound(Cline)>0 Then
        timebanned_users(timebanned_count) = Cline(0)
        timebanned_times(timebanned_count) = Int(Cline(1))
        timebanned_count = timebanned_count + 1
      end if
   Loop
   AddChat vbyellow, "[TIMEBAN] Во временном бане находится " & timebanned_count & " пользователей."
  tb_file.Close
End Sub

Sub Save_Timebans
  Dim score_file, sList, cUser
  if timebanned_count = 0 Then
   exit sub
  end if

  Set tb_file = fso.OpenTextFile("timebans.txt", 2, True)
   For i=0 to timebanned_count
    if (timebanned_times(i) - GetCurrentTime) > 0 Then
     tb_file.WriteLine timebanned_users(i) & "|" & timebanned_times(i)
    end if
   Next
  tb_file.Close
  AddChat vbGreen, "[TIMEBAN] Фаил с забаненными пользователями обновлён!"
End Sub

Sub TimeBan_userjoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
 if is_istrator = False Then
  exit sub
 end if
 For i = 0 to timebanned_count
  if LCase(timebanned_users(i)) = LCase(Username) Then
   if Int(timebanned_times(i)) > 0 Then
    if timeban_kick_enabled Then
     AddQ "/kick " & timebanned_users(i) & StarCraftPrefix & " Time banned. " & Int((timebanned_times(i) - GetCurrentTime)/60) & " минут осталось.",0
    else
     AddQ "/ban " & timebanned_users(i) & StarCraftPrefix & " Time banned. " & Int((timebanned_times(i) - GetCurrentTime)/60) & " минут осталось.",0
    end if
   end if
  end if
 next
end sub

Sub TimeBan_ban_user(Username, time_min)
 if is_istrator = False Then
  AddChat vbRed, "[TIMEBAN] Не удалось забанить прользвателя, так как бот не является администратором на канале."
  exit sub
 end if
' пользователь уже в бане
 For i = 0 to timebanned_count
  if LCase(timebanned_users(i)) = LCase(Username) Then
   timebanned_times(i) = GetCurrentTime + time_min*60
    if timeban_kick_enabled Then
     AddQ "/kick " & timebanned_users(i) & StarCraftPrefix & " Time banned. " & Int((timebanned_times(i) - GetCurrentTime)/60) & " минут осталось.",0
    else
     AddQ "/ban " & timebanned_users(i) & StarCraftPrefix & " Time banned. " & Int((timebanned_times(i) - GetCurrentTime)/60) & " минут осталось.",0
    end if
    call Save_Timebans
   exit sub
  end if
 next
' пользователя нет в бане
  timebanned_count = timebanned_count + 1
  timebanned_users(i) = Username
  timebanned_times(i) = GetCurrentTime + time_min*60
  if timeban_kick_enabled Then
     AddQ "/kick " & timebanned_users(i) & StarCraftPrefix & " Time banned. " & Int((timebanned_times(i) - GetCurrentTime)/60) & " минут осталось.",0
  else
     AddQ "/ban " & timebanned_users(i) & StarCraftPrefix & " Time banned. " & Int((timebanned_times(i) - GetCurrentTime)/60) & " минут осталось.",0
  end if
call Save_Timebans
End sub

Sub TimeBan_UserTalk(Username, Flags, Message, Ping)
 if is_istrator = False Then
  exit sub
 end if
 cline = split(Message," ")
 If (cline(0) = BotVars.Trigger & "timeban") and UBound(Cline)>1 Then
  If Verify_User_Command("timeban", Username, 60, "A") = 1 Then
    if isnumeric(cline(2)) Then
     call TimeBan_ban_user(cline(1),Int(cline(2)))
     call Save_Timebans()
    end if
  end if
  exit sub
 End If

 If (cline(0) = BotVars.Trigger & "unban") and UBound(Cline)>0 Then
  If Verify_User_Command("timeban", Username, 60, "A") = 1 Then
    For i = 0 to timebanned_count 
     if (LCase(timebanned_users(i)) = LCase(cline(1))) and (timebanned_times(i)>0) Then
      timebanned_times(i) = - 10
      AddQ "/unban " & timebanned_users(i) & StarCraftPrefix,0
      call Save_Timebans()
     end if
    next
  end if
  exit sub
 End If
end sub

Sub TimeBan_Timer()
 if is_istrator = False Then
  exit sub
 end if
' проверка и разбанивание пользователей
 For i = 0 to timebanned_count
   if (timebanned_times(i) > 0) and (timebanned_times(i) < GetCurrentTime) Then
    timebanned_times(i) = -10
    call Save_Timebans()
    AddChat vbGreen, "[TIMEBAN] Пользователь " & timebanned_users(i) & " разбанен."
    AddQ "/unban " & timebanned_users(i) & StarCraftPrefix,0
   end if
 next
End sub

'================================================================================
'============================ Trivia часть скрипта ==============================

dim lines_num, question(10000), answer(10000), asked(10000) 'questions and answers
public const max_lines=10000 
dim hscores_users(2000), hscores_scores(2000)
public const hscores_maxcount = 2000
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")

public const EnableDebugMessages=False
Sub debug_log(msg)
 if EnableDebugMessages then
  AddChat vbCyan, "[DEBUG] " & msg
 end if
end sub

' Fires when script loaded (reloaded)
Sub triv_Event_Load()
 questions_asked_count = 0
 call Load_Settings
 AddChat vbYellow, "[TRIVIA] Интервал вопросов: " & question_time_interval/1000 & " сек."
 if timer_division then
 AddChat vbYellow, "[TRIVIA] Интервал подсказок: " & question_time_interval*2/1000 & " сек."
 Else
 AddChat vbYellow, "[TRIVIA] Интервал подсказок: " & question_time_interval/1000 & " сек." 
 end if
 score.comparee = vbTextCompare
 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, "[TRIVIA] Счёт заружен из фаила: " & 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
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 Show_User_Rank(Username)
  dim i, user_found
  call Update_Rank

  user_found = False
  for i = 0 to rank_maxbnd 
   if LCase(hscores_users(i)) = Lcase(username) then
    AddQ send_to_whisper & "Пользователь " & Username & " имеет " & hscores_scores(i) & " очков. Он на " & i+1 & "/" & score.Count & " месте в статистике.",1
    user_found = True
    exit for
   end if
  next
  if user_found = False then
   AddQ send_to_whisper & "Пользователь " & Username & " не найден в рейтинговой таблице бота.",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
'addChat vbred, "TT"
  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 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, "[TRIVIA] Исправлен пользователь: " & 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, "[TRIVIA] Загрузка вопросов из фаила: " & QuestionFilesDir & QuestionFileName
  If Not fso.FileExists(QuestionFilesDir & QuestionFileName) Then
   AddChat vbRed, "[TRIVIA] Ошибка! Фаил с вопросами не найден! Проверьте параметры 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, "[TRIVIA] Слишком много строк в фаиле с вопросами! Проверьте параметры [question, answer, max_lines, asked] в скрипте!"
         AddChat vbGreen, "[TRIVIA] Загружено " & lines_num-1 & " вопросов!"
         triv_File.Close
         for i = 0 to lines_num 
          asked(i) = False
         next
         Exit Sub
        end if
       Else
       AddChat vbRed, "[TRIVIA] Символ * не найден в строке после " & 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, "[TRIVIA] Загружено " & 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, "[TRIVIA] Счёт был сохранён!"
  debug_log("Save_Scores.end")
End Sub

Sub UserTalk(Username, Flags, Message, Ping)
 dim i
  debug_log("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 ftime > 0 then
  exit sub
 end if

  If Message = BotVars.Trigger & "trivia" Then
   If Verify_User_Command("trivia", Username, trivAccess, TriviaFlag) = 1 Then
    ftime = anti_flood_time
    If trivia_enabled Then 
     trivia_enabled = False
     hints = -1
     timer_trigger = False
     AddQ send_to_whisper & "Trivia остановлен! Введите " & 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
    ftime = anti_flood_time
     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 (Left(Message, 6) = BotVars.Trigger & "score") or (Left(Message, 5) = BotVars.Trigger & "rank") or (Left(Message, 6) = BotVars.Trigger & "stats") Then
   If (Verify_User_Command("score", Username, -100, TriviaFlag) = 1) or (Verify_User_Command("rank", Username, -100, TriviaFlag) = 1) or (Verify_User_Command("stats", Username, -100, TriviaFlag) = 1) Then
    ftime = anti_flood_time
    uspl = split(Message, " ")
     if UBound(uspl) > 0 Then
      if Len(uspl(1)) > 3 Then
       call Show_User_Rank(uspl(1))
      end if
     else
      call Send_User_Rank(Username)
     end if
    exit sub
   end if
  End If 

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

  if Message = BotVars.Trigger & "filename" Then
   ftime = anti_flood_time
   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
     ftime = anti_flood_time
     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
    ftime = anti_flood_time
    call GetRusTriviaNews
   end if  
   exit sub 
  end if
  Наверх
Старый 17.04.2008, 00:33   #48
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

Код:
If Left(Message, 5) = BotVars.Trigger & "file" Then
   If Verify_User_Command("file", Username, trivAccess, TriviaFlag) = 1 Then
    ftime = anti_flood_time
    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
   ftime = anti_flood_time
   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
   ftime = anti_flood_time
   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
   ftime = anti_flood_time
   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
   ftime = anti_flood_time
   AddQ send_to_whisper & "С момента установки скрипта версии 0.7 бот задал " & questions_asked_count & " вопросов!",1
   call Save_Settings
   exit sub
  end if
  debug_log("UserTalk.end")
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

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

'==========================================================================
'======================== Get news and update =============================

private sub GetRusTriviaNews()
 AddChat vbGreen, "Попытка получения новостей и проверки наличия обновления..."
 scinet.Cancel
 if scinet.StillExecuting = True Then
  AddChat vbRed, "Произошла ошибка, проверьте обновление вручную. http://D3scene.ru"
  exit sub
 end if 
 arrbytes = scinet.openurl("http://D3scene.ru/newsbhy.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 vbyellow, ""& u_version &"   Зайдите на [Ссылки скрыты от гостей.] чтобы узнать больше."
  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

'==========================================================================
'======================== Share pingme system =============================

Sub Event_UserTalk_pingme(Username, Flags, Message, Ping)
 if Mid(Message, 1,1) <> BotVars.Trigger Then
  exit sub
 end if
 
 if ftime > 0 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!"
     ftime = anti_flood_time
     send_to_whisper = vbNullString
     exit sub
    end if
   end if
  end if

  If Message = BotVars.Trigger & "pingmeenable" Then
   If Verify_User_Command("pingmeenable", Username, trivAccess, TriviaFlag) = 1 Then
     ftime = anti_flood_time
     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
     ftime = anti_flood_time
     EnablePingMe = Flase
     AddQ send_to_whisper & "Команда " & BotVars.Trigger &  "pingme отключена для общего доступа!",1
     send_to_whisper = vbNullString
    End if
   exit sub
  End If
end sub

'==========================================================================
'============================= Help system ================================

Sub AdvancedHelp(Username, Message)
 if Mid(Message, 1,1) <> BotVars.Trigger Then
  exit sub
 end if
 
 if ftime > 0 then
  exit sub
 end if
 cline = Split(Lcase(Message), " ")
 if cline(0) = BotVars.Trigger & "help" then
  If Verify_User_Command("help", Username, -100, TriviaFlag) = 1 Then
   ftime = anti_flood_time
   if UBound(cline) > 0 Then
    select case cline(1)
     case "trvuser":
      if UBound(cline) > 1 Then
       Select case cline(2)
        case "top5": AddQ send_to_whisper & " .top5 - показывает пятерых самых активных пользователей.",1
        case "rank": AddQ send_to_whisper & " .rank <username> - позиция и счёт игрока.",1
        case "usercount": AddQ send_to_whisper & " .usercount - показывает сколько народу ответило на вопросы.",1
        case "total": AddQ send_to_whisper & " .total - показывает сколько вопросов задал бот.",1
        case "hints": AddQ send_to_whisper & " .hints - показывает колличество подсказок.",1
        case "filename": AddQ send_to_whisper & " .filename - показывает имя фаила с вопросами.",1       
        case else AddQ send_to_whisper & "USE: .help trvuser <cmd> | CMDs: top5, rank, filename, usercount, total, hints",1
       end select
      else AddQ send_to_whisper & "USE: .help trvuser <cmd> (top5, rank, filename, usercount, total, hints)",1
      end if

     case "trv":
      if UBound(cline) > 1 Then
       Select case cline(2)
        case "trivia": AddQ send_to_whisper & " .trivia - запускает/останавливает викторину без очистки списка заданных вопросов.",1
        case "triviarestart": AddQ send_to_whisper & " .triviarestart - запускает/останавливает викторину с очисткой списка заданных вопросов.",1
        case "file": AddQ send_to_whisper & " .file <Имя фаила> - установка имени фаила с вопросами. Для просмотра .filename",1
        case "arep": AddQ send_to_whisper & " .arep <on/off> - если включить то когда вопросы кончатся бот не будет их повторять и Trivia остановится.",1
        case "hints": AddQ send_to_whisper & " .hints <Колличество подсказок> - установка колличества подсказок.",1
        case "nextquestion": AddQ send_to_whisper & " .nextquestion - пропуск текущего вопроса.",1   
        case else AddQ send_to_whisper & "USE: .help trv <cmd> | CMDs: trivia, triviarestart, nextquestion, file, hints, arep",1
       end select
      else AddQ send_to_whisper & "USE: .help trv <cmd> (trivia, triviarestart, nextquestion, file, hints, arep)",1
      end if

     case "ping":
      if UBound(cline) > 1 Then
       Select case cline(2)
        case "pingme": AddQ send_to_whisper & " .pingme - показывает какой был у вас пинг, при входе в Battle.net",1
        case "pingmeenable": AddQ send_to_whisper & " .pingmeenable - включает публичный доступ к команде .pingme",1
        case "pingmedisable": AddQ send_to_whisper & " .pingmedisable - выключает публичный доступ к команде .pingme",1
        case else AddQ send_to_whisper & "USE: .help ping <cmd> ! Cmds: pingmeenable, pingmedisable, pingme",1
       end select
       else AddQ send_to_whisper & "USE: .help ping <cmd> (pingmeenable, pingmedisable, pingme)",1
      end if
   
     case "trvinfo":
      AddQ send_to_whisper & "RusTrivia script v" & CurrentVersion & " !! [Ссылки скрыты от гостей.] !! Script was created by Flexx(rus).",1

     case "tbans":
      if UBound(cline) > 1 Then
       Select case cline(2)
        case "timeban": AddQ send_to_whisper & " .timeban <Username> <Time> - банит любого пользователя на Time минут по абсолютному времени.",1
        case "unban": AddQ send_to_whisper & " .unban <username> - разбанивает пользователя.",1
       end select
       else AddQ send_to_whisper & "USE: .help tbans <cmd> (timeban, unban)",1
      end if
     
     case else AddQ send_to_whisper & "USE: help <topic> (trvuser, trv, trvinfo, ping, tbans)",1
    end select 
   else
    AddQ send_to_whisper & "USE: help <topic> (trvuser, trv, trvinfo, ping, tbans)",1
    exit sub
   end if
  end if
 end if
end sub

'==========================================================================
'===================== Загрузка и сохранение настроек =====================

Sub Load_Settings
' >> TRIVIA
 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", "totalasked", "config.ini")) Then
  questions_asked_count = Int(GetConfigEntry("Trivia", "totalasked", "config.ini"))
 end if
 if GetConfigEntry("Trivia", "questionfilename", "config.ini") <> vbNullString Then
  QuestionFileName = GetConfigEntry("Trivia", "questionfilename", "config.ini")
 end if
 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")
' >> AntiFlood
 if IsNumeric(GetConfigEntry("FRS", "anti_flood_time", "config.ini")) Then
  anti_flood_time = Int(GetConfigEntry("FRS", "anti_flood_time", "config.ini"))
 end if
 if IsNumeric(GetConfigEntry("FRS", "floodprotectiontime", "config.ini")) Then
  flood_p_arec_time = Int(GetConfigEntry("FRS", "floodprotectiontime", "config.ini"))
 end if
'>> TimeBan
 timeban_kick_enabled = Str2Bool(GetConfigEntry("Timeban", "KickEnabled", "config.ini"))
 settings_loaded = True
End Sub

Sub Save_Settings
' >> TRIVIA
 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","TotalAsked", questions_asked_count, "config.ini")
' >> AntiFlood
 call WriteConfigEntry("FRS","floodprotectiontime", flood_p_arec_time, "config.ini")
 call WriteConfigEntry("FRS","anti_flood_time", anti_flood_time, "config.ini")
' >> Timeban
 call WriteConfigEntry("Timeban","KickEnabled", timeban_kick_enabled, "config.ini")
end Sub

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

'==========================================================================
'====================== Полезные процедуры и функции ======================

Function GetCurrentTime
 GetCurrentTime = EncodeDateTime(Year(date), Month(Date), Day(Date), Hour(Time), Minute(Time), Second(Time))
end Function

Sub DecodeDateTime(d_hash, out_year, out_month, out_day, out_hour, out_minute, out_sec)
  For i = 0 to 3000
   if (Int(i/4) - i/4) = 0 Then
    if (d_hash - 31449600) < 0 Then
     out_year = i
     exit for
    else
     d_hash = d_hash - 31449600
    end if
   else
    if (d_hash - 31536000) < 0 Then
     out_year = i
     exit for
    else
     d_hash = d_hash - 31536000
    end if
   end if
  next
 For i = 1 to 365
  if (d_hash - 86400) < 0 Then
   out_day = i
   exit for
  else
   d_hash = d_hash - 86400
  end if
 next
 For i = 1 to 12
  if (Int(out_year/4) - out_year/4) = 0 Then
   if (out_day - GetMonthDayCount(i, True)) <= 0 Then
    out_month = i
    exit for
   else
    out_day = out_day - GetMonthDayCount(i, True)
   end if
  else
   AddChat vbred, out_day
   if (out_day - GetMonthDayCount(i, False)) <= 0 Then
    out_month = i
    exit for
   else
    out_day = out_day - GetMonthDayCount(i, False)
   end if 
  end if
 next
 out_hour = Int(d_hash/3600)
 d_hash = d_hash - out_hour*3600
 out_minute = Int(d_hash/60)
 out_sec = d_hash - out_minute*60
end sub

Function EncodeDateTime(m_Year, m_Month, m_day, m_hour, m_minute, m_sec)
 daycount = 0
  For i = 0 to m_Month-1
   if (Int(m_Year/4) - m_Year/4) = 0 Then
    daycount = daycount + GetMonthDayCount(i, True)
   else
    daycount = daycount + GetMonthDayCount(i, False)
   end if
  next
 year_sec = 0
 For i = 0 to m_Year-1
  if (Int(i/4) - i/4) = 0 Then
   year_sec = year_sec + 31449600
  else
   year_sec = year_sec + 31536000
  end if
 next
 EncodeDateTime = m_sec + m_minute*60 + m_hour*3600 + 86400*(daycount + m_day - 1) + year_sec
End Function

Function GetMonthDayCount(m_month, etype)
 select case m_month
  case 1: GetMonthDayCount = 31
  case 2: if etype Then GetMonthDayCount = 29 Else GetMonthDayCount = 28 end if
  case 3: GetMonthDayCount = 31
  case 4: GetMonthDayCount = 30
  case 5: GetMonthDayCount = 31
  case 6: GetMonthDayCount = 30
  case 7: GetMonthDayCount = 31
  case 8: GetMonthDayCount = 31
  case 9: GetMonthDayCount = 30
  case 10: GetMonthDayCount = 31
  case 11: GetMonthDayCount = 30
  case 12: GetMonthDayCount = 31
  case else GetMonthDayCount = 0
 end select
end function

' 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
 if Username = MyUsername Then
  Verify_User_Command = 1
  exit Function
 end if
 If LCase(UserFlags) = "a" Then
  Verify_User_Command = 1
  exit Function
 end if
 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
 If (LCase(UserFlags) = LCase(Need_Flags)) and (Need_Flags<>vbNullString) Then
  Verify_User_Command = 1
  exit Function
 end if
 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
 if UserAccess >= Int(Need_access) Then
  Verify_User_Command = 1
  exit Function   
 end if
 Verify_User_Command = 0
end Function

' преобразует строковое значение "True" ("Flase") в булевское
Function Str2Bool(bs2)
 if LCase(bs2) = "true" Then
  Str2Bool = True
 else
  Str2Bool = False
 end if
end Function

'==========================================================================
'===================== Стандартные события StealthBot =====================

Sub Event_Load()
 AddChat vbCyan, "[ TRIVIA ] [Ссылки скрыты от гостей.] Edition (version " & CurrentVersion & ")"
 AddChat vbCyan, "Обновлённую версию скрипта, а также новые скрипты можно найти на сайте: http://D3scene.ru"
 AddChat vbCyan, "Сообщить об ошибке: http://D3scene.ru/forum.php"
 AddChat vbCyan, "Заходите на наш сайт [Ссылки скрыты от гостей.]! Всегда рады вас видеть!"
 if GetBotVersion() <> "StealthBot v2.6" Then
  AddChat vbred, "[TRIVIA] ВНИМИАНИЕ: скрипт v" & CurrentVersion & " разрабатывался под StealthBot v2.6, у вас " & GetBotVersion()
 end if
 current_product = vbNullString
 call TimeBan_init()
 call Load_Event()
 call triv_Event_Load()
 If BotFlags And 2 Then
  is_istrator = True
  AddChat vbRed, "[ADMIN] Бот может администрировать канал."
 else
  is_istrator = False 
 end if
 call GetRusTriviaNews
End sub

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

Sub Event_ServerError(Message)
 call civ_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,"[FRS] Бот был забанен по IP за флуд на канале. Не принимайте меры по его подключению к серверу. Он сделает это сам через " & flood_p_arec_time & " минут."
   w_trivia = trivia_enabled
   trivia_enabled = False
  end if
 end if 
End Sub

Sub Event_UserTalk(Username, Flags, Message, Ping)
' переименование пользователей в StarCraft
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
 if renamed_shell = True Then
  call Command(Username, Message ,True)
 end if
end if

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

Sub Event_UserEmote(Username, Flags, Message)
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
end if
End Sub

Sub Event_WhisperFromUser(Username, Flags, Message)
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
end if
 send_to_whisper = "/w " & D2s &  Username & " " & StarCraftPrefix
 Call UserTalk(Username, Flags, Message, 0)
 call AdvancedHelp(Username, Message)
 call WhisperFromUser_Event(Username, Flags, Message)
 call TimeBan_UserTalk(Username, Flags, Message, 0)
 send_to_whisper = vbNullString
End Sub

Sub Event_FlagUpdate(Username, NewFlags, Ping)
 if Username = MyUsername Then
  If BotFlags And 2 Then
   is_istrator = True
   AddChat vbRed, "[ADMIN] Бот может администрировать канал."
  else
   is_istrator = False 
  end if 
 end if
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
end if
 call FlagUpdate_Event(Username, NewFlags, Ping)
End Sub

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

Sub Event_UserInChannel(Username, Flags, Message, Ping, Product)
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
end if
 call UserInChannel_Event(Username, Flags, Message, Ping, Product)
End Sub

' заджойнился на канал
Sub Event_ChannelJoin(ChannelName, Flags)
 If BotFlags And 2 Then
  is_istrator = True
  AddChat vbRed, "[ADMIN] Бот может администрировать канал."
 else
  is_istrator = False 
 end if
End Sub

' когда пользователь набирает строку и нажимает Enter
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 TimeBan_UserTalk(myUsername, 0, Text, 0)
 call PressedEnter_Event(Text)
End Sub

' когда пользователь приходит на канал
Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
 if Username = MyUsername Then
  If BotFlags And 2 Then
   is_istrator = True
   AddChat vbRed, "[ADMIN] Бот может администрировать канал!"
  else
   is_istrator = False
  end if
 end if
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
end if
 call UserJoins_Event(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
 call TimeBan_userjoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring)
' автозапуск тривии
 if no_hears_stopped Then
  no_hears_stopped = False
  if lines_num = 0 then
   AddChat vbred, "[TRIVIA] Не удалось запустить Trivia так как вопросы не загружены!"
   exit sub
  end if
  trivia_enabled = True
  hints = -1
  call resetTriviaTimer
  AddChat vbgreen, "[TRIVIA] Викторина продолжена!"
  if fast_question Then
   call Trivia_Time
  end if
 end if
End Sub

' когда пользователь уходит с канала
Sub Event_UserLeaves(Username, Flags)
if starcraft_rename and (current_product = "PXES") Then
 cline = split(Username, "@")
 Username = Cline(0)
 if Ubound(cline) > 0 Then
  StarCraftPrefix = "@" & cline(1)
 end if
end if
 call UserLeaves_Event(Username, Flags)
End Sub

Sub Event_LoggedOff()
 current_product = vbNullString
 If trivia_enabled Then 
  trivia_enabled = False
  hints = -1
  timer_trigger = False
  AddChat vbGreen, "[TRIVIA] 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

Sub scTimer_Timer()
' anti_flood_time
  if ftime>0 Then
   ftime = ftime - sctimer.Interval
  end if

' Time ban
  call TimeBan_Timer()

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

  if flood_rec_time < 0 then
   AddChat vbGreen, "[FRS] Прошло " & 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

'as
'1.35
'&Anti-Spam:Swent
'&aslevel:aslevel <integer>
'&18381
'&Anti-Spam only affects users with less than 20 access:Settings for this plugin can be found in pluginsettings.ini:To end a user's timeban punishment you must use ".untimeban <username>":Remember that this script is not intended for protection against heavy spam/flood bot attacks

'// Anti-Spam
'//   by Swent
'//     Last ified 12:01 PM 12/16/2007 by Swent


'// ver 1.35
'//   *Added the protect_safelisted setting. False by default. If True, users on bot's safelist are protected from Anti-Spam
'// ver 1.33
'//   *The safe_level setting can now handle flags (Thanks bambambigellow)
'//      -Setting must be either an access level or a flag. It will not handle a combination.
'// ver 1.32
'//   *Fixed a problem with the channel ops check
'// ver 1.31
'//   *Made some minor tweaks to various anti-spam components
'//   *Fixed an error where a user could be kicked after a single message
'//   *Added the ignore_emotes setting
'// ver 1.3
'//   *Added increasing timeban duration for repeat offenders (can be disabled)
'//   *Added descriptions of sensitivity in .aslevel command response
'// ver 1.2
'//   *Added some additonal spam checks based on various suggestions
'//      -Anti-spam will now trigger based on repetitive characters/words and repetitive messages
'//      -These additional checks can be disabled in pluginsettings.ini
'// ver 1.1
'//   *Fixed rare error where anti-spam would trigger after a user only typed one message


Public asMsgLog, asInterval, asMsgLimit, asDisplay, asLvlDscrps

Sub as_Event_Load()

  Set asMsgLog = CreateObject("Scripting.Dictionary")

  '// **Do not ify settings here** Settings ifications should be made in pluginsettings.ini / settings.ini
  SetSetting "as", "level", 6, "Anti-Spam Sensitivity. 13 = Extremely sensitive, 1 = Extremely loose. Recommended: 6", False
  SetSetting "as", "aslevel_cmd_access", 60, "Access required to use the aslevel command", False
  SetSetting "as", "safe_access", 20, "Anti-Spam will not affect users with at least this access or flag (one or the other)", False
  SetSetting "as", "protect_safelisted", False, "If True, Anti-Spam will not affect users in your bot's safelist", False
  SetSetting "as", "ignore_emotes", False, "If True, anti-spam will ignore emoted messages", False
  SetSetting "as", "repeat_sensitive", True, "If True, extra sensitivity is added for repeat messages", False
  Setsetting "as", "repetitive_msg_sensitive", True, "If True, extra sensitivity is added for repetitive message content (words and characters)", False
  setSetting "as", "display_trigger", True, "If True, reason anti-spam was triggered will be displayed in bot.", False
  SetSetting "as", "punish_cmd", "kick", "Punishment command. *If you have the timeban plugin*, you can set to timeban", False
  SetSetting "as", "tban_time", 10, "Seconds to timeban spammers (this and the following settings only apply if punish_cmd=timeban)", False
  SetSetting "as", "inc_duration", True, "If True, timeban duration will be increased for repeat offenders", False
  SetSetting "as", "offense_memory", 24, "Number of hours offenders will be remembered", False

  '// If punish_cmd is timeban make sure they have the plugin
  If GetSetting("as", "punish_cmd") = "timeban" And Not psPlugins.Exists("timeban") Then
    AddChat vbCyan, "The timeban plugin is required if punish_cmd=timeban"
    Event_PressedEnter "/getplugin timeban"
  End If

  asLvlDscrps = Array("Extremely Loose","Loose","Moderate","Sensitive","Extremely Sensitive")

  Call as_set_sensitivity()
End Sub


Sub as_Event_UserTalk(Username, Flags, Message, Ping)

  GetDBEntry Username, myAccess, myFlags
  If Username = BotVars.Username Then asDisplay = 4 Else asDisplay = 3 End If

  If Left(Message, 1) = BotVars.Trigger Or Left(Message, 1) = "/" Then

    If Len(Message) < 2 Then Exit Sub
    cmd = Split(Mid(LCase(Trim(Message)), 2))
    If cmd(0) = "aslevel" Then
      aslevel_cmd cmd, Username, myAccess: Exit Sub
    End If
  End If

  '// User is safelisted?
  If GetSetting("as", "protect_safelisted") Then
    If IsSafelisted(Username) Then Exit Sub
  End If

  '// At or above safe level / has safe flag?
  strSafe = GetSetting("as", "safe_level")
  If IsNumeric(strSafe) Then
    If myAccess >= CInt(strSafe) Then Exit Sub
  Else
    If Instr(myFlags, strSafe) Then Exit Sub
  End If

  '// Make sure they aren't an op
  If GetInternalDataByUsername(Username, 1) And 2 Then Exit Sub

  '// Is this a repetitive message?
  If GetSetting("as", "repetitive_msg_sensitive") Then

    '// Long enough to indicate spam?
    If Len(Message) > 150 \ GetSetting("as", "level") Then
      arrMsg = Split(Message)

      '// Check for repetitive words
      For i = 0 to UBound(arrMsg)
        If UBound(arrMsg) > 75 \ GetSetting("as", "level") And Len(arrMsg(i)) > 1 And UBound(Split(Message, " " & arrMsg(i) & " ")) > UBound(arrMsg) \ 2 Then
          index = i
          repCheck = 1
        End If
      Next

      '// Check for repetitive characters
      For i = 1 to Len(Message)
        strRepChar = String(75 \ GetSetting("as", "level"), Mid(Message, i, 1))
        If Len(Trim(strRepChar)) > 0 And Instr(Message, strRepChar) Then
          index = i
          repCheck = 2
        End If
      Next

      If repCheck > 0 Then
        spam = True
        If Not asMsgLog.Exists(Username) Then asMsgLog.Add Username, Array(0, "", 0, 0, 1)
        If repCheck = 1 Then as_display_trigger "Repetitive word: """ & arrMsg(index) & """"
        If repcheck = 2 Then as_display_trigger "Repetitive character: '" & Mid(Message, index, 1) & "'"
      End If
    End If
  End If

  If asMsgLog.Exists(Username) Then

    '// Was this message sent within the spam interval?
    If GetGTC() - asMsgLog.Item(Username)(0) <= asInterval Or spam Then

      '// Is this user spamming?
      If GetSetting("as", "repeat_sensitive") And asMsgLog.Item(Username)(2) >= asMsgLimit - 1 And Match(asMsgLog.Item(Username)(1), Message, 1) Then
        as_display_trigger asMsgLog.Item(Username)(2) + 1 & " *identical* messages within the spam interval (" & asInterval & " ms)"
        spam = True
      ElseIf asMsgLog.Item(Username)(2) = asMsgLimit Then
        as_display_trigger asMsgLog.Item(Username)(2) + 1 & " messages within the spam interval (" & asInterval & " ms)"
        spam = True
      End If

      '// If they're spamming, punish them
      punishCmd = Trim(GetSetting("as", "punish_cmd"))
      If spam Then
        If punishCmd = "timeban" Then
          If psPlugins.Exists("timeban") Then

            '// If they've been punished recently (past 24 hours) increase the severity
            If GetSetting("as", "inc_duration") Then
              If abs(DateDiff("h", asMsgLog.Item(Username)(3), Now())) < CInt(GetSetting("as", "offense_memory")) Then
                intDuration = GetSetting("as", "tban_time") * asMsgLog.Item(Username)(4) ^ 2
                strOffense = " - Offense #" & asMsgLog.Item(Username)(4)
              End If
              asMsgLog.Item(Username) = Array(0, "", 0, Now(), asMsgLog.Item(Username)(4) + 1)
            Else
              asMsgLog.Remove Username
            End If
            If Len(intDuration) = 0 Then intDuration = GetSetting("as", "tban_time")

            Call timeban_Event_PressedEnter("/timeban " & Username & " s/" & intDuration & " Spamming" & strOffense)
          Else
	    AddChat vbRed, "Anti-Spam Error: You must have the timeban plugin if punish_cmd=timeban. Type /getplugin timeban"
	  End If
        Else
          Command BotVars.Username, "/" & punishCmd & " " & Username & " Spamming", True
          asMsgLog.Remove Username
        End If
        Exit Sub
      End If
      asMsgLog.Item(Username) = Array(GetGTC(), Message, asMsgLog.Item(Username)(2) + 1, asMsgLog.Item(Username)(3), asMsgLog.Item(Username)(4))
    Else
      asMsgLog.Item(Username) = Array(GetGTC(), Message, 1, asMsgLog.Item(Username)(3), asMsgLog.Item(Username)(4))
    End If
  Else
    asMsgLog.Add Username, Array(GetGTC(), Message, 1, 0, 1)
  End If
End Sub


Sub as_Event_UserEmote(Username, Flags, Message)

  If Not GetSetting("as", "ignore_emotes") Then
    as_Event_UserTalk Username, Flags, Message, 0
  End If
End Sub


Sub as_Event_PressedEnter(Text)

  If Len(Text) < 2 Or Left(Text, 1) <> "/" Then Exit Sub
  cmd = Split(Mid(LCase(Trim(Text)), 2))

  Select Case cmd(0)
    Case "aslevel"
      VetoThisMessage
      as_Event_UserTalk BotVars.Username, "", Text, 0
  End Select
End Sub


Sub aslevel_cmd(cmd, Username, Access)

  If Access < CInt(GetSetting("as", "aslevel_cmd_access")) And Username <> BotVars.Username Then Exit Sub

  If UBound(cmd) = 0 Then
    intLevel = GetSetting("as", "level")
    dsp asDisplay, "The Anti-Spam sensitivity is at level " & intLevel & " (" & asLvlDscrps(intLevel \ 3) & ").", Username, vbCyan
  Else
    If IsNumeric(cmd(1)) Then
      If cmd(1) > 0 And cmd(1) < 14 Then
        SetSetting "as", "level", Int(cmd(1)), "", True
        Call as_set_sensitivity()
        dsp asDisplay, "Set Anti-Spam sensitivity to level " & cmd(1) & " (" & asLvlDscrps(cmd(1) \ 3) & ").", Username, vbCyan
      Else
        dsp asDisplay, "The Anti-Spam level must be an integer from 1 to 13", Username, vbRed
      End If
    Else
      dsp asDisplay, "Proper format: " & BotVars.Trigger & "aslevel <integer>", Username, vbRed
    End If
  End If
End Sub


Sub as_set_sensitivity()

  '// Custom timing changes can be made here *if you know what you're doing*
  '//   asInterval = maximum interval between each message in milliseconds
  '//   asMsgLimit = required number of consecutive messages within interval
  Select Case GetSetting("as", "level")
    Case 13: asInterval = 3500: asMsgLimit = 1 'Extremely Sensitive
    Case 12: asInterval = 3400: asMsgLimit = 1 '   ''
    Case 11: asInterval = 3300: asMsgLimit = 2 'Sensitive
    Case 10: asInterval = 3100: asMsgLimit = 2 '   ''
    Case 9:  asInterval = 2900: asMsgLimit = 2 '   ''
    Case 8:  asInterval = 2700: asMsgLimit = 2 'Moderate
    Case 7:  asInterval = 2650: asMsgLimit = 2 '   ''  
    Case 6:  asInterval = 2600: asMsgLimit = 2 '   ''
    Case 5:  asInterval = 2400: asMsgLimit = 2 'Loose
    Case 4:  asInterval = 2200: asMsgLimit = 2 '   '' 
    Case 3:  asInterval = 2000: asMsgLimit = 2 '   ''
    Case 2:  asInterval = 1900: asMsgLimit = 3 'Extremely Loose
    Case 1:  asInterval = 1800: asMsgLimit = 3 '   ''
  End Select
End Sub


Sub as_display_trigger(Trigger)
   
  If GetSetting("as", "display_trigger") Then
    AddChat vbCyan, "Anti-Spam Triggered: " & Trigger
  End If
End Sub
Добавлено через 20 часов 55 минут
Ну че там у меня не так?

Последний раз редактировалось eHoT; 17.04.2008 в 21:28. Причина: Добавлено сообщение
  Наверх
Старый 18.04.2008, 16:14   #49
Кодер-Дизайнер

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

Хм енот а у тебя voprosi.txt не пустой?
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 18.04.2008, 18:57   #50
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

Не не пустой. Я сам хз че там не так вроде везде порылся проверил переустановил и нифига... Бот тока на .pingme реагирует.
  Наверх
Старый 18.04.2008, 22:12   #51
- - - - avp]@94 - - - -
 
Аватар для dog94
 
Регистрация: 01.03.2008
Сообщений: 49
Репутация: 29
Отправить сообщение для dog94 с помощью ICQ
По умолчанию

ты 100 A отдельно написал?
  Наверх
Старый 18.04.2008, 22:17   #52
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

И слитно и отдельно)
__________________
Жизнь состоит не из черного и белого, а из черного и серого...
Keep ur soul open...
  Наверх
Старый 18.04.2008, 22:21   #53
- - - - avp]@94 - - - -
 
Аватар для dog94
 
Регистрация: 01.03.2008
Сообщений: 49
Репутация: 29
Отправить сообщение для dog94 с помощью ICQ
По умолчанию

100 нужно писать в отдельном пространстве что A. 100 под acces A под flags
  Наверх
Старый 18.04.2008, 22:33   #54
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

хм скинь плз свой accecs сюда
Сравнить хочу...
__________________
Жизнь состоит не из черного и белого, а из черного и серого...
Keep ur soul open...

Последний раз редактировалось eHoT; 18.04.2008 в 22:37.
  Наверх
Старый 20.04.2008, 15:39   #55
Освоившийся
 
Аватар для Ilya89
 
Регистрация: 09.03.2008
Адрес: Москва, Россия
Сообщений: 703
Репутация: 470
Отправить сообщение для Ilya89 с помощью ICQ
По умолчанию

AlfaDogg, слышь, как можно испавить такую дурь: допустим у меня вопросы так идут: "Какой первый скилл у архимага?*Буран; так, а щас у меня вот так "Какой первый скилл у архимага? | Буран"; кароче надо * заменить на |, а вопросов у меня 9000, сам понимаешь ленифо, менять а ошибка в скрипте возникает, типа не тот символ
  Наверх
Старый 20.04.2008, 15:43   #56
Кодер-Дизайнер

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

ищи програмку которая меняет 1 символ на другой
__________________
Когда власть любви превзойдет любовь к власти, настанет мир на земле. ©Jimi Hendrix
Я ставлю форумы... особые форумы... кто хочет увидеть не много выбулетиона?
  Наверх
Старый 20.04.2008, 15:51   #57
Освоившийся
 
Аватар для Ilya89
 
Регистрация: 09.03.2008
Адрес: Москва, Россия
Сообщений: 703
Репутация: 470
Отправить сообщение для Ilya89 с помощью ICQ
По умолчанию

кхе кхе, эта какая програмка... поконкретнее я
  Наверх
Старый 21.04.2008, 05:04   #58
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

Альфа так правильно должен выглядтьб accecs?

[Flags]
efe)ehot 100A
[Numeric]
;Warning!
; Adding anything other than a number as the required access for a command
; will result in that command being available with 0 ACCESS.

pingme=0
__________________
Жизнь состоит не из черного и белого, а из черного и серого...
Keep ur soul open...
  Наверх
Старый 21.04.2008, 08:13   #59
Местный
 
Аватар для baT
 
Регистрация: 01.03.2008
Адрес: из лесу
Сообщений: 92
Репутация: 53
По умолчанию

Цитата:
Сообщение от eHoT Посмотреть сообщение
efe)ehot 100A
[
пробел между 100 и A поставь
__________________
[Ссылки скрыты от гостей.]
  Наверх
Старый 21.04.2008, 13:17   #60
Гость_за_инактив
 
Аватар для eHoT
 
Регистрация: 16.04.2008
Адрес: Питер
Сообщений: 27
Репутация: 1
Отправить сообщение для eHoT с помощью ICQ
По умолчанию

Пробел поставил. Все равно кроме пинга ничо не отвечает. Бля я реально не понимаю че за фигня!*sos*
__________________
Жизнь состоит не из черного и белого, а из черного и серого...
Keep ur soul open...
  Наверх
Закрытая тема

Метки
Bot, FAQ по боту, Help Stealth bot, Stealth, Stealth Bot, Бот, Бот балтун, Вопросы по боту, Помощь с ботом, Стелс Бот


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

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

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

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


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