умеет принимать сообщения.
увяз на поиске контактов. сервер не понимает моего запроса, хоть плачь тут.
- Код: Выделить всё
#COMPILE EXE
#DIM ALL
#INCLUDE "Win32API.inc"
GLOBAL hFile&
GLOBAL SEQ AS LONG
GLOBAL cook AS STRING
GLOBAL i,n AS LONG
GLOBAL Serv2 AS STRING
GLOBAL Port2 AS LONG
GLOBAL mListenStat AS LONG
GLOBAL uin,Pass AS STRING
FUNCTION PBMAIN () AS LONG
Serv2 = ""
Port2 = 0
uin="ваш уин"
Pass="ваш пароль"
hFile = FREEFILE
TCP OPEN PORT 5190 AT "login.icq.com" AS #hFile TIMEOUT 3000
IF ERR THEN MSGBOX "ERR CON": EXIT FUNCTION
InkSEQ
mListenStat = 1
CALL GetData
END FUNCTION
FUNCTION ToMsgFromICQStr (BYVAL strInput AS STRING) AS STRING
LOCAL x$
DIM i AS INTEGER, tmpStr AS STRING, mLet AS STRING
FOR i = 1 TO LEN(strInput)
mLet = MID$(strInput, i, 2)
IF mLet = "00" THEN i=i+1: GOTO 1
IF mLet = "04" THEN
x$=MKI$(VAL("&H0" + "04"+MID$(strInput, i+2, 2)))
i=i+3
ELSE
x$=UCODE$(MKI$(VAL("&H0" + MID$(strInput, i, 2))))
i=i+1
END IF
tmpStr=tmpStr+MID$(x$, 1, 2)
1 NEXT i
FUNCTION = ACODE$(tmpStr)
END FUNCTION
'счётчик пакетов(нумерация пакетов)
SUB InkSEQ()
SEQ = SEQ + 1
IF SEQ = 300 THEN SEQ = 0
END SUB
'вытаскивает из блока байт
FUNCTION GetByte(Txt AS STRING, Num AS INTEGER) AS BYTE
FUNCTION = ASC(MID$(Txt, Num, 1))
END FUNCTION
'работа с флэпами
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
FUNCTION = VAL(HexBuff)
END FUNCTION
FUNCTION GetFlapSEQ(flapdata AS STRING) AS LONG
DIM HexBuff AS STRING
HexBuff = "&H" & HEX$(GetByte(flapdata, 3)) & HEX$(GetByte(flapdata, 4))
FUNCTION = VAL(HexBuff)
END FUNCTION
FUNCTION GetFlapData(flapdata AS STRING) AS STRING
FUNCTION = MID$(flapdata, 7, LEN(flapdata) - 6)
END FUNCTION
'делает XOR пароль
FUNCTION CalcPass(BYVAL Pass AS STRING) AS STRING
DIM tmpStr 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
tmpStr = ""
FOR i = 1 TO LEN(Pass)
tmpStr = tmpStr & CHR$(ASC(MID$(Pass, i, 1)) XOR passarr(i))
NEXT i
FUNCTION = tmpStr
END FUNCTION
'работа со снэками
FUNCTION GetSnacFid(sData AS STRING) AS LONG
DIM HexBuff AS STRING
HexBuff = "&H" & HEX$(GetByte(sData, 1)) & HEX$(GetByte(sData, 2))
FUNCTION = VAL(HexBuff)
END FUNCTION
FUNCTION GetSnacSID(sData AS STRING) AS LONG
DIM HexBuff AS STRING
HexBuff = "&H" & HEX$(GetByte(sData, 3)) & HEX$(GetByte(sData, 4))
FUNCTION = VAL(HexBuff)
END FUNCTION
FUNCTION GetSnacF1(sData AS STRING) AS BYTE
FUNCTION = GetByte(sData, 5)
END FUNCTION
FUNCTION GetSnacF2(sData AS STRING) AS BYTE
FUNCTION = GetByte(sData, 6)
END FUNCTION
FUNCTION GetSnacRID(sData AS STRING) AS LONG
DIM HexBuff AS STRING
HexBuff = "&H" & HEX$(GetByte(sData, 7)) & HEX$(GetByte(sData, 8)) & HEX$(GetByte(sData, 9)) & HEX$(GetByte(sData, 10))
FUNCTION = VAL(HexBuff)
END FUNCTION
FUNCTION GetSnacData(sData AS STRING) AS STRING
FUNCTION = MID$(sData, 11, LEN(sData) - 10)
END FUNCTION
'работа с TLV
FUNCTION GetTlvID(sData AS STRING) AS LONG
FUNCTION = VAL("&H" & str2hex(MID$(sData, 1, 2)))
END FUNCTION
FUNCTION GetTlvLEN(sData AS STRING) AS LONG
FUNCTION = VAL("&H" & str2hex(MID$(sData, 3, 2)))
END FUNCTION
FUNCTION GetTlvData(sData AS STRING, leng AS LONG) AS STRING
FUNCTION = MID$(sData, 5, leng)
END FUNCTION
'преобразование hex-строк
FUNCTION GetHEX(BYVAL Txt AS STRING) AS STRING
DIM i AS INTEGER
DIM buff AS STRING
DIM tmpStr AS STRING
FOR i = 1 TO LEN(Txt)
buff = HEX$(GetByte(Txt, i))
IF LEN(buff) = 1 THEN buff = "0" & buff
tmpStr = tmpStr & buff & " "
NEXT i
FUNCTION = tmpStr
END FUNCTION
FUNCTION hex2str(BYVAL sData AS STRING) AS STRING
DIM i AS INTEGER
DIM tmpStr AS STRING
FOR i = 1 TO LEN(sData) STEP 2
tmpStr = tmpStr & CHR$(VAL("&H" + MID$(sData, i, 2)))
NEXT i
FUNCTION = tmpStr
END FUNCTION
FUNCTION str2hex(BYVAL Txt AS STRING) AS STRING
DIM i AS INTEGER
DIM buff AS STRING
DIM tmpStr AS STRING
FOR i = 1 TO LEN(Txt)
buff = HEX$(GetByte(Txt, i))
IF LEN(buff) = 1 THEN buff = "0" & buff
tmpStr = tmpStr & buff
NEXT i
FUNCTION = tmpStr
END FUNCTION
FUNCTION Word2Str(sData AS LONG) AS STRING
DIM i AS INTEGER
DIM buff AS STRING
buff = HEX$(sData)
IF LEN(buff) = 1 THEN buff = "000" + buff
IF LEN(buff) = 2 THEN buff = "00" + buff
IF LEN(buff) = 3 THEN buff = "0" + buff
FUNCTION = CHR$(VAL("&H" & MID$(buff, 1, 2))) + CHR$(VAL("&H" & MID$(buff, 3, 2)))
END FUNCTION
FUNCTION GetPack(mData AS STRING) AS LONG
LOCAL sData$,fData$
LOCAL pack, snac, Packl2 AS STRING
LOCAL t_type AS LONG
LOCAL r_uin AS STRING
LOCAL r_msg AS STRING
LOCAL t_data AS STRING
LOCAL mParse AS STRING
LOCAL t_start, t_len AS LONG
sData = mData
fData = GetFlapData(sData)
IF GetByte(sData, 2) = 1 AND Serv2 <> "" AND str2hex(fData) = "00000001" THEN
snac = hex2str("00000001")
snac = snac + hex2str("00060100") & cook
pack = hex2str("2A01") + Word2Str(SEQ) + Word2Str(LEN(snac)) + snac
InkSEQ
TCP SEND #hFile, pack
EXIT FUNCTION
END IF
IF GetByte(sData, 2) = 1 AND Serv2 = "" AND str2hex(fData) = "00000001" THEN
RANDOMIZE TIMER
SEQ = RND(0,255)*32
LOCAL ClientIdn AS STRING
ClientIdn = "4a696d6d20302e362e30620000000000"
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("000300") + CHR$(LEN(hex2str(ClientIdn))) + hex2str(ClientIdn) 'TLV02
snac = snac + hex2str("00160002010A") '16й TLV
snac = snac + hex2str("001700020005") 'нижняя граница версии протокола(5)
snac = snac + hex2str("00180002000F") 'верхняя граница версии протокола
snac = snac + hex2str("001900020001")
snac = snac + hex2str("001A00020E36")
snac = snac + hex2str("0014000400000055")
snac = snac + hex2str("000F0002656E") 'язык (EN)
snac = snac + hex2str("000E00027573") 'местонахождение
pack = hex2str("2A01") + Word2Str(SEQ) + Word2Str(LEN(snac)) + snac
InkSEQ
TCP SEND #hFile, pack
EXIT FUNCTION
END IF
'второй канал (основной)
IF GetByte(sData, 2) = 2 THEN
'первые Families
IF GetSnacFid(fData) = 1 AND GetSnacSID(fData) = 3 THEN
snac = hex2str("00010002000000000000000100030110047B001300020110047B000200010101047B000300010110047B001500010110047B000400010110047B000600010110047B000900010110047B000A00010110047B000B00010110047B")
pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(LEN(snac)) + snac
InkSEQ
TCP SEND #hFile, pack
EXIT FUNCTION
END IF
'вторые Families
IF GetSnacFid(fData) = 1 AND GetSnacSID(fData) = &H18 THEN
snac = hex2str("00010006000000000000")
pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(LEN(snac)) + snac
InkSEQ
TCP SEND #hFile, pack
EXIT FUNCTION
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
InkSEQ
TCP SEND #hFile, 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
InkSEQ
TCP SEND #hFile, Packl2
SEQ = SEQ - 1
EXIT FUNCTION
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
InkSEQ
TCP SEND #hFile, 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
InkSEQ
TCP SEND #hFile, Packl2
SEQ = SEQ - 1
EXIT FUNCTION
END IF
IF GetSnacFid(fData) = &HB AND GetSnacSID(fData) = 2 THEN MSGBOX "CONNECT OK": EXIT FUNCTION
END IF
'третий канал (ошибки)
IF GetByte(sData, 2) = 3 THEN
MSGBOX fData
EXIT FUNCTION
END IF
'ошибки
IF MID$(str2hex(fData), 1, 20) = "000900020001000B0012" THEN mListenStat = 0: MSGBOX "UIN используется на другом компьютере": EXIT FUNCTION
IF MID$(str2hex(fData), LEN(str2hex(fData)) - 3, 4) = "0005" THEN mListenStat = 0: MSGBOX "неверный пароль": EXIT FUNCTION
IF MID$(str2hex(fData), LEN(str2hex(fData)) - 3, 4) = "0100" THEN mListenStat = 0: MSGBOX "превышен лимит подключений": EXIT FUNCTION
IF MID$(str2hex(fData), LEN(str2hex(fData)) - 3, 4) = "001D" THEN mListenStat = 0: MSGBOX "слишком много попыток": EXIT FUNCTION
'кукисы
IF GetByte(sData, 2) = 4 THEN
' если пришли куки
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
TCP CLOSE #hFile
hFile = FREEFILE
TCP OPEN PORT Port2 AT Serv2 AS #hFile TIMEOUT 3000
IF ERR THEN MSGBOX "ERR CON": EXIT FUNCTION
EXIT FUNCTION
END IF
END IF
'если пришло сообщение
IF GetSnacFid(fData) = 4 AND GetSnacSID(fData) = 7 OR GetSnacSID(fData) = 6 THEN
t_len = VAL("&H0" + MID$(PARSE$(PARSE$(str2hex(fData), "050100", 2), "0100", 2), 1, 2))
t_start = INSTR(INSTR(str2hex(fData), "050100")+6, str2hex(fData), "00")+12
mParse = MID$(str2hex(fData), t_start, t_len*2-8)
MSGBOX ToMsgFromICQStr(mParse)
EXIT FUNCTION
END IF
MSGBOX str2hex(GetFlapData(mData))
END FUNCTION
FUNCTION AddedYou(m_UIN AS STRING) AS LONG
LOCAL pack, snac AS STRING
snac = hex2str("0004000600000000000600002AA5D60C00000002") + CHR$(LEN(m_UIN)) + m_UIN
snac = snac + hex2str("0005005E000000002AA5D60C0000094613494C7F11D18222444553540000000A00020001000F0000271100361B000A000000000000000000000000000000000000000300000000CEF90E00CEF90000000000000000000000000C000000040001000000030000")
pack = hex2str("2A02") + Word2Str(SEQ) + Word2Str(LEN(snac)) + snac
TCP SEND #hFile, pack
END FUNCTION
FUNCTION GetData () AS STRING
LOCAL sTemp$,sBuffer$
1 DO
IF mListenStat = 0 THEN EXIT FUNCTION
TCP RECV #hFile,4096, sBuffer
sTemp = sTemp & sBuffer
LOOP UNTIL ISTRUE EOF(#hFile)
IF LEN(sTemp) <> 0 THEN CALL GetPack(sTemp): sTemp = ""
SLEEP 50
GOTO 1
END FUNCTION