Script to validate and Provide the access on a Shared Folder

Hello Experts,

I have a HTA script which is basically a free one from PrimalScript and I like the way it is designed.. I want to use the same HTA script to provide the access to the users on Shared Folders. Basically in my idea, it should look like attached picture and below are the details.

when a user is requesting access on a shared folder, I copy the UNC path of shared folder to the box and click on Report...
it will retrieve the details from Security tab and will in a screen or pop-up window.. then I will find out the right group where user has to be added and when I select the group from that list, it should validate whether this user is already member of that group or not and if not, it should give an option to add the user to that particular group.. once added, a confirmation message stating the job is completed successfully.
DiskReporter.Rename2hta.xls
2015-10-07_22-36-22.png
LVL 1
Affaan AbyazAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
Hi, I should be able to help with this, although ACLs are not VBScript's strong point, but I'm pretty sure it can be done.

Do you currently have any code that can enumerate the current security structure on a folder?  There may be some on here from myself or Chris Dent, but I can't remember whether we have any handy.

Rob.
0
Affaan AbyazAuthor Commented:
Thanks Rob for your response.. I really appreicate your help and I found this when I google for a VBScript to enumerate security structure of a folder: https://gallery.technet.microsoft.com/scriptcenter/List-Security-of-Folder-8f0487a9

if you think this can be achieved through a PowerShell coding in a HTA template, I am fine with that too.. I have found one of HTA script prepared by you which seems pretty close to our requirement..what I meant to say is the overall look would be like this.

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24279527.html

Regards,
Aamer
0
Affaan AbyazAuthor Commented:
@Rob - I have sent you a private message.. Could you please check and help me on this.. Thanks in advance.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

RobSampsonCommented:
Hi,

Sorry for my late reply.  I'm very busy at work, so finding it difficult to get time to look at this.  I hope to have time at some stage this week to check it out for you.

Rob.
0
Affaan AbyazAuthor Commented:
Thanks Rob.. I'll be waiting. 😊
0
RobSampsonCommented:
Hi, I have taken bits of the script you pointed to TechNet gallery and put it into a HTA.  This so far will only display the security on a *local* folder.  Try it out and see what you think, and we can expand from there.

I still need to work in how to add a specific user to a group, but don't have time right now.

Regards,

Rob.

<Html>
<Head>
<Title>Display Folder Security</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath, boolDCHardCodedDC, boolHardCodedUser, strSpecificDC, strTableHTML
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = strCurrentDomain
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
		boolDCHardCodedDC = False
		strSpecificDC = "mymaindc.domain.com"
		If boolDCHardCodedDC = False Then
			Load_Domain_Controller_List
		Else
			lst_domaincontrollers.Style.Visibility = "Hidden"
			span_domaincontroller.InnerHTML = strSpecificDC
		End If
 	End Sub
 
	Sub Load_Domain_Controller_List
		' Use ADO to search Active Directory for ObjectClass nTDSDSA.
		' This will identify all Domain Controllers.
		Set objRootDSE = GetObject("LDAP://RootDSE")
		strConfig = objRootDSE.Get("configurationNamingContext")
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Open "Active Directory Provider"
		adoCommand.ActiveConnection = adoConnection
		
		strBase = "<LDAP://" & strConfig & ">"
		strFilter = "(objectClass=nTDSDSA)"
		strAttributes = "AdsPath"
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 60
		adoCommand.Properties("Cache Results") = False
		
		Set adoRecordset = adoCommand.Execute
		
		' Enumerate parent objects of class nTDSDSA. Save Domain Controller
		' AdsPaths in dynamic array arrstrDCs.
		
		Dim strDetails
		
		Do Until adoRecordset.EOF
		    Set objDC = GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
			Set objActiveOption = Document.CreateElement("OPTION")
			objActiveOption.Text = objDC.DNSHostName
		    objActiveOption.Value = objDC.DNSHostName
		    lst_domaincontrollers.Add objActiveOption
		    adoRecordset.MoveNext
		Loop
		adoRecordset.Close
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_196.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,distinguishedName")
		If strDisplayName = "" Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_userdn.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_userdn.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub HTASleep(intSeconds)
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
	End Sub
 
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
	
	Sub Get_Permissions
		On Error Resume Next
		If txt_folderpath.Value <> "" Then
			strTargetPath = txt_folderpath.Value
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			'span_permissions.innerHTML = """Date"",""Time"",""Folder"",""Group / User Name"",""Commom Permission's"",""Special Permission's"",""Access Type"",""Inheritance"",""Error's"""
			strTableHTML = "<table border='1'>"
			'strTableHTML = strTableHTML & "<tr><th>Date</th><th>Time</th><th>Folder</th><th>Group / User Name</th><th>Commom Permission's</th><th>Special Permission's</th><th>Access Type</th><th>Inheritance</th><th>Error's</th></tr>"
			strTableHTML = strTableHTML & "<tr><th>Group / User Name</th><th>Commom Permission's</th><th>Access Type</th><th>Inheritance</th><th>Errors</th></tr>"
			ShowSubACL objFSO.GetFolder(strTargetPath)
			strTableHTML = strTableHTML & "</table>"
			span_permissions.innerHTML = strTableHTML
			'ShowSubfolders objFSO.GetFolder(strTargetPath)
		Else
			MsgBox "Please enter a folder path."
		End If 
	End Sub

	Sub ShowSubACL(FolderPerm)
		Const ForWriting = 2
		Const ForAppending = 8
		'Commom Permissions
		Const FOLDER_FULL_CONTROL = 2032127
		Const FOLDER_MODIFY = 1245631
		Const FOLDER_READ_ONLY = 1179785
		Const FOLDER_READ_CONTENT_EXECUTE =  1179817 
		Const FOLDER_READ_CONTENT_EXECUTE_WRITE =  1180095 
		Const FOLDER_WRITE = 1179926
		Const FOLDER_READ_WRITE = 1180063 
		'Special Permissions
		Const FOLDER_LIST_DIRECTORY = 1
		Const FOLDER_ADD_FILE = 2
		Const FOLDER_ADD_SUBDIRECTORY = 4
		Const FOLDER_READ_EA = 8
		Const FOLDER_WRITE_EA = 16
		Const FOLDER_EXECUTE = 32
		Const FOLDER_DELETE_CHILD = 64
		Const FOLDER_READ_ATTRIBUTES = 128
		Const FOLDER_WRITE_ATTRIBUTES = 256
		Const FOLDER_DELETE = 65536
		Const FOLDER_READ_CONTROL = 131072
		Const FOLDER_WRITE_DAC = 262144
		Const FOLDER_WRITE_OWNER = 524288
		Const FOLDER_SYNCHRONIZE = 1048576
		'INHERIT
		'Const FOLDER_OBJECT_INHERIT_ACE = 1
		'Const FOLDER_CONTAINER_INHERIT_ACE = 2
		'Const FOLDER_NO_PROPAGATE_INHERIT_ACE = 4
		'Const FOLDER_INHERIT_ONLY_ACE = 8
		Const FOLDER_INHERITED_ACE = 16
		'ACL Control
		Const SE_DACL_PRESENT = 4
		Const ACCESS_ALLOWED_ACE_TYPE = 0
		Const ACCESS_DENIED_ACE_TYPE  = 1
		
		On Error Resume Next
		strCPerm = ""
		strSPerm = ""
		strTypePerm = "" 
		strInherit = ""
		strErros = ""
		Set objWMIService = GetObject("winmgmts:")
		Set objFolderSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & FolderPerm & "'")
		intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
		intControlFlags = objSD.ControlFlags
		If intControlFlags AND SE_DACL_PRESENT Then
			arrACEs = objSD.DACL
			If Err.Number = 0 Then
				strErros = "&nbsp;"
			Else
				strErros = "Cod.: " & Err.Number & " Desc.: " & Err.description
				'strTableHTML = strTableHTML & """" & Date() & """,""" & Time() & """,""" & FolderPerm  & """,""" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & "" & """,""" & strErros & """"
				strTableHTML = strTableHTML & """" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & strErros & """"
				Err.clear
			End If
			For Each objACE in arrACEs
			'ACL Type
			If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then strTypePerm = "Allowed"
			If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then strTypePerm = "Denied"
			
			'Inherit
			If objAce.AceFlags AND FOLDER_INHERITED_ACE Then
				strInherit = "Yes"
			Else
				strInherit = "No"
			End if
			
			'Commom Permissions
			If objACE.AccessMask = FOLDER_FULL_CONTROL Then 
				strCPerm = "Full Control"
			ElseIf objACE.AccessMask = FOLDER_MODIFY Then 
				strCPerm = "Modify"
			ElseIf objACE.AccessMask = FOLDER_READ_CONTENT_EXECUTE_WRITE Then
				strCPerm = "Read & Execute / List Folder Contents (folders only) + Write"
			ElseIf objACE.AccessMask = FOLDER_READ_CONTENT_EXECUTE Then 
				strCPerm = "Read & Execute / List Folder Contents (folders only)"
			ElseIf objACE.AccessMask = FOLDER_READ_WRITE Then
				strCPerm = "Read + Write"
			ElseIf objACE.AccessMask = FOLDER_READ_ONLY Then 
				strCPerm = "Read Only"
			ElseIf objACE.AccessMask = FOLDER_WRITE Then 
				strCPerm = "Write"
			Else
				strCPerm = "Special"
			End If
			
			'Special Permissions
			strSPerm = ""
			If objACE.AccessMask and FOLDER_EXECUTE Then strSPerm = strSPerm & "Traverse Folder/Execute File, "
			If objACE.AccessMask and FOLDER_LIST_DIRECTORY Then strSPerm = strSPerm & "List Folder/Read Data, "
			If objACE.AccessMask and FOLDER_READ_ATTRIBUTES Then strSPerm = strSPerm & "Read Attributes, "
			If objACE.AccessMask and FOLDER_READ_EA Then strSPerm = strSPerm & "Read Extended Attributes, "
			If objACE.AccessMask and FOLDER_ADD_FILE Then strSPerm = strSPerm & "Create Files/Write Data, "
			If objACE.AccessMask and FOLDER_ADD_SUBDIRECTORY Then strSPerm = strSPerm & "Create Folders/Append Data"
			If objACE.AccessMask and FOLDER_WRITE_ATTRIBUTES Then strSPerm = strSPerm & "Write Attributes, "
			If objACE.AccessMask and FOLDER_WRITE_EA Then strSPerm = strSPerm & "Write Extended Attributes, "
			If objACE.AccessMask and FOLDER_DELETE_CHILD Then strSPerm = strSPerm & "Delete Subfolders and Files, "
			If objACE.AccessMask and FOLDER_DELETE Then strSPerm = strSPerm & "Delete, "
			If objACE.AccessMask and FOLDER_READ_CONTROL Then strSPerm = strSPerm & "Read Permissions, "
			If objACE.AccessMask and FOLDER_WRITE_DAC Then strSPerm = strSPerm & "Change Permissions, "
			If objACE.AccessMask and FOLDER_WRITE_OWNER Then strSPerm = strSPerm & "Take Ownership, "
			If objACE.AccessMask and FOLDER_SYNCHRONIZE Then strSPerm = strSPerm & "Synchronize, "
			If trim(strSPerm) <> "" then strSPerm =  left(strSPerm, len(strSPerm)-2)
			
			'If UCase(strdrop) = chk_skipinheritance and objAce.AceFlags AND FOLDER_INHERITED_ACE Then
			'	Wscript.echo "Droped ACL Inheritance " & FolderPerm    
			'Else 
			'Wscript.echo "Get ACL on Path: " & FolderPerm
			'""Date"",""Time"",""Folder"",""Group / User Name"",""Commom Permission's"",""Special Permission's"",""Access Type"",""Inherit"",""Error's""
				'span_permissions.innerHTML = span_permissions.innerHTML & "<BR>" & """" & Date() & """,""" & Time() & """,""" & FolderPerm & """,""" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & """,""" & strCPerm & """,""" & strSPerm & """,""" & strTypePerm  & """,""" & strInherit & """,""" & strErros & """"
				'strTableHTML = strTableHTML & "<tr><td>" & Date() & "</td><td>" & Time() & "</td><td>" & FolderPerm & "</td><td>" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & "</td><td>" & strCPerm & "</td><td>" & strSPerm & "</td><td>" & strTypePerm  & "</td><td>" & strInherit & "</td><td>" & strErros & "</td></tr>"
				strTableHTML = strTableHTML & "<tr><td>" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & "</td><td>" & strCPerm & "</td><td>" & strTypePerm  & "</td><td>" & strInherit & "</td><td>" & strErros & "</td></tr>"
			'wscript.echo objACE.Trustee.Name & " " & objACE.AceFlags
			'End If
		Next
	End If
End Sub

</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Display Folder Security</h2>
			</td>
		</tr>
		<tr>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				<fieldset style="padding:10 10 10 10;">
				<legend style="color:darkblue;font-weight:bold;">Alternate Credentials (Optional)</legend>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				</fieldset>
				<br>
			</td>
		</tr>
		<tr>
			<td>
				Folder path: <input type="text" id="txt_folderpath" name="txt_folderpath" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_getperms" id="btn_getperms" accessKey="g" onclick="vbs:Get_Permissions"><u>G</u>et Permissions</button><br><br>
				<span id="span_permissions">
				</span><br>
			</td>
		</tr>
		<tr>
			<td>
				Domain controller to change group membership on:&nbsp;<span id="span_domaincontroller"></span><select size='1' name='lst_domaincontrollers'></select>
			</td>
		</tr>
		<tr>
			<td align="center">
				<br><br>
				<button name="btn_adduser" id="btn_adduser" onclick="vbs:Add_User_To_Group">Add User to Group</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_userdn"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Affaan AbyazAuthor Commented:
as always Rob Rocks :-)
0
RobSampsonCommented:
Thanks for the grade Affaan, did you need this HTA to display the security on a remote folder?  I should be able to do that at least.  Or are you happy with your current solutions?

Rob.
0
Affaan AbyazAuthor Commented:
Hi Rob,

Yeah. It would be great if you could update the script to allow UNC PATH retrieval of security permissions..

Regards
Affaan
0
RobSampsonCommented:
Sure, this should now work on UNC paths as well.

Regards,

Rob.

<Html>
<Head>
<Title>Display Folder Security</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath, boolDCHardCodedDC, boolHardCodedUser, strSpecificDC, strTableHTML
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = strCurrentDomain
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
		boolDCHardCodedDC = False
		strSpecificDC = "mymaindc.domain.com"
		If boolDCHardCodedDC = False Then
			Load_Domain_Controller_List
		Else
			lst_domaincontrollers.Style.Visibility = "Hidden"
			span_domaincontroller.InnerHTML = strSpecificDC
		End If
 	End Sub
 
	Sub Load_Domain_Controller_List
		' Use ADO to search Active Directory for ObjectClass nTDSDSA.
		' This will identify all Domain Controllers.
		Set objRootDSE = GetObject("LDAP://RootDSE")
		strConfig = objRootDSE.Get("configurationNamingContext")
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Open "Active Directory Provider"
		adoCommand.ActiveConnection = adoConnection
		
		strBase = "<LDAP://" & strConfig & ">"
		strFilter = "(objectClass=nTDSDSA)"
		strAttributes = "AdsPath"
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 60
		adoCommand.Properties("Cache Results") = False
		
		Set adoRecordset = adoCommand.Execute
		
		' Enumerate parent objects of class nTDSDSA. Save Domain Controller
		' AdsPaths in dynamic array arrstrDCs.
		
		Dim strDetails
		
		Do Until adoRecordset.EOF
		    Set objDC = GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
			Set objActiveOption = Document.CreateElement("OPTION")
			objActiveOption.Text = objDC.DNSHostName
		    objActiveOption.Value = objDC.DNSHostName
		    lst_domaincontrollers.Add objActiveOption
		    adoRecordset.MoveNext
		Loop
		adoRecordset.Close
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_196.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,distinguishedName")
		If strDisplayName = "" Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_userdn.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_userdn.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub HTASleep(intSeconds)
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
	End Sub
 
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
	
	Sub Get_Permissions
		On Error Resume Next
		If txt_folderpath.Value <> "" Then
			strTargetPath = txt_folderpath.Value
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			'span_permissions.innerHTML = """Date"",""Time"",""Folder"",""Group / User Name"",""Commom Permission's"",""Special Permission's"",""Access Type"",""Inheritance"",""Error's"""
			strTableHTML = "<table border='1'>"
			'strTableHTML = strTableHTML & "<tr><th>Date</th><th>Time</th><th>Folder</th><th>Group / User Name</th><th>Commom Permission's</th><th>Special Permission's</th><th>Access Type</th><th>Inheritance</th><th>Error's</th></tr>"
			strTableHTML = strTableHTML & "<tr><th>Group / User Name</th><th>Commom Permission's</th><th>Access Type</th><th>Inheritance</th><th>Errors</th></tr>"
			ShowSubACL objFSO.GetFolder(strTargetPath)
			strTableHTML = strTableHTML & "</table>"
			span_permissions.innerHTML = strTableHTML
			'ShowSubfolders objFSO.GetFolder(strTargetPath)
		Else
			MsgBox "Please enter a folder path."
		End If 
	End Sub

	Sub ShowSubACL(FolderPerm)
		Const ForWriting = 2
		Const ForAppending = 8
		'Commom Permissions
		Const FOLDER_FULL_CONTROL = 2032127
		Const FOLDER_MODIFY = 1245631
		Const FOLDER_READ_ONLY = 1179785
		Const FOLDER_READ_CONTENT_EXECUTE =  1179817 
		Const FOLDER_READ_CONTENT_EXECUTE_WRITE =  1180095 
		Const FOLDER_WRITE = 1179926
		Const FOLDER_READ_WRITE = 1180063 
		'Special Permissions
		Const FOLDER_LIST_DIRECTORY = 1
		Const FOLDER_ADD_FILE = 2
		Const FOLDER_ADD_SUBDIRECTORY = 4
		Const FOLDER_READ_EA = 8
		Const FOLDER_WRITE_EA = 16
		Const FOLDER_EXECUTE = 32
		Const FOLDER_DELETE_CHILD = 64
		Const FOLDER_READ_ATTRIBUTES = 128
		Const FOLDER_WRITE_ATTRIBUTES = 256
		Const FOLDER_DELETE = 65536
		Const FOLDER_READ_CONTROL = 131072
		Const FOLDER_WRITE_DAC = 262144
		Const FOLDER_WRITE_OWNER = 524288
		Const FOLDER_SYNCHRONIZE = 1048576
		'INHERIT
		'Const FOLDER_OBJECT_INHERIT_ACE = 1
		'Const FOLDER_CONTAINER_INHERIT_ACE = 2
		'Const FOLDER_NO_PROPAGATE_INHERIT_ACE = 4
		'Const FOLDER_INHERIT_ONLY_ACE = 8
		Const FOLDER_INHERITED_ACE = 16
		'ACL Control
		Const SE_DACL_PRESENT = 4
		Const ACCESS_ALLOWED_ACE_TYPE = 0
		Const ACCESS_DENIED_ACE_TYPE  = 1
		
		On Error Resume Next
		strCPerm = ""
		strSPerm = ""
		strTypePerm = "" 
		strInherit = ""
		strErros = ""
		Set objNetwork = CreateObject("WScript.Network")
		If Left(txt_folderpath.value, 2) = "\\" Then
			strComputer = Left(Mid(txt_folderpath.value, 3), InStr(Mid(txt_folderpath.value, 3), "\") - 1)
		Else
			strComputer = "."
		End If
		If strComputer <> "." Then
			FolderPerm = GetSharePath(strComputer, FolderPerm)
			If FolderPerm = "" Then
				MsgBox "Shared folder " & FolderPerm & " was not found on " & strComputer
				Exit Sub
			End If
		End If
		'MsgBox strComputer & vbCrLf & "Physical folder: " & FolderPerm
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
		Set objFolderSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & FolderPerm & "'")
		intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
		intControlFlags = objSD.ControlFlags
		If intControlFlags AND SE_DACL_PRESENT Then
			arrACEs = objSD.DACL
			If Err.Number = 0 Then
				strErros = "&nbsp;"
			Else
				strErros = "Cod.: " & Err.Number & " Desc.: " & Err.description
				'strTableHTML = strTableHTML & """" & Date() & """,""" & Time() & """,""" & FolderPerm  & """,""" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & "" & """,""" & strErros & """"
				strTableHTML = strTableHTML & """" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & strErros & """"
				Err.clear
			End If
			For Each objACE in arrACEs
			'ACL Type
			If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then strTypePerm = "Allowed"
			If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then strTypePerm = "Denied"
			
			'Inherit
			If objAce.AceFlags AND FOLDER_INHERITED_ACE Then
				strInherit = "Yes"
			Else
				strInherit = "No"
			End if
			
			'Commom Permissions
			If objACE.AccessMask = FOLDER_FULL_CONTROL Then 
				strCPerm = "Full Control"
			ElseIf objACE.AccessMask = FOLDER_MODIFY Then 
				strCPerm = "Modify"
			ElseIf objACE.AccessMask = FOLDER_READ_CONTENT_EXECUTE_WRITE Then
				strCPerm = "Read & Execute / List Folder Contents (folders only) + Write"
			ElseIf objACE.AccessMask = FOLDER_READ_CONTENT_EXECUTE Then 
				strCPerm = "Read & Execute / List Folder Contents (folders only)"
			ElseIf objACE.AccessMask = FOLDER_READ_WRITE Then
				strCPerm = "Read + Write"
			ElseIf objACE.AccessMask = FOLDER_READ_ONLY Then 
				strCPerm = "Read Only"
			ElseIf objACE.AccessMask = FOLDER_WRITE Then 
				strCPerm = "Write"
			Else
				strCPerm = "Special"
			End If
			
			'Special Permissions
			strSPerm = ""
			If objACE.AccessMask and FOLDER_EXECUTE Then strSPerm = strSPerm & "Traverse Folder/Execute File, "
			If objACE.AccessMask and FOLDER_LIST_DIRECTORY Then strSPerm = strSPerm & "List Folder/Read Data, "
			If objACE.AccessMask and FOLDER_READ_ATTRIBUTES Then strSPerm = strSPerm & "Read Attributes, "
			If objACE.AccessMask and FOLDER_READ_EA Then strSPerm = strSPerm & "Read Extended Attributes, "
			If objACE.AccessMask and FOLDER_ADD_FILE Then strSPerm = strSPerm & "Create Files/Write Data, "
			If objACE.AccessMask and FOLDER_ADD_SUBDIRECTORY Then strSPerm = strSPerm & "Create Folders/Append Data"
			If objACE.AccessMask and FOLDER_WRITE_ATTRIBUTES Then strSPerm = strSPerm & "Write Attributes, "
			If objACE.AccessMask and FOLDER_WRITE_EA Then strSPerm = strSPerm & "Write Extended Attributes, "
			If objACE.AccessMask and FOLDER_DELETE_CHILD Then strSPerm = strSPerm & "Delete Subfolders and Files, "
			If objACE.AccessMask and FOLDER_DELETE Then strSPerm = strSPerm & "Delete, "
			If objACE.AccessMask and FOLDER_READ_CONTROL Then strSPerm = strSPerm & "Read Permissions, "
			If objACE.AccessMask and FOLDER_WRITE_DAC Then strSPerm = strSPerm & "Change Permissions, "
			If objACE.AccessMask and FOLDER_WRITE_OWNER Then strSPerm = strSPerm & "Take Ownership, "
			If objACE.AccessMask and FOLDER_SYNCHRONIZE Then strSPerm = strSPerm & "Synchronize, "
			If trim(strSPerm) <> "" then strSPerm =  left(strSPerm, len(strSPerm)-2)
			
			'If UCase(strdrop) = chk_skipinheritance and objAce.AceFlags AND FOLDER_INHERITED_ACE Then
			'	Wscript.echo "Droped ACL Inheritance " & FolderPerm    
			'Else 
			'Wscript.echo "Get ACL on Path: " & FolderPerm
			'""Date"",""Time"",""Folder"",""Group / User Name"",""Commom Permission's"",""Special Permission's"",""Access Type"",""Inherit"",""Error's""
				'span_permissions.innerHTML = span_permissions.innerHTML & "<BR>" & """" & Date() & """,""" & Time() & """,""" & FolderPerm & """,""" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & """,""" & strCPerm & """,""" & strSPerm & """,""" & strTypePerm  & """,""" & strInherit & """,""" & strErros & """"
				'strTableHTML = strTableHTML & "<tr><td>" & Date() & "</td><td>" & Time() & "</td><td>" & FolderPerm & "</td><td>" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & "</td><td>" & strCPerm & "</td><td>" & strSPerm & "</td><td>" & strTypePerm  & "</td><td>" & strInherit & "</td><td>" & strErros & "</td></tr>"
				strTableHTML = strTableHTML & "<tr><td>" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & "</td><td>" & strCPerm & "</td><td>" & strTypePerm  & "</td><td>" & strInherit & "</td><td>" & strErros & "</td></tr>"
			'wscript.echo objACE.Trustee.Name & " " & objACE.AceFlags
			'End If
		Next
	End If
End Sub

Function GetSharePath(strComputer, strFolderName)
	If Right(strFolderName, 1) = "\" Then strFolderName = Left(strFolderName, Len(strFolderName) - 1)
	arrFolderParts = Split(strFolderName, "\")
	Dim strReturn
	strReturn = ""
	For intFolder = UBound(arrFolderParts) To 3 Step -1
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
		Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Share WHERE Name='" & arrFolderParts(intFolder) & "'")
		For Each objItem In colItems
			strReturn = objItem.Path
			'MsgBox "Name: " & objItem.Name & vbCrLf & _
			'	"Path: " & objItem.Path
		Next
		If strReturn <> "" Then
			If intFolder < UBound(arrFolderParts) Then
				For intRemaining = intFolder + 1 To UBound(arrFolderParts)
					strReturn = strReturn & "\" & arrFolderParts(intRemaining)
				Next
			End If
			Exit For
		End If
	Next
	GetSharePath = strReturn
End Function

</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Display Folder Security</h2>
			</td>
		</tr>
		<tr>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				<fieldset style="padding:10 10 10 10;">
				<legend style="color:darkblue;font-weight:bold;">Alternate Credentials (Optional)</legend>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				</fieldset>
				<br>
			</td>
		</tr>
		<tr>
			<td>
				Folder path: <input type="text" id="txt_folderpath" name="txt_folderpath" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_getperms" id="btn_getperms" accessKey="g" onclick="vbs:Get_Permissions"><u>G</u>et Permissions</button><br><br>
				<span id="span_permissions">
				</span><br>
			</td>
		</tr>
		<tr>
			<td>
				Domain controller to change group membership on:&nbsp;<span id="span_domaincontroller"></span><select size='1' name='lst_domaincontrollers'></select>
			</td>
		</tr>
		<tr>
			<td align="center">
				<br><br>
				<button name="btn_adduser" id="btn_adduser" onclick="vbs:Add_User_To_Group" disabled>Add User to Group</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_userdn"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0
Affaan AbyazAuthor Commented:
Hi Rob,

looks like some issue while retrieving the security permissions... refer attached screenshot. User "Tech" have domain admin access and i have tested in my test lab..
0
RobSampsonCommented:
I don't think I can see the screenshot. Did you post it ok? Have you also tried with a path to the root of the share, and not a sub folder of it?
0
Affaan AbyazAuthor Commented:
I guess it has not uploaded properly last time..here we go..
no-output.png
0
RobSampsonCommented:
Hi, slightly revised, can you try this version:
<Html>
<Head>
<Title>Display Folder Security</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath, boolDCHardCodedDC, boolHardCodedUser, strSpecificDC, strTableHTML
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = strCurrentDomain
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
		boolDCHardCodedDC = False
		strSpecificDC = "mymaindc.domain.com"
		If boolDCHardCodedDC = False Then
			Load_Domain_Controller_List
		Else
			lst_domaincontrollers.Style.Visibility = "Hidden"
			span_domaincontroller.InnerHTML = strSpecificDC
		End If
 	End Sub
 
	Sub Load_Domain_Controller_List
		' Use ADO to search Active Directory for ObjectClass nTDSDSA.
		' This will identify all Domain Controllers.
		Set objRootDSE = GetObject("LDAP://RootDSE")
		strConfig = objRootDSE.Get("configurationNamingContext")
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Open "Active Directory Provider"
		adoCommand.ActiveConnection = adoConnection
		
		strBase = "<LDAP://" & strConfig & ">"
		strFilter = "(objectClass=nTDSDSA)"
		strAttributes = "AdsPath"
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 60
		adoCommand.Properties("Cache Results") = False
		
		Set adoRecordset = adoCommand.Execute
		
		' Enumerate parent objects of class nTDSDSA. Save Domain Controller
		' AdsPaths in dynamic array arrstrDCs.
		
		Dim strDetails
		
		Do Until adoRecordset.EOF
		    Set objDC = GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
			Set objActiveOption = Document.CreateElement("OPTION")
			objActiveOption.Text = objDC.DNSHostName
		    objActiveOption.Value = objDC.DNSHostName
		    lst_domaincontrollers.Add objActiveOption
		    adoRecordset.MoveNext
		Loop
		adoRecordset.Close
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_196.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,distinguishedName")
		If strDisplayName = "" Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_userdn.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_userdn.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub HTASleep(intSeconds)
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
	End Sub
 
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
	
	Sub Get_Permissions
		On Error Resume Next
		If txt_folderpath.Value <> "" Then
			strTargetPath = txt_folderpath.Value
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			If objFSO.FolderExists(strTargetPath) = False Then
				MsgBox strTargetPath & " could not be found. Please check the path and try again."
			Else
				'span_permissions.innerHTML = """Date"",""Time"",""Folder"",""Group / User Name"",""Commom Permission's"",""Special Permission's"",""Access Type"",""Inheritance"",""Error's"""
				strTableHTML = "<table border='1'>"
				'strTableHTML = strTableHTML & "<tr><th>Date</th><th>Time</th><th>Folder</th><th>Group / User Name</th><th>Commom Permission's</th><th>Special Permission's</th><th>Access Type</th><th>Inheritance</th><th>Error's</th></tr>"
				strTableHTML = strTableHTML & "<tr><th>Group / User Name</th><th>Commom Permission's</th><th>Access Type</th><th>Inheritance</th><th>Errors</th></tr>"
				ShowSubACL objFSO.GetFolder(strTargetPath)
				strTableHTML = strTableHTML & "</table>"
				span_permissions.innerHTML = strTableHTML
				'ShowSubfolders objFSO.GetFolder(strTargetPath)
			End If
		Else
			MsgBox "Please enter a folder path."
		End If 
		Err.Clear
		On Error GoTo 0
	End Sub

	Sub ShowSubACL(FolderPerm)
		Const ForWriting = 2
		Const ForAppending = 8
		'Commom Permissions
		Const FOLDER_FULL_CONTROL = 2032127
		Const FOLDER_MODIFY = 1245631
		Const FOLDER_READ_ONLY = 1179785
		Const FOLDER_READ_CONTENT_EXECUTE =  1179817 
		Const FOLDER_READ_CONTENT_EXECUTE_WRITE =  1180095 
		Const FOLDER_WRITE = 1179926
		Const FOLDER_READ_WRITE = 1180063 
		'Special Permissions
		Const FOLDER_LIST_DIRECTORY = 1
		Const FOLDER_ADD_FILE = 2
		Const FOLDER_ADD_SUBDIRECTORY = 4
		Const FOLDER_READ_EA = 8
		Const FOLDER_WRITE_EA = 16
		Const FOLDER_EXECUTE = 32
		Const FOLDER_DELETE_CHILD = 64
		Const FOLDER_READ_ATTRIBUTES = 128
		Const FOLDER_WRITE_ATTRIBUTES = 256
		Const FOLDER_DELETE = 65536
		Const FOLDER_READ_CONTROL = 131072
		Const FOLDER_WRITE_DAC = 262144
		Const FOLDER_WRITE_OWNER = 524288
		Const FOLDER_SYNCHRONIZE = 1048576
		'INHERIT
		'Const FOLDER_OBJECT_INHERIT_ACE = 1
		'Const FOLDER_CONTAINER_INHERIT_ACE = 2
		'Const FOLDER_NO_PROPAGATE_INHERIT_ACE = 4
		'Const FOLDER_INHERIT_ONLY_ACE = 8
		Const FOLDER_INHERITED_ACE = 16
		'ACL Control
		Const SE_DACL_PRESENT = 4
		Const ACCESS_ALLOWED_ACE_TYPE = 0
		Const ACCESS_DENIED_ACE_TYPE  = 1
		
		strCPerm = ""
		strSPerm = ""
		strTypePerm = "" 
		strInherit = ""
		strErros = ""
		Set objNetwork = CreateObject("WScript.Network")
		If Left(txt_folderpath.value, 2) = "\\" Then
			strComputer = Left(Mid(txt_folderpath.value, 3), InStr(Mid(txt_folderpath.value, 3), "\") - 1)
		Else
			strComputer = "."
		End If
		If strComputer <> "." Then
			FolderPerm = GetSharePath(strComputer, FolderPerm)
			If FolderPerm = "" Then
				MsgBox "Shared folder " & FolderPerm & " was not found on " & strComputer
				Exit Sub
			End If
		End If
		'MsgBox strComputer & vbCrLf & "Physical folder: " & FolderPerm
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
		Set objFolderSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & FolderPerm & "'")
		intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
		intControlFlags = objSD.ControlFlags
		On Error Resume Next
		If intControlFlags AND SE_DACL_PRESENT Then
			arrACEs = objSD.DACL
			If Err.Number = 0 Then
				strErros = "&nbsp;"
				For Each objACE in arrACEs
					'ACL Type
					If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then strTypePerm = "Allowed"
					If objACE.AceType = ACCESS_DENIED_ACE_TYPE Then strTypePerm = "Denied"
					
					'Inherit
					If objAce.AceFlags AND FOLDER_INHERITED_ACE Then
						strInherit = "Yes"
					Else
						strInherit = "No"
					End if
					
					'Commom Permissions
					If objACE.AccessMask = FOLDER_FULL_CONTROL Then 
						strCPerm = "Full Control"
					ElseIf objACE.AccessMask = FOLDER_MODIFY Then 
						strCPerm = "Modify"
					ElseIf objACE.AccessMask = FOLDER_READ_CONTENT_EXECUTE_WRITE Then
						strCPerm = "Read & Execute / List Folder Contents (folders only) + Write"
					ElseIf objACE.AccessMask = FOLDER_READ_CONTENT_EXECUTE Then 
						strCPerm = "Read & Execute / List Folder Contents (folders only)"
					ElseIf objACE.AccessMask = FOLDER_READ_WRITE Then
						strCPerm = "Read + Write"
					ElseIf objACE.AccessMask = FOLDER_READ_ONLY Then 
						strCPerm = "Read Only"
					ElseIf objACE.AccessMask = FOLDER_WRITE Then 
						strCPerm = "Write"
					Else
						strCPerm = "Special"
					End If
					
					'Special Permissions
					strSPerm = ""
					If objACE.AccessMask and FOLDER_EXECUTE Then strSPerm = strSPerm & "Traverse Folder/Execute File, "
					If objACE.AccessMask and FOLDER_LIST_DIRECTORY Then strSPerm = strSPerm & "List Folder/Read Data, "
					If objACE.AccessMask and FOLDER_READ_ATTRIBUTES Then strSPerm = strSPerm & "Read Attributes, "
					If objACE.AccessMask and FOLDER_READ_EA Then strSPerm = strSPerm & "Read Extended Attributes, "
					If objACE.AccessMask and FOLDER_ADD_FILE Then strSPerm = strSPerm & "Create Files/Write Data, "
					If objACE.AccessMask and FOLDER_ADD_SUBDIRECTORY Then strSPerm = strSPerm & "Create Folders/Append Data"
					If objACE.AccessMask and FOLDER_WRITE_ATTRIBUTES Then strSPerm = strSPerm & "Write Attributes, "
					If objACE.AccessMask and FOLDER_WRITE_EA Then strSPerm = strSPerm & "Write Extended Attributes, "
					If objACE.AccessMask and FOLDER_DELETE_CHILD Then strSPerm = strSPerm & "Delete Subfolders and Files, "
					If objACE.AccessMask and FOLDER_DELETE Then strSPerm = strSPerm & "Delete, "
					If objACE.AccessMask and FOLDER_READ_CONTROL Then strSPerm = strSPerm & "Read Permissions, "
					If objACE.AccessMask and FOLDER_WRITE_DAC Then strSPerm = strSPerm & "Change Permissions, "
					If objACE.AccessMask and FOLDER_WRITE_OWNER Then strSPerm = strSPerm & "Take Ownership, "
					If objACE.AccessMask and FOLDER_SYNCHRONIZE Then strSPerm = strSPerm & "Synchronize, "
					If trim(strSPerm) <> "" then strSPerm =  left(strSPerm, len(strSPerm)-2)
					
					'If UCase(strdrop) = chk_skipinheritance and objAce.AceFlags AND FOLDER_INHERITED_ACE Then
					'	Wscript.echo "Droped ACL Inheritance " & FolderPerm    
					'Else 
					'Wscript.echo "Get ACL on Path: " & FolderPerm
					'""Date"",""Time"",""Folder"",""Group / User Name"",""Commom Permission's"",""Special Permission's"",""Access Type"",""Inherit"",""Error's""
						'span_permissions.innerHTML = span_permissions.innerHTML & "<BR>" & """" & Date() & """,""" & Time() & """,""" & FolderPerm & """,""" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & """,""" & strCPerm & """,""" & strSPerm & """,""" & strTypePerm  & """,""" & strInherit & """,""" & strErros & """"
						'strTableHTML = strTableHTML & "<tr><td>" & Date() & "</td><td>" & Time() & "</td><td>" & FolderPerm & "</td><td>" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & "</td><td>" & strCPerm & "</td><td>" & strSPerm & "</td><td>" & strTypePerm  & "</td><td>" & strInherit & "</td><td>" & strErros & "</td></tr>"
						strTableHTML = strTableHTML & "<tr><td>" & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & "</td><td>" & strCPerm & "</td><td>" & strTypePerm  & "</td><td>" & strInherit & "</td><td>" & strErros & "</td></tr>"
					'wscript.echo objACE.Trustee.Name & " " & objACE.AceFlags
					'End If
				Next
			Else
				strErros = "Cod.: " & Err.Number & " Desc.: " & Err.description
				'strTableHTML = strTableHTML & """" & Date() & """,""" & Time() & """,""" & FolderPerm  & """,""" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & "" & """,""" & strErros & """"
				strTableHTML = strTableHTML & """" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & strErros & """"
				Err.clear
			End If
		Else
			strErros = "Control flags not present"
			'strTableHTML = strTableHTML & """" & Date() & """,""" & Time() & """,""" & FolderPerm  & """,""" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & "" & """,""" & strErros & """"
			strTableHTML = strTableHTML & """" & "" & "" & "" & """,""" & "" & """,""" & "" & """,""" & ""  & """,""" & strErros & """"
			Err.clear
		End If
		Err.Clear
		On Error GoTo 0
	End Sub

	Function GetSharePath(strComputer, strFolderName)
		If Right(strFolderName, 1) = "\" Then strFolderName = Left(strFolderName, Len(strFolderName) - 1)
		arrFolderParts = Split(strFolderName, "\")
		Dim strReturn
		strReturn = ""
		For intFolder = UBound(arrFolderParts) To 3 Step -1
			Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
			Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Share WHERE Name='" & arrFolderParts(intFolder) & "'")
			For Each objItem In colItems
				strReturn = objItem.Path
				'MsgBox "Name: " & objItem.Name & vbCrLf & _
				'	"Path: " & objItem.Path
			Next
			If strReturn <> "" Then
				If intFolder < UBound(arrFolderParts) Then
					For intRemaining = intFolder + 1 To UBound(arrFolderParts)
						strReturn = strReturn & "\" & arrFolderParts(intRemaining)
					Next
				End If
				Exit For
			End If
		Next
		GetSharePath = strReturn
	End Function

</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Display Folder Security</h2>
			</td>
		</tr>
		<tr>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				<fieldset style="padding:10 10 10 10;">
				<legend style="color:darkblue;font-weight:bold;">Alternate Credentials (Optional)</legend>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				</fieldset>
				<br>
			</td>
		</tr>
		<tr>
			<td>
				Folder path: <input type="text" id="txt_folderpath" name="txt_folderpath" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_getperms" id="btn_getperms" accessKey="g" onclick="vbs:Get_Permissions"><u>G</u>et Permissions</button><br><br>
				<span id="span_permissions">
				</span><br>
			</td>
		</tr>
		<tr>
			<td>
				Domain controller to change group membership on:&nbsp;<span id="span_domaincontroller"></span><select size='1' name='lst_domaincontrollers'></select>
			</td>
		</tr>
		<tr>
			<td align="center">
				<br><br>
				<button name="btn_adduser" id="btn_adduser" onclick="vbs:Add_User_To_Group" disabled>Add User to Group</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_userdn"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0
Affaan AbyazAuthor Commented:
Thanks Rob.. works like a charm..
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.