ANTICHAT — форум по информационной безопасности, OSINT и технологиям

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