daily pastebin goal
11%
SHARE
TWEET

VBScript IRC Bot

mabu Nov 28th, 2014 180 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.         Const strServer = "server name here"
  3.         Const intPort = 6667
  4.         Const PING = "PING :"
  5.         Const strNick = "Bot nick here"
  6.         Const strUserAgent = "IRC bot written in VBScript"
  7.         Dim objWinsock, bEndWork, bConnected, intPingCount
  8.         bEndWork = True
  9.         ' Каналы для присоединения
  10.         Dim astrChannels(0)
  11.         astrChannels(0) = "#channels"
  12.        
  13.         ' создали сокет
  14.         Set objWinsock = CreateObject("MSWinsock.Winsock")
  15.         ' Добавление обработчиков событий
  16.         WScript.ConnectObject objWinsock, "objWinsock_"
  17.        
  18.         ' устанавливаем соединение с сервером
  19.         LogData("Соединяюсь с сервером " & strServer & ":" & CStr(intPort))
  20.         objWinsock.Connect strServer, intPort
  21.        
  22.         ' ждем пока завершится обработка событий сокета
  23.         Do While bEndWork
  24.                 WScript.Sleep 100
  25.                 ' Буду каждые 60 секунд отправлять пинги
  26.                 REM intPingCount = intPingCount + 1
  27.                 REM If intPingCount > 600 Then
  28.                         REM intPingCount = 0
  29.                         REM If bConnected Then
  30.                                 REM objWinsock.SendData PING & strServer & vbCrLf
  31.                                 REM LogData(PING & strServer)
  32.                         REM End if
  33.                 REM End If
  34.         Loop
  35.        
  36.         Set objWinsock = Nothing
  37.        
  38. ' Обработка сообщения с канала
  39. Function ChannelMessage(strChannel, strUserName, strMessageText)
  40.        
  41. End Function
  42.  
  43. ' Обработка личного сообщения
  44. Function PrivateMessage(strUserName, strMessageText)
  45.         ' Заглушка
  46.         SendMessage strUserName, "Здравствуй. Я " & strNick & ". Я ещё не умею полноценно отвечать на личные сообщения."
  47. End Function
  48.  
  49. ' мы присоединились к серверу
  50. Sub objWinsock_Connect
  51.         LogData("Соединился")
  52.         ' Отправляем ник
  53.         objWinsock.SendData "NICK " & strNick & vbCrLf
  54.         LogData("NICK " & strNick)
  55.         ' Отправляем Юзер-строку
  56.         objWinsock.SendData "USER " & strNick & " 0 * :" & strUserAgent & vbCrLf
  57.         LogData("USER " & strNick & " 0 * :" & strUserAgent)
  58. End Sub
  59.  
  60. ' Ошибка сокета
  61. Sub objWinsock_Error(Number, Description, SCode, Source, HelpFile, HelpContext, CancelDisplay)
  62.         WScript.Echo "Ошибка", Number, SCode, Description
  63.         bConnected = False
  64.         objWinsock.Close
  65.         Set objWinsock = Nothing
  66.         bEndWork = False
  67. End Sub
  68.  
  69. ' Закрытие соединения
  70. Sub objWinsock_Close
  71.         ' Уничтожаем объект и выходим, хотя можно было бы перезапустить подключение заново
  72.         bConnected = False
  73.         objWinsock.Close
  74.         Set objWinsock = Nothing
  75.         bEndWork = False
  76. End Sub
  77.  
  78. ' Данные от сервера
  79. Sub objWinsock_DataArrival(bytTotal)
  80.         Dim strData, strTemp
  81.         ' Получение данных
  82.         objWinsock.GetData strData, 8
  83.         ' Преобразуем utf8 в строку
  84.         strData = DecodeUTF8(strData)
  85.         ' Выводим данные
  86.         LogData(strData)
  87.         ' Закомментировал, так как будет дублирование информации на экран
  88.         'LogData(strData)
  89.         ' Разбиваем на строки и отправляем на обработчик данных
  90.         For Each strTemp In Split(strData, vbCrLf)
  91.                 ' Пустые строки пропускаем
  92.                 If Len(strTemp) > 0 Then
  93.                         ParseData(strTemp)
  94.                 End If
  95.         Next
  96. End Sub
  97.  
  98. ''' Разбор данных от сервера
  99. Function ParseData(strData)
  100.         ' Разделини данные по пробелам
  101.         Dim ircData ' массив, но без скобок, это нужно для Split
  102.         ircData = Split(strData, " ")
  103.         ' Если сообщение начинается с PING, мы должны отправить PONG
  104.         If ircData(0) = "PING" Then
  105.                 ' отправляем понг без двоеточия в начале
  106.                 objWinsock.SendData "PONG " & EncodeUTF8(ircData(1)) & vbCrLf
  107.                 LogData("PONG " & ircData(1))
  108.         Else
  109.                 ' Определяем команду
  110.                 Select Case ircData(1)
  111.                         Case "001" 'RPL_WELCOME
  112.                                 ' Сервер приветствует
  113.                                 Dim strChannel
  114.                                 ' Присоединяемся к каналам
  115.                                 For Each strChannel In astrChannels
  116.                                         JoinChannel(strChannel)
  117.                                 Next
  118.                         Case "JOIN"
  119.                                 ' Кто-то присоединился к каналу
  120.                         Case "NICK"
  121.                                 ' Кто-то сменил ник
  122.                         Case "NOTICE"
  123.                                 ' Уведомление
  124.                         Case "PRIVMSG"
  125.                                 ' Сообщение от канала или пользователя
  126.                                 ' В ircData(2) содержится имя получателя
  127.                                 If LCase(ircData(2)) = LCase(strNick) Then
  128.                                         PrivateMessage Mid(ircData(0), 2, InStr(ircData(0), "!") - 2), Mid(JoinArray(ircData, 3), 2)
  129.                                 Else
  130.                                         ChannelMessage ircData(2), Mid(ircData(0), 2, InStr(ircData(0), "!") - 2), Mid(JoinArray(ircData, 3), 2)
  131.                                 End If
  132.                         Case "PART"
  133.                                 ' Пользователь покинул канал
  134.                         Case "QUIT"
  135.                                 ' Кто-то вышел
  136.                         Case "PONG"
  137.                                 ' Ответ от сервера
  138.                 End Select
  139.         End If
  140. End Function
  141.  
  142. ' Объединяет массив в строку начиная с указанного номера
  143. Function JoinArray(astrArray, StartIndex)
  144.         Dim i, strTemp
  145.         For i = StartIndex To UBound(astrArray) - 1
  146.                 strTemp = astrArray(i) & " "
  147.         Next
  148.         JoinArray = strTemp & astrArray(UBound(astrArray))
  149. End Function
  150.  
  151. ' Присоединение к каналу
  152. Function JoinChannel(strChannel)
  153.         objWinsock.SendData "JOIN " & EncodeUTF8(strChannel) & vbCrLf
  154.         LogData("JOIN " & strChannel)
  155. End Function
  156.  
  157. ' Отправка сообщения в канал (или пользователю)
  158. Function SendMessage(strChannel, strText)
  159.         objWinsock.SendData "PRIVMSG " & EncodeUTF8(strChannel) & " :" & EncodeUTF8(strText) & vbCrLf
  160.         LogData("PRIVMSG " & strChannel & " :" & strText)
  161. End Function
  162.  
  163. ' Ведёт лог-файл
  164. Function LogData(strData)
  165.         ' Заглушка, необходимо делать полноценный лог-файл
  166.         WScript.Echo strData
  167. End Function
  168.  
  169. ' Функции для работы с utf8
  170. ' эти функции я стащил с хабры habrahabr.ru/post/138173/
  171. ' Преобразует строку в utf8
  172. Function EncodeUTF8(s)
  173.     Dim i, c, utfc, b1, b2, b3
  174.    
  175.     For i=1 to Len(s)
  176.         c = ToLong(AscW(Mid(s,i,1)))
  177.  
  178.         If c < 128 Then
  179.             utfc = chr( c)
  180.         ElseIf c < 2048 Then
  181.             b1 = c Mod &h40
  182.             b2 = (c - b1) / &h40
  183.             utfc = chr(&hC0 + b2) & chr(&h80 + b1)
  184.         ElseIf c < 65536 And (c < 55296 Or c > 57343) Then
  185.             b1 = c Mod &h40
  186.             b2 = ((c - b1) / &h40) Mod &h40
  187.             b3 = (c - b1 - (&h40 * b2)) / &h1000
  188.             utfc = chr(&hE0 + b3) & chr(&h80 + b2) & chr(&h80 + b1)
  189.         Else
  190.             ' Младший или старший суррогат UTF-16
  191.            utfc = Chr(&hEF) & Chr(&hBF) & Chr(&hBD)
  192.         End If
  193.                
  194.         EncodeUTF8 = EncodeUTF8 + utfc
  195.     Next
  196. End Function
  197.  
  198. Function ToLong(intVal)
  199.     If intVal < 0 Then
  200.         ToLong = CLng(intVal) + &H10000
  201.     Else
  202.         ToLong = CLng(intVal)
  203.     End If
  204. End Function
  205.  
  206. ' преобразуем из utf8 в строку
  207. Function DecodeUTF8(s)
  208.     Dim i, c, n, b1, b2, b3
  209.        
  210.     i = 1
  211.     Do While i <= len(s)
  212.         c = asc(mid(s,i,1))
  213.         If (c and &hC0) = &hC0 Then
  214.             n = 1
  215.             Do While i + n <= len(s)
  216.                 If (asc(mid(s,i+n,1)) and &hC0) <> &h80 Then
  217.                     Exit Do
  218.                 End If
  219.                 n = n + 1
  220.             Loop
  221.             If n = 2 and ((c and &hE0) = &hC0) Then
  222.                 b1 = asc(mid(s,i+1,1)) and &h3F
  223.                 b2 = c and &h1F
  224.                 c = b1 + b2 * &h40
  225.             Elseif n = 3 and ((c and &hF0) = &hE0) Then
  226.                 b1 = asc(mid(s,i+2,1)) and &h3F
  227.                 b2 = asc(mid(s,i+1,1)) and &h3F
  228.                 b3 = c and &h0F
  229.                 c = b3 * &H1000 + b2 * &H40 + b1
  230.             Else
  231.                 ' Символ больше U+FFFF или неправильная последовательность
  232.                c = &hFFFD
  233.             End if
  234.             s = left(s,i-1) + chrw( c) + mid(s,i+n)
  235.         Elseif (c and &hC0) = &h80 then
  236.             ' Неожидаемый продолжающий байт
  237.            s = left(s,i-1) + chrw(&hFFFD) + mid(s,i+1)
  238.         End If
  239.         i = i + 1
  240.     Loop
  241.     DecodeUTF8 = s
  242. End Function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top