Tinggal taruh d module'nya aja..
LOGIN PACKET (MIG.V3)
Public Function login(Username As String)
login= HextoAscii("02 00 C8 00 01 00 00 00 " & (DecToHexStr(Len(Username) + 73)) & " 00 09 00 00 00 04 00 00 00 01 00 08 00 00 00 04 6A 32 6D 65 00 07 00 00 00 12 4A 32 4D 45 76 33 2E 30 31 20 4D 49 44 50 2D 31 2E 30 00 05 00 00 00 " & DecToHexStr(Len(Username)) & " " & Asciitohex(Username) & " 00 03 00 00 00 02 01 2D 00 02 00 00 00 01 01 00 01 00 00 00 02 00 01")
End Function
____________________
contoh penggunaan:
Socket.SendData 1,login("adhinegoro")
LOGIN PACKET (MIG.V4)
Public Function loginv4(Username As String)
loginv4 = HextoAscii("02 00 C8 00 03 00 00 00 " & DecToHexStr(Len(Username) + 123) & " 00 13 00 00 00 01 01 00 10 00 00 00 04 00 00 00 15 00 0F 00 00 00 05 65 6E 2D 55 53 00 0D 00 00 00 04 00 00 00 A9 00 0C 00 00 00 04 00 00 00 AA 00 0B 00 00 00 04 00 00 00 0E 00 09 00 00 00 01 01 00 08 00 00 00 04 6A 32 6D 65 00 07 00 00 00 0D 4A 32 4D 45 76 34 2E 30 35 2E 32 35 39 00 05 00 00 00 " & DecToHexStr(Len(Username)) & " " & Asciitohex(Username) & " 00 03 00 00 00 02 01 95 00 02 00 00 00 01 02 00 01 00 00 00 02 00 01")
End Function
HASHCODE CONVERTER & SEND HASHCODE PACKET
Public Function hashCode(Value)
Dim i As Integer
Const maxInt = 4294967295#
Const maxPostInt = 2147483647
Dim h As Currency
Dim div As Long
h = 0
For i = 1 To Len(Value)
h = h * 31 + Asc(Mid(Value, i, 1))
If (h > maxInt) Then
div = Int(h / (maxInt + 1))
h = h - (div * (maxInt + 1))
End If
Next i
If h > maxPostInt Then
h = h - maxInt - 1
End If
hashCode = h
End Function
Public Function GenerateHasCode(Packet As String) As String
Dim aLong As Long
Dim TempPacket As String
aLong = hashCode(Packet)
TempPacket = Right("00000000" & Hex(aLong), 8)
GenerateHasCode = Left$(TempPacket, 2) & " " & Mid$(TempPacket, 3, 2) & " " & Mid(TempPacket, 5, 2) & " " & Right(TempPacket, 2)
End Function
Public Function sendhash(datin As String, password As String)
sendhash= HextoAscii("02 00 CA 00 02 00 00 00 0A 00 01 00 00 00 04 " & GenerateHasCode(Right(datin, UnHex(Asciitohex(Mid(datin, (UnHex(Asciitohex(Mid(datin, 15, 1))) + 21), 1)))) & password))
End Function
CHANGE PRESENCE PACKET
Public Function set_online() As String
set_online = HextoAscii("02 02 58 00 " & Hex(increment) & " 00 00 00 07 00 01 00 00 00 01 01")
increment = increment + 1
End Function
Public Function set_offline() As String
set_offline = HextoAscii("02 02 58 00 " & Hex(increment) & " 00 00 00 07 00 01 00 00 00 01 63")
increment = increment + 1
End Function
Public Function set_away() As String
set_away = HextoAscii("02 02 58 00 " & Hex(increment) & " 00 00 00 07 00 01 00 00 00 01 04")
increment = increment + 1
End Function
Public Function set_busy() As String
set_busy = HextoAscii("02 02 58 00 " & Hex(increment) & " 00 00 00 07 00 01 00 00 00 01 03")
increment = increment + 1
End Function
JOIN ROOM
Public Function JoinRoom(room As String)
JoinRoom = HextoAscii("02 02 BF 00 " & Hex(increment) & " 00 00 00 " & DecToHexStr(Len(room) + 6) & " 00 01 00 00 00 " & DecToHexStr(Len(room)) & " " & Asciitohex(room))
increment = increment + 1
End Function
LEAVE ROOM
Public Function LeaveRoom(room As String)
LeaveRoom = HextoAscii("02 02 C0 00 " & Hex(increment) & " 00 00 00 " & DecToHexStr(Len(room) + 6) & " 00 01 00 00 00 " & DecToHexStr(Len(room)) & " " & Asciitohex(room))
increment = increment + 1
End Function
GET ROOM USER LIST
Public Function SpyRoom(room As String)
SpyRoom = (HextoAscii("02 02 C3 00 10 00 00 00 " & DecToHexStr(Len(room) + 6) & " 00 01 00 00 00 " & DecToHexStr(Len(room))) & room)
increment = increment + 1
End Function
ROOM SEND MSG
Public Function SendTextRoom(user As String, kata As String, room As String)
SendTextRoom = HextoAscii("02 01 F4 00 " & Hex(increment) & " 00 00 00 " & DecToHexStr(Len(user) + 40 + Len(room) + Len(kata)) & " 00 08 00 00 00 " & DecToHexStr(Len(kata)) & " " & Asciitohex(kata) & " 00 06 00 00 00 02 00 01 00 04 00 00 00 " & DecToHexStr(Len(room)) & " " & Asciitohex(room) & " 00 03 00 00 00 01 03 00 02 00 00 00 " & DecToHexStr(Len(user)) & " " & Asciitohex(user) & " 00 01 00 00 00 01 01")
increment = increment + 1
End Function
CREATE NEW GROUP CHAT
Public Function CreateGroup(txtuname1 As String, T1 As String)
CreateGroup = HextoAscii("02 02 EF 00 41 00 00 00 " & DecToHexStr(Len(txtuname1) + Len(T1) + 12) & " 00 02 00 00 00 " & DecToHexStr(Len(txtuname1))) & txtuname1 & HextoAscii("00 01 00 00 00 " & DecToHexStr(Len(T1))) & T1
increment = increment + 1
End Function
KICK
Private Sub kick()
tcpclient.SendData Chr(&H2) & Chr(&H2) & Chr(&HC2) & Chr(&H0) & Chr(&HD) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(12 + Len(txtchatroom.Text) +
Len(txtkickname.Text)) & Chr(&H0) & Chr(&H2) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(Len(txtkickname.Text)) & txtkickname.Text & Chr(&H0) & Chr(&H1) & Chr(&H0) & hr(&H0) & Chr(&H0) & Chr(Len(txtchatroom.Text)) &txtchatroom.Text
End Sub
PRIVATE CHAT
Private Sub pvt()
tcpclient.SendData Chr(&H2) & Chr(&H1) & Chr(&HF4) & Chr(&H0) & Chr(&H7) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(40 + Len(txtsend1.Text) + Len(txtpvt.Text) + Len(txtdisplay.Text)) & Chr(&H0) & Chr(&H8) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(Len(txtsend1.Text)) & txtsend1.Text & Chr(&H0) & Chr(&H6) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H2) & Chr(&H0) & Chr(1) & Chr(&H0) & Chr(&H4) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(Len(txtpvt.Text)) & txtpvt.Text & Chr(&H0) & Chr(&H3) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H1) & Chr(&H1) & Chr(&H0) & Chr(2) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(Len(txtdisplay)) & txtdisplay & Chr(&H0) & Chr(&H1) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H1) & Chr(&H1)
End Sub
CHECK ACCOUNT BALANCE
HextoAscii("02 03 85 00 05 00 00 00 00")
GET CONTACT LIST
HextoAscii("02 01 90 00 03 00 00 00 00")
REGISTER ID:
Public Function regid(name As String, password As String, Number As String)
regid = HextoAscii("02 00 64 00 04 00 00 00 " & DecToHexStr(Len(Number) + Len(name) + Len(password) + 25) & " 00 04 00 00 00 " & DecToHexStr(Len(Number)) & " " & Asciitohex(Number) & " 00 03 00 00 00 " & DecToHexStr(Len(password)) & " " & Asciitohex(password) & " 00 02 00 00 00 " & DecToHexStr(Len(name)) & " " & Asciitohex(name) & " 00 01 00 00 00 01 01")
End Function
CHANGE STATUS MESSAGE
Public Function statusmsg(NewStatus As String)
statusmsg = Chr(2) & Chr(2) & Chr(59) & HTA(inc) & HexToAscii(DexToHex(Len(NewStatus) + 6)) & Chr(0) & Chr(1) & HexToAscii(DexToHex(Len(NewStatus))) & NewStatus
End Function
BLOCK / MUTE
Public Function BlockMute(nick As String, Inc As String) As String
BlockMute = HTA("0201A1" & Inc & DTH(Len(nick) + 13) & "000200000001020001" & DTH(Len(nick)) & ATH(nick))
End Function
BANED / UNBANED
Public Function banuser(room as string, target as string)
Dim view as string
View="c=chatroom&a=ban_user&v=midlet&roomName=" & room & "&name=" & target
banuser = HextoAscii("02 03 9A 00 0E 00 00 00 " & DecToHexStr(Len(view) + 65) & " 00 04 00 00 00 04 00 00 00 01 00 03 " & DecToHexFull(Len(view)) & " " & Asciitohex(view) & " 00 02 00 00 00 24 68 74 74 70 3A 2F 2F 77 77 77 2E 6D 69 67 33 33 2E 63 6F 6D 2F 73 69 74 65 73 2F 69 6E 64 65 78 2E 70 68 70 00 01 00 00 00 01 02")
End Function
Public Function unbanuser(room as string, target as string)
Dim view as string
View="c=chatroom&v=midlet&a=unban_user&name=" & target & "&roomName=" & room
unbanuser = HextoAscii("02 03 9A 00 0E 00 00 00 " & DecToHexStr(Len(view) + 65) & " 00 04 00 00 00 04 00 00 00 01 00 03 " & DecToHexFull(Len(view)) & " " & Asciitohex(view) & " 00 02 00 00 00 24 68 74 74 70 3A 2F 2F 77 77 77 2E 6D 69 67 33 33 2E 63 6F 6D 2F 73 69 74 65 73 2F 69 6E 64 65 78 2E 70 68 70 00 01 00 00 00 01 02")
End Function
FUNCTION STRING
Public Function HextoAscii(inputstr As String) As String
On Error Resume Next
Dim spilter As Variant, i As Integer, finnal As String
If InStr(1, inputstr, " ") <> 0 Then
spilter = Split(inputstr, " ")
For i = 0 To UBound(spilter)
finnal = finnal & Chr(Val("&H" & spilter(i)))
DoEvents
Next i
HextoAscii = finnal
ElseIf Len(inputstr) = 2 Then
finnal = Chr(Val("&H" & inputstr))
HextoAscii = finnal
DoEvents
End If
End Function
Public Function Asciitohex(inputstr As String) As String
On Error Resume Next
Dim spilter As Variant, i As Integer, finnal As String
For i = 1 To Len(inputstr)
finnal = finnal & Hex(Asc(Mid(inputstr, i, 1))) & " "
DoEvents
Next i
Asciitohex = Mid(finnal, 1, Len(finnal) - 1)
End Function
Public Function UnHex(sHex As String) As Long
On Error Resume Next
UnHex = Val("&H" & sHex)
End Function
Public Function DecToHexStr(ByVal inVal As Integer) As String
On Error Resume Next
Dim s As String
s = Trim(Hex(inVal))
If Len(s) < 2 Then
s = "0" & s
End If
DecToHexStr = s
End Function
Public Function StringToHex(str1 As String) As String
Dim lengtestring
Dim HexString As String
Dim Hvalue As String
Dim Cnt As Integer
lengtestring = Len(str1)
For Cnt = 1 To lengtestring
Hvalue = Asc(Mid$(str1, Cnt, 1))
If Hvalue < 16 Then
Hvalue = "0" & Hex(Hvalue)
Else
Hvalue = Hex(Hvalue)
End If
HexString = HexString & Hvalue & " "
DoEvents
Next Cnt
'StringToHex = HexString 'will put space at the end of conversion
StringToHex = Mid$(HexString, 1, Len(HexString) - 1) 'will remove the space at the end of conversion, add by vortex
End Function
Public Function DecToHexFull(strAsc) As String
'this function will convert decimal (only decimal) to hex and the result will be in 00 00 00 00 format
'maximal value which can be handled will be only 2147483647
strAsc = Hex(strAsc)
If Len(strAsc) < 8 Then
Do Until Len(strAsc) = 8
strAsc = "0" & strAsc
Loop
End If
Dim lonLen As Long
lonLen = Len(strAsc)
Dim i As Integer
For i = 1 To Len(strAsc)
strAsc = strAsc & Mid(strAsc, i, 2) & " "
i = i + 1
DoEvents
Next i
DecToHexFull = Mid(strAsc, lonLen + 1)
DecToHexFull = Mid(DecToHexFull, 1, Len(DecToHexFull) - 1) 'will remove the space at the end of conversion, add by vortex
End Function
Semoga bermanfaat.. Salam Miggers..
0 komentar:
Posting Komentar