mig33
  • Search
  • Member List
  • Calendar
  • Help
Current time: 06-05-2023, 02:38 AM Hello There, Guest! (Login — Register)

mig33 / Management / mig33Chat / mig33Class module


Post Reply 
 
Thread Rating:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Threaded Mode | Linear Mode
mig33Class module
11-01-2011, 10:41 PM (This post was last modified: 11-08-2011 02:54 AM by xtrsyz.org.)
Post: #1
xtrsyz.org Offline
Posts: 306
Joined: May 2009
Reputation: 0
mig33Class module
Berikut adalah mig33Class module yang digunakan pada mig33Chat
Code:
Public Function OpenBrowser(ByVal Index As Long, ByVal URl As String) As String
PHeader = HexToAscii("02 03 9A " & IHeader(Index) & " 00 00")
URl = HexToAscii("00 02 00 00") & HexToAscii(HexLen(URl)) & URl
paket = HexToAscii("00 04 00 00 00 04 00 00 00 01") & URl & HexToAscii("00 01 00 00 00 01 01")
OpenBrowser = PHeader & HexToAscii(HexLen(paket)) & paket
End Function

Public Function UserUnBlock(ByVal Index As Long, ByVal UserName As String) As String
UserUnBlock = OpenBrowser(Index, "http://www.mig33.com/sites/index.php?c=settings&v=midlet&a=unblock_user&username=" & UserName & "&page=1")
End Function

Public Function UserMute(ByVal Index As Long, ByVal UserName As String, ByVal roomName As String) As String
UserName = HexToAscii("00 02 00 00 " & HexLen(UserName)) & UserName
roomName = HexToAscii("00 01 00 00 " & HexLen(roomName)) & roomName
paket = UserName & roomName
UserMute = HexToAscii("02 02 C5 " & IHeader(Index) & " 00 00 " & HexLen(paket)) & paket
End Function

Public Function UpdateStatus(ByVal Index As Long, ByVal Status As String) As String
paket = HexToAscii("00 01 00 00 " & HexLen(Status)) & Status
UpdateStatus = HexToAscii("02 02 59 " & IHeader(Index) & " 00 00 " & HexLen(paket)) & paket
End Function

Private Function HexLen(ByVal DataIn As String) As String
    HexLen = DecToHex(Len(DataIn))
        While Len(HexLen) < 4
        HexLen = "0" & HexLen
        Wend
    HexLen = Left(HexLen, 2) & " " & Right(HexLen, 2)
End Function


Public Function ModeratorAdd(ByVal Index As Long, ByVal UserName As String, ByVal roomName As String) As String
'PHeader = HexToAscii("02 03 9A " & IHeader(Index) & " 00 00 00")
'    URlBase = "http://www.mig33.com/sites/index.php"
'    URlv = "v=midlet"
'    URlc = "c=chatroom"
'    URla = "a=add_moderator"
'    URlname = "name=" & UserName
'    URlRoomName = "roomName=" & roomName
'    Variable = URlc & "&" & URla & "&" & URlv & "&" & URlRoomName & "&" & URlname
'    Paket = HexToAscii("00 04 00 00 00 04 00 00 00 01 00 03 00 00 00 " & DecToHex(Len(Variable))) & Variable & HexToAscii("00 02 00 00 00 " & DecToHex(Len(URlBase))) & URlBase & HexToAscii("00 01 00 00 00 01 02")
'
'    URl = URlBase & "?" & Variable
'    H04 = HexToAscii("00 04 00 00 00 04 00 00 00 01")
'    H01 = HexToAscii("00 01 00 00 00 01 01")
'    Paket = H04 & HexToAscii("00 02 00 00 " & HexLen(URl)) & URl & H01
'
'ModeratorAdd = PHeader & HexToAscii(DecToHex(Len(Paket))) & Paket

    URlBase = "http://www.mig33.com/sites/index.php"
    URlv = "v=midlet"
    URlc = "c=chatroom"
    URla = "a=add_moderator"
    URlname = "name=" & UserName
    URlRoomName = "roomName=" & roomName
    URlSend = URlc & "&" & URlv & "&" & URla & "&" & URlname & "&" & URlRoomName
    ModeratorAdd = URlBase & "?" & URlSend
    ModeratorAdd = OpenBrowser(Index, ModeratorAdd)
End Function
Public Function ModeratorRemove(ByVal Index As Long, ByVal UserName As String, ByVal roomName As String) As String
    URlBase = "http://www.mig33.com/sites/index.php"
    URlv = "v=midlet"
    URlc = "c=chatroom"
    URla = "a=remove_moderator"
    URlname = "name=" & UserName
    URlRoomName = "roomName=" & roomName
    URlSend = URlc & "&" & URlv & "&" & URla & "&" & URlname & "&" & URlRoomName
    ModeratorRemove = URlBase & "?" & URlSend
    ModeratorRemove = OpenBrowser(Index, ModeratorRemove)
End Function


Public Function SearchRoomOld(ByVal Index As Long, ByVal roomName As String, ByVal Page As Integer) As String
If Page > 0 Then
Pg = HexToAscii(DecToHex(Page))
Pg = HexToAscii("02 00 00 00") & HexToAscii(DecToHex(Len(Pg))) & Pg & HexToAscii("00")
End If
Packet = HexToAscii("00") & Pg & HexToAscii("01 00 00 00") & HexToAscii(DecToHex(Len(roomName))) & roomName
Psize = HexToAscii(DecToHex(Len(Packet)))
SearchRoomOld = HexToAscii("02 02 BC " & IHeader(Index) & " 00 00 00") & Psize & Packet
End Function
Public Function UserKick(ByVal Index As Long, ByVal UserName As String, ByVal roomName As String) As String
Usize = DecToHex(Len(UserName))
Rsize = DecToHex(Len(roomName))
Psize = DecToHex(Len(UserName) + Len(roomName) + 12)
UserKick = HexToAscii("02 02 C2 " & IHeader(Index) & " 00 00 00 " & Psize & " 00 02 00 00 00 " & Usize) & UserName & HexToAscii("00 01 00 00 00 " & Rsize) & roomName
End Function
Public Function UserBanned(ByVal Index As Long, ByVal UserName As String, ByVal roomName As String) As String
    URlBase = "http://www.mig33.com/sites/index.php"
    URlv = "v=midlet"
    URlc = "c=chatroom"
    URla = "a=ban_user"
    URlname = "name=" & UserName
    URlRoomName = "roomName=" & roomName
    URlSend = URlc & "&" & URlv & "&" & URla & "&" & URlname & "&" & URlRoomName
    UserBanned = URlBase & "?" & URlSend
    UserBanned = OpenBrowser(Index, UserBanned)
'Banned = HexToAscii("02 03 9A " & IHeader(Index) & " 00 00 00 " & Psize & " 00 04 00 00 00 04 00 00 00 01 00 03 00 00 00 " & Usize) & URlSend & HexToAscii("00 02 00 00 00 " & Bsize) & URlBase & HexToAscii("00 01 00 00 00 01 02")
End Function
Public Function UserUnbanned(ByVal Index As Long, ByVal UserName As String, ByVal roomName As String) As String
    'URlBase = "http://www.mig33.com/sites/index.php"
    'URlv = "v=midlet"
    'URlc = "c=chatroom"
    'URla = "a=unban_user"
    'URlname = "name=" & UserName
    'URlRoomName = "roomName=" & roomName
    'URlSend = URlc & "&" & URla & "&" & URlv & "&" & URlRoomName & "&" & URlname
    '    PURl = Len(URlSend)
    '    Usize = DecToHex(PURl)
    '    Plen = Len(URlBase) + Len(URlSend) + 29
    '    Bsize = DecToHex(Len(URlBase))
    '    Psize = DecToHex(Plen)
        
    URlBase = "http://www.mig33.com/sites/index.php"
    URlv = "v=midlet"
    URlc = "c=chatroom"
    URla = "a=unban_user"
    URlname = "name=" & UserName
    URlRoomName = "roomName=" & roomName
    URlSend = URlc & "&" & URlv & "&" & URla & "&" & URlname & "&" & URlRoomName
    UserUnbanned = URlBase & "?" & URlSend
    UserUnbanned = OpenBrowser(Index, UserUnbanned)
    
'UserUnbanned = HexToAscii("02 03 9A " & IHeader(Index) & " 00 00 00 " & Psize & " 00 04 00 00 00 04 00 00 00 01 00 03 00 00 00 " & Usize) & URlSend & HexToAscii("00 02 00 00 00 " & Bsize) & URlBase & HexToAscii("00 01 00 00 00 01 02")
End Function
Public Function SendPrivate(ByVal Index As Long, ByVal Message As String, ByVal Target As String, ByVal UserName As String) As String
Message = HexToAscii("00 08 00 00 " & HexLen(Message)) & Message
H06 = HexToAscii("00 06 00 00 00 02 00 01")
Target = HexToAscii("00 04 00 00 " & HexLen(Target)) & Target
H03 = HexToAscii("00 03 00 00 00 01 01")
UserName = HexToAscii("00 02 00 00 " & HexLen(UserName)) & UserName
H01 = HexToAscii("00 01 00 00 00 01 01")
Packet = Message & H06 & Target & H03 & UserName & H01
SendPrivate = HexToAscii("02 01 F4 " & IHeader(Index) & " 00 00 " & HexLen(Packet)) & Packet
End Function
Public Function SendGroup(ByVal Index As Long, ByVal Message As String, ByVal Target As String, ByVal UserName As String) As String
Message = HexToAscii("00 08 00 00 " & HexLen(Message)) & Message
H06 = HexToAscii("00 06 00 00 00 02 00 01")
Target = HexToAscii("00 04 00 00 " & HexLen(Target)) & Target
H03 = HexToAscii("00 03 00 00 00 01 02")
UserName = HexToAscii("00 02 00 00 " & HexLen(UserName)) & UserName
H01 = HexToAscii("00 01 00 00 00 01 01")
Packet = Message & H06 & Target & H03 & UserName & H01
SendGroup = HexToAscii("02 01 F4 " & IHeader(Index) & " 00 00 " & HexLen(Packet)) & Packet
End Function
Public Function SendRoom(ByVal Index As Long, ByVal Message As String, ByVal Target As String, ByVal UserName As String) As String
Message = HexToAscii("00 08 00 00 " & HexLen(Message)) & Message
H06 = HexToAscii("00 06 00 00 00 02 00 01")
Target = HexToAscii("00 04 00 00 " & HexLen(Target)) & Target
H03 = HexToAscii("00 03 00 00 00 01 03")
UserName = HexToAscii("00 02 00 00 " & HexLen(UserName)) & UserName
H01 = HexToAscii("00 01 00 00 00 01 01")
Packet = Message & H06 & Target & H03 & UserName & H01
SendRoom = HexToAscii("02 01 F4 " & IHeader(Index) & " 00 00 " & HexLen(Packet)) & Packet
End Function

Public Function InviteToGroup(ByVal Index As Long, ByVal GroupName As String, ByVal UserName As String) As String
HPacket = HexToAscii("02 02 F0 " & IHeader(Index) & " 00 00 00")
HGroupName = HexToAscii("01 00 00 00")
HUserName = HexToAscii("02 00 00 00")
GroupName = HGroupName & HexToAscii(DecToHex(Len(GroupName))) & GroupName
UserName = HUserName & HexToAscii(DecToHex(Len(UserName))) & UserName & HexToAscii("00")
Packet = HexToAscii("00 03 00 00 00 01 01 00") & UserName & GroupName
Psize = HexToAscii(DecToHex(Len(Packet)))
InviteToGroup = HPacket & Psize & Packet
End Function

Public Function CreatGroupChat(ByVal Index As Long, GroupName As String, ByVal UserName As String) As String
HPacket = HexToAscii("02 02 EF " & IHeader(Index) & " 00 00 00")
HGroupName = HexToAscii("01 00 00 00")
HUserName = HexToAscii("02 00 00 00")
GroupName = HGroupName & HexToAscii(DecToHex(Len(GroupName))) & GroupName
UserName = HUserName & HexToAscii(DecToHex(Len(UserName))) & UserName & HexToAscii("00")
Packet = HexToAscii("00 03 00 00 00 01 01 00") & UserName & GroupName
Psize = HexToAscii(DecToHex(Len(Packet)))
CreatGroupChat = HPacket & Psize & Packet
End Function

Public Function EnterRoom(ByVal Index As Long, ByVal roomName As String) As String
    If roomName <> "" Then
    Dim a
    Rsize = Len(roomName)
    Psize = DecToHex(Rsize + 6)
    Rsize = DecToHex(Rsize)
    Rname = AsciiToHex(roomName)
    End If
EnterRoom = HexToAscii("02 02 BF " & IHeader(Index) & " 00 00 00 " & Psize & " 00 01 00 00 00 " & Rsize & " " & Rname)
End Function

Public Function LeaveGroup(ByVal Index As Long, ByVal GroupName As String) As String
HPacket = HexToAscii("02 02 F1 " & IHeader(Index) & " 00 00")
Group = HexToAscii("00 01 00 00 " & HexLen(GroupName)) & GroupName
Packet = HexToAscii("00 02 00 00 00 01 01") & Group
LeaveGroup = HPacket & HexToAscii(HexLen(Packet)) & Packet
End Function
Public Function LeaveRoom(ByVal Index As Long, ByVal roomName As String) As String
Rsize = DecToHex(Len(roomName))
Psize = DecToHex(Len(roomName) + 6)
LeaveRoom = HexToAscii("02 02 C0 " & IHeader(Index) & " 00 00 00 " & Psize & " 00 01 00 00 00 " & Rsize) & roomName
End Function

Public Function ListGroup(ByVal Index As Long, ByVal GroupName As String) As String
HPacket = HexToAscii("02 02 F2 " & IHeader(Index) & " 00 00")
Group = HexToAscii("00 01 00 00 " & HexLen(GroupName)) & GroupName
Packet = HexToAscii("00 02 00 00 00 01 01") & Group
ListGroup = HPacket & HexToAscii(HexLen(Packet)) & Packet
End Function
Public Function ListRoom(ByVal Index As Long, ByVal roomName As String) As String
HPacket = HexToAscii("02 02 C3 " & IHeader(Index) & " 00 00")
Packet = HexToAscii("00 01 00 00 " & HexLen(roomName)) & roomName
ListRoom = HPacket & HexToAscii(HexLen(Packet)) & Packet
End Function

Public Function GetFavoriteRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 01") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetFavoriteRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 01 00") & PCategory
End Function
Public Function GetMoreFavoriteRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 01") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetMoreFavoriteRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 00 00") & PCategory
End Function
Public Function GetRecentRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 02") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetRecentRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 01 00") & PCategory
End Function
Public Function GetMoreRecentRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 02") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetMoreRecentRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 00 00") & PCategory
End Function
Public Function GetHotRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 03") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetHotRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 01 00") & PCategory
End Function
Public Function GetMoreHotRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 03") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetMoreHotRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 00 00") & PCategory
End Function
Public Function GetGameRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 04") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetGameRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 01 00") & PCategory
End Function
Public Function GetMoreGameRoom(ByVal Index As Long) As String
HCategory = HexToAscii("01 00 00 00")
Category = HexToAscii("00 04") '1-FavoriteRoom, 2-RecentRoom, 3-HotRoom, 4-GameRoom
LCategory = HexToAscii(DecToHex(Len(Category)))
PCategory = HCategory & LCategory & Category
GetMoreGameRoom = HexToAscii("02 02 CC " & IHeader(Index) & " 00 00 00 0F 00 02 00 00 00 01 00 00") & PCategory
End Function

Public Function SetPresence(ByVal Index As Long, ByVal Presence As Integer) As String
Status = HexToAscii(DecToHex(Presence))
SetPresence = HexToAscii("02 02 58 " & IHeader(Index) & " 00 00 00 0E 00 02 00 00 00 01 01 00 01 00 00 00 01") & Status
End Function

Public Function HashCode(ByVal Value) As String
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 SendHashCode(ByVal Index As Long, ByVal PassWord As String, ByVal CODE As String) As String
Dim strhashcode As String
strhashcode = Right$("00000000" & Hex(HashCode(CODE & PassWord)), 8)
SendHashCode = (HexToAscii("02 00 CA " & IHeader(Index) & " 00 00 00 0A 00 01 00 00 00 04 " & Left$(strhashcode, 2) & " " & Mid$(strhashcode, 3, 2) & " " & Mid$(strhashcode, 5, 2) & " " & Right$(strhashcode, 2)))
End Function


Public Function ContactAccept(ByVal Index As Long, ByVal UserName As String, ByVal Group As String) As String
PHeader = HexToAscii("02 01 9D " & IHeader(Index) & " 00 00")
If Group <> "" Then
'Group = HexToAscii(Group)
Group = HexToAscii("00 03 00 00 " & HexLen(Group)) & Group
End If
UserName = HexToAscii("00 01 00 00 " & HexLen(UserName)) & UserName
paket = HexToAscii("00 04 00 00 00 01 00") & Group & HexToAscii("00 02 00 00 00 01 01") & UserName
ContactAccept = PHeader & HexToAscii(HexLen(paket)) & paket
End Function

Public Function ContactInvite(ByVal UserName As String, ByVal Group As String) As String
PHeader = HexToAscii("02 01 95 " & IHeader(NoUrut(0)) & " 00 00")
UserName = HexToAscii("00 0C 00 00 " & HexLen(UserName)) & UserName
H18 = HexToAscii("00 18 00 00 00 01 00")
If Group <> "" Then
'Group = HexToAscii(Group)
Group = HexToAscii("00 02 00 00 " & HexLen(Group)) & Group
End If
paket = H18 & Group & UserName
ContactInvite = PHeader & HexToAscii(HexLen(paket)) & paket
End Function

Public Function ContactReject(ByVal Index As Long, ByVal UserName As String) As String
UserName = HexToAscii("00 01 00 00 " & HexLen(UserName)) & UserName
ContactReject = HexToAscii("02 01 9E " & IHeader(Index) & " 00 00 " & HexLen(UserName)) & UserName
End Function

Public Function ContactDelete(ByVal Index As Long, ByVal UserID As String) As String
UserID = HexToAscii("00 01 00 00 " & HexLen(UserID)) & UserID
ContactDelete = HexToAscii("02 01 96 " & IHeader(Index) & " 00 00 " & HexLen(UserID)) & UserID
End Function

Public Function LogIn(ByVal Index As Long, ByVal UserName As String, ByVal Presence As Integer) As String
Status = HexToAscii(DecToHex(Presence))

Language = "en-US"
UserAgent = "mig33Chat"
Version = UserAgent & "v" & cPanel.Tag
H01 = HexToAscii("00 01 00 00 00 02 00 01")
H02 = HexToAscii("00 02 00 00 00 01 02")
H03 = HexToAscii("00 03 00 00 00 02 01 99")
UserName = HexToAscii("00 05 00 00 00") & HexToAscii(DecToHex(Len(UserName))) & UserName
Version = HexToAscii("00 07 00 00 00 " & DecToHex(Len(Version))) & Version

UserAgent = HexToAscii("00 08 00 00 00 " & DecToHex(Len(UserAgent))) & UserAgent
Status = HexToAscii("00 09 00 00 00 01") & Status
H0B = HexToAscii("00 0B 00 00 00 04 00 00 00 0E")
H0C = HexToAscii("00 0C 00 00 00 04 00 00 00 AA")
H0D = HexToAscii("00 0D 00 00 00 04 00 00 00 A9")
'H0E = HexToAscii("00 0E 00 00 00 04 00 00 00 00")
Language = HexToAscii("00 0F 00 00 " & HexLen(Language)) & Language
H10 = HexToAscii("00 10 00 00 00 04 00 00 00 15")
H13 = HexToAscii("00 13 00 00 00 01 00")
PHeader = HexToAscii("02 00 C8 " & IHeader(Index) & " 00 00")

LogIn = H13 & H10 & Language & H0E & H0D & H0C & H0B & Status & UserAgent & Version & UserName & H03 & H02 & H01
LogIn = PHeader & HexToAscii(HexLen(LogIn)) & LogIn
'LogIn = HexToAscii("02 00 C8 00 01 00 00 00 80 00 13 00 00 00 01 00 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 32 30 2E 32 39 31 00 05 00 00 00 05 67 69 67 6E 65 00 03 00 00 00 02 01 99 00 02 00 00 00 01 02 00 01 00 00 00 02 00 01")
End Function

Public Function LogInGIF(ByVal UserName As String, ByVal Presence As Integer) As String

Status = HexToAscii(DecToHex(Presence))

Language = "en-US"
UserAgent = "xtrsyz"
Version = "http://xtrsyz.org/"
H01 = HexToAscii("00 01 00 00 00 02 00 01")
H02 = HexToAscii("00 02 00 00 00 01 02")
H03 = HexToAscii("00 03 00 00 00 02 01 8F")
UserName = HexToAscii("00 05 00 00 00") & HexToAscii(DecToHex(Len(UserName))) & UserName
Version = HexToAscii("00 07 00 00 00 " & DecToHex(Len(Version))) & Version

UserAgent = HexToAscii("00 08 00 00 00 " & DecToHex(Len(UserAgent))) & UserAgent
Status = HexToAscii("00 09 00 00 00 01") & Status
H0B = HexToAscii("00 0B 00 00 00 04 00 00 00 0E")
H0C = HexToAscii("00 0C 00 00 00 04 00 00 00 AA")
H0D = HexToAscii("00 0D 00 00 00 04 00 00 00 AE")
H0E = HexToAscii("00 0E 00 00 00 04 00 00 00 00")
'Language = HexToAscii("00 0F 00 00 00 " & DecToHex(Len(Language))) & Language & HexToAscii("00")
'H10 = HexToAscii("00 10 00 00 00 04 00 00 00 15")
'H13 = HexToAscii("00 13 00 00 00 01 00")
PHeader = HexToAscii("02 00 C8 " & IHeader(NoUrut(0)) & " 00 00")

LogInGIF = H0E & H0D & H0C & H0B & Status & UserAgent & Version & UserName & H03 & H02 & H01
LogInGIF = PHeader & HexToAscii(HexLen(LogInGIF)) & LogInGIF
End Function

Public Sub Respond(ByVal data As String, ByRef Khezia() As String)
Dim result As String
Erase Khezia()
On Error Resume Next
result = "xtrsyz" & XTSPLT & "http://xtrsyz.org/"
    logKhez = AsciiToHex(Left(data, 3))
    CodeX = Mid(data, 10)

Select Case logKhez
    Case "02 00 00"
        result = "Error"
    Case "02 00 01"
        result = "Info"
    Case "02 00 03"
        result = "KeepAlive"
    Case "02 00 05"
        result = "EnterRoom"
    Case "02 00 08"
        result = "ReceiveGift"
    Case "02 00 0E"
        result = "Invite"
    Case "02 00 CB"
        result = "02 00 CB"
    Case "02 00 C9"
        result = "HashCode"
    Case "02 01 91"
        result = "LoadContactGroup"
    Case "02 01 92"
        result = "LoadContactList"
    Case "02 01 94"
        result = "ChangeContactStatus"
    Case "02 01 9C"
        result = "Invite"
    Case "02 01 A4"
        result = "AddContactRespond" '5F=AddGroupContact 60=AddContact
    Case "02 01 A5"
        result = "StatusUpdate"
    Case "02 01 A6"
        result = "UpdateGift"
    Case "02 01 F4"
        result = "Chat"
    Case "02 01 F6"
        result = "ReceivePicture"
    Case "02 01 F7"
        result = "EmailNotification"
    Case "02 02 5B"
        result = "02 02 5B"
    Case "02 02 BD"
        result = "SearchRoomOld"
    Case "02 02 C4"
        result = "ListRoom"
    Case "02 02 CD"
        result = "02 02 CD"
    Case "02 02 CE"
        result = "Users&Rooms"
    Case "02 02 F3"
        result = "ListGroup"
    Case "02 03 26"
        result = "ReceiveCall"
    Case "02 03 86"
        result = "Credit"
    Case "02 03 8F"
        result = "Link"
    Case "02 03 92"
        result = "DownloadEmot"
    Case "02 03 94"
        result = "ListEmot"
    Case "02 03 9B"
        result = "Browser"
End Select

Khezia(0) = result

    While Len(CodeX) > 2
    Dim IsiPaket As String
    PanjangPaket = AsciiToDec(Mid(CodeX, 3, 4))
    i = AsciiToDec(Mid(CodeX, 2, 1))
    IsiPaket = Mid(CodeX, 7, PanjangPaket)
    Khezia(i) = IsiPaket
    'HTML = Mid(IsiPaket, 2, 6)
    'LPaket = Len(IsiPaket)
    'satudec = HexToDec(AsciiToHex(Left(IsiPaket, 1)))
    '    If LPaket > 1 And satudec = 0 And HTML <> "<html>" Then
    '    asdsad = AsciiToHex(IsiPaket)
    '    Khezia(i) = "#" & Mid(Trim(Replace(AsciiToHex(IsiPaket), " ", "")), 3)
    '    ElseIf LPaket = 1 Then
    '    Khezia(i) = HexToDec(Trim(AsciiToHex(IsiPaket)))
    '    ElseIf LPaket > 1 And satudec < 5 And HTML <> "<html>" Then
    '    'IsiPaket = Replace(AsciiToHex(IsiPaket), " ", "")
    '    Khezia(i) = Trim(AsciiToHex(IsiPaket))
    '    End If
    'If Khezia(i) = "#" Then
    'Khezia(i) = ""
    'End If
    CodeX = Mid(CodeX, 7 + PanjangPaket)
    Wend

End Sub


Private Function IHeader(ByVal Index As Long) As String
IHeader = Right("0000" & Hex(Index), 4)
IHeader = Left(IHeader, 2) & " " & Right(IHeader, 2)
End Function
Private Function Xrand()
Xrand = DecToHex((Int(66 * Rnd())) + 6)
End Function
Private Function Xsend()
Xsend = DecToHex((Int(66 * Rnd())) + 1)
End Function



Public Function HexToAscii(ByVal inputstr As String) As String
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)))
Next i
ElseIf Len(inputstr) = 2 Then
finnal = Chr(Val("&H" & inputstr))
End If
HexToAscii = finnal
End Function
Public Function AsciiToHex(ByVal 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)
HeXT = Hex(Asc(Mid(inputstr, i, 1)))
If Len(HeXT) < 2 Then HeXT = "0" & HeXT
finnal = finnal & HeXT & " "
Next i
AsciiToHex = Mid(finnal, 1, Len(finnal) - 1)
End Function
Public Function DecToHex(ByVal inVal As Integer) As String
    Dim s As String
    s = Trim(Hex(inVal))
    If Len(s) < 2 Then
         s = "0" & s
    End If
    DecToHex = s
End Function
Public Function AsciiToDec(ByVal asciiStr As String) As Long
asciiStr = AsciiToHex(asciiStr)
AsciiToDec = HexToDec(asciiStr)
End Function
Public Function HexToDec(ByVal hexStr As String) As Long
On Error GoTo bukanhex
hexStr = Replace(hexStr, " ", "")
hexStr = Replace(hexStr, "#", "")
If hexStr = "" Then hexStr = 0
HexToDec = CLng("&H" & hexStr)
If asdasdsd = True Then
bukanhex:
hexStr = AsciiToHex(hexStr)
HexToDec = HexToDec(hexStr)
End If
End Function
Public Function UnHex(ByVal sHex As String) As Long
    sHex = Replace(sHex, " ", "")
    'UnHex = Val("&H" & sHex)
    UnHex = CLng("&H" & sHex)
End Function

Public Function KeepAlive(ByVal Index As Long) As String
MXT = "xtrsyz still alive"
MXT = HexToAscii("00 08 00 00 " & HexLen(MXT)) & MXT
paket = MXT & HexToAscii("00 01 00 00 00 04 00 00 00 01")
KeepAlive = HexToAscii("02 00 02 " & IHeader(Index) & " 00 00 " & HexLen(paket)) & paket
End Function

Public Function GetEmot(ByVal Index As Long, ByVal List As String) As String
'PHeader = HexToAscii("02 03 91 " & IHeader(Index) & " 00 00")
'H02 = HexToAscii("00 02 00 00 00 04 00 00 00 01")
'H01 = HexToAscii("00 01 00 00 " & HexLen(List)) & List
'Paket = H02 & H01
'GetEmot = PHeader & HexToAscii(HexLen(Paket)) & Paket
GetEmot = HexToAscii("02 03 91 " & IHeader(Index) & " 00 00 00 08 00 01 00 00 00 " & DecToHex(Len(List))) & List
End Function

Private Function SegF(ByVal Index As Integer, ByVal data As String)
SegF = HexToAscii("00 " & DecToHex(Index) & " 00 00 " & HexLen(data)) & data
End Function
Hidden: PHP Class Module
Post reply to view.
Visit this user's website Find all posts by this user
Quote this message in a reply
02-06-2012, 07:38 PM
Post: #2
nicnoc Offline
Posts: 1
Joined: Oct 2011
Reputation: 0
RE: mig33Class module
yang php ada tambah dunk tutorial tambahannya hehehe
ijin copy ya untuk dipelajari :thumbup
Find all posts by this user
Quote this message in a reply
08-20-2012, 01:16 PM
Post: #3
masterplay Offline
Posts: 1
Joined: Aug 2012
Reputation: 0
RE: mig33Class module
(02-06-2012 07:38 PM)nicnoc Wrote:  yang php ada tambah dunk tutorial tambahannya hehehe
ijin copy ya untuk dipelajari :thumbup

betul banget...... biar tambah juga ilmunya...... sip buat ngembanginnya Very Happy
Find all posts by this user
Quote this message in a reply
08-25-2012, 09:01 AM (This post was last modified: 08-25-2012 09:02 AM by dewrin.)
Post: #4
dewrin Offline
Posts: 1
Joined: Nov 2011
Reputation: 0
RE: mig33Class module
thanks for sharing,,,lets see hidden code
thanks for sharing,,,lets see hidden code
Find all posts by this user
Quote this message in a reply
04-07-2013, 04:08 PM
Post: #5
atef201080 Offline
Posts: 2
Joined: Apr 2013
Reputation: 0
RE: mig33Class module
thanks for sharing,,,,,,,,,,, Happy
Find all posts by this user
Quote this message in a reply
05-30-2013, 01:36 AM
Post: #6
ade8977655 Offline
Posts: 1
Joined: May 2013
Reputation: 0
RE: mig33Class module
thx for sharing these code.........................................
Find all posts by this user
Quote this message in a reply
06-24-2013, 12:43 AM
Post: #7
nightmare Offline
Posts: 1
Joined: Jun 2013
Reputation: 0
RE: mig33Class module
serem script.a.. salut dah.. bisa buat belajar php ma vbVery Happy
Find all posts by this user
Quote this message in a reply
09-11-2013, 01:20 AM
Post: #8
azkha Offline
Posts: 1
Joined: Sep 2013
Reputation: 0
RE: mig33Class module
Oya baru liat text akhirnya, izin view Very Happy
Find all posts by this user
Quote this message in a reply
12-04-2013, 04:21 AM
Post: #9
wixe Offline
Posts: 1
Joined: Dec 2013
Reputation: 0
RE: mig33Class module
intip yg bawah Very Happy biar tambah greget ya gan
Find all posts by this user
Quote this message in a reply
« Next Oldest | Next Newest »
Post Reply 


  • View a Printable Version
  • Send this Thread to a Friend
  • Subscribe to this thread
Forum Jump:


User(s) browsing this thread: 1 Guest(s)

Contact Us | mig33 | Return to Top | Return to Content | Lite (Archive) Mode | RSS Syndication | Dr.XT | Domain & Hosting | Free Hosting

Powered By MyBB, © 2002-2023 MyBB Group.