On Error Resume Next
Const vbOK = 1
Const vbCancel = 2
Dim ML '//Minutes left
Dim ANS
Dim Wsh:Set Wsh = WScript.CreateObject("WScript.Shell")
Do
ML = GetML()
If ML = 0 Then WScript.Quit(0) '//退出
If ML = (-1) Then Call MsgBox("對不起，輸入有誤。" & vbCrLf & _
"請輸入十進制正整數。",vbExclamation,"輸入有誤")
Until ML > 0
Dim I
For I = 1 To ML '//Start from 1
WScript.Sleep(60 * 1000) '//1分鐘
Next I
ANS = MsgBox("妳的計時已到，請保存文件，並按確定關機。", _
vbOKCancel + vbInformation , "提示")
'//按照lz的意思，我個人覺得這裏有bug(即使用戶不知道強制終止進程)
'//只要不理睬這個對話框就不會關機。可以修改成Wsh.Popup()啊
If ANS = vbOK Then
Call Wsh.Run("SHUTDOWN -S -F -T 0",0) '//Run hide,我沒有要5秒，
Else '//想要就改成"SHUTDOWN -S -F -T 5"
Call Force()
End If
'////////////////////////////////////////////////////////////////////////
Sub Force()
Wsh.Popup("3分鐘後即將關機。請立刻保存工作！", _
5 , "警告" , vbExclamation + vbSystemModal)
WScript.Sleep(60 * 1000 * 3) '//3分鐘
Call Wsh.Run("SHUTDOWN -S -F -T 0",0)
End Sub
'////////////////////////////////////////////////////////////////////////
Function GetML()
On Error Resume Next
ANS = Trim(InputBox("妳要在多少分鐘之後提示關機？" & vbCrLf & _
"輸入0或者輸入空退出.","定時關機",))
Dim L : L = Len(ANS)
If L = 0 Then
GetML = 0 '//輸入空
Exit Function
End If
Dim Rtn : Rtn = True
Dim I
For I = 1 To L
Rtn = Rtn And IsDigit(Mid(ANS,I,1))
Next I
If Not Rtn Then
GetML = (-1) '//輸入不合法
Exit Function
End If
GetML = CInt(ANS)
End Sub
Function IsDigit( Src )
If Src = "0" Or Src = "1" Or Src = "2" Or Src = "3" Or Src = "4" _
Or Src = "5" Or Src = "6" Or Src = "7" Or Src = "8" Or Src = "9" Then
IsDigit = True
Else
IsDigit = False
End If
End Function