VBScript IRC Bot

Option Explicit
    Const strServer = "server name here"
    Const intPort = 6667
    Const PING = "PING :"
    Const strNick = "Bot nick here"
    Const strUserAgent = "IRC bot written in VBScript"
    Dim objWinsock, bEndWork, bConnected, intPingCount
    bEndWork = True
    ' Каналы для присоединения
    Dim astrChannels(0)
    astrChannels(0) = "#channels"

    ' создали сокет
    Set objWinsock = CreateObject("MSWinsock.Winsock")
    ' Добавление обработчиков событий
    WScript.ConnectObject objWinsock, "objWinsock_"

    ' устанавливаем соединение с сервером
    LogData("Соединяюсь с сервером " & strServer & ":" & CStr(intPort))
    objWinsock.Connect strServer, intPort

    ' ждем пока завершится обработка событий сокета
    Do While bEndWork
        WScript.Sleep 100
        ' Буду каждые 60 секунд отправлять пинги
        REM intPingCount = intPingCount + 1
        REM If intPingCount > 600 Then
            REM intPingCount = 0
            REM If bConnected Then
                REM objWinsock.SendData PING & strServer & vbCrLf
                REM LogData(PING & strServer)
            REM End if
        REM End If
    Loop

    Set objWinsock = Nothing

' Обработка сообщения с канала
Function ChannelMessage(strChannel, strUserName, strMessageText)

End Function

' Обработка личного сообщения
Function PrivateMessage(strUserName, strMessageText)
    ' Заглушка
    SendMessage strUserName, "Здравствуй. Я " & strNick & ". Я ещё не умею полноценно отвечать на личные сообщения."
End Function

' мы присоединились к серверу
Sub objWinsock_Connect
    LogData("Соединился")
    ' Отправляем ник
    objWinsock.SendData "NICK " & strNick & vbCrLf
    LogData("NICK " & strNick)
    ' Отправляем Юзер-строку
    objWinsock.SendData "USER " & strNick & " 0 * :" & strUserAgent & vbCrLf
    LogData("USER " & strNick & " 0 * :" & strUserAgent)
End Sub

' Ошибка сокета
Sub objWinsock_Error(Number, Description, SCode, Source, HelpFile, HelpContext, CancelDisplay)
    WScript.Echo "Ошибка", Number, SCode, Description
    bConnected = False
    objWinsock.Close
    Set objWinsock = Nothing
    bEndWork = False
End Sub

' Закрытие соединения
Sub objWinsock_Close
    ' Уничтожаем объект и выходим, хотя можно было бы перезапустить подключение заново
    bConnected = False
    objWinsock.Close
    Set objWinsock = Nothing
    bEndWork = False
End Sub

' Данные от сервера
Sub objWinsock_DataArrival(bytTotal)
    Dim strData, strTemp
    ' Получение данных
    objWinsock.GetData strData, 8
    ' Преобразуем utf8 в строку
    strData = DecodeUTF8(strData)
    ' Выводим данные
    LogData(strData)
    ' Закомментировал, так как будет дублирование информации на экран
    'LogData(strData)
    ' Разбиваем на строки и отправляем на обработчик данных
    For Each strTemp In Split(strData, vbCrLf)
        ' Пустые строки пропускаем
        If Len(strTemp) > 0 Then
            ParseData(strTemp)
        End If
    Next
End Sub

''' Разбор данных от сервера
Function ParseData(strData)
    ' Разделини данные по пробелам
    Dim ircData ' массив, но без скобок, это нужно для Split
    ircData = Split(strData, " ")
    ' Если сообщение начинается с PING, мы должны отправить PONG
    If ircData(0) = "PING" Then
        ' отправляем понг без двоеточия в начале
        objWinsock.SendData "PONG " & EncodeUTF8(ircData(1)) & vbCrLf
        LogData("PONG " & ircData(1))
    Else
        ' Определяем команду
        Select Case ircData(1)
            Case "001" 'RPL_WELCOME
                ' Сервер приветствует
                Dim strChannel
                ' Присоединяемся к каналам
                For Each strChannel In astrChannels
                    JoinChannel(strChannel)
                Next
            Case "JOIN"
                ' Кто-то присоединился к каналу
            Case "NICK"
                ' Кто-то сменил ник
            Case "NOTICE"
                ' Уведомление
            Case "PRIVMSG"
                ' Сообщение от канала или пользователя
                ' В ircData(2) содержится имя получателя
                If LCase(ircData(2)) = LCase(strNick) Then
                    PrivateMessage Mid(ircData(0), 2, InStr(ircData(0), "!") - 2), Mid(JoinArray(ircData, 3), 2)
                Else
                    ChannelMessage ircData(2), Mid(ircData(0), 2, InStr(ircData(0), "!") - 2), Mid(JoinArray(ircData, 3), 2)
                End If
            Case "PART"
                ' Пользователь покинул канал
            Case "QUIT"
                ' Кто-то вышел
            Case "PONG"
                ' Ответ от сервера
        End Select
    End If
End Function

' Объединяет массив в строку начиная с указанного номера
Function JoinArray(astrArray, StartIndex)
    Dim i, strTemp
    For i = StartIndex To UBound(astrArray) - 1
        strTemp = astrArray(i) & " "
    Next
    JoinArray = strTemp & astrArray(UBound(astrArray))
End Function

' Присоединение к каналу
Function JoinChannel(strChannel)
    objWinsock.SendData "JOIN " & EncodeUTF8(strChannel) & vbCrLf
    LogData("JOIN " & strChannel)
End Function

' Отправка сообщения в канал (или пользователю)
Function SendMessage(strChannel, strText)
    objWinsock.SendData "PRIVMSG " & EncodeUTF8(strChannel) & " :" & EncodeUTF8(strText) & vbCrLf
    LogData("PRIVMSG " & strChannel & " :" & strText)
End Function

' Ведёт лог-файл
Function LogData(strData)
    ' Заглушка, необходимо делать полноценный лог-файл
    WScript.Echo strData
End Function

' Функции для работы с utf8
' эти функции я стащил с хабры habrahabr.ru/post/138173/
' Преобразует строку в utf8
Function EncodeUTF8(s)
    Dim i, c, utfc, b1, b2, b3

    For i=1 to Len(s)
        c = ToLong(AscW(Mid(s,i,1)))

        If c < 128 Then
            utfc = chr( c)
        ElseIf c < 2048 Then
            b1 = c Mod &h40
            b2 = (c - b1) / &h40
            utfc = chr(&hC0 + b2) & chr(&h80 + b1)
        ElseIf c < 65536 And (c < 55296 Or c > 57343) Then
            b1 = c Mod &h40
            b2 = ((c - b1) / &h40) Mod &h40
            b3 = (c - b1 - (&h40 * b2)) / &h1000
            utfc = chr(&hE0 + b3) & chr(&h80 + b2) & chr(&h80 + b1)
        Else
            ' Младший или старший суррогат UTF-16
            utfc = Chr(&hEF) & Chr(&hBF) & Chr(&hBD)
        End If

        EncodeUTF8 = EncodeUTF8 + utfc
    Next
End Function

Function ToLong(intVal)
    If intVal < 0 Then
        ToLong = CLng(intVal) + &H10000
    Else
        ToLong = CLng(intVal)
    End If
End Function

' преобразуем из utf8 в строку
Function DecodeUTF8(s)
    Dim i, c, n, b1, b2, b3

    i = 1
    Do While i <= len(s)
        c = asc(mid(s,i,1))
        If (c and &hC0) = &hC0 Then
            n = 1
            Do While i + n <= len(s)
                If (asc(mid(s,i+n,1)) and &hC0) <> &h80 Then
                    Exit Do
                End If
                n = n + 1
            Loop
            If n = 2 and ((c and &hE0) = &hC0) Then
                b1 = asc(mid(s,i+1,1)) and &h3F
                b2 = c and &h1F
                c = b1 + b2 * &h40
            Elseif n = 3 and ((c and &hF0) = &hE0) Then
                b1 = asc(mid(s,i+2,1)) and &h3F
                b2 = asc(mid(s,i+1,1)) and &h3F
                b3 = c and &h0F
                c = b3 * &H1000 + b2 * &H40 + b1
            Else
                ' Символ больше U+FFFF или неправильная последовательность
                c = &hFFFD
            End if
            s = left(s,i-1) + chrw( c) + mid(s,i+n)
        Elseif (c and &hC0) = &h80 then
            ' Неожидаемый продолжающий байт
            s = left(s,i-1) + chrw(&hFFFD) + mid(s,i+1)
        End If
        i = i + 1
    Loop
    DecodeUTF8 = s
End Function