ActiveBasic ExitWindowsExを使いたい

質問

ActiveBasic 4.23.00を使ってプログラムを書いています。

電源を自動的に落としてくれるタイマーを作っているのですが、
ExitWindowsEx関数と言うものを見つけ、早速使ってみました。
しかし、ログオフ以外の機能が使えません。
なぜかと思い、検索したところ、shutdownの権限みたいなのを取得しないといけないようなのですが、VBスクリプトで書いてあって、よく分かりません。
参考にさせていただいたサイトは、
http://mt-soft.sakura.ne.jp/web_dl/vb-parts/poweroff/
です。

どのようにして、アクセス権を取得すればいいのでしょうか。
すみませんがご教授ください。
サンプルコードなどもいただけたら嬉しいです。
よろしくお願いします。

回答No.2

machongola · ベストアンサー

こんばんは。補足頂きました。

　以下のリンク内でもActiveBasic4で試みて、相当混乱した様です。結局の所、呼び出せずじまいで、その3年後辺りに再び誰かがActiveBasic5で試みたところ、漸く成功した様です。
　http://www.activebasic.com/forum/viewtopic.php?p=10407

　取り敢えず試し続けた所、ActiveBasic4.23.00で成功しました。以下で出来ませんか。

#ifdef UNICODE
TypeDef LPCTSTR = *WCHAR
#else
TypeDef LPCTSTR = *BYTE
#endif

'OpenProcessToken()に渡すフラグ
Const TOKEN_QUERY = (&h0008)
Const TOKEN_ADJUST_PRIVILEGES = (&h0020)

'LookupPrivilegeValue()に渡すフラグ
Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
Const SE_PRIVILEGE_ENABLED = (&h00000002)

'ExitWindowsEx()に渡すフラグ
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const EWX_POWEROFF = 8

Const ANYSIZE_ARRAY = 1

Type LUID
LowPart As DWord
HightPart As Long
End Type

Type LUID_AND_ATTRIBUTES
Luid As LUID
Attributes As Long
End Type

Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges[ELM(ANYSIZE_ARRAY)] As LUID_AND_ATTRIBUTES
End Type

Declare Function ExitWindowsEx Lib "user32" (uFlags As DWord, dwReserved As DWord) As BOOL
Declare Function OpenProcessToken Lib "advapi32" (ProcessHandle As HANDLE, DesiredAccess As DWord, ByRef TokenHandle As HANDLE) As BOOL
Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (lpSystemName As LPCTSTR, lpName As LPCTSTR, ByRef Luid As LUID) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32" (TokenHandle As HANDLE, DisableAllPrivileges As Long, ByRef NewState As TOKEN_PRIVILEGES, BufferLength As Long, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Long) As Long

Sub PowerOff()

Dim hToken As HANDLE
Dim tknPri As TOKEN_PRIVILEGES
Dim result As BOOL

'自分のトークンハンドルを取る
result = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)

'シャットダウンの特権を取る
result = LookupPrivilegeValue(NULL, SE_SHUTDOWN_NAME, tknPri.Privileges[0].Luid)

'情報の設定をする
tknPri.PrivilegeCount = 1
tknPri.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED

'自分のトークンハンドルにシャットダウンの特権を設定する
result = AdjustTokenPrivileges(hToken, FALSE, tknPri, 0, ByVal 0, ByVal 0)

'トークンハンドルを閉じる
CloseHandle(hToken)

'PCをシャットダウンする
ExitWindowsEx(EWX_POWEROFF Or EWX_FORCE, 0)

End Sub

お礼

ありがとうございます！
出来たようです！！

回答No.1

machongola

こんにちは。以下で出来ませんか。

Const EWX_POWEROFF = &H8

Sub PowerOff()

Dim hToken As HANDLE
Dim tknPri As TOKEN_PRIVILEGES
Dim result As BOOL
Dim luid As LUID

'シャットダウンの特権を取る
result = LookupPrivilegeValue(NULL, "SeShutdownPrivilege", luid)

'自分のトークンハンドルを取る
result = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)

'情報の設定をする
tknPri.PrivilegeCount = 1
tknPri.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED
tknPri.Privileges[0].Luid = luid

'自分のトークンハンドルにシャットダウンの特権を設定する
result = AdjustTokenPrivileges(hToken, FALSE, tknPri, 0, ByVal 0, ByVal 0)

'トークンハンドルを閉じる
CloseHandle(hToken)

'PCをシャットダウンする
ExitWindowsEx(EWX_POWEROFF, 0)

End Sub

お礼

すみません・・・
出来ませんでした。

エラーがでました。
エラーは、
"TOKEN_PRIVILEGES" 無効な識別子です
"OpenProcessToken" はすでに定義されています
"TOKEN_PRIVILEGES" 無効な識別子です
"LUID" 無効な識別子です
"LookupPrivilegeValue(NULL,"SeShutdownPrivilege",luid)" 無効な識別子です
"TOKEN_ADJUST_PRIVILEGES" 無効な識別子です
"TOKEN_QUERY" 無効な識別子です
実数に対して "or" 演算子は利用できません
"tknPri.PrivilegeCount" 無効な識別子です
"tknPri.Privileges[0].Attributes" 無効な識別子です
"SE_PRIVILEGE_ENABLED" 無効な識別子です
"tknPri.Privileges[0].Luid" 無効な識別子です
"luid" 無効な識別子です
"AdjustTokenPrivileges関数の第6パラメータ"は値参照型です。ByVal指定することはできません
"AdjustTokenPrivileges関数の第5パラメータ"は値参照型です。ByVal指定することはできません
"tknPri" 無効な識別子です