Mig33 Programing

[b4db0yb4d]

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

'Orginal by b4db0yb4d
Public Function AsciiToHex(ByVal StrToHex As String) As String
    Dim strTemp As String
    Dim strReturn As String
    Dim i As Long
    For i = 1 To Len(StrToHex)
        strTemp = Hex$(Asc(Mid$(StrToHex, i, 1)))
        If Len(strTemp) = 1 Then
            strTemp = "0" & strTemp
        End If
        strReturn = strReturn & strTemp
    Next i
    AsciiToHex = strReturn
End Function
Public Function HexToAscii(ByVal HexToStr As String) As String
    Dim strTemp As String
    Dim strReturn As String
    Dim i As Long
    For i = 1 To Len(HexToStr) Step 2
        strTemp = Chr$(Val("&H" & Mid$(HexToStr, i, 2)))
        strReturn = strReturn & strTemp
    Next i
    HexToAscii = strReturn
End Function
Public Function A2D(ascii As String)
A2D = Unhex(AsciiToHex(ascii))
End Function
Public Function Unhex(Hexa)
Unhex = Val("&H" & Hexa)
End Function
Public Function DecToHex(ByVal Value As Integer) As String
    Dim strResult As String
    strResult = Hex$(Value)
    If Len(strResult) < 2 Then
        DecToHex = "0" & strResult
    Else
        DecToHex = strResult
    End If
End Function
Public Function DecToHexStr(ByVal inVal As Integer) As String
    Dim s As String
    s = Trim(Hex(inVal))
    If Len(s) < 2 Then
         s = "0" & s
    End If
    DecToHexStr = s
End Function
Public Function DecToHexFull(strAsc) As String
    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
    Next i
    DecToHexFull = Mid(strAsc, lonLen + 1)
    DecToHexFull = Mid(DecToHexFull, 1, Len(DecToHexFull))
End Function

'Orginal by b4db0yb4d
Public Function hashCode(Value)
Const maxInt = 4294967295#
Const maxPostInt = 2147483647
Dim H As Currency
Dim div As Long
Dim i As Integer
Dim B4DH As String
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
B4DH = Len(H)
If B4DH = "8" Then hashCode = H
If B4DH = "7" Then hashCode = "0" & H
If B4DH = "6" Then hashCode = "00" & H
If B4DH = "5" Then hashCode = "000" & H
If B4DH = "4" Then hashCode = "0000" & H
If B4DH = "3" Then hashCode = "00000" & H
If B4DH = "2" Then hashCode = "000000" & H
If B4DH = "1" Then hashCode = "0000000" & H
End Function
 
Public Function GenerateHashCode(Packet As String)
Dim aLong As Long
Dim TempPacket As String
aLong = hashCode(Packet)
TempPacket = Right$("00000000" & Hex(aLong), 8)
GenerateHashCode = 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)
Dim Hash1 As String
Dim Hash2 As String
Dim Hash3 As String
Dim Chal As String
Dim Feed As String
    If InStr(AsciiToHex(Mid$(DatIn, 10, 4)), "00020000") > 0 Then
    Hash1 = Mid$(DatIn, 12, 4)
    Hash1 = AsciiToHex(Hash1)
    Hash1 = Unhex(Hash1)
    Hash2 = Mid$(DatIn, (Hash1 + 21), 1)
    Hash2 = AsciiToHex(Hash2)
    Hash2 = Unhex(Hash2)
    Chal = Right$(DatIn, Hash2)
    ElseIf InStr(AsciiToHex(Mid$(DatIn, 10, 4)), "00010000") > 0 Then
    Hash3 = Mid$(DatIn, 12, 4)
    Hash3 = AsciiToHex(Hash3)
    Hash3 = Unhex(Hash3)
    Chal = Mid$(DatIn, 16, Hash3)
    End If
    Chal = Chal & Password
    Feed = GenerateHashCode(Chal)
    SendHash = HexToAscii("0200CA00020000000A000100000004" & Feed)
End Function

Public Function LogIn(Username As String)
LogIn = HexToAscii("0200C80002" & DecToHexFull(Len(Username) + 154) & "0013000000010000110000000000100000000400000015000F00000005656E2D5553000D00000004000000A9000C00000004000000AA000B000000040000000E0009000000016300080000001D6D696733332F342E36322028556E6B6E6F776E29206B42726F7773657200070000000D4A324D4576342E36322E3030300005" & DecToHexFull(Len(Username)) & AsciiToHex(Username) & "00030000000201CE000200000001020001000000020001")
End Function
 
Public Function LeaveRoom(room As String)
LeaveRoom = HexToAscii("0202C00017" & DecToHexFull(Len(room) + 6) & "0001" & DecToHexFull(Len(room)) & AsciiToHex(room))
End Function
 
Public Function JoinRoom(room As String)
JoinRoom = HexToAscii("0202BF000F" & DecToHexFull(Len(room) + 6) & "0001" & DecToHexFull(Len(room)) & AsciiToHex(room))
End Function
 
Public Function SpyRoom(room As String)
SpyRoom = (HexToAscii("0202C30010" & DecToHexFull(Len(room) + 6) & "0001" & DecToHexFull(Len(room))) & room)
End Function
 
Public Function SendTextRoom(user As String, Text As String, room As String)
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")
End Function
 
Public Function KickUser(room As String, target As String)
KickUser = H2ANS("0202C20000" & DecToHexFull(Len(room) + Len(target) + 12) & "0002" & DecToHexFull(Len(target)) & A2HNS(target) & "0001" & DecToHexFull(Len(room)) & A2HNS(room))
End Function

Private Sub Socket_DataArrival(ByVal Index As Variant, ByVal bytesTotal As Long)
Socket.GetData (Index), b4d(Index), vbString
Header(Index) = A2HNS(Left(b4d(Index), 3))
If Header(Index) = "0200C9" Then
    Socket.SendData Index, SendHash(b4d(Index), TxtPass.Text)
End If
If Header(Index) = "020000" Then
    If InStr(LCase(b4d(Index)), "login failed - username") > 0 Then
    Socket.CloseSck Index
    End If
    If InStr(LCase(b4d(Index)), "login failed - ice") > 0 Then
    Socket.CloseSck (Index)
    Socket.Connect (Index), CmbHost.Text, TxtPort.Text
    End If
End If
If Header(Index) = "02019C" Or Header(Index) = "0201A6" Or Header(Index) = "0200CB" Then
    Lvw.ListItems.Item(Index).Checked = True
    If TotalLogin.Caption <> CmbClone.Text Then
    TotalLogin.Caption = TotalLogin.Caption + 1
    End If
End If
If Header(Index) = "0202C4" Then
    ListCode (Index)
End If
If CheckAutoTimer.Value = Checked Then
    If InStr(1, LCase(b4d(Index)), "a vote to kick") > 0 Then
        TimerWaktu.Enabled = True
        CheckAutoTimer.Value = Unchecked
    End If
End If
End Sub

Dim i As Integer
For i = 1 To Lvw.ListItems.Count
a(i) = Hex(Increment(i))
b(i) = Len(a(i))
If b(i) < 2 Then a(i) = "0" & a(i)
B4DBattle(i) = "02000200" & a(i) & "00000000"
B4DOut(i) = H2ANS(B4DBattle(i))
Increment(i) = Increment(i) + 1
If Increment(i) > 255 Then
Increment(i) = 0
End If
Socket.SendData (i), B4DOut(i)
Next i

Dim WithEvents Socket As CSocketPlus
 
Private Sub Form_Load()
Set Socket = New CSocketPlus
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.....................

[LaVolpe]

This may be better suited in the CodeBank section of the forum. If you agree, contact a moderator and ask them to move it for you

[b4db0yb4d]

hmm i thing u ryt Mod move this topic to codeBank section...

[solo.mero]

lol john how u come here

[solo.mero]

hello all i know most of you dont understand this bla bla which member b4db0yb4d gave it so i made a simple project for you to get the main and easest idea of mig33 programming

[b4db0yb4d]

yes i was there from long time mero

[nahidbigboss]

john bro thanks for ur demo its very helpful

[buzz4rd]

Thanks jhon bro. It's a nice effort for Mig33 developers