Follow the next steps to run the script (no admin rights needed):

• find the distinguished names of the nested groups (adsiedit.msc)
• put them in an Excel sheet in the first column ans save the sheet as c:\temp\groups.xls
• open your favorite text editor
• copy and paste the script below into the editor (you can use the icons in the upper rights corner of the code)
• save the script (for example c:\temp\enumeratenestedgroupsfromexcelsheet.vbs)
• open a command prompt
• go to “c:\temp”
• give “cscript enumeratenestedgroupsfromexcelsheet.vbs” (without quotes) and enter

The script:

' Name : enumeratenestedgroupsfromexcelsheet.vbs
' Description : script to enumerate nested Active Directory groups from an Excel sheet
' Author : dirk adamsky - deludi bv
' Version : 1.0
' Date : 04-10-2011

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\groups.xls")
intRow = 2
Do Until objExcel.Cells(intRow,1).Value = ""
strGroupDN = objExcel.Cells(intRow, 1).Value
If strGroupDN <> "" Then
wscript.echo strGroupDN
EnumNestedgroup "LDAP://" & strGroupDN
End If
intRow = intRow + 1
Loop
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

Function EnumNestedgroup(strGroupDN)
Set objGroup = GetObject(strGroupDN)
For Each objMember in objGroup.Members
If (LCase(objMember.Class) = "group") Then
EnumNestedgroup objMember.AdsPath
Else
Wscript.Echo objGroup.cn & " ; " & objMember.DisplayName & " ; " & objMember.Mail
End If
Next
Set objGroup = Nothing
End Function

When you have a modified version or problems/questions that you want to share please post it at the comments below.

Happy scripting.

Dirk Adamsky

Dave asked me for a script to enumerate all AD users, their home directories and the size of them.
I already had the script to do that for roaming profiles.
This script is a modified version.

Follow the next steps to run the script (admin rights needed for access to the home directories):

* open your favorite text editor
* copy and paste the script into the editor
* save the script (for example c:\temp\homedirectorysize.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript homedirectorysize.vbs” (without quotes) and enter

The script:

' Name : homedirectorysize.vbs
' Description : script to enumerate the home directories and their sizes of all users in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 12-07-2011
' Level : intermediate

arrAttributes = Array("homeDirectory","displayname","mail") 

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
Set objRootDSE = Nothing

strFilter = "(&(objectCategory=person)(objectClass=user)(homeDirectory=*))"
strAttributes = Join(arrAttributes,",")
Wscript.Echo Join(arrAttributes,";") & " ; home directory size in MB"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
	On Error Resume Next
	strTempOutput = ""
	For i = 0 To Ubound(arrAttributes)
		strTempOutput =  strTempOutput & " ; " & adoRecordset.Fields(arrAttributes(i)).Value
		strOutput = Mid(Ltrim(strTempOutput),3)
	Next
	Wscript.Echo strOutput & " ; " & Foldersize (adoRecordset.Fields(arrAttributes(0)).Value) & " MB"
	adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
Set adoRecordset = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

Function Foldersize(strPath)
	On Error Resume Next
	Set objFSO = CreateObject("scripting.filesystemobject")
	Set objFld = objFSO.GetFolder(strPath)
	Foldersize = Round(objFld.Size/1048576,2)
	Set objFld = Nothing
	Set objFSO = Nothing
End Function

When you have problems/questions please post a reply. Also can alo give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

Windows XP – “c:\documents and settings”

Windows 7 – “c:\users”

The script has to do:

• get all Windows XP and Windows 7 clients from Active Directory
• check if they are online
• get the local profiles and their sizes from each machine
• write the values to a central logfile

Follow the next steps to run the script (local admin rights needed for access to the target pc’s):

* open your favorite text editor
* copy and paste the script into the editor
* change the logfile location in line 73 (now c:\temp)
* save the script (for example c:\temp\localprofiles.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript localprofiles.vbs” (without quotes) and enter

The script:

' Name : localprofiles.vbs
' Description : script to enumerate the local profile size of all computers and users in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 28-06-2011

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
strFilter = "(&(objectCategory=computer)(|(operatingSystem=Windows XP Professional)(operatingSystem=Windows 7*)))"
strAttributes = "name, operatingSystem"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
	strHostname = adoRecordset.Fields("name").Value
	If CheckStatus(strHostname) = True Then
		If Instr(adoRecordset.Fields("operatingSystem").Value, "XP") > 0 Then
			strLocalProfilePath = "\Documents and Settings\"
		ElseIf Instr(adoRecordset.Fields("operatingSystem").Value, "7") > 0 Then
			strLocalProfilePath = "\users\"
		End If
		GetLocalProfileSize strHostname, "\\" & strHostname & "\c$" & strLocalProfilePath
	End If
	adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

Function CheckStatus(strAddress)
	Dim objPing, objRetStatus
	Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      ("select * from Win32_PingStatus where address = '" & strAddress & "'")
	For Each objRetStatus In objPing
        If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
			CheckStatus = False
        Else
			CheckStatus = True
        End If
    Next
	Set objPing = Nothing
End Function

Function GetLocalProfileSize(strTargetMachine, strFolder)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFSO.GetFolder(strFolder)
	For Each SubFolder in objFolder.SubFolders
		Logprint strTargetMachine & " ; " & SubFolder.Name & " ; " & SubFolder.Path & " ; " & Round(SubFolder.Size/1048576,2) & " MB"
	Next
	Set objFolder = Nothing
	Set objFSO = Nothing
End Function

Function LogPrint(Message)
Const ForAppending = 8
strDate = Replace(Date,"/","-")
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = ObjFSO.OpenTextFile("c:\temp\" & strDate & "-localprofiles.csv", ForAppending, True)
    objTextFile.WriteLine Message
    objTextFile.Close
Set objTextFile = Nothing
Set ObjFSO = Nothing
End Function

When you have problems/questions please post a reply. Also can also give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

My first attempt was to use the VB Arraylist object (.Net needed on the script machine).
Here’s an Arraylist example by Rob van der Woude.
The problem with the Arraylist object is that it is not made for sorting multi dimensional arrays.
I can do some tricks by concatenating all values to a superstring.
The problem is that sorting an Arraylist with superstrings will be next to impossible.

Luckily I found a better solution by using a disconnected recordset
(= a recordset without database connection).
One thing to check is to use the right datatype for each variable.
I declared the “size” variable as a “double precision floating point”.
The other 2 were delared as “null-terminated character strings”.
With the disconnected recordset you can do a lot of funky stuff like sorting, filtering and so on.
I will certainly use the disconnected recordset object in new scripts.

I have tested the script in a large environment (~ 8500 mailboxes).
It worked flawless (okay I had to test and modify it for half an hour or so).

What the script does:

• get all exchange servers from your AD domain
• make a wmi connection to each server and create a list of the mailboxes and their size
• put all values in a disconnected recordset, sort and output to the screen

The script is tested in a win2003/exchange2003 environment.

Follow the next steps to run the script (admin rights needed):

• copy and paste the script in your favorite text editor
• save the script (for example c:tempsortedlistofallmailboxes.vbs)
• open a command prompt
• go to “c:temp”
• give “cscript sortedlistofallmailboxes.vbs” (without quotes) and enter

The script:

' Name : sortedlistofallmailboxes.vbs
' Description : script to enumerate all mailboxes and their size in your AD domain
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 17-05-2011
' Level: intermediate

Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "Servername", 200, 255
DataList.Fields.Append "DisplayName", 200, 255
DataList.Fields.Append "Size", 5
DataList.Open

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("configurationnamingcontext") & ">"
strFilter = "(objectCategory=msExchExchangeServer)"
strAttributes = "name"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 3
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
 Set objWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//"&_
 adoRecordset.Fields("name").Value & "/root/MicrosoftExchangeV2")
 Set colExchangeMailboxes = objWMIExchange.InstancesOf("Exchange_Mailbox")
 For Each objExchangeMailbox in colExchangeMailboxes
 If Left(objExchangeMailbox.StorageGroupName, 5) <> "Recov" Then
 DataList.AddNew
 DataList("Servername") = adoRecordset.Fields("name").Value
 DataList("DisplayName") = objExchangeMailbox.MailboxDisplayName
 DataList("Size") = Round(objExchangeMailbox.Size/1024,0)
 Datalist.Update
 End If
 Next
 Set colExchange_Mailboxes = Nothing
 Set objWMIExchange = Nothing
 adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

DataList.Sort = "Size DESC"
DataList.MoveFirst

Do Until DataList.EOF
 Wscript.Echo DataList.Fields.Item("Size") & " MB ; " & DataList.Fields.Item("DisplayName") & " ; " &_
 DataList.Fields.Item("Servername")
 DataList.MoveNext
Loop

Datalist.Close
Set DataList = Nothing

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

This script enumerates all user accounts in Active Directory en checks if the “Password Never Expires”
marker is set.
The check is no simple 1 or 0 but a bitwise comparison of the userAccountControl Value with
ADS_UF_DONT_EXPIRE_PASSWD (or &H10000 in vbs hex code).
userAccountControl Value for accounts with “Password Never Expires” not enabled -
Decimal: 512 <=> Binary: 1000000000.
ADS_UF_DONT_EXPIRE_PASSWD – Hexadecimal (vbs):  &H10000 <=>
Decimal: 65536 <=> Binary: 10000000000000000.

In the example above the binary comparison gives a zero as result, all non-zero results implicate that the value is enabled.

Follow the next steps to run the script (no admin rights needed):

* open your favorite text editor
* copy and paste the script into the editor
* save the script (for example c:\temp\PasswordNeverExpires.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript PasswordNeverExpires.vbs” (without quotes) and enter

The script:

' Name : PasswordNeverExpires.vbs
' Description : script to enumerate all accounts with Password Never Expires enabled in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 11-05-2011
' Level: Intermediate

Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "cn,mail,distinguishedName"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
	On Error Resume Next
	Set objUser = GetObject("LDAP://" & adoRecordset.Fields("distinguishedName").Value)
	If (objUser.userAccountControl And ADS_UF_DONT_EXPIRE_PASSWD) <> 0 Then
		Wscript.echo adoRecordset.Fields("cn").Value & " ; " & adoRecordset.Fields("mail").Value
	End If
	Set objUser = Nothing
    adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

What the script does:

• create an array with all server you want to check (replace srv001, etc with your server names)
• create a variable with a date of 2 weeks ago (Date -14)(can easily be changed in 30, 60 days ago)
• change the variable date to the UTC date of 14 days ago (because WMI works with UTC dates)
• for each server in the array
• make a wmi connection
• query for files with specific extensions and a creation date older than 14 days ago
• in this example i took .txt and .csv extensions, change them in whatever filetype you want

The script is tested in an win2003 environment.

Follow the next steps to run the script (admin rights needed):

• copy and paste the script in your favorite text editor
• replace the strings ‘srv001′ and ‘srv002′ with the name of your exchange server
• replace the extensions ‘txt’ and ‘csv with the extensions you need
• save the script (for example c:tempfindoldfileswithspecificextensions.vbs)(or something shorter..)
• open a command prompt
• go to “c:temp”
• give “cscript findoldfileswithspecificextensions.vbs” (without quotes) and enter

When you want the output in a file please give this command:

“cscript findoldfileswithspecificextensions.vbs > findoldfileswithspecificextensions.txt” (again without the quotes)

The script:

' Name : findoldfileswithspecificextensions.vbs
' Description : VBscript to find files with specific extensions and creation date on remote servers
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 21-03-2011
' Level: intermediate

arrServers = Array("srv001","srv002")
strDate = Date - 14
Set objDateToUtcDate = CreateObject("WbemScripting.SWbemDateTime")
objDateToUtcDate.SetVarDate(strDate)

For Each Server in arrServers
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\" & Server & "rootcimv2")
	Set colFiles = objWMIService.ExecQuery("Select * from CIM_DataFile where (Extension = 'txt' or Extension = 'csv') and CreationDate < '" & objDateToUtcDate & "'")
	For Each objFile in colFiles
		Wscript.Echo objFile.Name
	Next
	Set colFiles = Nothing
	Set objWMIService = Nothing
Next
Set objDateToUtcDate = Nothing

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

Last week I had to do some work on Active Directory contacts.
For a starter I made a script that enumerates all contacts in Active Directory.
Be careful: this script does not include your local contact (they are a part of your mailbox).
The script is straight ahead: ADO query, filter on ‘objectclass=contacts’ and off you go.

Follow the next steps to run the script (no admin rights needed):

* open your favorite text editor
* copy and paste the script into the editor
* save the script (for example c:tempenumeratecontacts.vbs)
* open a command prompt
* go to “c:temp”
* give “cscript enumeratecontacts.vbs” (without quotes) and enter

The script:

' Name : enumeratecontacts.vbs
' Description : script to enumerate all contacts in your domain
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 14-01-2011
' Level: beginner

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(objectClass=contact)"
strAttributes = "displayname, mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
 Wscript.echo adoRecordset.Fields("displayname").Value & " ; " & adoRecordset.Fields("mail").Value
 adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoConnection = Nothing
Set adoCommand = Nothing

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

Follow the next steps to run the script (no admin rights needed):

* find the distinguished name of the nested group (adsiedit.msc)
* open your favorite text editor
* copy and paste the script into the editor
* change the distinguished name
* save the script (for example c:\temp\enumeratesendtorights.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript enumeratesendtorights.vbs” (without quotes) and enter

The script:

' Name : enumeratesendtorights.vbs
' Description : script to enumerate the message restrictions (send to rights) of a distributionlist
' Author : dirk adamsky - deludi bv
' Version : 3.00 added Distinguished Name input option based on input from Pol (see comments on previous script), removed the smtp input option
' Date : 16-11-2010
' Level: advanced

strObject = InputBox("Please enter the Distinguished Name")
Set objSource = GetObject("LDAP://" & strObject)
If TypeName(objSource.authOrig) = "String" Then
	GetSendToRights ("LDAP://" & objSource.authOrig)
Else
	For Each User In objSource.authOrig
		GetSendToRights ("LDAP://" & User)
	Next
End If
If TypeName(objSource.dLMemSubmitPerms) = "String" Then
	EnumNestedgroup objSource.dLMemSubmitPerms
Else
	For Each Group in objSource.dLMemSubmitPerms
		EnumNestedgroup Group
	Next
End If
Set objSource = Nothing

Function GetSendToRights(strUserDN)
	On Error Resume Next
	Set objAccount = GetObject(strUserDN)
	Wscript.Echo objAccount.Mail & " ; " & objAccount.DisplayName & " ; direct send to rights"
	Set objSecurityDescriptor = objAccount.Get("ntSecurityDescriptor")
	Set objDacl = objSecurityDescriptor.DiscretionaryAcl
	Set objAce = CreateObject("AccessControlEntry")
	For Each objAce In objDacl
		If objAce.ObjectType = "{AB721A54-1E2F-11D0-9819-00AA0040529B}" Then
			If (Left(objAce.Trustee,3) <> "S-1" And objAce.Trustee <> "NT AUTHORITYSELF") Then
				GetUserDetails Mid(objAce.Trustee,9)
			End If
		End If
	Next
End Function

Function GetUserDetails(strPreW2K)
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

	' Search entire Active Directory domain.
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	strBase = "<LDAP://" & strDNSDomain & ">"

	' Filter on user objects.
	strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" &  strPreW2K & "))"

	' Comma delimited list of attribute values to retrieve.
	strAttributes = "mail, displayname"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute
	Wscript.Echo adoRecordset.Fields("mail").Value & " ; " & adoRecordset.Fields("displayname").Value & " ; indirect send to rights"
	' Clean up.
	adoRecordset.Close
	adoConnection.Close

	Set adoRecordset = Nothing
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
End Function

Sub EnumNestedgroup(strGroupDN)
	Set objGroup = GetObject("LDAP://" & strGroupDN)
	For Each objMember in objGroup.Members
		If (LCase(objMember.Class) = "group") Then
			Call EnumNestedgroup(objMember.AdsPath)
		Else
			GetSendToRights objMember.AdsPath
		End If
	Next
	Set objGroup = Nothing
End Sub

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

Follow the next steps to run the script (admin rights needed for the WMI connection):

• copy and paste the script in your favorite text editor
• save the script (for example c:\temp\uncacl2.vbs)
• open a command prompt
• go to “c:\temp”
• give “cscript uncacl2.vbs” (without quotes) and enter

The script:

' Name : uncacl2.vbs
' Description : script to enumerate the ntfs rights of a given UNC path and a given level of subfolders
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 22-10-2010

strUNCPathName = InputBox("please supply the UNC path to the shared folder")
strSubfolderLevel = InputBox("please supply the subfolder depth (1,2,etc.)")
arrUNC = split(strUNCPathName,"\")
If Ubound(arrUNC) > 3 Then
strRightPartOfPath = Mid(strUNCPathName,(Instr(strUNCPathName,arrUNC(4)) -1))
End If
Set objWMI = GetObject("winmgmts:\\" & arrUNC(2) & "\root\CIMV2")
Set objFileShare = objWMI.Get("Win32_Share.Name=""" & arrUNC(3) & """")
If Right(arrUNC(3),1) = "$" And Len(arrUNC(3)) = 2 Then
strPath = objFileShare.Path & Mid(strRightPartOfPath,2)
Else
strPath = objFileShare.Path & strRightPartOfPath
End If
ShowACL strPath
ViewSubFolders strPath, strSubfolderLevel
Set objFileShare = Nothing
Set objWMI = Nothing

Function ViewSubfolders(strFolder, strMaxlevel)
Set colSubfolders = objWMI.ExecQuery("Associators Of {Win32_Directory.Name='" & strFolder & "'} " &_
"Where AssocClass = Win32_Subdirectory ResultRole = PartComponent")
If strMaxlevel >= 1 Then
    For Each SubFolder in colSubfolders
        wscript.echo SubFolder.Name
        ShowACL SubFolder.Name
        ViewSubFolders SubFolder.Name, (strMaxlevel - 1)
    Next
End If
Set colSubfolders = Nothing
End Function

Function ShowACL(strDir)
Set objFolderSecuritySettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
objFolderSecuritySettings.GetSecurityDescriptor objSD
For Each objAce in objSD.DACL
    Select Case objAce.AccessMask
        Case 1179817
            strRights = "read-only"
        Case 2032127
            strRights = "full-control"
        Case 1245631
            strRights = "change"
    End Select
Wscript.Echo strUNCPathName & " ; " & strDir & " ; " & objAce.Trustee.Domain & " ; " & objAce.Trustee.Name & " ; " & strRights
Next
Set objSD = Nothing
Set objFolderSecuritySettings = Nothing
End Function

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

• ask for a UNC path
• split the UNC path and put the substrings in an array
• make a wmi connection to the target server
• find the absolut path of the share
• enumerate the acl’s
• close the used objects

Follow the next steps to run the script (admin rights needed for the WMI connection):

• copy and paste the script in your favorite text editor
• save the script (for example c:tempuncacl.vbs)
• open a command prompt
• go to “c:temp”
• give “cscript uncacl.vbs” (without quotes) and enter

The script:

' Name : uncacl.vbs
' Description : script to enumerate the ntfs rights of a given UNC path
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 20-10-2010

strUNCPathName = InputBox("please supply the UNC path to the shared folder")
arrUNC = split(strUNCPathName,"")
If Ubound(arrUNC) > 3 Then
	strRightPartOfPath = Mid(strUNCPathName,(Instr(strUNCPathName,arrUNC(4)) -1))
End If
Set objWMI = GetObject("winmgmts:\" & arrUNC(2) & "rootCIMV2")
Set objFileShare = objWMI.Get("Win32_Share.Name=""" & arrUNC(3) & """")
If Right(arrUNC(3),1) = "$" And Len(arrUNC(3)) = 2 Then
	strPath = objFileShare.Path & Mid(strRightPartOfPath,2)
Else
	strPath = objFileShare.Path & strRightPartOfPath
End If
Set objFolderSecuritySettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'")
objFolderSecuritySettings.GetSecurityDescriptor objSD
For Each objAce in objSD.DACL
	Select Case objAce.AccessMask
		Case 1179817
			strRights = "read-only"
		Case 2032127
			strRights = "full-control"
		Case 1245631
			strRights = "change"
	End Select
	Wscript.Echo strUNCPathName & " ; " & strPath & " ; " & objAce.Trustee.Domain & " ; " & objAce.Trustee.Name & " ; " & strRights
Next
Set objSD = Nothing
Set objFolderSecuritySettings = Nothing
Set objFileShare = Nothing
Set objWMI = Nothing

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

[adrotate group="3"]