' ファイル/フォルダアクセス権追加サンプルスクリプト
Option Explicit

Const READ = 1179817    ' 読み取り(RX)

Call Main
WScript.Quit()

Sub Main()
    Dim result
    Dim objLocator
    Dim objPrivileges
    Dim objServices
    
    Set objLocator = CreateObject("WbemScripting.SWbemLocator")
    Set objPrivileges = objLocator.Security_.Privileges
    objPrivileges.AddAsString "SeSecurityPrivilege"
    objPrivileges.AddAsString "SeRestorePrivilege"
    Set objServices = objLocator.ConnectServer(".", "root\cimv2")
    result = ChangePermission(objServices, _
        "c:\father\test\testfolder", "Everyone", 1179817)
    WScript.Echo result
    
    Set objServices = Nothing
    Set objPrivileges = Nothing
    Set objLocator = Nothing
End Sub

' パーミッションの変更
Function ChangePermission(objService, strFileName, strAccountName, _
numPermission)
    Dim objSetting
    Dim objSecurityDescriptor
    Dim objTargetTrustee
    Dim objFileACL
    Dim objTargetAccountACEs
    Dim objACE
    Dim numOtherCount
    Dim numTargetCount
    Dim bMustCreateACE
    
'   On Error Resume Next
    
    ' 論理ファイルセキュリティ設定の取得
    Set objSetting = objService.Get( _
        "Win32_LogicalFileSecuritySetting='" & strFileName & "'")
    If Err.Number <> 0 Then
        ChangePermission = Err.Number
        Exit Function
    End If
    
    ' セキュリティ記述子の取得
    If objSetting.GetSecurityDescriptor(objSecurityDescriptor) <> 0 _
    Then
        Set objSetting = Nothing
        ChangePermission = Err.Number
        Exit Function
    End If
    
    ' ターゲットユーザの取得
    If CreateTrustee(strAccountName, objService, objTargetTrustee) _
    <> 0 Then
        Set objSecurityDescriptor = Nothing
        Set objSetting = Nothing
        ChangePermission = Err.Number
        Exit Function
    End If
    
    ' ディクショナリを作る
    Set objFileACL = CreateObject("Scripting.Dictionary")
    Set objTargetAccountACEs = CreateObject("Scripting.Dictionary")
    numOtherCount = 0
    numTargetCount = 0
    ' 既存の ACE をターゲットユーザのものとそれ以外のものに振り分ける
    For Each objACE In objSecurityDescriptor.DACL
        If objACE.Trustee.SIDString = objTargetTrustee.SIDString Then
            ' ターゲットユーザが対象の ACE を追加する
            numTargetCount = numTargetCount + 1
            objTargetAccountACEs.Add CStr(numTargetCount), objACE
        Else
            ' ターゲットユーザ以外が対象の ACE を追加する
            numOtherCount = numOtherCount + 1
            objFileACL.Add CStr(numOtherCount), objACE
        End If
    Next
    
    ' ターゲットユーザが対象の ACE を調べる
    If numTargetCount > 0 Then
        ' ある
        bMustCreateACE = True
        For Each objACE In objTargetAccountACEs.Items
            If objACE.AceType = 0 Then
                ' 許可
                If objACE.AccessMask = numPermission Then
                    ' 設定するつもりだったアクセス権が既にある
                    bMustCreateACE = False
                Else
                    objFileACL.Add CStr(objFileACL.Count + 1), objACE
                End If
            Else
                ' 拒否
                objFileACL.Add CStr(objFileACL.Count + 1), objACE
            End If
        Next
    Else
        ' ない
        bMustCreateACE = True
    End If
    
    ' 追加する必要があれば ACE を作成して追加
    If bMustCreateACE = True Then
        Set objACE = objService.Get("Win32_ACE").SpawnInstance_()
        With objACE
            .AceType = 0
            .AceFlags = 3
            .Trustee = objTargetTrustee
            .AccessMask = numPermission
        End With
        ' ディクショナリに追加
        objFileACL.Add CStr(objFileACL.Count + 1), objACE
        ' セキュリティ記述子を更新
        objSecurityDescriptor.DACL = objFileACL.Items
        ' 論理ファイルセキュリティ設定を更新
        objSetting.SetSecurityDescriptor objSecurityDescriptor
    End If
    
    ChangePermission = Err.Number
    If Err.Number <> 0 Then WScript.Echo Err.Description
    
    Set objACE = Nothing
    Set objSetting = Nothing
    Set objSecurityDescriptor = Nothing
    Set objTargetTrustee = Nothing
    Set objFileACL = Nothing
    Set objTargetAccountACEs = Nothing
End Function

' Trustee オブジェクトの作成
Function CreateTrustee(strAccountName, objService, objTrustee)
    Dim colAccount
    Dim objSID
    Dim item
    
    On Error Resume Next
    
    ' アカウントを取得する
    Set colAccount = objService.ExecQuery( _
        "SELECT * FROM Win32_ACCOUNT " & _
        "WHERE Name='" & strAccountName & "'")
    
    ' SID を取得する
    For Each item in colAccount
        Set objSID = objService.Get("Win32_SID='" & item.SID & "'")
    Next
    
    ' Win32_Trustee オブジェクトを作成
    Set objTrustee = objService.Get("Win32_Trustee").SpawnInstance_()
    With objTrustee
        .Domain = objSID.ReferencedDomainName
        .Name = objSID.AccountName
        .SID = objSID.BinaryRepresentation
        .SidLength = objSID.SidLength
        .SIDString = objSID.SID
    End With
    CreateTrustee = Err.Number
    
End Function