Exchange-Admin Blog

ファイルアクセス許可の追加

USERS GROUP WSH ML に投稿したスクリプト

既存のアクセス権があるときの対応が中途半端なので、このまま使うのは危ない。
上位フォルダから継承されたアクセス権がある場合、特に考慮してません。
設定する目的のアクセス権が、複数の ACE で表されている場合も未対処。

また、Everyone や ローカルの Users グループについてはとりあえず大丈夫で
したが、ドメインユーザやグループについてはテストしてません。

よく[名前の確認]ボタンがあるような、入力した文字列からユーザ/グループを
探す機能ってどうやって実装するんでしょうね。
ローカルユーザ探して、ADSI WinNTプロバイダ探して、ADSI LDAPクエリー探し
て、ってやるんでしょうか。結果が複数返ってきたらどうしよう。

add_permission.vbs

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

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