SOURCE CODE MIG33 TCP (visual basic)

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

Subyek: Re: SOURCE CODE MIG33 TCP (visual basic) Mon 31 Aug 2009 - 20:52

awal mulanya kaya apa ni bro binun

» PROJECT VISUAL NOVEL[Need Volunteer]
» Hanya Sebuah Kalimat Sederhana
» film detective
» Minta pendapat mau beli helm dengan budget terbatas!
» wta helm agv k3