作成 2009.12.28
更新 2010.01.09
ユーザープロファイル用のフォルダのアクセス権を設定する
目次
仕様
実行方法
コード
仕様
  • タブ区切りのファイルを読み込んで設定する
    ユーザー名<TAB>フォルダ名
    
  • ドメインユーザーでのみ作業可能
  • ユーザー存在とprofilePathの属性確認、スペース想定済み
  • フォルダ存在確認、共有経由でも可能、スペース想定済み
実行方法

コマンド プロンプトから実行してください。

cscript set_acl.vbs (読み込むファイル名)
コード
  • icacls を使っているので XP の管理コンソールでは使用できません。コマンドラインを任意に修正してください。
  • エラーログは LogError プロシージャへ集約しています。修正すればイベントログへ記録できます。
  • グループのアクセス権を設定したい場合は、AccountExists プロシージャを修正してください。

set_acl.vbs

Option Explicit
Const ForReading = 1
Const WindowMode = 0
Const WaitOnReturn = True

Dim objRootDSE, BaseDN, objSysInfo, DomainShortName
Dim objConnection, objCommand
Dim FSO, WshShell
Dim myList
Dim myLine, myArr
Dim myCountLine
Dim myAccount
Dim myReturnCode, myCommand

If WScript.Arguments.Count < 1 Then
  LogError "Usage: csript set_acl.vbs <filename>"
  WScript.Quit
End If

Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(WScript.Arguments(0)) Then
  LogError "File Not Found: " & WScript.Arguments(0)
  WScript.Quit
End If
On Error Resume Next
Set objRootDSE = GetObject("LDAP://rootDSE")
If Err.Number <> 0 Then
  LogError "ドメイン接続に失敗しました"
  WScript.Quit
Else
  BaseDN = objRootDSE.Get("defaultNamingContext")
End If
On Error Goto 0
Set objSysInfo = CreateObject("ADSystemInfo")
DomainShortName = objSysInfo.DomainShortName
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
Set myList = FSO.OpenTextFile(WScript.Arguments(0), ForReading, False)
myCountLine = 0
Do While myList.AtEndOfStream <> True
  myCountLine = myCountLine + 1
  myLine = myList.ReadLine
  myArr = Split(myLine, vbTab, 2)
  If UBound(myArr) = 1 Then
    myAccount = AccountExists(Trim(myArr(0)))
    If myAccount = 1 Then
      If FSO.FolderExists(myArr(1)) Then
        myCommand = "icacls """ & myArr(1) & """ /inheritance:d"
        LogInfo "line:" & myCountLine & " " & myCommand
        myReturnCode = WshShell.Run(myCommand, WindowMode, WaitOnReturn)
        If myReturnCode = 0 Then
          myCommand = "icacls """ & myArr(1) & """ /grant:r """ & DomainShortName & "\" & myArr(0) & """:(OI)(CI)(F)"
          LogInfo "line:" & myCountLine & " " & myCommand
          myReturnCode = WshShell.Run(myCommand, WindowMode, WaitOnReturn)
          If myReturnCode = 0 Then
            LogOK "line:" & myCountLine & " " & myArr(0)
          Else
            LogError "line:" & myCountLine & " 2," & myReturnCode
          End If
        Else
          LogError "line:" & myCountLine & " 1," & myReturnCode
        End If
      Else
        LogError "Folder Not Found: line:" & myCountLine & " " & myLine
      End If
    ElseIf myAccount = -1 Then
      LogError "ProfilePath Not Set: line:" & myCountLine & " " & myLine
    ElseIf myAccount = 0 Then
      LogError "Account Not Found: line:" & myCountLine & " " & myLine
    Else
      LogError "Unknown Error: line:" & myCountLine & " " & myLine
    End If
  Else
    LogError "Skip: line:" & myCountLine & " " & myLine
  End If
Loop
myList.Close

LogInfo "END"

Sub LogOK(strMessage)
  WScript.Echo "OK: " & strMessage
End Sub

Sub LogInfo(strMessage)
  WScript.Echo "Info: " & strMessage
End Sub

Sub LogError(strMessage)
  WScript.Echo "Error: " & strMessage
End Sub

Function AccountExists(strUserName)
  Dim strText, objRecordSet
  Dim myResult
  myResult = 0
  strText = "<LDAP://" & BaseDN & ">;(cn=" & strUserName & ");distinguishedName,profilePath;subtree"
  objCommand.CommandText = strText
  Set objRecordSet = objCommand.Execute
  If Not objRecordSet.EOF Then
    If Len(objRecordSet.Fields("profilePath")) >= 5 Then
      myResult = 1
    Else
      myResult = -1
    End If
  End If
  AccountExists = myResult
End Function

©2004-2017 UPKEN IPv4