#224 AccessからWindowsXPをシャットダウンさせるには? VBA、API

「#031 AccessからWindowsを終了させるには?」では、Windows9.X系の終了方法を紹介していますが、WindowsXPでは、OSのセキュリティ上の仕様によって、9.X系のような簡単なプログラムでは終了させることができません。ここでは、それを考慮したWindowsXPの各種シャットダウンのプログラムを紹介します。

まずここでは、以下のようなコードによって、汎用的に使える"WindowsXPシャットダウン"プロシージャを作成します。
  1. 標準モジュールのDeclarationsセクションにAPI関連の宣言を記述します。
    Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
    Private Const SE_PRIVILEGE_ENABLED = &H2
    Private Const ANYSIZE_ARRAY = 1
    Private Const TOKEN_ALL_ACCESS = &HF00FF
    Private Type LUID
      LowPart As Long
      HighPart As Long
    End Type
    Private Type LUID_AND_ATTRIBUTES
      pLuid As LUID
      Attributes As Long
    End Type
    Private Type TOKEN_PRIVILEGES
      PrivilegeCount As Long
      Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
    End Type
    Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
           ByVal dwReserved As Long) As Long
    Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
    Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, _
           ByVal DesiredAccess As Long, TokenHandle As Long) As Long
    Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" _
           (ByVal lpSystemName As Long, _
           ByVal lpName As String, lpLuid As LUID) As Long
    Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, _
           ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, _
           ByVal BufferLength As Long, ByVal PreviousState As Long, _
           ByVal ReturnLength As Long) As Long

  2. 続いて、標準モジュールに以下のようなSubプロシージャを記述します。
    Public Sub XPShutDown(lngSDFlg As Long)
    'WindowsXPのシステムをシャットダウンする
    '引数 lngSDFlg
    '      0: ログオフする

    '      1: シャットダウンし、電源を切れる状態にする
    '      2: シャットダウンし、システムを再起動する
      
      Dim lngToken As Long
      Dim udtTokenPrv As TOKEN_PRIVILEGES
      Dim lngRet As Long
      
      lngRet = OpenProcessToken(GetCurrentProcess(), TOKEN_ALL_ACCESS, lngToken)
      lngRet = LookupPrivilegeValue(0, SE_SHUTDOWN_NAME, udtTokenPrv.Privileges(0).pLuid)
      With udtTokenPrv
        .PrivilegeCount = 1
        .Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
      End With
      
      lngRet = AdjustTokenPrivileges(lngToken, 0, udtTokenPrv, 0, 0, 0)
      
      ExitWindowsEx lngSDFlg, 0

    End Sub

使用例:
上記Subプロシージャの呼び出し自体は非常に簡単です。以下の1行を実行するだけです。上記プロシージャの引数の説明を参考に、引数の部分を用途に合わせて変更して記述してください。

XPShutDown 1
| Index | Prev | Next |



T'sFactory
Accessで動く生産管理DB
Ureru Express
Webで使う販売顧客管理
Access開発&アドバイス
DB開発やテクニカルアドバイス
Copyright © T'sWare All rights reserved