VBScript 実行時に強制的にUAC確認画面を出す

Windowsでレジストリにちょいと手を出したり必要なファイルをコピーしたり、なんていう管理系の処理を手軽に記述するのに VBScript が大変便利なのですが、Vista 以降ふつうのユーザ権限ではレジストリをいじったりシステムフォルダに手を出したりできないのです。権限が足りなくてできないのです。

こんな時は管理者として実行をすれば良いのだけど、vbs ファイルを右クリックしても管理者として実行メニューが出ません。ショートカットを作って右クリックして管理者として実行を選択したり、管理者権限のコマンドプロンプトから呼び出したりすると管理者として実行できるのですけど、とにかく操作が面倒くさい。普通にダブルクリックするだけで管理者として実行するためのUAC確認画面を出して欲しいのです。

というわけで普通に vbs をダブルクリック実行しただけでUAC確認画面を出すためのコードをちょっと書いてみました。もしかしたらもっと簡単な手法があるのかもしれないけど。既存のコードのアタマに以下のをカますだけです。実行時に引数が何も無ければ uacCheck() を呼び出します。uacCheck() の中では、自身を再実行しています。このとき、Vista以降であれば "runas" 指定で動かして UAC確認画面を出しています。XP 以下であればそれは必要無いので普通に実行しています。管理者権限で動かすとカレントディレクトリが %SystemRoot%\System32 になってしまうので元々どこで動いていたのかを引数で渡すようにしています。受け取った側では WScript.Arguments(0) で元のカレントディレクトリを得れます。

'━━━━━━━━━━━━━━━━━━━━━━━
'実行前にUAC確認画面を必ず出す
'━━━━━━━━━━━━━━━━━━━━━━━
Sub uacCheck()
	'━[ UAC対策 要 or 不要の確認 ]━━━━━━━━━━━━━━━━━━━━━━━
	Dim objWMI, osInfo, flag
	Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set osInfo = objWMI.ExecQuery("SELECT Version FROM Win32_OperatingSystem")
	flag = False
	For Each os In osInfo
		If Left(os.Version, 3) >= 6.0 Then
			flag = True
		End If
	Next
	'━[ 自身を再実行 ]━━━━━━━━━━━━━━━━━━━━━━━
	Dim objShellApp, objWshShell
	Set objWshShell = CreateObject("WScript.Shell")
	Set objShellApp=CreateObject("Shell.Application") 
	If flag Then ' Vista or later 管理者権限実行
		objShellApp.ShellExecute "wscript.exe", "" & WScript.ScriptFullName & " " & objWshShell.CurrentDirectory ,"","runas",0
	Else ' XP 通常実行
		objShellApp.ShellExecute "wscript.exe", "" & WScript.ScriptFullName & " " & objWshShell.CurrentDirectory ,"","",0
	End If
End Sub
'━━━━━━━━━━━━━━━━━━━━━━━
'ここからメインの処理
'━━━━━━━━━━━━━━━━━━━━━━━
If WScript.Arguments.Count = 0 Then
	uacCheck
Else
	'～～ここに実際の処理内容～～
	WScript.Echo WScript.Arguments(0)
End If