Mig33 Programing-VBForums
Results 1 to 8 of 8

Thread: Mig33 Programing

Threaded View

  1. #1

    Thread Starter
    Member
    Join Date
    Nov 2010
    Posts
    53

    Talking Mig33 Programing

    Ok as i saw some user need mig33 source code ok here is it .im sharing some code of mig33 logn + kick + send text + bla bla bla

    Mig33 packet generator Code:
    1. 'Orginal by b4db0yb4d
    2. Public Function AsciiToHex(ByVal StrToHex As String) As String
    3.     Dim strTemp As String
    4.     Dim strReturn As String
    5.     Dim i As Long
    6.     For i = 1 To Len(StrToHex)
    7.         strTemp = Hex$(Asc(Mid$(StrToHex, i, 1)))
    8.         If Len(strTemp) = 1 Then
    9.             strTemp = "0" & strTemp
    10.         End If
    11.         strReturn = strReturn & strTemp
    12.     Next i
    13.     AsciiToHex = strReturn
    14. End Function
    15. Public Function HexToAscii(ByVal HexToStr As String) As String
    16.     Dim strTemp As String
    17.     Dim strReturn As String
    18.     Dim i As Long
    19.     For i = 1 To Len(HexToStr) Step 2
    20.         strTemp = Chr$(Val("&H" & Mid$(HexToStr, i, 2)))
    21.         strReturn = strReturn & strTemp
    22.     Next i
    23.     HexToAscii = strReturn
    24. End Function
    25. Public Function A2D(ascii As String)
    26. A2D = Unhex(AsciiToHex(ascii))
    27. End Function
    28. Public Function Unhex(Hexa)
    29. Unhex = Val("&H" & Hexa)
    30. End Function
    31. Public Function DecToHex(ByVal Value As Integer) As String
    32.     Dim strResult As String
    33.     strResult = Hex$(Value)
    34.     If Len(strResult) < 2 Then
    35.         DecToHex = "0" & strResult
    36.     Else
    37.         DecToHex = strResult
    38.     End If
    39. End Function
    40. Public Function DecToHexStr(ByVal inVal As Integer) As String
    41.     Dim s As String
    42.     s = Trim(Hex(inVal))
    43.     If Len(s) < 2 Then
    44.          s = "0" & s
    45.     End If
    46.     DecToHexStr = s
    47. End Function
    48. Public Function DecToHexFull(strAsc) As String
    49.     strAsc = Hex(strAsc)
    50.     If Len(strAsc) < 8 Then
    51.         Do Until Len(strAsc) = 8
    52.             strAsc = "0" & strAsc
    53.         Loop
    54.     End If
    55.     Dim lonLen As Long
    56.     lonLen = Len(strAsc)
    57.     Dim i As Integer
    58.     For i = 1 To Len(strAsc)
    59.         strAsc = strAsc & Mid(strAsc, i, 2)
    60.         i = i + 1
    61.     Next i
    62.     DecToHexFull = Mid(strAsc, lonLen + 1)
    63.     DecToHexFull = Mid(DecToHexFull, 1, Len(DecToHexFull))
    64. End Function

    Mig33 Hash code + hash code generator Code:
    1. 'Orginal by b4db0yb4d
    2. Public Function hashCode(Value)
    3. Const maxInt = 4294967295#
    4. Const maxPostInt = 2147483647
    5. Dim H As Currency
    6. Dim div As Long
    7. Dim i As Integer
    8. Dim B4DH As String
    9. H = 0
    10. For i = 1 To Len(Value)
    11.     H = H * 31 + Asc(Mid$(Value, i, 1))
    12.     If (H > maxInt) Then
    13.         div = Int(H / (maxInt + 1))
    14.         H = H - (div * (maxInt + 1))
    15.     End If
    16. Next i
    17. If H > maxPostInt Then
    18.     H = H - maxInt - 1
    19. End If
    20. B4DH = Len(H)
    21. If B4DH = "8" Then hashCode = H
    22. If B4DH = "7" Then hashCode = "0" & H
    23. If B4DH = "6" Then hashCode = "00" & H
    24. If B4DH = "5" Then hashCode = "000" & H
    25. If B4DH = "4" Then hashCode = "0000" & H
    26. If B4DH = "3" Then hashCode = "00000" & H
    27. If B4DH = "2" Then hashCode = "000000" & H
    28. If B4DH = "1" Then hashCode = "0000000" & H
    29. End Function
    30.  
    31. Public Function GenerateHashCode(Packet As String)
    32. Dim aLong As Long
    33. Dim TempPacket As String
    34. aLong = hashCode(Packet)
    35. TempPacket = Right$("00000000" & Hex(aLong), 8)
    36. GenerateHashCode = Left$(TempPacket, 2) & Mid$(TempPacket, 3, 2) & Mid$(TempPacket, 5, 2) & Right$(TempPacket, 2)
    37. End Function
    38.  
    39. Public Function SendHash(DatIn As String, Password As String)
    40. Dim Hash1 As String
    41. Dim Hash2 As String
    42. Dim Hash3 As String
    43. Dim Chal As String
    44. Dim Feed As String
    45.     If InStr(AsciiToHex(Mid$(DatIn, 10, 4)), "00020000") > 0 Then
    46.     Hash1 = Mid$(DatIn, 12, 4)
    47.     Hash1 = AsciiToHex(Hash1)
    48.     Hash1 = Unhex(Hash1)
    49.     Hash2 = Mid$(DatIn, (Hash1 + 21), 1)
    50.     Hash2 = AsciiToHex(Hash2)
    51.     Hash2 = Unhex(Hash2)
    52.     Chal = Right$(DatIn, Hash2)
    53.     ElseIf InStr(AsciiToHex(Mid$(DatIn, 10, 4)), "00010000") > 0 Then
    54.     Hash3 = Mid$(DatIn, 12, 4)
    55.     Hash3 = AsciiToHex(Hash3)
    56.     Hash3 = Unhex(Hash3)
    57.     Chal = Mid$(DatIn, 16, Hash3)
    58.     End If
    59.     Chal = Chal & Password
    60.     Feed = GenerateHashCode(Chal)
    61.     SendHash = HexToAscii("0200CA00020000000A000100000004" & Feed)
    62. End Function
    Mig33 Login + enter chat room/Leave chat room + kick + send room msg packet Code:
    1. Public Function LogIn(Username As String)
    2. LogIn = HexToAscii("0200C80002" & DecToHexFull(Len(Username) + 154) & "0013000000010000110000000000100000000400000015000F00000005656E2D5553000D00000004000000A9000C00000004000000AA000B000000040000000E0009000000016300080000001D6D696733332F342E36322028556E6B6E6F776E29206B42726F7773657200070000000D4A324D4576342E36322E3030300005" & DecToHexFull(Len(Username)) & AsciiToHex(Username) & "00030000000201CE000200000001020001000000020001")
    3. End Function
    4.  
    5. Public Function LeaveRoom(room As String)
    6. LeaveRoom = HexToAscii("0202C00017" & DecToHexFull(Len(room) + 6) & "0001" & DecToHexFull(Len(room)) & AsciiToHex(room))
    7. End Function
    8.  
    9. Public Function JoinRoom(room As String)
    10. JoinRoom = HexToAscii("0202BF000F" & DecToHexFull(Len(room) + 6) & "0001" & DecToHexFull(Len(room)) & AsciiToHex(room))
    11. End Function
    12.  
    13. Public Function SpyRoom(room As String)
    14. SpyRoom = (HexToAscii("0202C30010" & DecToHexFull(Len(room) + 6) & "0001" & DecToHexFull(Len(room))) & room)
    15. End Function
    16.  
    17. Public Function SendTextRoom(user As String, Text As String, room As String)
    18. SendTextRoom = H2ANS("0201F4000B000000" & DecToHex(Len(user) + 40 + Len(room) + Len(Text)) & "0008000000" & DecToHex(Len(Text)) & A2HNS(Text) & "00060000000200010004000000" & DecToHex(Len(room)) & A2HNS(room) & "000300000001030002000000" & DecToHex(Len(user)) & A2HNS(user) & "00010000000101")
    19. End Function
    20.  
    21. Public Function KickUser(room As String, target As String)
    22. KickUser = H2ANS("0202C20000" & DecToHexFull(Len(room) + Len(target) + 12) & "0002" & DecToHexFull(Len(target)) & A2HNS(target) & "0001" & DecToHexFull(Len(room)) & A2HNS(room))
    23. End Function

    How to identify packet header on socket data arrival ? Code:
    1. Private Sub Socket_DataArrival(ByVal Index As Variant, ByVal bytesTotal As Long)
    2. Socket.GetData (Index), b4d(Index), vbString
    3. Header(Index) = A2HNS(Left(b4d(Index), 3))
    4. If Header(Index) = "0200C9" Then
    5.     Socket.SendData Index, SendHash(b4d(Index), TxtPass.Text)
    6. End If
    7. If Header(Index) = "020000" Then
    8.     If InStr(LCase(b4d(Index)), "login failed - username") > 0 Then
    9.     Socket.CloseSck Index
    10.     End If
    11.     If InStr(LCase(b4d(Index)), "login failed - ice") > 0 Then
    12.     Socket.CloseSck (Index)
    13.     Socket.Connect (Index), CmbHost.Text, TxtPort.Text
    14.     End If
    15. End If
    16. If Header(Index) = "02019C" Or Header(Index) = "0201A6" Or Header(Index) = "0200CB" Then
    17.     Lvw.ListItems.Item(Index).Checked = True
    18.     If TotalLogin.Caption <> CmbClone.Text Then
    19.     TotalLogin.Caption = TotalLogin.Caption + 1
    20.     End If
    21. End If
    22. If Header(Index) = "0202C4" Then
    23.     ListCode (Index)
    24. End If
    25. If CheckAutoTimer.Value = Checked Then
    26.     If InStr(1, LCase(b4d(Index)), "a vote to kick") > 0 Then
    27.         TimerWaktu.Enabled = True
    28.         CheckAutoTimer.Value = Unchecked
    29.     End If
    30. End If
    31. End Sub

    KeepAlive on Mig33 session ? Code:
    1. Dim i As Integer
    2. For i = 1 To Lvw.ListItems.Count
    3. a(i) = Hex(Increment(i))
    4. b(i) = Len(a(i))
    5. If b(i) < 2 Then a(i) = "0" & a(i)
    6. B4DBattle(i) = "02000200" & a(i) & "00000000"
    7. B4DOut(i) = H2ANS(B4DBattle(i))
    8. Increment(i) = Increment(i) + 1
    9. If Increment(i) > 255 Then
    10. Increment(i) = 0
    11. End If
    12. Socket.SendData (i), B4DOut(i)
    13. Next i

    Wich socket ? Try CSocketPlus Code:
    1. Dim WithEvents Socket As CSocketPlus
    2.  
    3. Private Sub Form_Load()
    4. Set Socket = New CSocketPlus
    5. End Sub
    i thing what i share here it will help new mig33 programer
    ok lets rock then...
    If you need more help then contact with me there:
    Mig33: b4db0yb4d
    Yahoo: b4db0yb4d@yahoo.com
    MSN: b4db0yb4d@live.com
    Skype: b4db0yb4d

    Web: www.b4dcorp.com
    Wap: wap.b4dcorp.com

    Thankyou.....................
    Last edited by b4db0yb4d; Dec 31st, 2011 at 05:53 PM. Reason: Update some importent function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.