Windowsを終了させる方法

環境/言語:[WindowsXP、Windows７、VB6 SP6　]
分類:[VB6以前]

VB6 より　Windows のシャットダウンを実行したく、花ちゃんのサンプルプログラムコードを試用してみました。
結果としてはWin XP では正しく動作しましたが Win7では下記のエラーを出します。

Run-time error 429
ActiveX component cannot create object

Win XPとWin7での動作環境の違いから？かと思いますが、Win7での動作は可能でしょうか？　よろしくお願い致します。


下記はサンプルコードです。

Option Explicit　　 'SampleNo=137　WindowsXP VB6.0(SP5) 2002.05.22

Private Type LUID
　UsedPart As Long
　IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
　PrivilegeCount As Long
　TheLuid As LUID
　Attributes As Long
End Type

'プロセスに関連付けられているアクセストークンを開きます。
Private Declare Function OpenProcessToken Lib "advapi32" _
　　(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
　　TokenHandle As Long) As Long

'ローカル一意識別子（LUID）を取得し、指定された特権名を表現します
Private Declare Function LookupPrivilegeValue Lib "advapi32" _
　　Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
　　ByVal lpName As String, lpLuid As LUID) As Long

'カレントプロセスの擬似ハンドルを返す(P656)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

'指定したアクセストークン内の特権を有効または無効にします
Private Declare Function AdjustTokenPrivileges Lib "advapi32" _
　　(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

'カレントユーザーのログオフ、Windowsの終了、再スタートを行う(P1073)
Private Declare Function ExitWindowsEx Lib "user32" _
　　(ByVal uFlags As Long, ByVal dwReserved As Long) As Long


Private Const TOKEN_QUERY = &H8
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
Private Const SE_PRIVILEGE_ENABLED = &H2

'uFlags　は終了の方法を指定する次の定数
Private Const EWX_FORCE = &H4　　　 '応答のないプロセスを強制終了
Private Const EWX_LOGOFF = &H0　　　'ログオフ
Private Const EWX_REBOOT = &H2　　　'再起動
Private Const EWX_SHUTDOWN = &H1　　'シャットダウン（ノートPCの終了）
Private Const EWX_POWEROFF = &H8　　'電源をオフ


Private Sub sShutdown(myFlags As Long)
　　If CreateObject("SYSINFO.Sysinfo").OSPlatform = 2 Then
　　'OSがNT4・Win2000・WinXP の場合
　　　　Dim lngResult　　As Long
　　　　Dim hTokenHandle As Long
　　　　Dim tmpLuid　　　As LUID
　　　　Dim tkpNew　　　 As TOKEN_PRIVILEGES
　　　　Dim tkpPrevious　As TOKEN_PRIVILEGES
　　　　'プロセスに関連づけアクセストークンのオープン
　　　　lngResult = OpenProcessToken(GetCurrentProcess, TOKEN_QUERY Or _
　　　　　　　　　　　　　　　　TOKEN_ADJUST_PRIVILEGES, hTokenHandle)
　　　　 If lngResult = 0 Then Exit Sub
　　　　'ローカルシステムのシャットダウン特権の取得
　　　　lngResult = LookupPrivilegeValue(vbNullString, _
　　　　　　　　　　　　　　　　　　　　　　SE_SHUTDOWN_NAME, tmpLuid)
　　　　If lngResult = 0 Then Exit Sub
　　　　tkpNew.PrivilegeCount = 1
　　　　tkpNew.TheLuid = tmpLuid
　　　　tkpNew.Attributes = SE_PRIVILEGE_ENABLED
　　　　'アクセストークンの特権を変更する
　　　　lngResult = AdjustTokenPrivileges(hTokenHandle, False, _
　　　　　　　　　　　　　　　　tkpNew, Len(tkpPrevious), tkpPrevious, 0&)
　　　　If lngResult = 0 Then Exit Sub
　　End If
　　　　lngResult = ExitWindowsEx(myFlags, 0&)
End Sub


Private Sub Command1_Click()
'終了
　 Call sShutdown(EWX_POWEROFF)
End Sub


Private Sub Command2_Click()
'再起動　　 EWX_FORCE は併用しない方が無難です
　 Call sShutdown(EWX_REBOOT)
End Sub

'Windows NT/2000：システムをシャットダウンまたは再起動するには、
'呼び出し側プロセスは AdjustTokenPrivileges 関数を呼び出して、
'特権を有効にしておかなければなりません。


'Windows 95/98：シェルの仕様により、EWX_FORCE を指定して ExitWindowsEx 関数
'を呼び出すと、ユーザーを完全にログオフさせることはできません
'（システムはすべてのアプリケーションを終了させ、［ネットワークパスワードの
'入力］ダイアログボックスを表示しますが、元のユーザーのデスクトップはそのまま
'残っています）。ユーザーを強制的にログオフさせるには、［エクスプローラ］を
'終了させた後、EWX_LOGOFF と EWX_FORCE を指定して ExitWindowsEx 関数を
'呼び出してください。

■No30644に返信(コアさんの記事)
> サンプルプログラムコードを試用してみました。
下記の 2.7 の項をご覧ください。
http://hanatyan.sakura.ne.jp/hazimeni.htm


> Run-time error 429
> ActiveX component cannot create object
『If CreateObject("SYSINFO.Sysinfo").OSPlatform = 2 Then』
の行が失敗しているのでは無いでしょうか。

上記コードの実行には、SYSINFO.OCX がインストールされているだけではなく、
CreateObject するために、SYSINFO の開発時ライセンスが必要となります。

SYSINFO.OCX の実行時ライセンスだけで動作させたいのであれば、
CreateObject して使うのではなく、SysInfo コントロールを
フォームに貼って、If Me.SysInfo1.OSPlatform = 2 Then としてみてください。

■No30645に返信(魔界の仮面弁士さんの記事)
> ■No30644に返信(コアさんの記事)
>>サンプルプログラムコードを試用してみました。
> 下記の 2.7 の項をご覧ください。
> http://hanatyan.sakura.ne.jp/hazimeni.htm
>
>
>>Run-time error 429
>>ActiveX component cannot create object
> 『If CreateObject("SYSINFO.Sysinfo").OSPlatform = 2 Then』
> の行が失敗しているのでは無いでしょうか。
>
> 上記コードの実行には、SYSINFO.OCX がインストールされているだけではなく、
> CreateObject するために、SYSINFO の開発時ライセンスが必要となります。
>
> SYSINFO.OCX の実行時ライセンスだけで動作させたいのであれば、
> CreateObject して使うのではなく、SysInfo コントロールを
> フォームに貼って、If Me.SysInfo1.OSPlatform = 2 Then としてみてください。



魔界の仮面弁士 様　回答をありがとうございます。
ご指摘の通りやってみましたところ、正しく動作しました。
ありがとうございました。