boystars ADMINISTRATOR


 Jumlah posting : 526 Lokasi : Penajam Kota tercinta. Petung Desa damai nan permai Nick mig : boystars, dai4,ocal Room : Masih sekitar Indonesia juga 
 | Subyek: SOURCE CODE MIG33 TCP (visual basic) Mon 20 Jul 2009 - 23:08 | |
| 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 |
|
Kha-riem A J U D A N


 Jumlah posting : 35 Lokasi : Balikpapan_gc Nick mig : Kha-riem Room : lndonesia all
 | Subyek: Re: SOURCE CODE MIG33 TCP (visual basic) Mon 31 Aug 2009 - 20:52 | |
| awal mulanya kaya apa ni bro binun |
|