本程序啟動(dòng)后,出現藍屏,模擬藍屏死機情形。此時(shí),用戶(hù)無(wú)法使用開(kāi)始菜單、任務(wù)管理器,無(wú)法操作任何程序,只能干著(zhù)急。
1 秒鐘后,在藍屏的背景上顯示:Your Windows is died
5 秒鐘后,顯示:Windows 警告 內存出現嚴重錯誤
10 秒鐘后,顯示并計數:警告 硬盤(pán)錯誤,無(wú)法正常運行 Windows,Windows 正在試圖修復所有錯誤,請等待 100 秒……
25 秒鐘后,顯示:警告 由于你使用了盜版操作系統 微軟懲罰你:定期死機
此后,這 4 條信息交替顯示
結束本程序的方式有兩個(gè):
1.用鼠標單擊屏幕左上角,連續 5 次(左上角 20 個(gè)像素范圍的區域,大約 1 平方厘米的大?。?br> 2.到程序設定的時(shí)間后自動(dòng)結束,默認 120 秒。
下面是程序運行截圖:


'''以下是窗體代碼,在 VB6.0 上調試通過(guò):
' 一、在窗體添加一個(gè)控件:Timer1,不必設置任何屬性,采用默認屬性即可
' 二、在屬性窗口將窗體的 BorderStyle 屬性設置為 0
'本人原創(chuàng ),轉載請注明出處:http://hi.baidu.com/100bd/blog/item/633b6467ea2bab28aa184c75.html
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_Load()
ctExitT = 120 '程序自動(dòng)退出的時(shí)間(秒),可根據自己的喜好設定
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 個(gè)像素范圍
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 "哈哈,一個(gè)玩笑"
AddStr "結束本程序:?jiǎn)螕羲{色區任意位置"
Call ShowStr
End Sub
Private Sub Timer1_Timer()
Static Ci As Long
WinInTop Me.hWnd, True '始終將窗體保持在最前面,使用戶(hù)無(wú)法使用開(kāi)始菜單、任務(wù)管理器,無(wú)法操作任何程序
Ci = Ci + 1
If Ci * Timer1.Interval < 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 "硬盤(pán)錯誤,無(wú)法正常運行 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 = Me.TextHeight("A"): Hj = 0.5 '行高和行距
Y0 = S1 * (1 + Hj) * (1 + ctStrS) - S1 * Hj
Y0 = (Me.ScaleHeight - Y0) * 0.5
Me.Cls
For I = 0 To ctStrS
Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(ctStr(I))) * 0.5
Me.CurrentY = Y0 + I * S1 * (1 + Hj)
Me.Print 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
'本人原創(chuàng ),轉載請注明出處:http://hi.baidu.com/100bd/blog/item/633b6467ea2bab28aa184c75.html
聯(lián)系客服