vb怎么做个整人的自动关机程序

vb怎么做个整人的自动关机程序,第1张

vb中添加两个label,和一个timer,倒计时十秒,代码如下
Private Sub Timer1_Timer()
If Label2Caption <> Str(Timer) Then
Label2Caption = Time
End If
End Sub
Private Sub form_load()
Timer1Interval = 1000
Label1Caption = 10
End Sub
Private Sub label2_change()
Label1Caption = Label1Caption - 1
If Label1Caption = 0 Then
Shell "cmdexe /c shutdown -s -t 0"
End If
End Sub

呵呵,楼主的意思是写恶作剧吧,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)
Private Declare Function ShellAbout Lib "shell32dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const SHUTDOWN = 1
Const REBOOT = 2
Const LOGOFF = 0
Dim sh As Long
Dim counter As Integer
Dim n As Integer
Private Sub Check1_Click()
If Check1Value = 1 Then
Label3(0)Caption = "小时"
End If
End Sub
Private Sub Check2_Click()
If Check2Value = 1 Then
Label3(0)Caption = "点"
End If
End Sub
Private Sub Combo1_click()
Combo1BackColor = &H800000
Combo1ForeColor = &HFFFFFF
Select Case Combo1ListIndex
Case 0
Label2Caption = "结束会话,关闭Windows,以便安全关闭电源。"
Case 1
Label2Caption = "结束会话,关闭Windows,然后重新启动。"
Case 2
Label2Caption = "结束会话,用户重新登陆。"
End Select
End Sub
Private Sub Combo1_DropDown()
Combo1BackColor = &HFFFFFF
Combo1ForeColor = &H0
End Sub
Private Sub Command1_Click()
Dim str As String
If Command2Enabled = True Then
Select Case Combo1ListIndex
Case 0
shutdown1
Case 1
reboot1
Case 2
logoff1
End Select
Else
If Check1Value = 0 And Check2Value = 0 And Check3Value = 0 Then
Select Case Combo1ListIndex
Case 0
shutdown1
Case 1
reboot1
Case 2
logoff1
End Select
Else
If Check1Value = 0 And Check2Value = 0 Then
str = MsgBox("你还有设置漏选!", 48, "错误")
End If
End If
n = Val(Text1Text) 3600 + Val(Text2Text) 60 + Val(Text3Text)
If Check2Value = 1 Then
If Text1Text = "" Then
Text1Text = "0"
End If
If Text2Text = "" Then
Text2Text = "0"
End If
If Text3Text = "" Then
Text3Text = "0"
End If
End If
If Check1Value = 1 Then
If Val(Text3Text) > 60 Or Val(Text2Text) > 60 Then
MsgBox "填入的数据错误,要重填!", 48, "错误"
n = 0
Exit Sub
End If
If Text1Text <> "0" And Text2Text = "0" Then
Text2Text = "60"
End If
If Text2Text <> "0" And Text3Text = "0" Then
Text3Text = "60"
End If
End If
Timer1Enabled = True
End If
End Sub
Private Sub Command2_Click()
Dim str As String
If Combo1Text = "" Then
str = MsgBox("请选择 *** 作类型!", 0, "错误")
Exit Sub
End If
Frame1Visible = True
Command2Enabled = False
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Command4_Click()
Call ShellAbout(hwnd, "关闭Windows", "本软件由 HydeKong 制作!" & vbCrLf & "谢谢使用!", MeIcon)
End Sub
Private Sub Command5_Click()
If Timer1Enabled = True Then
Timer1Enabled = False
End If
Text1Text = 0
Text2Text = 0
Text3Text = 0
End Sub
Private Sub Form_Load()
Frame1Visible = False
Label2Caption = ""
Combo1AddItem "关机"
Combo1AddItem "重新启动"
Combo1AddItem "注销"
counter = 0
Timer1Enabled = False
End Sub
Private Sub shutdown1()
sh = ExitWindowsEx(SHUTDOWN, dwReserved)
End Sub
Private Sub reboot1()
sh = ExitWindowsEx(REBOOT, dwReserved)
End Sub
Private Sub logoff1()
sh = ExitWindowsEx(LOGOFF, dwReserved)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Key = Chr(KeyAscii)
If KeyAscii <> 8 And Key < "0" Or Key > "9" Then
MsgBox "请填入数字!"
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
Key = Chr(KeyAscii)
If KeyAscii <> 8 And Key < "0" Or Key > "9" Then
MsgBox "请填入数字!"
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
Key = Chr(KeyAscii)
If KeyAscii <> 8 And Key < "0" Or Key > "9" Then
MsgBox "请填入数字!"
End If
End Sub
Private Sub Timer1_Timer()
counter = counter + 1
If Check1Value = 1 Then
If Text1Text <> 0 And Text2Text = "60" Then
Text1Text = Text1Text - "1"
End If
If Text2Text <> 0 And Text3Text = "60" Then
Text2Text = Text2Text - "1"
End If
If Text3Text <> 0 Then
Text3Text = Text3Text - "1"
End If
If Text2Text = "0" And Text1Text <> "0" Then
Text2Text = "60"
End If
If Text3Text = "0" And Text2Text <> "0" Then
Text3Text = "60"
End If
End If
Dim ch As String
If Check3Value = 1 Then
If n > 300 Then
If n - counter = 300 Then
Dim rtn
rtn = SetWindowPos(Mehwnd, -1, 0, 0, 0, 0, 3)
ch = MsgBox("还有5分钟就要关机,是否继续执行?", 48 + vbYesNo, "提醒")
If ch = vbNo Then
Timer1Enabled = False
rtn = SetWindowPos(Mehwnd, -2, 0, 0, 0, 0, 3)
counter = 0
Exit Sub
Else
MsgBox "请做好数据保存,就要关机了!", 48, "提醒"
End If
End If
End If
End If
If (n - counter) = 0 Then
Select Case Combo1ListIndex
Case 0
shutdown1
Case 1
reboot1
Case 2
logoff1
End Select
End If
End Sub

Private Declare Function RtlAdjustPrivilege Lib "ntdlldll" (ByVal Privilege As Long, ByVal Enable As Long, ByVal CurrentThread As Long, Enabled As Long) As Long
Private Declare Sub NtShutdownSystem Lib "ntdlldll" (ByVal Action As Long)
窗体的事件中(如Command_Click中)加入
Dim tmpPriv as long
RtlAdjustPrivilege &H13,1,0,tmpPriv
NtShutdownSystem 0
点击之前要先保存所有未完成的工作,否则丢失数据可别怪我

Private
Sub
Command1_Click(Index
As
Integer)
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
Private
Sub
Command4_Click()
Unload
Me
'卸载窗体
End
Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/13356198.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-07-20
下一篇 2023-07-20

发表评论

登录后才能评论

评论列表(0条)

保存