лол ) альфабрут на старом протоколе работает что дает ему брутить тока девятки(на остальных ступор) я все это декомпилятором искатал. он работает по старому VBicq контролу от карася Code: Option Explicit ' Socket Public Enum StateVars Connecting = 0 Connected = 1 Sending = 2 Sended = 3 Recving = 4 Listening = 5 Accepted = 6 End Enum Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function gethostname Lib "ws2_32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long Private Declare Function getpeername Lib "ws2_32.dll" (ByVal so As Long, ByRef stru As sockaddr_in, ByRef strulen As Long) As Long Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal BufLen As Long, ByVal Flags As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long) Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long Private Declare Function Lis Lib "ws2_32.dll" Alias "listen" (ByVal s As Long, ByVal backlog As Long) As Long Private Declare Function gethostbyname Lib "wsock32" (ByVal hostname As String) As Long Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal inn As Long) As Long Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer Private Declare Function htonl Lib "ws2_32.dll" (ByVal hostlong As Long) As Long Private Declare Function Socket Lib "ws2_32.dll" Alias "socket" (ByVal afi As Long, ByVal s_type As Long, ByVal protocol As Long) As Long Private Declare Function Con Lib "ws2_32.dll" Alias "connect" (ByVal s As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long Private Declare Function VBind Lib "ws2_32.dll" Alias "bind" (ByVal s As Long, ByRef name As sockaddr_in, ByRef namelen As Long) As Long Private Declare Function WSAAsyncSelect Lib "ws2_32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long Private Declare Function accept Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr_in, addrlen As Long) As Long Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As Any, ByVal BufLen As Long, ByVal Flags As Long) As Long Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSAData) As Long Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long Private Type WSAData wVersion As Integer wHighVersion As Integer szDescription As String * 257 szSystemStatus As String * 129 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As Long End Type Private Type sockaddr_in sin_family As Integer sin_port As Integer sin_addr As Long sin_zero(1 To 8) As Byte End Type Private Const MAXCONN = &H7FFFFFFF Private Const FD_READ = &H1 Private Const FD_ACCEPT = &H8 Private Const FD_CONNECT = &H10 Private Const FD_CLOSE = &H20 Private LocalIP As String Private LocalName As String Public State As StateVars Public Server As String Public Port As Long Private ConnectedRemoteIP As String Dim NewSocket As Long Dim IncSocket As Long Dim aSocket As Long Dim imClient As Boolean Dim tmppIP As String Dim tmppPort As Long 'VBicq Dim CLI As Boolean Dim CliReady As String Dim MainBuff As String Dim Flen, mlen As Integer Dim cook As String Dim SEQ As Long Dim Serv2 As String Dim Port2 As Long Public uin As String Public Pass As String Public Enum IcqStatus online = "0000" invisible = "0100" away = "0001" NA = "0005" Occupied = "0011" DND = "0013" FFC = "0020" End Enum Event GetIcqData(data As String) Event Connected() Event IcqError(msg As String) Event MsgRecv(uin As String, msg As String) Event SendOK(uin As String) '/////////////////////////////////////////////////////////////////// ' ///////////////////////////// VBsocket блок ///////////////////// '///////////////////////////////////////////////////////////////// Private Function Connect(host As String, Port As Long) Dim IP As String tmppIP = host tmppPort = Port Dim cStruct As sockaddr_in Dim retV As Long If Left(host, 1) <> 1 Or Left(host, 1) <> 2 Then IP = GetIPFromHostName(host) cStruct.sin_addr = inet_addr(IP) cStruct.sin_family = 2 cStruct.sin_port = htons(Port) State = Connecting closesocket NewSocket closesocket aSocket NewSocket = Socket(2, 1, 6) WSAAsyncSelect NewSocket, inCON.hwnd, &H202, FD_CONNECT retV = Con(NewSocket, cStruct, Len(cStruct)) aSocket = NewSocket End Function Private Function SendData(data As String) As Boolean Dim sB() As Byte Dim sBytes As Long Dim LensB As Long InkSEQ LensB = Len(data) sB = data sB() = StrConv(data, vbFromUnicode) sBytes = send(aSocket, sB(0), LensB, 0&) If sBytes = -1 Then SendData = False Else SendData = True State = Sended End If End Function Private Function Listen(Port As Long) As Boolean closesocket aSocket Dim sST As sockaddr_in Dim tRe sST.sin_addr = &H0 sST.sin_family = 2 sST.sin_port = htons(Port) IncSocket = Socket(2, 1, 6) tRe = VBind(IncSocket, sST, LenB(sST)) If tRe = -1 Then Listen = False Else Listen = True State = Listening End If tRe = Lis(IncSocket, MAXCONN) tRe = WSAAsyncSelect(IncSocket, inC.hwnd, &H202, FD_CONNECT Or FD_ACCEPT) End Function Public Sub CloseConnection() closesocket NewSocket closesocket IncSocket closesocket aSocket End Sub Private Sub inC_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim ns As sockaddr_in Dim vRE As Long aSocket = accept(IncSocket, ns, Len(ns)) ConnectedRemoteIP = Convert(inet_ntoa(ns.sin_addr)) 'RaiseEvent Accepted(ConnectedRemoteIP) WSAAsyncSelect aSocket, inD.hwnd, &H202, FD_READ Or FD_CLOSE End Sub Private Sub inCON_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim nst As sockaddr_in Dim rVal As Long rVal = getpeername(aSocket, nst, Len(nst)) If rVal = -1 Then closesocket NewSocket closesocket aSocket 'RaiseEvent ConnectError Exit Sub End If State = Connected imClient = True 'RaiseEvent Connected(tmppIP, tmppPort) WSAAsyncSelect aSocket, inD.hwnd, &H202, FD_READ Or FD_CLOSE End Sub Private Sub inD_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next Dim incData As String incData = GetData If incData = "" Then If imClient = True Then Exit Sub WSAAsyncSelect IncSocket, inC.hwnd, &H202, FD_CONNECT Or FD_ACCEPT Else DataArrival incData End If End Sub Private Function GetData() As String Dim bytes As Long Dim RB As String * 16384 Dim data As String bytes = recv(aSocket, RB, 16384, 0) If bytes > 0 Then data = Left$(RB, bytes) GetData = data Else GetData = "" End If End Function Private Sub UserControl_Initialize() Dim ws As WSAData WSAStartup &H202, ws Dim MyName As String * 255 gethostname MyName, 255 LocalName = MyName LocalIP = GetIPFromHostName(MyName) Server = "login.icq.com" Port = 5190 End Sub Private Function GetIPFromHostName(ByVal sHostName As String) As String Dim nbytes As Long Dim ptrHosent As Long Dim ptrName As Long Dim ptrAddress As Long Dim ptrIPAddress As Long Dim sAddress As String sAddress = Space$(4) ptrHosent = gethostbyname(sHostName & vbNullChar) If ptrHosent <> 0 Then ptrAddress = ptrHosent + 12 CopyMemory ptrAddress, ByVal ptrAddress, 4 CopyMemory ptrIPAddress, ByVal ptrAddress, 4 CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4 GetIPFromHostName = IPToText(sAddress) End If End Function Private Function IPToText(ByVal IPAddress As String) As String IPToText = CStr(Asc(IPAddress)) & "." & _ CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _ CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _ CStr(Asc(Mid$(IPAddress, 4, 1))) End Function Private Function Convert(ByVal Inp As Long) As String Dim pr As String Dim re As Long pr = String$(lstrlen(ByVal Inp), 0) re = lstrcpy(ByVal pr, ByVal Inp) If re Then Convert = pr End Function Private Sub UserControl_Resize() Width = 450 Height = 405 End Sub Private Sub UserControl_Terminate() closesocket NewSocket closesocket IncSocket closesocket aSocket End Sub '------------------------------------------------------------------------ '/////////////////////////////////////////////////////////////////// ' ///////////////////////////// VBicq блок //////////////////////// '///////////////////////////////////////////////////////////////// '// вспомогательный функции ' вытаскивает из блока байт Private Function GetByte(Txt As String, num As Integer) As Byte GetByte = Asc(Mid$(Txt, num, 1)) End Function 'работа с флэпами Private Function GetFlapLen(flapdata As String) As Long 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 GetFlapSEQ(flapdata As String) As Long Dim HexBuff As String HexBuff = "&H" & Hex(GetByte(flapdata, 3)) & Hex(GetByte(flapdata, 4)) GetFlapSEQ = Val(HexBuff) End Function Private Function GetFlapData(flapdata As String) As String GetFlapData = Mid$(flapdata, 7, Len(flapdata) - 6) End Function '--------------- работа со снэками ------------ Private Function GetSnacFid(data As String) As Long Dim HexBuff As String HexBuff = "&H" & Hex(GetByte(data, 1)) & Hex(GetByte(data, 2)) GetSnacFid = Val(HexBuff) End Function Private Function GetSnacSID(data As String) As Long Dim HexBuff As String HexBuff = "&H" & Hex(GetByte(data, 3)) & Hex(GetByte(data, 4)) GetSnacSID = Val(HexBuff) End Function Private Function GetSnacF1(data As String) As Byte GetSnacF1 = GetByte(data, 5) End Function Private Function GetSnacF2(data As String) As Byte GetSnacF2 = GetByte(data, 6) End Function Private Function GetSnacRID(data As String) As Long Dim HexBuff As String HexBuff = "&H" & Hex(GetByte(data, 7)) & Hex(GetByte(data, 8)) & Hex(GetByte(data, 9)) & Hex(GetByte(data, 10)) GetSnacRID = Val(HexBuff) End Function Private Function GetSnacData(data As String) As String GetSnacData = Mid$(data, 11, Len(data) - 10) End Function '------------- работа с TLV ---------------- Private Function GetTlvID(data As String) As Long GetTlvID = Val("&H" & str2hex(Mid$(data, 1, 2))) End Function Private Function GetTlvLEN(data As String) As Long GetTlvLEN = Val("&H" & str2hex(Mid$(data, 3, 2))) End Function Private Function GetTlvData(data As String, leng As Long) As String GetTlvData = Mid$(data, 5, leng) End Function '/ппреобразование hex-строк Private Function GetHEX(ByVal Txt As String) As String 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 hex2str(ByVal data As String) As String 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 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 Word2Str(data As Long) As String 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 ' счётчик пакетов(нумерация пакетов) Private Sub InkSEQ() SEQ = SEQ + 1 If SEQ = 65535 Then SEQ = 0 End Sub 'делает XOR пароль Private Function CalcPass(ByVal Pass As String) As String 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 Sub DataArrival(ByVal data As String) Dim flen2 As Long ' если свободно If CLI = False Then 'определим длину флэпа Flen = GetFlapLen(data) mlen = Flen + 6 CLI = True MainBuff = "" 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 = "" End If End Sub ' самая главная процелура - распределитель Private Sub Flapper(data As String) Dim i, j As Long Dim n As Integer Dim fData As String Dim sData As String Dim pack, snac, Packl2 As String Dim r_uin As String Dim r_msg As String Dim t_type, t_len As Long Dim t_len2 As Long Dim t_data As String fData = GetFlapData(data) RaiseEvent GetIcqData("Chanel [" & GetByte(data, 2) & "] " & GetHEX(fData)) '-------- первый канал (установка соединения) If GetByte(data, 2) = 1 Then 'первый коннект (к autorization server) If str2hex(fData) = "00000001" And Serv2 <> "" Then snac = hex2str("00000001") snac = snac + hex2str("00060100") & cook pack = hex2str("2A01") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) End If If str2hex(fData) = "00000001" And Serv2 = "" Then ' если добро на соединение то SEQ = Rnd * 32767 'идентификация '/делаем снэк логина snac = hex2str("00000001") 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") 'нижняя граница версии протокола(5) 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") 'местонахождение pack = hex2str("2A01") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) End If End If '-------- второй канал (основной) If GetByte(data, 2) = 2 Then ' первые Families If GetSnacFid(fData) = 1 And GetSnacSID(fData) = 3 Then snac = hex2str("000100170000000000000001000300130002000200010003000100150001000400010006000100090001000A0001000B0001") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) End If ' вторые Families If GetSnacFid(fData) = 1 And GetSnacSID(fData) = &H18 Then snac = hex2str("00010006000000000000") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) End If 'SRV_RATES If GetSnacFid(fData) = 1 And GetSnacSID(fData) = 7 Then snac = hex2str("0001000800000000000000010002000300040005") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) Packl2 = "" For i = 1 To 6 If i = 1 Then snac = hex2str("000400020000000000000000000000031F4003E703E700000000") If i = 2 Then snac = hex2str("0001000E000000000000") If i = 3 Then snac = hex2str("00020002000000000000") If i = 4 Then snac = hex2str("00030002000000000000") If i = 5 Then snac = hex2str("00040004000000000000") If i = 6 Then snac = hex2str("00090002000000000000") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac InkSEQ Packl2 = Packl2 & pack Next i SendData (Packl2) SEQ = SEQ - 1 End If 'SRV_REPLYBOS If GetSnacFid(fData) = 9 And GetSnacSID(fData) = 3 Then snac = hex2str("00020004000000000004000500055642696371") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) Packl2 = "" For i = 1 To 4 If i = 1 Then snac = hex2str("00090007000000000000") If i = 2 Then snac = hex2str("0001001100000000000000000000") If i = 3 Then snac = hex2str("0001001E0000000000000006000400000000000800020000000C002559BD9BDD00000BB80400082DA84E5600000050000000030000000000000000000000000000") If i = 4 Then snac = hex2str("00010002000000000000000100030110047B001300020110047B000200010101047B000300010110047B001500010110047B000400010110047B000600010110047B000900010110047B000A00010110047B000B00010110047B") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac InkSEQ Packl2 = Packl2 & pack Next i SendData (Packl2) SEQ = SEQ - 1 End If If GetSnacFid(fData) = &HB And GetSnacSID(fData) = 2 Then RaiseEvent Connected If GetSnacFid(fData) = 4 And GetSnacSID(fData) = 7 Then fData = Mid$(fData, 21, Len(fData) - 20) t_len = GetByte(fData, 1) r_uin = Mid$(fData, 2, t_len) For i = 1 To Len(fData) If str2hex(Mid$(fData, i, 4)) = "00030004" Then For j = i + 8 To Len(fData) If str2hex(Mid$(fData, j, 4)) = "00000000" Then t_len = Val("&H" & Hex(GetByte(fData, j - 2) & Hex(GetByte(fData, j - 1)))) r_msg = Mid$(fData, j, t_len) r_msg = Strings.Replace(r_msg, Chr(0), "") r_msg = Strings.Replace(r_msg, Chr(2), "") RaiseEvent MsgRecv(r_uin, r_msg) Exit Sub End If Next j End If Next i End If If GetSnacFid(fData) = 4 And GetSnacSID(fData) = &HC Then fData = Mid$(fData, 21, Len(fData) - 20) t_len = GetByte(fData, 1) r_uin = Mid$(fData, 2, t_len) RaiseEvent SendOK(r_uin) r_uin = "" End If End If '-------- третий канал (ошибки) If GetByte(data, 2) = 3 Then RaiseEvent IcqError(fData) End If '-------- четвёртый канал If GetByte(data, 2) = 4 Then If GetSnacFid(fData) = 1 And GetSnacSID(fData) = 9 Then RaiseEvent IcqError("Ошибка соединения...") ' если пришли куки If Mid$(fData, 1, 5) = hex2str("008E000100") Then fData = Mid$(fData, 6, Len(fData) - 5) Do t_type = GetTlvID(fData) t_len = GetTlvLEN(fData) t_data = GetTlvData(fData, t_len) If t_type = 1 Then uin = t_data If t_type = 5 Then For i = 1 To Len(t_data) If Mid$(t_data, i, 1) = ":" Then n = i Next i Serv2 = Mid$(t_data, 1, n - 1) Port2 = Val(Mid$(t_data, n + 1, Len(t_data) - n)) End If If t_type = 6 Then cook = t_data fData = Mid$(fData, t_len + 1 + 4, Len(fData) - t_len - 4) Loop Until Len(fData) = 0 CloseConnection Connect Serv2, Port2 End If End If End Sub Public Sub login() Serv2 = "" Port2 = 0 CloseConnection Connect Server, Port End Sub Public Sub SetStatus(ByVal s_status As String) Dim pack, snac As String snac = hex2str("0001001E00000000000000060004") & hex2str("2003") & Word2Str(Val("&h" & s_status)) pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) End Sub Public Sub SendMessage(ByVal m_UIN As String, ByVal m_msg As String) Dim pack, snac, TLVl2 As String TLVl2 = hex2str("0501000201010101") & Word2Str(Len(m_msg) + 4) & hex2str("00000000") & m_msg snac = hex2str("0004000600000001000600000000000000000001") & Chr(Len(m_UIN)) & m_UIN & hex2str("0002") & Word2Str(Len(TLVl2)) & TLVl2 & hex2str("00060000") pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac SendData (pack) End Sub Public Function KeepAlive() As Boolean Dim snac, pack As String KeepAlive = False snac = hex2str("0000") pack = hex2str("2A05") + Word2Str(SEQ) + Word2Str(Len(snac)) + snac KeepAlive = SendData(pack) End Function отчетливо видно что старый протокол. мои изобретения на VBicq2 который работает по новому протоколу
