vb蓝屏整人代码

整人VB小程序：蓝屏死机

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

1 秒钟后，在蓝屏的背景上显示：Your Windows is died

5 秒钟后，显示：Windows 警告内存出现严重错误

10 秒钟后，显示并计数：警告硬盘错误，无法正常运行Windows，Windows 正在试图修复所有错误，请等待100 秒……

25 秒钟后，显示：警告由于你使用了盗版操作系统微软惩罚你：定期死机

此后，这4 条信息交替显示

结束本程序的方式有两个：

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

2.到程序设定的时间后自动结束，默认120 秒。

下面是程序运行截图：

'''以下是窗体代码，在VB6.0 上调试通过：

' 一、在窗体添加一个定时器控件：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 '**** 运行程序后，延时显示蓝屏的时间（秒），可根据自己的喜好设定

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

Me.Hide

Me.BackColor = RGB(0, 0, 255): Me.Caption = "蓝屏死机"

Me.AutoRedraw = True: Me.WindowState = 2

Me.Font.Size = 21: Me.ForeColor = &HFFFFFF

Timer1.Interval = 50: Timer1.Enabled = 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 = Me.ScaleX(20, 3, Me.ScaleMode)

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()

Timer1.Enabled = False: Me.WindowState = 0: ctCi = 0: ctExit = True

Me.Move Screen.Width * 0.1, Screen.Height * 0.1, Screen.Width * 0.8, Screen.Height * 0.8

ctStrS = -1

AddStr "哈哈，一个玩笑"

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

Call ShowStr

End Sub

Private Sub Timer1_Timer()

Static Ci As Long

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

Ci = Ci + 1

If Ci * Timer1.Interval < 1000 Then Exit Sub '保证一秒钟计数一次Ci = 0

If ctShowT > 1 Then ctShowT = ctShowT - 1: Exit Sub

If ctShowT = 1 Then ctShowT = 0: Me.Show

ctT = ctT + 1: ctExitT = ctExitT - 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 "警告"