WSHで環境変数を設定する

<?xml version="1.0" encoding="Shift_JIS" standalone="yes" ?>
<package>
<job id="SetUserEnvByFldDiag">
<script language="VBScript">
<![CDATA[
Option Explicit

'設定する環境変数名の配列
Dim gEnvNames 'As Variant
gEnvNames = Array("BuckUp1", "BuckUp2", "BuckUp3")

'メイン ルーチンを実行
JobMain


'メイン ルーチン
Sub JobMain()
    Dim wshShell 'As WshShell
    Set wshShell = WScript.CreateObject("WScript.Shell")
    
    '処理開始の確認メッセージ
    If wshShell.Popup("環境変数を設定します。よろしいですか？", _
        0, "処理の開始", vbOKCancel + vbQuestion) = vbCancel Then
        wshShell.Popup "処理を中止しました。", _
                       0, "処理の終了", vbOKOnly + vbInformation
        WScript.Quit
    End If
    
    '設定しようとする環境変数が未定義であることを確認
    If Not NotExistsUserEnv(gEnvNames) Then
        wshShell.Popup _
            "すでに設定済みの環境変数が存在します。処理を中止します。", _
            0, "処理の終了", vbOKOnly + vbInformation
        WScript.Quit
    End If
    
    '環境変数名とパスをハッシュ（連想配列）に格納
    Dim envPaths 'As Dictionary
    Set envPaths = GetEnvPathHash(gEnvNames)
    If envPaths Is Nothing Then
        wshShell.Popup _
            "有効なフォルダが選択されなかったため処理を中止します。", _
            0, "処理の終了", vbOKOnly + vbInformation
        WScript.Quit
    End If
    
    'システム環境変数に設定
    SetUserEnvs envPaths
    
    '処理完了メッセージ
    wshShell.Popup "環境変数の設定が完了しました。", _
                   0, "処理の終了", vbOKOnly + vbInformation
    
    Set envPaths = Nothing
    Set wshShell = Nothing
End Sub

'環境変数名とフォルダ パスのハッシュ（連想配列）を返す。
'このハッシュは、引数で渡される環境変数名の配列をキーに、
'BrowseFolder 関数で取得するフォルダ パスを値に持つ。ただし、
'BrowseFolder が有効なフォルダ パスを返さなかった場合、Nothing を返す。
'
'@param  envNames {Variant} Array 関数による環境変数名の配列
'@return {Dictionary} 環境変数名とフォルダ パスのハッシュ
Function GetEnvPathHash(ByVal envNames) 'As Dictionary
    Dim envPaths 'As Dictionary
    Set envPaths = WScript.CreateObject("Scripting.Dictionary")
    
    Dim envName 'As Variant
    For Each envName In envNames
        Dim path 'As String
        path = BrowseFolder( _
            envName & " に設定するフォルダを選択してください。")
        
        If Not ValidateFilePath(path) Then
            Set GetEnvPathHash = Nothing
            Exit Function
        End If
        
        envPaths.Add envName, path
    Next
    
    Set GetEnvPathHash = envPaths
End Function

'引数のファイル パスが、有効なパスであるかどうかを判定します。
'
'@param  path {String} ファイル パス
'@return {Boolean} 有効なパスであるかどうか
Function ValidateFilePath(ByVal path) 'As Boolean
    Dim ret 'As Boolean
    ret = False
    
    If Len(path) > 2 Then
        If Mid(path, 2, 2) = ":\" Then
            ret = True
        End If
    End If
    
    ValidateFilePath = ret
End Function

'引数で渡される環境変数名の配列の各要素が、未定義であることを調べる。
'既に定義されているものが見つかった時点で False を返す。
'
'@param  envNames {Variant} Array 関数による環境変数名の配列
'@return {Boolean} フォルダ パス
Function NotExistsUserEnv(ByVal envNames) 'As Boolean
    Dim ret 'As Boolean
    ret = True
    
    Dim wshShell 'As WshShell
    Dim userEnv  'As WshEnvironment
    Set wshShell = WScript.CreateObject("WScript.Shell")
    Set userEnv  = wshShell.Environment("User")
    
    Dim nameList 'As String
    Dim envName  'As Variant
    For Each envName In userEnv
        nameList = nameList & Mid(envName, 1, InStr(envName, "="))
    Next
    For Each envName In envNames
        If InStr(nameList, envName) > 0 Then
            ret = False
            Exit For
        End If
    Next
    
    Set wshShell = Nothing
    Set userEnv  = Nothing
    
    NotExistsUserEnv = ret
End Function

'引数のハッシュ（連想配列）の内容を環境変数に設定する。
'
'@param  hash {Dictionary} 環境変数の名前と値のハッシュ
Sub SetUserEnvs(ByVal hash)
    Dim wshShell 'As WshShell
    Dim userEnv  'As WshEnvironment
    Set wshShell = WScript.CreateObject("WScript.Shell")
    Set userEnv  = wshShell.Environment("User")
    
    Dim key 'As Variant
    For Each key In hash
        userEnv.Item(key) = hash.Item(key)
    Next
    
    Set wshShell = Nothing
    Set userEnv  = Nothing
End Sub

'フォルダを開くダイアログでパスを取得する。
'
'@param  msg {String} ダイアログに表示するメッセージ
'@return {String} フォルダ パス
Function BrowseFolder(ByVal msg) 'As String
    Dim shell 'As Shell
    Dim dir   'As Directry
    Set shell = WScript.CreateObject("Shell.Application")
    Set dir   = shell.BrowseForFolder(0, msg, 0)
    
    If Not dir Is Nothing Then
        BrowseFolder = dir.Self.path
    End If
    
    Set dir   = Nothing
    Set shell = Nothing
End Function
]]>
</script>
</job>
</package>