作成 2009.12.28
更新 2010.01.09
更新 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