1. Вы находитесь в архивной версии форума xaker.name. Здесь собраны темы с 2007 по 2012 год, большинство инструкций и мануалов уже неактуальны.
    Скрыть объявление

VB. Создание ICQ бота!

Тема в разделе "Visual Basic", создана пользователем karas, 12 фев 2009.

  1. karas

    karas Продвинутый

    Регистрация:
    30 апр 2007
    Сообщения:
    59
    Симпатии:
    70
    Баллы:
    0
    Привет ребята! Соскучились? =) Начну. Вобщем все просто. Будем кодить простенького icq-бота на visual basic 6.0 (ток не надо говорить что это г ит.д.). Бэйсик классный язык, в чем мы сегодня с вами и убедимся =) Итак, нам потребуются:

    1. Visual basic 6.0
    2. ICQ движок (даю на растерзание мой activex-контрол vbicq3)
    3. UIN с паролем для бота
    4. Немного времени и желания кодить

    [Поехали]
    Зупускаем Visual Basic 6.0. Создаем Standart EXE проект. Сохраняем проект в папку.
    Качаем контрол, кидаем его в папку. Регистрируем его в винде (запустив RegisertComponent.bat)
    Добавляем контрол к нашему проекту:
    project->components
    [​IMG] [​IMG]

    На панели инструментов должен появиться новый инструмент(наш контрол). Добавляем его на форму и называем icq. Составляем простой интерфейс:

    [​IMG]

    Для чего нам два таймера? Один будет смотреть чтоб бот не вылетел, второй - рассылать сообщения. Теперь расскажу об архитектуре:
    Как известно, слишком часто отправлять сообщения в icq нельзя, имеется риск вылететь за первышение лимита. Поэтому наш бот должен отпралять сообщения не чаще чем каждые 1,5 секунды(если бот будет популярен, то сервер снизит ему этот лимит). Все исходящие сообщения будут помещаться в буффер, таймер будет их вытаскивать и рассылать. Итак, читаем код:

    Код:
    'Данные и структуры
    Const BuffSize = 10 'размер буфера отправки (очередь)
    
    'пользовательский тип - уин\сообшение
    Private Type UIN_MSG
        UIN As String
        MSG As String
    End Type
    
    Dim Buff(BuffSize) As UIN_MSG   'собственно сама очередь
    
    'загрузка формы
    Private Sub Form_Load()
        Timer1.Interval = Int(text_ping)    'присваиваем интервал
        Timer2.Interval = Int(text_send)    'присваиваем интервал
        'присваиваем контролу uin и пароль бота
        icq.UIN = "123456789"
        icq.Pass = "qwerty"
        Timer1.Enabled = False  'выключаем пинг-таймер
        Timer2.Enabled = True   'включаем рассыльщик
    End Sub
    
    'кнопка "включить"
    Private Sub but_on_Click()
        Timer1.Enabled = Not Timer1.Enabled 'вкл\выкл таймера
        If Timer2.Enabled Then
            but_on.Caption = "Выключить"
        Else
            but_on.Caption = "Включить"
            icq.CloseConnection
        End If
    End Sub
    
    'Пинг-таймер
    Private Sub Timer1_Timer()
        If Int(text_ping) < 100 Then text_ping = 100    'исключаем нулевое значение и слишком быстрый пинг
        Timer1.Interval = Int(text_ping)    'присваиваем интервал
        'проверка коннекта
        If icq.KeepAlive = False Then
            trace "Подключаемся..."
            icq.login
        End If
    End Sub
    
    'добавление строки в текстбокс
    Private Sub trace(ByVal text As String)
        text_trace = text_trace & text & vbCrLf 'добавка
        If Len(text_trace) > 16000 Then text_trace = "" 'проверка на переполнение
        text_trace.SelStart = Len(text_trace)   'прокрутка
    End Sub
    
    'Событие "в сети"
    Private Sub icq_Connected()
        trace "В сети!"     'выводим текст
        icq.SetStatus FFC   'делаем статус "готов поболтать"
    End Sub
    
    'событие ошибки подключения
    Private Sub icq_ControlError(ByVal data As String)
        trace "Ошибка: " & data
    End Sub
    
    'Пришло сообщение
    Private Sub icq_MsgRecv(UIN As String, MSG As String)
        'наш ответ
        Dim ans As String
        Dim i As Integer
        ans = ""
        
        '=================== обработка команды ========================
        Select Case MSG
            'условия
            Case "!help": ans = ReadFile(App.Path & "\help.txt")    'Отправляем содерживое файла help.txt в ответ на команду !help
            'case ...
            '....
            '... пишем тут обрабуотк ваших команд ...
            '...
            Case Else   'если ни одно из условий не выполняется то:
            ans = "Неизвестная команда"
        End Select
        
        '=================== добавляем ответ в буфер ==================
        'перебираем буфер
        For i = 0 To BuffSize
            'если нашли место:
            If Buff(i).UIN = "" Then
                Buff(i).UIN = UIN 'забиваем уин на который отослать (уин отправителя)
                Buff(i).MSG = ans 'забиваем в буффер сообщение
                Exit For          'выходим из цикла
            End If
        Next i
        
        'добавляем текст
        trace UIN & ": " & MSG
    End Sub
    
    'таймер рассылки
    Private Sub Timer2_Timer()
        Dim i As Integer
        
        If Int(text_send) < 100 Then text_send = 100    'исключаем нулевое значение и слишком быструю отпрвку
        Timer2.Interval = Int(text_send)    'присваиваем интервал
        
        'ищем неотправленное сообщение в буфере
        'перебираем буфер
        For i = 0 To BuffSize
            'если нашли:
            If Buff(i).UIN <> "" Then
                icq.SendMessage Buff(i).UIN, Buff(i).MSG    'отправляем
                Buff(i).UIN = ""    'чистим
                Buff(i).MSG = ""
                Exit For          'выходим из цикла
            End If
        Next i
    End Sub
    
    
    
    
    '============ вспомогательные функции ====================================
    'запись в файл
    Public Sub WriteFile(ddata As String, ffile As String)
    Dim f As Long
    f = FreeFile
    Open ffile For Append As #f
        Print #f, ddata
    Close #f
    End Sub
    
    'Чтение файла
    Public Function ReadFile(sfile As String) As String
    On Error GoTo err
    Dim fff As Long
    Dim sBuff As String
    fff = FreeFile
    ReadFile = ""
    Open sfile For Input As #fff
        Do While Not (EOF(fff))
        Line Input #fff, sBuff
        ReadFile = ReadFile & sBuff & vbCrLf
        Loop
    err:
    Close #fff
    End Function
    
    Думаю коментарии в коде понятны =) Простой icq бот готов. Можете поэксперементировать, добавить свои файлы, команды, статистику (подсчет входящих/исходящих сообщений и т.д.). Удачи в ботостроении.

    Исходники и контрол в атаче.

    (с) karas
     
    Последнее редактирование: 10 мар 2009
    4 пользователям это понравилось.
  2. lytgeygen

    lytgeygen pacifiste maniaque ..::V.I.P::..

    Регистрация:
    13 окт 2008
    Сообщения:
    431
    Симпатии:
    244
    Баллы:
    0
    Дааа.... неплохо но так и не понял чего делает бот ?
    Я как то пытался написать своего icq бота при помощи вашего контрола но очень старого (самого первого)

    Исходники: тыЦ

    готовый *.EXE: тыЦ

    Добавлено через 19 часов 50 минут
    karas,
    Я вот думаю что обработку команд сделать облегчённой

    типа:

    If Dir(App.Path & MSG) <> "" Then 'Если файл с названием команды существует
    Open App.Path & "\" & MSG & ".txt" For Input As #1 'То открываем его
    Line Input #1, ans
    Close #1
    Else
    icq.SendMessage UIN, "Такой команды нет"
    End if

    Перезалейте пожалуйста [​IMG]
     
    Последнее редактирование модератором: 4 апр 2009
  3. tasya41

    tasya41 Новичок

    Регистрация:
    23 апр 2009
    Сообщения:
    1
    Симпатии:
    0
    Баллы:
    0
    блин а почему вот всё сделала,но когда запускаю бота,там нет этого значка icq???помогитн плиз((
     
  4. xeran

    xeran Продвинутый

    Регистрация:
    28 июл 2008
    Сообщения:
    109
    Симпатии:
    45
    Баллы:
    0
    tasya41,
    а чего значок влияет на работо способность?=)

    ЗЫ. Значка и так не должно быть видно в запущенной программе, тк значек отображает добавленный класс на форму.(видно только при редактировании формы)
     
  5. lytgeygen

    lytgeygen pacifiste maniaque ..::V.I.P::..

    Регистрация:
    13 окт 2008
    Сообщения:
    431
    Симпатии:
    244
    Баллы:
    0
    tasya41,
    не должно и не будет атребут видимости = False
    и при запуске его не увидеть, это что бы не мозолил глаза :)

    Добавлено через 6 минут
    Вот моя небольшая модификация:
    код всей программы (заменить!)

    Код:
    'Данные и структуры
    Const BuffSize = 10 'размер буфера отправки (очередь)
    
    'пользовательский тип - уин\сообшение
    Private Type UIN_MSG
        UIN As String
        MSG As String
    End Type
    
    Dim Buff(BuffSize) As UIN_MSG   'собственно сама очередь
    
    'загрузка формы
    Private Sub Form_Load()
        Timer1.Interval = Int(text_ping)    'присваиваем интервал
        Timer2.Interval = Int(text_send)    'присваиваем интервал
        'присваиваем контролу uin и пароль бота
        icq.UIN = "123456789"
        icq.Pass = "qwerty"
        Timer1.Enabled = False  'выключаем пинг-таймер
        Timer2.Enabled = True   'включаем рассыльщик
    End Sub
    
    'кнопка "включить"
    Private Sub but_on_Click()
        Timer1.Enabled = Not Timer1.Enabled 'вкл\выкл таймера
        If Timer2.Enabled Then
            but_on.Caption = "Выключить"
        Else
            but_on.Caption = "Включить"
            icq.CloseConnection
        End If
    End Sub
    
    'Пинг-таймер
    Private Sub Timer1_Timer()
        If Int(text_ping) < 100 Then text_ping = 100    'исключаем нулевое значение и слишком быстрый пинг
        Timer1.Interval = Int(text_ping)    'присваиваем интервал
        'проверка коннекта
        If icq.KeepAlive = False Then
            trace "Подключаемся..."
            icq.login
        End If
    End Sub
    
    'добавление строки в текстбокс
    Private Sub trace(ByVal text As String)
        text_trace = text_trace & text & vbCrLf 'добавка
        If Len(text_trace) > 16000 Then text_trace = "" 'проверка на переполнение
        text_trace.SelStart = Len(text_trace)   'прокрутка
    End Sub
    
    'Событие "в сети"
    Private Sub icq_Connected()
        trace "В сети!"     'выводим текст
        icq.SetStatus FFC   'делаем статус "готов поболтать"
    End Sub
    
    'событие ошибки подключения
    Private Sub icq_ControlError(ByVal data As String)
        trace "Ошибка: " & data
    End Sub
    
    'Пришло сообщение
    Private Sub icq_MsgRecv(UIN As String, MSG As String)
        'наш ответ
        Dim ans As String
        Dim i As Integer
        ans = ""
        
        '=================== обработка команды ========================
        Select Case MSG
    If Dir(App.Path & "\command\" & MSG & ".txt") <> "" Then 'Если файл с названием команды существует
    Open App.Path & "\" & MSG & ".txt" For Input As #1 'То открываем его
    Line Input #1, ans
    Close #1
    Else
    ans = "Такой команды нет"
    End if
        End Select
        
        '=================== добавляем ответ в буфер ==================
        'перебираем буфер
        For i = 0 To BuffSize
            'если нашли место:
            If Buff(i).UIN = "" Then
                Buff(i).UIN = UIN 'забиваем уин на который отослать (уин отправителя)
                Buff(i).MSG = ans 'забиваем в буффер сообщение
                Exit For          'выходим из цикла
            End If
        Next i
        
        'добавляем текст
        trace UIN & ": " & MSG
    End Sub
    
    'таймер рассылки
    Private Sub Timer2_Timer()
        Dim i As Integer
        
        If Int(text_send) < 100 Then text_send = 100    'исключаем нулевое значение и слишком быструю отпрвку
        Timer2.Interval = Int(text_send)    'присваиваем интервал
        
        'ищем неотправленное сообщение в буфере
        'перебираем буфер
        For i = 0 To BuffSize
            'если нашли:
            If Buff(i).UIN <> "" Then
                icq.SendMessage Buff(i).UIN, Buff(i).MSG    'отправляем
                Buff(i).UIN = ""    'чистим
                Buff(i).MSG = ""
                Exit For          'выходим из цикла
            End If
        Next i
    End Sub
    
    
    
    
    '============ вспомогательные функции ====================================
    'запись в файл
    Public Sub WriteFile(ddata As String, ffile As String)
    Dim f As Long
    f = FreeFile
    Open ffile For Append As #f
        Print #f, ddata
    Close #f
    End Sub
    
    'Чтение файла
    Public Function ReadFile(sfile As String) As String
    On Error GoTo err
    Dim fff As Long
    Dim sBuff As String
    fff = FreeFile
    ReadFile = ""
    Open sfile For Input As #fff
        Do While Not (EOF(fff))
        Line Input #fff, sBuff
        ReadFile = ReadFile & sBuff & vbCrLf
        Loop
    err:
    Close #fff
    End Function
    Добавлено через 11 часов 58 минут
    Блин, забыл сказать... тамже где ваша программа создаём папку command и там создаёте блокнотики с такимже названием как и команды... бот открывает блокнотик с такимже названием и отправляет содержимое тому кто написал, если такого файлика нет то далее понятно пишет что такой команды нет))
     
    Последнее редактирование: 25 апр 2009
  6. DanxilL

    DanxilL Новичок

    Регистрация:
    16 июл 2009
    Сообщения:
    21
    Симпатии:
    0
    Баллы:
    0
    А есть ли тут знающие РНР код ребята, которые написали бы для начинающих статью как написать icq бот на рнр?
     
  7. xeran

    xeran Продвинутый

    Регистрация:
    28 июл 2008
    Сообщения:
    109
    Симпатии:
    45
    Баллы:
    0
    DanxilL,
    угу и давай будем флудь где попало. Причем тут vb и пхп ((
    Имхо статья на эту тему не для начинающих(
     
  8. diman2008

    diman2008 Новичок

    Регистрация:
    24 авг 2008
    Сообщения:
    6
    Симпатии:
    0
    Баллы:
    0
    karas, классная статья, спасибо! Никогда не думал открыть свой блог по VB?!))

    Добавлено через 1 час 12 минут
    А вот еще вопрос, как средствами VB, запросить контактный лист?
     
    Последнее редактирование: 15 авг 2009
  9. karas

    karas Продвинутый

    Регистрация:
    30 апр 2007
    Сообщения:
    59
    Симпатии:
    70
    Баллы:
    0
    Пробовал, только уже на .NET.
    Копать тут: http://dev.aol.com/aim/oscar
    =)
     
  10. танк90

    танк90 Новичок

    Регистрация:
    15 сен 2009
    Сообщения:
    1
    Симпатии:
    0
    Баллы:
    0
    люди а где эту программу visual basic 6.0 скачать? скажите плиз!!!!!!
     
  11. lytgeygen

    lytgeygen pacifiste maniaque ..::V.I.P::..

    Регистрация:
    13 окт 2008
    Сообщения:
    431
    Симпатии:
    244
    Баллы:
    0
  12. dioxin

    dioxin Новичок

    Регистрация:
    27 ноя 2009
    Сообщения:
    1
    Симпатии:
    0
    Баллы:
    0
    Народ, чет не пашет ботик то.
    Вроде протокол меняли шоле, qip старый тоже перестал работать.
    Есть новый контрол для icq?
     
  13. lytgeygen

    lytgeygen pacifiste maniaque ..::V.I.P::..

    Регистрация:
    13 окт 2008
    Сообщения:
    431
    Симпатии:
    244
    Баллы:
    0
    dioxin,
    Это вроде вам руки забыли поменять или поменяли да не на те....
    _http://s13.radikal.ru/i186/0911/a3/487d9b34a51d.jpg
     
  14. PAIN6821

    PAIN6821 Новичок

    Регистрация:
    27 апр 2010
    Сообщения:
    6
    Симпатии:
    1
    Баллы:
    0
    Парни а как мне сделать бота чтобы он просто ..чтобы только войти в него он сам сообщение отправил какие надо на определённые уины и всё

    Добавлено через 2 часа 5 минут
    или вот нашел тему http://techmastery.net/phpmysql/118-icq-bot-na-php-besplatno.html
    но как запустить этот бот не пойму помогите пожалуйста((
     
    Последнее редактирование: 22 ноя 2011
  15. PAS_CAL

    PAS_CAL Новичок

    Регистрация:
    31 окт 2011
    Сообщения:
    2
    Симпатии:
    0
    Баллы:
    0
  16. chimatii

    chimatii Глобальный модератор

    Регистрация:
    13 окт 2009
    Сообщения:
    0
    Симпатии:
    98
    Баллы:
    0
    охренеть((
    вот их статья, а вот моя статья, сравните
     

Поделиться этой страницей