Option Explicit
'OS情報
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long '構造体のサイズ（バイト単位）
dwMajorVersion As Long 'メジャー バージョン
dwMinorVersion As Long 'マイナ バージョン
dwBuildNumber As Long 'ビルド番号
dwPlatformId As Long 'OS識別（下記）
szCSDVersion(127) As Byte '任意の OS に関する追加情報を提供する NULL で終わる文字列
End Type
'dwPlatformId OS識別
Const VER_PLATFORM_WIN32s = 0 'Windows 3.1
Const VER_PLATFORM_WIN32_WINDOWS = 1 'Windows 95 または Windows 98
' Windows 95：dwMinorVersion 0
' Windows 98：dwMinorVersion 0 より大きい
Const VER_PLATFORM_WIN32_NT = 2 'Windows NT
Const VER_PLATFORM_WIN32_CE = 3 'Windows Embedded CE
'OS情報取得
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(ByRef VersionInfo As OSVERSIONINFO) As Long
' シャットダウンの種類を指定
Const EWX_LOGOFF = 0 'ログオフ
Const EWX_SHUTDOWN = &H1 'シャットダウン 98:電源オフ
Const EWX_REBOOT = &H2 '再起動
Const EWX_FORCE = &H4 '強制（無条件に実行）
Const EWX_POWEROFF = &H8 '電源オフ NT:電源オフ 98:無し
' システムをログオフまたはシャットダウン
Private Declare Function ExitWindowsEx Lib "user32.dll" _
(ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
' 自分自身の擬似プロセスハンドルを取得
Private Declare Function GetCurrentProcess Lib "KERNEL32.DLL" () As Long
' アクセストークンのタイプ
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
' プロセスと結び付けられたアクセストークンを開く
Private Declare Function OpenProcessToken Lib "advapi32.dll" _
(ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
' ユニークな認証標識を定義する構造体
Private Type tagLUID
LowPart As Long
HighPart As Long
End Type
' SE_SHUTDOWN_NAME特権を示す定数
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
' 指定した特権名のLUIDを検索
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" _
Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLuid As tagLUID) As Long
' ユニークな認証標識と属性を定義
Private Type LUID_AND_ATTRIBUTES
Luid As tagLUID
Attributes As Long
End Type
' アクセストークンの特権セット情報を定義
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(0) As LUID_AND_ATTRIBUTES
End Type
' 特権の属性を示す定数
Private Const SE_PRIVILEGE_ENABLED = &H2&
' 指定したアクセストークンを設定
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _
(ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, _
ReturnLength As Long) As Long
Private 予定時刻 As Date
Private Op As Long '処理種別
Private Sub Form_Load()
'------------------
' 書式設定
'------------------
Me.Caption = "指定時間後にシャットダウン／再起動／ログオフ"
Command1.Caption = "電源オフ"
Command2.Caption = "再起動"
Command3.Caption = "ログオフ"
Command4.Caption = "中止"
Command4.Enabled = False
With Combo1
.FontSize = 11 'フォントサイズ
.IMEMode = 2 'IMEモード:オフ
.List(0) = 0 '時間リスト 0分
.List(1) = 1 '1分
.List(2) = 10 '10分
.List(3) = 30 '30分
.ListIndex = 0 '初期選択位置：0分
End With
With Label1
.FontSize = 16
.Alignment = 2
.Caption = ""
End With
With Timer1
.Enabled = False '初期状態は無効
.Interval = 1000 '周期：1秒
End With
End Sub
'----------------------------
' 指定時間の入力チェック
'----------------------------
Private Sub Combo1_KeyPress(KeyAscii As Integer)
If (KeyAscii <> Asc(vbBack)) And _
(Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0 '0〜9以外は不許可
End Sub
Private Sub Combo1_Validate(Cancel As Boolean)
If Combo1.Text = "" Then
MsgBox "指定時間：空白は無効"
Cancel = True '空白は不許可
End If
End Sub
Private Sub Command1_Click() '電源オフ
Call Go(EWX_SHUTDOWN)
End Sub
Private Sub Command2_Click() '再起動
Call Go(EWX_REBOOT)
End Sub
Private Sub Command3_Click() 'ログオフ
Call Go(EWX_LOGOFF)
End Sub
Private Sub Command4_Click() 'キャンセル
Timer1.Enabled = False 'タイマー停止
Label1.Caption = ""
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = False
End Sub
Private Sub Go(Param As Long)
Op = Param '処理種別
Label1.ForeColor = vbBlack '表示色=黒
Timer1.Enabled = True
If Val(Combo1) = 0 Then '指定時間が0なら
予定時刻 = Now() + TimeSerial(0, 0, 5) '5秒前から
Else
予定時刻 = Now() + TimeSerial(0, Val(Combo1), 0) 'そのまま
End If
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = True
End Sub
Private Sub Timer1_Timer()
Dim t As Date '残り時間
t = 予定時刻 - Now()
Label1.Caption = Format(t, "hh:mm:ss")
Select Case t
Case Is <= 0 '時間=0
'-------------------
' 電源オフ実行
'-------------------
Call PowerOff '電源オフ実行
End
Case Is <= TimeSerial(0, 0, 10) '10秒以内
Label1.ForeColor = vbRed '表示色=赤
Beep 'カウントダウン音
Case Else
End Select
End Sub
Private Sub PowerOff()
'
' 電源オフ用サブルーチン
'
Dim lngHandleProcess As Long
Dim lngHandleToken As Long
Dim udtLuid As tagLUID
Dim udtNewState As TOKEN_PRIVILEGES
Dim udtPreviousState As TOKEN_PRIVILEGES
Dim lngLengthReturn As Long
Dim lngRc As Long
'OS識別
Dim Os As OSVERSIONINFO
Os.dwOSVersionInfoSize = Len(Os)
Call GetVersionEx(Os) 'OSバージョン取得
If Os.dwPlatformId = VER_PLATFORM_WIN32_NT Then 'NT系OS?
' カレントプロセスの疑似ハンドルを取得
lngHandleProcess = GetCurrentProcess()
' カレントプロセスのアクセストークンを開く
lngRc = OpenProcessToken(lngHandleProcess, TOKEN_QUERY Or _
TOKEN_ADJUST_PRIVILEGES, lngHandleToken)
' SE_SHUTDOWN_NAME特権のLUIDを検索
lngRc = LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, udtLuid)
' アクセストークンのパラメータに特権を付与
With udtNewState
.PrivilegeCount = UBound(.Privileges) + 1
.Privileges(0).Luid.LowPart = udtLuid.LowPart
.Privileges(0).Luid.HighPart = udtLuid.HighPart
.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
End With
' 新しいアクセストークンを設定
lngRc = AdjustTokenPrivileges(lngHandleToken, False, udtNewState, _
Len(udtPreviousState), udtPreviousState, lngLengthReturn)
' 終了処理(NTの場合、SHUTDOWNでは電源は切れない)
Call ExitWindowsEx(Op, CLng(0))
Else
' 終了処理(98の場合、POWEROFFでは誤動作(ログオフとなる))
If Op = EWX_POWEROFF Then Op = EWX_SHUTDOWN
Call ExitWindowsEx(Op, CLng(0))
End If
End Sub