Solved

Active Directory User Search HTA

Posted on 2012-04-13
9
1,594 Views
Last Modified: 2012-04-19
I pulled some code from another post, what I am looking to do is kind of the same thing with a little more control. I want to be able to search for a user in the entire domain, not just a specific ou. I'd like it to be a wildcard search just in case they dont get the whole name typed in. Then display the search results in a selection box, to be manipulated by some other stuff that I have in my hta. I'm not sure how to filter the search based on user objects in the entire domain.

Thanks for the help

EE Code

  'get all members of group and put them in the selection box
                  Dim arrNames()
                  intSize = 0
                  dd_group.style.width = 200
                  useraccounts.style.width = 200
                  group.style.width = 200
                   Set objRootDSE = GetObject("LDAP://RootDSE")
                   strDNSDomain = objRootDSE.Get("defaultNamingContext")
                  Set objGroup = GetObject("LDAP://CN=G_Group,OU=ou1,OU=ou2,OU=ou3," & strDNSDomain)
 
                                      
                        For Each strUser in objGroup.Member
                              ReDim Preserve arrNames(intSize)
                            Next
       
                        For i = (UBound(arrNames) - 1) to 0 Step -1
                              For j= 0 to i
                                    If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
                                          strHolder = arrNames(j+1)
                                          arrNames(j+1) = arrNames(j)
                                          arrNames(j) = strHolder
                                    End If
                              Next
                        Next 
       
                        For Each strUser in arrNames
                              Set objOption = Document.createElement("OPTION")
                        objOption.Text = Split(strUser, "|")(0)
                        objOption.Value = Split(strUser, "|")(1)
                        UserAccounts.Add(objOption)
                        Next
                  

Open in new window

0
Comment
Question by:rjccomps
  • 5
  • 4
9 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 37848192
Hi, I think we'll need to see more of your HTA for the changes you have requested.  You can remove company specific strings before you post it.

Rob.
0
 
LVL 1

Author Comment

by:rjccomps
ID: 37852290
Ok code is attached for the full HTA, I tried something with the UserSearch sub but it doesnt work. I specified the user in the code rather than inserting a variable just until I can get something working. But ultimately I'll put a search box. The majority of the code comes from the link above with a few modifications.

<html>
<head>
<title>User Manager</title>
<style type="text/css">
body {
	margin:0px;
	background-color:#CBCBCB; /*#F6F6F6;*/
	font-family:Arial, Helvetica, sans-serif;
	font-size:14px;
	color:#595959;
}
h1 {
	font-size:24px;
	font-weight:bold;
	color:#FFFFFF;
	background-color:#2886C8;
	text-align:center;
	border-style:solid;
	border-width:thin;
	border-color:#C9E0F1;
	padding:5px;
}
</style>
</head>
 
<body>
<center>
<table border="0" width="50%">
	<tr>
		<td width="100%" colspan="4">
		<br></br>
		<br></br>
		<p align="center">Select a group:
		<select size="1" name="DD_Group" onchange="vbs:GetMembers">
    </select>

	</tr>
	<tr>
		<td width="50%">
		<p align="center">
<select size="10" name="UserAccounts"></select></td>
		<td width="50%">
		<p align="center">
<select size="10" name="Group"></select></td>
	</tr>
	<tr>
		<td width="50%">
		<p align="center">
<input type="button" value="Add To Group" onClick="AddToGroup"></td>
		<td width="50%">
		<p align="center">
<input type="button" value="Remove From Group" onClick="RemoveFromGroup"></td>
<input type="button" value="List Users" onClick="vbs:UserSearch"></td>
	</tr>
</table>
 
</center>
</body>

<SCRIPT Language="VBScript">
Sub Window_Onload

dd_group.style.width = 460
			useraccounts.style.width = 200
			group.style.width = 200
'Grabs the groups from specific OU and populates the combobox			
Dim objGroup1
Set objOU = GetObject("LDAP://ou=groups,ou=OU,ou=OU,ou=us,dc=COM,dc=COM,dc=COM")
objOU.Filter = Array("Group")

                        For Each objGroup In objOU
						objGroup1 = right(objGroup.name,len(objGroup.name)-3)
                                         Set objOption = Document.createElement("OPTION")
										 objOption.Text = objGroup1
										 objOption.Value = objGroup.Name
										 DD_Group.Add(objOption)
                                    Next					

End Sub



Sub GetMembers

Dim strGroup
Dim arrNames()
			intSize = 0
			
			strGroup = "LDAP://" & DD_Group.Value & ",ou=groups,ou=nor,ou=pep,ou=us,dc=AM,dc=CPB,dc=COM"

			Set objGroup = GetObject(strGroup)
			
	    	For intOption = 1 To Group.Length
	    		Group.Remove 0
	    	Next
 
			If TypeName(objGroup.Member) = "Empty" Then
				MsgBox "There are no members in the selected group."
			ElseIf TypeName(objGroup.Member) = "String" Then
				Set objOption = Document.createElement("OPTION")
	            objOption.Text = Mid(Split(objGroup.Member, ",")(0), 4)
	            objOption.Value = objGroup.Member
	            Group.Add(objOption)
			Else
				For Each strUser in objGroup.Member
					ReDim Preserve arrNames(intSize)
					arrNames(intSize) = Mid(Split(strUser, ",")(0), 4) & "|" & strUser
					intSize = intSize + 1
				Next
	 
				For i = (UBound(arrNames) - 1) to 0 Step -1
					For j= 0 to i
						If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
							strHolder = arrNames(j+1)
							arrNames(j+1) = arrNames(j)
							arrNames(j) = strHolder
						End If
					Next
				Next 
	 
				For Each strUser in arrNames
					Set objOption = Document.createElement("OPTION")
		            objOption.Text = Split(strUser, "|")(0)
		            objOption.Value = Split(strUser, "|")(1)
		            Group.Add(objOption)
				Next
			End If
	End Sub
	
	
Sub RemoveFromGroup
	ADS_PROPERTY_DELETE = 4
	strGroup = "LDAP://" & DD_Group.Value & ",ou=groups,ou=OU,ou=OU,ou=us,dc=COM,dc=COM,dc=COM"
	Set objGroup = GetObject(strGroup)
	strUser = group.Value
    objGroup.PutEx ADS_PROPERTY_DELETE, "member", Array(strUser)
    objGroup.SetInfo
    Set objGroup = Nothing
	Call GetMembers
End Sub

Sub UserSearch
Dim arrNames()
			intSize = 0
	Set objRootDSE = GetObject("LDAP://RootDSE")
 			strDNSDomain = objRootDSE.Get("defaultNamingContext")
			Set objGroup = GetObject("LDAP://" & strDNSDomain);(&(objectCategory=person)(objectClass=user)(cn="test*"));
 			
				For Each strUser in arrNames
					ReDim Preserve arrNames(intSize)
						arrNames(intSize) = Mid(Split(strUser, ",")(0), 4) & "|" & strUser
						intSize = intSize + 1
				Next
	 
				For Each strUser in arrNames
					Set objOption = Document.createElement("OPTION")
		            objOption.Text = Split(strUser, "|")(0)
		            objOption.Value = Split(strUser, "|")(1)
		            UserAccounts.Add(objOption)
				Next
	End sub
	
	</SCRIPT>

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37854096
Hi, I've reworked the code quite a bit, and added the search function.  See how this goes for you.

Regards,

Rob.

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>User Manager</title>
<hta:application
	applicationname="User Manager"	
	caption="User Manager"
	contextmenu="no"
	maximizebutton="no"
	minimizebutton="yes"
	navigable="no"
	scroll="no"
	selection="no"
	showintaskbar="yes"
	singleinstance="yes"
	sysmenu="yes"
	windowstate="normal"
>
<style type="text/css">
body {
	margin:0px;
	background-color:#CBCBCB; /*#F6F6F6;*/
	font-family:Arial, Helvetica, sans-serif;
	font-size:14px;
	color:#595959;
}
h1 {
	font-size:24px;
	font-weight:bold;
	color:#FFFFFF;
	background-color:#2886C8;
	text-align:center;
	border-style:solid;
	border-width:thin;
	border-color:#C9E0F1;
	padding:5px;
}
</style>
<script language="vbscript">
Sub Window_Onload

	dd_group.style.width = 460
	useraccounts.style.width = 200
	group.style.width = 200
	'Grabs the groups from specific OU and populates the combobox			
	Dim objGroup1
	'Set objOU = GetObject("LDAP://ou=groups,ou=OU,ou=OU,ou=us,dc=COM,dc=COM,dc=COM")
	Set objOU = GetObject("LDAP://ou=TestUsers,ou=TestOU,dc=Maroondah,dc=Local")
	objOU.Filter = Array("Group")
	
	For Each objGroup In objOU
		objGroup1 = right(objGroup.name,len(objGroup.name)-3)
		Set objOption = Document.createElement("OPTION")
		objOption.Text = objGroup1
		objOption.Value = objGroup.adsPath
		DD_Group.Add(objOption)
	Next					
	GetMembers
End Sub

Sub GetMembers

	Dim strGroup
	Dim arrNames()
	intSize = 0
	'strGroup = "LDAP://" & DD_Group.Value & ",ou=groups,ou=nor,ou=pep,ou=us,dc=AM,dc=CPB,dc=COM"
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)

	For intOption = 1 To Group.Length
		Group.Remove 0
	Next

	If TypeName(objGroup.Member) = "Empty" Then
		MsgBox "There are no members in the selected group."
	ElseIf TypeName(objGroup.Member) = "String" Then
		Set objOption = Document.createElement("OPTION")
		objOption.Text = Mid(Split(objGroup.Member, ",")(0), 4)
		objOption.Value = objGroup.Member
		Group.Add(objOption)
	Else
		For Each strUser in objGroup.Member
			ReDim Preserve arrNames(intSize)
			arrNames(intSize) = Mid(Split(strUser, ",")(0), 4) & "|" & strUser
			intSize = intSize + 1
		Next
		For i = (UBound(arrNames) - 1) to 0 Step -1
			For j= 0 To i
				If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
					strHolder = arrNames(j+1)
					arrNames(j+1) = arrNames(j)
					arrNames(j) = strHolder
				End If
			Next
		Next
		For Each strUser in arrNames
			Set objOption = Document.createElement("OPTION")
			objOption.Text = Split(strUser, "|")(0)
			objOption.Value = Split(strUser, "|")(1)
			Group.Add(objOption)
		Next
	End If
End Sub

Sub RemoveFromGroup
	ADS_PROPERTY_DELETE = 4
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)
	strUser = group.Value
	objGroup.PutEx ADS_PROPERTY_DELETE, "member", Array(strUser)
	objGroup.SetInfo
	Set objGroup = Nothing
	Call GetMembers
End Sub

Sub AddToGroup
	ADS_PROPERTY_APPEND = 3
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)
	strUser = UserAccounts.Value
	objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(strUser)
	objGroup.SetInfo
	Set objGroup = Nothing
	Call GetMembers
End Sub

Sub UserSearch
	If Trim(txt_usersearch.value) = "" Then
		MsgBox "Please enter a search term."
		Exit Sub
	End If
	Dim arrNames()
	intSize = 0
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	'Set objGroup = GetObject("LDAP://" & strDNSDomain);(&(objectCategory=person)(objectClass=user)(cn="test*"));
	
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection
	
	strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Trim(txt_usersearch.Value) & "*))"
	
	strAttributes = "cn,distinguishedname"
	
	' Construct the LDAP syntax query.
	strQuery = "<LDAP://" & strDNSDomain & ">;" & 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
	 
	' Enumerate the resulting recordset.
	Do Until adoRecordset.EOF
		ReDim Preserve arrNames(intSize)
		arrNames(intSize) = Mid(Split(adoRecordset("distinguishedname"), ",")(0), 4) & "|" & adoRecordset("distinguishedname")
		intSize = intSize + 1
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
	Loop
	
	' Clean up.
	adoRecordset.Close
	Set adoRecordset = Nothing
	
	adoConnection.Close

	For i = (UBound(arrNames) - 1) to 0 Step -1
		For j= 0 To i
			If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
				strHolder = arrNames(j+1)
				arrNames(j+1) = arrNames(j)
				arrNames(j) = strHolder
			End If
		Next
	Next
	For Each strUser in arrNames
		Set objOption = Document.createElement("OPTION")
		objOption.Text = Split(strUser, "|")(0)
		objOption.Value = Split(strUser, "|")(1)
		UserAccounts.Add(objOption)
	Next
End Sub
</script>
</head>
<body>
<center>
<table border="0" width="50%">
	<tr>
		<td width="100%" colspan="4">
			<br></br>
			<br></br>
			<p align="center">Select a group:
				<select size="1" name="DD_Group" onchange="vbs:GetMembers">
		    	</select>
		    </p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				Current Members:
			</p>
		</td>
		<td width="50%">
			<p align="center">
				Search for User: <input type="text" maxlength="40" size="30" name="txt_usersearch" id="txt_usersearch"> <input type="button" value="List Users" onClick="vbs:UserSearch">
			</p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				<select size="10" name="Group"></select>
			</p>
		</td>
		<td width="50%">
			<p align="center">
				<select size="10" name="UserAccounts"></select>
			</p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				<input type="button" value="Remove From Group" onClick="RemoveFromGroup">
			</p>
		</td>
		<td width="50%">
			<p align="center">
				<input type="button" value="Add To Group" onClick="AddToGroup">
			</p>
		</td>
	</tr>
</table>
 
</center>
</body>
</html>

Open in new window

0
 
LVL 1

Author Comment

by:rjccomps
ID: 37855382
Works great, one issue though, it doesn't clear the user accounts from a previous search it just appends the new search results to whats it there. Also is it possible to have something pop up saying searching and once the vbs completes it closes?

Edit: Added this to the UserSearch sub to clear the listbox still working on the searching... popup


For each strUser in useraccounts
strUser.RemoveNode
Next

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37858770
I have added a textual output, and disabled the buttons while searching.

Regards,

Rob.

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>User Manager</title>
<hta:application
	applicationname="User Manager"	
	caption="User Manager"
	contextmenu="no"
	maximizebutton="no"
	minimizebutton="yes"
	navigable="no"
	scroll="no"
	selection="no"
	showintaskbar="yes"
	singleinstance="yes"
	sysmenu="yes"
	windowstate="normal"
>
<style type="text/css">
body {
	margin:0px;
	background-color:#CBCBCB; /*#F6F6F6;*/
	font-family:Arial, Helvetica, sans-serif;
	font-size:14px;
	color:#595959;
}
h1 {
	font-size:24px;
	font-weight:bold;
	color:#FFFFFF;
	background-color:#2886C8;
	text-align:center;
	border-style:solid;
	border-width:thin;
	border-color:#C9E0F1;
	padding:5px;
}
</style>
<script language="vbscript">
Sub Window_Onload

	dd_group.style.width = 460
	useraccounts.style.width = 200
	group.style.width = 200
	'Grabs the groups from specific OU and populates the combobox			
	Dim objGroup1
	Set objOU = GetObject("LDAP://ou=groups,ou=OU,ou=OU,ou=us,dc=COM,dc=COM,dc=COM")
	objOU.Filter = Array("Group")
	
	For Each objGroup In objOU
		objGroup1 = right(objGroup.name,len(objGroup.name)-3)
		Set objOption = Document.createElement("OPTION")
		objOption.Text = objGroup1
		objOption.Value = objGroup.adsPath
		DD_Group.Add(objOption)
	Next					
	GetMembers
End Sub

Sub GetMembers

	Dim strGroup
	Dim arrNames()
	intSize = 0
	'strGroup = "LDAP://" & DD_Group.Value & ",ou=groups,ou=nor,ou=pep,ou=us,dc=AM,dc=CPB,dc=COM"
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)

	For intOption = 1 To Group.Length
		Group.Remove 0
	Next

	If TypeName(objGroup.Member) = "Empty" Then
		MsgBox "There are no members in the selected group."
	ElseIf TypeName(objGroup.Member) = "String" Then
		Set objOption = Document.createElement("OPTION")
		objOption.Text = Mid(Split(objGroup.Member, ",")(0), 4)
		objOption.Value = objGroup.Member
		Group.Add(objOption)
	Else
		For Each strUser in objGroup.Member
			ReDim Preserve arrNames(intSize)
			arrNames(intSize) = Mid(Split(strUser, ",")(0), 4) & "|" & strUser
			intSize = intSize + 1
		Next
		For i = (UBound(arrNames) - 1) to 0 Step -1
			For j= 0 To i
				If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
					strHolder = arrNames(j+1)
					arrNames(j+1) = arrNames(j)
					arrNames(j) = strHolder
				End If
			Next
		Next
		For Each strUser in arrNames
			Set objOption = Document.createElement("OPTION")
			objOption.Text = Split(strUser, "|")(0)
			objOption.Value = Split(strUser, "|")(1)
			Group.Add(objOption)
		Next
	End If
End Sub

Sub RemoveFromGroup
	ADS_PROPERTY_DELETE = 4
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)
	strUser = group.Value
	objGroup.PutEx ADS_PROPERTY_DELETE, "member", Array(strUser)
	objGroup.SetInfo
	Set objGroup = Nothing
	Call GetMembers
End Sub

Sub AddToGroup
	ADS_PROPERTY_APPEND = 3
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)
	strUser = UserAccounts.Value
	objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(strUser)
	objGroup.SetInfo
	Set objGroup = Nothing
	Call GetMembers
End Sub

Sub UserSearch
    For Each objOption In UserAccounts.Options
        UserAccounts.Remove(objOption.Index)
   	Next
	If Trim(txt_usersearch.value) = "" Then
		MsgBox "Please enter a search term."
		Exit Sub
	End If
	span_progress.InnerHTML = "Searching..."
	btn_search.disabled = True
	btn_remove.disabled = True
	btn_add.disabled = True
	Dim arrNames()
	intSize = 0
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	'Set objGroup = GetObject("LDAP://" & strDNSDomain);(&(objectCategory=person)(objectClass=user)(cn="test*"));
	
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection
	
	strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Trim(txt_usersearch.Value) & "*))"
	
	strAttributes = "cn,distinguishedname"
	
	' Construct the LDAP syntax query.
	strQuery = "<LDAP://" & strDNSDomain & ">;" & 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
	 
	' Enumerate the resulting recordset.
	Do Until adoRecordset.EOF
		ReDim Preserve arrNames(intSize)
		arrNames(intSize) = Mid(Split(adoRecordset("distinguishedname"), ",")(0), 4) & "|" & adoRecordset("distinguishedname")
		intSize = intSize + 1
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
	Loop
	
	' Clean up.
	adoRecordset.Close
	Set adoRecordset = Nothing
	
	adoConnection.Close

	If intSize > 0 Then
		For i = (UBound(arrNames) - 1) to 0 Step -1
			For j= 0 To i
				If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
					strHolder = arrNames(j+1)
					arrNames(j+1) = arrNames(j)
					arrNames(j) = strHolder
				End If
			Next
		Next
		For Each strUser in arrNames
			Set objOption = Document.createElement("OPTION")
			objOption.Text = Split(strUser, "|")(0)
			objOption.Value = Split(strUser, "|")(1)
			UserAccounts.Add(objOption)
		Next
	Else
		MsgBox "No users were found."
	End If
	span_progress.InnerHTML = ""
	btn_search.disabled = False
	btn_remove.disabled = False
	btn_add.disabled = False
End Sub
</script>
</head>
<body>
<center>
<table border="0" width="50%">
	<tr>
		<td width="100%" colspan="4">
			<br></br>
			<br></br>
			<p align="center">Select a group:
				<select size="1" name="DD_Group" onchange="vbs:GetMembers">
		    	</select>
		    </p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				Current Members:
			</p>
		</td>
		<td width="50%">
			<p align="center">
				Search for User: <input type="text" maxlength="40" size="30" name="txt_usersearch" id="txt_usersearch"> <input type="button" name="btn_search" value="List Users" onClick="vbs:UserSearch">
			</p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				<select size="10" name="Group"></select>
			</p>
		</td>
		<td width="50%">
			<p align="center">
				<select size="10" name="UserAccounts"></select>
			</p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				<input type="button" value="Remove From Group" name="btn_remove" onClick="RemoveFromGroup">
			</p>
		</td>
		<td width="50%">
			<p align="center">
				<input type="button" value="Add To Group" name="btn_add" onClick="AddToGroup">
			</p>
		</td>
	</tr>
	<tr>
		<td colspan="2" align="center">
			<br>
			<span id="span_progress"></span>
		</td>
	</tr>
</table>
 
</center>
</body>
</html>

Open in new window

0
 
LVL 1

Author Comment

by:rjccomps
ID: 37861746
that html span doesn't popup on the search still
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 37864167
It should say Searching... as given by this line:
      span_progress.InnerHTML = "Searching..."

but it's probably more that the HTA isn't completing the request before the search takes upt the processing.

See if this helps.

Regards,

Rob.

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>User Manager</title>
<hta:application
	applicationname="User Manager"	
	caption="User Manager"
	contextmenu="no"
	maximizebutton="no"
	minimizebutton="yes"
	navigable="no"
	scroll="no"
	selection="no"
	showintaskbar="yes"
	singleinstance="yes"
	sysmenu="yes"
	windowstate="normal"
>
<style type="text/css">
body {
	margin:0px;
	background-color:#CBCBCB; /*#F6F6F6;*/
	font-family:Arial, Helvetica, sans-serif;
	font-size:14px;
	color:#595959;
}
h1 {
	font-size:24px;
	font-weight:bold;
	color:#FFFFFF;
	background-color:#2886C8;
	text-align:center;
	border-style:solid;
	border-width:thin;
	border-color:#C9E0F1;
	padding:5px;
}
</style>
<script language="vbscript">
Sub Window_Onload

	dd_group.style.width = 460
	useraccounts.style.width = 200
	group.style.width = 200
	'Grabs the groups from specific OU and populates the combobox			
	Dim objGroup1
	Set objOU = GetObject("LDAP://ou=groups,ou=OU,ou=OU,ou=us,dc=COM,dc=COM,dc=COM")
	objOU.Filter = Array("Group")
	
	For Each objGroup In objOU
		objGroup1 = right(objGroup.name,len(objGroup.name)-3)
		Set objOption = Document.createElement("OPTION")
		objOption.Text = objGroup1
		objOption.Value = objGroup.adsPath
		DD_Group.Add(objOption)
	Next					
	GetMembers
End Sub

Sub GetMembers

	Dim strGroup
	Dim arrNames()
	intSize = 0
	'strGroup = "LDAP://" & DD_Group.Value & ",ou=groups,ou=nor,ou=pep,ou=us,dc=AM,dc=CPB,dc=COM"
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)

	For intOption = 1 To Group.Length
		Group.Remove 0
	Next

	If TypeName(objGroup.Member) = "Empty" Then
		MsgBox "There are no members in the selected group."
	ElseIf TypeName(objGroup.Member) = "String" Then
		Set objOption = Document.createElement("OPTION")
		objOption.Text = Mid(Split(objGroup.Member, ",")(0), 4)
		objOption.Value = objGroup.Member
		Group.Add(objOption)
	Else
		For Each strUser in objGroup.Member
			ReDim Preserve arrNames(intSize)
			arrNames(intSize) = Mid(Split(strUser, ",")(0), 4) & "|" & strUser
			intSize = intSize + 1
		Next
		For i = (UBound(arrNames) - 1) to 0 Step -1
			For j= 0 To i
				If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
					strHolder = arrNames(j+1)
					arrNames(j+1) = arrNames(j)
					arrNames(j) = strHolder
				End If
			Next
		Next
		For Each strUser in arrNames
			Set objOption = Document.createElement("OPTION")
			objOption.Text = Split(strUser, "|")(0)
			objOption.Value = Split(strUser, "|")(1)
			Group.Add(objOption)
		Next
	End If
End Sub

Sub RemoveFromGroup
	ADS_PROPERTY_DELETE = 4
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)
	strUser = group.Value
	objGroup.PutEx ADS_PROPERTY_DELETE, "member", Array(strUser)
	objGroup.SetInfo
	Set objGroup = Nothing
	Call GetMembers
End Sub

Sub AddToGroup
	ADS_PROPERTY_APPEND = 3
	strGroup = DD_Group.Value
	Set objGroup = GetObject(strGroup)
	strUser = UserAccounts.Value
	objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(strUser)
	objGroup.SetInfo
	Set objGroup = Nothing
	Call GetMembers
End Sub

Sub UserSearch
    For Each objOption In UserAccounts.Options
        UserAccounts.Remove(objOption.Index)
   	Next
	If Trim(txt_usersearch.value) = "" Then
		MsgBox "Please enter a search term."
		Exit Sub
	End If
	span_progress.InnerHTML = "Searching..."
	HTASleep 1
	btn_search.disabled = True
	btn_remove.disabled = True
	btn_add.disabled = True
	Dim arrNames()
	intSize = 0
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	'Set objGroup = GetObject("LDAP://" & strDNSDomain);(&(objectCategory=person)(objectClass=user)(cn="test*"));
	
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection
	
	strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Trim(txt_usersearch.Value) & "*))"
	
	strAttributes = "cn,distinguishedname"
	
	' Construct the LDAP syntax query.
	strQuery = "<LDAP://" & strDNSDomain & ">;" & 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
	 
	' Enumerate the resulting recordset.
	Do Until adoRecordset.EOF
		ReDim Preserve arrNames(intSize)
		arrNames(intSize) = Mid(Split(adoRecordset("distinguishedname"), ",")(0), 4) & "|" & adoRecordset("distinguishedname")
		intSize = intSize + 1
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
	Loop
	
	' Clean up.
	adoRecordset.Close
	Set adoRecordset = Nothing
	
	adoConnection.Close

	If intSize > 0 Then
		For i = (UBound(arrNames) - 1) to 0 Step -1
			For j= 0 To i
				If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
					strHolder = arrNames(j+1)
					arrNames(j+1) = arrNames(j)
					arrNames(j) = strHolder
				End If
			Next
		Next
		For Each strUser in arrNames
			Set objOption = Document.createElement("OPTION")
			objOption.Text = Split(strUser, "|")(0)
			objOption.Value = Split(strUser, "|")(1)
			UserAccounts.Add(objOption)
		Next
	Else
		MsgBox "No users were found."
	End If
	span_progress.InnerHTML = ""
	btn_search.disabled = False
	btn_remove.disabled = False
	btn_add.disabled = False
End Sub

Sub HTASleep(intSeconds)
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
End Sub
</script>
</head>
<body>
<center>
<table border="0" width="50%">
	<tr>
		<td width="100%" colspan="4">
			<br></br>
			<br></br>
			<p align="center">Select a group:
				<select size="1" name="DD_Group" onchange="vbs:GetMembers">
		    	</select>
		    </p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				Current Members:
			</p>
		</td>
		<td width="50%">
			<p align="center">
				Search for User: <input type="text" maxlength="40" size="30" name="txt_usersearch" id="txt_usersearch"> <input type="button" name="btn_search" value="List Users" onClick="vbs:UserSearch">
			</p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				<select size="10" name="Group"></select>
			</p>
		</td>
		<td width="50%">
			<p align="center">
				<select size="10" name="UserAccounts"></select>
			</p>
		</td>
	</tr>
	<tr>
		<td width="50%">
			<p align="center">
				<input type="button" value="Remove From Group" name="btn_remove" onClick="RemoveFromGroup">
			</p>
		</td>
		<td width="50%">
			<p align="center">
				<input type="button" value="Add To Group" name="btn_add" onClick="AddToGroup">
			</p>
		</td>
	</tr>
	<tr>
		<td colspan="2" align="center">
			<br>
			<span id="span_progress"></span>
		</td>
	</tr>
</table>
 
</center>
</body>
</html>

Open in new window

0
 
LVL 1

Author Comment

by:rjccomps
ID: 37867222
That works! Awesome thanks for the help
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37868428
No problem. Thanks for the grade.

Regards,

Rob.
0

Join & Write a Comment

Building a website can seem like a daunting task to the uninitiated but it really only requires knowledge of two basic languages: HTML and CSS.
This article discusses how to create an extensible mechanism for linked drop downs.
In this tutorial viewers will learn how to embed Flash content in a webpage using HTML5. Ensure your DOCTYPE declaration is set to HTML5: "<!DOCTYPE html>": Use the <object> tag to embed Flash content.: To specify that the object is Flash content, d…
The viewer will learn the basics of jQuery including how to code hide show and toggles. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now