作成 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