递归获取指定文件夹下的所有用户权限，代码如下：
rootPath = "D:\File Data\Shared"
forbiddenFile = "D:\forbidden_result.txt"
resultFile = "D:\security_result.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(forbiddenFile) Then
fso.DeleteFile forbiddenFile
End If
If fso.FileExists(resultFile) Then
fso.DeleteFile resultFile
End If
Set treeList = CreateObject("Scripting.Dictionary")
FolderTree rootPath, "", "", treeList
Set fso = Nothing
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Open
stream.Charset = "UTF-8"
For Each key In treeList.Keys
Set folder = treeList.Item(key)
shortPath = folder.Item("shortPath")
path = folder.Item("path")
parent = folder.Item("parent")
Set securityList = GetFolderSecurityDescriptor(shortPath, path, stream)
Set parentSecurityList = CreateObject("Scripting.Dictionary")
If parent <> "" Then
Set parentSecurityList = treeList.Item(parent).Item("securityList")
End If
For Each itemKey in securityList.Keys
Set item = securityList.Item(itemKey)
sid = item.Item("sid")
If parentSecurityList.Exists(sid) Then
accessMask = item.Item("accessMask")
Set parentItem = parentSecurityList.Item(sid)
parentAccessMask = parentItem.Item("accessMask")
If accessMask = parentAccessMask Then
item.Item("inherit") = 1
End If
End If
Next
folder.Remove "securityList"
folder.Add "securityList", securityList
Next
stream.SaveToFile forbiddenFile, 2
stream.Close
Set stream = Nothing
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Open
stream.Charset = "UTF-8"
stream.Position = stream.Size
header = "folder" & vbTab & _
"domain" & vbTab & _
"username" & vbTab & _
"access mask" & vbTab &_
"inherit" & vbTab & _
"allow full control" & vbTab & _
"allow modify" & vbTab & _
"allow read and execute" & vbTab & _
"allow list" & vbTab & _
"allow read" & vbTab & _
"allow write" & vbTab & _
"allow special" & vbTab & _
"deny full control" & vbTab & _
"deny modify" & vbTab & _
"deny read and execute" & vbTab & _
"deny list" & vbTab & _
"deny read" & vbTab & _
"deny write" & vbTab & _
"deny special" & vbNewLine
stream.WriteText header
For Each key In treeList.Keys
Set folder = treeList.Item(key)
path = folder.Item("path")
Set securityList = folder.Item("securityList")
For Each itemKey In securityList.Keys
Set item = securityList.Item(itemKey)
flag = ""
If item.Item("inherit") > 0 Then flag = "Y"
line = path & vbTab & _
item.Item("domain") & vbTab &_
item.Item("name") & vbTab & _
item.Item("accessMask") & vbTab & _
flag & vbTab &_
GetAccessFlags(item.Item("accessMask")) & vbNewLine
stream.WriteText line
Next
Next
stream.SaveToFile resultFile, 2
stream.Close
Set treeList = Nothing
Set stream = Nothing
Wscript.Echo "Finished"
Function FolderTree(path, shortPath, parent, list)
Set fso = CreateObject("Scripting.FileSystemObject")
If shortPath <> "" Then
Set folder = fso.GetFolder(shortPath)
Else
Set folder = fso.GetFolder(path)
End If
Err.Clear
shortPath = folder.ShortPath
If fso.FolderExists(folder) = True Then
Set item = CreateObject("Scripting.Dictionary")
Set securityList = CreateObject("Scripting.Dictionary")
item.Add "path", path
item.Add "parent", parent
item.Add "shortPath", shortPath
item.Add "securityList", securityList
list.Add path, item
Set subFolders = folder.SubFolders
On Error Resume Next
For Each subFolder In subFolders
fullPath = path & "\" & subFolder.Name
FolderTree fullPath, subFolder.shortPath, path, list
Next
On Error GoTo 0
Set subFolders = Nothing
End If
Set fso = Nothing
Set folder = Nothing
End Function
Function GetFolderSecurityDescriptor(path, fullPath, currentStream)
On Error Resume Next
Set list = CreateObject("Scripting.Dictionary")
pathExpr = "winmgmts:Win32_LogicalFileSecuritySetting.path"
Set wmiFileSecSetting = GetObject(pathExpr & "=""" & replace(path, "\", "\\") & """")
wmiFileSecSetting.GetSecurityDescriptor wmiSecurityDescriptor
DACL = wmiSecurityDescriptor.DACL
On Error GoTo 0
If VarType(DACL) <> 0 Then
For Each wmiAce In DACL
Set item = CreateObject("Scripting.Dictionary")
Set trustee = wmiAce.Trustee
sid = trustee.SIDString
domain = trustee.Domain
name = Trustee.Name
accessMask = wmiAce.AceType & " " & wmiAce.AccessMask
If list.Exists(sid) Then
Set item = list.Item(sid)
accessMask = item.Item("accessMask") & "," & accessMask
item.Item("accessMask") = accessMask
Else
item.Add "sid", sid
item.Add "domain", domain
item.Add "name", name
item.Add "accessMask", accessMask
item.Add "inherit", 0
list.Add sid, item
End If
Next
Else
currentStream.Position = currentStream.Size
currentStream.WriteText fullPath & vbNewLine
End If
Set wmiSecurityDescriptor = Nothing
Set wmiFileSecSetting = Nothing
Set GetFolderSecurityDescriptor = list
End Function
Function GetAccessFlags(accessMask)
Dim arr(14)
For i = 0 To 13
arr(i) = ""
Next
list = Split(accessMask, ",")
For i = 0 To UBound(list)
list2 = Split(list(i), " ")
aceType = Int(list2(0))
mask = Int(list2(1))
flag = GetAccessFlag(mask)
list2 = Split(flag, ",")
startIndex = 0
endIndex = 6
If aceType = 1 Then
startIndex = 7
endIndex = 13
End If
For j = startIndex To endIndex
value = ""
If aceType = 1 Then
value = list2(j - 7)
Else
value = list2(j)
End If
If arr(j) = "" And value <> "" Then arr(j) = value
Next
Next
GetAccessFlags = Join(arr, vbTab)
End Function
Function GetAccessFlag(accessMask)
FILE_READ_DATA = 1
FILE_LIST_DIRECTORY = 1
FILE_WRITE_DATA = 2
FILE_ADD_FILE = 2
FILE_APPEND_DATA = 4
FILE_ADD_SUBDIRECTORY = 4
FILE_READ_EA = 8
FILE_WRITE_EA = 16
FILE_EXECUTE = 32
FILE_TRAVERSE = 32
FILE_DELETE_CHILD = 64
FILE_READ_ATTRIBUTES = 128
FILE_WRITE_ATTRIBUTES = 256
DELETE = 65536
READ_CONTROL = 131072
WRITE_DAC = 262144
WRITE_OWNER = 524288
SYNCHRONIZE = 1048576
acRead = FILE_READ_DATA Or FILE_READ_ATTRIBUTES Or FILE_READ_EA Or READ_CONTROL Or SYNCHRONIZE
acWrite = FILE_WRITE_DATA Or FILE_APPEND_DATA Or FILE_WRITE_ATTRIBUTES Or FILE_WRITE_EA Or SYNCHRONIZE
acReadAndExecute = acRead Or FILE_EXECUTE
acList = acReadAndExecute
acModify = acReadAndExecute Or acWrite Or DELETE
acFullControl = acModify Or FILE_DELETE_CHILD Or WRITE_DAC Or WRITE_OWNER
Dim arr(7)
For i = 0 To 6
arr(i) = ""
Next
If (accessMask And acFullControl) = acFullControl Then arr(0) = "Y"
If (accessMask And acModify) = acModify Then arr(1) = "Y"
If (accessMask And acReadAndExecute) = acReadAndExecute Then arr(2) = "Y"
If (accessMask And acList) = acList Then arr(3) = "Y"
If (accessMask And acRead) = acRead Then arr(4) = "Y"
If (accessMask And acWrite) = acWrite Then arr(5) = "Y"
If arr(0) = "" And arr(1) = "" And arr(2) = "" And _
arr(3) = "" And arr(4) = "" And arr(5) = "" Then
arr(6) = "Y"
End If
GetAccessFlag = Join(arr, ",")
End Function
程序执行完后会放到将结果保存到 D:\security_result.txt 中，此时复制该文件中的文本，粘贴到Excel中即可。D:\forbidden_result.txt保存当前用户无法访问的目录列表。