Link to home
Start Free TrialLog in
Avatar of itsmevic
itsmevicFlag for United States of America

asked on

Active Directory: Group Security Mapping

I've got a great .HTA application that was written by Rob Sampson here on EE.  This little application has truly turned into gem for me. The code attached basically queries AD and then provides a list of members who belong to each group.  This is great, however business needs have changed since first using this, and with sOX being so privalant, I realized just how much more powerful this utility could be if it could also provide the "Managed by" person for each Group and his or her email address.  This would be a HUGE HELP!  It already has an Export function to .txt which is fine because I can copy the results into a spreadsheet.

Right now the application is static, meaning you can only search ONE group at a time, so it's time consuming.

In a "perfect world", if I were to be able to just click a button and have it cycle through every group in AD, providing member names that belong to each group as well as the managed by name and their email address, and then when finished if it allow me to just export the whole thing to a spreadsheet (.CSV) that would be AWESOME!

Any help with this is GREATLY APPRECIATED!
HTA-APPLICATION.TXT
Avatar of Meir Rivkin
Meir Rivkin
Flag of Israel image

basically is doing something like:

Set objGroup = GetObject _
  ("LDAP://cn=Scientists,ou=R&D,dc=NA,dc=fabrikam,dc=com")
 
strManagedBy = objGroup.Get("managedBy")
 

check http://www.activexperts.com/activmonitor/windowsmanagement/adminscripts/usersgroups/groups/#ReturnManaged.htm
to cover groups with no managedby attribute do something like that:

Set objGroup = GetObject("LDAP://cn=Scientists,ou=R&D,dc=NA,dc=fabrikam,dc=com")
			On Error Resume Next
			strManagedBy = objGroup.Get("managedBy")
			Err.Clear
			On Error GoTo 0
			
			
			If IsEmpty(strManagedBy) = TRUE Then
			  WScript.Echo "No user account is assigned to manage " & _
				"this group."
			else
			WScript.Echo strManagedBy
			end if

Open in new window

Avatar of itsmevic

ASKER

Does the suggestion you provided below generate the results within the HTA applicatoni or will it just echo out onto the screen?  Where would I need to place this within the existing code?

Set objGroup = GetObject("LDAP://cn=Scientists,ou=R&D,dc=NA,dc=fabrikam,dc=com")
                  On Error Resume Next
                  strManagedBy = objGroup.Get("managedBy")
                  Err.Clear
                  On Error GoTo 0
                  
                  
                  If IsEmpty(strManagedBy) = TRUE Then
                    WScript.Echo "No user account is assigned to manage " & _
                        "this group."
                  else
                  WScript.Echo strManagedBy
                  end if
do u use the HTA as is? or did u modify it?
where do you wanna put this information (managed by and email)?
Hi SeD!

     Right now I'm using the .HTA as is but would like to add the "Managed by" attribute and the Managed by "Email Address."  We could put it anywhere in the .HTA, it doesn't matter.  Hope that helps.

Thanks.
the script uses the group name and value in the option list so where/how do u wish to display the managedBy and email attribute of the group?
i've added the code to retrieve the managedBy user of the group and its email address (lines 59-70).


<Html>
<Head>
<Title>List Group Members</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_members.Style.Width = 500
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		EnumerateGroups strBaseConnString
		Show_Group_Selection
	End Sub
 
	Sub Clear_Members
		For intListProgress = 1 To lst_members.Length
	   		lst_members.Remove 0
	   	Next
	End Sub
 
	Sub EnumerateGroups(strDNSDomain)
		Const ADS_SCOPE_SUBTREE = 2
		Const adVarChar = 200
		Const MaxCharacters = 255
		
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand =   CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCommand.ActiveConnection = objConnection
		
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		
		objCommand.CommandText = "SELECT Name, distinguishedName FROM 'LDAP://" & strDNSDomain & "' WHERE objectClass='group'"
		Set objRecordSet = objCommand.Execute
		
		Set objDataList = CreateObject("ADOR.Recordset")
		objDataList.Fields.Append "name", adVarChar, MaxCharacters
		objDataList.Fields.Append "distinguishedName", adVarChar, MaxCharacters
		objDataList.Open
		
		While Not objRecordSet.EOF
		    objDataList.AddNew
			
			''get managedBy user
			If IsNull(objRecordSet.Fields("managedBy")) then
				WScript.Echo "No user account is assigned to manage group " & objRecordSet.Fields("name").Value
			else
				objDataList("managedBy") = objRecordSet.Fields("managedBy").Value
			end if 

			''get email of managedBy user
			On Error Resume Next
			Set objUser = GetObject("LDAP://" & objRecordSet.Fields("name").Value)
			objUser.GetInfo
			objDataList("email") = objUser.Get("mail")
			
			
		    objDataList("name") = objRecordSet.Fields("name").Value
		    objDataList("distinguishedName") = objRecordSet.Fields("distinguishedName").Value
		    objDataList.Update
			objRecordSet.MoveNext
		Wend
		objRecordSet.Close
		objDataList.Sort = "name"
		objDataList.MoveFirst
		While Not objDataList.EOF
			Set objActiveOption = Document.CreateElement("OPTION")
    		objActiveOption.Text = objDataList.Fields("name").Value
	    	objActiveOption.Value = objDataList.Fields("distinguishedName").Value
	    	lst_GroupFilter.Add objActiveOption
	    	objDataList.MoveNext
		Wend
		objDataList.Close
	End Sub
 
	Sub Show_Group_Selection
		span_GroupFilter.InnerHTML = lst_GroupFilter.Value
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Const adVarChar = 200
		Const MaxCharacters = 255

		Clear_Members

		Set objGroup = GetObject("LDAP://" & lst_groupfilter.Value)
		Set objDataList = CreateObject("ADOR.Recordset")
		objDataList.Fields.Append "name", adVarChar, MaxCharacters
		objDataList.Fields.Append "distinguishedName", adVarChar, MaxCharacters
		objDataList.Open
		
		For Each objObject In objGroup.Members
		    objDataList.AddNew
		    objDataList("name") = objObject.cn
		    objDataList("distinguishedName") = objObject.distinguishedName
		    objDataList.Update
		Next
		objDataList.Sort = "name"
		If Not objDataList.BOF Then objDataList.MoveFirst
		While Not objDataList.EOF
			Set objMember = Document.CreateElement("OPTION")
    		objMember.Text = objDataList.Fields("name").Value
	    	objMember.Value = objDataList.Fields("distinguishedName").Value
	    	lst_members.Add objMember
	    	objDataList.MoveNext
		Wend
		objDataList.Close
	End Sub
	
	Sub ExporT_To_TXT
	    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
		strFileName = Left(strHTAPath, InStrRev(strHTAPath, "\")) & lst_GroupFilter.Item(lst_GroupFilter.SelectedIndex).Text & ".txt"
		strFileName = InputBox("Enter file name to save as:", "Save As", strFileName)
		If strFileName <> "" Then
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			Set objFile = objFSO.CreateTextFile(strFileName, True)
			objFile.WriteLine "Group Distinguished Name: " & lst_groupfilter.Value
			For Each objOption In lst_members
				objFile.WriteLine objOption.Text
			Next
			objFile.Close
			MsgBox "File saved."
		End If
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>List Group Members</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Group Filter:</b>
			</td>
			<td>
			    <select size='1' name='lst_GroupFilter'  onChange='vbs:Show_Group_Selection'>
				</select>
			</td>
		</tr>
		<tr>
			<td colspan=2>
				<b>Group Selected:</b>&nbsp&nbsp&nbsp<span id='span_GroupFilter'></span>
			</td>
		</tr>		<tr>
			<td>
				<b>Members:</b>
			</td>
			<td>
			    <select size='8' name='lst_members'>
				</select>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
			<td>
				<button name="btn_export" id="btn_export" accessKey="E" onclick="vbs:Export_To_TXT"><u>E</u>xport to TXT</button>
			</td>
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

Hi SedWick,

    Where you have the fields are perfect.  The "Group Filter" field is a little skinny and may need more width.  Also, when executing the .HTA file I'm getting the following error:

Line: 60
Character: 4
Error:  "Item cannot be found in the Collection of corresponding to the requested name or ordinal."
Code:  0
i forgot to add managedBy to the select query, so change line 48 to this one:
objCommand.CommandText = "SELECT Name, distinguishedName,ManagedBy FROM 'LDAP://" & strDNSDomain & "' WHERE objectClass='group'"
Hi Sedgwick,

    Thanks for the revision.  Looks like I'm getting this error now when launching:

Line:  61
Char:  5
Error:  Object required: 'WScript'
Code:  0

Thanks for your help!
ASKER CERTIFIED SOLUTION
Avatar of Meir Rivkin
Meir Rivkin
Flag of Israel image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Hi Sedgwick,

     No errors upon executing the script this time, however it doesn't appear to be launching into the GUI.  It will eventually hang and I'll get a "Not Responding" on the top of it's dialog box.  I went into the Task Manager and the Memory usage isn't increasing like it does in the original .HTA.   Interesting.
Thank you.