SOURCE CODE MIG33 TCP (VISUAL BASIC)

Bagian form 1

Code:

Private Declare Function GetHash Lib "hashGen.dll" (ByVal tEncode As String) As Long    'perintah load hashgen.dll

Private Sub about_Click()
MsgBox "mig33 tcp login by phat, www.mig33mgl.co.cc", vbSystemModal
End Sub

Private Sub Conek_Click()
On Error GoTo t                'apabila error menuju ke t
Winsock1.Close                  'koneksi ke server mig33
Winsock1.RemoteHost = IPe      'IP gateway.mig33.com
Winsock1.RemotePort = Port      'port nya
Winsock1.Connect                'perintah koneksi
Exit Sub
t:
MsgBox "Error : " & Err.Description, vbCritical    'menampilkan pesan error
Exit Sub
End Sub

Private Sub Disco_Click()
Winsock1_Close                  'memanggil sub winsock_close
End Sub

Private Sub Erum_Click()
On Error GoTo t
Dim i As Integer, X As String      'deklarasi variabel
Dim Lrum As String, Arum As String      'deklarasi variabel
Dim HexPaket As String, HexPaketFull As String, EnterPaket As String    'deklarasi variabel
Lrum = Room.Text    'deklarasi variabel pengganti room
i = Len(Lrum)  'len = jumlah digit room
If i < 3 Or i > 15 Then 'kalo gak ngerti kebangeten, ya dah ku kasih tau, ckakak (gak ada room yg kurang dr 3 digit or lebih dr 15 digit jika gak segitu maka keluar)
Exit Sub
Else
X = Hex(6 + i)
End If
Arum = Asciitohex(Lrum)    'perintah mengubah ascii room mjd hexa
HexPaket = "02 02 BF 00 0C 00 00 00 00 00 01 00 00 00 "    'code enter room
HexPaketFull = Left$(HexPaket, 24) & X & " " & Mid$(HexPaket, 28, 14) & " " & Hex(i) & " " & Arum
EnterPaket = HextoAscii(HexPaketFull)      'code enter room setelah digabung dgn kode username
Winsock1.SendData EnterPaket        'perintah mengirim code enter room
t:
Exit Sub
End Sub

Private Sub exit_Click()
Unload Me      'perintah menutup form
End Sub

Private Sub Glogin_Click()
On Error GoTo t
Dim a As Integer    'deklarasi variabel
Dim Usiz As String  'deklarasi variabel
Dim Psize As String 'deklarasi variabel
Dim Aname As String 'deklarasi variabel
Usiz = Len(Uname)  'uzis = jmlh digit username
Aname = Asciitohex(Uname)  'aname = mengubah username mjd hexa
Psize = (Hex(101 + Usiz))
Usiz = Hex(Usiz)
a = Len(Usiz)  'a = jumlah digit uzise
If a < 2 Then Usiz = "0" & Usiz 'jika a kurang dr 2 maka uzise ditambah "0"
Winsock1.SendData (HextoAscii("02 00 C8 00 01 00 00 00 " & Psize & " 00 0E 00 00 00 04 00 00 00 00 00 0D 00 00 00 04 00 00 00 AE 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 63 00 08 00 00 00 04 6A 32 6D 65 00 07 00 00 00 09 4A 32 4D 45 76 33 2E 30 35 00 05 00 00 00 " & Usiz & " " & Aname & " 00 03 00 00 00 02 01 31 00 02 00 00 00 01 02 00 01 00 00 00 02 00 01"))  'perintah menirim paket pertama code login
t:
Exit Sub
End Sub

Private Sub how_Click()
MsgBox "click get login then click login", vbSystemModal
End Sub

Private Sub kick_Click()
On Error GoTo t
Dim Psize As String 'deklarasi variabel
Dim Coder As String 'deklarasi variabel
Dim KickUname As String 'deklarasi variabel
Dim KickUsize As String 'deklarasi variabel
Dim DataOut As String  'deklarasi variabel
Dim Rname As String 'deklarasi variabel
Dim Rsize As String 'deklarasi variabel
Dim a  'deklarasi variabel
Dim b  'deklarasi variabel
Dim c  'deklarasi variabel
a = Len(Tkick.Text) 'a = jmlh digit username yg mo di kick
b = Len(Room.Text)  'b = jmlh digit room
Psize = (a + b) + 12
Psize = Hex(Psize)
c = Len(Psize)
If c < 2 Then Psize = "0" & Psize
KickUsize = Hex(a)
c = Len(KickUsize)
If c < 2 Then KickUsize = "0" & KickUsize
Rsize = Hex(b)
c = Len(Rsize)
If c < 2 Then Rsize = "0" & Rsize
KickUname = Asciitohex(Tkick.Text)  'username yg mo di kick
Rname = Asciitohex(Room.Text)  'nama room
Coder = "02 02 C2 00 0A 00 00 00 " & Psize & " 00 02 00 00 00 " & KickUsize & " " & KickUname & " 00 01 00 00 00 " & Rsize & " " & Rname    'code kick + username
DatOut = HextoAscii(Coder)  'mengubah coder dr hexa ke ascii
Winsock1.SendData DatOut    'mengirim ke server
t:
Exit Sub
End Sub

Private Sub Lerum_Click()
On Error GoTo t
Dim i As Integer, X As String  'deklarasi variabel
Dim Lrum As String, Arum As String  'deklarasi variabel
Dim HexPaket As String, HexPaketFull As String, LeavePaket As String    'deklarasi variabel
Lrum = Room.Text    'deklarasi variabel pengganti room
i = Len(Lrum)
If i < 3 Or i > 15 Then
Exit Sub
Else
X = Hex(6 + i)
End If
Arum = Asciitohex(Lrum) 'mengubah lrum dr ascii mjd hexa
HexPaket = "02 02 C0 00 14 00 00 00 00 00 01 00 00 00 " 'code leave room
HexPaketFull = Left$(HexPaket, 24) & X & " " & Mid$(HexPaket, 28, 14) & " " & Hex(i) & " " & Arum  'menggabungkan code room dgn username
LeavePaket = HextoAscii(HexPaketFull)  'mengubah HexPaketFull dr hexa mjd ascii
Winsock1.SendData LeavePaket    'send data ke server
t:
Exit Sub
End Sub

Private Sub Login_Click()
Ngehash 'memanggil sub ngehash
End Sub

Private Sub Send_Click()
On Error GoTo t
If Tteks = "" Then
Exit Sub
End If
Dim a As Integer    'deklarasi variabel
Dim b As Integer    'deklarasi variabel
Dim Coder As String, name As String, Rname As String, Tisi As String, DatOut As String  'deklarasi variabel
Dim Usize As String, Rsize As String, Tsize As String, Psize As String  'deklarasi variabel
Usize = Len(Uname)  'usize = jmlh digit username
Rsize = Len(Room)  'rsize = jmlh digit room
Tsize = Len(Tteks)  'tsize = jmlh digit teks yg mo disend
b = Usize + 40
b = b + Rsize
b = b + Tsize
Psize = Hex(b)
a = Len(Psize)
If a < 2 Then Psize = "0" & Psize
Usize = Hex(Usize)
a = Len(Usize)
If a < 2 Then Usize = "0" & Usize
Rsize = Hex(Rsize)
a = Len(Rsize)
If a < 2 Then Rsize = "0" & Rsize
Tsize = Hex(Tsize)
a = Len(Tsize)
If a < 2 Then Tsize = "0" & Tsize
name = Asciitohex(Uname)    'mengubah uname menjadi hexa
Rname = Asciitohex(Room)    'mengubah room mjd hexa
Tisi = Asciitohex(Tteks)    'mengubah Tteks mjd hexa
Coder = "02 01 F4 00 0B 00 00 00 " & Psize & " 00 08 00 00 00 " & Tsize & " " & Tisi & " 00 06 00 00 00 02 00 01 00 04 00 00 00 " & Rsize & " " & Rname & " 00 03 00 00 00 01 03 00 02 00 00 00 " & Usize & " " & name & " 00 01 00 00 00 01 01"    'code send teks
DatOut = HextoAscii(Coder)  'mengubah coder hexa mjd ascii
Winsock1.SendData DatOut    'mengirim paket ke server
t:
Exit Sub
End Sub

Private Sub Winsock1_Close()
Winsock1.Close  'menutup koneksi winsock
ST = "..::Disconnected::.." 'menampilkan status disco
End Sub

Private Sub Winsock1_Connect()
ST = "..::Connected::.."    'menampilkan status connect
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String, midHash As String, hasege As String  'deklarasi variabel
Dim Hash As String  'deklarasi variabel
Dim Hstrdata As String  'deklarasi variabel
Winsock1.GetData strData, vbString  'perintah untuk mendapatkan data dr server
Hstrdata = Asciitohex(strData)  'mengubah data dr server ke haxa
midHash = Mid$(Hstrdata, 69, Len(Hstrdata)) 'potong memotong teks
hasege = HextoAscii(midHash)    'setelah dipotong diubah lg ke ascii
Nah.Text = hasege  'menampilkanya
strData = Replace(strData, vbNullChar, "")  'perintah mereplace karakter yg gak bisa ditampilkan
Debug.Print strData 'menampilkan debug strdata
ST = strData    'menampilkan data dr server ke text box
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
ST = "Error cannot connect" 'menampilkan status error apabila tjd error
End Sub

Private Sub Ngehash()
On Error GoTo t
Dim haus As Long    'deklarasi variabel
Dim haos As String  'deklarasi variabel
Dim Hash As String  'deklarasi variabel
Dim DOK As String, jajal As String  'deklarasi variabel
Hash = Nah.Text & Paswot.Text  'deklarasi variabel penggabungan code dr server + password
haus = GetHash(Hash)    'menggenerate data dgn hashgen.dll
haos = Hex(haus)    'sama
DOK = Left(haos, 2) & " " & Mid(haos, 3, 2) & " " & Mid(haos, 5, 2) & " " & Right(haos, 2)
jajal = "02 00 CA 00 02 00 00 00 0A 00 01 00 00 00 04 " & DOK  'data login + hasil generate hash data
Winsock1.SendData (HextoAscii(jajal)) 'mengirim ke server
t:
Exit Sub
End

Sub

Bagian module 1

Code:

Option Explicit
    Public Function HextoAscii(inputstr As String) As String    'fungsi untuk mengubah hexa ke ascii
    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
    HextoAscii = finnal
    ElseIf Len(inputstr) = 2 Then
    finnal = Chr(Val("&H" & inputstr))
    HextoAscii = finnal
    End If
    End Function

    Public Function Asciitohex(inputstr As String) As String    'fungsi untuk mengubah assci ke hexa
    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))) & " "
    Next i
    Asciitohex = Mid(finnal, 1, Len(finnal) - 1)
    End Function

SOURCE CODE MIG33 TCP

NOTHING IS IMMPOSIBLE. . .

IMMPOSIBLE IS NOTHING. . .

Thx;s Buanyaaakkkkkkkkkk :d

Wah. .Wah. .Wah. . . Btw pa aja c app yg dpake buat bikin tuh app. .Kyk kick dan lain2 nya

software yang di gunakan om phat itu adalah visual basic ( VB ),,itu software untuk membuat apps,,,kalo aku VB lebih mudah dari pada C++

hlem_standart. wrote:software yang di gunakan om phat itu adalah visual basic ( VB ),,itu software untuk membuat apps,,,kalo aku VB lebih mudah dari pada C++

Q JUGA BUAT LEWAT AHK. . . .

HAHAHHA. . . . .



NOTHING IS IMMPOSIBLE. . . .

IMMPOSIBLE IS NOTHING. . . .

linknya gag bisa di dunlud




tolong duuuuuuuuuuuuuuuuuunnnnnkkkkkkkzzzzzzzzzzz:speker:



mw belajar bikinnnnnnnnnnnnnnnn applikasiiiiiiiiiiiiiiiiiinya niiiiiiiiiiieeeeeeeeeeeee

rama_reagen wrote:linknya gag bisa di dunlud




tolong duuuuuuuuuuuuuuuuuunnnnnkkkkkkkzzzzzzzzzzz:speker:



mw belajar bikinnnnnnnnnnnnnnnn applikasiiiiiiiiiiiiiiiiiinya niiiiiiiiiiieeeeeeeeeeeee

yang mna yang gag bisa????





NOTHING IS IMMPOSIBLE. . .

IMMPOSIBLE IS NOTHING. . .

dah bisa thanx yawhh

siiiiipppppppppp bro,. . . . .





NOTHING IS IMMPOSIBLE. . . .

IMMPOSIBLE IS NOTHING. . . .

MINTA TUTORIALNYA DONG VB 2005 .......
MUU BELAJAR BIKIN ........

Wah, makasih byank bro phat....
Gw udah berhasil, tinggal berkraesi sendiri..........

tanks

askum............sblm na met knal mua all.
gw leh gbung ga nie?
sbner na gw tuh ga ngrti ap it Vb. stelah gw buka forum nie ternyata banyak code2 vb n gw nyoba wat blajar bikin app yang code na udh tersdia d atas. ternyata brhasil!
nah....ad kendala nie yang mw gw tanyain ma senior2 yang ad d forum nie....
gmana c cra na bikin id supaya bisa ol lebih dari satu?
soal na,,, wktu gw nambahn textbox untuk user name yg k-2 it sllalu ggal alias error...mohon pencerahannya...

ws mas bro mungkin bisa liat di sini klik ini

kang pean gw e o app u/ mig33 aq ta gw VB5 gawe app nek toko toko alias app pembukuan laaaa..... VB5 seng ta belajari mung iku tok coz aq pe ngopeni anak e pak mudin kan yow bth duit

whuakakakakakakak. .. .ndang dimuLai toh. . . .

wah kok gak bisa ya ga keluar apa2... salah dimana ya....

aq coba dulu ea brow

plis bantu ,, aq binggung bagian ip dan port nya,,,
plisss bantu ya.........

Aq minta tolong bget ma kak admin yg udah postingin souce code bikin app diatas?
Eh aq minta sub code buat
winsock1.RemoteIP
winsock1.RemotePort
winsock1.SendData
pliz kasih tau aq,
aq pengen jdi pengembang aplikasi miger terutama kicker...,

o.o

bingung aku

MAS bro, SOURCE CODE MIG33 TCP ,kok ngak bisa di download,.... mau nyoba ngulik, biar berpusing-pusing ria,.... klo boleh ya Mas Bro, thanx's